diff --git a/lib/sundials_6.1.1/include/arkode/arkode.h b/lib/sundials_6.1.1/include/arkode/arkode.h new file mode 100644 index 00000000000..fa30036ffb2 --- /dev/null +++ b/lib/sundials_6.1.1/include/arkode/arkode.h @@ -0,0 +1,183 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the main ARKode infrastructure. + * ----------------------------------------------------------------- + * ARKode is used to numerically solve the ordinary initial value + * problems using one-step methods. Users do not call ARKode + * infrastructure routines directly; they instead interact with + * one of the time stepping modules built on top of ARKode. + * These time step modules define their supported problem types, + * solver options, etc. + * + * This file serves to define constants and provide function + * prototypes for use across ARKode-based time integration + * modules. + * -----------------------------------------------------------------*/ + +#ifndef _ARKODE_H +#define _ARKODE_H + +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ----------------- + * ARKode Constants + * ----------------- */ + +/* usage modes (itask) */ +#define ARK_NORMAL 1 +#define ARK_ONE_STEP 2 + +/* adaptivity module flags */ +#define ARK_ADAPT_CUSTOM -1 +#define ARK_ADAPT_PID 0 +#define ARK_ADAPT_PI 1 +#define ARK_ADAPT_I 2 +#define ARK_ADAPT_EXP_GUS 3 +#define ARK_ADAPT_IMP_GUS 4 +#define ARK_ADAPT_IMEX_GUS 5 + +/* Constants for evaluating the full RHS */ +#define ARK_FULLRHS_START 0 +#define ARK_FULLRHS_END 1 +#define ARK_FULLRHS_OTHER 2 + +/* interpolation module flags */ + +/* max allowed degree */ +#define ARK_INTERP_MAX_DEGREE 5 + +/* interpolation module types */ +#define ARK_INTERP_HERMITE 0 +#define ARK_INTERP_LAGRANGE 1 + + +/* return values */ + +#define ARK_SUCCESS 0 +#define ARK_TSTOP_RETURN 1 +#define ARK_ROOT_RETURN 2 + +#define ARK_WARNING 99 + +#define ARK_TOO_MUCH_WORK -1 +#define ARK_TOO_MUCH_ACC -2 +#define ARK_ERR_FAILURE -3 +#define ARK_CONV_FAILURE -4 + +#define ARK_LINIT_FAIL -5 +#define ARK_LSETUP_FAIL -6 +#define ARK_LSOLVE_FAIL -7 +#define ARK_RHSFUNC_FAIL -8 +#define ARK_FIRST_RHSFUNC_ERR -9 +#define ARK_REPTD_RHSFUNC_ERR -10 +#define ARK_UNREC_RHSFUNC_ERR -11 +#define ARK_RTFUNC_FAIL -12 +#define ARK_LFREE_FAIL -13 +#define ARK_MASSINIT_FAIL -14 +#define ARK_MASSSETUP_FAIL -15 +#define ARK_MASSSOLVE_FAIL -16 +#define ARK_MASSFREE_FAIL -17 +#define ARK_MASSMULT_FAIL -18 + +#define ARK_CONSTR_FAIL -19 +#define ARK_MEM_FAIL -20 +#define ARK_MEM_NULL -21 +#define ARK_ILL_INPUT -22 +#define ARK_NO_MALLOC -23 +#define ARK_BAD_K -24 +#define ARK_BAD_T -25 +#define ARK_BAD_DKY -26 +#define ARK_TOO_CLOSE -27 + +#define ARK_VECTOROP_ERR -28 + +#define ARK_NLS_INIT_FAIL -29 +#define ARK_NLS_SETUP_FAIL -30 +#define ARK_NLS_SETUP_RECVR -31 +#define ARK_NLS_OP_ERR -32 + +#define ARK_INNERSTEP_ATTACH_ERR -33 +#define ARK_INNERSTEP_FAIL -34 +#define ARK_OUTERTOINNER_FAIL -35 +#define ARK_INNERTOOUTER_FAIL -36 + +/* ARK_POSTPROCESS_FAIL equals ARK_POSTPROCESS_STEP_FAIL + for backwards compatibility */ +#define ARK_POSTPROCESS_FAIL -37 +#define ARK_POSTPROCESS_STEP_FAIL -37 +#define ARK_POSTPROCESS_STAGE_FAIL -38 + +#define ARK_USER_PREDICT_FAIL -39 +#define ARK_INTERP_FAIL -40 + +#define ARK_INVALID_TABLE -41 + +#define ARK_CONTEXT_ERR -42 + +#define ARK_UNRECOGNIZED_ERROR -99 + +/* ------------------------------ + * User-Supplied Function Types + * ------------------------------ */ + +typedef int (*ARKRhsFn)(realtype t, N_Vector y, + N_Vector ydot, void *user_data); + +typedef int (*ARKRootFn)(realtype t, N_Vector y, + realtype *gout, void *user_data); + +typedef int (*ARKEwtFn)(N_Vector y, N_Vector ewt, void *user_data); + +typedef int (*ARKRwtFn)(N_Vector y, N_Vector rwt, void *user_data); + +typedef void (*ARKErrHandlerFn)(int error_code, const char *module, + const char *function, char *msg, + void *user_data); + +typedef int (*ARKAdaptFn)(N_Vector y, realtype t, realtype h1, + realtype h2, realtype h3, + realtype e1, realtype e2, + realtype e3, int q, int p, + realtype *hnew, void *user_data); + +typedef int (*ARKExpStabFn)(N_Vector y, realtype t, + realtype *hstab, void *user_data); + +typedef int (*ARKVecResizeFn)(N_Vector y, N_Vector ytemplate, + void *user_data); + +typedef int (*ARKPostProcessFn)(realtype t, N_Vector y, + void *user_data); + +typedef int (*ARKStagePredictFn)(realtype t, N_Vector zpred, + void *user_data); + +/* -------------------------- + * MRIStep Inner Stepper Type + * -------------------------- */ + +typedef _SUNDIALS_STRUCT_ _MRIStepInnerStepper *MRIStepInnerStepper; + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/include/arkode/arkode_arkstep.h b/lib/sundials_6.1.1/include/arkode/arkode_arkstep.h new file mode 100644 index 00000000000..22245ce2f52 --- /dev/null +++ b/lib/sundials_6.1.1/include/arkode/arkode_arkstep.h @@ -0,0 +1,465 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the ARKode ARKStep module. + * -----------------------------------------------------------------*/ + +#ifndef _ARKSTEP_H +#define _ARKSTEP_H + +#include +#include +#include +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ----------------- + * ARKStep Constants + * ----------------- */ + +/* Default Butcher tables for each method/order */ + +/* explicit */ +static const int ARKSTEP_DEFAULT_ERK_2 = ARKODE_HEUN_EULER_2_1_2; +static const int ARKSTEP_DEFAULT_ERK_3 = ARKODE_BOGACKI_SHAMPINE_4_2_3; +static const int ARKSTEP_DEFAULT_ERK_4 = ARKODE_ZONNEVELD_5_3_4; +static const int ARKSTEP_DEFAULT_ERK_5 = ARKODE_CASH_KARP_6_4_5; +static const int ARKSTEP_DEFAULT_ERK_6 = ARKODE_VERNER_8_5_6; +static const int ARKSTEP_DEFAULT_ERK_8 = ARKODE_FEHLBERG_13_7_8; + +/* implicit */ +static const int ARKSTEP_DEFAULT_DIRK_2 = ARKODE_SDIRK_2_1_2; +static const int ARKSTEP_DEFAULT_DIRK_3 = ARKODE_ARK324L2SA_DIRK_4_2_3; +static const int ARKSTEP_DEFAULT_DIRK_4 = ARKODE_SDIRK_5_3_4; +static const int ARKSTEP_DEFAULT_DIRK_5 = ARKODE_ARK548L2SA_DIRK_8_4_5; + +/* ImEx */ +static const int ARKSTEP_DEFAULT_ARK_ETABLE_3 = ARKODE_ARK324L2SA_ERK_4_2_3; +static const int ARKSTEP_DEFAULT_ARK_ETABLE_4 = ARKODE_ARK436L2SA_ERK_6_3_4; +static const int ARKSTEP_DEFAULT_ARK_ETABLE_5 = ARKODE_ARK548L2SA_ERK_8_4_5; +static const int ARKSTEP_DEFAULT_ARK_ITABLE_3 = ARKODE_ARK324L2SA_DIRK_4_2_3; +static const int ARKSTEP_DEFAULT_ARK_ITABLE_4 = ARKODE_ARK436L2SA_DIRK_6_3_4; +static const int ARKSTEP_DEFAULT_ARK_ITABLE_5 = ARKODE_ARK548L2SA_DIRK_8_4_5; + +#ifndef DEFAULT_ERK_2 +/* DEPRECATED DEFAULT_ERK_2: use ARKSTEP_ERK_DEFAULT_2 */ +#define DEFAULT_ERK_2 ARKSTEP_ERK_DEFAULT_2 +#endif + +#ifndef DEFAULT_ERK_3 +/* DEPRECATED DEFAULT_ERK_3: use ARKSTEP_ERK_DEFAULT_3 */ +#define DEFAULT_ERK_3 ARKSTEP_ERK_DEFAULT_3 +#endif + +#ifndef DEFAULT_ERK_4 +/* DEPRECATED DEFAULT_ERK_4: use ARKSTEP_ERK_DEFAULT_4 */ +#define DEFAULT_ERK_4 ARKSTEP_ERK_DEFAULT_4 +#endif + +#ifndef DEFAULT_ERK_5 +/* DEPRECATED DEFAULT_ERK_5: use ARKSTEP_ERK_DEFAULT_5 */ +#define DEFAULT_ERK_5 ARKSTEP_ERK_DEFAULT_5 +#endif + +#ifndef DEFAULT_ERK_6 +/* DEPRECATED DEFAULT_ERK_6: use ARKSTEP_ERK_DEFAULT_6 */ +#define DEFAULT_ERK_6 ARKSTEP_ERK_DEFAULT_6 +#endif + +#ifndef DEFAULT_ERK_8 +/* DEPRECATED DEFAULT_ERK_8: use ARKSTEP_ERK_DEFAULT_8 */ +#define DEFAULT_ERK_8 ARKSTEP_ERK_DEFAULT_8 +#endif + +/* ImEx */ +/* DEPRECATED DEFAULT_ARK_ETABLE_3: use ARKSTEP_DEFAULT_ARK_ETABLE_3 */ +#define DEFAULT_ARK_ETABLE_3 ARKSTEP_DEFAULT_ARK_ETABLE_3 +/* DEPRECATED DEFAULT_ARK_ETABLE_4: use ARKSTEP_DEFAULT_ARK_ETABLE_4 */ +#define DEFAULT_ARK_ETABLE_4 ARKSTEP_DEFAULT_ARK_ETABLE_4 +/* DEPRECATED DEFAULT_ARK_ETABLE_5: use ARKSTEP_DEFAULT_ARK_ETABLE_4 */ +#define DEFAULT_ARK_ETABLE_5 ARKSTEP_DEFAULT_ARK_ETABLE_5 +/* DEPRECATED DEFAULT_ARK_ITABLE_3: use ARKSTEP_DEFAULT_ARK_ITABLE_3 */ +#define DEFAULT_ARK_ITABLE_3 ARKSTEP_DEFAULT_ARK_ITABLE_3 +/* DEPRECATED DEFAULT_ARK_ITABLE_4: use ARKSTEP_DEFAULT_ARK_ITABLE_4 */ +#define DEFAULT_ARK_ITABLE_4 ARKSTEP_DEFAULT_ARK_ITABLE_4 +/* DEPRECATED DEFAULT_ARK_ITABLE_5: use ARKSTEP_DEFAULT_ARK_ITABLE_5 */ +#define DEFAULT_ARK_ITABLE_5 ARKSTEP_DEFAULT_ARK_ITABLE_5 + +/* backwards-compatibility */ +typedef ARKStagePredictFn ARKStepStagePredictFn; + +/* ------------------- + * Exported Functions + * ------------------- */ + +/* Create, Resize, and Reinitialization functions */ +SUNDIALS_EXPORT void* ARKStepCreate(ARKRhsFn fe, ARKRhsFn fi, + realtype t0, N_Vector y0, + SUNContext sunctx); + +SUNDIALS_EXPORT int ARKStepResize(void *arkode_mem, N_Vector ynew, + realtype hscale, realtype t0, + ARKVecResizeFn resize, + void *resize_data); + +SUNDIALS_EXPORT int ARKStepReInit(void* arkode_mem, ARKRhsFn fe, + ARKRhsFn fi, realtype t0, N_Vector y0); + +SUNDIALS_EXPORT int ARKStepReset(void* arkode_mem, realtype tR, N_Vector yR); + +/* Tolerance input functions */ +SUNDIALS_EXPORT int ARKStepSStolerances(void *arkode_mem, + realtype reltol, + realtype abstol); +SUNDIALS_EXPORT int ARKStepSVtolerances(void *arkode_mem, + realtype reltol, + N_Vector abstol); +SUNDIALS_EXPORT int ARKStepWFtolerances(void *arkode_mem, + ARKEwtFn efun); + +/* Residual tolerance input functions */ +SUNDIALS_EXPORT int ARKStepResStolerance(void *arkode_mem, + realtype rabstol); +SUNDIALS_EXPORT int ARKStepResVtolerance(void *arkode_mem, + N_Vector rabstol); +SUNDIALS_EXPORT int ARKStepResFtolerance(void *arkode_mem, + ARKRwtFn rfun); + + +/* Linear solver set functions */ +SUNDIALS_EXPORT int ARKStepSetLinearSolver(void *arkode_mem, + SUNLinearSolver LS, + SUNMatrix A); +SUNDIALS_EXPORT int ARKStepSetMassLinearSolver(void *arkode_mem, + SUNLinearSolver LS, + SUNMatrix M, + booleantype time_dep); + +/* Rootfinding initialization */ +SUNDIALS_EXPORT int ARKStepRootInit(void *arkode_mem, int nrtfn, + ARKRootFn g); + +/* Optional input functions -- must be called AFTER ARKStepCreate */ +SUNDIALS_EXPORT int ARKStepSetDefaults(void* arkode_mem); +SUNDIALS_EXPORT int ARKStepSetOptimalParams(void *arkode_mem); +SUNDIALS_EXPORT int ARKStepSetOrder(void *arkode_mem, int maxord); +SUNDIALS_EXPORT int ARKStepSetInterpolantType(void *arkode_mem, int itype); +SUNDIALS_EXPORT int ARKStepSetInterpolantDegree(void *arkode_mem, int degree); +SUNDIALS_EXPORT int ARKStepSetDenseOrder(void *arkode_mem, int dord); +SUNDIALS_EXPORT int ARKStepSetNonlinearSolver(void *arkode_mem, + SUNNonlinearSolver NLS); +SUNDIALS_EXPORT int ARKStepSetNlsRhsFn(void *arkode_mem, ARKRhsFn nls_fi); +SUNDIALS_EXPORT int ARKStepSetLinear(void *arkode_mem, int timedepend); +SUNDIALS_EXPORT int ARKStepSetNonlinear(void *arkode_mem); +SUNDIALS_EXPORT int ARKStepSetExplicit(void *arkode_mem); +SUNDIALS_EXPORT int ARKStepSetImplicit(void *arkode_mem); +SUNDIALS_EXPORT int ARKStepSetImEx(void *arkode_mem); +SUNDIALS_EXPORT int ARKStepSetTables(void *arkode_mem, int q, int p, + ARKodeButcherTable Bi, + ARKodeButcherTable Be); +SUNDIALS_EXPORT int ARKStepSetTableNum(void *arkode_mem, + ARKODE_DIRKTableID itable, ARKODE_ERKTableID etable); +SUNDIALS_EXPORT int ARKStepSetCFLFraction(void *arkode_mem, + realtype cfl_frac); +SUNDIALS_EXPORT int ARKStepSetSafetyFactor(void *arkode_mem, + realtype safety); +SUNDIALS_EXPORT int ARKStepSetErrorBias(void *arkode_mem, + realtype bias); +SUNDIALS_EXPORT int ARKStepSetMaxGrowth(void *arkode_mem, + realtype mx_growth); +SUNDIALS_EXPORT int ARKStepSetMinReduction(void *arkode_mem, + realtype eta_min); +SUNDIALS_EXPORT int ARKStepSetFixedStepBounds(void *arkode_mem, + realtype lb, realtype ub); +SUNDIALS_EXPORT int ARKStepSetAdaptivityMethod(void *arkode_mem, + int imethod, + int idefault, int pq, + realtype adapt_params[3]); +SUNDIALS_EXPORT int ARKStepSetAdaptivityFn(void *arkode_mem, + ARKAdaptFn hfun, + void *h_data); +SUNDIALS_EXPORT int ARKStepSetMaxFirstGrowth(void *arkode_mem, + realtype etamx1); +SUNDIALS_EXPORT int ARKStepSetMaxEFailGrowth(void *arkode_mem, + realtype etamxf); +SUNDIALS_EXPORT int ARKStepSetSmallNumEFails(void *arkode_mem, + int small_nef); +SUNDIALS_EXPORT int ARKStepSetMaxCFailGrowth(void *arkode_mem, + realtype etacf); +SUNDIALS_EXPORT int ARKStepSetNonlinCRDown(void *arkode_mem, + realtype crdown); +SUNDIALS_EXPORT int ARKStepSetNonlinRDiv(void *arkode_mem, + realtype rdiv); +SUNDIALS_EXPORT int ARKStepSetDeltaGammaMax(void *arkode_mem, + realtype dgmax); +SUNDIALS_EXPORT int ARKStepSetLSetupFrequency(void *arkode_mem, + int msbp); +SUNDIALS_EXPORT int ARKStepSetPredictorMethod(void *arkode_mem, + int method); +SUNDIALS_EXPORT int ARKStepSetStabilityFn(void *arkode_mem, + ARKExpStabFn EStab, + void *estab_data); +SUNDIALS_EXPORT int ARKStepSetMaxErrTestFails(void *arkode_mem, + int maxnef); +SUNDIALS_EXPORT int ARKStepSetMaxNonlinIters(void *arkode_mem, + int maxcor); +SUNDIALS_EXPORT int ARKStepSetMaxConvFails(void *arkode_mem, + int maxncf); +SUNDIALS_EXPORT int ARKStepSetNonlinConvCoef(void *arkode_mem, + realtype nlscoef); +SUNDIALS_EXPORT int ARKStepSetConstraints(void *arkode_mem, + N_Vector constraints); +SUNDIALS_EXPORT int ARKStepSetMaxNumSteps(void *arkode_mem, + long int mxsteps); +SUNDIALS_EXPORT int ARKStepSetMaxHnilWarns(void *arkode_mem, + int mxhnil); +SUNDIALS_EXPORT int ARKStepSetInitStep(void *arkode_mem, + realtype hin); +SUNDIALS_EXPORT int ARKStepSetMinStep(void *arkode_mem, + realtype hmin); +SUNDIALS_EXPORT int ARKStepSetMaxStep(void *arkode_mem, + realtype hmax); +SUNDIALS_EXPORT int ARKStepSetStopTime(void *arkode_mem, + realtype tstop); +SUNDIALS_EXPORT int ARKStepSetFixedStep(void *arkode_mem, + realtype hfixed); +SUNDIALS_EXPORT int ARKStepSetMaxNumConstrFails(void *arkode_mem, + int maxfails); + +SUNDIALS_EXPORT int ARKStepSetRootDirection(void *arkode_mem, + int *rootdir); +SUNDIALS_EXPORT int ARKStepSetNoInactiveRootWarn(void *arkode_mem); + +SUNDIALS_EXPORT int ARKStepSetErrHandlerFn(void *arkode_mem, + ARKErrHandlerFn ehfun, + void *eh_data); +SUNDIALS_EXPORT int ARKStepSetErrFile(void *arkode_mem, + FILE *errfp); +SUNDIALS_EXPORT int ARKStepSetUserData(void *arkode_mem, + void *user_data); +SUNDIALS_EXPORT int ARKStepSetDiagnostics(void *arkode_mem, + FILE *diagfp); + +SUNDIALS_EXPORT int ARKStepSetPostprocessStepFn(void *arkode_mem, + ARKPostProcessFn ProcessStep); +SUNDIALS_EXPORT int ARKStepSetPostprocessStageFn(void *arkode_mem, + ARKPostProcessFn ProcessStage); +SUNDIALS_EXPORT int ARKStepSetStagePredictFn(void *arkode_mem, + ARKStagePredictFn PredictStage); + +/* Linear solver interface optional input functions -- must be called + AFTER ARKStepSetLinearSolver and/or ARKStepSetMassLinearSolver */ +SUNDIALS_EXPORT int ARKStepSetJacFn(void *arkode_mem, ARKLsJacFn jac); +SUNDIALS_EXPORT int ARKStepSetMassFn(void *arkode_mem, ARKLsMassFn mass); +SUNDIALS_EXPORT int ARKStepSetJacEvalFrequency(void *arkode_mem, + long int msbj); +SUNDIALS_EXPORT int ARKStepSetLinearSolutionScaling(void *arkode_mem, + booleantype onoff); +SUNDIALS_EXPORT int ARKStepSetEpsLin(void *arkode_mem, realtype eplifac); +SUNDIALS_EXPORT int ARKStepSetMassEpsLin(void *arkode_mem, realtype eplifac); +SUNDIALS_EXPORT int ARKStepSetLSNormFactor(void *arkode_mem, + realtype nrmfac); +SUNDIALS_EXPORT int ARKStepSetMassLSNormFactor(void *arkode_mem, + realtype nrmfac); +SUNDIALS_EXPORT int ARKStepSetPreconditioner(void *arkode_mem, + ARKLsPrecSetupFn psetup, + ARKLsPrecSolveFn psolve); +SUNDIALS_EXPORT int ARKStepSetMassPreconditioner(void *arkode_mem, + ARKLsMassPrecSetupFn psetup, + ARKLsMassPrecSolveFn psolve); +SUNDIALS_EXPORT int ARKStepSetJacTimes(void *arkode_mem, + ARKLsJacTimesSetupFn jtsetup, + ARKLsJacTimesVecFn jtimes); +SUNDIALS_EXPORT int ARKStepSetJacTimesRhsFn(void *arkode_mem, + ARKRhsFn jtimesRhsFn); +SUNDIALS_EXPORT int ARKStepSetMassTimes(void *arkode_mem, + ARKLsMassTimesSetupFn msetup, + ARKLsMassTimesVecFn mtimes, + void *mtimes_data); +SUNDIALS_EXPORT int ARKStepSetLinSysFn(void *arkode_mem, ARKLsLinSysFn linsys); + +/* Integrate the ODE over an interval in t */ +SUNDIALS_EXPORT int ARKStepEvolve(void *arkode_mem, realtype tout, + N_Vector yout, realtype *tret, + int itask); + +/* Computes the kth derivative of the y function at time t */ +SUNDIALS_EXPORT int ARKStepGetDky(void *arkode_mem, realtype t, + int k, N_Vector dky); + +/* Utility function to update/compute y based on zcor */ +SUNDIALS_EXPORT int ARKStepComputeState(void *arkode_mem, N_Vector zcor, + N_Vector z); + +/* Optional output functions */ +SUNDIALS_EXPORT int ARKStepGetNumExpSteps(void *arkode_mem, + long int *expsteps); +SUNDIALS_EXPORT int ARKStepGetNumAccSteps(void *arkode_mem, + long int *accsteps); +SUNDIALS_EXPORT int ARKStepGetNumStepAttempts(void *arkode_mem, + long int *step_attempts); +SUNDIALS_EXPORT int ARKStepGetNumRhsEvals(void *arkode_mem, + long int *nfe_evals, + long int *nfi_evals); +SUNDIALS_EXPORT int ARKStepGetNumLinSolvSetups(void *arkode_mem, + long int *nlinsetups); +SUNDIALS_EXPORT int ARKStepGetNumErrTestFails(void *arkode_mem, + long int *netfails); +SUNDIALS_EXPORT int ARKStepGetCurrentButcherTables(void *arkode_mem, + ARKodeButcherTable *Bi, + ARKodeButcherTable *Be); +SUNDIALS_EXPORT int ARKStepGetEstLocalErrors(void *arkode_mem, + N_Vector ele); +SUNDIALS_EXPORT int ARKStepGetWorkSpace(void *arkode_mem, + long int *lenrw, + long int *leniw); +SUNDIALS_EXPORT int ARKStepGetNumSteps(void *arkode_mem, + long int *nsteps); +SUNDIALS_EXPORT int ARKStepGetActualInitStep(void *arkode_mem, + realtype *hinused); +SUNDIALS_EXPORT int ARKStepGetLastStep(void *arkode_mem, + realtype *hlast); +SUNDIALS_EXPORT int ARKStepGetCurrentStep(void *arkode_mem, + realtype *hcur); +SUNDIALS_EXPORT int ARKStepGetCurrentTime(void *arkode_mem, + realtype *tcur); +SUNDIALS_EXPORT int ARKStepGetCurrentState(void *arkode_mem, + N_Vector *state); +SUNDIALS_EXPORT int ARKStepGetCurrentGamma(void *arkode_mem, + realtype *gamma); +SUNDIALS_EXPORT int ARKStepGetCurrentMassMatrix(void *arkode_mem, + SUNMatrix *M); +SUNDIALS_EXPORT int ARKStepGetTolScaleFactor(void *arkode_mem, + realtype *tolsfac); +SUNDIALS_EXPORT int ARKStepGetErrWeights(void *arkode_mem, + N_Vector eweight); +SUNDIALS_EXPORT int ARKStepGetResWeights(void *arkode_mem, + N_Vector rweight); +SUNDIALS_EXPORT int ARKStepGetNumGEvals(void *arkode_mem, + long int *ngevals); +SUNDIALS_EXPORT int ARKStepGetRootInfo(void *arkode_mem, + int *rootsfound); +SUNDIALS_EXPORT int ARKStepGetNumConstrFails(void *arkode_mem, + long int *nconstrfails); +SUNDIALS_EXPORT char *ARKStepGetReturnFlagName(long int flag); + +SUNDIALS_EXPORT int ARKStepWriteParameters(void *arkode_mem, FILE *fp); + +SUNDIALS_EXPORT int ARKStepWriteButcher(void *arkode_mem, FILE *fp); + + +/* Grouped optional output functions */ +SUNDIALS_EXPORT int ARKStepGetTimestepperStats(void *arkode_mem, + long int *expsteps, + long int *accsteps, + long int *step_attempts, + long int *nfe_evals, + long int *nfi_evals, + long int *nlinsetups, + long int *netfails); +SUNDIALS_EXPORT int ARKStepGetStepStats(void *arkode_mem, + long int *nsteps, + realtype *hinused, + realtype *hlast, + realtype *hcur, + realtype *tcur); + +/* Nonlinear solver optional output functions */ +SUNDIALS_EXPORT int ARKStepGetNonlinearSystemData(void *arkode_mem, + realtype *tcur, + N_Vector *zpred, + N_Vector *z, + N_Vector *Fi, + realtype *gamma, + N_Vector *sdata, + void **user_data); + +SUNDIALS_EXPORT int ARKStepGetNumNonlinSolvIters(void *arkode_mem, + long int *nniters); +SUNDIALS_EXPORT int ARKStepGetNumNonlinSolvConvFails(void *arkode_mem, + long int *nncfails); +SUNDIALS_EXPORT int ARKStepGetNonlinSolvStats(void *arkode_mem, + long int *nniters, + long int *nncfails); + +/* Linear solver optional output functions */ +SUNDIALS_EXPORT int ARKStepGetLinWorkSpace(void *arkode_mem, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int ARKStepGetNumJacEvals(void *arkode_mem, + long int *njevals); +SUNDIALS_EXPORT int ARKStepGetNumPrecEvals(void *arkode_mem, + long int *npevals); +SUNDIALS_EXPORT int ARKStepGetNumPrecSolves(void *arkode_mem, + long int *npsolves); +SUNDIALS_EXPORT int ARKStepGetNumLinIters(void *arkode_mem, + long int *nliters); +SUNDIALS_EXPORT int ARKStepGetNumLinConvFails(void *arkode_mem, + long int *nlcfails); +SUNDIALS_EXPORT int ARKStepGetNumJTSetupEvals(void *arkode_mem, + long int *njtsetups); +SUNDIALS_EXPORT int ARKStepGetNumJtimesEvals(void *arkode_mem, + long int *njvevals); +SUNDIALS_EXPORT int ARKStepGetNumLinRhsEvals(void *arkode_mem, + long int *nfevalsLS); +SUNDIALS_EXPORT int ARKStepGetLastLinFlag(void *arkode_mem, + long int *flag); + +SUNDIALS_EXPORT int ARKStepGetMassWorkSpace(void *arkode_mem, + long int *lenrwMLS, + long int *leniwMLS); +SUNDIALS_EXPORT int ARKStepGetNumMassSetups(void *arkode_mem, + long int *nmsetups); +SUNDIALS_EXPORT int ARKStepGetNumMassMultSetups(void *arkode_mem, + long int *nmvsetups); +SUNDIALS_EXPORT int ARKStepGetNumMassMult(void *arkode_mem, + long int *nmvevals); +SUNDIALS_EXPORT int ARKStepGetNumMassSolves(void *arkode_mem, + long int *nmsolves); +SUNDIALS_EXPORT int ARKStepGetNumMassPrecEvals(void *arkode_mem, + long int *nmpevals); +SUNDIALS_EXPORT int ARKStepGetNumMassPrecSolves(void *arkode_mem, + long int *nmpsolves); +SUNDIALS_EXPORT int ARKStepGetNumMassIters(void *arkode_mem, + long int *nmiters); +SUNDIALS_EXPORT int ARKStepGetNumMassConvFails(void *arkode_mem, + long int *nmcfails); +SUNDIALS_EXPORT int ARKStepGetNumMTSetups(void *arkode_mem, + long int *nmtsetups); +SUNDIALS_EXPORT int ARKStepGetLastMassFlag(void *arkode_mem, + long int *flag); + +SUNDIALS_EXPORT char *ARKStepGetLinReturnFlagName(long int flag); + + +/* Free function */ +SUNDIALS_EXPORT void ARKStepFree(void **arkode_mem); + +/* Output the ARKStep memory structure (useful when debugging) */ +SUNDIALS_EXPORT void ARKStepPrintMem(void* arkode_mem, FILE* outfile); + +/* MRIStep interface functions */ +SUNDIALS_EXPORT int ARKStepCreateMRIStepInnerStepper(void *arkode_mem, + MRIStepInnerStepper *stepper); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/include/arkode/arkode_bandpre.h b/lib/sundials_6.1.1/include/arkode/arkode_bandpre.h new file mode 100644 index 00000000000..501a48757b2 --- /dev/null +++ b/lib/sundials_6.1.1/include/arkode/arkode_bandpre.h @@ -0,0 +1,46 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the ARKBANDPRE module, which provides + * a banded difference quotient Jacobian-based preconditioner. + * -----------------------------------------------------------------*/ + +#ifndef _ARKBANDPRE_H +#define _ARKBANDPRE_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* BandPrec inititialization function */ + +SUNDIALS_EXPORT int ARKBandPrecInit(void *arkode_mem, sunindextype N, + sunindextype mu, sunindextype ml); + +/* Optional output functions */ + +SUNDIALS_EXPORT int ARKBandPrecGetWorkSpace(void *arkode_mem, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int ARKBandPrecGetNumRhsEvals(void *arkode_mem, + long int *nfevalsBP); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/include/arkode/arkode_bbdpre.h b/lib/sundials_6.1.1/include/arkode/arkode_bbdpre.h new file mode 100644 index 00000000000..7b2e6abdf10 --- /dev/null +++ b/lib/sundials_6.1.1/include/arkode/arkode_bbdpre.h @@ -0,0 +1,67 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the ARKBBDPRE module, for a + * band-block-diagonal preconditioner, i.e. a block-diagonal + * matrix with banded blocks. + * -----------------------------------------------------------------*/ + +#ifndef _ARKBBDPRE_H +#define _ARKBBDPRE_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* User-supplied function Types */ + +typedef int (*ARKLocalFn)(sunindextype Nlocal, realtype t, + N_Vector y, N_Vector g, void *user_data); + +typedef int (*ARKCommFn)(sunindextype Nlocal, realtype t, + N_Vector y, void *user_data); + +/* Exported Functions */ + +SUNDIALS_EXPORT int ARKBBDPrecInit(void *arkode_mem, + sunindextype Nlocal, + sunindextype mudq, + sunindextype mldq, + sunindextype mukeep, + sunindextype mlkeep, + realtype dqrely, + ARKLocalFn gloc, + ARKCommFn cfn); + +SUNDIALS_EXPORT int ARKBBDPrecReInit(void *arkode_mem, + sunindextype mudq, + sunindextype mldq, + realtype dqrely); + +/* Optional output functions */ + +SUNDIALS_EXPORT int ARKBBDPrecGetWorkSpace(void *arkode_mem, + long int *lenrwBBDP, + long int *leniwBBDP); + +SUNDIALS_EXPORT int ARKBBDPrecGetNumGfnEvals(void *arkode_mem, + long int *ngevalsBBDP); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/include/arkode/arkode_butcher.h b/lib/sundials_6.1.1/include/arkode/arkode_butcher.h new file mode 100644 index 00000000000..4a9469dbaf5 --- /dev/null +++ b/lib/sundials_6.1.1/include/arkode/arkode_butcher.h @@ -0,0 +1,75 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for ARKode Butcher table structures. + * -----------------------------------------------------------------*/ + +#ifndef _ARKODE_BUTCHER_H +#define _ARKODE_BUTCHER_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/*--------------------------------------------------------------- + Types : struct ARKodeButcherTableMem, ARKodeButcherTable + ---------------------------------------------------------------*/ +struct ARKodeButcherTableMem { + + int q; /* method order of accuracy */ + int p; /* embedding order of accuracy */ + int stages; /* number of stages */ + realtype **A; /* Butcher table coefficients */ + realtype *c; /* canopy node coefficients */ + realtype *b; /* root node coefficients */ + realtype *d; /* embedding coefficients */ + +}; + + +typedef _SUNDIALS_STRUCT_ ARKodeButcherTableMem *ARKodeButcherTable; + + +/* Utility routines to allocate/free/output Butcher table structures */ +SUNDIALS_EXPORT ARKodeButcherTable ARKodeButcherTable_Alloc(int stages, + booleantype embedded); +SUNDIALS_EXPORT ARKodeButcherTable ARKodeButcherTable_Create(int s, int q, + int p, + realtype *c, + realtype *A, + realtype *b, + realtype *d); +SUNDIALS_EXPORT ARKodeButcherTable ARKodeButcherTable_Copy(ARKodeButcherTable B); +SUNDIALS_EXPORT void ARKodeButcherTable_Space(ARKodeButcherTable B, + sunindextype *liw, + sunindextype *lrw); +SUNDIALS_EXPORT void ARKodeButcherTable_Free(ARKodeButcherTable B); +SUNDIALS_EXPORT void ARKodeButcherTable_Write(ARKodeButcherTable B, + FILE *outfile); + +SUNDIALS_EXPORT int ARKodeButcherTable_CheckOrder(ARKodeButcherTable B, int *q, + int *p, FILE *outfile); +SUNDIALS_EXPORT int ARKodeButcherTable_CheckARKOrder(ARKodeButcherTable B1, + ARKodeButcherTable B2, + int *q, int *p, + FILE *outfile); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/include/arkode/arkode_butcher_dirk.h b/lib/sundials_6.1.1/include/arkode/arkode_butcher_dirk.h new file mode 100644 index 00000000000..a57ab6d8401 --- /dev/null +++ b/lib/sundials_6.1.1/include/arkode/arkode_butcher_dirk.h @@ -0,0 +1,97 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for ARKode's built-in DIRK Butcher tables. + * -----------------------------------------------------------------*/ + +#ifndef _ARKODE_DIRK_TABLES_H +#define _ARKODE_DIRK_TABLES_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* Butcher table accessor IDs + ERK: 0 - 99 + DIRK: 100 - 199 + MRI: 200 - 299 */ + +/* DEPRECATED SDIRK_2_1_2: use ARKODE_SDIRK_2_1_2 */ +#define SDIRK_2_1_2 100 +/* DEPRECATED BILLINGTON_3_3_2: use ARKODE_BILLINGTON_3_3_2 */ +#define BILLINGTON_3_3_2 101 +/* DEPRECATED TRBDF2_3_3_2: use ARKODE_TRBDF2_3_3_2 */ +#define TRBDF2_3_3_2 102 +/* DEPRECATED KVAERNO_4_2_3: use ARKODE_KVAERNO_4_2_3 */ +#define KVAERNO_4_2_3 103 +/* DEPRECATED ARK324L2SA_DIRK_4_2_3: use ARKODE_ARK324L2SA_DIRK_4_2_3 */ +#define ARK324L2SA_DIRK_4_2_3 104 +/* DEPRECATED CASH_5_2_4: use ARKODE_CASH_5_2_4 */ +#define CASH_5_2_4 105 +/* DEPRECATED CASH_5_3_4: use ARKODE_CASH_5_3_4 */ +#define CASH_5_3_4 106 +/* DEPRECATED SDIRK_5_3_4: use ARKODE_SDIRK_5_3_4 */ +#define SDIRK_5_3_4 107 +/* DEPRECATED KVAERNO_5_3_4: use ARKODE_KVAERNO_5_3_4 */ +#define KVAERNO_5_3_4 108 +/* DEPRECATED ARK436L2SA_DIRK_6_3_4: use ARKODE_ARK436L2SA_DIRK_6_3_4 */ +#define ARK436L2SA_DIRK_6_3_4 109 +/* DEPRECATED KVAERNO_7_4_5: use ARKODE_KVAERNO_7_4_5 */ +#define KVAERNO_7_4_5 110 +/* DEPRECATED ARK548L2SA_DIRK_8_4_5: use ARKODE_ARK548L2SA_DIRK_8_4_5 */ +#define ARK548L2SA_DIRK_8_4_5 111 +/* DEPRECATED ARK437L2SA_DIRK_7_3_4: use ARKODE_ARK437L2SA_DIRK_7_3_4 */ +#define ARK437L2SA_DIRK_7_3_4 112 +/* DEPRECATED ARK548L2SAb_DIRK_8_4_5: use ARKODE_ARK548L2SAb_DIRK_8_4_5 */ +#define ARK548L2SAb_DIRK_8_4_5 113 + +/* Utility #defines to ensure valid input IDs for DIRK tables */ + +/* DEPRECATED MIN_DIRK_NUM: use ARKODE_MIN_DIRK_NUM */ +#define MIN_DIRK_NUM 100 + +/* DEPRECATED MAX_DIRK_NUM: use ARKODE_MAX_DIRK_NUM */ +#define MAX_DIRK_NUM 113 + +typedef enum { + ARKODE_DIRK_NONE = -1, /* ensure enum is signed int */ + ARKODE_MIN_DIRK_NUM = 100, + ARKODE_SDIRK_2_1_2 = ARKODE_MIN_DIRK_NUM, + ARKODE_BILLINGTON_3_3_2, + ARKODE_TRBDF2_3_3_2, + ARKODE_KVAERNO_4_2_3, + ARKODE_ARK324L2SA_DIRK_4_2_3, + ARKODE_CASH_5_2_4, + ARKODE_CASH_5_3_4, + ARKODE_SDIRK_5_3_4, + ARKODE_KVAERNO_5_3_4, + ARKODE_ARK436L2SA_DIRK_6_3_4, + ARKODE_KVAERNO_7_4_5, + ARKODE_ARK548L2SA_DIRK_8_4_5, + ARKODE_ARK437L2SA_DIRK_7_3_4, + ARKODE_ARK548L2SAb_DIRK_8_4_5, + ARKODE_MAX_DIRK_NUM = ARKODE_ARK548L2SAb_DIRK_8_4_5 +} ARKODE_DIRKTableID; + +/* Accessor routine to load built-in DIRK table */ +SUNDIALS_EXPORT ARKodeButcherTable ARKodeButcherTable_LoadDIRK(ARKODE_DIRKTableID imethod); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/include/arkode/arkode_butcher_erk.h b/lib/sundials_6.1.1/include/arkode/arkode_butcher_erk.h new file mode 100644 index 00000000000..1c31c9a3029 --- /dev/null +++ b/lib/sundials_6.1.1/include/arkode/arkode_butcher_erk.h @@ -0,0 +1,98 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for ARKode's built-in ERK Butcher tables. + * -----------------------------------------------------------------*/ + +#ifndef _ARKODE_ERK_TABLES_H +#define _ARKODE_ERK_TABLES_H + +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* Butcher table accessor IDs + ERK: 0 - 99 + DIRK: 100 - 199 + MRI: 200 - 299 */ + +/* DEPRECATED HEUN_EULER_2_1_2: use ARKODE_HEUN_EULER_2_1_2 */ +#define HEUN_EULER_2_1_2 0 +/* DEPRECATED BOGACKI_SHAMPINE_4_2_3: use ARKODE_BOGACKI_SHAMPINE_4_2_3 */ +#define BOGACKI_SHAMPINE_4_2_3 1 +/* DEPRECATED ARK324L2SA_ERK_4_2_3: use ARKODE_ARK324L2SA_ERK_4_2_3 */ +#define ARK324L2SA_ERK_4_2_3 2 +/* DEPRECATED ZONNEVELD_5_3_4: use ARKODE_ZONNEVELD_5_3_4 */ +#define ZONNEVELD_5_3_4 3 +/* DEPRECATED ARK436L2SA_ERK_6_3_4: use ARKODE_ARK436L2SA_ERK_6_3_4 */ +#define ARK436L2SA_ERK_6_3_4 4 +/* DEPRECATED SAYFY_ABURUB_6_3_4: use ARKODE_SAYFY_ABURUB_6_3_4 */ +#define SAYFY_ABURUB_6_3_4 5 +/* DEPRECATED CASH_KARP_6_4_5: use ARKODE_CASH_KARP_6_4_5 */ +#define CASH_KARP_6_4_5 6 +/* DEPRECATED FEHLBERG_6_4_5: use ARKODE_FEHLBERG_6_4_5 */ +#define FEHLBERG_6_4_5 7 +/* DEPRECATED DORMAND_PRINCE_7_4_5: use ARKODE_DORMAND_PRINCE_7_4_5 */ +#define DORMAND_PRINCE_7_4_5 8 +/* DEPRECATED ARK548L2SA_ERK_8_4_5: use ARKODE_ARK548L2SA_ERK_8_4_5 */ +#define ARK548L2SA_ERK_8_4_5 9 +/* DEPRECATED VERNER_8_5_6: use ARKODE_VERNER_8_5_6 */ +#define VERNER_8_5_6 10 +/* DEPRECATED FEHLBERG_13_7_8: use ARKODE_FEHLBERG_13_7_8 */ +#define FEHLBERG_13_7_8 11 +/* DEPRECATED KNOTH_WOLKE_3_3: use ARKODE_KNOTH_WOLKE_3_3 */ +#define KNOTH_WOLKE_3_3 12 +/* DEPRECATED ARK437L2SA_ERK_7_3_4: use ARKODE_ARK437L2SA_ERK_7_3_4 */ +#define ARK437L2SA_ERK_7_3_4 13 +/* DEPRECATED ARK548L2SAb_ERK_8_4_5: use ARKODE_ARK548L2SAb_ERK_8_4_5 */ +#define ARK548L2SAb_ERK_8_4_5 14 + +/* Utility #defines to ensure valid input IDs for ERK tables */ + +/* DEPRECATED MIN_ERK_NUM: use ARKODE_MIN_ERK_NUM */ +#define MIN_ERK_NUM 0 +/* DEPRECATED MAX_ERK_NUM: use ARKODE_MAX_ERK_NUM */ +#define MAX_ERK_NUM 14 + +typedef enum { + ARKODE_ERK_NONE = -1, /* ensure enum is signed int */ + ARKODE_MIN_ERK_NUM = 0, + ARKODE_HEUN_EULER_2_1_2 = ARKODE_MIN_ERK_NUM, + ARKODE_BOGACKI_SHAMPINE_4_2_3, + ARKODE_ARK324L2SA_ERK_4_2_3, + ARKODE_ZONNEVELD_5_3_4, + ARKODE_ARK436L2SA_ERK_6_3_4, + ARKODE_SAYFY_ABURUB_6_3_4, + ARKODE_CASH_KARP_6_4_5, + ARKODE_FEHLBERG_6_4_5, + ARKODE_DORMAND_PRINCE_7_4_5, + ARKODE_ARK548L2SA_ERK_8_4_5, + ARKODE_VERNER_8_5_6, + ARKODE_FEHLBERG_13_7_8, + ARKODE_KNOTH_WOLKE_3_3, + ARKODE_ARK437L2SA_ERK_7_3_4, + ARKODE_ARK548L2SAb_ERK_8_4_5, + ARKODE_MAX_ERK_NUM = ARKODE_ARK548L2SAb_ERK_8_4_5 +} ARKODE_ERKTableID; + +/* Accessor routine to load built-in ERK table */ +SUNDIALS_EXPORT ARKodeButcherTable ARKodeButcherTable_LoadERK(ARKODE_ERKTableID imethod); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/include/arkode/arkode_erkstep.h b/lib/sundials_6.1.1/include/arkode/arkode_erkstep.h new file mode 100644 index 00000000000..4aff73aba5a --- /dev/null +++ b/lib/sundials_6.1.1/include/arkode/arkode_erkstep.h @@ -0,0 +1,262 @@ +/* ----------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the ARKode ERKStep module. + * -----------------------------------------------------------------*/ + +#ifndef _ERKSTEP_H +#define _ERKSTEP_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ----------------- + * ERKStep Constants + * ----------------- */ + +/* Default Butcher tables for each order */ + +static const int ERKSTEP_DEFAULT_2 = ARKODE_HEUN_EULER_2_1_2; +static const int ERKSTEP_DEFAULT_3 = ARKODE_BOGACKI_SHAMPINE_4_2_3; +static const int ERKSTEP_DEFAULT_4 = ARKODE_ZONNEVELD_5_3_4; +static const int ERKSTEP_DEFAULT_5 = ARKODE_CASH_KARP_6_4_5; +static const int ERKSTEP_DEFAULT_6 = ARKODE_VERNER_8_5_6; +static const int ERKSTEP_DEFAULT_8 = ARKODE_FEHLBERG_13_7_8; + +#ifndef DEFAULT_ERK_2 +/* DEPRECATED DEFAULT_ERK_2: use ERKSTEP_DEFAULT_2 */ +#define DEFAULT_ERK_2 ERKSTEP_DEFAULT_2 +#endif + +#ifndef DEFAULT_ERK_3 +/* DEPRECATED DEFAULT_ERK_3: use ERKSTEP_DEFAULT_3 */ +#define DEFAULT_ERK_3 ERKSTEP_DEFAULT_3 +#endif + +#ifndef DEFAULT_ERK_4 +/* DEPRECATED DEFAULT_ERK_4: use ERKSTEP_DEFAULT_4 */ +#define DEFAULT_ERK_4 ERKSTEP_DEFAULT_4 +#endif + +#ifndef DEFAULT_ERK_5 +/* DEPRECATED DEFAULT_ERK_5: use ERKSTEP_DEFAULT_5 */ +#define DEFAULT_ERK_5 ERKSTEP_DEFAULT_5 +#endif + +#ifndef DEFAULT_ERK_6 +/* DEPRECATED DEFAULT_ERK_6: use ERKSTEP_DEFAULT_6 */ +#define DEFAULT_ERK_6 ERKSTEP_DEFAULT_6 +#endif + +#ifndef DEFAULT_ERK_8 +/* DEPRECATED DEFAULT_ERK_8: use ERKSTEP_DEFAULT_8 */ +#define DEFAULT_ERK_8 ERKSTEP_DEFAULT_8 +#endif + +/* ------------------- + * Exported Functions + * ------------------- */ + +/* Create, Resize, and Reinitialization functions */ +SUNDIALS_EXPORT void* ERKStepCreate(ARKRhsFn f, realtype t0, + N_Vector y0, SUNContext sunctx); + +SUNDIALS_EXPORT int ERKStepResize(void *arkode_mem, N_Vector ynew, + realtype hscale, realtype t0, + ARKVecResizeFn resize, + void *resize_data); + +SUNDIALS_EXPORT int ERKStepReInit(void* arkode_mem, ARKRhsFn f, + realtype t0, N_Vector y0); + +SUNDIALS_EXPORT int ERKStepReset(void* arkode_mem, realtype tR, + N_Vector yR); + +/* Tolerance input functions */ +SUNDIALS_EXPORT int ERKStepSStolerances(void *arkode_mem, + realtype reltol, + realtype abstol); +SUNDIALS_EXPORT int ERKStepSVtolerances(void *arkode_mem, + realtype reltol, + N_Vector abstol); +SUNDIALS_EXPORT int ERKStepWFtolerances(void *arkode_mem, + ARKEwtFn efun); + +/* Rootfinding initialization */ +SUNDIALS_EXPORT int ERKStepRootInit(void *arkode_mem, int nrtfn, + ARKRootFn g); + +/* Optional input functions -- must be called AFTER ERKStepCreate */ +SUNDIALS_EXPORT int ERKStepSetDefaults(void* arkode_mem); +SUNDIALS_EXPORT int ERKStepSetOrder(void *arkode_mem, int maxord); +SUNDIALS_EXPORT int ERKStepSetInterpolantType(void *arkode_mem, int itype); +SUNDIALS_EXPORT int ERKStepSetInterpolantDegree(void *arkode_mem, int degree); +SUNDIALS_EXPORT int ERKStepSetDenseOrder(void *arkode_mem, int dord); +SUNDIALS_EXPORT int ERKStepSetTable(void *arkode_mem, + ARKodeButcherTable B); +SUNDIALS_EXPORT int ERKStepSetTableNum(void *arkode_mem, ARKODE_ERKTableID itable); +SUNDIALS_EXPORT int ERKStepSetCFLFraction(void *arkode_mem, + realtype cfl_frac); +SUNDIALS_EXPORT int ERKStepSetSafetyFactor(void *arkode_mem, + realtype safety); +SUNDIALS_EXPORT int ERKStepSetErrorBias(void *arkode_mem, + realtype bias); +SUNDIALS_EXPORT int ERKStepSetMaxGrowth(void *arkode_mem, + realtype mx_growth); +SUNDIALS_EXPORT int ERKStepSetMinReduction(void *arkode_mem, + realtype eta_min); +SUNDIALS_EXPORT int ERKStepSetFixedStepBounds(void *arkode_mem, + realtype lb, realtype ub); +SUNDIALS_EXPORT int ERKStepSetAdaptivityMethod(void *arkode_mem, + int imethod, + int idefault, int pq, + realtype adapt_params[3]); +SUNDIALS_EXPORT int ERKStepSetAdaptivityFn(void *arkode_mem, + ARKAdaptFn hfun, + void *h_data); +SUNDIALS_EXPORT int ERKStepSetMaxFirstGrowth(void *arkode_mem, + realtype etamx1); +SUNDIALS_EXPORT int ERKStepSetMaxEFailGrowth(void *arkode_mem, + realtype etamxf); +SUNDIALS_EXPORT int ERKStepSetSmallNumEFails(void *arkode_mem, + int small_nef); +SUNDIALS_EXPORT int ERKStepSetStabilityFn(void *arkode_mem, + ARKExpStabFn EStab, + void *estab_data); +SUNDIALS_EXPORT int ERKStepSetMaxErrTestFails(void *arkode_mem, + int maxnef); +SUNDIALS_EXPORT int ERKStepSetConstraints(void *arkode_mem, + N_Vector constraints); +SUNDIALS_EXPORT int ERKStepSetMaxNumSteps(void *arkode_mem, + long int mxsteps); +SUNDIALS_EXPORT int ERKStepSetMaxHnilWarns(void *arkode_mem, + int mxhnil); +SUNDIALS_EXPORT int ERKStepSetInitStep(void *arkode_mem, + realtype hin); +SUNDIALS_EXPORT int ERKStepSetMinStep(void *arkode_mem, + realtype hmin); +SUNDIALS_EXPORT int ERKStepSetMaxStep(void *arkode_mem, + realtype hmax); +SUNDIALS_EXPORT int ERKStepSetStopTime(void *arkode_mem, + realtype tstop); +SUNDIALS_EXPORT int ERKStepSetFixedStep(void *arkode_mem, + realtype hfixed); +SUNDIALS_EXPORT int ERKStepSetMaxNumConstrFails(void *arkode_mem, + int maxfails); + +SUNDIALS_EXPORT int ERKStepSetRootDirection(void *arkode_mem, + int *rootdir); +SUNDIALS_EXPORT int ERKStepSetNoInactiveRootWarn(void *arkode_mem); + +SUNDIALS_EXPORT int ERKStepSetErrHandlerFn(void *arkode_mem, + ARKErrHandlerFn ehfun, + void *eh_data); +SUNDIALS_EXPORT int ERKStepSetErrFile(void *arkode_mem, + FILE *errfp); +SUNDIALS_EXPORT int ERKStepSetUserData(void *arkode_mem, + void *user_data); +SUNDIALS_EXPORT int ERKStepSetDiagnostics(void *arkode_mem, + FILE *diagfp); + +SUNDIALS_EXPORT int ERKStepSetPostprocessStepFn(void *arkode_mem, + ARKPostProcessFn ProcessStep); +SUNDIALS_EXPORT int ERKStepSetPostprocessStageFn(void *arkode_mem, + ARKPostProcessFn ProcessStage); + + +/* Integrate the ODE over an interval in t */ +SUNDIALS_EXPORT int ERKStepEvolve(void *arkode_mem, realtype tout, + N_Vector yout, realtype *tret, + int itask); + +/* Computes the kth derivative of the y function at time t */ +SUNDIALS_EXPORT int ERKStepGetDky(void *arkode_mem, realtype t, + int k, N_Vector dky); + +/* Optional output functions */ +SUNDIALS_EXPORT int ERKStepGetNumExpSteps(void *arkode_mem, + long int *expsteps); +SUNDIALS_EXPORT int ERKStepGetNumAccSteps(void *arkode_mem, + long int *accsteps); +SUNDIALS_EXPORT int ERKStepGetNumStepAttempts(void *arkode_mem, + long int *step_attempts); +SUNDIALS_EXPORT int ERKStepGetNumRhsEvals(void *arkode_mem, + long int *nfevals); +SUNDIALS_EXPORT int ERKStepGetNumErrTestFails(void *arkode_mem, + long int *netfails); +SUNDIALS_EXPORT int ERKStepGetCurrentButcherTable(void *arkode_mem, + ARKodeButcherTable *B); +SUNDIALS_EXPORT int ERKStepGetEstLocalErrors(void *arkode_mem, + N_Vector ele); +SUNDIALS_EXPORT int ERKStepGetWorkSpace(void *arkode_mem, + long int *lenrw, + long int *leniw); +SUNDIALS_EXPORT int ERKStepGetNumSteps(void *arkode_mem, + long int *nsteps); +SUNDIALS_EXPORT int ERKStepGetActualInitStep(void *arkode_mem, + realtype *hinused); +SUNDIALS_EXPORT int ERKStepGetLastStep(void *arkode_mem, + realtype *hlast); +SUNDIALS_EXPORT int ERKStepGetCurrentStep(void *arkode_mem, + realtype *hcur); +SUNDIALS_EXPORT int ERKStepGetCurrentTime(void *arkode_mem, + realtype *tcur); +SUNDIALS_EXPORT int ERKStepGetTolScaleFactor(void *arkode_mem, + realtype *tolsfac); +SUNDIALS_EXPORT int ERKStepGetErrWeights(void *arkode_mem, + N_Vector eweight); +SUNDIALS_EXPORT int ERKStepGetNumGEvals(void *arkode_mem, + long int *ngevals); +SUNDIALS_EXPORT int ERKStepGetRootInfo(void *arkode_mem, + int *rootsfound); +SUNDIALS_EXPORT int ERKStepGetNumConstrFails(void *arkode_mem, + long int *nconstrfails); +SUNDIALS_EXPORT char *ERKStepGetReturnFlagName(long int flag); + +SUNDIALS_EXPORT int ERKStepWriteParameters(void *arkode_mem, FILE *fp); + +SUNDIALS_EXPORT int ERKStepWriteButcher(void *arkode_mem, FILE *fp); + + +/* Grouped optional output functions */ +SUNDIALS_EXPORT int ERKStepGetTimestepperStats(void *arkode_mem, + long int *expsteps, + long int *accsteps, + long int *step_attempts, + long int *nfevals, + long int *netfails); +SUNDIALS_EXPORT int ERKStepGetStepStats(void *arkode_mem, + long int *nsteps, + realtype *hinused, + realtype *hlast, + realtype *hcur, + realtype *tcur); + + +/* Free function */ +SUNDIALS_EXPORT void ERKStepFree(void **arkode_mem); + +/* Output the ERKStep memory structure (useful when debugging) */ +SUNDIALS_EXPORT void ERKStepPrintMem(void* arkode_mem, FILE* outfile); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/include/arkode/arkode_ls.h b/lib/sundials_6.1.1/include/arkode/arkode_ls.h new file mode 100644 index 00000000000..75db992dd1d --- /dev/null +++ b/lib/sundials_6.1.1/include/arkode/arkode_ls.h @@ -0,0 +1,102 @@ +/* ---------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * ---------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ---------------------------------------------------------------- + * This is the header file for ARKode's linear solver interface. + * ----------------------------------------------------------------*/ + +#ifndef _ARKLS_H +#define _ARKLS_H + +#include +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/*================================================================= + ARKLS Constants + =================================================================*/ + +#define ARKLS_SUCCESS 0 +#define ARKLS_MEM_NULL -1 +#define ARKLS_LMEM_NULL -2 +#define ARKLS_ILL_INPUT -3 +#define ARKLS_MEM_FAIL -4 +#define ARKLS_PMEM_NULL -5 +#define ARKLS_MASSMEM_NULL -6 +#define ARKLS_JACFUNC_UNRECVR -7 +#define ARKLS_JACFUNC_RECVR -8 +#define ARKLS_MASSFUNC_UNRECVR -9 +#define ARKLS_MASSFUNC_RECVR -10 +#define ARKLS_SUNMAT_FAIL -11 +#define ARKLS_SUNLS_FAIL -12 + + +/*================================================================= + ARKLS user-supplied function prototypes + =================================================================*/ + +typedef int (*ARKLsJacFn)(realtype t, N_Vector y, N_Vector fy, + SUNMatrix Jac, void *user_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +typedef int (*ARKLsMassFn)(realtype t, SUNMatrix M, void *user_data, + N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); + +typedef int (*ARKLsPrecSetupFn)(realtype t, N_Vector y, + N_Vector fy, booleantype jok, + booleantype *jcurPtr, + realtype gamma, void *user_data); + +typedef int (*ARKLsPrecSolveFn)(realtype t, N_Vector y, + N_Vector fy, N_Vector r, + N_Vector z, realtype gamma, + realtype delta, int lr, + void *user_data); + +typedef int (*ARKLsJacTimesSetupFn)(realtype t, N_Vector y, + N_Vector fy, void *user_data); + +typedef int (*ARKLsJacTimesVecFn)(N_Vector v, N_Vector Jv, + realtype t, N_Vector y, + N_Vector fy, void *user_data, + N_Vector tmp); + +typedef int (*ARKLsLinSysFn)(realtype t, N_Vector y, N_Vector fy, SUNMatrix A, + SUNMatrix M, booleantype jok, booleantype *jcur, + realtype gamma, void *user_data, N_Vector tmp1, + N_Vector tmp2, N_Vector tmp3); + +typedef int (*ARKLsMassTimesSetupFn)(realtype t, void *mtimes_data); + + +typedef int (*ARKLsMassTimesVecFn)(N_Vector v, N_Vector Mv, + realtype t, void *mtimes_data); + +typedef int (*ARKLsMassPrecSetupFn)(realtype t, void *user_data); + +typedef int (*ARKLsMassPrecSolveFn)(realtype t, N_Vector r, + N_Vector z, realtype delta, + int lr, void *user_data); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/include/arkode/arkode_mristep.h b/lib/sundials_6.1.1/include/arkode/arkode_mristep.h new file mode 100644 index 00000000000..0d825e38647 --- /dev/null +++ b/lib/sundials_6.1.1/include/arkode/arkode_mristep.h @@ -0,0 +1,430 @@ +/* ----------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------- + * This is the header file for the ARKode MRIStep module. + * -----------------------------------------------------------------*/ + +#ifndef _MRISTEP_H +#define _MRISTEP_H + +#include +#include +#include +#include +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/* ----------------- + * MRIStep Constants + * ----------------- */ + +/* MRIStep method types */ +typedef enum { + MRISTEP_EXPLICIT, + MRISTEP_IMPLICIT, + MRISTEP_IMEX +} MRISTEP_METHOD_TYPE; + + +/* MRI coupling table table accessor IDs: + ERK: 0 - 99 + DIRK: 100 - 199 + MRI: 200 - 299 */ + +/* DEPRECATED MIS_KW3: use ARKODE_MIS_KW3 */ +#define MIS_KW3 200 +/* DEPRECATED MRI_GARK_ERK33a: use ARKODE_MRI_GARK_ERK33a */ +#define MRI_GARK_ERK33a 201 +/* DEPRECATED MRI_GARK_ERK45a: use ARKODE_MRI_GARK_ERK45a */ +#define MRI_GARK_ERK45a 202 +/* DEPRECATED MRI_GARK_IRK21a: use ARKODE_MRI_GARK_IRK21a */ +#define MRI_GARK_IRK21a 203 +/* DEPRECATED MRI_GARK_ESDIRK34a: use ARKODE_MRI_GARK_ESDIRK34a */ +#define MRI_GARK_ESDIRK34a 204 +/* DEPRECATED MRI_GARK_ESDIRK46a: use ARKODE_MRI_GARK_ESDIRK46a */ +#define MRI_GARK_ESDIRK46a 205 +/* DEPRECATED IMEX_MRI_GARK3a: use ARKODE_IMEX_MRI_GARK3a */ +#define IMEX_MRI_GARK3a 206 +/* DEPRECATED IMEX_MRI_GARK3b: use ARKODE_IMEX_MRI_GARK3b */ +#define IMEX_MRI_GARK3b 207 +/* DEPRECATED IMEX_MRI_GARK4: use ARKODE_IMEX_MRI_GARK4 */ +#define IMEX_MRI_GARK4 208 + +/* Utility #defines to ensure valid input IDs for MRI tables */ + +/* DEPRECATED MIN_MRI_NUM: use ARKODE_MIN_MRI_NUM */ +#define MIN_MRI_NUM 200 +/* DEPRECATED MAX_MRI_NUM: use ARKODE_MAX_MRI_NUM */ +#define MAX_MRI_NUM 208 + +typedef enum { + ARKODE_MRI_NONE = -1, /* ensure enum is signed int */ + ARKODE_MIN_MRI_NUM = 200, + ARKODE_MIS_KW3 = ARKODE_MIN_MRI_NUM, + ARKODE_MRI_GARK_ERK33a, + ARKODE_MRI_GARK_ERK45a, + ARKODE_MRI_GARK_IRK21a, + ARKODE_MRI_GARK_ESDIRK34a, + ARKODE_MRI_GARK_ESDIRK46a, + ARKODE_IMEX_MRI_GARK3a, + ARKODE_IMEX_MRI_GARK3b, + ARKODE_IMEX_MRI_GARK4, + ARKODE_MAX_MRI_NUM = ARKODE_IMEX_MRI_GARK4 +} ARKODE_MRITableID; + + +/* Default MRI coupling tables for each order */ + +static const int MRISTEP_DEFAULT_3 = ARKODE_MIS_KW3; +static const int MRISTEP_DEFAULT_EXPL_3 = ARKODE_MIS_KW3; +static const int MRISTEP_DEFAULT_EXPL_4 = ARKODE_MRI_GARK_ERK45a; +static const int MRISTEP_DEFAULT_IMPL_SD_2 = ARKODE_MRI_GARK_IRK21a; +static const int MRISTEP_DEFAULT_IMPL_SD_3 = ARKODE_MRI_GARK_ESDIRK34a; +static const int MRISTEP_DEFAULT_IMPL_SD_4 = ARKODE_MRI_GARK_ESDIRK46a; +static const int MRISTEP_DEFAULT_IMEX_SD_3 = ARKODE_IMEX_MRI_GARK3b; +static const int MRISTEP_DEFAULT_IMEX_SD_4 = ARKODE_IMEX_MRI_GARK4; + +/* DEPRECATED DEFAULT_MRI_TABLE_3: use MRISTEP_DEFAULT_3 */ +#define DEFAULT_MRI_TABLE_3 MRISTEP_DEFAULT_3 /* backwards-compatibility */ +/* DEPRECATED DEFAULT_EXPL_MRI_TABLE_3: use MRISTEP_DEFAULT_EXPL_3 */ +#define DEFAULT_EXPL_MRI_TABLE_3 MRISTEP_DEFAULT_EXPL_3 +/* DEPRECATED DEFAULT_EXPL_MRI_TABLE_4: use MRISTEP_DEFAULT_EXPL_4 */ +#define DEFAULT_EXPL_MRI_TABLE_4 MRISTEP_DEFAULT_EXPL_4 +/* DEPRECATED DEFAULT_IMPL_SD_TABLE_2: use MRISTEP_DEFAULT_IMPL_SD_2 */ +#define DEFAULT_IMPL_SD_MRI_TABLE_2 MRISTEP_DEFAULT_IMPL_SD_2 +/* DEPRECATED DEFAULT_IMPL_SD_TABLE_3: use MRISTEP_DEFAULT_IMPL_SD_3 */ +#define DEFAULT_IMPL_SD_MRI_TABLE_3 MRISTEP_DEFAULT_IMPL_SD_3 +/* DEPRECATED DEFAULT_IMPL_SD_TABLE_4: use MRISTEP_DEFAULT_IMPL_SD_4 */ +#define DEFAULT_IMPL_SD_MRI_TABLE_4 MRISTEP_DEFAULT_IMPL_SD_4 +/* DEPRECATED DEFAULT_IMEX_SD_TABLE_3: use MRISTEP_DEFAULT_IMEX_SD_3 */ +#define DEFAULT_IMEX_SD_MRI_TABLE_3 MRISTEP_DEFAULT_IMEX_SD_3 +/* DEPRECATED DEFAULT_IMEX_SD_TABLE_4: use MRISTEP_DEFAULT_IMEX_SD_4 */ +#define DEFAULT_IMEX_SD_MRI_TABLE_4 MRISTEP_DEFAULT_IMEX_SD_4 + +/* ------------------------------------ + * MRIStep Inner Stepper Function Types + * ------------------------------------ */ + +typedef int (*MRIStepInnerEvolveFn)(MRIStepInnerStepper stepper, + realtype t0, realtype tout, N_Vector y); + +typedef int (*MRIStepInnerFullRhsFn)(MRIStepInnerStepper stepper, + realtype t, N_Vector y, N_Vector f, + int mode); + +typedef int (*MRIStepInnerResetFn)(MRIStepInnerStepper stepper, + realtype tR, N_Vector yR); + +/*--------------------------------------------------------------- + MRI coupling data structure and associated utility routines + ---------------------------------------------------------------*/ +struct MRIStepCouplingMem +{ + int nmat; /* number of MRI coupling matrices */ + int stages; /* size of coupling matrices (stages * stages) */ + int q; /* method order of accuracy */ + int p; /* embedding order of accuracy */ + realtype *c; /* stage abscissae */ + realtype ***W; /* explicit coupling matrices [nmat][stages][stages] */ + realtype ***G; /* implicit coupling matrices [nmat][stages][stages] */ +}; + +typedef _SUNDIALS_STRUCT_ MRIStepCouplingMem *MRIStepCoupling; + +/* Accessor routine to load built-in MRI table */ +SUNDIALS_EXPORT MRIStepCoupling MRIStepCoupling_LoadTable(ARKODE_MRITableID imethod); + +/* Utility routines to allocate/free/output coupling table structures */ +SUNDIALS_EXPORT MRIStepCoupling MRIStepCoupling_Alloc(int nmat, int stages, + MRISTEP_METHOD_TYPE type); +SUNDIALS_EXPORT MRIStepCoupling MRIStepCoupling_Create(int nmat, + int stages, + int q, + int p, + realtype *W, + realtype *G, + realtype *c); +SUNDIALS_EXPORT MRIStepCoupling MRIStepCoupling_MIStoMRI(ARKodeButcherTable B, + int q, int p); +SUNDIALS_EXPORT MRIStepCoupling MRIStepCoupling_Copy(MRIStepCoupling MRIC); +SUNDIALS_EXPORT void MRIStepCoupling_Space(MRIStepCoupling MRIC, + sunindextype *liw, + sunindextype *lrw); +SUNDIALS_EXPORT void MRIStepCoupling_Free(MRIStepCoupling MRIC); +SUNDIALS_EXPORT void MRIStepCoupling_Write(MRIStepCoupling MRIC, + FILE *outfile); + + +/* ------------------------------ + * User-Supplied Function Types + * ------------------------------ */ + +typedef int (*MRIStepPreInnerFn)(realtype t, N_Vector *f, int nvecs, + void *user_data); + +typedef int (*MRIStepPostInnerFn)(realtype t, N_Vector y, void *user_data); + +/* ------------------- + * Exported Functions + * ------------------- */ + +/* Create, Resize, and Reinitialization functions */ +SUNDIALS_EXPORT void* MRIStepCreate(ARKRhsFn fse, ARKRhsFn fsi, realtype t0, + N_Vector y0, MRIStepInnerStepper stepper, + SUNContext sunctx); + +SUNDIALS_EXPORT int MRIStepResize(void *arkode_mem, N_Vector ynew, + realtype t0, ARKVecResizeFn resize, + void *resize_data); + +SUNDIALS_EXPORT int MRIStepReInit(void* arkode_mem, ARKRhsFn fse, ARKRhsFn fsi, + realtype t0, N_Vector y0); + +SUNDIALS_EXPORT int MRIStepReset(void* arkode_mem, realtype tR, N_Vector yR); + +/* Tolerance input functions */ +SUNDIALS_EXPORT int MRIStepSStolerances(void *arkode_mem, + realtype reltol, + realtype abstol); +SUNDIALS_EXPORT int MRIStepSVtolerances(void *arkode_mem, + realtype reltol, + N_Vector abstol); +SUNDIALS_EXPORT int MRIStepWFtolerances(void *arkode_mem, + ARKEwtFn efun); + +/* Linear solver set function */ +SUNDIALS_EXPORT int MRIStepSetLinearSolver(void *arkode_mem, + SUNLinearSolver LS, + SUNMatrix A); + +/* Rootfinding initialization */ +SUNDIALS_EXPORT int MRIStepRootInit(void *arkode_mem, int nrtfn, + ARKRootFn g); + +/* Optional input functions -- must be called AFTER MRIStepCreate */ +SUNDIALS_EXPORT int MRIStepSetDefaults(void* arkode_mem); +SUNDIALS_EXPORT int MRIStepSetInterpolantType(void *arkode_mem, int itype); +SUNDIALS_EXPORT int MRIStepSetInterpolantDegree(void *arkode_mem, int degree); +SUNDIALS_EXPORT int MRIStepSetDenseOrder(void *arkode_mem, int dord); +SUNDIALS_EXPORT int MRIStepSetNonlinearSolver(void *arkode_mem, + SUNNonlinearSolver NLS); +SUNDIALS_EXPORT int MRIStepSetNlsRhsFn(void *arkode_mem, ARKRhsFn nls_fs); +SUNDIALS_EXPORT int MRIStepSetLinear(void *arkode_mem, int timedepend); +SUNDIALS_EXPORT int MRIStepSetNonlinear(void *arkode_mem); +SUNDIALS_EXPORT int MRIStepSetCoupling(void *arkode_mem, + MRIStepCoupling MRIC); +SUNDIALS_EXPORT int MRIStepSetMaxNumSteps(void *arkode_mem, + long int mxsteps); +SUNDIALS_EXPORT int MRIStepSetNonlinCRDown(void *arkode_mem, + realtype crdown); +SUNDIALS_EXPORT int MRIStepSetNonlinRDiv(void *arkode_mem, + realtype rdiv); +SUNDIALS_EXPORT int MRIStepSetDeltaGammaMax(void *arkode_mem, + realtype dgmax); +SUNDIALS_EXPORT int MRIStepSetLSetupFrequency(void *arkode_mem, + int msbp); +SUNDIALS_EXPORT int MRIStepSetPredictorMethod(void *arkode_mem, + int method); +SUNDIALS_EXPORT int MRIStepSetMaxNonlinIters(void *arkode_mem, + int maxcor); +SUNDIALS_EXPORT int MRIStepSetNonlinConvCoef(void *arkode_mem, + realtype nlscoef); +SUNDIALS_EXPORT int MRIStepSetMaxHnilWarns(void *arkode_mem, + int mxhnil); +SUNDIALS_EXPORT int MRIStepSetStopTime(void *arkode_mem, + realtype tstop); +SUNDIALS_EXPORT int MRIStepSetFixedStep(void *arkode_mem, + realtype hsfixed); +SUNDIALS_EXPORT int MRIStepSetRootDirection(void *arkode_mem, + int *rootdir); +SUNDIALS_EXPORT int MRIStepSetNoInactiveRootWarn(void *arkode_mem); +SUNDIALS_EXPORT int MRIStepSetErrHandlerFn(void *arkode_mem, + ARKErrHandlerFn ehfun, + void *eh_data); +SUNDIALS_EXPORT int MRIStepSetErrFile(void *arkode_mem, + FILE *errfp); +SUNDIALS_EXPORT int MRIStepSetUserData(void *arkode_mem, + void *user_data); +SUNDIALS_EXPORT int MRIStepSetDiagnostics(void *arkode_mem, + FILE *diagfp); +SUNDIALS_EXPORT int MRIStepSetPostprocessStepFn(void *arkode_mem, + ARKPostProcessFn ProcessStep); +SUNDIALS_EXPORT int MRIStepSetPostprocessStageFn(void *arkode_mem, + ARKPostProcessFn ProcessStage); +SUNDIALS_EXPORT int MRIStepSetPreInnerFn(void *arkode_mem, + MRIStepPreInnerFn prefn); +SUNDIALS_EXPORT int MRIStepSetPostInnerFn(void *arkode_mem, + MRIStepPostInnerFn postfn); +SUNDIALS_EXPORT int MRIStepSetStagePredictFn(void *arkode_mem, + ARKStagePredictFn PredictStage); + +/* Linear solver interface optional input functions -- must be called + AFTER MRIStepSetLinearSolver */ +SUNDIALS_EXPORT int MRIStepSetJacFn(void *arkode_mem, ARKLsJacFn jac); +SUNDIALS_EXPORT int MRIStepSetJacEvalFrequency(void *arkode_mem, + long int msbj); +SUNDIALS_EXPORT int MRIStepSetLinearSolutionScaling(void *arkode_mem, + booleantype onoff); +SUNDIALS_EXPORT int MRIStepSetEpsLin(void *arkode_mem, realtype eplifac); +SUNDIALS_EXPORT int MRIStepSetLSNormFactor(void *arkode_mem, + realtype nrmfac); +SUNDIALS_EXPORT int MRIStepSetPreconditioner(void *arkode_mem, + ARKLsPrecSetupFn psetup, + ARKLsPrecSolveFn psolve); +SUNDIALS_EXPORT int MRIStepSetJacTimes(void *arkode_mem, + ARKLsJacTimesSetupFn jtsetup, + ARKLsJacTimesVecFn jtimes); +SUNDIALS_EXPORT int MRIStepSetJacTimesRhsFn(void *arkode_mem, + ARKRhsFn jtimesRhsFn); +SUNDIALS_EXPORT int MRIStepSetLinSysFn(void *arkode_mem, ARKLsLinSysFn linsys); + +/* Integrate the ODE over an interval in t */ +SUNDIALS_EXPORT int MRIStepEvolve(void *arkode_mem, realtype tout, + N_Vector yout, realtype *tret, + int itask); + +/* Computes the kth derivative of the y function at time t */ +SUNDIALS_EXPORT int MRIStepGetDky(void *arkode_mem, realtype t, + int k, N_Vector dky); + +/* Utility function to update/compute y based on zcor */ +SUNDIALS_EXPORT int MRIStepComputeState(void *arkode_mem, N_Vector zcor, + N_Vector z); + +/* Optional output functions */ +SUNDIALS_EXPORT int MRIStepGetNumRhsEvals(void *arkode_mem, + long int *nfse_evals, + long int *nfsi_evals); +SUNDIALS_EXPORT int MRIStepGetNumLinSolvSetups(void *arkode_mem, + long int *nlinsetups); +SUNDIALS_EXPORT int MRIStepGetCurrentCoupling(void *arkode_mem, + MRIStepCoupling *MRIC); +SUNDIALS_EXPORT int MRIStepGetWorkSpace(void *arkode_mem, + long int *lenrw, + long int *leniw); +SUNDIALS_EXPORT int MRIStepGetNumSteps(void *arkode_mem, + long int *nssteps); +SUNDIALS_EXPORT int MRIStepGetLastStep(void *arkode_mem, + realtype *hlast); +SUNDIALS_EXPORT int MRIStepGetCurrentTime(void *arkode_mem, + realtype *tcur); +SUNDIALS_EXPORT int MRIStepGetCurrentState(void *arkode_mem, + N_Vector *state); +SUNDIALS_EXPORT int MRIStepGetCurrentGamma(void *arkode_mem, + realtype *gamma); +SUNDIALS_EXPORT int MRIStepGetTolScaleFactor(void *arkode_mem, + realtype *tolsfac); +SUNDIALS_EXPORT int MRIStepGetErrWeights(void *arkode_mem, + N_Vector eweight); +SUNDIALS_EXPORT int MRIStepGetNumGEvals(void *arkode_mem, + long int *ngevals); +SUNDIALS_EXPORT int MRIStepGetRootInfo(void *arkode_mem, + int *rootsfound); +SUNDIALS_EXPORT int MRIStepGetLastInnerStepFlag(void *arkode_mem, int *flag); + +SUNDIALS_EXPORT char *MRIStepGetReturnFlagName(long int flag); + +SUNDIALS_EXPORT int MRIStepWriteParameters(void *arkode_mem, FILE *fp); + +SUNDIALS_EXPORT int MRIStepWriteCoupling(void *arkode_mem, FILE *fp); + +/* Nonlinear solver optional output functions */ +SUNDIALS_EXPORT int MRIStepGetNonlinearSystemData(void *arkode_mem, + realtype *tcur, + N_Vector *zpred, + N_Vector *z, + N_Vector *F, + realtype *gamma, + N_Vector *sdata, + void **user_data); +SUNDIALS_EXPORT int MRIStepGetNumNonlinSolvIters(void *arkode_mem, + long int *nniters); +SUNDIALS_EXPORT int MRIStepGetNumNonlinSolvConvFails(void *arkode_mem, + long int *nncfails); +SUNDIALS_EXPORT int MRIStepGetNonlinSolvStats(void *arkode_mem, + long int *nniters, + long int *nncfails); + +/* Linear solver optional output functions */ +SUNDIALS_EXPORT int MRIStepGetLinWorkSpace(void *arkode_mem, + long int *lenrwLS, + long int *leniwLS); +SUNDIALS_EXPORT int MRIStepGetNumJacEvals(void *arkode_mem, + long int *njevals); +SUNDIALS_EXPORT int MRIStepGetNumPrecEvals(void *arkode_mem, + long int *npevals); +SUNDIALS_EXPORT int MRIStepGetNumPrecSolves(void *arkode_mem, + long int *npsolves); +SUNDIALS_EXPORT int MRIStepGetNumLinIters(void *arkode_mem, + long int *nliters); +SUNDIALS_EXPORT int MRIStepGetNumLinConvFails(void *arkode_mem, + long int *nlcfails); +SUNDIALS_EXPORT int MRIStepGetNumJTSetupEvals(void *arkode_mem, + long int *njtsetups); +SUNDIALS_EXPORT int MRIStepGetNumJtimesEvals(void *arkode_mem, + long int *njvevals); +SUNDIALS_EXPORT int MRIStepGetNumLinRhsEvals(void *arkode_mem, + long int *nfevalsLS); +SUNDIALS_EXPORT int MRIStepGetLastLinFlag(void *arkode_mem, + long int *flag); + +SUNDIALS_EXPORT char *MRIStepGetLinReturnFlagName(long int flag); + + +/* Free function */ +SUNDIALS_EXPORT void MRIStepFree(void **arkode_mem); + +/* Output the MRIStep memory structure (useful when debugging) */ +SUNDIALS_EXPORT void MRIStepPrintMem(void* arkode_mem, FILE* outfile); + +/* Custom inner stepper functions */ +SUNDIALS_EXPORT int MRIStepInnerStepper_Create(SUNContext sunctx, + MRIStepInnerStepper *stepper); + +SUNDIALS_EXPORT int MRIStepInnerStepper_Free(MRIStepInnerStepper *stepper); + +SUNDIALS_EXPORT int MRIStepInnerStepper_SetContent(MRIStepInnerStepper stepper, + void *content); + +SUNDIALS_EXPORT int MRIStepInnerStepper_GetContent(MRIStepInnerStepper stepper, + void **content); + +SUNDIALS_EXPORT int MRIStepInnerStepper_SetEvolveFn(MRIStepInnerStepper stepper, + MRIStepInnerEvolveFn fn); + +SUNDIALS_EXPORT int MRIStepInnerStepper_SetFullRhsFn(MRIStepInnerStepper stepper, + MRIStepInnerFullRhsFn fn); + +SUNDIALS_EXPORT int MRIStepInnerStepper_SetResetFn(MRIStepInnerStepper stepper, + MRIStepInnerResetFn fn); + +SUNDIALS_EXPORT int MRIStepInnerStepper_AddForcing(MRIStepInnerStepper stepper, + realtype t, N_Vector f); + +SUNDIALS_EXPORT int MRIStepInnerStepper_GetForcingData(MRIStepInnerStepper stepper, + realtype *tshift, + realtype *tscale, + N_Vector **forcing, + int *nforcing); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/include/arkode/arkode_xbraid.h b/lib/sundials_6.1.1/include/arkode/arkode_xbraid.h new file mode 100644 index 00000000000..32b3cf39588 --- /dev/null +++ b/lib/sundials_6.1.1/include/arkode/arkode_xbraid.h @@ -0,0 +1,109 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This is the header file for the ARKODE + XBraid interface. + * ---------------------------------------------------------------------------*/ + +#ifndef _ARKODE_XBRAID_H +#define _ARKODE_XBRAID_H + +#include "sundials/sundials_xbraid.h" +#include "braid.h" +#include "mpi.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* ------------------------------- + * Construct, initialize, and free + * ------------------------------- */ + + +SUNDIALS_EXPORT int ARKBraid_Create(void *arkode_mem, braid_App *app); + +SUNDIALS_EXPORT int ARKBraid_BraidInit(MPI_Comm comm_w, MPI_Comm comm_t, + realtype tstart, realtype tstop, + sunindextype nt, braid_App app, + braid_Core *core); + +SUNDIALS_EXPORT int ARKBraid_Free(braid_App *app); + + +/* ---------------------- + * ARKBraid Set Functions + * ---------------------- */ + + +SUNDIALS_EXPORT int ARKBraid_SetStepFn(braid_App app, braid_PtFcnStep step); + +SUNDIALS_EXPORT int ARKBraid_SetInitFn(braid_App app, braid_PtFcnInit init); + +SUNDIALS_EXPORT int ARKBraid_SetSpatialNormFn(braid_App app, + braid_PtFcnSpatialNorm snorm); + +SUNDIALS_EXPORT int ARKBraid_SetAccessFn(braid_App app, + braid_PtFcnAccess access); + + +/* ---------------------- + * ARKBraid Get Functions + * ---------------------- */ + + +SUNDIALS_EXPORT int ARKBraid_GetVecTmpl(braid_App app, N_Vector *tmpl); + +SUNDIALS_EXPORT int ARKBraid_GetARKStepMem(braid_App app, void **arkode_mem); + +SUNDIALS_EXPORT int ARKBraid_GetUserData(braid_App app, void **user_data); + +SUNDIALS_EXPORT int ARKBraid_GetLastBraidFlag(braid_App app, int *last_flag); + +SUNDIALS_EXPORT int ARKBraid_GetLastARKStepFlag(braid_App app, int *last_flag); + +SUNDIALS_EXPORT int ARKBraid_GetSolution(braid_App app, realtype *tout, + N_Vector yout); + + +/* -------------------------- + * XBraid Interface Functions + * -------------------------- */ + + +SUNDIALS_EXPORT int ARKBraid_Step(braid_App app, braid_Vector ustop, + braid_Vector fstop, braid_Vector u, + braid_StepStatus status); + +SUNDIALS_EXPORT int ARKBraid_Init(braid_App app, realtype t, + braid_Vector *u_ptr); + +SUNDIALS_EXPORT int ARKBraid_Access(braid_App app, braid_Vector u, + braid_AccessStatus astatus); + + +/* ----------------- + * Utility Functions + * ----------------- */ + + +SUNDIALS_EXPORT int ARKBraid_TakeStep(void *arkode_mem, realtype tstart, + realtype tstop, N_Vector y, + int *ark_flag); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/include/sundials/sundials_export.h b/lib/sundials_6.1.1/include/sundials/sundials_export.h index c84af70c490..02c1ce3b63d 100644 --- a/lib/sundials_6.1.1/include/sundials/sundials_export.h +++ b/lib/sundials_6.1.1/include/sundials/sundials_export.h @@ -33,6 +33,7 @@ # define SUNDIALS_DEPRECATED_NO_EXPORT SUNDIALS_NO_EXPORT SUNDIALS_DEPRECATED #endif +/* NOLINTNEXTLINE(readability-avoid-unconditional-preprocessor-if) */ #if 0 /* DEFINE_NO_DEPRECATED */ # ifndef SUNDIALS_NO_DEPRECATED # define SUNDIALS_NO_DEPRECATED diff --git a/lib/sundials_6.1.1/src/arkode/LICENSE b/lib/sundials_6.1.1/src/arkode/LICENSE new file mode 100644 index 00000000000..d2280c365de --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/LICENSE @@ -0,0 +1,29 @@ +BSD 3-Clause License + +Copyright (c) 2002-2022, Lawrence Livermore National Security and Southern Methodist University. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +* Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/lib/sundials_6.1.1/src/arkode/NOTICE b/lib/sundials_6.1.1/src/arkode/NOTICE new file mode 100644 index 00000000000..329b142ee63 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/NOTICE @@ -0,0 +1,21 @@ +This work was produced under the auspices of the U.S. Department of +Energy by Lawrence Livermore National Laboratory under Contract +DE-AC52-07NA27344. + +This work was prepared as an account of work sponsored by an agency of +the United States Government. Neither the United States Government nor +Lawrence Livermore National Security, LLC, nor any of their employees +makes any warranty, expressed or implied, or assumes any legal liability +or responsibility for the accuracy, completeness, or usefulness of any +information, apparatus, product, or process disclosed, or represents that +its use would not infringe privately owned rights. + +Reference herein to any specific commercial product, process, or service +by trade name, trademark, manufacturer, or otherwise does not necessarily +constitute or imply its endorsement, recommendation, or favoring by the +United States Government or Lawrence Livermore National Security, LLC. + +The views and opinions of authors expressed herein do not necessarily +state or reflect those of the United States Government or Lawrence +Livermore National Security, LLC, and shall not be used for advertising +or product endorsement purposes. \ No newline at end of file diff --git a/lib/sundials_6.1.1/src/arkode/README.md b/lib/sundials_6.1.1/src/arkode/README.md new file mode 100644 index 00000000000..03ebeec9aa9 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/README.md @@ -0,0 +1,56 @@ +# ARKode +### Version 5.1.1 (Feb 2022) + +**Daniel R. Reynolds, + Department of Mathematics, SMU** + +**David J. Gardner, Carol S. Woodward, and Cody J. Balos, + Center for Applied Scientific Computing, LLNL** + +ARKode is a package for the solution of stiff, nonstiff, and multirate ordinary +differential equation (ODE) systems (initial value problems) given in linearly +implicit the form +``` +M y' = f1(t,y) + f2(t,y), y(t0) = y0. +``` +The integration methods implemented in ARKode include explicit and implicit +Runge-Kutta methods, implicit-explicit (IMEX) additive Runge-Kutta methods, and +multirate infatesemial step (MIS) methods. + +ARKode is part of a the SUNDIALS Suite of Nonlinear and Differential/Algebraic +equation Solvers which consists of ARKode, CVODE, CVODES, IDA, IDAS, and KINSOL. +It is written in ANSI standard C and can be used in a variety of computing +environments including serial, shared memory, distributed memory, and +accelerator-based (e.g., GPU) systems. This flexibility is obtained from a +modular design that leverages the shared vector, matrix, linear solver, and +nonlinear solver APIs used across SUNDIALS packages. + +For use with Fortran applications, a set of Fortran/C interface routines, called +FARKODE, is also supplied. These are written in C, but assume that the user +calling program and all user-supplied routines are in Fortran. + +## Documentation + +See the [ARKode User Guide](/doc/arkode/ark_guide.pdf) and +[ARKode Examples](/doc/arkode/ark_examples.pdf) document for more information +about ARKode usage and the provided example programs respectively. + +## Installation + +For installation instructions see the [INSTALL_GUIDE](/INSTALL_GUIDE.pdf) +or "Installation Procedure" chapter in the ARKode User Guide. + +## Release History + +Information on recent changes to ARKode can be found in the "Introduction" +chapter of the ARKode User Guide and a complete release history is available in +the "SUNDIALS Release History" appendix of the ARKode User Guide. + +## References + +* D. R. Reynolds, D. J. Gardner, C. S. Woodward, and C. J. Balos, + "User Documentation for ARKode v5.1.1," LLNL technical report + LLNL-SM-668082, Feb 2022. + +* D. R. Reynolds, "Example Programs for ARKode v5.1.1," Technical Report, + Southern Methodist University Center for Scientific Computation, Feb 2022. diff --git a/lib/sundials_6.1.1/src/arkode/arkode.c b/lib/sundials_6.1.1/src/arkode/arkode.c new file mode 100644 index 00000000000..831adf9d304 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode.c @@ -0,0 +1,3058 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * This is the implementation file for the main ARKode + * infrastructure. It is independent of the ARKode time step + * module, nonlinear solver, linear solver and vector modules in + * use. + *--------------------------------------------------------------*/ + +/*=============================================================== + Import Header Files + ===============================================================*/ +#include +#include +#include +#include + +#include "arkode_impl.h" +#include "arkode_interp_impl.h" +#include +#include + + +/*=============================================================== + EXPORTED FUNCTIONS + ===============================================================*/ + +/*--------------------------------------------------------------- + arkCreate: + + arkCreate creates an internal memory block for a problem to + be solved by a time step module built on ARKode. If successful, + arkCreate returns a pointer to the problem memory. If an + initialization error occurs, arkCreate prints an error message + to standard err and returns NULL. + ---------------------------------------------------------------*/ +ARKodeMem arkCreate(SUNContext sunctx) +{ + int iret; + ARKodeMem ark_mem; + + if (!sunctx) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKODE", "arkCreate", + MSG_ARK_NULL_SUNCTX); + return(NULL); + } + + ark_mem = NULL; + ark_mem = (ARKodeMem) malloc(sizeof(struct ARKodeMemRec)); + if (ark_mem == NULL) { + arkProcessError(NULL, ARK_MEM_FAIL, "ARKode", "arkCreate", + MSG_ARK_ARKMEM_FAIL); + return(NULL); + } + + /* Zero out ark_mem */ + memset(ark_mem, 0, sizeof(struct ARKodeMemRec)); + + /* Set the context */ + ark_mem->sunctx = sunctx; + + /* Set uround */ + ark_mem->uround = UNIT_ROUNDOFF; + + /* Initialize time step module to NULL */ + ark_mem->step_attachlinsol = NULL; + ark_mem->step_attachmasssol = NULL; + ark_mem->step_disablelsetup = NULL; + ark_mem->step_disablemsetup = NULL; + ark_mem->step_getlinmem = NULL; + ark_mem->step_getmassmem = NULL; + ark_mem->step_getimplicitrhs = NULL; + ark_mem->step_mmult = NULL; + ark_mem->step_getgammas = NULL; + ark_mem->step_init = NULL; + ark_mem->step_fullrhs = NULL; + ark_mem->step = NULL; + ark_mem->step_mem = NULL; + + /* Initialize root finding variables */ + ark_mem->root_mem = NULL; + + /* Initialize inequality constraints variables */ + ark_mem->constraintsSet = SUNFALSE; + ark_mem->constraints = NULL; + + /* Initialize diagnostics reporting variables */ + ark_mem->report = SUNFALSE; + ark_mem->diagfp = NULL; + + /* Initialize lrw and liw */ + ark_mem->lrw = 18; + ark_mem->liw = 39; /* fcn/data ptr, int, long int, sunindextype, booleantype */ + + /* No mallocs have been done yet */ + ark_mem->VabstolMallocDone = SUNFALSE; + ark_mem->VRabstolMallocDone = SUNFALSE; + ark_mem->MallocDone = SUNFALSE; + + /* No user-supplied step postprocessing function yet */ + ark_mem->ProcessStep = NULL; + ark_mem->ps_data = NULL; + + /* No user-supplied stage postprocessing function yet */ + ark_mem->ProcessStage = NULL; + + /* No user_data pointer yet */ + ark_mem->user_data = NULL; + + /* Allocate step adaptivity structure and note storage */ + ark_mem->hadapt_mem = arkAdaptInit(); + if (ark_mem->hadapt_mem == NULL) { + arkProcessError(NULL, ARK_MEM_FAIL, "ARKode", "arkCreate", + "Allocation of step adaptivity structure failed"); + return(NULL); + } + ark_mem->lrw += ARK_ADAPT_LRW; + ark_mem->liw += ARK_ADAPT_LIW; + + /* Initialize the interpolation structure to NULL */ + ark_mem->interp = NULL; + + /* Initially, rwt should point to ewt */ + ark_mem->rwt_is_ewt = SUNTRUE; + + /* Indicate that evaluation of the full RHS is not required after each step, + this flag is updated to SUNTRUE by the interpolation module initialization + function and/or the stepper initialization function in arkInitialSetup */ + ark_mem->call_fullrhs = SUNFALSE; + + /* Indicate that the problem needs to be initialized */ + ark_mem->initsetup = SUNTRUE; + ark_mem->init_type = FIRST_INIT; + ark_mem->firststage = SUNTRUE; + ark_mem->initialized = SUNFALSE; + + /* Initial step size has not been determined yet */ + ark_mem->h = ZERO; + ark_mem->h0u = ZERO; + + /* Set default values for integrator optional inputs */ + iret = arkSetDefaults(ark_mem); + if (iret != ARK_SUCCESS) { + arkProcessError(NULL, 0, "ARKode", "arkCreate", + "Error setting default solver options"); + return(NULL); + } + + /* Return pointer to ARKode memory block */ + return(ark_mem); +} + + +/*--------------------------------------------------------------- + arkResize: + + arkResize re-initializes ARKode's memory for a problem with a + changing vector size. It is assumed that the problem dynamics + before and after the vector resize will be comparable, so that + all time-stepping heuristics prior to calling arkResize + remain valid after the call. If instead the dynamics should be + re-calibrated, the ARKode memory structure should be deleted + with a call to *StepFree, and re-created with a call to + *StepCreate. + + To aid in the vector-resize operation, the user can supply a + vector resize function, that will take as input an N_Vector with + the previous size, and return as output a corresponding vector + of the new size. If this function (of type ARKVecResizeFn) is + not supplied (i.e. is set to NULL), then all existing N_Vectors + will be destroyed and re-cloned from the input vector. + + In the case that the dynamical time scale should be modified + slightly from the previous time scale, an input "hscale" is + allowed, that will re-scale the upcoming time step by the + specified factor. If a value <= 0 is specified, the default of + 1.0 will be used. + + Other arguments: + ark_mem Existing ARKode memory data structure. + y0 The newly-sized solution vector, holding + the current dependent variable values. + t0 The current value of the independent + variable. + resize_data User-supplied data structure that will be + passed to the supplied resize function. + + The return value is ARK_SUCCESS = 0 if no errors occurred, or + a negative value otherwise. + ---------------------------------------------------------------*/ +int arkResize(ARKodeMem ark_mem, N_Vector y0, realtype hscale, + realtype t0, ARKVecResizeFn resize, void *resize_data) +{ + booleantype resizeOK; + sunindextype lrw1, liw1, lrw_diff, liw_diff; + int retval; + + /* Check ark_mem */ + if (ark_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkResize", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + + /* Check if ark_mem was allocated */ + if (ark_mem->MallocDone == SUNFALSE) { + arkProcessError(ark_mem, ARK_NO_MALLOC, "ARKode", + "arkResize", MSG_ARK_NO_MALLOC); + return(ARK_NO_MALLOC); + } + + /* Check for legal input parameters */ + if (y0 == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkResize", MSG_ARK_NULL_Y0); + return(ARK_ILL_INPUT); + } + + /* Copy the input parameters into ARKode state */ + ark_mem->tcur = t0; + ark_mem->tn = t0; + + /* Update time-stepping parameters */ + /* adjust upcoming step size depending on hscale */ + if (hscale < ZERO) hscale = ONE; + if (hscale != ONE) { + + /* Encode hscale into ark_mem structure */ + ark_mem->eta = hscale; + ark_mem->hprime *= hscale; + + /* If next step would overtake tstop, adjust stepsize */ + if ( ark_mem->tstopset ) + if ( (ark_mem->tcur + ark_mem->hprime - ark_mem->tstop)*ark_mem->hprime > ZERO ) { + ark_mem->hprime = (ark_mem->tstop-ark_mem->tcur) * + (ONE-FOUR*ark_mem->uround); + ark_mem->eta = ark_mem->hprime/ark_mem->h; + } + + } + + /* Determing change in vector sizes */ + lrw1 = liw1 = 0; + if (y0->ops->nvspace != NULL) + N_VSpace(y0, &lrw1, &liw1); + lrw_diff = lrw1 - ark_mem->lrw1; + liw_diff = liw1 - ark_mem->liw1; + ark_mem->lrw1 = lrw1; + ark_mem->liw1 = liw1; + + /* Resize the solver vectors (using y0 as a template) */ + resizeOK = arkResizeVectors(ark_mem, resize, resize_data, + lrw_diff, liw_diff, y0); + if (!resizeOK) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkResize", "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + + /* Resize the interpolation structure memory */ + if (ark_mem->interp != NULL) { + retval = arkInterpResize(ark_mem, ark_mem->interp, resize, + resize_data, lrw_diff, liw_diff, y0); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode", "arkResize", + "Interpolation module resize failure"); + return(retval); + } + } + + /* Copy y0 into ark_yn to set the current solution */ + N_VScale(ONE, y0, ark_mem->yn); + + /* Disable constraints */ + ark_mem->constraintsSet = SUNFALSE; + + /* Indicate that problem needs to be initialized */ + ark_mem->initsetup = SUNTRUE; + ark_mem->init_type = RESIZE_INIT; + ark_mem->firststage = SUNTRUE; + + /* Problem has been successfully re-sized */ + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSStolerances, arkSVtolerances, arkWFtolerances: + + These functions specify the integration tolerances. One of them + SHOULD be called before the first call to arkEvolve; otherwise + default values of reltol=1e-4 and abstol=1e-9 will be used, + which may be entirely incorrect for a specific problem. + + arkSStolerances specifies scalar relative and absolute + tolerances. + + arkSVtolerances specifies scalar relative tolerance and a + vector absolute tolerance (a potentially different absolute + tolerance for each vector component). + + arkWFtolerances specifies a user-provides function (of type + ARKEwtFn) which will be called to set the error weight vector. + ---------------------------------------------------------------*/ +int arkSStolerances(ARKodeMem ark_mem, realtype reltol, realtype abstol) +{ + /* Check inputs */ + if (ark_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSStolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + if (ark_mem->MallocDone == SUNFALSE) { + arkProcessError(ark_mem, ARK_NO_MALLOC, "ARKode", + "arkSStolerances", MSG_ARK_NO_MALLOC); + return(ARK_NO_MALLOC); + } + if (reltol < ZERO) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSStolerances", MSG_ARK_BAD_RELTOL); + return(ARK_ILL_INPUT); + } + if (abstol < ZERO) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSStolerances", MSG_ARK_BAD_ABSTOL); + return(ARK_ILL_INPUT); + } + + /* Set flag indicating whether abstol == 0 */ + ark_mem->atolmin0 = (abstol == ZERO); + + /* Copy tolerances into memory */ + ark_mem->reltol = reltol; + ark_mem->Sabstol = abstol; + ark_mem->itol = ARK_SS; + + /* enforce use of arkEwtSetSS */ + ark_mem->user_efun = SUNFALSE; + ark_mem->efun = arkEwtSetSS; + ark_mem->e_data = ark_mem; + + return(ARK_SUCCESS); +} + + +int arkSVtolerances(ARKodeMem ark_mem, realtype reltol, N_Vector abstol) +{ + /* local variables */ + realtype abstolmin; + + /* Check inputs */ + if (ark_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSVtolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + if (ark_mem->MallocDone == SUNFALSE) { + arkProcessError(ark_mem, ARK_NO_MALLOC, "ARKode", + "arkSVtolerances", MSG_ARK_NO_MALLOC); + return(ARK_NO_MALLOC); + } + if (reltol < ZERO) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSVtolerances", MSG_ARK_BAD_RELTOL); + return(ARK_ILL_INPUT); + } + if (abstol == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSVtolerances", MSG_ARK_NULL_ABSTOL); + return(ARK_ILL_INPUT); + } + if (abstol->ops->nvmin == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkSVtolerances", + "Missing N_VMin routine from N_Vector"); + return(ARK_ILL_INPUT); + } + abstolmin = N_VMin(abstol); + if (abstolmin < ZERO) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSVtolerances", MSG_ARK_BAD_ABSTOL); + return(ARK_ILL_INPUT); + } + + /* Set flag indicating whether min(abstol) == 0 */ + ark_mem->atolmin0 = (abstolmin == ZERO); + + /* Copy tolerances into memory */ + if ( !(ark_mem->VabstolMallocDone) ) { + if (!arkAllocVec(ark_mem, ark_mem->ewt, &(ark_mem->Vabstol))) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkSVtolerances", MSG_ARK_ARKMEM_FAIL); + return(ARK_ILL_INPUT); + } + ark_mem->VabstolMallocDone = SUNTRUE; + } + N_VScale(ONE, abstol, ark_mem->Vabstol); + ark_mem->reltol = reltol; + ark_mem->itol = ARK_SV; + + /* enforce use of arkEwtSetSV */ + ark_mem->user_efun = SUNFALSE; + ark_mem->efun = arkEwtSetSV; + ark_mem->e_data = ark_mem; + + return(ARK_SUCCESS); +} + + +int arkWFtolerances(ARKodeMem ark_mem, ARKEwtFn efun) +{ + if (ark_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkWFtolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + if (ark_mem->MallocDone == SUNFALSE) { + arkProcessError(ark_mem, ARK_NO_MALLOC, "ARKode", + "arkWFtolerances", MSG_ARK_NO_MALLOC); + return(ARK_NO_MALLOC); + } + + /* Copy tolerance data into memory */ + ark_mem->itol = ARK_WF; + ark_mem->user_efun = SUNTRUE; + ark_mem->efun = efun; + ark_mem->e_data = ark_mem->user_data; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkResStolerance, arkResVtolerance, arkResFtolerance: + + These functions specify the absolute residual tolerance. + Specification of the absolute residual tolerance is only + necessary for problems with non-identity mass matrices in which + the units of the solution vector y dramatically differ from the + units of the ODE right-hand side f(t,y). If this occurs, one + of these routines SHOULD be called before the first call to + ARKode; otherwise the default value of rabstol=1e-9 will be + used, which may be entirely incorrect for a specific problem. + + arkResStolerances specifies a scalar residual tolerance. + + arkResVtolerances specifies a vector residual tolerance + (a potentially different absolute residual tolerance for + each vector component). + + arkResFtolerances specifies a user-provides function (of + type ARKRwtFn) which will be called to set the residual + weight vector. + ---------------------------------------------------------------*/ +int arkResStolerance(ARKodeMem ark_mem, realtype rabstol) +{ + /* Check inputs */ + if (ark_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkResStolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + if (ark_mem->MallocDone == SUNFALSE) { + arkProcessError(ark_mem, ARK_NO_MALLOC, "ARKode", + "arkResStolerances", MSG_ARK_NO_MALLOC); + return(ARK_NO_MALLOC); + } + if (rabstol < ZERO) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkResStolerances", MSG_ARK_BAD_RABSTOL); + return(ARK_ILL_INPUT); + } + + /* Set flag indicating whether rabstol == 0 */ + ark_mem->Ratolmin0 = (rabstol == ZERO); + + /* Allocate space for rwt if necessary */ + if (ark_mem->rwt_is_ewt) { + ark_mem->rwt = NULL; + if (!arkAllocVec(ark_mem, ark_mem->ewt, &(ark_mem->rwt))) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkResStolerances", MSG_ARK_ARKMEM_FAIL); + return(ARK_ILL_INPUT); + } + ark_mem->rwt_is_ewt = SUNFALSE; + } + + /* Copy tolerances into memory */ + ark_mem->SRabstol = rabstol; + ark_mem->ritol = ARK_SS; + + /* enforce use of arkRwtSet */ + ark_mem->user_efun = SUNFALSE; + ark_mem->rfun = arkRwtSet; + ark_mem->r_data = ark_mem; + + return(ARK_SUCCESS); +} + + +int arkResVtolerance(ARKodeMem ark_mem, N_Vector rabstol) +{ + /* local variables */ + realtype rabstolmin; + + /* Check inputs */ + if (ark_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkResVtolerance", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + if (ark_mem->MallocDone == SUNFALSE) { + arkProcessError(ark_mem, ARK_NO_MALLOC, "ARKode", + "arkResVtolerance", MSG_ARK_NO_MALLOC); + return(ARK_NO_MALLOC); + } + if (rabstol == NULL) { + arkProcessError(ark_mem, ARK_NO_MALLOC, "ARKode", + "arkResVtolerance", MSG_ARK_NULL_RABSTOL); + return(ARK_NO_MALLOC); + } + if (rabstol->ops->nvmin == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkResVtolerance", + "Missing N_VMin routine from N_Vector"); + return(ARK_ILL_INPUT); + } + rabstolmin = N_VMin(rabstol); + if (rabstolmin < ZERO) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkResVtolerance", MSG_ARK_BAD_RABSTOL); + return(ARK_ILL_INPUT); + } + + /* Set flag indicating whether min(abstol) == 0 */ + ark_mem->Ratolmin0 = (rabstolmin == ZERO); + + /* Allocate space for rwt if necessary */ + if (ark_mem->rwt_is_ewt) { + ark_mem->rwt = NULL; + if (!arkAllocVec(ark_mem, ark_mem->ewt, &(ark_mem->rwt))) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkResVtolerances", MSG_ARK_ARKMEM_FAIL); + return(ARK_ILL_INPUT); + } + ark_mem->rwt_is_ewt = SUNFALSE; + } + + /* Copy tolerances into memory */ + if ( !(ark_mem->VRabstolMallocDone) ) { + if (!arkAllocVec(ark_mem, ark_mem->rwt, &(ark_mem->VRabstol))) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkResStolerances", MSG_ARK_ARKMEM_FAIL); + return(ARK_ILL_INPUT); + } + ark_mem->VRabstolMallocDone = SUNTRUE; + } + N_VScale(ONE, rabstol, ark_mem->VRabstol); + ark_mem->ritol = ARK_SV; + + + /* enforce use of arkRwtSet */ + ark_mem->user_efun = SUNFALSE; + ark_mem->rfun = arkRwtSet; + ark_mem->r_data = ark_mem; + + return(ARK_SUCCESS); +} + + +int arkResFtolerance(ARKodeMem ark_mem, ARKRwtFn rfun) +{ + if (ark_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkResFtolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + if (ark_mem->MallocDone == SUNFALSE) { + arkProcessError(ark_mem, ARK_NO_MALLOC, "ARKode", + "arkResFtolerances", MSG_ARK_NO_MALLOC); + return(ARK_NO_MALLOC); + } + + /* Allocate space for rwt if necessary */ + if (ark_mem->rwt_is_ewt) { + ark_mem->rwt = NULL; + if (!arkAllocVec(ark_mem, ark_mem->ewt, &(ark_mem->rwt))) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkResFtolerances", MSG_ARK_ARKMEM_FAIL); + return(ARK_ILL_INPUT); + } + ark_mem->rwt_is_ewt = SUNFALSE; + } + + /* Copy tolerance data into memory */ + ark_mem->ritol = ARK_WF; + ark_mem->user_rfun = SUNTRUE; + ark_mem->rfun = rfun; + ark_mem->r_data = ark_mem->user_data; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkEvolve: + + This routine is the main driver of ARKode-based integrators. + + It integrates over a time interval defined by the user, by + calling the time step module to do internal time steps. + + The first time that arkEvolve is called for a successfully + initialized problem, it computes a tentative initial step size. + + arkEvolve supports two modes as specified by itask: ARK_NORMAL and + ARK_ONE_STEP. In the ARK_NORMAL mode, the solver steps until + it reaches or passes tout and then interpolates to obtain + y(tout). In the ARK_ONE_STEP mode, it takes one internal step + and returns. The behavior of both modes can be over-rided + through user-specification of ark_tstop (through the + *StepSetStopTime function), in which case if a solver step + would pass tstop, the step is shortened so that it stops at + exactly the specified stop time, and hence interpolation of + y(tout) is not required. + ---------------------------------------------------------------*/ +int arkEvolve(ARKodeMem ark_mem, realtype tout, N_Vector yout, + realtype *tret, int itask) +{ + long int nstloc; + int retval, kflag, istate, ir; + int ewtsetOK; + realtype troundoff, nrm; + booleantype inactive_roots; + realtype dsm; + int nflag, attempts, ncf, nef, constrfails; + + /* Check and process inputs */ + + /* Check if ark_mem exists */ + if (ark_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", "arkEvolve", + MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + + /* Check if ark_mem was allocated */ + if (ark_mem->MallocDone == SUNFALSE) { + arkProcessError(ark_mem, ARK_NO_MALLOC, "ARKode", "arkEvolve", + MSG_ARK_NO_MALLOC); + return(ARK_NO_MALLOC); + } + + /* Check for yout != NULL */ + if ((ark_mem->ycur = yout) == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkEvolve", + MSG_ARK_YOUT_NULL); + return(ARK_ILL_INPUT); + } + + /* Check for tret != NULL */ + if (tret == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkEvolve", + MSG_ARK_TRET_NULL); + return(ARK_ILL_INPUT); + } + + /* Check for valid itask */ + if ( (itask != ARK_NORMAL) && (itask != ARK_ONE_STEP) ) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkEvolve", + MSG_ARK_BAD_ITASK); + return(ARK_ILL_INPUT); + } + + /* store copy of itask if using root-finding */ + if (ark_mem->root_mem != NULL) { + if (itask == ARK_NORMAL) ark_mem->root_mem->toutc = tout; + ark_mem->root_mem->taskc = itask; + } + + + /* perform first-step-specific initializations: + - initialize tret values to initialization time + - perform initial integrator setup */ + if (ark_mem->initsetup) { + ark_mem->tretlast = *tret = ark_mem->tcur; + retval = arkInitialSetup(ark_mem, tout); + if (retval!= ARK_SUCCESS) return(retval); + } + + /* perform stopping tests */ + if (!ark_mem->initsetup) + if (arkStopTests(ark_mem, tout, yout, tret, itask, &retval)) + return(retval); + + + /*-------------------------------------------------- + Looping point for successful internal steps + + - update the ewt/rwt vectors for upcoming step + - check for errors (too many steps, too much + accuracy requested, step size too small) + - loop over attempts at a new step: + * try to take step (via time stepper module), + handle solver convergence or other failures + * perform constraint-handling (if selected) + * check temporal error + * if all of the above pass, complete step by + updating current time, solution, error & + stepsize history arrays. + - perform stop tests: + * check for root in last step taken + * check if tout was passed + * check if close to tstop + * check if in ONE_STEP mode (must return) + --------------------------------------------------*/ + nstloc = 0; + for(;;) { + + ark_mem->next_h = ark_mem->h; + + /* Reset and check ewt and rwt */ + if (!ark_mem->initsetup) { + + ewtsetOK = ark_mem->efun(ark_mem->yn, + ark_mem->ewt, + ark_mem->e_data); + if (ewtsetOK != 0) { + if (ark_mem->itol == ARK_WF) + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkEvolve", + MSG_ARK_EWT_NOW_FAIL, ark_mem->tcur); + else + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkEvolve", + MSG_ARK_EWT_NOW_BAD, ark_mem->tcur); + + istate = ARK_ILL_INPUT; + ark_mem->tretlast = *tret = ark_mem->tcur; + N_VScale(ONE, ark_mem->yn, yout); + break; + } + + if (!ark_mem->rwt_is_ewt) { + ewtsetOK = ark_mem->rfun(ark_mem->yn, + ark_mem->rwt, + ark_mem->r_data); + if (ewtsetOK != 0) { + if (ark_mem->itol == ARK_WF) + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkEvolve", + MSG_ARK_RWT_NOW_FAIL, ark_mem->tcur); + else + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkEvolve", + MSG_ARK_RWT_NOW_BAD, ark_mem->tcur); + + istate = ARK_ILL_INPUT; + ark_mem->tretlast = *tret = ark_mem->tcur; + N_VScale(ONE, ark_mem->yn, yout); + break; + } + } + } + + /* Check for too many steps */ + if ( (ark_mem->mxstep > 0) && (nstloc >= ark_mem->mxstep) ) { + arkProcessError(ark_mem, ARK_TOO_MUCH_WORK, "ARKode", "arkEvolve", + MSG_ARK_MAX_STEPS, ark_mem->tcur); + istate = ARK_TOO_MUCH_WORK; + ark_mem->tretlast = *tret = ark_mem->tcur; + N_VScale(ONE, ark_mem->yn, yout); + break; + } + + /* Check for too much accuracy requested */ + nrm = N_VWrmsNorm(ark_mem->yn, ark_mem->ewt); + ark_mem->tolsf = ark_mem->uround * nrm; + if (ark_mem->tolsf > ONE) { + arkProcessError(ark_mem, ARK_TOO_MUCH_ACC, "ARKode", "arkEvolve", + MSG_ARK_TOO_MUCH_ACC, ark_mem->tcur); + istate = ARK_TOO_MUCH_ACC; + ark_mem->tretlast = *tret = ark_mem->tcur; + N_VScale(ONE, ark_mem->yn, yout); + ark_mem->tolsf *= TWO; + break; + } else { + ark_mem->tolsf = ONE; + } + + /* Check for h below roundoff level in tn */ + if (ark_mem->tcur + ark_mem->h == ark_mem->tcur) { + ark_mem->nhnil++; + if (ark_mem->nhnil <= ark_mem->mxhnil) + arkProcessError(ark_mem, ARK_WARNING, "ARKode", "arkEvolve", + MSG_ARK_HNIL, ark_mem->tcur, ark_mem->h); + if (ark_mem->nhnil == ark_mem->mxhnil) + arkProcessError(ark_mem, ARK_WARNING, "ARKode", "arkEvolve", + MSG_ARK_HNIL_DONE); + } + + /* Update parameter for upcoming step size */ + if (ark_mem->hprime != ark_mem->h) { + ark_mem->h = ark_mem->h * ark_mem->eta; + ark_mem->next_h = ark_mem->h; + } + if (ark_mem->fixedstep) { + ark_mem->h = ark_mem->hin; + ark_mem->next_h = ark_mem->h; + + /* patch for 'fixedstep' + 'tstop' use case: + limit fixed step size if step would overtake tstop */ + if ( ark_mem->tstopset ) { + if ( (ark_mem->tcur + ark_mem->h - ark_mem->tstop)*ark_mem->h > ZERO ) { + ark_mem->h = (ark_mem->tstop - ark_mem->tcur) * + (ONE-FOUR*ark_mem->uround); + } + } + } + + /* Looping point for step attempts */ + dsm = ZERO; + attempts = ncf = nef = constrfails = ark_mem->last_kflag = 0; + nflag = FIRST_CALL; + for(;;) { + + /* increment attempt counters */ + attempts++; + ark_mem->nst_attempts++; + +#ifdef SUNDIALS_DEBUG + STAN_SUNDIALS_PRINTF("ARKODE start step %li, attempt %i, h = %"RSYM", t_n = %"RSYM"\n", + ark_mem->nst, attempts, ark_mem->h, ark_mem->tcur); +#endif + + /* Call time stepper module to attempt a step: + 0 => step completed successfully + >0 => step encountered recoverable failure; reduce step if possible + <0 => step encountered unrecoverable failure */ + kflag = ark_mem->step((void*) ark_mem, &dsm, &nflag); + if (kflag < 0) break; + + /* handle solver convergence failures */ + kflag = arkCheckConvergence(ark_mem, &nflag, &ncf); + if (kflag < 0) break; + + /* perform constraint-handling (if selected, and if solver check passed) */ + if (ark_mem->constraintsSet && (kflag == ARK_SUCCESS)) { + kflag = arkCheckConstraints(ark_mem, &constrfails, &nflag); + if (kflag < 0) break; + } + + /* when fixed time-stepping is enabled, 'success' == successful stage solves + (checked in previous block), so just enforce no step size change */ + if (ark_mem->fixedstep) { + ark_mem->eta = ONE; + break; + } + + /* check temporal error (if checks above passed) */ + if (kflag == ARK_SUCCESS) { + kflag = arkCheckTemporalError(ark_mem, &nflag, &nef, dsm); + if (kflag < 0) break; + } + + /* if we've made it here then no nonrecoverable failures occurred; someone above + has recommended an 'eta' value for the next step -- enforce bounds on that value + and set upcoming step size */ + ark_mem->eta = SUNMIN(ark_mem->eta, ark_mem->hadapt_mem->etamax); + ark_mem->eta = SUNMAX(ark_mem->eta, ark_mem->hmin / SUNRabs(ark_mem->h)); + ark_mem->eta /= SUNMAX(ONE, SUNRabs(ark_mem->h) * ark_mem->hmax_inv*ark_mem->eta); + + /* if ignoring temporal error test result (XBraid) force step to pass */ + if (ark_mem->force_pass) { + ark_mem->last_kflag = kflag; + kflag = ARK_SUCCESS; + break; + } + + /* break attempt loop on successful step */ + if (kflag == ARK_SUCCESS) break; + + /* unsuccessful step, if |h| = hmin, return ARK_ERR_FAILURE */ + if (SUNRabs(ark_mem->h) <= ark_mem->hmin*ONEPSM) return(ARK_ERR_FAILURE); + + /* update h, hprime and next_h for next iteration */ + ark_mem->h *= ark_mem->eta; + ark_mem->next_h = ark_mem->hprime = ark_mem->h; + + } /* end looping for step attempts */ + + /* If step attempt loop succeeded, complete step (update current time, solution, + error stepsize history arrays; call user-supplied step postprocessing function) + (added stuff from arkStep_PrepareNextStep -- revisit) */ + if (kflag == ARK_SUCCESS) kflag = arkCompleteStep(ark_mem, dsm); + + /* If step attempt loop failed, process flag and return to user */ + if (kflag != ARK_SUCCESS) { + istate = arkHandleFailure(ark_mem, kflag); + ark_mem->tretlast = *tret = ark_mem->tcur; + N_VScale(ONE, ark_mem->yn, yout); + break; + } + + nstloc++; + + /* Check for root in last step taken. */ + if (ark_mem->root_mem != NULL) { + if (ark_mem->root_mem->nrtfn > 0) { + + retval = arkRootCheck3((void*) ark_mem); + if (retval == RTFOUND) { /* A new root was found */ + ark_mem->root_mem->irfnd = 1; + istate = ARK_ROOT_RETURN; + ark_mem->tretlast = *tret = ark_mem->root_mem->tlo; + break; + } else if (retval == ARK_RTFUNC_FAIL) { /* g failed */ + arkProcessError(ark_mem, ARK_RTFUNC_FAIL, "ARKode", "arkEvolve", + MSG_ARK_RTFUNC_FAILED, ark_mem->root_mem->tlo); + istate = ARK_RTFUNC_FAIL; + break; + } + + /* If we are at the end of the first step and we still have + some event functions that are inactive, issue a warning + as this may indicate a user error in the implementation + of the root function. */ + if (ark_mem->nst==1) { + inactive_roots = SUNFALSE; + for (ir=0; irroot_mem->nrtfn; ir++) { + if (!ark_mem->root_mem->gactive[ir]) { + inactive_roots = SUNTRUE; + break; + } + } + if ((ark_mem->root_mem->mxgnull > 0) && inactive_roots) { + arkProcessError(ark_mem, ARK_WARNING, "ARKode", "arkEvolve", + MSG_ARK_INACTIVE_ROOTS); + } + } + } + } + + /* In NORMAL mode, check if tout reached */ + if ( (itask == ARK_NORMAL) && + (ark_mem->tcur-tout)*ark_mem->h >= ZERO ) { + istate = ARK_SUCCESS; + ark_mem->tretlast = *tret = tout; + (void) arkGetDky(ark_mem, tout, 0, yout); + ark_mem->next_h = ark_mem->hprime; + break; + } + + /* Check if tn is at tstop or near tstop */ + if ( ark_mem->tstopset ) { + troundoff = FUZZ_FACTOR*ark_mem->uround * + (SUNRabs(ark_mem->tcur) + SUNRabs(ark_mem->h)); + if ( SUNRabs(ark_mem->tcur - ark_mem->tstop) <= troundoff) { + (void) arkGetDky(ark_mem, ark_mem->tstop, 0, yout); + ark_mem->tretlast = *tret = ark_mem->tstop; + ark_mem->tstopset = SUNFALSE; + istate = ARK_TSTOP_RETURN; + break; + } + /* limit upcoming step if it will overcome tstop */ + if ( (ark_mem->tcur + ark_mem->hprime - ark_mem->tstop)*ark_mem->h > ZERO ) { + ark_mem->hprime = (ark_mem->tstop - ark_mem->tcur) * + (ONE-FOUR*ark_mem->uround); + ark_mem->eta = ark_mem->hprime/ark_mem->h; + } + } + + /* In ONE_STEP mode, copy y and exit loop */ + if (itask == ARK_ONE_STEP) { + istate = ARK_SUCCESS; + ark_mem->tretlast = *tret = ark_mem->tcur; + N_VScale(ONE, ark_mem->yn, yout); + ark_mem->next_h = ark_mem->hprime; + break; + } + + } /* end looping for internal steps */ + + return(istate); +} + + +/*--------------------------------------------------------------- + arkGetDky: + + This routine computes the k-th derivative of the interpolating + polynomial at the time t and stores the result in the vector + dky. This routine internally calls arkInterpEvaluate to perform + the interpolation. We have the restriction that 0 <= k <= 3. + This routine uses an interpolating polynomial of degree + max(deg, k), i.e. it will form a polynomial of the degree + available by the interpolation module and/or requested by + the user through deg, unless higher-order derivatives are + requested. + + This function is called by arkEvolve with k=0 and t=tout to + perform interpolation of outputs, but may also be called + indirectly by the user via time step module *StepGetDky calls. + Note: in all cases it will be called after ark_tcur has been + updated to correspond with the end time of the last successful + step. + ---------------------------------------------------------------*/ +int arkGetDky(ARKodeMem ark_mem, realtype t, int k, N_Vector dky) +{ + realtype s, tfuzz, tp, tn1; + int retval; + + /* Check all inputs for legality */ + if (ark_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", "arkGetDky", + MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + if (dky == NULL) { + arkProcessError(ark_mem, ARK_BAD_DKY, "ARKode", "arkGetDky", + MSG_ARK_NULL_DKY); + return(ARK_BAD_DKY); + } + if (ark_mem->interp == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", "arkGetDky", + "Missing interpolation structure"); + return(ARK_MEM_NULL); + } + + + /* Allow for some slack */ + tfuzz = FUZZ_FACTOR * ark_mem->uround * + (SUNRabs(ark_mem->tcur) + SUNRabs(ark_mem->hold)); + if (ark_mem->hold < ZERO) tfuzz = -tfuzz; + tp = ark_mem->tcur - ark_mem->hold - tfuzz; + tn1 = ark_mem->tcur + tfuzz; + if ((t-tp)*(t-tn1) > ZERO) { + arkProcessError(ark_mem, ARK_BAD_T, "ARKode", "arkGetDky", + MSG_ARK_BAD_T, t, ark_mem->tcur-ark_mem->hold, + ark_mem->tcur); + return(ARK_BAD_T); + } + + /* call arkInterpEvaluate to evaluate result */ + s = (t - ark_mem->tcur) / ark_mem->h; + retval = arkInterpEvaluate(ark_mem, ark_mem->interp, s, + k, ARK_INTERP_MAX_DEGREE, dky); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode", "arkGetDky", + "Error calling arkInterpEvaluate"); + return(retval); + } + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkFree: + + This routine frees the ARKode infrastructure memory. + ---------------------------------------------------------------*/ +void arkFree(void **arkode_mem) +{ + ARKodeMem ark_mem; + + if (*arkode_mem == NULL) return; + + ark_mem = (ARKodeMem) (*arkode_mem); + + /* free vector storage */ + arkFreeVectors(ark_mem); + + /* free the time step adaptivity module */ + if (ark_mem->hadapt_mem != NULL) { + free(ark_mem->hadapt_mem); + ark_mem->hadapt_mem = NULL; + } + + /* free the interpolation module */ + if (ark_mem->interp != NULL) { + arkInterpFree(ark_mem, ark_mem->interp); + ark_mem->interp = NULL; + } + + /* free the root-finding module */ + if (ark_mem->root_mem != NULL) { + (void) arkRootFree(*arkode_mem); + ark_mem->root_mem = NULL; + } + + free(*arkode_mem); + *arkode_mem = NULL; +} + + + +/*=============================================================== + Internal functions that may be replaced by the user + ===============================================================*/ + +/*--------------------------------------------------------------- + arkRwtSet + + This routine is responsible for setting the residual weight + vector rwt, according to tol_type, as follows: + + (1) rwt[i] = 1 / (reltol * SUNRabs(M*ycur[i]) + rabstol), i=0,...,neq-1 + if tol_type = ARK_SS + (2) rwt[i] = 1 / (reltol * SUNRabs(M*ycur[i]) + rabstol[i]), i=0,...,neq-1 + if tol_type = ARK_SV + (3) unset if tol_type is any other value (occurs rwt=ewt) + + arkRwtSet returns 0 if rwt is successfully set as above to a + positive vector and -1 otherwise. In the latter case, rwt is + considered undefined. + + All the real work is done in the routines arkRwtSetSS, arkRwtSetSV. + ---------------------------------------------------------------*/ +int arkRwtSet(N_Vector y, N_Vector weight, void *data) +{ + ARKodeMem ark_mem; + N_Vector My; + int flag = 0; + + /* data points to ark_mem here */ + ark_mem = (ARKodeMem) data; + + /* return if rwt is just ewt */ + if (ark_mem->rwt_is_ewt) return(0); + + /* put M*y into ark_tempv1 */ + My = ark_mem->tempv1; + if (ark_mem->step_mmult != NULL) { + flag = ark_mem->step_mmult((void *) ark_mem, y, My); + if (flag != ARK_SUCCESS) return (ARK_MASSMULT_FAIL); + } else { /* this condition should not apply, but just in case */ + N_VScale(ONE, y, My); + } + + /* call appropriate routine to fill rwt */ + switch(ark_mem->ritol) { + case ARK_SS: + flag = arkRwtSetSS(ark_mem, My, weight); + break; + case ARK_SV: + flag = arkRwtSetSV(ark_mem, My, weight); + break; + } + + return(flag); +} + + +/*--------------------------------------------------------------- + arkErrHandler is the default error handling function. + It sends the error message to the stream pointed to by ark_errfp + ---------------------------------------------------------------*/ +void arkErrHandler(int error_code, const char *module, + const char *function, char *msg, void *data) +{ + ARKodeMem ark_mem; + char err_type[10]; + + /* data points to ark_mem here */ + ark_mem = (ARKodeMem) data; + + if (error_code == ARK_WARNING) + sprintf(err_type,"WARNING"); + else + sprintf(err_type,"ERROR"); + +#ifndef NO_FPRINTF_OUTPUT + if (ark_mem->errfp!=NULL) { + STAN_SUNDIALS_FPRINTF(ark_mem->errfp,"\n[%s %s] %s\n",module,err_type,function); + STAN_SUNDIALS_FPRINTF(ark_mem->errfp," %s\n\n",msg); + } +#endif + + return; +} + + + +/*=============================================================== + Private Helper Functions + ===============================================================*/ + +/*--------------------------------------------------------------- + arkInit: + + arkInit allocates and initializes memory for a problem. All + inputs are checked for errors. If any error occurs during + initialization, it is reported to the file whose file pointer + is errfp and an error flag is returned. Otherwise, it returns + ARK_SUCCESS. This routine should be called by an ARKode + timestepper module (not by the user). This routine must be + called prior to calling arkEvolve to evolve the problem. The + initialization type indicates if the values of internal counters + should be reinitialized (FIRST_INIT) or retained (RESET_INIT). + ---------------------------------------------------------------*/ +int arkInit(ARKodeMem ark_mem, realtype t0, N_Vector y0, + int init_type) +{ + booleantype stepperOK, nvectorOK, allocOK; + sunindextype lrw1, liw1; + + /* Check ark_mem */ + if (ark_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkInit", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + + /* Check for legal input parameters */ + if (y0 == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkInit", MSG_ARK_NULL_Y0); + return(ARK_ILL_INPUT); + } + + /* Check if reset was called before the first Evolve call */ + if (init_type == RESET_INIT && !(ark_mem->initialized)) + init_type = FIRST_INIT; + + /* Check if allocations have been done i.e., is this first init call */ + if (ark_mem->MallocDone == SUNFALSE) { + + /* Test if all required time stepper operations are implemented */ + stepperOK = arkCheckTimestepper(ark_mem); + if (!stepperOK) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkInit", + "Time stepper module is missing required functionality"); + return(ARK_ILL_INPUT); + } + + /* Test if all required vector operations are implemented */ + nvectorOK = arkCheckNvector(y0); + if (!nvectorOK) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkInit", MSG_ARK_BAD_NVECTOR); + return(ARK_ILL_INPUT); + } + + /* Set space requirements for one N_Vector */ + if (y0->ops->nvspace != NULL) { + N_VSpace(y0, &lrw1, &liw1); + } else { + lrw1 = 0; + liw1 = 0; + } + ark_mem->lrw1 = lrw1; + ark_mem->liw1 = liw1; + + /* Allocate the solver vectors (using y0 as a template) */ + allocOK = arkAllocVectors(ark_mem, y0); + if (!allocOK) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkInit", MSG_ARK_MEM_FAIL); + return(ARK_MEM_FAIL); + } + + /* Create default Hermite interpolation module */ + ark_mem->interp = arkInterpCreate_Hermite(ark_mem, ARK_INTERP_MAX_DEGREE); + if (ark_mem->interp == NULL) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", "arkInit", + "Unable to allocate interpolation module"); + return(ARK_MEM_FAIL); + } + + /* All allocations are complete */ + ark_mem->MallocDone = SUNTRUE; + + } + + /* All allocation and error checking is complete at this point */ + + /* Copy the input parameters into ARKode state */ + ark_mem->tcur = t0; + ark_mem->tn = t0; + + /* Initialize yn */ + N_VScale(ONE, y0, ark_mem->yn); + + /* Initializations on (re-)initialization call, skip on reset */ + if (init_type == FIRST_INIT) { + + /* Counters */ + ark_mem->nst_attempts = 0; + ark_mem->nst = 0; + ark_mem->nhnil = 0; + ark_mem->ncfn = 0; + ark_mem->netf = 0; + ark_mem->nconstrfails = 0; + + /* Initial, old, and next step sizes */ + ark_mem->h0u = ZERO; + ark_mem->hold = ZERO; + ark_mem->next_h = ZERO; + + /* Tolerance scale factor */ + ark_mem->tolsf = ONE; + + /* Adaptivity counters */ + ark_mem->hadapt_mem->nst_acc = 0; + ark_mem->hadapt_mem->nst_exp = 0; + + /* Error and step size history */ + ark_mem->hadapt_mem->ehist[0] = ONE; + ark_mem->hadapt_mem->ehist[1] = ONE; + ark_mem->hadapt_mem->hhist[0] = ZERO; + ark_mem->hadapt_mem->hhist[1] = ZERO; + + /* Indicate that evaluation of the full RHS is not required after each step, + this flag is updated to SUNTRUE by the interpolation module initialization + function and/or the stepper initialization function in arkInitialSetup */ + ark_mem->call_fullrhs = SUNFALSE; + + /* Indicate that initialization has not been done before */ + ark_mem->initialized = SUNFALSE; + } + + /* Indicate initialization is needed */ + ark_mem->initsetup = SUNTRUE; + ark_mem->init_type = init_type; + ark_mem->firststage = SUNTRUE; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkPrintMem: + + This routine outputs the ark_mem structure to a specified file + pointer. + ---------------------------------------------------------------*/ +void arkPrintMem(ARKodeMem ark_mem, FILE *outfile) +{ + /* output general values */ + STAN_SUNDIALS_FPRINTF(outfile, "itol = %i\n", ark_mem->itol); + STAN_SUNDIALS_FPRINTF(outfile, "ritol = %i\n", ark_mem->ritol); + STAN_SUNDIALS_FPRINTF(outfile, "mxhnil = %i\n", ark_mem->mxhnil); + STAN_SUNDIALS_FPRINTF(outfile, "mxstep = %li\n", ark_mem->mxstep); + STAN_SUNDIALS_FPRINTF(outfile, "lrw1 = %li\n", (long int) ark_mem->lrw1); + STAN_SUNDIALS_FPRINTF(outfile, "liw1 = %li\n", (long int) ark_mem->liw1); + STAN_SUNDIALS_FPRINTF(outfile, "lrw = %li\n", (long int) ark_mem->lrw); + STAN_SUNDIALS_FPRINTF(outfile, "liw = %li\n", (long int) ark_mem->liw); + STAN_SUNDIALS_FPRINTF(outfile, "user_efun = %i\n", ark_mem->user_efun); + STAN_SUNDIALS_FPRINTF(outfile, "tstopset = %i\n", ark_mem->tstopset); + STAN_SUNDIALS_FPRINTF(outfile, "tstop = %" RSYM"\n", ark_mem->tstop); + STAN_SUNDIALS_FPRINTF(outfile, "report = %i\n", ark_mem->report); + STAN_SUNDIALS_FPRINTF(outfile, "VabstolMallocDone = %i\n", ark_mem->VabstolMallocDone); + STAN_SUNDIALS_FPRINTF(outfile, "MallocDone = %i\n", ark_mem->MallocDone); + STAN_SUNDIALS_FPRINTF(outfile, "initsetup = %i\n", ark_mem->initsetup); + STAN_SUNDIALS_FPRINTF(outfile, "init_type = %i\n", ark_mem->init_type); + STAN_SUNDIALS_FPRINTF(outfile, "firststage = %i\n", ark_mem->firststage); + STAN_SUNDIALS_FPRINTF(outfile, "uround = %" RSYM"\n", ark_mem->uround); + STAN_SUNDIALS_FPRINTF(outfile, "reltol = %" RSYM"\n", ark_mem->reltol); + STAN_SUNDIALS_FPRINTF(outfile, "Sabstol = %" RSYM"\n", ark_mem->Sabstol); + STAN_SUNDIALS_FPRINTF(outfile, "fixedstep = %i\n", ark_mem->fixedstep); + STAN_SUNDIALS_FPRINTF(outfile, "tolsf = %" RSYM"\n", ark_mem->tolsf); + STAN_SUNDIALS_FPRINTF(outfile, "call_fullrhs = %i\n", ark_mem->call_fullrhs); + + /* output counters */ + STAN_SUNDIALS_FPRINTF(outfile, "nhnil = %i\n", ark_mem->nhnil); + STAN_SUNDIALS_FPRINTF(outfile, "nst_attempts = %li\n", ark_mem->nst_attempts); + STAN_SUNDIALS_FPRINTF(outfile, "nst = %li\n", ark_mem->nst); + STAN_SUNDIALS_FPRINTF(outfile, "ncfn = %li\n", ark_mem->ncfn); + STAN_SUNDIALS_FPRINTF(outfile, "netf = %li\n", ark_mem->netf); + + /* output time-stepping values */ + STAN_SUNDIALS_FPRINTF(outfile, "hin = %" RSYM"\n", ark_mem->hin); + STAN_SUNDIALS_FPRINTF(outfile, "h = %" RSYM"\n", ark_mem->h); + STAN_SUNDIALS_FPRINTF(outfile, "hprime = %" RSYM"\n", ark_mem->hprime); + STAN_SUNDIALS_FPRINTF(outfile, "next_h = %" RSYM"\n", ark_mem->next_h); + STAN_SUNDIALS_FPRINTF(outfile, "eta = %" RSYM"\n", ark_mem->eta); + STAN_SUNDIALS_FPRINTF(outfile, "tcur = %" RSYM"\n", ark_mem->tcur); + STAN_SUNDIALS_FPRINTF(outfile, "tretlast = %" RSYM"\n", ark_mem->tretlast); + STAN_SUNDIALS_FPRINTF(outfile, "hmin = %" RSYM"\n", ark_mem->hmin); + STAN_SUNDIALS_FPRINTF(outfile, "hmax_inv = %" RSYM"\n", ark_mem->hmax_inv); + STAN_SUNDIALS_FPRINTF(outfile, "h0u = %" RSYM"\n", ark_mem->h0u); + STAN_SUNDIALS_FPRINTF(outfile, "tn = %" RSYM"\n", ark_mem->tn); + STAN_SUNDIALS_FPRINTF(outfile, "hold = %" RSYM"\n", ark_mem->hold); + STAN_SUNDIALS_FPRINTF(outfile, "maxnef = %i\n", ark_mem->maxnef); + STAN_SUNDIALS_FPRINTF(outfile, "maxncf = %i\n", ark_mem->maxncf); + + /* output time-stepping adaptivity structure */ + STAN_SUNDIALS_FPRINTF(outfile, "timestep adaptivity structure:\n"); + arkPrintAdaptMem(ark_mem->hadapt_mem, outfile); + + /* output inequality constraints quantities */ + STAN_SUNDIALS_FPRINTF(outfile, "constraintsSet = %i\n", ark_mem->constraintsSet); + STAN_SUNDIALS_FPRINTF(outfile, "maxconstrfails = %i\n", ark_mem->maxconstrfails); + + /* output root-finding quantities */ + if (ark_mem->root_mem != NULL) + (void) arkPrintRootMem((void*) ark_mem, outfile); + + /* output interpolation quantities */ + arkInterpPrintMem(ark_mem->interp, outfile); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + /* output vector quantities */ + STAN_SUNDIALS_FPRINTF(outfile, "Vapbsol:\n"); + N_VPrintFile(ark_mem->Vabstol, outfile); + STAN_SUNDIALS_FPRINTF(outfile, "ewt:\n"); + N_VPrintFile(ark_mem->ewt, outfile); + if (!ark_mem->rwt_is_ewt) { + STAN_SUNDIALS_FPRINTF(outfile, "rwt:\n"); + N_VPrintFile(ark_mem->rwt, outfile); + } + STAN_SUNDIALS_FPRINTF(outfile, "ycur:\n"); + N_VPrintFile(ark_mem->ycur, outfile); + STAN_SUNDIALS_FPRINTF(outfile, "yn:\n"); + N_VPrintFile(ark_mem->yn, outfile); + STAN_SUNDIALS_FPRINTF(outfile, "fn:\n"); + N_VPrintFile(ark_mem->fn, outfile); + STAN_SUNDIALS_FPRINTF(outfile, "tempv1:\n"); + N_VPrintFile(ark_mem->tempv1, outfile); + STAN_SUNDIALS_FPRINTF(outfile, "tempv2:\n"); + N_VPrintFile(ark_mem->tempv2, outfile); + STAN_SUNDIALS_FPRINTF(outfile, "tempv3:\n"); + N_VPrintFile(ark_mem->tempv3, outfile); + STAN_SUNDIALS_FPRINTF(outfile, "tempv4:\n"); + N_VPrintFile(ark_mem->tempv4, outfile); + STAN_SUNDIALS_FPRINTF(outfile, "constraints:\n"); + N_VPrintFile(ark_mem->constraints, outfile); +#endif + +} + + +/*--------------------------------------------------------------- + arkCheckTimestepper: + + This routine checks if all required time stepper function + pointers have been supplied. If any of them is missing it + returns SUNFALSE. + ---------------------------------------------------------------*/ +booleantype arkCheckTimestepper(ARKodeMem ark_mem) +{ + if ( (ark_mem->step_init == NULL) || + (ark_mem->step == NULL) || + (ark_mem->step_mem == NULL) || + (ark_mem->step_fullrhs == NULL) ) + return(SUNFALSE); + return(SUNTRUE); +} + + +/*--------------------------------------------------------------- + arkCheckNvector: + + This routine checks if all required vector operations are + present. If any of them is missing it returns SUNFALSE. + ---------------------------------------------------------------*/ +booleantype arkCheckNvector(N_Vector tmpl) /* to be updated?? */ +{ + if ((tmpl->ops->nvclone == NULL) || + (tmpl->ops->nvdestroy == NULL) || + (tmpl->ops->nvlinearsum == NULL) || + (tmpl->ops->nvconst == NULL) || + (tmpl->ops->nvdiv == NULL) || + (tmpl->ops->nvscale == NULL) || + (tmpl->ops->nvabs == NULL) || + (tmpl->ops->nvinv == NULL) || + (tmpl->ops->nvaddconst == NULL) || + (tmpl->ops->nvmaxnorm == NULL) || + (tmpl->ops->nvwrmsnorm == NULL)) + return(SUNFALSE); + else + return(SUNTRUE); +} + + +/*--------------------------------------------------------------- + arkAllocVec and arkAllocVecArray: + + These routines allocate (respectively) single vector or a vector + array based on a template vector. If the target vector or vector + array already exists it is left alone; otherwise it is allocated + by cloning the input vector. + + This routine also updates the optional outputs lrw and liw, which + are (respectively) the lengths of the overall ARKode real and + integer work spaces. + + SUNTRUE is returned if the allocation is successful (or if the + target vector or vector array already exists) otherwise SUNFALSE + is retured. + ---------------------------------------------------------------*/ +booleantype arkAllocVec(ARKodeMem ark_mem, N_Vector tmpl, N_Vector *v) +{ + /* allocate the new vector if necessary */ + if (*v == NULL) { + *v = N_VClone(tmpl); + if (*v == NULL) { + arkFreeVectors(ark_mem); + return(SUNFALSE); + } else { + ark_mem->lrw += ark_mem->lrw1; + ark_mem->liw += ark_mem->liw1; + } + } + return (SUNTRUE); +} + + +booleantype arkAllocVecArray(int count, N_Vector tmpl, N_Vector **v, + sunindextype lrw1, long int *lrw, + sunindextype liw1, long int *liw) +{ + /* allocate the new vector array if necessary */ + if (*v == NULL) { + *v = N_VCloneVectorArray(count, tmpl); + if (*v == NULL) return(SUNFALSE); + *lrw += count * lrw1; + *liw += count * liw1; + } + return (SUNTRUE); +} + + +/*--------------------------------------------------------------- + arkFreeVec and arkFreeVecArray: + + These routines (respectively) free a single vector or a vector + array. If the target vector or vector array is already NULL it + is left alone; otherwise it is freed and the optional outputs + lrw and liw are updated accordingly. + ---------------------------------------------------------------*/ +void arkFreeVec(ARKodeMem ark_mem, N_Vector *v) +{ + if (*v != NULL) { + N_VDestroy(*v); + *v = NULL; + ark_mem->lrw -= ark_mem->lrw1; + ark_mem->liw -= ark_mem->liw1; + } +} + + +void arkFreeVecArray(int count, N_Vector **v, + sunindextype lrw1, long int *lrw, + sunindextype liw1, long int *liw) +{ + if (*v != NULL) { + N_VDestroyVectorArray(*v, count); + *v = NULL; + *lrw -= count * lrw1; + *liw -= count * liw1; + } +} + + +/*--------------------------------------------------------------- + arkResizeVec and arkResizeVecArray: + + This routines (respectively) resize a single vector or a vector + array based on a template vector. If the ARKVecResizeFn function + is non-NULL, then it calls that routine to perform the resize; + otherwise it deallocates and reallocates the target vector or + vector array based on the template vector. These routines also + updates the optional outputs lrw and liw, which are + (respectively) the lengths of the overall ARKode real and + integer work spaces. + + SUNTRUE is returned if the resize is successful otherwise + SUNFALSE is retured. + ---------------------------------------------------------------*/ +booleantype arkResizeVec(ARKodeMem ark_mem, ARKVecResizeFn resize, + void *resize_data, sunindextype lrw_diff, + sunindextype liw_diff, N_Vector tmpl, N_Vector *v) +{ + if (*v != NULL) { + if (resize == NULL) { + N_VDestroy(*v); + *v = NULL; + *v = N_VClone(tmpl); + if (*v == NULL) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkResizeVec", "Unable to clone vector"); + return(SUNFALSE); + } + } else { + if (resize(*v, tmpl, resize_data)) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkResizeVec", MSG_ARK_RESIZE_FAIL); + return(SUNFALSE); + } + } + ark_mem->lrw += lrw_diff; + ark_mem->liw += liw_diff; + } + return(SUNTRUE); +} + + +booleantype arkResizeVecArray(ARKVecResizeFn resize, void *resize_data, + int count, N_Vector tmpl, N_Vector **v, + sunindextype lrw_diff, long int *lrw, + sunindextype liw_diff, long int *liw) +{ + int i; + + if (*v != NULL) { + if (resize == NULL) { + N_VDestroyVectorArray(*v, count); + *v = NULL; + *v = N_VCloneVectorArray(count, tmpl); + if (*v == NULL) return(SUNFALSE); + } else { + for (i = 0; i < count; i++) { + if (resize((*v)[i], tmpl, resize_data)) return(SUNFALSE); + } + } + *lrw += count * lrw_diff; + *liw += count * liw_diff; + } + return(SUNTRUE); +} + + +/*--------------------------------------------------------------- + arkAllocVectors: + + This routine allocates the ARKode vectors ewt, yn, tempv* and + ftemp. If any of these vectors already exist, they are left + alone. Otherwise, it will allocate each vector by cloning the + input vector. This routine also updates the optional outputs + lrw and liw, which are (respectively) the lengths of the real + and integer work spaces. + + If all memory allocations are successful, arkAllocVectors + returns SUNTRUE, otherwise it returns SUNFALSE. + ---------------------------------------------------------------*/ +booleantype arkAllocVectors(ARKodeMem ark_mem, N_Vector tmpl) +{ + /* Allocate ewt if needed */ + if (!arkAllocVec(ark_mem, tmpl, &ark_mem->ewt)) + return(SUNFALSE); + + /* Set rwt to point at ewt */ + if (ark_mem->rwt_is_ewt) + ark_mem->rwt = ark_mem->ewt; + + /* Allocate yn if needed */ + if (!arkAllocVec(ark_mem, tmpl, &ark_mem->yn)) + return(SUNFALSE); + + /* Allocate fn if needed */ + if (!arkAllocVec(ark_mem, tmpl, &ark_mem->fn)) + return(SUNFALSE); + + /* Allocate tempv1 if needed */ + if (!arkAllocVec(ark_mem, tmpl, &ark_mem->tempv1)) + return(SUNFALSE); + + /* Allocate tempv2 if needed */ + if (!arkAllocVec(ark_mem, tmpl, &ark_mem->tempv2)) + return(SUNFALSE); + + /* Allocate tempv3 if needed */ + if (!arkAllocVec(ark_mem, tmpl, &ark_mem->tempv3)) + return(SUNFALSE); + + /* Allocate tempv4 if needed */ + if (!arkAllocVec(ark_mem, tmpl, &ark_mem->tempv4)) + return(SUNFALSE); + + return(SUNTRUE); +} + +/*--------------------------------------------------------------- + arkResizeVectors: + + This routine resizes all ARKode vectors if they exist, + otherwise they are left alone. If a resize function is provided + it is called to resize the vectors otherwise the vector is + freed and a new vector is created by cloning in input vector. + This routine also updates the optional outputs lrw and liw, + which are (respectively) the lengths of the real and integer + work spaces. + + If all memory allocations are successful, arkResizeVectors + returns SUNTRUE, otherwise it returns SUNFALSE. + ---------------------------------------------------------------*/ +booleantype arkResizeVectors(ARKodeMem ark_mem, ARKVecResizeFn resize, + void *resize_data, sunindextype lrw_diff, + sunindextype liw_diff, N_Vector tmpl) +{ + /* Vabstol */ + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, tmpl, &ark_mem->Vabstol)) + return(SUNFALSE); + + /* VRabstol */ + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, tmpl, &ark_mem->VRabstol)) + return(SUNFALSE); + + /* ewt */ + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, tmpl, &ark_mem->ewt)) + return(SUNFALSE); + + /* rwt */ + if (ark_mem->rwt_is_ewt) { /* update pointer to ewt */ + ark_mem->rwt = ark_mem->ewt; + } else { /* resize if distinct from ewt */ + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, tmpl, &ark_mem->rwt)) + return(SUNFALSE); + } + + /* yn */ + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, tmpl, &ark_mem->yn)) + return(SUNFALSE); + + /* fn */ + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, tmpl, &ark_mem->fn)) + return(SUNFALSE); + + /* tempv* */ + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, tmpl, &ark_mem->tempv1)) + return(SUNFALSE); + + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, tmpl, &ark_mem->tempv2)) + return(SUNFALSE); + + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, tmpl, &ark_mem->tempv3)) + return(SUNFALSE); + + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, tmpl, &ark_mem->tempv4)) + return(SUNFALSE); + + /* constraints */ + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, tmpl, &ark_mem->constraints)) + return(SUNFALSE); + + return(SUNTRUE); +} + + +/*--------------------------------------------------------------- + arkFreeVectors + + This routine frees the ARKode vectors allocated in both + arkAllocVectors and arkAllocRKVectors. + ---------------------------------------------------------------*/ +void arkFreeVectors(ARKodeMem ark_mem) +{ + arkFreeVec(ark_mem, &ark_mem->ewt); + if (!ark_mem->rwt_is_ewt) + arkFreeVec(ark_mem, &ark_mem->rwt); + arkFreeVec(ark_mem, &ark_mem->tempv1); + arkFreeVec(ark_mem, &ark_mem->tempv2); + arkFreeVec(ark_mem, &ark_mem->tempv3); + arkFreeVec(ark_mem, &ark_mem->tempv4); + arkFreeVec(ark_mem, &ark_mem->yn); + arkFreeVec(ark_mem, &ark_mem->fn); + arkFreeVec(ark_mem, &ark_mem->Vabstol); + arkFreeVec(ark_mem, &ark_mem->constraints); +} + + +/*--------------------------------------------------------------- + arkInitialSetup + + This routine performs all necessary items to prepare ARKode for + the first internal step after initialization, reinitialization, + a reset() call, or a resize() call, including: + - input consistency checks + - (re)initializes the stepper + - computes error and residual weights + - (re)initialize the interpolation structure + - checks for valid initial step input or estimates first step + - checks for approach to tstop + - checks for root near t0 + ---------------------------------------------------------------*/ +int arkInitialSetup(ARKodeMem ark_mem, realtype tout) +{ + int retval, hflag, istate; + realtype tout_hin, rh, htmp; + booleantype conOK; + + /* Set up the time stepper module */ + if (ark_mem->step_init == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkInitialSetup", "Time stepper module is missing"); + return(ARK_ILL_INPUT); + } + retval = ark_mem->step_init(ark_mem, ark_mem->init_type); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode", "arkInitialSetup", + "Error in initialization of time stepper module"); + return(retval); + } + + /* Check that user has supplied an initial step size if fixedstep mode is on */ + if ( (ark_mem->fixedstep) && (ark_mem->hin == ZERO) ) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkInitialSetup", + "Fixed step mode enabled, but no step size set"); + return(ARK_ILL_INPUT); + } + + /* If using a built-in routine for error/residual weights with abstol==0, + ensure that N_VMin is available */ + if ((!ark_mem->user_efun) && (ark_mem->atolmin0) && (!ark_mem->yn->ops->nvmin)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkInitialSetup", + "N_VMin unimplemented (required by error-weight function)"); + return(ARK_ILL_INPUT); + } + if ( (!ark_mem->user_rfun) && (!ark_mem->rwt_is_ewt) && + (ark_mem->Ratolmin0) && (!ark_mem->yn->ops->nvmin) ) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkInitialSetup", + "N_VMin unimplemented (required by residual-weight function)"); + return(ARK_ILL_INPUT); + } + + /* Test input tstop for legality (correct direction of integration) */ + if ( ark_mem->tstopset ) { + htmp = (ark_mem->h == ZERO) ? tout - ark_mem->tcur : ark_mem->h; + if ( (ark_mem->tstop - ark_mem->tcur) * htmp <= ZERO ) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkInitialSetup", + MSG_ARK_BAD_TSTOP, ark_mem->tstop, ark_mem->tcur); + return(ARK_ILL_INPUT); + } + } + + /* Check to see if y0 satisfies constraints */ + if (ark_mem->constraintsSet) { + conOK = N_VConstrMask(ark_mem->constraints, ark_mem->yn, ark_mem->tempv1); + if (!conOK) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkInitialSetup", MSG_ARK_Y0_FAIL_CONSTR); + return(ARK_ILL_INPUT); + } + } + + /* Load initial error weights */ + retval = ark_mem->efun(ark_mem->yn, ark_mem->ewt, ark_mem->e_data); + if (retval != 0) { + if (ark_mem->itol == ARK_WF) + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkInitialSetup", MSG_ARK_EWT_FAIL); + else + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkInitialSetup", MSG_ARK_BAD_EWT); + return(ARK_ILL_INPUT); + } + + /* Load initial residual weights */ + if (ark_mem->rwt_is_ewt) { /* update pointer to ewt */ + ark_mem->rwt = ark_mem->ewt; + } else { + retval = ark_mem->rfun(ark_mem->yn, ark_mem->rwt, ark_mem->r_data); + if (retval != 0) { + if (ark_mem->itol == ARK_WF) + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkInitialSetup", MSG_ARK_RWT_FAIL); + else + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkInitialSetup", MSG_ARK_BAD_RWT); + return(ARK_ILL_INPUT); + } + } + + /* If necessary, temporarily set h as it is used to compute the tolerance in a + potential mass matrix solve when computing the full rhs */ + if (ark_mem->h == ZERO) ark_mem->h = ONE; + + /* Call fullrhs (used in estimating initial step, explicit steppers, Hermite + interpolation module, and possibly (but not always) arkRootCheck1) */ + retval = ark_mem->step_fullrhs(ark_mem, ark_mem->tcur, ark_mem->yn, + ark_mem->fn, ARK_FULLRHS_START); + if (retval != 0) return(ARK_RHSFUNC_FAIL); + + /* Fill initial interpolation data (if needed) */ + if (ark_mem->interp != NULL) { + retval = arkInterpInit(ark_mem, ark_mem->interp, ark_mem->tcur); + if (retval != 0) return(retval); + } + + /* initialization complete */ + ark_mem->initialized = SUNTRUE; + + /* Set initial step size */ + if (ark_mem->h0u == ZERO) { + + /* Check input h for validity */ + ark_mem->h = ark_mem->hin; + if ( (ark_mem->h != ZERO) && + ((tout-ark_mem->tcur)*ark_mem->h < ZERO) ) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkInitialSetup", + MSG_ARK_BAD_H0); + return(ARK_ILL_INPUT); + } + + /* Estimate initial h if not set */ + if (ark_mem->h == ZERO) { + /* Again, temporarily set h for estimating an optimal value */ + ark_mem->h = SUNRabs(tout - ark_mem->tcur); + if (ark_mem->h == ZERO) ark_mem->h = ONE; + /* Estimate the first step size */ + tout_hin = tout; + if ( ark_mem->tstopset && + (tout-ark_mem->tcur)*(tout-ark_mem->tstop) > ZERO ) + tout_hin = ark_mem->tstop; + hflag = arkHin(ark_mem, tout_hin); + if (hflag != ARK_SUCCESS) { + istate = arkHandleFailure(ark_mem, hflag); + return(istate); + } + /* Use first step growth factor for estimated h */ + ark_mem->hadapt_mem->etamax = ark_mem->hadapt_mem->etamx1; + } else if (ark_mem->nst == 0) { + /* Use first step growth factor for user defined h */ + ark_mem->hadapt_mem->etamax = ark_mem->hadapt_mem->etamx1; + } else { + /* Use standard growth factor (e.g., for reset) */ + ark_mem->hadapt_mem->etamax = ark_mem->hadapt_mem->growth; + } + + /* Enforce step size bounds */ + rh = SUNRabs(ark_mem->h)*ark_mem->hmax_inv; + if (rh > ONE) ark_mem->h /= rh; + if (SUNRabs(ark_mem->h) < ark_mem->hmin) + ark_mem->h *= ark_mem->hmin/SUNRabs(ark_mem->h); + + /* Check for approach to tstop */ + if (ark_mem->tstopset) { + if ( (ark_mem->tcur + ark_mem->h - ark_mem->tstop)*ark_mem->h > ZERO ) { + ark_mem->h = (ark_mem->tstop - ark_mem->tcur)*(ONE-FOUR*ark_mem->uround); + } + } + + /* Set initial time step factors */ + ark_mem->h0u = ark_mem->h; + ark_mem->eta = ONE; + ark_mem->hprime = ark_mem->h; + } else { + /* If next step would overtake tstop, adjust stepsize */ + if ( (ark_mem->tcur + ark_mem->hprime - ark_mem->tstop)*ark_mem->h > ZERO ) { + ark_mem->hprime = (ark_mem->tstop - ark_mem->tcur)*(ONE-FOUR*ark_mem->uround); + ark_mem->eta = ark_mem->hprime/ark_mem->h; + } + } + + /* Check for zeros of root function g at and near t0. */ + if (ark_mem->root_mem != NULL) { + if (ark_mem->root_mem->nrtfn > 0) { + retval = arkRootCheck1((void*) ark_mem); + + if (retval == ARK_RTFUNC_FAIL) { + arkProcessError(ark_mem, ARK_RTFUNC_FAIL, "ARKode", "arkRootCheck1", + MSG_ARK_RTFUNC_FAILED, ark_mem->tcur); + return(ARK_RTFUNC_FAIL); + } + } + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStopTests + + This routine performs relevant stopping tests: + - check for root in last step + - check if we passed tstop + - check if we passed tout (NORMAL mode) + - check if current tn was returned (ONE_STEP mode) + - check if we are close to tstop + (adjust step size if needed) + ---------------------------------------------------------------*/ +int arkStopTests(ARKodeMem ark_mem, realtype tout, N_Vector yout, + realtype *tret, int itask, int *ier) +{ + int irfndp, retval; + realtype troundoff; + + /* Estimate an infinitesimal time interval to be used as + a roundoff for time quantities (based on current time + and step size) */ + troundoff = FUZZ_FACTOR*ark_mem->uround * + (SUNRabs(ark_mem->tcur) + SUNRabs(ark_mem->h)); + + /* First, check for a root in the last step taken, other than the + last root found, if any. If itask = ARK_ONE_STEP and y(tn) was not + returned because of an intervening root, return y(tn) now. */ + if (ark_mem->root_mem != NULL) + if (ark_mem->root_mem->nrtfn > 0) { + + /* Shortcut to roots found in previous step */ + irfndp = ark_mem->root_mem->irfnd; + + /* If the full rhs was not computed in the last call to arkCompleteStep + and roots were found in the previous step, then compute the full rhs + for possible use in arkRootCheck2 (not always necessary) */ + if (!(ark_mem->call_fullrhs) && irfndp != 0) { + retval = ark_mem->step_fullrhs(ark_mem, ark_mem->tcur, ark_mem->yn, + ark_mem->fn, ARK_FULLRHS_END); + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode", "arkStopTests", + MSG_ARK_RHSFUNC_FAILED); + *ier = ARK_RHSFUNC_FAIL; + return(1); + } + } + + retval = arkRootCheck2((void*) ark_mem); + + if (retval == CLOSERT) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkStopTests", + MSG_ARK_CLOSE_ROOTS, ark_mem->root_mem->tlo); + *ier = ARK_ILL_INPUT; + return(1); + } else if (retval == ARK_RTFUNC_FAIL) { + arkProcessError(ark_mem, ARK_RTFUNC_FAIL, "ARKode", "arkStopTests", + MSG_ARK_RTFUNC_FAILED, ark_mem->root_mem->tlo); + *ier = ARK_RTFUNC_FAIL; + return(1); + } else if (retval == RTFOUND) { + ark_mem->tretlast = *tret = ark_mem->root_mem->tlo; + *ier = ARK_ROOT_RETURN; + return(1); + } + + /* If tn is distinct from tretlast (within roundoff), + check remaining interval for roots */ + if ( SUNRabs(ark_mem->tcur - ark_mem->tretlast) > troundoff ) { + + retval = arkRootCheck3((void*) ark_mem); + + if (retval == ARK_SUCCESS) { /* no root found */ + ark_mem->root_mem->irfnd = 0; + if ((irfndp == 1) && (itask == ARK_ONE_STEP)) { + ark_mem->tretlast = *tret = ark_mem->tcur; + N_VScale(ONE, ark_mem->yn, yout); + *ier = ARK_SUCCESS; + return(1); + } + } else if (retval == RTFOUND) { /* a new root was found */ + ark_mem->root_mem->irfnd = 1; + ark_mem->tretlast = *tret = ark_mem->root_mem->tlo; + *ier = ARK_ROOT_RETURN; + return(1); + } else if (retval == ARK_RTFUNC_FAIL) { /* g failed */ + arkProcessError(ark_mem, ARK_RTFUNC_FAIL, "ARKode", "arkStopTests", + MSG_ARK_RTFUNC_FAILED, ark_mem->root_mem->tlo); + *ier = ARK_RTFUNC_FAIL; + return(1); + } + } + + } /* end of root stop check */ + + /* In ARK_NORMAL mode, test if tout was reached */ + if ( (itask == ARK_NORMAL) && + ((ark_mem->tcur-tout)*ark_mem->h >= ZERO) ) { + ark_mem->tretlast = *tret = tout; + *ier = arkGetDky(ark_mem, tout, 0, yout); + if (*ier != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkStopTests", MSG_ARK_BAD_TOUT, tout); + *ier = ARK_ILL_INPUT; + return(1); + } + *ier = ARK_SUCCESS; + return(1); + } + + /* In ARK_ONE_STEP mode, test if tn was returned */ + if ( itask == ARK_ONE_STEP && + SUNRabs(ark_mem->tcur - ark_mem->tretlast) > troundoff ) { + ark_mem->tretlast = *tret = ark_mem->tcur; + N_VScale(ONE, ark_mem->yn, yout); + *ier = ARK_SUCCESS; + return(1); + } + + /* Test for tn at tstop or near tstop */ + if ( ark_mem->tstopset ) { + + if ( SUNRabs(ark_mem->tcur - ark_mem->tstop) <= troundoff) { + *ier = arkGetDky(ark_mem, ark_mem->tstop, 0, yout); + if (*ier != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkStopTests", + MSG_ARK_BAD_TSTOP, ark_mem->tstop, ark_mem->tcur); + *ier = ARK_ILL_INPUT; + return(1); + } + ark_mem->tretlast = *tret = ark_mem->tstop; + ark_mem->tstopset = SUNFALSE; + *ier = ARK_TSTOP_RETURN; + return(1); + } + + /* If next step would overtake tstop, adjust stepsize */ + if ( (ark_mem->tcur + ark_mem->hprime - ark_mem->tstop)*ark_mem->h > ZERO ) { + ark_mem->hprime = (ark_mem->tstop - ark_mem->tcur)*(ONE-FOUR*ark_mem->uround); + ark_mem->eta = ark_mem->hprime/ark_mem->h; + } + } + + return(0); +} + + +/*--------------------------------------------------------------- + arkHin + + This routine computes a tentative initial step size h0. + If tout is too close to tn (= t0), then arkHin returns + ARK_TOO_CLOSE and h remains uninitialized. Note that here tout + is either the value passed to arkEvolve at the first call or the + value of tstop (if tstop is enabled and it is closer to t0=tn + than tout). If the RHS function fails unrecoverably, arkHin + returns ARK_RHSFUNC_FAIL. If the RHS function fails recoverably + too many times and recovery is not possible, arkHin returns + ARK_REPTD_RHSFUNC_ERR. Otherwise, arkHin sets h to the chosen + value h0 and returns ARK_SUCCESS. + + The algorithm used seeks to find h0 as a solution of + (WRMS norm of (h0^2 ydd / 2)) = 1, + where ydd = estimated second derivative of y. Although this + choice is based on an error expansion of the Backward Euler + method, and hence results in an overly-conservative time step + for our higher-order ARK methods, it does find an order-of- + magnitude estimate of the initial time scale of the solution. + Since this method is only used on the first time step, the + additional caution will not overly hinder solver efficiency. + + We start with an initial estimate equal to the geometric mean + of the lower and upper bounds on the step size. + + Loop up to H0_ITERS times to find h0. + Stop if new and previous values differ by a factor < 2. + Stop if hnew/hg > 2 after one iteration, as this probably + means that the ydd value is bad because of cancellation error. + + For each new proposed hg, we allow H0_ITERS attempts to + resolve a possible recoverable failure from f() by reducing + the proposed stepsize by a factor of 0.2. If a legal stepsize + still cannot be found, fall back on a previous value if + possible, or else return ARK_REPTD_RHSFUNC_ERR. + + Finally, we apply a bias (0.5) and verify that h0 is within + bounds. + ---------------------------------------------------------------*/ +int arkHin(ARKodeMem ark_mem, realtype tout) +{ + int retval, sign, count1, count2; + realtype tdiff, tdist, tround, hlb, hub; + realtype hg, hgs, hs, hnew, hrat, h0, yddnrm; + booleantype hgOK; + + /* If tout is too close to tn, give up */ + if ((tdiff = tout-ark_mem->tcur) == ZERO) return(ARK_TOO_CLOSE); + + sign = (tdiff > ZERO) ? 1 : -1; + tdist = SUNRabs(tdiff); + tround = ark_mem->uround * SUNMAX(SUNRabs(ark_mem->tcur), SUNRabs(tout)); + + if (tdist < TWO*tround) return(ARK_TOO_CLOSE); + + /* Set lower and upper bounds on h0, and take geometric mean + as first trial value. + Exit with this value if the bounds cross each other. */ + hlb = H0_LBFACTOR * tround; + hub = arkUpperBoundH0(ark_mem, tdist); + + hg = SUNRsqrt(hlb*hub); + + if (hub < hlb) { + if (sign == -1) ark_mem->h = -hg; + else ark_mem->h = hg; + return(ARK_SUCCESS); + } + + /* Outer loop */ + hs = hg; /* safeguard against 'uninitialized variable' warning */ + for(count1 = 1; count1 <= H0_ITERS; count1++) { + + /* Attempts to estimate ydd */ + hgOK = SUNFALSE; + + for (count2 = 1; count2 <= H0_ITERS; count2++) { + hgs = hg*sign; + retval = arkYddNorm(ark_mem, hgs, &yddnrm); + /* If f() failed unrecoverably, give up */ + if (retval < 0) return(ARK_RHSFUNC_FAIL); + /* If successful, we can use ydd */ + if (retval == ARK_SUCCESS) {hgOK = SUNTRUE; break;} + /* f() failed recoverably; cut step size and test it again */ + hg *= RCONST(0.2); + } + + /* If f() failed recoverably H0_ITERS times */ + if (!hgOK) { + /* Exit if this is the first or second pass. No recovery possible */ + if (count1 <= 2) return(ARK_REPTD_RHSFUNC_ERR); + /* We have a fall-back option. The value hs is a previous hnew which + passed through f(). Use it and break */ + hnew = hs; + break; + } + + /* The proposed step size is feasible. Save it. */ + hs = hg; + + /* Propose new step size */ + hnew = (yddnrm*hub*hub > TWO) ? SUNRsqrt(TWO/yddnrm) : SUNRsqrt(hg*hub); + + /* If last pass, stop now with hnew */ + if (count1 == H0_ITERS) break; + + hrat = hnew/hg; + + /* Accept hnew if it does not differ from hg by more than a factor of 2 */ + if ((hrat > HALF) && (hrat < TWO)) break; + + /* After one pass, if ydd seems to be bad, use fall-back value. */ + if ((count1 > 1) && (hrat > TWO)) { + hnew = hg; + break; + } + + /* Send this value back through f() */ + hg = hnew; + } + + /* Apply bounds, bias factor, and attach sign */ + h0 = H0_BIAS*hnew; + if (h0 < hlb) h0 = hlb; + if (h0 > hub) h0 = hub; + if (sign == -1) h0 = -h0; + ark_mem->h = h0; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkUpperBoundH0 + + This routine sets an upper bound on abs(h0) based on + tdist = tn - t0 and the values of y[i]/y'[i]. + ---------------------------------------------------------------*/ +realtype arkUpperBoundH0(ARKodeMem ark_mem, realtype tdist) +{ + realtype hub_inv, hub; + N_Vector temp1, temp2; + + /* Bound based on |y0|/|y0'| -- allow at most an increase of + * H0_UBFACTOR in y0 (based on a forward Euler step). The weight + * factor is used as a safeguard against zero components in y0. */ + temp1 = ark_mem->tempv1; + temp2 = ark_mem->tempv2; + + N_VAbs(ark_mem->yn, temp2); + ark_mem->efun(ark_mem->yn, temp1, ark_mem->e_data); + N_VInv(temp1, temp1); + N_VLinearSum(H0_UBFACTOR, temp2, ONE, temp1, temp1); + + N_VAbs(ark_mem->fn, temp2); + + N_VDiv(temp2, temp1, temp1); + hub_inv = N_VMaxNorm(temp1); + + /* bound based on tdist -- allow at most a step of magnitude + * H0_UBFACTOR * tdist */ + hub = H0_UBFACTOR*tdist; + + /* Use the smaller of the two */ + if (hub*hub_inv > ONE) hub = ONE/hub_inv; + + return(hub); +} + + +/*--------------------------------------------------------------- + arkYddNorm + + This routine computes an estimate of the second derivative of y + using a difference quotient, and returns its WRMS norm. + ---------------------------------------------------------------*/ +int arkYddNorm(ARKodeMem ark_mem, realtype hg, realtype *yddnrm) +{ + int retval; + + if (ark_mem->interp == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", "arkYddNorm", + "Missing interpolation structure"); + return(ARK_MEM_NULL); + } + + /* increment y with a multiple of f */ + N_VLinearSum(hg, ark_mem->fn, ONE, ark_mem->yn, ark_mem->ycur); + + /* compute y', via the ODE RHS routine */ + retval = ark_mem->step_fullrhs(ark_mem, ark_mem->tcur + hg, ark_mem->ycur, + ark_mem->tempv1, ARK_FULLRHS_OTHER); + if (retval != 0) return(ARK_RHSFUNC_FAIL); + + /* difference new f and original f to estimate y'' */ + N_VLinearSum(ONE/hg, ark_mem->tempv1, -ONE/hg, ark_mem->fn, ark_mem->tempv1); + + /* reset ycur to equal yn (unnecessary?) */ + N_VScale(ONE, ark_mem->yn, ark_mem->ycur); + + /* compute norm of y'' */ + *yddnrm = N_VWrmsNorm(ark_mem->tempv1, ark_mem->ewt); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkCompleteStep + + This routine performs various update operations when the step + solution is complete. It is assumed that the timestepper + module has stored the time-evolved solution in ark_mem->ycur, + and the step that gave rise to this solution in ark_mem->h. + We update the current time (tn), the current solution (yn), + increment the overall step counter nst, record the values hold + and tnew, allow for user-provided postprocessing, and update + the interpolation structure. + ---------------------------------------------------------------*/ +int arkCompleteStep(ARKodeMem ark_mem, realtype dsm) +{ + int retval, mode; + realtype troundoff; + + /* Set current time to the end of the step (in case the last + stage time does not coincide with the step solution time). + If tstop is enabled, it is possible for tn + h to be past + tstop by roundoff, and in that case, we reset tn (after + incrementing by h) to tstop. */ + ark_mem->tcur = ark_mem->tn + ark_mem->h; + if ( ark_mem->tstopset ) { + troundoff = FUZZ_FACTOR * ark_mem->uround * + (SUNRabs(ark_mem->tcur) + SUNRabs(ark_mem->h)); + if ( SUNRabs(ark_mem->tcur - ark_mem->tstop) <= troundoff) + ark_mem->tcur = ark_mem->tstop; + } + +#ifdef SUNDIALS_DEBUG + STAN_SUNDIALS_PRINTF("ARKODE end step %li, h = %"RSYM", t_n = %"RSYM"\n", + ark_mem->nst, ark_mem->h, ark_mem->tcur); +#endif + + /* apply user-supplied step postprocessing function (if supplied) */ + if (ark_mem->ProcessStep != NULL) { + retval = ark_mem->ProcessStep(ark_mem->tcur, + ark_mem->ycur, + ark_mem->ps_data); + if (retval != 0) return(ARK_POSTPROCESS_STEP_FAIL); + } + + /* update interpolation structure */ + if (ark_mem->interp != NULL) { + retval = arkInterpUpdate(ark_mem, ark_mem->interp, ark_mem->tcur); + if (retval != ARK_SUCCESS) return(retval); + } + + /* call fullrhs if needed */ + if (ark_mem->call_fullrhs) { + mode = (ark_mem->ProcessStep != NULL) ? ARK_FULLRHS_START : ARK_FULLRHS_END; + retval = ark_mem->step_fullrhs(ark_mem, ark_mem->tcur, ark_mem->ycur, + ark_mem->fn, mode); + if (retval != 0) return(ARK_RHSFUNC_FAIL); + } + + /* update yn to current solution */ + N_VScale(ONE, ark_mem->ycur, ark_mem->yn); + + /* Update step size and error history arrays */ + ark_mem->hadapt_mem->ehist[1] = ark_mem->hadapt_mem->ehist[0]; + ark_mem->hadapt_mem->ehist[0] = dsm*ark_mem->hadapt_mem->bias; + ark_mem->hadapt_mem->hhist[1] = ark_mem->hadapt_mem->hhist[0]; + ark_mem->hadapt_mem->hhist[0] = ark_mem->h; + + /* update scalar quantities */ + ark_mem->nst++; + ark_mem->hold = ark_mem->h; + ark_mem->tn = ark_mem->tcur; + ark_mem->hprime = ark_mem->h * ark_mem->eta; + + /* Reset growth factor for subsequent time step */ + ark_mem->hadapt_mem->etamax = ark_mem->hadapt_mem->growth; + + /* Turn off flag indicating initial step and first stage */ + ark_mem->initsetup = SUNFALSE; + ark_mem->firststage = SUNFALSE; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkHandleFailure + + This routine prints error messages for all cases of failure by + arkHin and ark_step. It returns to ARKode the value that ARKode + is to return to the user. + ---------------------------------------------------------------*/ +int arkHandleFailure(ARKodeMem ark_mem, int flag) +{ + + /* Depending on flag, print error message and return error flag */ + switch (flag) { + case ARK_ERR_FAILURE: + arkProcessError(ark_mem, ARK_ERR_FAILURE, "ARKode", "ARKode", + MSG_ARK_ERR_FAILS, ark_mem->tcur, ark_mem->h); + break; + case ARK_CONV_FAILURE: + arkProcessError(ark_mem, ARK_CONV_FAILURE, "ARKode", "ARKode", + MSG_ARK_CONV_FAILS, ark_mem->tcur, ark_mem->h); + break; + case ARK_LSETUP_FAIL: + arkProcessError(ark_mem, ARK_LSETUP_FAIL, "ARKode", "ARKode", + MSG_ARK_SETUP_FAILED, ark_mem->tcur); + break; + case ARK_LSOLVE_FAIL: + arkProcessError(ark_mem, ARK_LSOLVE_FAIL, "ARKode", "ARKode", + MSG_ARK_SOLVE_FAILED, ark_mem->tcur); + break; + case ARK_RHSFUNC_FAIL: + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode", "ARKode", + MSG_ARK_RHSFUNC_FAILED, ark_mem->tcur); + break; + case ARK_UNREC_RHSFUNC_ERR: + arkProcessError(ark_mem, ARK_UNREC_RHSFUNC_ERR, "ARKode", "ARKode", + MSG_ARK_RHSFUNC_UNREC, ark_mem->tcur); + break; + case ARK_REPTD_RHSFUNC_ERR: + arkProcessError(ark_mem, ARK_REPTD_RHSFUNC_ERR, "ARKode", "ARKode", + MSG_ARK_RHSFUNC_REPTD, ark_mem->tcur); + break; + case ARK_RTFUNC_FAIL: + arkProcessError(ark_mem, ARK_RTFUNC_FAIL, "ARKode", "ARKode", + MSG_ARK_RTFUNC_FAILED, ark_mem->tcur); + break; + case ARK_TOO_CLOSE: + arkProcessError(ark_mem, ARK_TOO_CLOSE, "ARKode", "ARKode", + MSG_ARK_TOO_CLOSE); + break; + case ARK_CONSTR_FAIL: + arkProcessError(ark_mem, ARK_CONSTR_FAIL, "ARKode", "ARKode", + MSG_ARK_FAILED_CONSTR, ark_mem->tcur); + break; + case ARK_MASSSOLVE_FAIL: + arkProcessError(ark_mem, ARK_MASSSOLVE_FAIL, "ARKode", "ARKode", + MSG_ARK_MASSSOLVE_FAIL); + break; + case ARK_NLS_SETUP_FAIL: + arkProcessError(ark_mem, ARK_NLS_SETUP_FAIL, "ARKode", "ARKode", + "At t = %Lg the nonlinear solver setup failed unrecoverably", + (long double) ark_mem->tcur); + break; + case ARK_VECTOROP_ERR: + arkProcessError(ark_mem, ARK_VECTOROP_ERR, "ARKode", "ARKode", + MSG_ARK_VECTOROP_ERR, ark_mem->tcur); + break; + case ARK_INNERSTEP_FAIL: + arkProcessError(ark_mem, ARK_INNERSTEP_FAIL, "ARKode", "ARKode", + MSG_ARK_INNERSTEP_FAILED, ark_mem->tcur); + break; + case ARK_NLS_OP_ERR: + arkProcessError(ark_mem, ARK_NLS_OP_ERR, "ARKode", "ARKode", + MSG_ARK_NLS_FAIL, ark_mem->tcur); + break; + case ARK_USER_PREDICT_FAIL: + arkProcessError(ark_mem, ARK_USER_PREDICT_FAIL, "ARKode", "ARKode", + MSG_ARK_USER_PREDICT_FAIL, ark_mem->tcur); + break; + case ARK_POSTPROCESS_STEP_FAIL: + arkProcessError(ark_mem, ARK_POSTPROCESS_STEP_FAIL, "ARKode", "ARKode", + MSG_ARK_POSTPROCESS_STEP_FAIL, ark_mem->tcur); + break; + case ARK_POSTPROCESS_STAGE_FAIL: + arkProcessError(ark_mem, ARK_POSTPROCESS_STAGE_FAIL, "ARKode", "ARKode", + MSG_ARK_POSTPROCESS_STAGE_FAIL, ark_mem->tcur); + break; + case ARK_INTERP_FAIL: + arkProcessError(ark_mem, ARK_INTERP_FAIL, "ARKode", "ARKode", + "At t = %Lg the interpolation module failed unrecoverably", + (long double) ark_mem->tcur); + break; + case ARK_INVALID_TABLE: + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode", "ARKode", + "ARKode was provided an invalid method table"); + break; + default: + /* This return should never happen */ + arkProcessError(ark_mem, ARK_UNRECOGNIZED_ERROR, "ARKode", "ARKode", + "ARKode encountered an unrecognized error. Please report this to the Sundials developers at sundials-users@llnl.gov"); + return(ARK_UNRECOGNIZED_ERROR); + } + + return(flag); +} + + +/*--------------------------------------------------------------- + arkEwtSetSS + + This routine is responsible for setting the error weight vector + ewt as follows: + + ewt[i] = 1 / (reltol * SUNRabs(ycur[i]) + abstol), i=0,...,neq-1 + + When the absolute tolerance is zero, it tests for non-positive + components before inverting. arkEwtSetSS returns 0 if ewt is + successfully set to a positive vector and -1 otherwise. In the + latter case, ewt is considered undefined. + ---------------------------------------------------------------*/ +int arkEwtSetSS(N_Vector ycur, N_Vector weight, void* arkode_mem) +{ + ARKodeMem ark_mem = (ARKodeMem) arkode_mem; + N_VAbs(ycur, ark_mem->tempv1); + N_VScale(ark_mem->reltol, ark_mem->tempv1, ark_mem->tempv1); + N_VAddConst(ark_mem->tempv1, ark_mem->Sabstol, ark_mem->tempv1); + if (ark_mem->atolmin0) { + if (N_VMin(ark_mem->tempv1) <= ZERO) return(-1); + } + N_VInv(ark_mem->tempv1, weight); + return(0); +} + + +/*--------------------------------------------------------------- + arkEwtSetSV + + This routine is responsible for setting the error weight vector + ewt as follows: + + ewt[i] = 1 / (reltol * SUNRabs(ycur[i]) + abstol[i]), i=0,...,neq-1 + + When any absolute tolerance is zero, it tests for non-positive + components before inverting. arkEwtSetSV returns 0 if ewt is + successfully set to a positive vector and -1 otherwise. In the + latter case, ewt is considered undefined. + ---------------------------------------------------------------*/ +int arkEwtSetSV(N_Vector ycur, N_Vector weight, void* arkode_mem) +{ + ARKodeMem ark_mem = (ARKodeMem) arkode_mem; + N_VAbs(ycur, ark_mem->tempv1); + N_VLinearSum(ark_mem->reltol, ark_mem->tempv1, ONE, + ark_mem->Vabstol, ark_mem->tempv1); + if (ark_mem->atolmin0) { + if (N_VMin(ark_mem->tempv1) <= ZERO) return(-1); + } + N_VInv(ark_mem->tempv1, weight); + return(0); +} + + +/*--------------------------------------------------------------- + arkEwtSetSmallReal + + This routine is responsible for setting the error weight vector + ewt as follows: + + ewt[i] = SMALL_REAL + + This is routine is only used with explicit time stepping with + a fixed step size to avoid a potential too much error return + to the user. + ---------------------------------------------------------------*/ +int arkEwtSetSmallReal(N_Vector ycur, N_Vector weight, void* arkode_mem) +{ + N_VConst(SMALL_REAL, weight); + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkRwtSetSS + + This routine sets rwt as decribed above in the case tol_type = ARK_SS. + When the absolute tolerance is zero, it tests for non-positive + components before inverting. arkRwtSetSS returns 0 if rwt is + successfully set to a positive vector and -1 otherwise. In the + latter case, rwt is considered undefined. + ---------------------------------------------------------------*/ +int arkRwtSetSS(ARKodeMem ark_mem, N_Vector My, N_Vector weight) +{ + N_VAbs(My, ark_mem->tempv1); + N_VScale(ark_mem->reltol, ark_mem->tempv1, ark_mem->tempv1); + N_VAddConst(ark_mem->tempv1, ark_mem->SRabstol, ark_mem->tempv1); + if (ark_mem->Ratolmin0) { + if (N_VMin(ark_mem->tempv1) <= ZERO) return(-1); + } + N_VInv(ark_mem->tempv1, weight); + return(0); +} + + +/*--------------------------------------------------------------- + arkRwtSetSV + + This routine sets rwt as decribed above in the case tol_type = ARK_SV. + When any absolute tolerance is zero, it tests for non-positive + components before inverting. arkRwtSetSV returns 0 if rwt is + successfully set to a positive vector and -1 otherwise. In the + latter case, rwt is considered undefined. + ---------------------------------------------------------------*/ +int arkRwtSetSV(ARKodeMem ark_mem, N_Vector My, N_Vector weight) +{ + N_VAbs(My, ark_mem->tempv1); + N_VLinearSum(ark_mem->reltol, ark_mem->tempv1, ONE, + ark_mem->VRabstol, ark_mem->tempv1); + if (ark_mem->Ratolmin0) { + if (N_VMin(ark_mem->tempv1) <= ZERO) return(-1); + } + N_VInv(ark_mem->tempv1, weight); + return(0); +} + + +/*--------------------------------------------------------------- + arkExpStab is the default explicit stability estimation function + ---------------------------------------------------------------*/ +int arkExpStab(N_Vector y, realtype t, realtype *hstab, void *data) +{ + /* explicit stability not used by default, + set to zero to disable */ + *hstab = RCONST(0.0); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkPredict_MaximumOrder + + This routine predicts the nonlinear implicit stage solution + using the ARKode interpolation module. This uses the + highest-degree interpolant supported by the module (stored + in the interpolation module). + ---------------------------------------------------------------*/ +int arkPredict_MaximumOrder(ARKodeMem ark_mem, realtype tau, N_Vector yguess) +{ + + /* verify that ark_mem and interpolation structure are provided */ + if (ark_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkPredict_MaximumOrder", + "ARKodeMem structure is NULL"); + return(ARK_MEM_NULL); + } + if (ark_mem->interp == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", + "arkPredict_MaximumOrder", + "ARKodeInterpMem structure is NULL"); + return(ARK_MEM_NULL); + } + + /* call the interpolation module to do the work */ + return(arkInterpEvaluate(ark_mem, ark_mem->interp, tau, + 0, ARK_INTERP_MAX_DEGREE, yguess)); +} + + +/*--------------------------------------------------------------- + arkPredict_VariableOrder + + This routine predicts the nonlinear implicit stage solution + using the ARKode interpolation module. The degree of the + interpolant is based on the level of extrapolation outside the + preceding time step. + ---------------------------------------------------------------*/ +int arkPredict_VariableOrder(ARKodeMem ark_mem, realtype tau, N_Vector yguess) +{ + int ord; + realtype tau_tol = 0.5; + realtype tau_tol2 = 0.75; + + /* verify that ark_mem and interpolation structure are provided */ + if (ark_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkPredict_VariableOrder", + "ARKodeMem structure is NULL"); + return(ARK_MEM_NULL); + } + if (ark_mem->interp == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", + "arkPredict_VariableOrder", + "ARKodeInterpMem structure is NULL"); + return(ARK_MEM_NULL); + } + + /* set the polynomial order based on tau input */ + if (tau <= tau_tol) { + ord = 3; + } else if (tau <= tau_tol2) { + ord = 2; + } else { + ord = 1; + } + + /* call the interpolation module to do the work */ + return(arkInterpEvaluate(ark_mem, ark_mem->interp, tau, + 0, ord, yguess)); +} + + +/*--------------------------------------------------------------- + arkPredict_CutoffOrder + + This routine predicts the nonlinear implicit stage solution + using the ARKode interpolation module. If the level of + extrapolation is small enough, it uses the maximum degree + polynomial available (stored in the interpolation module + structure); otherwise it uses a linear polynomial. + ---------------------------------------------------------------*/ +int arkPredict_CutoffOrder(ARKodeMem ark_mem, realtype tau, N_Vector yguess) +{ + int ord; + realtype tau_tol = 0.5; + + /* verify that ark_mem and interpolation structure are provided */ + if (ark_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkPredict_CutoffOrder", + "ARKodeMem structure is NULL"); + return(ARK_MEM_NULL); + } + if (ark_mem->interp == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", + "arkPredict_CutoffOrder", + "ARKodeInterpMem structure is NULL"); + return(ARK_MEM_NULL); + } + + /* set the polynomial order based on tau input */ + if (tau <= tau_tol) { + ord = ARK_INTERP_MAX_DEGREE; + } else { + ord = 1; + } + + /* call the interpolation module to do the work */ + return(arkInterpEvaluate(ark_mem, ark_mem->interp, tau, + 0, ord, yguess)); +} + + +/*--------------------------------------------------------------- + arkPredict_Bootstrap + + This routine predicts the nonlinear implicit stage solution + using a quadratic Hermite interpolating polynomial, based on + the data {y_n, f(t_n,y_n), f(t_n+hj,z_j)}. + + Note: we assume that ftemp = f(t_n+hj,z_j) can be computed via + N_VLinearCombination(nvec, cvals, Xvecs, ftemp), + i.e. the inputs cvals[0:nvec-1] and Xvecs[0:nvec-1] may be + combined to form f(t_n+hj,z_j). + ---------------------------------------------------------------*/ +int arkPredict_Bootstrap(ARKodeMem ark_mem, realtype hj, + realtype tau, int nvec, realtype *cvals, + N_Vector *Xvecs, N_Vector yguess) +{ + realtype a0, a1, a2; + int i, retval; + + /* verify that ark_mem and interpolation structure are provided */ + if (ark_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkPredict_Bootstrap", + "ARKodeMem structure is NULL"); + return(ARK_MEM_NULL); + } + if (ark_mem->interp == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", + "arkPredict_Bootstrap", + "ARKodeInterpMem structure is NULL"); + return(ARK_MEM_NULL); + } + + /* set coefficients for Hermite interpolant */ + a0 = ONE; + a2 = tau*tau/TWO/hj; + a1 = tau - a2; + + /* set arrays for fused vector operation; shift inputs for + f(t_n+hj,z_j) to end of queue */ + for (i=0; iyn; + cvals[1] = a1; + Xvecs[1] = ark_mem->fn; + + /* call fused vector operation to compute prediction */ + retval = N_VLinearCombination(nvec+2, cvals, Xvecs, yguess); + if (retval != 0) return(ARK_VECTOROP_ERR); + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkCheckConvergence + + This routine checks the return flag from the time-stepper's + "step" routine for algebraic solver convergence issues. + + Returns ARK_SUCCESS (0) if successful, PREDICT_AGAIN (>0) + on a recoverable convergence failure, or a relevant + nonrecoverable failure flag (<0). + --------------------------------------------------------------*/ +int arkCheckConvergence(ARKodeMem ark_mem, int *nflagPtr, int *ncfPtr) +{ + ARKodeHAdaptMem hadapt_mem; + + if (*nflagPtr == ARK_SUCCESS) return(ARK_SUCCESS); + + /* The nonlinear soln. failed; increment ncfn */ + ark_mem->ncfn++; + + /* If fixed time stepping, then return with convergence failure */ + if (ark_mem->fixedstep) return(ARK_CONV_FAILURE); + + /* Otherwise, access adaptivity structure */ + if (ark_mem->hadapt_mem == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", "arkCheckConvergence", + MSG_ARKADAPT_NO_MEM); + return(ARK_MEM_NULL); + } + hadapt_mem = ark_mem->hadapt_mem; + + /* Return if lsetup, lsolve, or rhs failed unrecoverably */ + if (*nflagPtr < 0) { + if (*nflagPtr == ARK_LSETUP_FAIL) return(ARK_LSETUP_FAIL); + else if (*nflagPtr == ARK_LSOLVE_FAIL) return(ARK_LSOLVE_FAIL); + else if (*nflagPtr == ARK_RHSFUNC_FAIL) return(ARK_RHSFUNC_FAIL); + else return(ARK_NLS_OP_ERR); + } + + /* At this point, nflag = CONV_FAIL or RHSFUNC_RECVR; increment ncf */ + (*ncfPtr)++; + hadapt_mem->etamax = ONE; + + /* If we had maxncf failures, or if |h| = hmin, + return ARK_CONV_FAILURE or ARK_REPTD_RHSFUNC_ERR. */ + if ((*ncfPtr == ark_mem->maxncf) || + (SUNRabs(ark_mem->h) <= ark_mem->hmin*ONEPSM)) { + if (*nflagPtr == CONV_FAIL) return(ARK_CONV_FAILURE); + if (*nflagPtr == RHSFUNC_RECVR) return(ARK_REPTD_RHSFUNC_ERR); + } + + /* Reduce step size due to convergence failure */ + ark_mem->eta = hadapt_mem->etacf; + + /* Signal for Jacobian/preconditioner setup */ + *nflagPtr = PREV_CONV_FAIL; + + /* Return to reattempt the step */ + return(PREDICT_AGAIN); +} + + +/*--------------------------------------------------------------- + arkCheckConstraints + + This routine determines if the constraints of the problem + are satisfied by the proposed step + + Returns ARK_SUCCESS if successful, otherwise CONSTR_RECVR + --------------------------------------------------------------*/ +int arkCheckConstraints(ARKodeMem ark_mem, int *constrfails, int *nflag) +{ + booleantype constraintsPassed; + N_Vector mm = ark_mem->tempv4; + N_Vector tmp = ark_mem->tempv1; + + /* Check constraints and get mask vector mm for where constraints failed */ + constraintsPassed = N_VConstrMask(ark_mem->constraints, ark_mem->ycur, mm); + if (constraintsPassed) return(ARK_SUCCESS); + + /* Constraints not met */ + + /* Update total fails and fails in current step */ + ark_mem->nconstrfails++; + (*constrfails)++; + + /* Return with error if reached max fails in a step */ + if (*constrfails == ark_mem->maxconstrfails) return(ARK_CONSTR_FAIL); + + /* Return with error if using fixed step sizes */ + if (ark_mem->fixedstep) return(ARK_CONSTR_FAIL); + + /* Return with error if |h| == hmin */ + if (SUNRabs(ark_mem->h) <= ark_mem->hmin*ONEPSM) return(ARK_CONSTR_FAIL); + + /* Reduce h by computing eta = h'/h */ + N_VLinearSum(ONE, ark_mem->yn, -ONE, ark_mem->ycur, tmp); + N_VProd(mm, tmp, tmp); + ark_mem->eta = RCONST(0.9)*N_VMinQuotient(ark_mem->yn, tmp); + ark_mem->eta = SUNMAX(ark_mem->eta, TENTH); + + /* Signal for Jacobian/preconditioner setup */ + *nflag = PREV_CONV_FAIL; + + /* Return to reattempt the step */ + return(CONSTR_RECVR); +} + + +/*--------------------------------------------------------------- + arkCheckTemporalError + + This routine performs the local error test for the method. + The weighted local error norm dsm is passed in. This value is + used to predict the next step to attempt based on dsm. + The test dsm <= 1 is made, and if this fails then additional + checks are performed based on the number of successive error + test failures. + + Returns ARK_SUCCESS if the test passes. + + If the test fails: + - if maxnef error test failures have occurred or if + SUNRabs(h) = hmin, we return ARK_ERR_FAILURE. + - otherwise: set *nflagPtr to PREV_ERR_FAIL, and + return TRY_AGAIN. + --------------------------------------------------------------*/ +int arkCheckTemporalError(ARKodeMem ark_mem, int *nflagPtr, int *nefPtr, realtype dsm) +{ + int retval; + realtype ttmp; + long int nsttmp; + ARKodeHAdaptMem hadapt_mem; + + /* Access hadapt_mem structure */ + if (ark_mem->hadapt_mem == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", "arkCheckTemporalError", + MSG_ARKADAPT_NO_MEM); + return(ARK_MEM_NULL); + } + hadapt_mem = ark_mem->hadapt_mem; + + /* consider change of step size for next step attempt (may be + larger/smaller than current step, depending on dsm) */ + ttmp = (dsm <= ONE) ? ark_mem->tn + ark_mem->h : ark_mem->tn; + nsttmp = (dsm <= ONE) ? ark_mem->nst+1 : ark_mem->nst; + retval = arkAdapt((void*) ark_mem, hadapt_mem, ark_mem->ycur, ttmp, + ark_mem->h, dsm*ark_mem->hadapt_mem->bias, nsttmp); + if (retval != ARK_SUCCESS) return(ARK_ERR_FAILURE); + + /* If est. local error norm dsm passes test, return ARK_SUCCESS */ + if (dsm <= ONE) return(ARK_SUCCESS); + + /* Test failed; increment counters, set nflag */ + (*nefPtr)++; + ark_mem->netf++; + *nflagPtr = PREV_ERR_FAIL; + + /* At maxnef failures, return ARK_ERR_FAILURE */ + if (*nefPtr == ark_mem->maxnef) return(ARK_ERR_FAILURE); + + /* Set etamax=1 to prevent step size increase at end of this step */ + hadapt_mem->etamax = ONE; + + /* Enforce failure bounds on eta, update h, and return for retry of step */ + if (*nefPtr >= hadapt_mem->small_nef) + ark_mem->eta = SUNMIN(ark_mem->eta, hadapt_mem->etamxf); + return(TRY_AGAIN); +} + + +/*--------------------------------------------------------------- + arkAccessHAdaptMem: + + Shortcut routine to unpack ark_mem and hadapt_mem structures from + void* pointer. If either is missing it returns ARK_MEM_NULL. + ---------------------------------------------------------------*/ +int arkAccessHAdaptMem(void* arkode_mem, const char *fname, + ARKodeMem *ark_mem, ARKodeHAdaptMem *hadapt_mem) +{ + + /* access ARKodeMem structure */ + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + fname, MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + *ark_mem = (ARKodeMem) arkode_mem; + if ((*ark_mem)->hadapt_mem==NULL) { + arkProcessError(*ark_mem, ARK_MEM_NULL, "ARKode", + fname, MSG_ARKADAPT_NO_MEM); + return(ARK_MEM_NULL); + } + *hadapt_mem = (ARKodeHAdaptMem) (*ark_mem)->hadapt_mem; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkProcessError is a high level error handling function + - if ark_mem==NULL it prints the error message to stderr + - otherwise, it sets-up and calls the error handling function + pointed to by ark_ehfun + ---------------------------------------------------------------*/ +void arkProcessError(ARKodeMem ark_mem, int error_code, + const char *module, const char *fname, + const char *msgfmt, ...) +{ + va_list ap; + char msg[256]; + + /* Initialize the argument pointer variable + (msgfmt is the last required argument to arkProcessError) */ + va_start(ap, msgfmt); + + /* Compose the message */ + vsprintf(msg, msgfmt, ap); + + if (ark_mem == NULL) { /* We write to stderr */ + +#ifndef NO_FPRINTF_OUTPUT + STAN_SUNDIALS_FPRINTF(stderr, "\n[%s ERROR] %s\n ", module, fname); + STAN_SUNDIALS_FPRINTF(stderr, "%s\n\n", msg); +#endif + + } else { /* We can call ehfun */ + ark_mem->ehfun(error_code, module, fname, msg, + ark_mem->eh_data); + } + + /* Finalize argument processing */ + va_end(ap); + + return; +} + + +/*=============================================================== + EOF + ===============================================================*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_adapt.c b/lib/sundials_6.1.1/src/arkode/arkode_adapt.c new file mode 100644 index 00000000000..15eab49b39c --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_adapt.c @@ -0,0 +1,398 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 time step + * adaptivity utilities. + *--------------------------------------------------------------*/ + +#include +#include +#include +#include + +#include "arkode_impl.h" +#include +#include + + +/*--------------------------------------------------------------- + arkAdaptInit: + + This routine creates and sets default values in an + ARKodeHAdaptMem structure. This returns a non-NULL structure + if no errors occurred, or a NULL value otherwise. + ---------------------------------------------------------------*/ +ARKodeHAdaptMem arkAdaptInit() +{ + ARKodeHAdaptMem hadapt_mem; + + /* allocate structure */ + hadapt_mem = (ARKodeHAdaptMem) malloc(sizeof(struct ARKodeHAdaptMemRec)); + if (hadapt_mem == NULL) return(NULL); + + /* initialize values (default parameters are set in arkSetDefaults) */ + memset(hadapt_mem, 0, sizeof(struct ARKodeHAdaptMemRec)); + hadapt_mem->ehist[0] = ONE; + hadapt_mem->ehist[1] = ONE; + hadapt_mem->hhist[0] = ZERO; + hadapt_mem->hhist[1] = ZERO; + hadapt_mem->nst_acc = 0; + hadapt_mem->nst_exp = 0; + return(hadapt_mem); +} + + +/*--------------------------------------------------------------- + arkPrintAdaptMem + + This routine outputs the time step adaptivity memory structure + to a specified file pointer. + ---------------------------------------------------------------*/ +void arkPrintAdaptMem(ARKodeHAdaptMem hadapt_mem, FILE *outfile) +{ + if (hadapt_mem != NULL) { + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: etamax = %"RSYM"\n", hadapt_mem->etamax); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: etamx1 = %"RSYM"\n", hadapt_mem->etamx1); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: etamxf = %"RSYM"\n", hadapt_mem->etamxf); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: etamin = %"RSYM"\n", hadapt_mem->etamin); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: small_nef = %i\n", hadapt_mem->small_nef); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: etacf = %"RSYM"\n", hadapt_mem->etacf); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: imethod = %i\n", hadapt_mem->imethod); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: ehist = %"RSYM" %"RSYM"\n", + hadapt_mem->ehist[0], + hadapt_mem->ehist[1]); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: hhist = %"RSYM" %"RSYM"\n", + hadapt_mem->hhist[0], + hadapt_mem->hhist[1]); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: cfl = %"RSYM"\n", hadapt_mem->cfl); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: safety = %"RSYM"\n", hadapt_mem->safety); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: bias = %"RSYM"\n", hadapt_mem->bias); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: growth = %"RSYM"\n", hadapt_mem->growth); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: lbound = %"RSYM"\n", hadapt_mem->lbound); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: ubound = %"RSYM"\n", hadapt_mem->ubound); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: k1 = %"RSYM"\n", hadapt_mem->k1); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: k2 = %"RSYM"\n", hadapt_mem->k2); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: k3 = %"RSYM"\n", hadapt_mem->k3); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: q = %i\n", hadapt_mem->q); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: p = %i\n", hadapt_mem->p); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: pq = %i\n", hadapt_mem->pq); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: nst_acc = %li\n", hadapt_mem->nst_acc); + STAN_SUNDIALS_FPRINTF(outfile, "ark_hadapt: nst_exp = %li\n", hadapt_mem->nst_exp); + if (hadapt_mem->expstab == arkExpStab) { + STAN_SUNDIALS_FPRINTF(outfile, " ark_hadapt: Default explicit stability function\n"); + } else { + STAN_SUNDIALS_FPRINTF(outfile, " ark_hadapt: User provided explicit stability function\n"); + STAN_SUNDIALS_FPRINTF(outfile, " ark_hadapt: stability function data pointer = %p\n", + hadapt_mem->estab_data); + } + } +} + + + + +/*--------------------------------------------------------------- + arkAdapt is the time step adaptivity wrapper function. This + computes and sets the value of ark_eta inside of the ARKodeMem + data structure. + ---------------------------------------------------------------*/ +int arkAdapt(void* arkode_mem, ARKodeHAdaptMem hadapt_mem, + N_Vector ycur, realtype tcur, realtype hcur, + realtype ecur, long int nst) +{ + int ier, k; + realtype h_acc, h_cfl, int_dir; + ARKodeMem ark_mem; + if (arkode_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkAdapt", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* Set k as either p or q, based on pq flag */ + k = (hadapt_mem->pq) ? hadapt_mem->q : hadapt_mem->p; + + /* Call algorithm-specific error adaptivity method */ + switch (hadapt_mem->imethod) { + case(ARK_ADAPT_PID): /* PID controller */ + ier = arkAdaptPID(hadapt_mem, k, hcur, ecur, &h_acc); + break; + case(ARK_ADAPT_PI): /* PI controller */ + ier = arkAdaptPI(hadapt_mem, k, hcur, ecur, &h_acc); + break; + case(ARK_ADAPT_I): /* I controller */ + ier = arkAdaptI(hadapt_mem, k, hcur, ecur, &h_acc); + break; + case(ARK_ADAPT_EXP_GUS): /* explicit Gustafsson controller */ + ier = arkAdaptExpGus(hadapt_mem, k, nst, hcur, ecur, &h_acc); + break; + case(ARK_ADAPT_IMP_GUS): /* implicit Gustafsson controller */ + ier = arkAdaptImpGus(hadapt_mem, k, nst, hcur, ecur, &h_acc); + break; + case(ARK_ADAPT_IMEX_GUS): /* imex Gustafsson controller */ + ier = arkAdaptImExGus(hadapt_mem, k, nst, hcur, ecur, &h_acc); + break; + case(ARK_ADAPT_CUSTOM): /* user-supplied controller */ + ier = hadapt_mem->HAdapt(ycur, tcur, hcur, hadapt_mem->hhist[0], + hadapt_mem->hhist[1], ecur, + hadapt_mem->ehist[0], + hadapt_mem->ehist[1], + hadapt_mem->q, hadapt_mem->p, + &h_acc, hadapt_mem->HAdapt_data); + break; + default: + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkAdapt", + "Illegal imethod."); + return (ARK_ILL_INPUT); + } + if (ier != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkAdapt", + "Error in accuracy-based adaptivity function."); + return (ARK_ILL_INPUT); + } + + /* determine direction of integration */ + int_dir = hcur / SUNRabs(hcur); + + /* Call explicit stability function */ + ier = hadapt_mem->expstab(ycur, tcur, &h_cfl, hadapt_mem->estab_data); + if (ier != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", "arkAdapt", + "Error in explicit stability function."); + return (ARK_ILL_INPUT); + } + if (h_cfl <= ZERO) h_cfl = RCONST(1.0e30) * SUNRabs(hcur); + + /* Solver diagnostics reporting */ + if (ark_mem->report) + STAN_SUNDIALS_FPRINTF(ark_mem->diagfp, "ARKadapt adapt %"RSYM" %"RSYM" %"RSYM" %"RSYM" %"RSYM" %"RSYM" %"RSYM" %"RSYM" ", + ecur, hadapt_mem->ehist[0], hadapt_mem->ehist[1], + hcur, hadapt_mem->hhist[0], hadapt_mem->hhist[1], h_acc, h_cfl); + + /* enforce safety factors */ + h_acc *= hadapt_mem->safety; + h_cfl *= hadapt_mem->cfl * int_dir; + + /* enforce maximum bound on time step growth */ + h_acc = int_dir * SUNMIN(SUNRabs(h_acc), SUNRabs(hadapt_mem->etamax*hcur)); + + /* enforce minimum bound time step reduction */ + h_acc = int_dir * SUNMAX(SUNRabs(h_acc), SUNRabs(hadapt_mem->etamin*hcur)); + + /* Solver diagnostics reporting */ + if (ark_mem->report) + STAN_SUNDIALS_FPRINTF(ark_mem->diagfp, "%"RSYM" %"RSYM" ", h_acc, h_cfl); + + /* increment the relevant step counter, set desired step */ + if (SUNRabs(h_acc) < SUNRabs(h_cfl)) + hadapt_mem->nst_acc++; + else + hadapt_mem->nst_exp++; + h_acc = int_dir * SUNMIN(SUNRabs(h_acc), SUNRabs(h_cfl)); + + /* enforce adaptivity bounds to retain Jacobian/preconditioner accuracy */ + if ( (SUNRabs(h_acc) > SUNRabs(hcur*hadapt_mem->lbound*ONEMSM)) && + (SUNRabs(h_acc) < SUNRabs(hcur*hadapt_mem->ubound*ONEPSM)) ) + h_acc = hcur; + + /* set basic value of ark_eta */ + ark_mem->eta = h_acc / hcur; + + /* enforce minimum time step size */ + ark_mem->eta = SUNMAX(ark_mem->eta, + ark_mem->hmin / SUNRabs(hcur)); + + /* enforce maximum time step size */ + ark_mem->eta /= SUNMAX(ONE, SUNRabs(hcur) * + ark_mem->hmax_inv*ark_mem->eta); + + /* Solver diagnostics reporting */ + if (ark_mem->report) + STAN_SUNDIALS_FPRINTF(ark_mem->diagfp, "%"RSYM"\n", ark_mem->eta); + + return(ier); +} + + +/*--------------------------------------------------------------- + arkAdaptPID implements a PID time step control algorithm. + ---------------------------------------------------------------*/ +int arkAdaptPID(ARKodeHAdaptMem hadapt_mem, int k, realtype hcur, + realtype ecur, realtype *hnew) +{ + realtype k1, k2, k3, e1, e2, e3, h_acc; + + /* set usable time-step adaptivity parameters */ + k1 = -hadapt_mem->k1 / k; + k2 = hadapt_mem->k2 / k; + k3 = -hadapt_mem->k3 / k; + e1 = SUNMAX(ecur, TINY); + e2 = SUNMAX(hadapt_mem->ehist[0], TINY); + e3 = SUNMAX(hadapt_mem->ehist[1], TINY); + + /* compute estimated optimal time step size, set into output */ + h_acc = hcur * SUNRpowerR(e1,k1) * SUNRpowerR(e2,k2) * SUNRpowerR(e3,k3); + *hnew = h_acc; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkAdaptPI implements a PI time step control algorithm. + ---------------------------------------------------------------*/ +int arkAdaptPI(ARKodeHAdaptMem hadapt_mem, int k, realtype hcur, + realtype ecur, realtype *hnew) +{ + realtype k1, k2, e1, e2, h_acc; + + /* set usable time-step adaptivity parameters */ + k1 = -hadapt_mem->k1 / k; + k2 = hadapt_mem->k2 / k; + e1 = SUNMAX(ecur, TINY); + e2 = SUNMAX(hadapt_mem->ehist[0], TINY); + + /* compute estimated optimal time step size, set into output */ + h_acc = hcur * SUNRpowerR(e1,k1) * SUNRpowerR(e2,k2); + *hnew = h_acc; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkAdaptI implements an I time step control algorithm. + ---------------------------------------------------------------*/ +int arkAdaptI(ARKodeHAdaptMem hadapt_mem, int k, realtype hcur, + realtype ecur, realtype *hnew) +{ + realtype k1, e1, h_acc; + + /* set usable time-step adaptivity parameters */ + k1 = -hadapt_mem->k1 / k; + e1 = SUNMAX(ecur, TINY); + + /* compute estimated optimal time step size, set into output */ + h_acc = hcur * SUNRpowerR(e1,k1); + *hnew = h_acc; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkAdaptExpGus implements the explicit Gustafsson time step + control algorithm. + ---------------------------------------------------------------*/ +int arkAdaptExpGus(ARKodeHAdaptMem hadapt_mem, int k, long int nst, + realtype hcur, realtype ecur, realtype *hnew) +{ + realtype k1, k2, e1, e2, h_acc; + + /* modified method for first step */ + if (nst < 2) { + + k1 = -ONE / k; + e1 = SUNMAX(ecur, TINY); + h_acc = hcur * SUNRpowerR(e1,k1); + + /* general estimate */ + } else { + + k1 = -hadapt_mem->k1 / k; + k2 = -hadapt_mem->k2 / k; + e1 = SUNMAX(ecur, TINY); + e2 = e1 / SUNMAX(hadapt_mem->ehist[0], TINY); + h_acc = hcur * SUNRpowerR(e1,k1) * SUNRpowerR(e2,k2); + + } + *hnew = h_acc; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkAdaptImpGus implements the implicit Gustafsson time step + control algorithm. + ---------------------------------------------------------------*/ +int arkAdaptImpGus(ARKodeHAdaptMem hadapt_mem, int k, long int nst, + realtype hcur, realtype ecur, realtype *hnew) +{ + realtype k1, k2, e1, e2, hrat, h_acc; + + /* modified method for first step */ + if (nst < 2) { + + k1 = -ONE / k; + e1 = SUNMAX(ecur, TINY); + h_acc = hcur * SUNRpowerR(e1,k1); + + /* general estimate */ + } else { + + k1 = -hadapt_mem->k1 / k; + k2 = -hadapt_mem->k2 / k; + e1 = SUNMAX(ecur, TINY); + e2 = e1 / SUNMAX(hadapt_mem->ehist[0], TINY); + hrat = hcur / hadapt_mem->hhist[0]; + h_acc = hcur * hrat * SUNRpowerR(e1,k1) * SUNRpowerR(e2,k2); + + } + *hnew = h_acc; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkAdaptImExGus implements a combination implicit/explicit + Gustafsson time step control algorithm. + ---------------------------------------------------------------*/ +int arkAdaptImExGus(ARKodeHAdaptMem hadapt_mem, int k, long int nst, + realtype hcur, realtype ecur, realtype *hnew) +{ + realtype k1, k2, k3, e1, e2, hrat, h_acc; + + /* modified method for first step */ + if (nst < 2) { + + k1 = -ONE / k; + e1 = SUNMAX(ecur, TINY); + h_acc = hcur * SUNRpowerR(e1,k1); + + /* general estimate */ + } else { + + k1 = -hadapt_mem->k1 / k; + k2 = -hadapt_mem->k2 / k; + k3 = -hadapt_mem->k3 / k; + e1 = SUNMAX(ecur, TINY); + e2 = e1 / SUNMAX(hadapt_mem->ehist[0], TINY); + hrat = hcur / hadapt_mem->hhist[0]; + /* implicit estimate */ + h_acc = hcur * hrat * SUNRpowerR(e1,k3) * SUNRpowerR(e2,k3); + /* explicit estimate */ + h_acc = SUNMIN(h_acc, hcur * SUNRpowerR(e1,k1) * SUNRpowerR(e2,k2)); + + } + *hnew = h_acc; + + return(ARK_SUCCESS); +} + + +/*=============================================================== + EOF + ===============================================================*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_adapt_impl.h b/lib/sundials_6.1.1/src/arkode/arkode_adapt_impl.h new file mode 100644 index 00000000000..b3bd882258c --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_adapt_impl.h @@ -0,0 +1,149 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * Implementation header file for ARKode's time step adaptivity + * utilities. + *--------------------------------------------------------------*/ + +#ifndef _ARKODE_ADAPT_IMPL_H +#define _ARKODE_ADAPT_IMPL_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/*=============================================================== + ARKode Time Step Adaptivity Private Constants + ===============================================================*/ + +/* size constants for the adaptivity memory structure */ +#define ARK_ADAPT_LRW 19 +#define ARK_ADAPT_LIW 8 /* includes function/data pointers */ + +/* Time step controller default values */ +#define CFLFAC RCONST(0.5) +#define SAFETY RCONST(0.96) /* CVODE uses 1.0 */ +#define BIAS RCONST(1.5) /* CVODE uses 6.0 */ +#define GROWTH RCONST(20.0) /* CVODE uses 10.0 */ +#define HFIXED_LB RCONST(1.0) /* CVODE uses 1.0 */ +#define HFIXED_UB RCONST(1.5) /* CVODE uses 1.5 */ +#define AD0_K1 RCONST(0.58) /* PID controller constants */ +#define AD0_K2 RCONST(0.21) +#define AD0_K3 RCONST(0.1) +#define AD1_K1 RCONST(0.8) /* PI controller constants */ +#define AD1_K2 RCONST(0.31) +#define AD2_K1 RCONST(1.0) /* I controller constants */ +#define AD3_K1 RCONST(0.367) /* explicit Gustafsson controller */ +#define AD3_K2 RCONST(0.268) +#define AD4_K1 RCONST(0.98) /* implicit Gustafsson controller */ +#define AD4_K2 RCONST(0.95) +#define AD5_K1 RCONST(0.367) /* imex Gustafsson controller */ +#define AD5_K2 RCONST(0.268) +#define AD5_K3 RCONST(0.95) + +#define ETAMX1 RCONST(10000.0) /* maximum step size change on first step */ +#define ETAMXF RCONST(0.3) /* step size reduction factor on multiple error + test failures (multiple implies >= SMALL_NEF) */ +#define ETAMIN RCONST(0.1) /* smallest allowable step size reduction factor + on an error test failure */ +#define ETACF RCONST(0.25) /* step size reduction factor on nonlinear + convergence failure */ +#define SMALL_NEF 2 /* if an error failure occurs and SMALL_NEF <= nef, + then reset eta = MIN(eta, ETAMXF) */ + + +/*=============================================================== + ARKode Time Step Adaptivity Data Structure + ===============================================================*/ + +/*--------------------------------------------------------------- + Types : struct ARKodeHAdaptMemRec, ARKodeHAdaptMem + ----------------------------------------------------------------- + The type ARKodeHAdaptMem is type pointer to struct + ARKodeHAdaptMemRec. This structure contains fields to + keep track of temporal adaptivity. + ---------------------------------------------------------------*/ +typedef struct ARKodeHAdaptMemRec { + + realtype etamax; /* eta <= etamax */ + realtype etamx1; /* max step size change on first step */ + realtype etamxf; /* h reduction factor on multiple error fails */ + realtype etamin; /* eta >= etamin on error test fail */ + int small_nef; /* bound to determine 'multiple' above */ + realtype etacf; /* h reduction factor on nonlinear conv fail */ + ARKAdaptFn HAdapt; /* function to set the new time step size */ + void *HAdapt_data; /* user pointer passed to hadapt */ + realtype ehist[2]; /* error history for time adaptivity */ + realtype hhist[2]; /* step history for time adaptivity */ + int imethod; /* step adaptivity method to use: + -1 -> User-specified function above + 0 -> PID controller + 1 -> PI controller + 2 -> I controller + 3 -> explicit Gustafsson controller + 4 -> implicit Gustafsson controller + 5 -> imex Gustafsson controller */ + realtype cfl; /* cfl safety factor */ + realtype safety; /* accuracy safety factor on h */ + realtype bias; /* accuracy safety factor on LTE */ + realtype growth; /* maximum step growth safety factor */ + realtype lbound; /* eta lower bound to leave h unchanged */ + realtype ubound; /* eta upper bound to leave h unchanged */ + realtype k1; /* method-specific adaptivity parameters */ + realtype k2; + realtype k3; + int q; /* method order */ + int p; /* embedding order */ + booleantype pq; /* choice of using p (0) vs q (1) */ + + ARKExpStabFn expstab; /* step stability function */ + void *estab_data; /* user pointer passed to expstab */ + + long int nst_acc; /* num accuracy-limited internal steps */ + long int nst_exp; /* num stability-limited internal steps */ + +} *ARKodeHAdaptMem; + + +/*=============================================================== + ARKode Time Step Adaptivity Routines + ===============================================================*/ + +ARKodeHAdaptMem arkAdaptInit(); +void arkPrintAdaptMem(ARKodeHAdaptMem hadapt_mem, FILE *outfile); +int arkAdapt(void* arkode_mem, ARKodeHAdaptMem hadapt_mem, + N_Vector ycur, realtype tcur, realtype hcur, + realtype ecur, long int nst); +int arkAdaptPID(ARKodeHAdaptMem hadapt_mem, int k, + realtype hcur, realtype ecur, realtype *hnew); +int arkAdaptPI(ARKodeHAdaptMem hadapt_mem, int k, + realtype hcur, realtype ecur, realtype *hnew); +int arkAdaptI(ARKodeHAdaptMem hadapt_mem, int k, + realtype hcur, realtype ecur, realtype *hnew); +int arkAdaptExpGus(ARKodeHAdaptMem hadapt_mem, int k, long int nst, + realtype hcur, realtype ecur, realtype *hnew); +int arkAdaptImpGus(ARKodeHAdaptMem hadapt_mem, int k, long int nst, + realtype hcur, realtype ecur, realtype *hnew); +int arkAdaptImExGus(ARKodeHAdaptMem hadapt_mem, int k, long int nst, + realtype hcur, realtype ecur, realtype *hnew); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/src/arkode/arkode_arkstep.c b/lib/sundials_6.1.1/src/arkode/arkode_arkstep.c new file mode 100644 index 00000000000..ef52fabc4e7 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_arkstep.c @@ -0,0 +1,2938 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 ARK time stepper + * module. + *--------------------------------------------------------------*/ + +#include +#include +#include + +#include "arkode_impl.h" +#include "arkode_arkstep_impl.h" +#include "arkode_interp_impl.h" +#include +#include + +#define FIXED_LIN_TOL + +/*=============================================================== + SHORTCUTS + ===============================================================*/ + +#define ARK_PROFILER ark_mem->sunctx->profiler + +/*=============================================================== + ARKStep Exported functions -- Required + ===============================================================*/ + +void* ARKStepCreate(ARKRhsFn fe, ARKRhsFn fi, realtype t0, N_Vector y0, + SUNContext sunctx) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + SUNNonlinearSolver NLS; + booleantype nvectorOK; + int retval; + + /* Check that at least one of fe, fi is supplied and is to be used */ + if (fe == NULL && fi == NULL) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepCreate", MSG_ARK_NULL_F); + return(NULL); + } + + /* Check for legal input parameters */ + if (y0 == NULL) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepCreate", MSG_ARK_NULL_Y0); + return(NULL); + } + + if (!sunctx) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepCreate", MSG_ARK_NULL_SUNCTX); + return(NULL); + } + + /* Test if all required vector operations are implemented */ + nvectorOK = arkStep_CheckNVector(y0); + if (!nvectorOK) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepCreate", MSG_ARK_BAD_NVECTOR); + return(NULL); + } + + /* Create ark_mem structure and set default values */ + ark_mem = arkCreate(sunctx); + if (ark_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepCreate", MSG_ARK_NO_MEM); + return(NULL); + } + + /* Allocate ARKodeARKStepMem structure, and initialize to zero */ + step_mem = NULL; + step_mem = (ARKodeARKStepMem) malloc(sizeof(struct ARKodeARKStepMemRec)); + if (step_mem == NULL) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::ARKStep", + "ARKStepCreate", MSG_ARK_ARKMEM_FAIL); + return(NULL); + } + memset(step_mem, 0, sizeof(struct ARKodeARKStepMemRec)); + + /* Attach step_mem structure and function pointers to ark_mem */ + ark_mem->step_attachlinsol = arkStep_AttachLinsol; + ark_mem->step_attachmasssol = arkStep_AttachMasssol; + ark_mem->step_disablelsetup = arkStep_DisableLSetup; + ark_mem->step_disablemsetup = arkStep_DisableMSetup; + ark_mem->step_getlinmem = arkStep_GetLmem; + ark_mem->step_getmassmem = arkStep_GetMassMem; + ark_mem->step_getimplicitrhs = arkStep_GetImplicitRHS; + ark_mem->step_mmult = NULL; + ark_mem->step_getgammas = arkStep_GetGammas; + ark_mem->step_init = arkStep_Init; + ark_mem->step_fullrhs = arkStep_FullRHS; + ark_mem->step = arkStep_TakeStep_Z; + ark_mem->step_mem = (void*) step_mem; + + /* Set default values for ARKStep optional inputs */ + retval = ARKStepSetDefaults((void *)ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::ARKStep", + "ARKStepCreate", + "Error setting default solver options"); + ARKStepFree((void**) &ark_mem); return(NULL); + } + + /* Set implicit/explicit problem based on function pointers */ + step_mem->explicit = (fe == NULL) ? SUNFALSE : SUNTRUE; + step_mem->implicit = (fi == NULL) ? SUNFALSE : SUNTRUE; + + /* Allocate the general ARK stepper vectors using y0 as a template */ + /* NOTE: Fe, Fi, cvals and Xvecs will be allocated later on + (based on the number of ARK stages) */ + + /* Clone the input vector to create sdata, zpred and zcor */ + if (!arkAllocVec(ark_mem, y0, &(step_mem->sdata))) { + ARKStepFree((void**) &ark_mem); return(NULL); } + if (!arkAllocVec(ark_mem, y0, &(step_mem->zpred))) { + ARKStepFree((void**) &ark_mem); return(NULL); } + if (!arkAllocVec(ark_mem, y0, &(step_mem->zcor))) { + ARKStepFree((void**) &ark_mem); return(NULL); } + + /* Copy the input parameters into ARKode state */ + step_mem->fe = fe; + step_mem->fi = fi; + + /* Update the ARKode workspace requirements */ + ark_mem->liw += 41; /* fcn/data ptr, int, long int, sunindextype, booleantype */ + ark_mem->lrw += 10; + + /* If an implicit component is to be solved, create default Newton NLS object */ + step_mem->ownNLS = SUNFALSE; + if (step_mem->implicit) { + NLS = SUNNonlinSol_Newton(y0, ark_mem->sunctx); + if (NLS == NULL) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::ARKStep", + "ARKStepCreate", "Error creating default Newton solver"); + ARKStepFree((void**) &ark_mem); return(NULL); + } + retval = ARKStepSetNonlinearSolver(ark_mem, NLS); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::ARKStep", + "ARKStepCreate", "Error attaching default Newton solver"); + ARKStepFree((void**) &ark_mem); return(NULL); + } + step_mem->ownNLS = SUNTRUE; + } + + /* Set the linear solver addresses to NULL (we check != NULL later) */ + step_mem->linit = NULL; + step_mem->lsetup = NULL; + step_mem->lsolve = NULL; + step_mem->lfree = NULL; + step_mem->lmem = NULL; + step_mem->lsolve_type = -1; + + /* Set the mass matrix solver addresses to NULL */ + step_mem->minit = NULL; + step_mem->msetup = NULL; + step_mem->mmult = NULL; + step_mem->msolve = NULL; + step_mem->mfree = NULL; + step_mem->mass_mem = NULL; + step_mem->mass_type = MASS_IDENTITY; + step_mem->msolve_type = -1; + + /* Initialize initial error norm */ + step_mem->eRNrm = ONE; + + /* Initialize all the counters */ + step_mem->nfe = 0; + step_mem->nfi = 0; + step_mem->nsetups = 0; + step_mem->nstlp = 0; + step_mem->nls_iters = 0; + + /* Initialize fused op work space */ + step_mem->cvals = NULL; + step_mem->Xvecs = NULL; + step_mem->nfusedopvecs = 0; + + /* Initialize external polynomial forcing data */ + step_mem->expforcing = SUNFALSE; + step_mem->impforcing = SUNFALSE; + step_mem->forcing = NULL; + step_mem->nforcing = 0; + + /* Initialize main ARKode infrastructure */ + retval = arkInit(ark_mem, t0, y0, FIRST_INIT); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::ARKStep", "ARKStepCreate", + "Unable to initialize main ARKode infrastructure"); + ARKStepFree((void**) &ark_mem); return(NULL); + } + + return((void *)ark_mem); +} + + +/*--------------------------------------------------------------- + ARKStepResize: + + This routine resizes the memory within the ARKStep module. + It first resizes the main ARKode infrastructure memory, and + then resizes its own data. + ---------------------------------------------------------------*/ +int ARKStepResize(void *arkode_mem, N_Vector y0, realtype hscale, + realtype t0, ARKVecResizeFn resize, void *resize_data) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + SUNNonlinearSolver NLS; + sunindextype lrw1, liw1, lrw_diff, liw_diff; + int i, retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepResize", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Determing change in vector sizes */ + lrw1 = liw1 = 0; + if (y0->ops->nvspace != NULL) + N_VSpace(y0, &lrw1, &liw1); + lrw_diff = lrw1 - ark_mem->lrw1; + liw_diff = liw1 - ark_mem->liw1; + ark_mem->lrw1 = lrw1; + ark_mem->liw1 = liw1; + + /* resize ARKode infrastructure memory */ + retval = arkResize(ark_mem, y0, hscale, t0, resize, resize_data); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::ARKStep", "ARKStepResize", + "Unable to resize main ARKode infrastructure"); + return(retval); + } + + /* Resize the sdata, zpred and zcor vectors */ + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &step_mem->sdata)) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::ARKStep", "ARKStepResize", + "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &step_mem->zpred)) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::ARKStep", "ARKStepResize", + "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &step_mem->zcor)) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::ARKStep", "ARKStepResize", + "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + + /* Resize the ARKStep vectors */ + /* Fe */ + if (step_mem->Fe != NULL) { + for (i=0; istages; i++) { + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &step_mem->Fe[i])) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::ARKStep", "ARKStepResize", + "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + } + } + /* Fi */ + if (step_mem->Fi != NULL) { + for (i=0; istages; i++) { + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &step_mem->Fi[i])) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::ARKStep", "ARKStepResize", + "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + } + } + + /* If a NLS object was previously used, destroy and recreate default Newton + NLS object (can be replaced by user-defined object if desired) */ + if ((step_mem->NLS != NULL) && (step_mem->ownNLS)) { + + /* destroy existing NLS object */ + retval = SUNNonlinSolFree(step_mem->NLS); + if (retval != ARK_SUCCESS) return(retval); + step_mem->NLS = NULL; + step_mem->ownNLS = SUNFALSE; + + /* create new Newton NLS object */ + NLS = SUNNonlinSol_Newton(y0, ark_mem->sunctx); + if (NLS == NULL) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::ARKStep", + "ARKStepResize", "Error creating default Newton solver"); + return(ARK_MEM_FAIL); + } + + /* attach new Newton NLS object to ARKStep */ + retval = ARKStepSetNonlinearSolver(ark_mem, NLS); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::ARKStep", + "ARKStepResize", "Error attaching default Newton solver"); + return(ARK_MEM_FAIL); + } + step_mem->ownNLS = SUNTRUE; + + } + + /* reset nonlinear solver counters */ + if (step_mem->NLS != NULL) step_mem->nsetups = 0; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepReInit: + + This routine re-initializes the ARKStep module to solve a new + problem of the same size as was previously solved. This routine + should also be called when the problem dynamics or desired solvers + have changed dramatically, so that the problem integration should + resume as if started from scratch. + + Note all internal counters are set to 0 on re-initialization. + ---------------------------------------------------------------*/ +int ARKStepReInit(void* arkode_mem, ARKRhsFn fe, + ARKRhsFn fi, realtype t0, N_Vector y0) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepReInit", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Check if ark_mem was allocated */ + if (ark_mem->MallocDone == SUNFALSE) { + arkProcessError(ark_mem, ARK_NO_MALLOC, "ARKode::ARKStep", + "ARKStepReInit", MSG_ARK_NO_MALLOC); + return(ARK_NO_MALLOC); + } + + /* Check that at least one of fe, fi is supplied and is to be used */ + if (fe == NULL && fi == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepReInit", MSG_ARK_NULL_F); + return(ARK_ILL_INPUT); + } + + /* Check that y0 is supplied */ + if (y0 == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepReInit", MSG_ARK_NULL_Y0); + return(ARK_ILL_INPUT); + } + + /* Set implicit/explicit problem based on function pointers */ + step_mem->explicit = (fe == NULL) ? SUNFALSE : SUNTRUE; + step_mem->implicit = (fi == NULL) ? SUNFALSE : SUNTRUE; + + /* Copy the input parameters into ARKode state */ + step_mem->fe = fe; + step_mem->fi = fi; + + /* Initialize initial error norm */ + step_mem->eRNrm = ONE; + + /* Initialize main ARKode infrastructure */ + retval = arkInit(ark_mem, t0, y0, FIRST_INIT); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::ARKStep", "ARKStepReInit", + "Unable to reinitialize main ARKode infrastructure"); + return(retval); + } + + /* Initialize all the counters */ + step_mem->nfe = 0; + step_mem->nfi = 0; + step_mem->nsetups = 0; + step_mem->nstlp = 0; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepReset: + + This routine resets the ARKStep module state to solve the same + problem from the given time with the input state (all counter + values are retained). + ---------------------------------------------------------------*/ +int ARKStepReset(void* arkode_mem, realtype tR, N_Vector yR) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepReset", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Initialize main ARKode infrastructure */ + retval = arkInit(ark_mem, tR, yR, RESET_INIT); + + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::ARKStep", "ARKStepReset", + "Unable to initialize main ARKode infrastructure"); + return(retval); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSStolerances, ARKStepSVtolerances, ARKStepWFtolerances, + ARKStepResStolerance, ARKStepResVtolerance, ARKStepResFtolerance: + + These routines set integration tolerances (wrappers for general + ARKode utility routines) + ---------------------------------------------------------------*/ +int ARKStepSStolerances(void *arkode_mem, realtype reltol, realtype abstol) +{ + /* unpack ark_mem, call arkSStolerances, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSStolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkSStolerances(ark_mem, reltol, abstol)); +} + +int ARKStepSVtolerances(void *arkode_mem, realtype reltol, N_Vector abstol) +{ + /* unpack ark_mem, call arkSVtolerances, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSVtolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkSVtolerances(ark_mem, reltol, abstol)); +} + +int ARKStepWFtolerances(void *arkode_mem, ARKEwtFn efun) +{ + /* unpack ark_mem, call arkWFtolerances, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepWFtolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkWFtolerances(ark_mem, efun)); +} + +int ARKStepResStolerance(void *arkode_mem, realtype rabstol) +{ + /* unpack ark_mem, call arkResStolerance, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepResStolerance", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkResStolerance(ark_mem, rabstol)); +} + +int ARKStepResVtolerance(void *arkode_mem, N_Vector rabstol) +{ + /* unpack ark_mem, call arkResVtolerance, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepResVtolerance", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkResVtolerance(ark_mem, rabstol)); +} + +int ARKStepResFtolerance(void *arkode_mem, ARKRwtFn rfun) +{ + /* unpack ark_mem, call arkResFtolerance, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepResFtolerance", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkResFtolerance(ark_mem, rfun)); +} + + +/*--------------------------------------------------------------- + ARKStepRootInit: + + Initialize (attach) a rootfinding problem to the stepper + (wrappers for general ARKode utility routine) + ---------------------------------------------------------------*/ +int ARKStepRootInit(void *arkode_mem, int nrtfn, ARKRootFn g) +{ + /* unpack ark_mem, call arkRootInit, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepRootInit", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkRootInit(ark_mem, nrtfn, g)); +} + + +/*--------------------------------------------------------------- + ARKStepEvolve: + + This is the main time-integration driver (wrappers for general + ARKode utility routine) + ---------------------------------------------------------------*/ +int ARKStepEvolve(void *arkode_mem, realtype tout, N_Vector yout, + realtype *tret, int itask) +{ + /* unpack ark_mem, call arkEvolve, and return */ + int retval; + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepEvolve", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + SUNDIALS_MARK_FUNCTION_BEGIN(ARK_PROFILER); + retval = arkEvolve(ark_mem, tout, yout, tret, itask); + SUNDIALS_MARK_FUNCTION_END(ARK_PROFILER); + return(retval); +} + + +/*--------------------------------------------------------------- + ARKStepGetDky: + + This returns interpolated output of the solution or its + derivatives over the most-recently-computed step (wrapper for + generic ARKode utility routine) + ---------------------------------------------------------------*/ +int ARKStepGetDky(void *arkode_mem, realtype t, int k, N_Vector dky) +{ + /* unpack ark_mem, call arkGetDky, and return */ + int retval; + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepGetDky", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + SUNDIALS_MARK_FUNCTION_BEGIN(ARK_PROFILER); + retval = arkGetDky(ark_mem, t, k, dky); + SUNDIALS_MARK_FUNCTION_END(ARK_PROFILER); + return(retval); +} + + +/*--------------------------------------------------------------- + ARKStepComputeState: + + Computes y based on the current prediction and given correction. + ---------------------------------------------------------------*/ +int ARKStepComputeState(void *arkode_mem, N_Vector zcor, N_Vector z) +{ + int retval; + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepComputeState", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + N_VLinearSum(ONE, step_mem->zpred, ONE, zcor, z); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepFree frees all ARKStep memory, and then calls an ARKode + utility routine to free the ARKode infrastructure memory. + ---------------------------------------------------------------*/ +void ARKStepFree(void **arkode_mem) +{ + int j; + sunindextype Bliw, Blrw; + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + + /* nothing to do if arkode_mem is already NULL */ + if (*arkode_mem == NULL) return; + + /* conditional frees on non-NULL ARKStep module */ + ark_mem = (ARKodeMem) (*arkode_mem); + if (ark_mem->step_mem != NULL) { + + step_mem = (ARKodeARKStepMem) ark_mem->step_mem; + + /* free the Butcher tables */ + if (step_mem->Be != NULL) { + ARKodeButcherTable_Space(step_mem->Be, &Bliw, &Blrw); + ARKodeButcherTable_Free(step_mem->Be); + step_mem->Be = NULL; + ark_mem->liw -= Bliw; + ark_mem->lrw -= Blrw; + } + if (step_mem->Bi != NULL) { + ARKodeButcherTable_Space(step_mem->Bi, &Bliw, &Blrw); + ARKodeButcherTable_Free(step_mem->Bi); + step_mem->Bi = NULL; + ark_mem->liw -= Bliw; + ark_mem->lrw -= Blrw; + } + + /* free the nonlinear solver memory (if applicable) */ + if ((step_mem->NLS != NULL) && (step_mem->ownNLS)) { + SUNNonlinSolFree(step_mem->NLS); + step_mem->ownNLS = SUNFALSE; + } + step_mem->NLS = NULL; + + /* free the linear solver memory */ + if (step_mem->lfree != NULL) { + step_mem->lfree((void *) ark_mem); + step_mem->lmem = NULL; + } + + /* free the mass matrix solver memory */ + if (step_mem->mfree != NULL) { + step_mem->mfree((void *) ark_mem); + step_mem->mass_mem = NULL; + } + + /* free the sdata, zpred and zcor vectors */ + if (step_mem->sdata != NULL) { + arkFreeVec(ark_mem, &step_mem->sdata); + step_mem->sdata = NULL; + } + if (step_mem->zpred != NULL) { + arkFreeVec(ark_mem, &step_mem->zpred); + step_mem->zpred = NULL; + } + if (step_mem->zcor != NULL) { + arkFreeVec(ark_mem, &step_mem->zcor); + step_mem->zcor = NULL; + } + + /* free the RHS vectors */ + if (step_mem->Fe != NULL) { + for(j=0; jstages; j++) + arkFreeVec(ark_mem, &step_mem->Fe[j]); + free(step_mem->Fe); + step_mem->Fe = NULL; + ark_mem->liw -= step_mem->stages; + } + if (step_mem->Fi != NULL) { + for(j=0; jstages; j++) + arkFreeVec(ark_mem, &step_mem->Fi[j]); + free(step_mem->Fi); + step_mem->Fi = NULL; + ark_mem->liw -= step_mem->stages; + } + + /* free the reusable arrays for fused vector interface */ + if (step_mem->cvals != NULL) { + free(step_mem->cvals); + step_mem->cvals = NULL; + ark_mem->lrw -= step_mem->nfusedopvecs; + } + if (step_mem->Xvecs != NULL) { + free(step_mem->Xvecs); + step_mem->Xvecs = NULL; + ark_mem->liw -= step_mem->nfusedopvecs; + } + step_mem->nfusedopvecs = 0; + + /* free the time stepper module itself */ + free(ark_mem->step_mem); + ark_mem->step_mem = NULL; + + } + + /* free memory for overall ARKode infrastructure */ + arkFree(arkode_mem); +} + + +/*--------------------------------------------------------------- + ARKStepPrintMem: + + This routine outputs the memory from the ARKStep structure and + the main ARKode infrastructure to a specified file pointer + (useful when debugging). + ---------------------------------------------------------------*/ +void ARKStepPrintMem(void* arkode_mem, FILE* outfile) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + +#ifdef SUNDIALS_DEBUG_PRINTVEC + int i; +#endif + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepPrintMem", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return; + + /* if outfile==NULL, set it to stdout */ + if (outfile == NULL) outfile = stdout; + + /* output data from main ARKode infrastructure */ + arkPrintMem(ark_mem, outfile); + + /* output integer quantities */ + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: q = %i\n", step_mem->q); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: p = %i\n", step_mem->p); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: istage = %i\n", step_mem->istage); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: stages = %i\n", step_mem->stages); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: maxcor = %i\n", step_mem->maxcor); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: msbp = %i\n", step_mem->msbp); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: predictor = %i\n", step_mem->predictor); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: lsolve_type = %i\n", step_mem->lsolve_type); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: msolve_type = %i\n", step_mem->msolve_type); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: convfail = %i\n", step_mem->convfail); + + /* output long integer quantities */ + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: nfe = %li\n", step_mem->nfe); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: nfi = %li\n", step_mem->nfi); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: nsetups = %li\n", step_mem->nsetups); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: nstlp = %li\n", step_mem->nstlp); + + /* output boolean quantities */ + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: user_linear = %i\n", step_mem->linear); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: user_linear_timedep = %i\n", step_mem->linear_timedep); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: user_explicit = %i\n", step_mem->explicit); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: user_implicit = %i\n", step_mem->implicit); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: jcur = %i\n", step_mem->jcur); + + /* output realtype quantities */ + if (step_mem->Be != NULL) { + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: explicit Butcher table:\n"); + ARKodeButcherTable_Write(step_mem->Be, outfile); + } + if (step_mem->Bi != NULL) { + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: implicit Butcher table:\n"); + ARKodeButcherTable_Write(step_mem->Bi, outfile); + } + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: gamma = %"RSYM"\n", step_mem->gamma); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: gammap = %"RSYM"\n", step_mem->gammap); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: gamrat = %"RSYM"\n", step_mem->gamrat); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: crate = %"RSYM"\n", step_mem->crate); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: eRNrm = %"RSYM"\n", step_mem->eRNrm); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: nlscoef = %"RSYM"\n", step_mem->nlscoef); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: crdown = %"RSYM"\n", step_mem->crdown); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: rdiv = %"RSYM"\n", step_mem->rdiv); + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: dgmax = %"RSYM"\n", step_mem->dgmax); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + /* output vector quantities */ + STAN_SUNDIALS_FPRINTF(outfile, "ARKStep: sdata:\n"); + N_VPrintFile(step_mem->sdata, outfile); + STAN_SUNDIALS_FPRINTF(outfile, "ARKStep: zpred:\n"); + N_VPrintFile(step_mem->zpred, outfile); + STAN_SUNDIALS_FPRINTF(outfile, "ARKStep: zcor:\n"); + N_VPrintFile(step_mem->zcor, outfile); + if (step_mem->Fe != NULL) + for (i=0; istages; i++) { + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: Fe[%i]:\n", i); + N_VPrintFile(step_mem->Fe[i], outfile); + } + if (step_mem->Fi != NULL) + for (i=0; istages; i++) { + STAN_SUNDIALS_FPRINTF(outfile,"ARKStep: Fi[%i]:\n", i); + N_VPrintFile(step_mem->Fi[i], outfile); + } +#endif +} + + +/*=============================================================== + ARKStep Private functions + ===============================================================*/ + +/*--------------------------------------------------------------- + Interface routines supplied to ARKode + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + arkStep_AttachLinsol: + + This routine attaches the various set of system linear solver + interface routines, data structure, and solver type to the + ARKStep module. + ---------------------------------------------------------------*/ +int arkStep_AttachLinsol(void* arkode_mem, ARKLinsolInitFn linit, + ARKLinsolSetupFn lsetup, + ARKLinsolSolveFn lsolve, + ARKLinsolFreeFn lfree, + SUNLinearSolver_Type lsolve_type, + void *lmem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_AttachLinsol", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* free any existing system solver */ + if (step_mem->lfree != NULL) step_mem->lfree(arkode_mem); + + /* Attach the provided routines, data structure and solve type */ + step_mem->linit = linit; + step_mem->lsetup = lsetup; + step_mem->lsolve = lsolve; + step_mem->lfree = lfree; + step_mem->lmem = lmem; + step_mem->lsolve_type = lsolve_type; + + /* Reset all linear solver counters */ + step_mem->nsetups = 0; + step_mem->nstlp = 0; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_AttachMasssol: + + This routine attaches the set of mass matrix linear solver + interface routines, data structure, and solver type to the + ARKStep module. + ---------------------------------------------------------------*/ +int arkStep_AttachMasssol(void* arkode_mem, + ARKMassInitFn minit, + ARKMassSetupFn msetup, + ARKMassMultFn mmult, + ARKMassSolveFn msolve, + ARKMassFreeFn mfree, + booleantype time_dep, + SUNLinearSolver_Type msolve_type, + void *mass_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_AttachMasssol", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* free any existing mass matrix solver */ + if (step_mem->mfree != NULL) step_mem->mfree(arkode_mem); + + /* Attach the provided routines, data structure and solve type */ + step_mem->minit = minit; + step_mem->msetup = msetup; + step_mem->mmult = mmult; + step_mem->msolve = msolve; + step_mem->mfree = mfree; + step_mem->mass_mem = mass_mem; + step_mem->mass_type = (time_dep) ? MASS_TIMEDEP : MASS_FIXED; + step_mem->msolve_type = msolve_type; + + /* Attach mmult function pointer to ark_mem as well */ + ark_mem->step_mmult = mmult; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_DisableLSetup: + + This routine NULLifies the lsetup function pointer in the + ARKStep module. + ---------------------------------------------------------------*/ +void arkStep_DisableLSetup(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + + /* access ARKodeARKStepMem structure */ + if (arkode_mem==NULL) return; + ark_mem = (ARKodeMem) arkode_mem; + if (ark_mem->step_mem==NULL) return; + step_mem = (ARKodeARKStepMem) ark_mem->step_mem; + + /* nullify the lsetup function pointer */ + step_mem->lsetup = NULL; +} + + +/*--------------------------------------------------------------- + arkStep_DisableMSetup: + + This routine NULLifies the msetup function pointer in the + ARKStep module. + ---------------------------------------------------------------*/ +void arkStep_DisableMSetup(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + + /* access ARKodeARKStepMem structure */ + if (arkode_mem==NULL) return; + ark_mem = (ARKodeMem) arkode_mem; + if (ark_mem->step_mem==NULL) return; + step_mem = (ARKodeARKStepMem) ark_mem->step_mem; + + /* nullify the msetup function pointer */ + step_mem->msetup = NULL; +} + + +/*--------------------------------------------------------------- + arkStep_GetLmem: + + This routine returns the system linear solver interface memory + structure, lmem. + ---------------------------------------------------------------*/ +void* arkStep_GetLmem(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure, and return lmem */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_GetLmem", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(NULL); + return(step_mem->lmem); +} + + +/*--------------------------------------------------------------- + arkStep_GetMassMem: + + This routine returns the mass matrix solver interface memory + structure, mass_mem. + ---------------------------------------------------------------*/ +void* arkStep_GetMassMem(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure, and return mass_mem */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_GetMassMem", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(NULL); + return(step_mem->mass_mem); +} + + +/*--------------------------------------------------------------- + arkStep_GetImplicitRHS: + + This routine returns the implicit RHS function pointer, fi. + ---------------------------------------------------------------*/ +ARKRhsFn arkStep_GetImplicitRHS(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure, and return fi */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_GetImplicitRHS", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(NULL); + return(step_mem->fi); +} + + +/*--------------------------------------------------------------- + arkStep_GetGammas: + + This routine fills the current value of gamma, and states + whether the gamma ratio fails the dgmax criteria. + ---------------------------------------------------------------*/ +int arkStep_GetGammas(void* arkode_mem, realtype *gamma, + realtype *gamrat, booleantype **jcur, + booleantype *dgamma_fail) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_GetGammas", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set outputs */ + step_mem = (ARKodeARKStepMem) ark_mem->step_mem; + *gamma = step_mem->gamma; + *gamrat = step_mem->gamrat; + *jcur = &step_mem->jcur; + *dgamma_fail = (SUNRabs(*gamrat - ONE) >= step_mem->dgmax); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_Init: + + This routine is called just prior to performing internal time + steps (after all user "set" routines have been called) from + within arkInitialSetup. + + For all initialization types, this routine sets the relevant + TakeStep routine based on the current problem configuration. + + With initialization type FIRST_INIT this routine: + - sets/checks the ARK Butcher tables to be used + - allocates any memory that depends on the number of ARK stages, + method order, or solver options + - checks for consistency between the system and mass matrix + linear solvers (if applicable) + - initializes and sets up the system and mass matrix linear + solvers (if applicable) + - initializes and sets up the nonlinear solver (if applicable) + - allocates the interpolation data structure (if needed based + on ARKStep solver options) + - updates the call_fullrhs flag if necessary + + With initialization type FIRST_INIT or RESIZE_INIT, this routine: + - sets the relevant TakeStep routine based on the current + problem configuration + - checks for consistency between the system and mass matrix + linear solvers (if applicable) + - initializes and sets up the system and mass matrix linear + solvers (if applicable) + - initializes and sets up the nonlinear solver (if applicable) + + With initialization type RESET_INIT, this routine does nothing. + ---------------------------------------------------------------*/ +int arkStep_Init(void* arkode_mem, int init_type) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int j, retval; + booleantype reset_efun; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_Init", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* immediately return if reset */ + if (init_type == RESET_INIT) return(ARK_SUCCESS); + + /* initializations/checks for (re-)initialization call */ + if (init_type == FIRST_INIT) { + + /* enforce use of arkEwtSmallReal if using a fixed step size for + an explicit method, an internal error weight function, and not + using an iterative mass matrix solver with rwt=ewt */ + reset_efun = SUNTRUE; + if ( step_mem->implicit ) reset_efun = SUNFALSE; + if ( !ark_mem->fixedstep ) reset_efun = SUNFALSE; + if ( ark_mem->user_efun ) reset_efun = SUNFALSE; + if ( ark_mem->rwt_is_ewt && (step_mem->msolve_type == SUNLINEARSOLVER_ITERATIVE) ) + reset_efun = SUNFALSE; + if ( ark_mem->rwt_is_ewt && (step_mem->msolve_type == SUNLINEARSOLVER_MATRIX_ITERATIVE) ) + reset_efun = SUNFALSE; + if (reset_efun) { + ark_mem->user_efun = SUNFALSE; + ark_mem->efun = arkEwtSetSmallReal; + ark_mem->e_data = ark_mem; + } + + /* Create Butcher tables (if not already set) */ + retval = arkStep_SetButcherTables(ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", "arkStep_Init", + "Could not create Butcher table(s)"); + return(ARK_ILL_INPUT); + } + + /* Check that Butcher tables are OK */ + retval = arkStep_CheckButcherTables(ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "arkStep_Init", "Error in Butcher table(s)"); + return(ARK_ILL_INPUT); + } + + /* Retrieve/store method and embedding orders now that tables are finalized */ + if (step_mem->Bi != NULL) { + step_mem->q = ark_mem->hadapt_mem->q = step_mem->Bi->q; + step_mem->p = ark_mem->hadapt_mem->p = step_mem->Bi->p; + } else { + step_mem->q = ark_mem->hadapt_mem->q = step_mem->Be->q; + step_mem->p = ark_mem->hadapt_mem->p = step_mem->Be->p; + } + + /* Ensure that if adaptivity is enabled, then method includes embedding coefficients */ + if (!ark_mem->fixedstep && (step_mem->p == 0)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", "arkStep_Init", + "Adaptive timestepping cannot be performed without embedding coefficients"); + return(ARK_ILL_INPUT); + } + + /* Allocate ARK RHS vector memory, update storage requirements */ + /* Allocate Fe[0] ... Fe[stages-1] if needed */ + if (step_mem->explicit) { + if (step_mem->Fe == NULL) + step_mem->Fe = (N_Vector *) calloc(step_mem->stages, sizeof(N_Vector)); + for (j=0; jstages; j++) { + if (!arkAllocVec(ark_mem, ark_mem->ewt, &(step_mem->Fe[j]))) + return(ARK_MEM_FAIL); + } + ark_mem->liw += step_mem->stages; /* pointers */ + } + + /* Allocate Fi[0] ... Fi[stages-1] if needed */ + if (step_mem->implicit) { + if (step_mem->Fi == NULL) + step_mem->Fi = (N_Vector *) calloc(step_mem->stages, sizeof(N_Vector)); + for (j=0; jstages; j++) { + if (!arkAllocVec(ark_mem, ark_mem->ewt, &(step_mem->Fi[j]))) + return(ARK_MEM_FAIL); + } + ark_mem->liw += step_mem->stages; /* pointers */ + } + + /* Allocate reusable arrays for fused vector operations */ + step_mem->nfusedopvecs = 2 * step_mem->stages + 2 + step_mem->nforcing; + if (step_mem->cvals == NULL) { + step_mem->cvals = (realtype *) calloc(step_mem->nfusedopvecs, + sizeof(realtype)); + if (step_mem->cvals == NULL) return(ARK_MEM_FAIL); + ark_mem->lrw += step_mem->nfusedopvecs; + } + if (step_mem->Xvecs == NULL) { + step_mem->Xvecs = (N_Vector *) calloc(step_mem->nfusedopvecs, + sizeof(N_Vector)); + if (step_mem->Xvecs == NULL) return(ARK_MEM_FAIL); + ark_mem->liw += step_mem->nfusedopvecs; /* pointers */ + } + + /* Limit interpolant degree based on method order (use negative + argument to specify update instead of overwrite) */ + if (ark_mem->interp != NULL) { + retval = arkInterpSetDegree(ark_mem, ark_mem->interp, -(step_mem->q-1)); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", "arkStep_Init", + "Unable to update interpolation polynomial degree"); + return(ARK_ILL_INPUT); + } + } + + /* If configured with either predictor 4 or 5 and a non-identity mass + matrix, reset to trivial predictor */ + if (step_mem->mass_type != MASS_IDENTITY) + if ((step_mem->predictor == 4) || (step_mem->predictor == 5)) + step_mem->predictor = 0; + + /* If the bootstrap predictor is enabled, signal to shared arkode module that + fullrhs is required after each step */ + if (step_mem->predictor == 4) ark_mem->call_fullrhs = SUNTRUE; + } + + /* set appropriate TakeStep routine based on problem configuration */ + /* (only one choice for now) */ + 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) */ + if ((step_mem->mass_type != MASS_IDENTITY) && step_mem->lmem) { + if (step_mem->lsolve_type != step_mem->msolve_type) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", "arkStep_Init", + "Incompatible linear and mass matrix solvers"); + return(ARK_ILL_INPUT); + } + } + + /* Perform mass matrix solver initialization and setup (if applicable) */ + if (step_mem->mass_type != MASS_IDENTITY) { + + /* Call minit (if it exists) */ + if (step_mem->minit != NULL) { + retval = step_mem->minit((void *) ark_mem); + if (retval != 0) { + arkProcessError(ark_mem, ARK_MASSINIT_FAIL, "ARKode::ARKStep", + "arkStep_Init", MSG_ARK_MASSINIT_FAIL); + return(ARK_MASSINIT_FAIL); + } + } + + /* Call msetup (if it exists) */ + if (step_mem->msetup != NULL) { + retval = step_mem->msetup((void *) ark_mem, ark_mem->tcur, + ark_mem->tempv1, ark_mem->tempv2, + ark_mem->tempv3); + if (retval != 0) { + arkProcessError(ark_mem, ARK_MASSSETUP_FAIL, "ARKode::ARKStep", + "arkStep_Init", MSG_ARK_MASSSETUP_FAIL); + return(ARK_MASSSETUP_FAIL); + } + } + } + + /* Call linit (if it exists) */ + if (step_mem->linit) { + retval = step_mem->linit(ark_mem); + if (retval != 0) { + arkProcessError(ark_mem, ARK_LINIT_FAIL, "ARKode::ARKStep", + "arkStep_Init", MSG_ARK_LINIT_FAIL); + return(ARK_LINIT_FAIL); + } + } + + /* Initialize the nonlinear solver object (if it exists) */ + if (step_mem->NLS) { + retval = arkStep_NlsInit(ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_NLS_INIT_FAIL, "ARKode::ARKStep", "arkStep_Init", + "Unable to initialize SUNNonlinearSolver object"); + return(ARK_NLS_INIT_FAIL); + } + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_FullRHS: + + Rewriting the problem + My' = fe(t,y) + fi(t,y) + in the form + y' = M^{-1}*[ fe(t,y) + fi(t,y) ], + this routine computes the full right-hand side vector, + f = M^{-1}*[ fe(t,y) + fi(t,y) ] + + This will be called in one of three 'modes': + ARK_FULLRHS_START -> called at the beginning of a simulation + or after post processing at step + ARK_FULLRHS_END -> called at the end of a successful step + ARK_FULLRHS_OTHER -> called elsewhere (e.g. for dense output) + + If it is called in ARK_FULLRHS_START mode, we store the vectors + fe(t,y) and fi(t,y) in Fe[0] and Fi[0] for possible reuse in the + first stage of the subsequent time step. + + If it is called in ARK_FULLRHS_END mode and the ARK method + coefficients support it, we may just copy vectors Fe[stages] and + Fi[stages] to fill f instead of calling fe() and fi(). + + ARK_FULLRHS_OTHER mode is only called for dense output in-between + steps, or when estimating the initial time step size, so we strive to + store the intermediate parts so that they do not interfere + with the other two modes. + ---------------------------------------------------------------*/ +int arkStep_FullRHS(void* arkode_mem, realtype t, N_Vector y, N_Vector f, + int mode) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int nvec, retval; + booleantype recomputeRHS; + realtype* cvals; + N_Vector* Xvecs; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_FullRHS", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* local shortcuts for use with fused vector operations */ + cvals = step_mem->cvals; + Xvecs = step_mem->Xvecs; + + /* setup mass-matrix if required (use output f as a temporary) */ + if ((step_mem->mass_type == MASS_TIMEDEP) && (step_mem->msetup != NULL)) { + retval = step_mem->msetup((void *) ark_mem, t, f, + ark_mem->tempv2, ark_mem->tempv3); + if (retval != ARK_SUCCESS) return(ARK_MASSSETUP_FAIL); + } + + /* perform RHS functions contingent on 'mode' argument */ + switch(mode) { + + /* ARK_FULLRHS_START: called at the beginning of a simulation + Store the vectors fe(t,y) and fi(t,y) in Fe[0] and Fi[0] for + possible reuse in the first stage of the subsequent time step */ + case ARK_FULLRHS_START: + + /* call fe if the problem has an explicit component */ + if (step_mem->explicit) { + retval = step_mem->fe(t, y, step_mem->Fe[0], ark_mem->user_data); + step_mem->nfe++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::ARKStep", + "arkStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + /* apply external polynomial forcing */ + if (step_mem->expforcing) { + cvals[0] = ONE; + Xvecs[0] = step_mem->Fe[0]; + nvec = 1; + arkStep_ApplyForcing(step_mem, t, ONE, &nvec); + N_VLinearCombination(nvec, cvals, Xvecs, step_mem->Fe[0]); + } + } + + /* call fi if the problem has an implicit component */ + if (step_mem->implicit) { + retval = step_mem->fi(t, y, step_mem->Fi[0], ark_mem->user_data); + step_mem->nfi++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::ARKStep", + "arkStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + /* apply external polynomial forcing */ + if (step_mem->impforcing) { + cvals[0] = ONE; + Xvecs[0] = step_mem->Fi[0]; + nvec = 1; + arkStep_ApplyForcing(step_mem, t, ONE, &nvec); + N_VLinearCombination(nvec, cvals, Xvecs, step_mem->Fi[0]); + } + } + + /* combine RHS vector(s) into output */ + if (step_mem->explicit && step_mem->implicit) { /* ImEx */ + N_VLinearSum(ONE, step_mem->Fi[0], ONE, step_mem->Fe[0], f); + } else if (step_mem->implicit) { /* implicit */ + N_VScale(ONE, step_mem->Fi[0], f); + } else { /* explicit */ + N_VScale(ONE, step_mem->Fe[0], f); + } + + break; + + + /* ARK_FULLRHS_END: called at the end of a successful step + If the ARK method coefficients support it, we just copy the last stage RHS + vectors to fill f instead of calling fe() and fi(). + Copy the results to Fe[0] and Fi[0] if the ARK coefficients support it. */ + case ARK_FULLRHS_END: + + /* determine if explicit/implicit RHS functions need to be recomputed */ + recomputeRHS = SUNFALSE; + if ( step_mem->explicit && (SUNRabs(step_mem->Be->c[step_mem->stages-1]-ONE)>TINY) ) + recomputeRHS = SUNTRUE; + if ( step_mem->implicit && (SUNRabs(step_mem->Bi->c[step_mem->stages-1]-ONE)>TINY) ) + recomputeRHS = SUNTRUE; + + /* base RHS calls on recomputeRHS argument */ + if (recomputeRHS) { + + /* call fe if the problem has an explicit component */ + if (step_mem->explicit) { + retval = step_mem->fe(t, y, step_mem->Fe[0], ark_mem->user_data); + step_mem->nfe++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::ARKStep", + "arkStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + /* apply external polynomial forcing */ + if (step_mem->expforcing) { + cvals[0] = ONE; + Xvecs[0] = step_mem->Fe[0]; + nvec = 1; + arkStep_ApplyForcing(step_mem, t, ONE, &nvec); + N_VLinearCombination(nvec, cvals, Xvecs, step_mem->Fe[0]); + } + } + + /* call fi if the problem has an implicit component */ + if (step_mem->implicit) { + retval = step_mem->fi(t, y, step_mem->Fi[0], ark_mem->user_data); + step_mem->nfi++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::ARKStep", + "arkStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + /* apply external polynomial forcing */ + if (step_mem->impforcing) { + cvals[0] = ONE; + Xvecs[0] = step_mem->Fi[0]; + nvec = 1; + arkStep_ApplyForcing(step_mem, t, ONE, &nvec); + N_VLinearCombination(nvec, cvals, Xvecs, step_mem->Fi[0]); + } + } + } else { + if (step_mem->explicit) + N_VScale(ONE, step_mem->Fe[step_mem->stages-1], step_mem->Fe[0]); + if (step_mem->implicit) + N_VScale(ONE, step_mem->Fi[step_mem->stages-1], step_mem->Fi[0]); + } + + /* combine RHS vector(s) into output */ + if (step_mem->explicit && step_mem->implicit) { /* ImEx */ + N_VLinearSum(ONE, step_mem->Fi[0], ONE, step_mem->Fe[0], f); + } else if (step_mem->implicit) { /* implicit */ + N_VScale(ONE, step_mem->Fi[0], f); + } else { /* explicit */ + N_VScale(ONE, step_mem->Fe[0], f); + } + + break; + + /* ARK_FULLRHS_OTHER: called for dense output in-between steps or for + estimation of the initial time step size, store the intermediate + calculations in such a way as to not interfere with the other two modes */ + case ARK_FULLRHS_OTHER: + + /* call fe if the problem has an explicit component (store in ark_tempv2) */ + if (step_mem->explicit) { + retval = step_mem->fe(t, y, ark_mem->tempv2, ark_mem->user_data); + step_mem->nfe++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::ARKStep", + "arkStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + /* apply external polynomial forcing */ + if (step_mem->expforcing) { + cvals[0] = ONE; + Xvecs[0] = ark_mem->tempv2; + nvec = 1; + arkStep_ApplyForcing(step_mem, t, ONE, &nvec); + N_VLinearCombination(nvec, cvals, Xvecs, ark_mem->tempv2); + } + } + + /* call fi if the problem has an implicit component (store in sdata) */ + if (step_mem->implicit) { + retval = step_mem->fi(t, y, step_mem->sdata, ark_mem->user_data); + step_mem->nfi++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::ARKStep", + "arkStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + /* apply external polynomial forcing */ + if (step_mem->impforcing) { + cvals[0] = ONE; + Xvecs[0] = step_mem->sdata; + nvec = 1; + arkStep_ApplyForcing(step_mem, t, ONE, &nvec); + N_VLinearCombination(nvec, cvals, Xvecs, step_mem->sdata); + } + } + + /* combine RHS vector(s) into output */ + if (step_mem->explicit && step_mem->implicit) { /* ImEx */ + N_VLinearSum(ONE, step_mem->sdata, ONE, ark_mem->tempv2, f); + } else if (step_mem->implicit) { /* implicit */ + N_VScale(ONE, step_mem->sdata, f); + } else { /* explicit */ + N_VScale(ONE, ark_mem->tempv2, f); + } + + break; + + default: + /* return with RHS failure if unknown mode is passed */ + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::ARKStep", + "arkStep_FullRHS", "Unknown full RHS mode"); + return(ARK_RHSFUNC_FAIL); + } + + /* if M != I, then update f = M^{-1}*f */ + if (step_mem->mass_type != MASS_IDENTITY) { + retval = step_mem->msolve((void *) ark_mem, f, + step_mem->nlscoef/ark_mem->h); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_MASSSOLVE_FAIL, "ARKode::ARKStep", + "arkStep_FullRHS", "Mass matrix solver failure"); + return(ARK_MASSSOLVE_FAIL); + } + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_TakeStep_Z: + + This routine serves the primary purpose of the ARKStep module: + it performs a single ARK step (with embedding, if possible). + This version solves for each ARK stage vector, z_i. + + The output variable dsmPtr should contain estimate of the + weighted local error if an embedding is present; otherwise it + should be 0. + + The input/output variable nflagPtr is used to gauge convergence + of any algebraic solvers within the step. At the start of a new + time step, this will initially have the value FIRST_CALL. On + return from this function, nflagPtr should have a value: + 0 => algebraic solve completed successfully + >0 => solve did not converge at this step size + (but may with a smaller stepsize) + <0 => solve encountered an unrecoverable failure + + 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_Z(void* arkode_mem, realtype *dsmPtr, int *nflagPtr) +{ + int retval, is, nvec; + booleantype implicit_stage; + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + N_Vector zcor0; + realtype* cvals; + N_Vector* Xvecs; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_TakeStep_Z", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* local shortcuts for use with fused vector operations */ + cvals = step_mem->cvals; + Xvecs = step_mem->Xvecs; + + /* if problem will involve no algebraic solvers, initialize nflagPtr to success */ + if ((!step_mem->implicit) && (step_mem->mass_type == MASS_IDENTITY)) + *nflagPtr = ARK_SUCCESS; + + /* call nonlinear solver setup if it exists */ + if (step_mem->NLS) + if ((step_mem->NLS)->ops->setup) { + zcor0 = ark_mem->tempv3; + N_VConst(ZERO, zcor0); /* set guess to all 0 (since using predictor-corrector form) */ + retval = SUNNonlinSolSetup(step_mem->NLS, zcor0, ark_mem); + if (retval < 0) return(ARK_NLS_SETUP_FAIL); + if (retval > 0) return(ARK_NLS_SETUP_RECVR); + } + + /* loop over internal stages to the step */ + for (is=0; isstages; is++) { + + /* store current stage index */ + step_mem->istage = is; + + /* set current stage time(s) */ + if (step_mem->implicit) + ark_mem->tcur = ark_mem->tn + step_mem->Bi->c[is]*ark_mem->h; + else + ark_mem->tcur = ark_mem->tn + step_mem->Be->c[is]*ark_mem->h; + +#ifdef SUNDIALS_DEBUG + STAN_SUNDIALS_PRINTF(" ARKStep step %li, stage %i, h = %"RSYM", t_n = %"RSYM"\n", + ark_mem->nst, is, ark_mem->h, ark_mem->tcur); +#endif + + /* setup time-dependent mass matrix */ + if ((step_mem->mass_type == MASS_TIMEDEP) && (step_mem->msetup != NULL)) { + retval = step_mem->msetup((void *) ark_mem, ark_mem->tcur, + ark_mem->tempv1, ark_mem->tempv2, + ark_mem->tempv3); + if (retval != ARK_SUCCESS) return(ARK_MASSSETUP_FAIL); + } + + /* determine whether implicit solve is required */ + implicit_stage = SUNFALSE; + if (step_mem->implicit) + if (SUNRabs(step_mem->Bi->A[is][is]) > TINY) + implicit_stage = SUNTRUE; + +#ifdef SUNDIALS_DEBUG + if (implicit_stage) + STAN_SUNDIALS_PRINTF("implicit stage\n"); + else + STAN_SUNDIALS_PRINTF("explicit stage\n"); +#endif + + /* if implicit, call built-in and user-supplied predictors + (results placed in zpred) */ + if (implicit_stage) { + + retval = arkStep_Predict(ark_mem, is, step_mem->zpred); + if (retval != ARK_SUCCESS) return (retval); + + /* if a user-supplied predictor routine is provided, call that here. + Note that arkStep_Predict is *still* called, so this user-supplied + routine can just 'clean up' the built-in prediction, if desired. */ + if (step_mem->stage_predict) { + retval = step_mem->stage_predict(ark_mem->tcur, step_mem->zpred, + ark_mem->user_data); + if (retval < 0) return(ARK_USER_PREDICT_FAIL); + if (retval > 0) return(TRY_AGAIN); + } + + } + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" ARKStep predictor:\n"); + N_VPrint(step_mem->zpred); +#endif + + /* set up explicit data for evaluation of ARK stage (store in sdata) */ + retval = arkStep_StageSetup(ark_mem, implicit_stage); + if (retval != ARK_SUCCESS) return (retval); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" ARKStep rhs data:\n"); + N_VPrint(step_mem->sdata); +#endif + + /* solver diagnostics reporting */ + if (ark_mem->report) + STAN_SUNDIALS_FPRINTF(ark_mem->diagfp, "ARKStep step %li %"RSYM" %i %"RSYM"\n", + ark_mem->nst, ark_mem->h, is, ark_mem->tcur); + + /* perform implicit solve if required */ + if (implicit_stage) { + + /* implicit solve result is stored in ark_mem->ycur; + return with positive value on anything but success */ + *nflagPtr = arkStep_Nls(ark_mem, *nflagPtr); + if (*nflagPtr != ARK_SUCCESS) return(TRY_AGAIN); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" ARKStep implicit stage %i solution:\n",is); + N_VPrint(ark_mem->ycur); +#endif + + /* otherwise no implicit solve is needed */ + } else { + + /* if M is fixed, solve with it to compute update (place back in sdata) */ + if (step_mem->mass_type == MASS_FIXED) { + + /* perform solve; return with positive value on anything but success */ + *nflagPtr = step_mem->msolve((void *) ark_mem, step_mem->sdata, + step_mem->nlscoef); + if (*nflagPtr != ARK_SUCCESS) return(TRY_AGAIN); + + } + + /* set y to be yn + sdata (either computed in arkStep_StageSetup, + or updated in prev. block) */ + N_VLinearSum(ONE, ark_mem->yn, ONE, step_mem->sdata, ark_mem->ycur); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" ARKStep explicit stage %i solution:\n",is); + N_VPrint(ark_mem->ycur); +#endif + + } + + /* apply user-supplied stage postprocessing function (if supplied) */ + /* NOTE: with internally inconsistent IMEX methods (c_i^E != c_i^I) the value + of tcur corresponds to the stage time from the implicit table (c_i^I). */ + if (ark_mem->ProcessStage != NULL) { + retval = ark_mem->ProcessStage(ark_mem->tcur, + ark_mem->ycur, + ark_mem->user_data); + if (retval != 0) return(ARK_POSTPROCESS_STAGE_FAIL); + } + + /* successful stage solve */ + /* store implicit RHS (value in Fi[is] is from preceding nonlinear iteration) */ + if (step_mem->implicit) { + retval = step_mem->fi(ark_mem->tcur, ark_mem->ycur, + step_mem->Fi[is], ark_mem->user_data); + step_mem->nfi++; + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" ARKStep implicit stage RHS Fi[%i]:\n",is); + N_VPrint(step_mem->Fi[is]); +#endif + + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(ARK_UNREC_RHSFUNC_ERR); + /* apply external polynomial forcing */ + if (step_mem->impforcing) { + cvals[0] = ONE; + Xvecs[0] = step_mem->Fi[is]; + nvec = 1; + arkStep_ApplyForcing(step_mem, ark_mem->tcur, ONE, &nvec); + N_VLinearCombination(nvec, cvals, Xvecs, step_mem->Fi[is]); + } + } + + /* store explicit RHS */ + if (step_mem->explicit) { + retval = step_mem->fe(ark_mem->tn + step_mem->Be->c[is]*ark_mem->h, + ark_mem->ycur, step_mem->Fe[is], ark_mem->user_data); + step_mem->nfe++; + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" ARKStep explicit stage RHS Fe[%i]:\n",is); + N_VPrint(step_mem->Fe[is]); +#endif + + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(ARK_UNREC_RHSFUNC_ERR); + /* apply external polynomial forcing */ + if (step_mem->expforcing) { + cvals[0] = ONE; + Xvecs[0] = step_mem->Fe[is]; + nvec = 1; + arkStep_ApplyForcing(step_mem, ark_mem->tn+step_mem->Be->c[is]*ark_mem->h, + ONE, &nvec); + N_VLinearCombination(nvec, cvals, Xvecs, step_mem->Fe[is]); + } + } + + /* if using a time-dependent mass matrix, update Fe[is] and/or Fi[is] with M(t)^{-1} */ + if (step_mem->mass_type == MASS_TIMEDEP) { + if (step_mem->implicit) { + *nflagPtr = step_mem->msolve((void *) ark_mem, step_mem->Fi[is], step_mem->nlscoef); + if (*nflagPtr != ARK_SUCCESS) return(TRY_AGAIN); + } + if (step_mem->explicit) { + *nflagPtr = step_mem->msolve((void *) ark_mem, step_mem->Fe[is], step_mem->nlscoef); + if (*nflagPtr != ARK_SUCCESS) return(TRY_AGAIN); + } + } + + } /* loop over stages */ + + /* compute time-evolved solution (in ark_ycur), error estimate (in dsm). + This can fail recoverably due to nonconvergence of the mass matrix solve, + so handle that appropriately. */ + if (step_mem->mass_type == MASS_FIXED) { + retval = arkStep_ComputeSolutions_MassFixed(ark_mem, dsmPtr); + } else { + retval = arkStep_ComputeSolutions(ark_mem, dsmPtr); + } + if (retval < 0) return(retval); + if (retval > 0) { + *nflagPtr = retval; + return(TRY_AGAIN); + } + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" ARKStep updated solution:\n"); + N_VPrint(ark_mem->ycur); +#endif + +#ifdef SUNDIALS_DEBUG + STAN_SUNDIALS_PRINTF(" ARKStep error estimate = %"RSYM"\n", *dsmPtr); +#endif + + /* solver diagnostics reporting */ + if (ark_mem->report) + STAN_SUNDIALS_FPRINTF(ark_mem->diagfp, "ARKStep etest %li %"RSYM" %"RSYM"\n", + ark_mem->nst, ark_mem->h, *dsmPtr); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + Internal utility routines + ---------------------------------------------------------------*/ + + +/*--------------------------------------------------------------- + arkStep_AccessStepMem: + + Shortcut routine to unpack ark_mem and step_mem structures from + void* pointer. If either is missing it returns ARK_MEM_NULL. + ---------------------------------------------------------------*/ +int arkStep_AccessStepMem(void* arkode_mem, const char *fname, + ARKodeMem *ark_mem, ARKodeARKStepMem *step_mem) +{ + + /* access ARKodeMem structure */ + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + fname, MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + *ark_mem = (ARKodeMem) arkode_mem; + if ((*ark_mem)->step_mem==NULL) { + arkProcessError(*ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + fname, MSG_ARKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + *step_mem = (ARKodeARKStepMem) (*ark_mem)->step_mem; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_CheckNVector: + + This routine checks if all required vector operations are + present. If any of them is missing it returns SUNFALSE. + ---------------------------------------------------------------*/ +booleantype arkStep_CheckNVector(N_Vector tmpl) +{ + if ( (tmpl->ops->nvclone == NULL) || + (tmpl->ops->nvdestroy == NULL) || + (tmpl->ops->nvlinearsum == NULL) || + (tmpl->ops->nvconst == NULL) || + (tmpl->ops->nvscale == NULL) || + (tmpl->ops->nvwrmsnorm == NULL) ) + return(SUNFALSE); + return(SUNTRUE); +} + + +/*--------------------------------------------------------------- + arkStep_SetButcherTables + + This routine determines the ERK/DIRK/ARK method to use, based + on the desired accuracy and information on whether the problem + is explicit, implicit or imex. + ---------------------------------------------------------------*/ +int arkStep_SetButcherTables(ARKodeMem ark_mem) +{ + int etable, itable; + ARKodeARKStepMem step_mem; + sunindextype Blrw, Bliw; + + /* access ARKodeARKStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "arkStep_SetButcherTables", MSG_ARKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeARKStepMem) ark_mem->step_mem; + + /* if tables have already been specified, just return */ + if ( (step_mem->Be != NULL) || (step_mem->Bi != NULL) ) + return(ARK_SUCCESS); + + /* initialize table numbers to illegal values */ + etable = itable = -1; + + /**** ImEx methods ****/ + if (step_mem->explicit && step_mem->implicit) { + + switch (step_mem->q) { + + case(2): + case(3): + etable = ARKSTEP_DEFAULT_ARK_ETABLE_3; + itable = ARKSTEP_DEFAULT_ARK_ITABLE_3; + break; + case(4): + etable = ARKSTEP_DEFAULT_ARK_ETABLE_4; + itable = ARKSTEP_DEFAULT_ARK_ITABLE_4; + break; + case(5): + etable = ARKSTEP_DEFAULT_ARK_ETABLE_5; + itable = ARKSTEP_DEFAULT_ARK_ITABLE_5; + break; + default: /* no available method, set default */ + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "arkStep_SetButcherTables", + "No ImEx method at requested order, using q=5."); + etable = ARKSTEP_DEFAULT_ARK_ETABLE_5; + itable = ARKSTEP_DEFAULT_ARK_ITABLE_5; + break; + } + + /**** implicit methods ****/ + } else if (step_mem->implicit) { + + switch (step_mem->q) { + case(2): + itable = ARKSTEP_DEFAULT_DIRK_2; + break; + case(3): + itable = ARKSTEP_DEFAULT_DIRK_3; + break; + case(4): + itable = ARKSTEP_DEFAULT_DIRK_4; + break; + case(5): + itable = ARKSTEP_DEFAULT_DIRK_5; + break; + default: /* no available method, set default */ + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "arkStep_SetButcherTables", + "No implicit method at requested order, using q=5."); + itable = ARKSTEP_DEFAULT_DIRK_5; + break; + } + + /**** explicit methods ****/ + } else { + + switch (step_mem->q) { + case(2): + etable = ARKSTEP_DEFAULT_ERK_2; + break; + case(3): + etable = ARKSTEP_DEFAULT_ERK_3; + break; + case(4): + etable = ARKSTEP_DEFAULT_ERK_4; + break; + case(5): + etable = ARKSTEP_DEFAULT_ERK_5; + break; + case(6): + etable = ARKSTEP_DEFAULT_ERK_6; + break; + case(7): + case(8): + etable = ARKSTEP_DEFAULT_ERK_8; + break; + default: /* no available method, set default */ + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "arkStep_SetButcherTables", + "No explicit method at requested order, using q=6."); + etable = ARKSTEP_DEFAULT_ERK_6; + break; + } + + } + + if (etable > -1) + step_mem->Be = ARKodeButcherTable_LoadERK(etable); + if (itable > -1) + step_mem->Bi = ARKodeButcherTable_LoadDIRK(itable); + + /* note Butcher table space requirements */ + ARKodeButcherTable_Space(step_mem->Be, &Bliw, &Blrw); + ark_mem->liw += Bliw; + ark_mem->lrw += Blrw; + + ARKodeButcherTable_Space(step_mem->Bi, &Bliw, &Blrw); + ark_mem->liw += Bliw; + ark_mem->lrw += Blrw; + + /* set [redundant] ARK stored values for stage numbers and method orders */ + if (step_mem->Be != NULL) { + step_mem->stages = step_mem->Be->stages; + step_mem->q = step_mem->Be->q; + step_mem->p = step_mem->Be->p; + } + if (step_mem->Bi != NULL) { + step_mem->stages = step_mem->Bi->stages; + step_mem->q = step_mem->Bi->q; + step_mem->p = step_mem->Bi->p; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_CheckButcherTables + + This routine runs through the explicit and/or implicit Butcher + tables to ensure that they meet all necessary requirements, + including: + strictly lower-triangular (ERK) + lower-triangular with some nonzeros on diagonal (IRK) + method order q > 0 (all) + embedding order q > 0 (all -- if adaptive time-stepping enabled) + stages > 0 (all) + + Returns ARK_SUCCESS if tables pass, ARK_INVALID_TABLE otherwise. + ---------------------------------------------------------------*/ +int arkStep_CheckButcherTables(ARKodeMem ark_mem) +{ + int i, j; + booleantype okay; + ARKodeARKStepMem step_mem; + const realtype tol = RCONST(100.0) * UNIT_ROUNDOFF; + + /* access ARKodeARKStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "arkStep_CheckButcherTables", MSG_ARKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeARKStepMem) ark_mem->step_mem; + + /* check that the expected tables are set */ + if (step_mem->explicit && step_mem->Be == NULL) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ARKStep", + "arkStep_CheckButcherTables", + "explicit table is NULL!"); + return(ARK_INVALID_TABLE); + } + + if (step_mem->implicit && step_mem->Bi == NULL) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ARKStep", + "arkStep_CheckButcherTables", + "implicit table is NULL!"); + return(ARK_INVALID_TABLE); + } + + /* check that stages > 0 */ + if (step_mem->stages < 1) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ARKStep", + "arkStep_CheckButcherTables", + "stages < 1!"); + return(ARK_INVALID_TABLE); + } + + /* check that method order q > 0 */ + if (step_mem->q < 1) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ARKStep", + "arkStep_CheckButcherTables", + "method order < 1!"); + return(ARK_INVALID_TABLE); + } + + /* check that embedding order p > 0 */ + if ((step_mem->p < 1) && (!ark_mem->fixedstep)) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ARKStep", + "arkStep_CheckButcherTables", + "embedding order < 1!"); + return(ARK_INVALID_TABLE); + } + + /* check that embedding exists */ + if ((step_mem->p > 0) && (!ark_mem->fixedstep)) { + if (step_mem->implicit) { + if (step_mem->Bi->d == NULL) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ARKStep", + "arkStep_CheckButcherTables", + "no implicit embedding!"); + return(ARK_INVALID_TABLE); + } + } + if (step_mem->explicit) { + if (step_mem->Be->d == NULL) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ARKStep", + "arkStep_CheckButcherTables", + "no explicit embedding!"); + return(ARK_INVALID_TABLE); + } + } + } + + /* check that ERK table is strictly lower triangular */ + if (step_mem->explicit) { + okay = SUNTRUE; + for (i=0; istages; i++) + for (j=i; jstages; j++) + if (SUNRabs(step_mem->Be->A[i][j]) > tol) + okay = SUNFALSE; + if (!okay) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ARKStep", + "arkStep_CheckButcherTables", + "Ae Butcher table is implicit!"); + return(ARK_INVALID_TABLE); + } + } + + /* check that IRK table is implicit and lower triangular */ + if (step_mem->implicit) { + okay = SUNFALSE; + for (i=0; istages; i++) + if (SUNRabs(step_mem->Bi->A[i][i]) > tol) + okay = SUNTRUE; + if (!okay) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ARKStep", + "arkStep_CheckButcherTables", + "Ai Butcher table is explicit!"); + return(ARK_INVALID_TABLE); + } + + okay = SUNTRUE; + for (i=0; istages; i++) + for (j=i+1; jstages; j++) + if (SUNRabs(step_mem->Bi->A[i][j]) > tol) + okay = SUNFALSE; + if (!okay) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ARKStep", + "arkStep_CheckButcherTables", + "Ai Butcher table has entries above diagonal!"); + return(ARK_INVALID_TABLE); + } + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_Predict + + This routine computes the prediction for a specific internal + stage solution, storing the result in yguess. The + prediction is done using the interpolation structure in + extrapolation mode, hence stages "far" from the previous time + interval are predicted using lower order polynomials than the + "nearby" stages. + ---------------------------------------------------------------*/ +int arkStep_Predict(ARKodeMem ark_mem, int istage, N_Vector yguess) +{ + int i, retval, jstage, nvec; + realtype tau; + realtype h; + ARKodeARKStepMem step_mem; + realtype* cvals; + N_Vector* Xvecs; + + /* access ARKodeARKStepMem structure */ + if (ark_mem->step_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "arkStep_Predict", MSG_ARKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeARKStepMem) ark_mem->step_mem; + + /* verify that interpolation structure is provided */ + if ((ark_mem->interp == NULL) && (step_mem->predictor > 0) && (step_mem->predictor < 4)) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "arkStep_Predict", + "Interpolation structure is NULL"); + return(ARK_MEM_NULL); + } + + /* local shortcuts for use with fused vector operations */ + cvals = step_mem->cvals; + Xvecs = step_mem->Xvecs; + + /* if the first step, use initial condition as guess */ + if (ark_mem->initsetup) { + N_VScale(ONE, ark_mem->yn, yguess); + return(ARK_SUCCESS); + } + + /* set evaluation time tau as relative shift from previous successful time */ + tau = step_mem->Bi->c[istage]*ark_mem->h/ark_mem->hold; + + /* use requested predictor formula */ + switch (step_mem->predictor) { + + case 1: + + /***** Interpolatory Predictor 1 -- all to max order *****/ + retval = arkPredict_MaximumOrder(ark_mem, tau, yguess); + if (retval != ARK_ILL_INPUT) return(retval); + break; + + case 2: + + /***** Interpolatory Predictor 2 -- decrease order w/ increasing level of extrapolation *****/ + retval = arkPredict_VariableOrder(ark_mem, tau, yguess); + if (retval != ARK_ILL_INPUT) return(retval); + break; + + case 3: + + /***** Cutoff predictor: max order interpolatory output for stages "close" + to previous step, first-order predictor for subsequent stages *****/ + retval = arkPredict_CutoffOrder(ark_mem, tau, yguess); + if (retval != ARK_ILL_INPUT) return(retval); + break; + + case 4: + + /***** Bootstrap predictor: if any previous stage in step has nonzero c_i, + construct a quadratic Hermite interpolant for prediction; otherwise + use the trivial predictor. The actual calculations are performed in + arkPredict_Bootstrap, but here we need to determine the appropriate + stage, c_j, to use. *****/ + + /* determine if any previous stages in step meet criteria */ + jstage = -1; + for (i=0; iBi->c[i] != ZERO) ? i : jstage; + + /* if using the trivial predictor, break */ + if (jstage == -1) break; + + /* find the "optimal" previous stage to use */ + for (i=0; iBi->c[i] > step_mem->Bi->c[jstage]) && + (step_mem->Bi->c[i] != ZERO) ) + jstage = i; + + /* set stage time, stage RHS and interpolation values */ + h = ark_mem->h * step_mem->Bi->c[jstage]; + tau = ark_mem->h * step_mem->Bi->c[istage]; + nvec = 0; + if (step_mem->implicit) { /* Implicit piece */ + cvals[nvec] = ONE; + Xvecs[nvec] = step_mem->Fi[jstage]; + nvec += 1; + } + if (step_mem->explicit) { /* Explicit piece */ + cvals[nvec] = ONE; + Xvecs[nvec] = step_mem->Fe[jstage]; + nvec += 1; + } + + /* call predictor routine */ + retval = arkPredict_Bootstrap(ark_mem, h, tau, nvec, cvals, Xvecs, yguess); + if (retval != ARK_ILL_INPUT) return(retval); + break; + + case 5: + + /***** Minimal correction predictor: use all previous stage + information in this step *****/ + + /* set arrays for fused vector operation */ + nvec = 0; + if (step_mem->explicit) { /* Explicit pieces */ + for (jstage=0; jstageh * step_mem->Be->A[istage][jstage]; + Xvecs[nvec] = step_mem->Fe[jstage]; + nvec += 1; + } + } + if (step_mem->implicit) { /* Implicit pieces */ + for (jstage=0; jstageh * step_mem->Bi->A[istage][jstage]; + Xvecs[nvec] = step_mem->Fi[jstage]; + nvec += 1; + } + } + cvals[nvec] = ONE; + Xvecs[nvec] = ark_mem->yn; + nvec += 1; + + /* compute predictor */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, yguess); + if (retval != 0) return(ARK_VECTOROP_ERR); + return(ARK_SUCCESS); + break; + + } + + /* if we made it here, use the trivial predictor (previous step solution) */ + N_VScale(ONE, ark_mem->yn, yguess); + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_StageSetup + + This routine sets up the stage data for computing the RK + residual, along with the step- and method-related factors + gamma, gammap and gamrat. + + The internal behavior of this setup depends on two factors: + (a) whether the stage is explicit or implicit, and + (b) the form of mass matrix (I, M, M(t)). + + In each of the following: + * yn is the previous time step solution, + * r corresponds to the nonlinear residual, + * z=zp+zc corresponds to the updated stage solution, where + zp is the predictor (zp=yn for explicit stages), and zc + is the corrector, + * i is the current stage index, and + * g = h*Ai(i,i) is the implicit coefficient. + + Explicit, I: + z = yn + h*sum_{j=0}^{i-1} (Ae(i,j)*Fe(j) + Ai(i,j)*Fi(j)) + <=> + zc = h*sum_{j=0}^{i-1} (Ae(i,j)*Fe(j) + Ai(i,j)*Fi(j)) + This routine computes zc, stored in step_mem->sdata. + + Implicit, I: + z = yn - h*sum_{j=0}^{i-1} Ae(i,j)*Fe(j) + - h*sum_{j=0}^{i} Ai(i,j)*Fi(j) + <=> + r = zc - g*Fi(i) - s + s = yn - zp + h*sum_{j=0}^{i-1} (Ae(i,j)*Fe(j) + Ai(i,j)*Fi(j)) + This routine computes s, stored in step_mem->sdata. + + Explicit, M: + M*z = M*yn + h*sum_{j=0}^{i-1} (Ae(i,j)*Fe(j) + Ai(i,j)*Fi(j)) + <=> + M*zc = s + s = h*sum_{j=0}^{i-1} (Ae(i,j)*Fe(j) + Ai(i,j)*Fi(j)) + This routine computes s, stored in step_mem->sdata. + + Implicit, M: + M*z = M*yn + h*sum_{j=0}^{i-1} Ae(i,j)*Fe(j) + + h*sum_{j=0}^{i} Ai(i,j)*Fi(j) + <=> + r = M*zc - g*Fi(i) - s + s = M*(yn - zp) + h*sum_{j=0}^{i-1} (Ae(i,j)*Fe(j) + Ai(i,j)*Fi(j)) + This routine computes s, stored in step_mem->sdata. + + Explicit, M(t): + z = yn + h*sum_{j=0}^{i-1} (Ae(i,j)*Fe(j)+Ai(i,j)*Fi(j)) + <=> + zc = h*sum_{j=0}^{i-1} (Ae(i,j)*Fe(j)+Ai(i,j)*Fi(j)) + This routine computes zc, stored in step_mem->sdata. + + Implicit, M(t): + M(t)*z = M(t)*yn + h*sum_{j=0}^{i-1} Ae(i,j)*Fe(j) + + h*sum_{j=0}^{i} Ai(i,j)*Fi(j) + <=> + r = M(t)*(zc - s) - g*Fi(i) + s = yn - zp + h*sum_{j=0}^{i-1} (Ae(i,j)*Fe(j) + Ai(i,j)*Fi(j)) + This routine computes s, stored in step_mem->sdata. + + + Thus _internal_ to this routine, we have 3 modes: + + Explicit (any): + sdata = h*sum_{j=0}^{i-1} (Ae(i,j)*Fe(j) + Ai(i,j)*Fi(j)) + Implicit, M: + sdata = M*(yn - zp) + h*sum_{j=0}^{i-1} (Ae(i,j)*Fe(j) + Ai(i,j)*Fi(j)) + Implicit, I or M(t): + sdata = yn - zp + h*sum_{j=0}^{i-1} (Ae(i,j)*Fe(j) + Ai(i,j)*Fi(j)) + + ---------------------------------------------------------------*/ +int arkStep_StageSetup(ARKodeMem ark_mem, booleantype implicit) +{ + /* local data */ + ARKodeARKStepMem step_mem; + int retval, i, j, nvec; + realtype* cvals; + N_Vector* Xvecs; + + /* access ARKodeARKStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "arkStep_StageSetup", MSG_ARKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeARKStepMem) ark_mem->step_mem; + + /* Set shortcut to current stage index */ + i = step_mem->istage; + + /* If this is the first stage, and explicit, just set sdata=0 and return */ + if (!implicit && (i==0)) { + N_VConst(ZERO, step_mem->sdata); + return (ARK_SUCCESS); + } + + /* local shortcuts for fused vector operations */ + cvals = step_mem->cvals; + Xvecs = step_mem->Xvecs; + + /* Update gamma if stage is implicit */ + if (implicit) { + step_mem->gamma = ark_mem->h * step_mem->Bi->A[i][i]; + if (ark_mem->firststage) + step_mem->gammap = step_mem->gamma; + step_mem->gamrat = (ark_mem->firststage) ? + ONE : step_mem->gamma / step_mem->gammap; /* protect x/x != 1.0 */ + } + + /* If predictor==5, then sdata=0 (plus any implicit forcing). + Set sdata appropriately and return */ + if (implicit && (step_mem->predictor == 5)) { + + /* apply external polynomial forcing (updates nvec, cvals, Xvecs) */ + if (step_mem->impforcing) { + nvec = 0; + arkStep_ApplyForcing(step_mem, ark_mem->tcur, step_mem->gamma, &nvec); + retval = N_VLinearCombination(nvec, cvals, Xvecs, step_mem->sdata); + if (retval != 0) return(ARK_VECTOROP_ERR); + } else { + N_VConst(ZERO, step_mem->sdata); + } + return (ARK_SUCCESS); + + } + + /* If implicit, initialize sdata to yn - zpred (here: zpred = zp), and set + first entries for eventual N_VLinearCombination call */ + nvec = 0; + if (implicit) { + N_VLinearSum(ONE, ark_mem->yn, -ONE, step_mem->zpred, step_mem->sdata); + cvals[0] = ONE; + Xvecs[0] = step_mem->sdata; + nvec = 1; + } + + /* If implicit with fixed M!=I, update sdata with M*sdata */ + if (implicit && (step_mem->mass_type == MASS_FIXED)) { + N_VScale(ONE, step_mem->sdata, ark_mem->tempv1); + retval = step_mem->mmult((void *) ark_mem, ark_mem->tempv1, step_mem->sdata); + if (retval != ARK_SUCCESS) return (ARK_MASSMULT_FAIL); + } + + /* Update sdata with prior stage information */ + if (step_mem->explicit) { /* Explicit pieces */ + for (j=0; jh * step_mem->Be->A[i][j]; + Xvecs[nvec] = step_mem->Fe[j]; + nvec += 1; + } + } + if (step_mem->implicit) { /* Implicit pieces */ + for (j=0; jh * step_mem->Bi->A[i][j]; + Xvecs[nvec] = step_mem->Fi[j]; + nvec += 1; + } + } + + /* apply external polynomial forcing (updates nvec, cvals, Xvecs) */ + if (step_mem->impforcing) { + arkStep_ApplyForcing(step_mem, ark_mem->tcur, + ark_mem->h * step_mem->Bi->A[i][i], &nvec); + } + + /* call fused vector operation to do the work */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, step_mem->sdata); + if (retval != 0) return(ARK_VECTOROP_ERR); + + /* return with success */ + return (ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_ComputeSolutions + + This routine calculates the final RK solution using the existing + data. This solution is placed directly in ark_ycur. This routine + also computes the error estimate ||y-ytilde||_WRMS, where ytilde + is the embedded solution, and the norm weights come from + ark_ewt. This norm value is returned. The vector form of this + estimated error (y-ytilde) is stored in ark_mem->tempv1, in case + the calling routine wishes to examine the error locations. + + This version assumes either an identity or time-dependent mass + matrix (identical steps). + ---------------------------------------------------------------*/ +int arkStep_ComputeSolutions(ARKodeMem ark_mem, realtype *dsmPtr) +{ + /* local data */ + int retval, j, nvec; + N_Vector y, yerr; + realtype* cvals; + N_Vector* Xvecs; + ARKodeARKStepMem step_mem; + + /* access ARKodeARKStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "arkStep_ComputeSolutions", MSG_ARKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeARKStepMem) ark_mem->step_mem; + + /* set N_Vector shortcuts, and shortcut to time at end of step */ + y = ark_mem->ycur; + yerr = ark_mem->tempv1; + + /* local shortcuts for fused vector operations */ + cvals = step_mem->cvals; + Xvecs = step_mem->Xvecs; + + /* initialize output */ + *dsmPtr = ZERO; + + /* Compute time step solution */ + /* set arrays for fused vector operation */ + cvals[0] = ONE; + Xvecs[0] = ark_mem->yn; + nvec = 1; + for (j=0; jstages; j++) { + if (step_mem->explicit) { /* Explicit pieces */ + cvals[nvec] = ark_mem->h * step_mem->Be->b[j]; + Xvecs[nvec] = step_mem->Fe[j]; + nvec += 1; + } + if (step_mem->implicit) { /* Implicit pieces */ + cvals[nvec] = ark_mem->h * step_mem->Bi->b[j]; + Xvecs[nvec] = step_mem->Fi[j]; + nvec += 1; + } + } + + /* call fused vector operation to do the work */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, y); + if (retval != 0) return(ARK_VECTOROP_ERR); + + /* Compute yerr (if step adaptivity enabled) */ + if (!ark_mem->fixedstep) { + + /* set arrays for fused vector operation */ + nvec = 0; + for (j=0; jstages; j++) { + if (step_mem->explicit) { /* Explicit pieces */ + cvals[nvec] = ark_mem->h * (step_mem->Be->b[j] - step_mem->Be->d[j]); + Xvecs[nvec] = step_mem->Fe[j]; + nvec += 1; + } + if (step_mem->implicit) { /* Implicit pieces */ + cvals[nvec] = ark_mem->h * (step_mem->Bi->b[j] - step_mem->Bi->d[j]); + Xvecs[nvec] = step_mem->Fi[j]; + nvec += 1; + } + } + + /* call fused vector operation to do the work */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, yerr); + if (retval != 0) return(ARK_VECTOROP_ERR); + + /* fill error norm */ + *dsmPtr = N_VWrmsNorm(yerr, ark_mem->ewt); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_ComputeSolutions_MassFixed + + This routine calculates the final RK solution using the existing + data. This solution is placed directly in ark_ycur. This routine + also computes the error estimate ||y-ytilde||_WRMS, where ytilde + is the embedded solution, and the norm weights come from + ark_ewt. This norm value is returned. The vector form of this + estimated error (y-ytilde) is stored in ark_mem->tempv1, in case + the calling routine wishes to examine the error locations. + + This version assumes a fixed mass matrix. + ---------------------------------------------------------------*/ +int arkStep_ComputeSolutions_MassFixed(ARKodeMem ark_mem, realtype *dsmPtr) +{ + /* local data */ + int retval, j, nvec; + N_Vector y, yerr; + realtype* cvals; + N_Vector* Xvecs; + ARKodeARKStepMem step_mem; + + /* access ARKodeARKStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "arkStep_ComputeSolutions_MassFixed", MSG_ARKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeARKStepMem) ark_mem->step_mem; + + /* set N_Vector shortcuts, and shortcut to time at end of step */ + y = ark_mem->ycur; + yerr = ark_mem->tempv1; + + /* local shortcuts for fused vector operations */ + cvals = step_mem->cvals; + Xvecs = step_mem->Xvecs; + + /* initialize output */ + *dsmPtr = ZERO; + + /* compute y RHS (store in y) */ + /* set arrays for fused vector operation */ + nvec = 0; + for (j=0; jstages; j++) { + if (step_mem->explicit) { /* Explicit pieces */ + cvals[nvec] = ark_mem->h * step_mem->Be->b[j]; + Xvecs[nvec] = step_mem->Fe[j]; + nvec += 1; + } + if (step_mem->implicit) { /* Implicit pieces */ + cvals[nvec] = ark_mem->h * step_mem->Bi->b[j]; + Xvecs[nvec] = step_mem->Fi[j]; + nvec += 1; + } + } + + /* call fused vector operation to compute RHS */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, y); + if (retval != 0) return(ARK_VECTOROP_ERR); + + /* solve for y update (stored in y) */ + retval = step_mem->msolve((void *) ark_mem, y, step_mem->nlscoef); + if (retval < 0) { + *dsmPtr = RCONST(2.0); /* indicate too much error, step with smaller step */ + N_VScale(ONE, ark_mem->yn, y); /* place old solution into y */ + return(CONV_FAIL); + } + + /* compute y = yn + update */ + N_VLinearSum(ONE, ark_mem->yn, ONE, y, y); + + + /* compute yerr (if step adaptivity enabled) */ + if (!ark_mem->fixedstep) { + + /* compute yerr RHS vector */ + /* set arrays for fused vector operation */ + nvec = 0; + for (j=0; jstages; j++) { + if (step_mem->explicit) { /* Explicit pieces */ + cvals[nvec] = ark_mem->h * (step_mem->Be->b[j] - step_mem->Be->d[j]); + Xvecs[nvec] = step_mem->Fe[j]; + nvec += 1; + } + if (step_mem->implicit) { /* Implicit pieces */ + cvals[nvec] = ark_mem->h * (step_mem->Bi->b[j] - step_mem->Bi->d[j]); + Xvecs[nvec] = step_mem->Fi[j]; + nvec += 1; + } + } + + /* call fused vector operation to compute yerr RHS */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, yerr); + if (retval != 0) return(ARK_VECTOROP_ERR); + + /* solve for yerr */ + retval = step_mem->msolve((void *) ark_mem, yerr, step_mem->nlscoef); + if (retval < 0) { + *dsmPtr = RCONST(2.0); /* next attempt will reduce step by 'etacf'; + insert dsmPtr placeholder here */ + return(CONV_FAIL); + } + /* fill error norm */ + *dsmPtr = N_VWrmsNorm(yerr, ark_mem->ewt); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + Utility routines for interfacing with MRIStep + ---------------------------------------------------------------*/ + + +/*------------------------------------------------------------------------------ + ARKStepCreateMRIStepInnerStepper + + Wraps an ARKStep memory structure as an MRIStep inner stepper. + ----------------------------------------------------------------------------*/ + +int ARKStepCreateMRIStepInnerStepper(void *inner_arkode_mem, + MRIStepInnerStepper *stepper) +{ + int retval; + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + + retval = arkStep_AccessStepMem(inner_arkode_mem, + "ARKStepCreateMRIStepInnerStepper", + &ark_mem, &step_mem); + if (retval) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKODE::ARKStep", + "ARKStepCreateMRIStepInnerStepper", + "The ARKStep memory pointer is NULL"); + return ARK_ILL_INPUT; + } + + retval = MRIStepInnerStepper_Create(ark_mem->sunctx, stepper); + if (retval != ARK_SUCCESS) return(retval); + + retval = MRIStepInnerStepper_SetContent(*stepper, inner_arkode_mem); + if (retval != ARK_SUCCESS) return(retval); + + retval = MRIStepInnerStepper_SetEvolveFn(*stepper, + arkStep_MRIStepInnerEvolve); + if (retval != ARK_SUCCESS) return(retval); + + retval = MRIStepInnerStepper_SetFullRhsFn(*stepper, + arkStep_MRIStepInnerFullRhs); + if (retval != ARK_SUCCESS) return(retval); + + retval = MRIStepInnerStepper_SetResetFn(*stepper, + arkStep_MRIStepInnerReset); + if (retval != ARK_SUCCESS) return(retval); + + return(ARK_SUCCESS); +} + + +/*------------------------------------------------------------------------------ + arkStep_MRIStepInnerEvolve + + Implementation of MRIStepInnerStepperEvolveFn to advance the inner (fast) + ODE IVP. + ----------------------------------------------------------------------------*/ + +int arkStep_MRIStepInnerEvolve(MRIStepInnerStepper stepper, realtype t0, + realtype tout, N_Vector y) +{ + void* arkode_mem; /* arkode memory */ + realtype tret; /* return time */ + realtype tshift, tscale; /* time normalization values */ + N_Vector *forcing; /* forcing vectors */ + int nforcing; /* number of forcing vectors */ + int retval; /* return value */ + + /* extract the ARKODE memory struct */ + retval = MRIStepInnerStepper_GetContent(stepper, &arkode_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* get the forcing data */ + retval = MRIStepInnerStepper_GetForcingData(stepper, + &tshift, &tscale, + &forcing, &nforcing); + if (retval != ARK_SUCCESS) return(retval); + + /* set the inner forcing data */ + retval = arkStep_SetInnerForcing(arkode_mem, tshift, tscale, + forcing, nforcing); + if (retval != ARK_SUCCESS) return(retval); + + /* set the stop time */ + retval = ARKStepSetStopTime(arkode_mem, tout); + if (retval != ARK_SUCCESS) return(retval); + + /* evolve inner ODE */ + retval = ARKStepEvolve(arkode_mem, tout, y, &tret, ARK_NORMAL); + if (retval < 0) return(retval); + + /* disable inner forcing */ + retval = arkStep_SetInnerForcing(arkode_mem, ZERO, ONE, NULL, 0); + if (retval != ARK_SUCCESS) return(retval); + + return(ARK_SUCCESS); +} + + +/*------------------------------------------------------------------------------ + arkStep_MRIStepInnerFullRhs + + Implementation of MRIStepInnerStepperFullRhsFn to compute the full inner + (fast) ODE IVP RHS. + ----------------------------------------------------------------------------*/ + +int arkStep_MRIStepInnerFullRhs(MRIStepInnerStepper stepper, realtype t, + N_Vector y, N_Vector f, int mode) +{ + void* arkode_mem; + int retval; + + /* extract the ARKODE memory struct */ + retval = MRIStepInnerStepper_GetContent(stepper, &arkode_mem); + if (retval != ARK_SUCCESS) return(retval); + + return(arkStep_FullRHS(arkode_mem, t, y, f, mode)); +} + + +/*------------------------------------------------------------------------------ + arkStep_MRIStepInnerReset + + Implementation of MRIStepInnerStepperResetFn to reset the inner (fast) stepper + state. + ----------------------------------------------------------------------------*/ + +int arkStep_MRIStepInnerReset(MRIStepInnerStepper stepper, realtype tR, + N_Vector yR) +{ + void* arkode_mem; + int retval; + + /* extract the ARKODE memory struct */ + retval = MRIStepInnerStepper_GetContent(stepper, &arkode_mem); + if (retval != ARK_SUCCESS) return(retval); + + return(ARKStepReset(arkode_mem, tR, yR)); +} + + +/*------------------------------------------------------------------------------ + arkStep_ApplyForcing + + Determines the linear combination coefficients and vectors to apply forcing + at a given value of the independent variable (t). This occurs through + appending coefficients and N_Vector pointers to the underlying cvals and Xvecs + arrays in the step_mem structure. The dereferenced input *nvec should indicate + the next available entry in the cvals/Xvecs arrays. The input 's' is a + scaling factor that should be applied to each of these coefficients. + ----------------------------------------------------------------------------*/ + +void arkStep_ApplyForcing(ARKodeARKStepMem step_mem, realtype t, + realtype s, int *nvec) +{ + realtype tau, taui; + int i; + + /* always append the constant forcing term */ + step_mem->cvals[*nvec] = s; + step_mem->Xvecs[*nvec] = step_mem->forcing[0]; + (*nvec) += 1; + + /* compute normalized time tau and initialize tau^i */ + tau = (t - step_mem->tshift) / (step_mem->tscale); + taui = tau; + for (i=1; inforcing; i++) { + step_mem->cvals[*nvec] = s*taui; + step_mem->Xvecs[*nvec] = step_mem->forcing[i]; + taui *= tau; + (*nvec) += 1; + } +} + +/*------------------------------------------------------------------------------ + arkStep_SetInnerForcing + + Sets an array of coefficient vectors for a time-dependent external polynomial + forcing term in the ODE RHS i.e., y' = fe(t,y) + fi(t,y) + p(t). This + function is primarily intended for use with multirate integration methods + (e.g., MRIStep) where ARKStep is used to solve a modified ODE at a fast time + scale. The polynomial is of the form + + p(t) = sum_{i = 0}^{nvecs - 1} forcing[i] * ((t - tshift) / (tscale))^i + + where tshift and tscale are used to normalize the time t (e.g., with MRIGARK + methods). + ----------------------------------------------------------------------------*/ + +int arkStep_SetInnerForcing(void* arkode_mem, realtype tshift, realtype tscale, + N_Vector* forcing, int nvecs) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_SetInnerForcing", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + if (nvecs > 0) { + + /* enable forcing */ + if (step_mem->explicit) { + step_mem->expforcing = SUNTRUE; + step_mem->impforcing = SUNFALSE; + } else { + step_mem->expforcing = SUNFALSE; + step_mem->impforcing = SUNTRUE; + } + step_mem->tshift = tshift; + step_mem->tscale = tscale; + step_mem->forcing = forcing; + step_mem->nforcing = nvecs; + + /* If cvals and Xvecs are not allocated then arkStep_Init has not been + called and the number of stages has not been set yet. These arrays will + be allocated in arkStep_Init and take into account the value of nforcing. + On subsequent calls will check if enough space has allocated in case + nforcing has increased since the original allocation. */ + if (step_mem->cvals != NULL && step_mem->Xvecs != NULL) { + + /* check if there are enough reusable arrays for fused operations */ + if ((step_mem->nfusedopvecs - nvecs) < (2 * step_mem->stages + 2)) { + + /* free current work space */ + if (step_mem->cvals != NULL) { + free(step_mem->cvals); + ark_mem->lrw -= step_mem->nfusedopvecs; + } + if (step_mem->Xvecs != NULL) { + free(step_mem->Xvecs); + ark_mem->liw -= step_mem->nfusedopvecs; + } + + /* allocate reusable arrays for fused vector operations */ + step_mem->nfusedopvecs = 2 * step_mem->stages + 2 + nvecs; + + step_mem->cvals = NULL; + step_mem->cvals = (realtype *) calloc(step_mem->nfusedopvecs, + sizeof(realtype)); + if (step_mem->cvals == NULL) return(ARK_MEM_FAIL); + ark_mem->lrw += step_mem->nfusedopvecs; + + step_mem->Xvecs = NULL; + step_mem->Xvecs = (N_Vector *) calloc(step_mem->nfusedopvecs, + sizeof(N_Vector)); + if (step_mem->Xvecs == NULL) return(ARK_MEM_FAIL); + ark_mem->liw += step_mem->nfusedopvecs; + } + } + + } else { + + /* disable forcing */ + step_mem->expforcing = SUNFALSE; + step_mem->impforcing = SUNFALSE; + step_mem->tshift = ZERO; + step_mem->tscale = ONE; + step_mem->forcing = NULL; + step_mem->nforcing = 0; + + } + + return(0); +} + +/*=============================================================== + EOF + ===============================================================*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_arkstep_impl.h b/lib/sundials_6.1.1/src/arkode/arkode_arkstep_impl.h new file mode 100644 index 00000000000..fa1538ca617 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_arkstep_impl.h @@ -0,0 +1,247 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * Implementation header file for ARKode's ARK time stepper + * module. + *--------------------------------------------------------------*/ + +#ifndef _ARKODE_ARKSTEP_IMPL_H +#define _ARKODE_ARKSTEP_IMPL_H + +#include +#include "arkode_impl.h" +#include "arkode_ls_impl.h" + +/* access to MRIStepInnerStepper_Create */ +#include "arkode/arkode_mristep.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*=============================================================== + ARK time step module constants + ===============================================================*/ + +#define MAXCOR 3 /* max number of nonlinear iterations */ +#define CRDOWN RCONST(0.3) /* constant to estimate the convergence + rate for the nonlinear equation */ +#define DGMAX RCONST(0.2) /* if |gamma/gammap-1| > DGMAX then call lsetup */ +#define RDIV RCONST(2.3) /* declare divergence if ratio del/delp > RDIV */ +#define MSBP 20 /* max no. of steps between lsetup calls */ + +/* Default solver tolerance factor */ +/* #define NLSCOEF RCONST(0.003) */ /* Hairer & Wanner constant */ +/* #define NLSCOEF RCONST(0.2) */ /* CVODE constant */ +#define NLSCOEF RCONST(0.1) + +/* Mass matrix types */ +#define MASS_IDENTITY 0 +#define MASS_FIXED 1 +#define MASS_TIMEDEP 2 + + +/*=============================================================== + ARK time step module data structure + ===============================================================*/ + +/*--------------------------------------------------------------- + Types : struct ARKodeARKStepMemRec, ARKodeARKStepMem + --------------------------------------------------------------- + The type ARKodeARKStepMem is type pointer to struct + ARKodeARKStepMemRec. This structure contains fields to + perform an additive Runge-Kutta time step. + ---------------------------------------------------------------*/ +typedef struct ARKodeARKStepMemRec { + + /* ARK problem specification */ + ARKRhsFn fe; /* My' = fe(t,y) + fi(t,y) */ + ARKRhsFn fi; + booleantype linear; /* SUNTRUE if fi is linear */ + booleantype linear_timedep; /* SUNTRUE if dfi/dy depends on t */ + booleantype explicit; /* SUNTRUE if fe is enabled */ + booleantype implicit; /* SUNTRUE if fi is enabled */ + + /* ARK method storage and parameters */ + N_Vector *Fe; /* explicit RHS at each stage */ + N_Vector *Fi; /* implicit RHS at each stage */ + N_Vector sdata; /* old stage data in residual */ + N_Vector zpred; /* predicted stage solution */ + N_Vector zcor; /* stage correction */ + int q; /* method order */ + int p; /* embedding order */ + int istage; /* current stage */ + int stages; /* number of stages */ + ARKodeButcherTable Be; /* ERK Butcher table */ + ARKodeButcherTable Bi; /* IRK Butcher table */ + + /* User-supplied stage predictor routine */ + ARKStagePredictFn stage_predict; + + /* (Non)Linear solver parameters & data */ + SUNNonlinearSolver NLS; /* generic SUNNonlinearSolver object */ + booleantype ownNLS; /* flag indicating ownership of NLS */ + ARKRhsFn nls_fi; /* fi(t,y) used in the nonlinear solver */ + realtype gamma; /* gamma = h * A(i,i) */ + realtype gammap; /* gamma at the last setup call */ + realtype gamrat; /* gamma / gammap */ + realtype dgmax; /* call lsetup if |gamma/gammap-1| >= dgmax */ + + int predictor; /* implicit prediction method to use */ + realtype crdown; /* nonlinear conv rate estimation constant */ + realtype rdiv; /* nonlin divergence if del/delp > rdiv */ + realtype crate; /* estimated nonlin convergence rate */ + realtype delp; /* norm of previous nonlinear solver update */ + realtype eRNrm; /* estimated residual norm, used in nonlin + and linear solver convergence tests */ + realtype nlscoef; /* coefficient in nonlin. convergence test */ + + int msbp; /* positive => max # steps between lsetup + negative => call at each Newton iter */ + long int nstlp; /* step number of last setup call */ + + int maxcor; /* max num iterations for solving the + nonlinear equation */ + + int convfail; /* NLS fail flag (for interface routines) */ + booleantype jcur; /* is Jacobian info for lin solver current? */ + + /* Linear Solver Data */ + ARKLinsolInitFn linit; + ARKLinsolSetupFn lsetup; + ARKLinsolSolveFn lsolve; + ARKLinsolFreeFn lfree; + void *lmem; + SUNLinearSolver_Type lsolve_type; + + /* Mass matrix solver data */ + ARKMassInitFn minit; + ARKMassSetupFn msetup; + ARKMassMultFn mmult; + ARKMassSolveFn msolve; + ARKMassFreeFn mfree; + void* mass_mem; + int mass_type; /* 0=identity, 1=fixed, 2=time-dep */ + SUNLinearSolver_Type msolve_type; + + /* Counters */ + long int nfe; /* num fe calls */ + long int nfi; /* num fi calls */ + long int nsetups; /* num setup calls */ + long int nls_iters; /* num nonlinear solver iters */ + + /* Reusable arrays for fused vector operations */ + realtype *cvals; /* scalar array for fused ops */ + N_Vector *Xvecs; /* array of vectors for fused ops */ + int nfusedopvecs; /* length of cvals and Xvecs arrays */ + + /* Data for using ARKStep with external polynomial forcing */ + booleantype expforcing; /* add forcing to explicit RHS */ + booleantype impforcing; /* add forcing to implicit RHS */ + realtype tshift; /* time normalization shift */ + realtype tscale; /* time normalization scaling */ + N_Vector* forcing; /* array of forcing vectors */ + int nforcing; /* number of forcing vectors */ + +} *ARKodeARKStepMem; + + +/*=============================================================== + ARK time step module private function prototypes + ===============================================================*/ + +/* Interface routines supplied to ARKode */ +int arkStep_AttachLinsol(void* arkode_mem, ARKLinsolInitFn linit, + ARKLinsolSetupFn lsetup, + ARKLinsolSolveFn lsolve, + ARKLinsolFreeFn lfree, + SUNLinearSolver_Type lsolve_type, + void *lmem); +int arkStep_AttachMasssol(void* arkode_mem, + ARKMassInitFn minit, + ARKMassSetupFn msetup, + ARKMassMultFn mmult, + ARKMassSolveFn msolve, + ARKMassFreeFn lfree, + booleantype time_dep, + SUNLinearSolver_Type msolve_type, + void *mass_mem); +void arkStep_DisableLSetup(void* arkode_mem); +void arkStep_DisableMSetup(void* arkode_mem); +int arkStep_Init(void* arkode_mem, int init_type); +void* arkStep_GetLmem(void* arkode_mem); +void* arkStep_GetMassMem(void* arkode_mem); +ARKRhsFn arkStep_GetImplicitRHS(void* arkode_mem); +int arkStep_GetGammas(void* arkode_mem, realtype *gamma, + realtype *gamrat, booleantype **jcur, + booleantype *dgamma_fail); +int arkStep_FullRHS(void* arkode_mem, realtype t, + N_Vector y, N_Vector f, int mode); +int arkStep_TakeStep_Z(void* arkode_mem, realtype *dsmPtr, int *nflagPtr); + +/* Internal utility routines */ +int arkStep_AccessStepMem(void* arkode_mem, const char *fname, + ARKodeMem *ark_mem, ARKodeARKStepMem *step_mem); +booleantype arkStep_CheckNVector(N_Vector tmpl); +int arkStep_SetButcherTables(ARKodeMem ark_mem); +int arkStep_CheckButcherTables(ARKodeMem ark_mem); +int arkStep_Predict(ARKodeMem ark_mem, int istage, N_Vector yguess); +int arkStep_StageSetup(ARKodeMem ark_mem, booleantype implicit); +int arkStep_NlsInit(ARKodeMem ark_mem); +int arkStep_Nls(ARKodeMem ark_mem, int nflag); +int arkStep_ComputeSolutions(ARKodeMem ark_mem, realtype *dsm); +int arkStep_ComputeSolutions_MassFixed(ARKodeMem ark_mem, realtype *dsm); +void arkStep_ApplyForcing(ARKodeARKStepMem step_mem, realtype t, + realtype s, int *nvec); + +/* private functions passed to nonlinear solver */ +int arkStep_NlsResidual_MassIdent(N_Vector zcor, N_Vector r, void* arkode_mem); +int arkStep_NlsResidual_MassFixed(N_Vector zcor, N_Vector r, void* arkode_mem); +int arkStep_NlsResidual_MassTDep(N_Vector zcor, N_Vector r, void* arkode_mem); +int arkStep_NlsFPFunction_MassIdent(N_Vector zcor, N_Vector g, void* arkode_mem); +int arkStep_NlsFPFunction_MassFixed(N_Vector zcor, N_Vector g, void* arkode_mem); +int arkStep_NlsFPFunction_MassTDep(N_Vector zcor, N_Vector g, void* arkode_mem); +int arkStep_NlsLSetup(booleantype jbad, booleantype* jcur, void* arkode_mem); +int arkStep_NlsLSolve(N_Vector delta, void* arkode_mem); +int arkStep_NlsConvTest(SUNNonlinearSolver NLS, N_Vector y, N_Vector del, + realtype tol, N_Vector ewt, void* arkode_mem); + +/* private functions for interfacing with MRIStep */ +int arkStep_SetInnerForcing(void* arkode_mem, realtype tshift, realtype tscale, + N_Vector *f, int nvecs); +int arkStep_MRIStepInnerEvolve(MRIStepInnerStepper stepper, + realtype t0, realtype tout, N_Vector y); +int arkStep_MRIStepInnerFullRhs(MRIStepInnerStepper stepper, realtype t, + N_Vector y, N_Vector f, int mode); +int arkStep_MRIStepInnerReset(MRIStepInnerStepper stepper, realtype tR, + N_Vector yR); + + +/*=============================================================== + Reusable ARKStep Error Messages + ===============================================================*/ + +/* Initialization and I/O error messages */ +#define MSG_ARKSTEP_NO_MEM "Time step module memory is NULL." +#define MSG_NLS_INIT_FAIL "The nonlinear solver's init routine failed." + +/* Other error messages */ +#define MSG_ARK_MISSING_FE "Cannot specify that method is explicit without providing a function pointer to fe(t,y)." +#define MSG_ARK_MISSING_FI "Cannot specify that method is implicit without providing a function pointer to fi(t,y)." +#define MSG_ARK_MISSING_F "Cannot specify that method is ImEx without providing function pointers to fi(t,y) and fe(t,y)." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/src/arkode/arkode_arkstep_io.c b/lib/sundials_6.1.1/src/arkode/arkode_arkstep_io.c new file mode 100644 index 00000000000..6738667f6af --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_arkstep_io.c @@ -0,0 +1,1665 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * This is the implementation file for the optional input and + * output functions for the ARKode ARKStep time stepper module. + * + * NOTE: many functions currently in arkode_io.c will move here, + * with slightly different names. The code transition will be + * minimal, but the documentation changes will be significant. + *--------------------------------------------------------------*/ + +#include +#include + +#include "arkode_arkstep_impl.h" +#include +#include + + +/*=============================================================== + ARKStep Optional input functions (wrappers for generic ARKode + utility routines). All are documented in arkode_io.c. + ===============================================================*/ +int ARKStepSetDenseOrder(void *arkode_mem, int dord) { + return(ARKStepSetInterpolantDegree(arkode_mem, dord)); } +int ARKStepSetInterpolantDegree(void *arkode_mem, int degree) { + if (degree < 0) degree = ARK_INTERP_MAX_DEGREE; + return(arkSetInterpolantDegree(arkode_mem, degree)); } +int ARKStepSetInterpolantType(void *arkode_mem, int itype) { + return(arkSetInterpolantType(arkode_mem, itype)); } +int ARKStepSetErrHandlerFn(void *arkode_mem, ARKErrHandlerFn ehfun, + void *eh_data) { + return(arkSetErrHandlerFn(arkode_mem, ehfun, eh_data)); } +int ARKStepSetErrFile(void *arkode_mem, FILE *errfp) { + return(arkSetErrFile(arkode_mem, errfp)); } +int ARKStepSetDiagnostics(void *arkode_mem, FILE *diagfp) { + return(arkSetDiagnostics(arkode_mem, diagfp)); } +int ARKStepSetMaxNumSteps(void *arkode_mem, long int mxsteps) { + return(arkSetMaxNumSteps(arkode_mem, mxsteps)); } +int ARKStepSetMaxHnilWarns(void *arkode_mem, int mxhnil) { + return(arkSetMaxHnilWarns(arkode_mem, mxhnil)); } +int ARKStepSetInitStep(void *arkode_mem, realtype hin) { + return(arkSetInitStep(arkode_mem, hin)); } +int ARKStepSetMinStep(void *arkode_mem, realtype hmin) { + return(arkSetMinStep(arkode_mem, hmin)); } +int ARKStepSetMaxStep(void *arkode_mem, realtype hmax) { + return(arkSetMaxStep(arkode_mem, hmax)); } +int ARKStepSetStopTime(void *arkode_mem, realtype tstop) { + return(arkSetStopTime(arkode_mem, tstop)); } +int ARKStepSetRootDirection(void *arkode_mem, int *rootdir) { + return(arkSetRootDirection(arkode_mem, rootdir)); } +int ARKStepSetNoInactiveRootWarn(void *arkode_mem) { + return(arkSetNoInactiveRootWarn(arkode_mem)); } +int ARKStepSetConstraints(void *arkode_mem, N_Vector constraints) { + return(arkSetConstraints(arkode_mem, constraints)); } +int ARKStepSetMaxNumConstrFails(void *arkode_mem, int maxfails) { + return(arkSetMaxNumConstrFails(arkode_mem, maxfails)); } +int ARKStepSetPostprocessStepFn(void *arkode_mem, + ARKPostProcessFn ProcessStep) { + return(arkSetPostprocessStepFn(arkode_mem, ProcessStep)); } +int ARKStepSetPostprocessStageFn(void *arkode_mem, + ARKPostProcessFn ProcessStage) { + return(arkSetPostprocessStageFn(arkode_mem, ProcessStage)); } +int ARKStepSetCFLFraction(void *arkode_mem, realtype cfl_frac) { + return(arkSetCFLFraction(arkode_mem, cfl_frac)); } +int ARKStepSetSafetyFactor(void *arkode_mem, realtype safety) { + return(arkSetSafetyFactor(arkode_mem, safety)); } +int ARKStepSetErrorBias(void *arkode_mem, realtype bias) { + return(arkSetErrorBias(arkode_mem, bias)); } +int ARKStepSetMaxGrowth(void *arkode_mem, realtype mx_growth) { + return(arkSetMaxGrowth(arkode_mem, mx_growth)); } +int ARKStepSetMinReduction(void *arkode_mem, realtype eta_min) { + return(arkSetMinReduction(arkode_mem, eta_min)); } +int ARKStepSetFixedStepBounds(void *arkode_mem, realtype lb, realtype ub) { + return(arkSetFixedStepBounds(arkode_mem, lb, ub)); } +int ARKStepSetAdaptivityMethod(void *arkode_mem, int imethod, int idefault, + int pq, realtype adapt_params[3]) { + return(arkSetAdaptivityMethod(arkode_mem, imethod, idefault, pq, adapt_params)); } +int ARKStepSetAdaptivityFn(void *arkode_mem, ARKAdaptFn hfun, void *h_data) { + return(arkSetAdaptivityFn(arkode_mem, hfun, h_data)); } +int ARKStepSetMaxFirstGrowth(void *arkode_mem, realtype etamx1) { + return(arkSetMaxFirstGrowth(arkode_mem, etamx1)); } +int ARKStepSetMaxEFailGrowth(void *arkode_mem, realtype etamxf) { + return(arkSetMaxEFailGrowth(arkode_mem, etamxf)); } +int ARKStepSetSmallNumEFails(void *arkode_mem, int small_nef) { + return(arkSetSmallNumEFails(arkode_mem, small_nef)); } +int ARKStepSetMaxCFailGrowth(void *arkode_mem, realtype etacf) { + return(arkSetMaxCFailGrowth(arkode_mem, etacf)); } +int ARKStepSetStabilityFn(void *arkode_mem, ARKExpStabFn EStab, void *estab_data) { + return(arkSetStabilityFn(arkode_mem, EStab, estab_data)); } +int ARKStepSetMaxErrTestFails(void *arkode_mem, int maxnef) { + return(arkSetMaxErrTestFails(arkode_mem, maxnef)); } +int ARKStepSetMaxConvFails(void *arkode_mem, int maxncf) { + return(arkSetMaxConvFails(arkode_mem, maxncf)); } +int ARKStepSetFixedStep(void *arkode_mem, realtype hfixed) { + return(arkSetFixedStep(arkode_mem, hfixed)); } + + +/*--------------------------------------------------------------- + These wrappers for ARKLs module 'set' routines all are + documented in arkode_arkstep.h. + ---------------------------------------------------------------*/ +int ARKStepSetLinearSolver(void *arkode_mem, SUNLinearSolver LS, + SUNMatrix A) { + return(arkLSSetLinearSolver(arkode_mem, LS, A)); } +int ARKStepSetMassLinearSolver(void *arkode_mem, SUNLinearSolver LS, + SUNMatrix M, booleantype time_dep) { + return(arkLSSetMassLinearSolver(arkode_mem, LS, M, time_dep)); } +int ARKStepSetJacFn(void *arkode_mem, ARKLsJacFn jac) { + return(arkLSSetJacFn(arkode_mem, jac)); } +int ARKStepSetMassFn(void *arkode_mem, ARKLsMassFn mass) { + return(arkLSSetMassFn(arkode_mem, mass)); } +int ARKStepSetJacEvalFrequency(void *arkode_mem, long int msbj) { + return(arkLSSetJacEvalFrequency(arkode_mem, msbj)); } +int ARKStepSetLinearSolutionScaling(void *arkode_mem, booleantype onoff) { + return(arkLSSetLinearSolutionScaling(arkode_mem, onoff)); } +int ARKStepSetEpsLin(void *arkode_mem, realtype eplifac) { + return(arkLSSetEpsLin(arkode_mem, eplifac)); } +int ARKStepSetMassEpsLin(void *arkode_mem, realtype eplifac) { + return(arkLSSetMassEpsLin(arkode_mem, eplifac)); } +int ARKStepSetLSNormFactor(void *arkode_mem, realtype nrmfac) { + return(arkLSSetNormFactor(arkode_mem, nrmfac)); } +int ARKStepSetMassLSNormFactor(void *arkode_mem, realtype nrmfac) { + return(arkLSSetMassNormFactor(arkode_mem, nrmfac)); } +int ARKStepSetPreconditioner(void *arkode_mem, ARKLsPrecSetupFn psetup, + ARKLsPrecSolveFn psolve) { + return(arkLSSetPreconditioner(arkode_mem, psetup, psolve)); } +int ARKStepSetMassPreconditioner(void *arkode_mem, ARKLsMassPrecSetupFn psetup, + ARKLsMassPrecSolveFn psolve) { + return(arkLSSetMassPreconditioner(arkode_mem, psetup, psolve)); } +int ARKStepSetJacTimes(void *arkode_mem, ARKLsJacTimesSetupFn jtsetup, + ARKLsJacTimesVecFn jtimes) { + return(arkLSSetJacTimes(arkode_mem, jtsetup, jtimes)); } +int ARKStepSetJacTimesRhsFn(void *arkode_mem, ARKRhsFn jtimesRhsFn) { + return(arkLSSetJacTimesRhsFn(arkode_mem, jtimesRhsFn)); } +int ARKStepSetMassTimes(void *arkode_mem, ARKLsMassTimesSetupFn msetup, + ARKLsMassTimesVecFn mtimes, void *mtimes_data) { + return(arkLSSetMassTimes(arkode_mem, msetup, mtimes, mtimes_data)); } +int ARKStepSetLinSysFn(void *arkode_mem, ARKLsLinSysFn linsys) { + return(arkLSSetLinSysFn(arkode_mem, linsys)); } + +/*=============================================================== + ARKStep Optional output functions (wrappers for generic ARKode + utility routines). All are documented in arkode_io.c. + ===============================================================*/ +int ARKStepGetNumStepAttempts(void *arkode_mem, long int *nstep_attempts) { + return(arkGetNumStepAttempts(arkode_mem, nstep_attempts)); } +int ARKStepGetNumSteps(void *arkode_mem, long int *nsteps) { + return(arkGetNumSteps(arkode_mem, nsteps)); } +int ARKStepGetActualInitStep(void *arkode_mem, realtype *hinused) { + return(arkGetActualInitStep(arkode_mem, hinused)); } +int ARKStepGetLastStep(void *arkode_mem, realtype *hlast) { + return(arkGetLastStep(arkode_mem, hlast)); } +int ARKStepGetCurrentStep(void *arkode_mem, realtype *hcur) { + return(arkGetCurrentStep(arkode_mem, hcur)); } +int ARKStepGetCurrentTime(void *arkode_mem, realtype *tcur) { + return(arkGetCurrentTime(arkode_mem, tcur)); } +int ARKStepGetCurrentState(void *arkode_mem, N_Vector *state) { + return(arkGetCurrentState(arkode_mem, state)); } +int ARKStepGetTolScaleFactor(void *arkode_mem, realtype *tolsfact) { + return(arkGetTolScaleFactor(arkode_mem, tolsfact)); } +int ARKStepGetErrWeights(void *arkode_mem, N_Vector eweight) { + return(arkGetErrWeights(arkode_mem, eweight)); } +int ARKStepGetResWeights(void *arkode_mem, N_Vector rweight) { + return(arkGetResWeights(arkode_mem, rweight)); } +int ARKStepGetWorkSpace(void *arkode_mem, long int *lenrw, long int *leniw) { + return(arkGetWorkSpace(arkode_mem, lenrw, leniw)); } +int ARKStepGetNumGEvals(void *arkode_mem, long int *ngevals) { + return(arkGetNumGEvals(arkode_mem, ngevals)); } +int ARKStepGetRootInfo(void *arkode_mem, int *rootsfound) { + return(arkGetRootInfo(arkode_mem, rootsfound)); } +int ARKStepGetStepStats(void *arkode_mem, long int *nsteps, + realtype *hinused, realtype *hlast, + realtype *hcur, realtype *tcur) { + return(arkGetStepStats(arkode_mem, nsteps, hinused, hlast, hcur, tcur)); } +int ARKStepGetNumConstrFails(void *arkode_mem, long int *nconstrfails) { + return(arkGetNumConstrFails(arkode_mem, nconstrfails)); } +int ARKStepGetNumExpSteps(void *arkode_mem, long int *nsteps) { + return(arkGetNumExpSteps(arkode_mem, nsteps)); } +int ARKStepGetNumAccSteps(void *arkode_mem, long int *nsteps) { + return(arkGetNumAccSteps(arkode_mem, nsteps)); } +int ARKStepGetNumErrTestFails(void *arkode_mem, long int *netfails) { + return(arkGetNumErrTestFails(arkode_mem, netfails)); } +char *ARKStepGetReturnFlagName(long int flag) { + return(arkGetReturnFlagName(flag)); } + +/*--------------------------------------------------------------- + These wrappers for ARKLs module 'get' routines all are + documented in arkode_arkstep.h. + ---------------------------------------------------------------*/ +int ARKStepGetLinWorkSpace(void *arkode_mem, long int *lenrwLS, long int *leniwLS) { + return(arkLSGetWorkSpace(arkode_mem, lenrwLS, leniwLS)); } +int ARKStepGetNumJacEvals(void *arkode_mem, long int *njevals) { + return(arkLSGetNumJacEvals(arkode_mem, njevals)); } +int ARKStepGetNumPrecEvals(void *arkode_mem, long int *npevals) { + return(arkLSGetNumPrecEvals(arkode_mem, npevals)); } +int ARKStepGetNumPrecSolves(void *arkode_mem, long int *npsolves) { + return(arkLSGetNumPrecSolves(arkode_mem, npsolves)); } +int ARKStepGetNumLinIters(void *arkode_mem, long int *nliters) { + return(arkLSGetNumLinIters(arkode_mem, nliters)); } +int ARKStepGetNumLinConvFails(void *arkode_mem, long int *nlcfails) { + return(arkLSGetNumConvFails(arkode_mem, nlcfails)); } +int ARKStepGetNumJTSetupEvals(void *arkode_mem, long int *njtsetups) { + return(arkLSGetNumJTSetupEvals(arkode_mem, njtsetups)); } +int ARKStepGetNumJtimesEvals(void *arkode_mem, long int *njvevals) { + return(arkLSGetNumJtimesEvals(arkode_mem, njvevals)); } +int ARKStepGetNumLinRhsEvals(void *arkode_mem, long int *nfevalsLS) { + return(arkLSGetNumRhsEvals(arkode_mem, nfevalsLS)); } +int ARKStepGetLastLinFlag(void *arkode_mem, long int *flag) { + return(arkLSGetLastFlag(arkode_mem, flag)); } + +int ARKStepGetMassWorkSpace(void *arkode_mem, long int *lenrwMLS, long int *leniwMLS) { + return(arkLSGetMassWorkSpace(arkode_mem, lenrwMLS, leniwMLS)); } +int ARKStepGetNumMassSetups(void *arkode_mem, long int *nmsetups) { + return(arkLSGetNumMassSetups(arkode_mem, nmsetups)); } +int ARKStepGetNumMassMultSetups(void *arkode_mem, long int *nmvsetups) { + return(arkLSGetNumMassMatvecSetups(arkode_mem, nmvsetups)); } +int ARKStepGetNumMassMult(void *arkode_mem, long int *nmvevals) { + return(arkLSGetNumMassMult(arkode_mem, nmvevals)); } +int ARKStepGetNumMassSolves(void *arkode_mem, long int *nmsolves) { + return(arkLSGetNumMassSolves(arkode_mem, nmsolves)); } +int ARKStepGetNumMassPrecEvals(void *arkode_mem, long int *nmpevals) { + return(arkLSGetNumMassPrecEvals(arkode_mem, nmpevals)); } +int ARKStepGetNumMassPrecSolves(void *arkode_mem, long int *nmpsolves) { + return(arkLSGetNumMassPrecSolves(arkode_mem, nmpsolves)); } +int ARKStepGetNumMassIters(void *arkode_mem, long int *nmiters) { + return(arkLSGetNumMassIters(arkode_mem, nmiters)); } +int ARKStepGetNumMassConvFails(void *arkode_mem, long int *nmcfails) { + return(arkLSGetNumMassConvFails(arkode_mem, nmcfails)); } +int ARKStepGetNumMTSetups(void *arkode_mem, long int *nmtsetups) { + return(arkLSGetNumMTSetups(arkode_mem, nmtsetups)); } +int ARKStepGetCurrentMassMatrix(void *arkode_mem, SUNMatrix *M) { + return(arkLSGetCurrentMassMatrix(arkode_mem, M)); } +int ARKStepGetLastMassFlag(void *arkode_mem, long int *flag) { + return(arkLSGetLastMassFlag(arkode_mem, flag)); } +char *ARKStepGetLinReturnFlagName(long int flag) { + return(arkLSGetReturnFlagName(flag)); } + + + +/*=============================================================== + ARKStep optional input functions -- stepper-specific + ===============================================================*/ + +/*--------------------------------------------------------------- + ARKStepSetUserData: + + Wrapper for generic arkSetUserData and arkLSSetUserData + routines. + ---------------------------------------------------------------*/ +int ARKStepSetUserData(void *arkode_mem, void *user_data) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetUserData", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set user_data in ARKode mem */ + retval = arkSetUserData(arkode_mem, user_data); + if (retval != ARK_SUCCESS) return(retval); + + /* set user data in ARKodeLS mem */ + if (step_mem->lmem != NULL) { + retval = arkLSSetUserData(arkode_mem, user_data); + if (retval != ARKLS_SUCCESS) return(retval); + } + + /* set user data in ARKodeLSMass mem */ + if (step_mem->mass_mem != NULL) { + retval = arkLSSetMassUserData(arkode_mem, user_data); + if (retval != ARKLS_SUCCESS) return(retval); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetDefaults: + + Resets all ARKStep optional inputs to their default values. + Does not change problem-defining function pointers or + user_data pointer. Also leaves alone any data + structures/options related to the ARKode infrastructure itself + (e.g., root-finding and post-process step). + ---------------------------------------------------------------*/ +int ARKStepSetDefaults(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetDefaults", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Set default ARKode infrastructure parameters */ + retval = arkSetDefaults(ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetDefaults", + "Error setting ARKode infrastructure defaults"); + return(retval); + } + + /* Set default values for integrator optional inputs */ + step_mem->q = Q_DEFAULT; /* method order */ + step_mem->p = 0; /* embedding order */ + step_mem->predictor = 0; /* trivial predictor */ + step_mem->linear = SUNFALSE; /* nonlinear problem */ + step_mem->linear_timedep = SUNTRUE; /* dfi/dy depends on t */ + step_mem->explicit = SUNTRUE; /* fe(t,y) will be used */ + step_mem->implicit = SUNTRUE; /* fi(t,y) will be used */ + step_mem->maxcor = MAXCOR; /* max nonlinear iters/stage */ + step_mem->nlscoef = NLSCOEF; /* nonlinear tolerance coefficient */ + step_mem->crdown = CRDOWN; /* nonlinear convergence estimate coeff. */ + step_mem->rdiv = RDIV; /* nonlinear divergence tolerance */ + step_mem->dgmax = DGMAX; /* max step change before recomputing J or P */ + step_mem->msbp = MSBP; /* max steps between updates to J or P */ + step_mem->stages = 0; /* no stages */ + step_mem->istage = 0; /* current stage */ + step_mem->Be = NULL; /* no Butcher tables */ + step_mem->Bi = NULL; + step_mem->NLS = NULL; /* no nonlinear solver object */ + step_mem->jcur = SUNFALSE; + step_mem->convfail = ARK_NO_FAILURES; + step_mem->stage_predict = NULL; /* no user-supplied stage predictor */ + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetOptimalParams: + + Sets all adaptivity and solver parameters to our 'best guess' + values, for a given ARKStep integration method (ERK, DIRK, ARK), + a given method order, and a given nonlinear solver type. Should + only be called after the method order, solver, and integration + method have been set, and only if time step adaptivity is + enabled. + ---------------------------------------------------------------*/ +int ARKStepSetOptimalParams(void *arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + ARKodeHAdaptMem hadapt_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetOptimalParams", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* access ARKodeHAdaptMem structure */ + if (ark_mem->hadapt_mem == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetOptimalParams", + MSG_ARKADAPT_NO_MEM); + return(ARK_MEM_NULL); + } + hadapt_mem = ark_mem->hadapt_mem; + + /* Choose values based on method, order */ + + /* explicit */ + if (step_mem->explicit && !step_mem->implicit) { + hadapt_mem->imethod = ARK_ADAPT_PI; + hadapt_mem->safety = RCONST(0.99); + hadapt_mem->bias = RCONST(1.2); + hadapt_mem->growth = RCONST(25.0); + hadapt_mem->k1 = RCONST(0.8); + hadapt_mem->k2 = RCONST(0.31); + hadapt_mem->etamxf = RCONST(0.3); + + /* implicit */ + } else if (step_mem->implicit && !step_mem->explicit) { + switch (step_mem->q) { + case 2: /* just use standard defaults since better ones unknown */ + hadapt_mem->imethod = ARK_ADAPT_PID; + hadapt_mem->safety = SAFETY; + hadapt_mem->bias = BIAS; + hadapt_mem->growth = GROWTH; + hadapt_mem->etamxf = ETAMXF; + hadapt_mem->small_nef = SMALL_NEF; + hadapt_mem->etacf = ETACF; + step_mem->nlscoef = RCONST(0.001); + step_mem->maxcor = 5; + step_mem->crdown = CRDOWN; + step_mem->rdiv = RDIV; + step_mem->dgmax = DGMAX; + step_mem->msbp = MSBP; + break; + case 3: + hadapt_mem->imethod = ARK_ADAPT_I; + hadapt_mem->safety = RCONST(0.957); + hadapt_mem->bias = RCONST(1.9); + hadapt_mem->growth = RCONST(17.6); + hadapt_mem->etamxf = RCONST(0.45); + hadapt_mem->small_nef = SMALL_NEF; + hadapt_mem->etacf = ETACF; + step_mem->nlscoef = RCONST(0.22); + step_mem->crdown = RCONST(0.17); + step_mem->rdiv = RCONST(2.3); + step_mem->dgmax = RCONST(0.19); + step_mem->msbp = 60; + break; + case 4: + hadapt_mem->imethod = ARK_ADAPT_PID; + hadapt_mem->safety = RCONST(0.988); + hadapt_mem->bias = RCONST(1.2); + hadapt_mem->growth = RCONST(31.5); + hadapt_mem->k1 = RCONST(0.535); + hadapt_mem->k2 = RCONST(0.209); + hadapt_mem->k3 = RCONST(0.148); + hadapt_mem->etamxf = RCONST(0.33); + hadapt_mem->small_nef = SMALL_NEF; + hadapt_mem->etacf = ETACF; + step_mem->nlscoef = RCONST(0.24); + step_mem->crdown = RCONST(0.26); + step_mem->rdiv = RCONST(2.3); + step_mem->dgmax = RCONST(0.16); + step_mem->msbp = 31; + break; + case 5: + hadapt_mem->imethod = ARK_ADAPT_PID; + hadapt_mem->safety = RCONST(0.937); + hadapt_mem->bias = RCONST(3.3); + hadapt_mem->growth = RCONST(22.0); + hadapt_mem->k1 = RCONST(0.56); + hadapt_mem->k2 = RCONST(0.338); + hadapt_mem->k3 = RCONST(0.14); + hadapt_mem->etamxf = RCONST(0.44); + hadapt_mem->small_nef = SMALL_NEF; + hadapt_mem->etacf = ETACF; + step_mem->nlscoef = RCONST(0.25); + step_mem->crdown = RCONST(0.4); + step_mem->rdiv = RCONST(2.3); + step_mem->dgmax = RCONST(0.32); + step_mem->msbp = 31; + break; + } + + /* imex */ + } else { + switch (step_mem->q) { + case 3: + hadapt_mem->imethod = ARK_ADAPT_PID; + hadapt_mem->safety = RCONST(0.965); + hadapt_mem->bias = RCONST(1.42); + hadapt_mem->growth = RCONST(28.7); + hadapt_mem->k1 = RCONST(0.54); + hadapt_mem->k2 = RCONST(0.36); + hadapt_mem->k3 = RCONST(0.14); + hadapt_mem->etamxf = RCONST(0.46); + hadapt_mem->small_nef = SMALL_NEF; + hadapt_mem->etacf = ETACF; + step_mem->nlscoef = RCONST(0.22); + step_mem->crdown = RCONST(0.17); + step_mem->rdiv = RCONST(2.3); + step_mem->dgmax = RCONST(0.19); + step_mem->msbp = 60; + break; + case 4: + hadapt_mem->imethod = ARK_ADAPT_PID; + hadapt_mem->safety = RCONST(0.97); + hadapt_mem->bias = RCONST(1.35); + hadapt_mem->growth = RCONST(25.0); + hadapt_mem->k1 = RCONST(0.543); + hadapt_mem->k2 = RCONST(0.297); + hadapt_mem->k3 = RCONST(0.14); + hadapt_mem->etamxf = RCONST(0.47); + hadapt_mem->small_nef = SMALL_NEF; + hadapt_mem->etacf = ETACF; + step_mem->nlscoef = RCONST(0.24); + step_mem->crdown = RCONST(0.26); + step_mem->rdiv = RCONST(2.3); + step_mem->dgmax = RCONST(0.16); + step_mem->msbp = 31; + break; + case 5: + hadapt_mem->imethod = ARK_ADAPT_PI; + hadapt_mem->safety = RCONST(0.993); + hadapt_mem->bias = RCONST(1.15); + hadapt_mem->growth = RCONST(28.5); + hadapt_mem->k1 = RCONST(0.8); + hadapt_mem->k2 = RCONST(0.35); + hadapt_mem->etamxf = RCONST(0.3); + hadapt_mem->small_nef = SMALL_NEF; + hadapt_mem->etacf = ETACF; + step_mem->nlscoef = RCONST(0.25); + step_mem->crdown = RCONST(0.4); + step_mem->rdiv = RCONST(2.3); + step_mem->dgmax = RCONST(0.32); + step_mem->msbp = 31; + break; + } + + } + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetOrder: + + Specifies the method order + + ** Note in documentation that this should not be called along + with ARKStepSetTable or ARKStepSetTableNum. This routine + is used to specify a desired method order using default Butcher + tables, whereas any user-supplied table will have their own + order associated with them. + ---------------------------------------------------------------*/ +int ARKStepSetOrder(void *arkode_mem, int ord) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + sunindextype Blrw, Bliw; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetOrder", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set user-provided value, or default, depending on argument */ + if (ord <= 0) { + step_mem->q = Q_DEFAULT; + } else { + step_mem->q = ord; + } + + /* clear Butcher tables, since user is requesting a change in method + or a reset to defaults. Tables will be set in ARKInitialSetup. */ + step_mem->stages = 0; + step_mem->istage = 0; + step_mem->p = 0; + + ARKodeButcherTable_Space(step_mem->Be, &Bliw, &Blrw); + ARKodeButcherTable_Free(step_mem->Be); + step_mem->Be = NULL; + ark_mem->liw -= Bliw; + ark_mem->lrw -= Blrw; + + ARKodeButcherTable_Space(step_mem->Bi, &Bliw, &Blrw); + ARKodeButcherTable_Free(step_mem->Bi); + step_mem->Bi = NULL; + ark_mem->liw -= Bliw; + ark_mem->lrw -= Blrw; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetLinear: + + Specifies that the implicit portion of the problem is linear, + and to tighten the linear solver tolerances while taking only + one Newton iteration. DO NOT USE IN COMBINATION WITH THE + FIXED-POINT SOLVER. Automatically tightens DeltaGammaMax + to ensure that step size changes cause Jacobian recomputation. + + The argument should be 1 or 0, where 1 indicates that the + Jacobian of fi with respect to y depends on time, and + 0 indicates that it is not time dependent. Alternately, when + using an iterative linear solver this flag denotes time + dependence of the preconditioner. + ---------------------------------------------------------------*/ +int ARKStepSetLinear(void *arkode_mem, int timedepend) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetLinear", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set parameters */ + step_mem->linear = SUNTRUE; + step_mem->linear_timedep = (timedepend == 1); + step_mem->dgmax = RCONST(100.0)*UNIT_ROUNDOFF; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetNonlinear: + + Specifies that the implicit portion of the problem is nonlinear. + Used to undo a previous call to ARKStepSetLinear. Automatically + loosens DeltaGammaMax back to default value. + ---------------------------------------------------------------*/ +int ARKStepSetNonlinear(void *arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetNonlinear", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set parameters */ + step_mem->linear = SUNFALSE; + step_mem->linear_timedep = SUNTRUE; + step_mem->dgmax = DGMAX; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetExplicit: + + Specifies that the implicit portion of the problem is disabled, + and to use an explicit RK method. + ---------------------------------------------------------------*/ +int ARKStepSetExplicit(void *arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetExplicit", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* ensure that fe is defined */ + if (step_mem->fe == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetExplicit", MSG_ARK_MISSING_FE); + return(ARK_ILL_INPUT); + } + + /* set the relevant parameters */ + step_mem->explicit = SUNTRUE; + step_mem->implicit = SUNFALSE; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetImplicit: + + Specifies that the explicit portion of the problem is disabled, + and to use an implicit RK method. + ---------------------------------------------------------------*/ +int ARKStepSetImplicit(void *arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetImplicit", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* ensure that fi is defined */ + if (step_mem->fi == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetImplicit", MSG_ARK_MISSING_FI); + return(ARK_ILL_INPUT); + } + + /* set the relevant parameters */ + step_mem->implicit = SUNTRUE; + step_mem->explicit = SUNFALSE; + + /* re-attach internal error weight functions if necessary */ + if (!ark_mem->user_efun) { + if (ark_mem->itol == ARK_SV && ark_mem->Vabstol != NULL) + retval = arkSVtolerances(ark_mem, ark_mem->reltol, ark_mem->Vabstol); + else + retval = arkSStolerances(ark_mem, ark_mem->reltol, ark_mem->Sabstol); + if (retval != ARK_SUCCESS) return(retval); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetImEx: + + Specifies that the specifies that problem has both implicit and + explicit parts, and to use an ARK method (this is the default). + ---------------------------------------------------------------*/ +int ARKStepSetImEx(void *arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetImEx", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* ensure that fe and fi are defined */ + if (step_mem->fe == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetImEx", MSG_ARK_MISSING_FE); + return(ARK_ILL_INPUT); + } + if (step_mem->fi == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetImEx", MSG_ARK_MISSING_FI); + return(ARK_ILL_INPUT); + } + + /* set the relevant parameters */ + step_mem->explicit = SUNTRUE; + step_mem->implicit = SUNTRUE; + + /* re-attach internal error weight functions if necessary */ + if (!ark_mem->user_efun) { + if (ark_mem->itol == ARK_SV && ark_mem->Vabstol != NULL) + retval = arkSVtolerances(ark_mem, ark_mem->reltol, ark_mem->Vabstol); + else + retval = arkSStolerances(ark_mem, ark_mem->reltol, ark_mem->Sabstol); + if (retval != ARK_SUCCESS) return(retval); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetTables: + + Specifies to use customized Butcher tables for the system. + + If Bi is NULL, then this sets the integrator in 'explicit' mode. + + If Be is NULL, then this sets the integrator in 'implicit' mode. + + Returns ARK_ILL_INPUT if both Butcher tables are not supplied. + ---------------------------------------------------------------*/ +int ARKStepSetTables(void *arkode_mem, int q, int p, + ARKodeButcherTable Bi, ARKodeButcherTable Be) +{ + int retval; + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + sunindextype Blrw, Bliw; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetTables", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* check for illegal inputs */ + if ((Bi == NULL) && (Be == NULL)) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTables", + "At least one complete table must be supplied"); + return(ARK_ILL_INPUT); + } + + /* if both tables are set, check that they have the same number of stages */ + if ((Bi != NULL) && (Be != NULL)) { + if (Bi->stages != Be->stages) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTables", + "Both tables must have the same number of stages"); + return(ARK_ILL_INPUT); + } + } + + /* clear any existing parameters and Butcher tables */ + step_mem->stages = 0; + step_mem->q = 0; + step_mem->p = 0; + + ARKodeButcherTable_Space(step_mem->Be, &Bliw, &Blrw); + ARKodeButcherTable_Free(step_mem->Be); + step_mem->Be = NULL; + ark_mem->liw -= Bliw; + ark_mem->lrw -= Blrw; + + ARKodeButcherTable_Space(step_mem->Bi, &Bliw, &Blrw); + ARKodeButcherTable_Free(step_mem->Bi); + step_mem->Bi = NULL; + ark_mem->liw -= Bliw; + ark_mem->lrw -= Blrw; + + /* + * determine mode (implicit/explicit/ImEx), and perform appropriate actions + */ + + /* explicit */ + if (Bi == NULL) { + + /* set the relevant parameters (use table q and p) */ + step_mem->stages = Be->stages; + step_mem->q = Be->q; + step_mem->p = Be->p; + + /* copy the table in step memory */ + step_mem->Be = ARKodeButcherTable_Copy(Be); + if (step_mem->Be == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTables", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + + /* set method as purely explicit */ + retval = ARKStepSetExplicit(arkode_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetTables", + "Error in ARKStepSetExplicit"); + return(retval); + } + + /* implicit */ + } else if (Be == NULL) { + + /* set the relevant parameters (use table q and p) */ + step_mem->stages = Bi->stages; + step_mem->q = Bi->q; + step_mem->p = Bi->p; + + /* copy the table in step memory */ + step_mem->Bi = ARKodeButcherTable_Copy(Bi); + if (step_mem->Bi == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTables", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + + /* set method as purely implicit */ + retval = ARKStepSetImplicit(arkode_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetTables", + "Error in ARKStepSetImplicit"); + return(ARK_ILL_INPUT); + } + + /* ImEx */ + } else { + + /* set the relevant parameters (use input q and p) */ + step_mem->stages = Bi->stages; + step_mem->q = q; + step_mem->p = p; + + /* copy the explicit table into step memory */ + step_mem->Be = ARKodeButcherTable_Copy(Be); + if (step_mem->Be == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTables", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + + /* copy the implicit table into step memory */ + step_mem->Bi = ARKodeButcherTable_Copy(Bi); + if (step_mem->Bi == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTables", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + + /* set method as ImEx */ + retval = ARKStepSetImEx(arkode_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetTables", + "Error in ARKStepSetImEx"); + return(ARK_ILL_INPUT); + } + } + + /* note Butcher table space requirements */ + ARKodeButcherTable_Space(step_mem->Be, &Bliw, &Blrw); + ark_mem->liw += Bliw; + ark_mem->lrw += Blrw; + + ARKodeButcherTable_Space(step_mem->Bi, &Bliw, &Blrw); + ark_mem->liw += Bliw; + ark_mem->lrw += Blrw; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetTableNum: + + Specifies to use pre-existing Butcher tables for the system, + based on the integer flags passed to + ARKodeButcherTable_LoadERK() and ARKodeButcherTable_LoadDIRK() + within the files arkode_butcher_erk.c and arkode_butcher_dirk.c + (automatically calls ARKStepSetImEx). + + If either argument is negative (illegal), then this disables the + corresponding table (e.g. itable = -1 -> explicit) + ---------------------------------------------------------------*/ +int ARKStepSetTableNum(void *arkode_mem, ARKODE_DIRKTableID itable, ARKODE_ERKTableID etable) +{ + int flag, retval; + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + sunindextype Blrw, Bliw; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetTableNum", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* clear any existing parameters and Butcher tables */ + step_mem->stages = 0; + step_mem->q = 0; + step_mem->p = 0; + + ARKodeButcherTable_Space(step_mem->Be, &Bliw, &Blrw); + ARKodeButcherTable_Free(step_mem->Be); + step_mem->Be = NULL; + ark_mem->liw -= Bliw; + ark_mem->lrw -= Blrw; + + ARKodeButcherTable_Space(step_mem->Bi, &Bliw, &Blrw); + ARKodeButcherTable_Free(step_mem->Bi); + step_mem->Bi = NULL; + ark_mem->liw -= Bliw; + ark_mem->lrw -= Blrw; + + /* determine mode (implicit/explicit/ImEx), and perform + appropriate actions */ + + /* illegal inputs */ + if ((itable < 0) && (etable < 0)) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTableNum", + "At least one valid table number must be supplied"); + return(ARK_ILL_INPUT); + + + /* explicit */ + } else if (itable < 0) { + + /* check that argument specifies an explicit table */ + if (etableARKODE_MAX_ERK_NUM) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTableNum", + "Illegal ERK table number"); + return(ARK_ILL_INPUT); + } + + /* fill in table based on argument */ + step_mem->Be = ARKodeButcherTable_LoadERK(etable); + if (step_mem->Be == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTableNum", + "Error setting explicit table with that index"); + return(ARK_ILL_INPUT); + } + step_mem->stages = step_mem->Be->stages; + step_mem->q = step_mem->Be->q; + step_mem->p = step_mem->Be->p; + + /* set method as purely explicit */ + flag = ARKStepSetExplicit(arkode_mem); + if (flag != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetTableNum", + "Error in ARKStepSetExplicit"); + return(flag); + } + + + /* implicit */ + } else if (etable < 0) { + + /* check that argument specifies an implicit table */ + if (itableARKODE_MAX_DIRK_NUM) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTableNum", + "Illegal IRK table number"); + return(ARK_ILL_INPUT); + } + + /* fill in table based on argument */ + step_mem->Bi = ARKodeButcherTable_LoadDIRK(itable); + if (step_mem->Bi == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTableNum", + "Error setting table with that index"); + return(ARK_ILL_INPUT); + } + step_mem->stages = step_mem->Bi->stages; + step_mem->q = step_mem->Bi->q; + step_mem->p = step_mem->Bi->p; + + /* set method as purely implicit */ + flag = ARKStepSetImplicit(arkode_mem); + if (flag != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetTableNum", + "Error in ARKStepSetIxplicit"); + return(flag); + } + + + /* ImEx */ + } else { + + /* ensure that tables match */ + if ( !((etable == ARKODE_ARK324L2SA_ERK_4_2_3) && (itable == ARKODE_ARK324L2SA_DIRK_4_2_3)) && + !((etable == ARKODE_ARK436L2SA_ERK_6_3_4) && (itable == ARKODE_ARK436L2SA_DIRK_6_3_4)) && + !((etable == ARKODE_ARK437L2SA_ERK_7_3_4) && (itable == ARKODE_ARK437L2SA_DIRK_7_3_4)) && + !((etable == ARKODE_ARK548L2SA_ERK_8_4_5) && (itable == ARKODE_ARK548L2SA_DIRK_8_4_5)) && + !((etable == ARKODE_ARK548L2SAb_ERK_8_4_5) && (itable == ARKODE_ARK548L2SAb_DIRK_8_4_5)) ) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetTableNum", + "Incompatible Butcher tables for ARK method"); + return(ARK_ILL_INPUT); + } + + /* fill in tables based on arguments */ + step_mem->Bi = ARKodeButcherTable_LoadDIRK(itable); + step_mem->Be = ARKodeButcherTable_LoadERK(etable); + if (step_mem->Bi == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTableNum", + "Illegal IRK table number"); + return(ARK_ILL_INPUT); + } + if (step_mem->Be == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepSetTableNum", + "Illegal ERK table number"); + return(ARK_ILL_INPUT); + } + step_mem->stages = step_mem->Bi->stages; + step_mem->q = step_mem->Bi->q; + step_mem->p = step_mem->Bi->p; + + /* set method as ImEx */ + if (ARKStepSetImEx(arkode_mem) != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetTableNum", MSG_ARK_MISSING_F); + return(ARK_ILL_INPUT); + } + + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetNonlinCRDown: + + Specifies the user-provided nonlinear convergence constant + crdown. Legal values are strictly positive; illegal values + imply a reset to the default. + ---------------------------------------------------------------*/ +int ARKStepSetNonlinCRDown(void *arkode_mem, realtype crdown) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetNonlinCRDown", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if argument legal set it, otherwise set default */ + if (crdown <= ZERO) { + step_mem->crdown = CRDOWN; + } else { + step_mem->crdown = crdown; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetNonlinRDiv: + + Specifies the user-provided nonlinear convergence constant + rdiv. Legal values are strictly positive; illegal values + imply a reset to the default. + ---------------------------------------------------------------*/ +int ARKStepSetNonlinRDiv(void *arkode_mem, realtype rdiv) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetNonlinRDiv", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if argument legal set it, otherwise set default */ + if (rdiv <= ZERO) { + step_mem->rdiv = RDIV; + } else { + step_mem->rdiv = rdiv; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetDeltaGammaMax: + + Specifies the user-provided linear setup decision constant + dgmax. Legal values are strictly positive; illegal values imply + a reset to the default. + ---------------------------------------------------------------*/ +int ARKStepSetDeltaGammaMax(void *arkode_mem, realtype dgmax) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetDeltaGammaMax", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if argument legal set it, otherwise set default */ + if (dgmax <= ZERO) { + step_mem->dgmax = DGMAX; + } else { + step_mem->dgmax = dgmax; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetLSetupFrequency: + + Specifies the user-provided linear setup decision constant + msbp. Positive values give the frequency for calling lsetup; + negative values imply recomputation of lsetup at each nonlinear + solve; a zero value implies a reset to the default. + ---------------------------------------------------------------*/ +int ARKStepSetLSetupFrequency(void *arkode_mem, int msbp) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetLSetupFrequency", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if argument legal set it, otherwise set default */ + if (msbp == 0) { + step_mem->msbp = MSBP; + } else { + step_mem->msbp = msbp; + } + + return(ARK_SUCCESS); +} + +/*--------------------------------------------------------------- + ARKStepSetPredictorMethod: + + Specifies the method to use for predicting implicit solutions. + Non-default choices are {1,2,3,4}, all others will use default + (trivial) predictor. + ---------------------------------------------------------------*/ +int ARKStepSetPredictorMethod(void *arkode_mem, int pred_method) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetPredictorMethod", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* return error if pred_method==5 and a non-NULL stage predictor function + has been supplied */ + if ((pred_method == 5) && (step_mem->stage_predict != NULL)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", "ARKStepSetPredictorMethod", + "predictor 5 cannot be combined with user-supplied stage predictor"); + return(ARK_ILL_INPUT); + } + + /* Deprecate options 4 and 5 */ + if (pred_method == 4) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", "ARKStepSetPredictorMethod", + "Predictor option 4 is deprecated, and will be removed in an upcoming release"); + } + if (pred_method == 5) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", "ARKStepSetPredictorMethod", + "Predictor option 5 is deprecated, and will be removed in an upcoming release"); + } + + /* set parameter */ + step_mem->predictor = pred_method; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetMaxNonlinIters: + + Specifies the maximum number of nonlinear iterations during + one solve. A non-positive input implies a reset to the + default value. + ---------------------------------------------------------------*/ +int ARKStepSetMaxNonlinIters(void *arkode_mem, int maxcor) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetMaxNonlinIters", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Return error message if no NLS module is present */ + if (step_mem->NLS == NULL) { + arkProcessError(ark_mem, ARK_NLS_OP_ERR, "ARKode::ARKStep", + "ARKStepSetMaxNonlinIters", + "No SUNNonlinearSolver object is present"); + return(ARK_ILL_INPUT); + } + + /* argument <= 0 sets default, otherwise set input */ + if (maxcor <= 0) { + step_mem->maxcor = MAXCOR; + } else { + step_mem->maxcor = maxcor; + } + + /* send argument to NLS structure */ + retval = SUNNonlinSolSetMaxIters(step_mem->NLS, step_mem->maxcor); + if (retval != SUN_NLS_SUCCESS) { + arkProcessError(ark_mem, ARK_NLS_OP_ERR, "ARKode::ARKStep", + "ARKStepSetMaxNonlinIters", + "Error setting maxcor in SUNNonlinearSolver object"); + return(ARK_NLS_OP_ERR); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetNonlinConvCoef: + + Specifies the coefficient in the nonlinear solver convergence + test. A non-positive input implies a reset to the default value. + ---------------------------------------------------------------*/ +int ARKStepSetNonlinConvCoef(void *arkode_mem, realtype nlscoef) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetNonlinConvCoef", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* argument <= 0 sets default, otherwise set input */ + if (nlscoef <= ZERO) { + step_mem->nlscoef = NLSCOEF; + } else { + step_mem->nlscoef = nlscoef; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetStagePredictFn: Specifies a user-provided step + predictor function having type ARKStagePredictFn. A + NULL input function disables calls to this routine. + ---------------------------------------------------------------*/ +int ARKStepSetStagePredictFn(void *arkode_mem, + ARKStagePredictFn PredictStage) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure and set function pointer */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetStagePredictFn", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* override predictor method 5 if non-NULL PredictStage is supplied */ + if ((step_mem->predictor == 5) && (PredictStage != NULL)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetStagePredictFn", + "User-supplied predictor is incompatible with predictor method 5"); + return(ARK_ILL_INPUT); + } + + step_mem->stage_predict = PredictStage; + return(ARK_SUCCESS); +} + + +/*=============================================================== + ARKStep optional output functions -- stepper-specific + ===============================================================*/ + +/*--------------------------------------------------------------- + ARKStepGetCurrentGamma: Returns the current value of gamma + ---------------------------------------------------------------*/ +int ARKStepGetCurrentGamma(void *arkode_mem, realtype *gamma) +{ + int retval; + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + retval = arkStep_AccessStepMem(arkode_mem, NULL, &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + *gamma = step_mem->gamma; + return(retval); +} + + +/*--------------------------------------------------------------- + ARKStepGetNumRhsEvals: + + Returns the current number of calls to fe and fi + ---------------------------------------------------------------*/ +int ARKStepGetNumRhsEvals(void *arkode_mem, long int *fe_evals, + long int *fi_evals) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepGetNumRhsEvals", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* get values from step_mem */ + *fe_evals = step_mem->nfe; + *fi_evals = step_mem->nfi; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepGetNumLinSolvSetups: + + Returns the current number of calls to the lsetup routine + ---------------------------------------------------------------*/ +int ARKStepGetNumLinSolvSetups(void *arkode_mem, long int *nlinsetups) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepGetNumLinSolvSetups", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* get value from step_mem */ + *nlinsetups = step_mem->nsetups; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepGetCurrentButcherTables: + + Sets pointers to the explicit and implicit Butcher tables + currently in use. + ---------------------------------------------------------------*/ +int ARKStepGetCurrentButcherTables(void *arkode_mem, + ARKodeButcherTable *Bi, + ARKodeButcherTable *Be) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepGetCurrentButcherTables", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* get tables from step_mem */ + *Bi = step_mem->Bi; + *Be = step_mem->Be; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepGetEstLocalErrors: (updated to the correct vector, but + need to verify that it is unchanged between filling the + estimated error and the end of the time step) + + Returns an estimate of the local error + ---------------------------------------------------------------*/ +int ARKStepGetEstLocalErrors(void *arkode_mem, N_Vector ele) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepGetEstLocalErrors", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* copy vector to output */ + N_VScale(ONE, ark_mem->tempv1, ele); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepGetTimestepperStats: + + Returns integrator statistics + ---------------------------------------------------------------*/ +int ARKStepGetTimestepperStats(void *arkode_mem, long int *expsteps, + long int *accsteps, long int *step_attempts, + long int *fe_evals, long int *fi_evals, + long int *nlinsetups, long int *netfails) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepGetTimestepperStats", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set expsteps and accsteps from adaptivity structure */ + *expsteps = ark_mem->hadapt_mem->nst_exp; + *accsteps = ark_mem->hadapt_mem->nst_acc; + + /* set remaining outputs */ + *step_attempts = ark_mem->nst_attempts; + *fe_evals = step_mem->nfe; + *fi_evals = step_mem->nfi; + *nlinsetups = step_mem->nsetups; + *netfails = ark_mem->netf; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepGetNumNonlinSolvIters: + + Returns the current number of nonlinear solver iterations + ---------------------------------------------------------------*/ +int ARKStepGetNumNonlinSolvIters(void *arkode_mem, long int *nniters) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepGetNumNonlinSolvIters", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + *nniters = step_mem->nls_iters; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepGetNumNonlinSolvConvFails: + + Returns the current number of nonlinear solver convergence fails + ---------------------------------------------------------------*/ +int ARKStepGetNumNonlinSolvConvFails(void *arkode_mem, long int *nncfails) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepGetNumNonlinSolvConvFails", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set output from step_mem */ + *nncfails = ark_mem->ncfn; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepGetNonlinSolvStats: + + Returns nonlinear solver statistics + ---------------------------------------------------------------*/ +int ARKStepGetNonlinSolvStats(void *arkode_mem, long int *nniters, + long int *nncfails) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepGetNonlinSolvStats", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + *nniters = step_mem->nls_iters; + *nncfails = ark_mem->ncfn; + + return(ARK_SUCCESS); +} + + +/*=============================================================== + ARKStep parameter output + ===============================================================*/ + +/*--------------------------------------------------------------- + ARKStepWriteParameters: + + Outputs all solver parameters to the provided file pointer. + ---------------------------------------------------------------*/ +int ARKStepWriteParameters(void *arkode_mem, FILE *fp) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int flag, retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepWriteParameters", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* output ARKode infrastructure parameters first */ + flag = arkWriteParameters(ark_mem, fp); + if (flag != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepWriteParameters", + "Error writing ARKode infrastructure parameters"); + return(flag); + } + + /* print integrator parameters to file */ + STAN_SUNDIALS_FPRINTF(fp, "ARKStep time step module parameters:\n"); + STAN_SUNDIALS_FPRINTF(fp, " Method order %i\n",step_mem->q); + if (step_mem->linear) { + STAN_SUNDIALS_FPRINTF(fp, " Linear implicit problem"); + if (step_mem->linear_timedep) { + STAN_SUNDIALS_FPRINTF(fp, " (time-dependent Jacobian)\n"); + } else { + STAN_SUNDIALS_FPRINTF(fp, " (time-independent Jacobian)\n"); + } + } + if (step_mem->explicit && step_mem->implicit) { + STAN_SUNDIALS_FPRINTF(fp, " ImEx integrator\n"); + } else if (step_mem->implicit) { + STAN_SUNDIALS_FPRINTF(fp, " Implicit integrator\n"); + } else { + STAN_SUNDIALS_FPRINTF(fp, " Explicit integrator\n"); + } + + if (step_mem->implicit) { + STAN_SUNDIALS_FPRINTF(fp, " Implicit predictor method = %i\n",step_mem->predictor); + STAN_SUNDIALS_FPRINTF(fp, " Implicit solver tolerance coefficient = %"RSYM"\n",step_mem->nlscoef); + STAN_SUNDIALS_FPRINTF(fp, " Maximum number of nonlinear corrections = %i\n",step_mem->maxcor); + STAN_SUNDIALS_FPRINTF(fp, " Nonlinear convergence rate constant = %"RSYM"\n",step_mem->crdown); + STAN_SUNDIALS_FPRINTF(fp, " Nonlinear divergence tolerance = %"RSYM"\n",step_mem->rdiv); + STAN_SUNDIALS_FPRINTF(fp, " Gamma factor LSetup tolerance = %"RSYM"\n",step_mem->dgmax); + STAN_SUNDIALS_FPRINTF(fp, " Number of steps between LSetup calls = %i\n",step_mem->msbp); + } + STAN_SUNDIALS_FPRINTF(fp, "\n"); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepWriteButcher: + + Outputs Butcher tables to the provided file pointer. + ---------------------------------------------------------------*/ +int ARKStepWriteButcher(void *arkode_mem, FILE *fp) +{ + int retval; + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepWriteButcher", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* check that Butcher table is non-NULL (otherwise report error) */ + if ((step_mem->Be == NULL) && (step_mem->Bi == NULL)) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "ARKStepWriteButcher", "Butcher table memory is NULL"); + return(ARK_MEM_NULL); + } + + /* print Butcher tables to file */ + STAN_SUNDIALS_FPRINTF(fp, "\nARKStep Butcher tables (stages = %i):\n", step_mem->stages); + if (step_mem->explicit && (step_mem->Be != NULL)) { + STAN_SUNDIALS_FPRINTF(fp, " Explicit Butcher table:\n"); + ARKodeButcherTable_Write(step_mem->Be, fp); + } + STAN_SUNDIALS_FPRINTF(fp, "\n"); + if (step_mem->implicit && (step_mem->Bi != NULL)) { + STAN_SUNDIALS_FPRINTF(fp, " Implicit Butcher table:\n"); + ARKodeButcherTable_Write(step_mem->Bi, fp); + } + STAN_SUNDIALS_FPRINTF(fp, "\n"); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + EOF + ---------------------------------------------------------------*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_arkstep_nls.c b/lib/sundials_6.1.1/src/arkode/arkode_arkstep_nls.c new file mode 100644 index 00000000000..95050dfbb15 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_arkstep_nls.c @@ -0,0 +1,918 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 interface between ARKStep and the + * SUNNonlinearSolver object + *--------------------------------------------------------------*/ + +#include +#include +#include + +#include "arkode_impl.h" +#include "arkode_arkstep_impl.h" +#include + + +/*=============================================================== + Exported functions + ===============================================================*/ + +/*--------------------------------------------------------------- + ARKStepSetNonlinearSolver: + + This routine attaches a SUNNonlinearSolver object to the ARKStep + module. + ---------------------------------------------------------------*/ +int ARKStepSetNonlinearSolver(void *arkode_mem, SUNNonlinearSolver NLS) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetNonlinearSolver", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Return immediately if NLS input is NULL */ + if (NLS == NULL) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetNonlinearSolver", + "The NLS input must be non-NULL"); + return(ARK_ILL_INPUT); + } + + /* check for required nonlinear solver functions */ + if ( (NLS->ops->gettype == NULL) || + (NLS->ops->solve == NULL) || + (NLS->ops->setsysfn == NULL) ) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "ARKStepSetNonlinearSolver", + "NLS does not support required operations"); + return(ARK_ILL_INPUT); + } + + /* free any existing nonlinear solver */ + if ((step_mem->NLS != NULL) && (step_mem->ownNLS)) + retval = SUNNonlinSolFree(step_mem->NLS); + + /* set SUNNonlinearSolver pointer */ + step_mem->NLS = NLS; + step_mem->ownNLS = SUNFALSE; + + /* set default convergence test function */ + retval = SUNNonlinSolSetConvTestFn(step_mem->NLS, arkStep_NlsConvTest, + (void*) ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetNonlinearSolver", + "Setting convergence test function failed"); + return(ARK_ILL_INPUT); + } + + /* set default nonlinear iterations */ + retval = SUNNonlinSolSetMaxIters(step_mem->NLS, step_mem->maxcor); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetNonlinearSolver", + "Setting maximum number of nonlinear iterations failed"); + return(ARK_ILL_INPUT); + } + + /* set the nonlinear system RHS function */ + if (!(step_mem->fi)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetNonlinearSolver", + "The implicit ODE RHS function is NULL"); + return(ARK_ILL_INPUT); + } + step_mem->nls_fi = step_mem->fi; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepSetNlsRhsFn: + + This routine sets an alternative user-supplied implicit ODE + right-hand side function to use in the evaluation of nonlinear + system functions. + ---------------------------------------------------------------*/ +int ARKStepSetNlsRhsFn(void *arkode_mem, ARKRhsFn nls_fi) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepSetNlsRhsFn", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + if (nls_fi) + step_mem->nls_fi = nls_fi; + else + step_mem->nls_fi = step_mem->fi; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKStepGetNonlinearSystemData: + + This routine provides access to the relevant data needed to + compute the nonlinear system function. + ---------------------------------------------------------------*/ +int ARKStepGetNonlinearSystemData(void *arkode_mem, realtype *tcur, + N_Vector *zpred, N_Vector *z, + N_Vector *Fi, realtype *gamma, + N_Vector *sdata, void **user_data) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "ARKStepGetNonlinearSystemData", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + *tcur = ark_mem->tcur; + *zpred = step_mem->zpred; + *z = ark_mem->ycur; + *Fi = step_mem->Fi[step_mem->istage]; + *gamma = step_mem->gamma; + *sdata = step_mem->sdata; + *user_data = ark_mem->user_data; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + Utility routines called by ARKStep + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + arkStep_NlsInit: + + This routine attaches the linear solver 'setup' and 'solve' + routines to the nonlinear solver object, and then initializes + the nonlinear solver object itself. This should only be + called at the start of a simulation, after a re-init, or after + a re-size. + ---------------------------------------------------------------*/ +int arkStep_NlsInit(ARKodeMem ark_mem) +{ + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "arkStep_NlsInit", MSG_ARKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeARKStepMem) ark_mem->step_mem; + + /* reset counters */ + step_mem->nls_iters = 0; + + /* set the linear solver setup wrapper function */ + if (step_mem->lsetup) + retval = SUNNonlinSolSetLSetupFn(step_mem->NLS, arkStep_NlsLSetup); + else + retval = SUNNonlinSolSetLSetupFn(step_mem->NLS, NULL); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "arkStep_NlsInit", + "Setting the linear solver setup function failed"); + return(ARK_NLS_INIT_FAIL); + } + + /* set the linear solver solve wrapper function */ + if (step_mem->lsolve) + retval = SUNNonlinSolSetLSolveFn(step_mem->NLS, arkStep_NlsLSolve); + else + retval = SUNNonlinSolSetLSolveFn(step_mem->NLS, NULL); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "arkStep_NlsInit", + "Setting linear solver solve function failed"); + return(ARK_NLS_INIT_FAIL); + } + + /* set the nonlinear residual/fixed-point function, based on solver type */ + if (SUNNonlinSolGetType(step_mem->NLS) == SUNNONLINEARSOLVER_ROOTFIND) { + if (step_mem->mass_type == MASS_IDENTITY) { + retval = SUNNonlinSolSetSysFn(step_mem->NLS, arkStep_NlsResidual_MassIdent); + } else if (step_mem->mass_type == MASS_FIXED) { + retval = SUNNonlinSolSetSysFn(step_mem->NLS, arkStep_NlsResidual_MassFixed); + } else if (step_mem->mass_type == MASS_TIMEDEP) { + retval = SUNNonlinSolSetSysFn(step_mem->NLS, arkStep_NlsResidual_MassTDep); + } else { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "arkStep_NlsInit", + "Invalid mass matrix type"); + return(ARK_ILL_INPUT); + } + } else if (SUNNonlinSolGetType(step_mem->NLS) == SUNNONLINEARSOLVER_FIXEDPOINT) { + if (step_mem->mass_type == MASS_IDENTITY) { + retval = SUNNonlinSolSetSysFn(step_mem->NLS, arkStep_NlsFPFunction_MassIdent); + } else if (step_mem->mass_type == MASS_FIXED) { + retval = SUNNonlinSolSetSysFn(step_mem->NLS, arkStep_NlsFPFunction_MassFixed); + } else if (step_mem->mass_type == MASS_TIMEDEP) { + retval = SUNNonlinSolSetSysFn(step_mem->NLS, arkStep_NlsFPFunction_MassTDep); + } else { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "arkStep_NlsInit", + "Invalid mass matrix type"); + return(ARK_ILL_INPUT); + } + } else { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "arkStep_NlsInit", + "Invalid nonlinear solver type"); + return(ARK_ILL_INPUT); + } + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "arkStep_NlsInit", + "Setting nonlinear system function failed"); + return(ARK_ILL_INPUT); + } + + /* initialize nonlinear solver */ + retval = SUNNonlinSolInitialize(step_mem->NLS); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "arkStep_NlsInit", MSG_NLS_INIT_FAIL); + return(ARK_NLS_INIT_FAIL); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_Nls + + This routine attempts to solve the nonlinear system associated + with a single implicit stage. It calls the supplied + SUNNonlinearSolver object to perform the solve. + + Upon entry, the predicted solution is held in step_mem->zpred, + which is never changed throughout this routine. If an initial + attempt at solving the nonlinear system fails (e.g. due to a + stale Jacobian), this allows for new attempts at the solution. + + Upon a successful solve, the solution is held in ark_mem->ycur. + ---------------------------------------------------------------*/ +int arkStep_Nls(ARKodeMem ark_mem, int nflag) +{ + ARKodeARKStepMem step_mem; + booleantype callLSetup; + long int nls_iters_inc; + int retval; + + /* access ARKodeARKStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ARKStep", + "arkStep_Nls", MSG_ARKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeARKStepMem) ark_mem->step_mem; + + /* If a linear solver 'setup' is supplied, set various flags for + determining whether it should be called */ + if (step_mem->lsetup) { + + /* Set interface 'convfail' flag for use inside lsetup */ + if (step_mem->linear) { + step_mem->convfail = (nflag == FIRST_CALL) ? ARK_NO_FAILURES : ARK_FAIL_OTHER; + } else { + step_mem->convfail = ((nflag == FIRST_CALL) || (nflag == PREV_ERR_FAIL)) ? + ARK_NO_FAILURES : ARK_FAIL_OTHER; + } + + /* Decide whether to recommend call to lsetup within nonlinear solver */ + callLSetup = (ark_mem->firststage) || (step_mem->msbp < 0) || + (SUNRabs(step_mem->gamrat-ONE) > step_mem->dgmax); + if (step_mem->linear) { /* linearly-implicit problem */ + callLSetup = callLSetup || (step_mem->linear_timedep); + } else { /* nonlinearly-implicit problem */ + callLSetup = callLSetup || + (nflag == PREV_CONV_FAIL) || (nflag == PREV_ERR_FAIL) || + (ark_mem->nst >= step_mem->nstlp + abs(step_mem->msbp)); + } + } else { + step_mem->crate = ONE; + callLSetup = SUNFALSE; + } + + /* set a zero guess for correction */ + N_VConst(ZERO, step_mem->zcor); + + /* Reset the stored residual norm (for iterative linear solvers) */ + step_mem->eRNrm = RCONST(0.1) * step_mem->nlscoef; + + /* solve the nonlinear system for the actual correction */ + retval = SUNNonlinSolSolve(step_mem->NLS, step_mem->zpred, step_mem->zcor, + ark_mem->ewt, step_mem->nlscoef, callLSetup, ark_mem); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" ARKStep nonlinear solution zcor:\n"); + N_VPrint(step_mem->zcor); +#endif + + /* apply the correction to construct ycur */ + N_VLinearSum(ONE, step_mem->zcor, ONE, step_mem->zpred, ark_mem->ycur); + + /* increment counter */ + nls_iters_inc = 0; + (void) SUNNonlinSolGetNumIters(step_mem->NLS, &(nls_iters_inc)); + step_mem->nls_iters += nls_iters_inc; + + /* on successful solve, reset the jcur flag */ + if (retval == ARK_SUCCESS) step_mem->jcur = SUNFALSE; + + /* if convergence failure, return ARKode::CONV_FAIL */ + if (retval == SUN_NLS_CONV_RECVR) return(CONV_FAIL); + + return(retval); +} + + +/*--------------------------------------------------------------- + Interface routines supplied to the SUNNonlinearSolver module + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + arkStep_NlsLSetup: + + This routine wraps the ARKode linear solver interface 'setup' + routine for use by the nonlinear solver object. + ---------------------------------------------------------------*/ +int arkStep_NlsLSetup(booleantype jbad, booleantype* jcur, void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_NlsLSetup", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* update convfail based on jbad flag */ + if (jbad) step_mem->convfail = ARK_FAIL_BAD_J; + + /* Use ARKode's tempv1, tempv2 and tempv3 as + temporary vectors for the linear solver setup routine */ + step_mem->nsetups++; + retval = step_mem->lsetup(ark_mem, step_mem->convfail, ark_mem->tcur, + ark_mem->ycur, step_mem->Fi[step_mem->istage], + &(step_mem->jcur), ark_mem->tempv1, + ark_mem->tempv2, ark_mem->tempv3); + + /* update Jacobian status */ + *jcur = step_mem->jcur; + + /* update flags and 'gamma' values for last lsetup call */ + ark_mem->firststage = SUNFALSE; + step_mem->gamrat = step_mem->crate = ONE; + step_mem->gammap = step_mem->gamma; + step_mem->nstlp = ark_mem->nst; + + if (retval < 0) return(ARK_LSETUP_FAIL); + if (retval > 0) return(CONV_FAIL); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_NlsLSolve: + + This routine wraps the ARKode linear solver interface 'solve' + routine for use by the nonlinear solver object. + ---------------------------------------------------------------*/ +int arkStep_NlsLSolve(N_Vector b, void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval, nonlin_iter; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_NlsLSolve", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* retrieve nonlinear solver iteration from module */ + retval = SUNNonlinSolGetCurIter(step_mem->NLS, &nonlin_iter); + if (retval != SUN_NLS_SUCCESS) + return(ARK_NLS_OP_ERR); + + /* call linear solver interface, and handle return value */ + retval = step_mem->lsolve(ark_mem, b, ark_mem->tcur, + ark_mem->ycur, step_mem->Fi[step_mem->istage], + step_mem->eRNrm, nonlin_iter); + + if (retval < 0) return(ARK_LSOLVE_FAIL); + if (retval > 0) return(CONV_FAIL); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_NlsResidual_MassIdent: + + This routine evaluates the nonlinear residual for the additive + Runge-Kutta method. It assumes that any data from previous + time steps/stages is contained in step_mem, and merely combines + this old data with the current implicit ODE RHS vector to + compute the nonlinear residual r. + + This version assumes an identity mass matrix. + + At the ith stage, we compute the residual vector: + r = z - yn - h*sum_{j=0}^{i-1} Ae(i,j)*Fe(j) + - h*sum_{j=0}^{i} Ai(i,j)*Fi(j) + <=> + r = zp + zc - yn - h*sum_{j=0}^{i-1} Ae(i,j)*Fe(j) + - h*sum_{j=0}^{i} Ai(i,j)*Fi(j) + <=> + r = (zc - gamma*Fi(z)) - (yn - zp + data) + where the current stage solution z = zp + zc, and where + zc is stored in the input, zcor + (yn-zp+data) is stored in step_mem->sdata, + so we really just compute: + z = zp + zc (stored in ark_mem->ycur) + Fi(z) (stored step_mem->Fi[step_mem->istage]) + r = zc - gamma*Fi(z) - step_mem->sdata + ---------------------------------------------------------------*/ +int arkStep_NlsResidual_MassIdent(N_Vector zcor, N_Vector r, void* arkode_mem) +{ + /* temporary variables */ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + realtype c[3]; + N_Vector X[3]; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_NlsResidual_MassIdent", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* update 'ycur' value as stored predictor + current corrector */ + N_VLinearSum(ONE, step_mem->zpred, ONE, zcor, ark_mem->ycur); + + /* compute implicit RHS */ + retval = step_mem->nls_fi(ark_mem->tcur, ark_mem->ycur, + step_mem->Fi[step_mem->istage], + ark_mem->user_data); + step_mem->nfi++; + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + /* compute residual via linear combination */ + c[0] = ONE; + X[0] = zcor; + c[1] = -ONE; + X[1] = step_mem->sdata; + c[2] = -step_mem->gamma; + X[2] = step_mem->Fi[step_mem->istage]; + retval = N_VLinearCombination(3, c, X, r); + if (retval != 0) return(ARK_VECTOROP_ERR); + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_NlsResidual_MassFixed: + + This routine evaluates the nonlinear residual for the additive + Runge-Kutta method. It assumes that any data from previous + time steps/stages is contained in step_mem, and merely combines + this old data with the current implicit ODE RHS vector to + compute the nonlinear residual r. + + This version assumes a fixed mass matrix. + + At the ith stage, we compute the residual vector: + r = M*z - M*yn - h*sum_{j=0}^{i-1} Ae(i,j)*Fe(j) + - h*sum_{j=0}^{i} Ai(i,j)*Fi(j) + <=> + r = M*zp + M*zc - M*yn - h*sum_{j=0}^{i-1} Ae(i,j)*Fe(j) + - h*sum_{j=0}^{i} Ai(i,j)*Fi(j) + <=> + r = (M*zc - gamma*Fi(z)) - (M*yn - M*zp + data) + where the current stage solution z = zp + zc, and where + zc is stored in the input, zcor + (M*yn-M*zp+data) is stored in step_mem->sdata, + so we really just compute: + z = zp + zc (stored in ark_mem->ycur) + Fi(z) (stored step_mem->Fi[step_mem->istage]) + r = M*zc - gamma*Fi(z) - step_mem->sdata + ---------------------------------------------------------------*/ +int arkStep_NlsResidual_MassFixed(N_Vector zcor, N_Vector r, void* arkode_mem) +{ + /* temporary variables */ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + realtype c[3]; + N_Vector X[3]; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_NlsResidual_MassFixed", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* update 'ycur' value as stored predictor + current corrector */ + N_VLinearSum(ONE, step_mem->zpred, ONE, zcor, ark_mem->ycur); + + /* compute implicit RHS */ + retval = step_mem->nls_fi(ark_mem->tcur, ark_mem->ycur, + step_mem->Fi[step_mem->istage], + ark_mem->user_data); + step_mem->nfi++; + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + /* put M*zcor in r */ + retval = step_mem->mmult((void *) ark_mem, zcor, r); + if (retval != ARK_SUCCESS) return (ARK_MASSMULT_FAIL); + + /* compute residual via linear combination */ + c[0] = ONE; + X[0] = r; + c[1] = -ONE; + X[1] = step_mem->sdata; + c[2] = -step_mem->gamma; + X[2] = step_mem->Fi[step_mem->istage]; + retval = N_VLinearCombination(3, c, X, r); + if (retval != 0) return(ARK_VECTOROP_ERR); + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_NlsResidual_MassTDep: + + This routine evaluates the nonlinear residual for the additive + Runge-Kutta method. It assumes that any data from previous + time steps/stages is contained in step_mem, and merely combines + this old data with the current implicit ODE RHS vector to + compute the nonlinear residual r. + + This version assumes a time-dependent mass matrix. + + At the ith stage, we compute the residual vector: + r = M(ti)*(z - yn) - M(ti)*h*sum_{j=0}^{i-1} Ae(i,j)*M(tj)^{-1}*Fe(j) + - M(ti)*h*sum_{j=0}^{i} Ai(i,j)*M(tj)^{-1}*Fi(j) + <=> + r = M(ti)*[zc + zp - yn - h*sum_{j=0}^{i-1} (Ai(i,j)*M(tj)^{-1}*Fi(j) + + Ae(i,j)*M(tj)^{-1}*Fe(j))] + - M(ti)*gamma*M(ti)^{-1}*Fi(i) + <=> + r = M(ti)*(zc - data) - gamma*Fi(z) + where the current stage solution z = zp + zc, and where + zc is stored in the input, zcor + yn - zp + h*sum_{j=0}^{i-1} (Ai(i,j)*M(tj)^{-1}*Fi(j) + + Ae(i,j)*M(tj)^{-1}*Fe(j)) stored in step_mem->sdata, + so we really just compute: + z = zp + zc (stored in ark_mem->ycur) + tmp = zc - data (stored in Fi[istage]) + M(t)*tmp (stored in r) + Fi(z) (stored step_mem->Fi[istage]) + r = r - gamma*Fi(z) + ---------------------------------------------------------------*/ +int arkStep_NlsResidual_MassTDep(N_Vector zcor, N_Vector r, void* arkode_mem) +{ + /* temporary variables */ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_NlsResidual_MassTDep", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* update 'ycur' value as stored predictor + current corrector */ + N_VLinearSum(ONE, step_mem->zpred, ONE, zcor, ark_mem->ycur); + + /* put M*(zcor - sdata) in r (use Fi[is] as temporary storage) */ + N_VLinearSum(ONE, zcor, -ONE, step_mem->sdata, step_mem->Fi[step_mem->istage]); + retval = step_mem->mmult((void *) ark_mem, step_mem->Fi[step_mem->istage], r); + if (retval != ARK_SUCCESS) return (ARK_MASSMULT_FAIL); + + /* compute implicit RHS */ + retval = step_mem->nls_fi(ark_mem->tcur, ark_mem->ycur, + step_mem->Fi[step_mem->istage], + ark_mem->user_data); + step_mem->nfi++; + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + /* compute residual via linear sum */ + N_VLinearSum(ONE, r, -step_mem->gamma, step_mem->Fi[step_mem->istage], r); + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_NlsFPFunction_MassIdent: + + This routine evaluates the fixed point iteration function for + the additive Runge-Kutta method. It assumes that any data from + previous time steps/stages is contained in step_mem, and + merely combines this old data with the current guess and + implicit ODE RHS vector to compute the iteration function g. + + This version assumes an identity mass matrix. + + At the ith stage, the new stage solution z should solve: + z = yn + h*sum_{j=0}^{i-1} Ae(i,j)*Fe(j) + + h*sum_{j=0}^{i} Ai(i,j)*Fi(j) + <=> + z = yn + gamma*Fi(z) + h*sum_{j=0}^{i-1} ( Ae(i,j)*Fe(j) + + Ai(i,j)*Fi(j) ) + <=> + z = yn + gamma*Fi(z) + data + <=> + zc = -zp + yn + gamma*Fi(zp+zc) + data + Where zp is the predicted stage and zc is the correction to + the prediction. + + Our fixed-point problem is zc=g(zc), so the FP function is just: + g(z) = gamma*Fi(z) + (yn - zp + data) + where the current nonlinear guess is z = zp + zc, and where + z is stored in ycur, + zp is stored in step_mem->zpred, + (yn-zp+data) is stored in step_mem->sdata, + so we really just compute: + Fi(z) (store in step_mem->Fi[step_mem->istage]) + g = gamma*Fi(z) + step_mem->sdata + ---------------------------------------------------------------*/ +int arkStep_NlsFPFunction_MassIdent(N_Vector zcor, N_Vector g, void* arkode_mem) +{ + /* temporary variables */ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_NlsFPFunction_MassIdent", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* update 'ycur' value as stored predictor + current corrector */ + N_VLinearSum(ONE, step_mem->zpred, ONE, zcor, ark_mem->ycur); + + /* compute implicit RHS and save for later */ + retval = step_mem->nls_fi(ark_mem->tcur, ark_mem->ycur, + step_mem->Fi[step_mem->istage], + ark_mem->user_data); + step_mem->nfi++; + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + /* combine parts: g = gamma*Fi(z) + sdata */ + N_VLinearSum(step_mem->gamma, step_mem->Fi[step_mem->istage], + ONE, step_mem->sdata, g); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_NlsFPFunction_MassFixed: + + This routine evaluates the fixed point iteration function for + the additive Runge-Kutta method. It assumes that any data from + previous time steps/stages is contained in step_mem, and + merely combines this old data with the current guess and + implicit ODE RHS vector to compute the iteration function g. + + This version assumes a fixed mass matrix. + + At the ith stage, the new stage solution z should solve: + M*z = M*yn + h*sum_{j=0}^{i-1} Ae(i,j)*Fe(j) + + h*sum_{j=0}^{i} Ai(i,j)*Fi(j) + <=> + M*z = M*yn + gamma*Fi(z) + h*sum_{j=0}^{i-1} ( Ae(i,j)*Fe(j) + + Ai(i,j)*Fi(j) ) + <=> + z = yn + M^{-1}*(gamma*Fi(z) + data) + <=> + zc = M^{-1}*(gamma*Fi(zp+zc) + M*yn - M*zp + data) + Where zp is the predicted stage and zc is the correction to + the prediction. + + Our fixed-point problem is zc=g(zc), so the FP function is just: + g(z) = M^{-1}*(gamma*Fi(z) + M*yn - M*zp + data) + where the current nonlinear guess is z = zp + zc, and where + z is stored in ycur, + zp is stored in step_mem->zpred, + (M*yn-M*zp+data) is stored in step_mem->sdata, + so we really just compute: + Fi(z) (store in step_mem->Fi[step_mem->istage]) + g = gamma*Fi(z) + step_mem->sdata + g = M^{-1}*g + ---------------------------------------------------------------*/ +int arkStep_NlsFPFunction_MassFixed(N_Vector zcor, N_Vector g, void* arkode_mem) +{ + /* temporary variables */ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_NlsFPFunction_MassFixed", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* update 'ycur' value as stored predictor + current corrector */ + N_VLinearSum(ONE, step_mem->zpred, ONE, zcor, ark_mem->ycur); + + /* compute implicit RHS and save for later */ + retval = step_mem->nls_fi(ark_mem->tcur, ark_mem->ycur, + step_mem->Fi[step_mem->istage], + ark_mem->user_data); + step_mem->nfi++; + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + /* combine parts: g = gamma*Fi(z) + sdata */ + N_VLinearSum(step_mem->gamma, step_mem->Fi[step_mem->istage], + ONE, step_mem->sdata, g); + + /* perform mass matrix solve */ + retval = step_mem->msolve((void *) ark_mem, g, step_mem->nlscoef); + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_NlsFPFunction_MassTDep: + + This routine evaluates the fixed point iteration function for + the additive Runge-Kutta method. It assumes that any data from + previous time steps/stages is contained in step_mem, and + merely combines this old data with the current guess and + implicit ODE RHS vector to compute the iteration function g. + + This version assumes a time-dependent mass matrix. + + At the ith stage, the new stage solution z should solve: + z = yn + h*sum_{j=0}^{i-1} Ae(i,j)*M(tj)^{-1}*Fe(j) + + h*sum_{j=0}^{i} Ai(i,j)*M(tj)^{-1}*Fi(j) + <=> + z = yn + gamma*M(ti)^{-1}*Fi(z) + + h*sum_{j=0}^{i-1} ( Ae(i,j)*M(tj)^{-1}*Fe(j) + + Ai(i,j)*M(tj)^{-1}*Fi(j) ) + <=> + z = yn + M(ti)^{-1}*gamma*Fi(z) + data + <=> + zc = yn - zp + data + M(ti)^{-1}*gamma*Fi(z) + Where zp is the predicted stage and zc is the correction to + the prediction. + + Our fixed-point problem is zc=g(zc), so the FP function is just: + g(z) = yn - zp + data + M(ti)^{-1}*gamma*Fi(z) + where the current nonlinear guess is z = zp + zc, and where + z is stored in ycur, + zp is stored in step_mem->zpred, + (yn-zp+data) is stored in step_mem->sdata, + so we really just compute: + Fi(z) (store in step_mem->Fi[step_mem->istage]) + g = M(ti)^{-1}*(gamma*Fi(z)) + g = g + step_mem->sdata + ---------------------------------------------------------------*/ +int arkStep_NlsFPFunction_MassTDep(N_Vector zcor, N_Vector g, void* arkode_mem) +{ + /* temporary variables */ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_NlsFPFunction_MassTDep", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* update 'ycur' value as stored predictor + current corrector */ + N_VLinearSum(ONE, step_mem->zpred, ONE, zcor, ark_mem->ycur); + + /* compute implicit RHS and save for later */ + retval = step_mem->nls_fi(ark_mem->tcur, ark_mem->ycur, + step_mem->Fi[step_mem->istage], + ark_mem->user_data); + step_mem->nfi++; + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + /* copy step_mem->gamma*Fi into g */ + N_VScale(step_mem->gamma, step_mem->Fi[step_mem->istage], g); + + /* perform mass matrix solve */ + retval = step_mem->msolve((void *) ark_mem, g, step_mem->nlscoef); + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + /* combine parts: g = g + sdata */ + N_VLinearSum(ONE, g, ONE, step_mem->sdata, g); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkStep_NlsConvTest: + + This routine provides the nonlinear solver convergence test for + the additive Runge-Kutta method. We have two modes. + + Standard: + delnorm = ||del||_WRMS + if (m==0) crate = 1 + if (m>0) crate = max(crdown*crate, delnorm/delp) + dcon = min(crate, ONE) * del / nlscoef + if (dcon<=1) return convergence + if ((m >= 2) && (del > rdiv*delp)) return divergence + + Linearly-implicit mode: + if the user specifies that the problem is linearly + implicit, then we just declare 'success' no matter what + is provided. + ---------------------------------------------------------------*/ +int arkStep_NlsConvTest(SUNNonlinearSolver NLS, N_Vector y, N_Vector del, + realtype tol, N_Vector ewt, void* arkode_mem) +{ + /* temporary variables */ + ARKodeMem ark_mem; + ARKodeARKStepMem step_mem; + realtype delnrm, dcon; + int m, retval; + + /* access ARKodeARKStepMem structure */ + retval = arkStep_AccessStepMem(arkode_mem, "arkStep_NlsConvTest", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if the problem is linearly implicit, just return success */ + if (step_mem->linear) + return(SUN_NLS_SUCCESS); + + /* compute the norm of the correction */ + delnrm = N_VWrmsNorm(del, ewt); + + /* get the current nonlinear solver iteration count */ + retval = SUNNonlinSolGetCurIter(NLS, &m); + if (retval != ARK_SUCCESS) return(ARK_MEM_NULL); + + /* update the stored estimate of the convergence rate (assumes linear convergence) */ + if (m > 0) + step_mem->crate = SUNMAX(step_mem->crdown*step_mem->crate, delnrm/step_mem->delp); + + /* compute our scaled error norm for testing convergence */ + dcon = SUNMIN(step_mem->crate, ONE) * delnrm / tol; + + /* check for convergence; if so return with success */ + if (dcon <= ONE) return(SUN_NLS_SUCCESS); + + /* check for divergence */ + if ((m >= 1) && (delnrm > step_mem->rdiv*step_mem->delp)) + return(SUN_NLS_CONV_RECVR); + + /* save norm of correction for next iteration */ + step_mem->delp = delnrm; + + /* return with flag that there is more work to do */ + return(SUN_NLS_CONTINUE); +} + + +/*=============================================================== + EOF + ===============================================================*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_bandpre.c b/lib/sundials_6.1.1/src/arkode/arkode_bandpre.c new file mode 100644 index 00000000000..046aef1ab6c --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_bandpre.c @@ -0,0 +1,561 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + * Based off of cvode_bandpre.c by Scott D. Cohen, + * Alan C. Hindmarsh, Radu Serban, and Aaron Collier @ LLNL + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * This file contains implementations of the banded difference + * quotient Jacobian-based preconditioner and solver routines for + * use with the ARKLS linear solver interface. + *--------------------------------------------------------------*/ + +#include +#include + +#include "arkode_impl.h" +#include "arkode_bandpre_impl.h" +#include "arkode_ls_impl.h" +#include + +#define MIN_INC_MULT RCONST(1000.0) +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + + +/* Prototypes of ARKBandPrecSetup and ARKBandPrecSolve */ +static int ARKBandPrecSetup(realtype t, N_Vector y, N_Vector fy, + booleantype jok, booleantype *jcurPtr, + realtype gamma, void *bp_data); +static int ARKBandPrecSolve(realtype t, N_Vector y, N_Vector fy, + N_Vector r, N_Vector z, + realtype gamma, realtype delta, + int lr, void *bp_data); + +/* Prototype for ARKBandPrecFree */ +static int ARKBandPrecFree(ARKodeMem ark_mem); + +/* Prototype for difference quotient Jacobian calculation routine */ +static int ARKBandPDQJac(ARKBandPrecData pdata, + realtype t, N_Vector y, N_Vector fy, + N_Vector ftemp, N_Vector ytemp); + + +/*--------------------------------------------------------------- + Initialization, Free, and Get Functions + NOTE: The band linear solver assumes a serial implementation + of the NVECTOR package. Therefore, ARKBandPrecInit will + first test for a compatible N_Vector internal + representation by checking that the function + N_VGetArrayPointer exists. +---------------------------------------------------------------*/ +int ARKBandPrecInit(void *arkode_mem, sunindextype N, + sunindextype mu, sunindextype ml) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + ARKBandPrecData pdata; + sunindextype mup, mlp, storagemu; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "ARKBandPrecInit", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Test compatibility of NVECTOR package with the BAND preconditioner */ + if(ark_mem->tempv1->ops->nvgetarraypointer == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKBANDPRE", + "ARKBandPrecInit", MSG_BP_BAD_NVECTOR); + return(ARKLS_ILL_INPUT); + } + + /* Allocate data memory */ + pdata = NULL; + pdata = (ARKBandPrecData) malloc(sizeof *pdata); + if (pdata == NULL) { + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBANDPRE", + "ARKBandPrecInit", MSG_BP_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + /* Load pointers and bandwidths into pdata block. */ + pdata->arkode_mem = arkode_mem; + pdata->N = N; + pdata->mu = mup = SUNMIN(N-1, SUNMAX(0,mu)); + pdata->ml = mlp = SUNMIN(N-1, SUNMAX(0,ml)); + + /* Initialize nfeBP counter */ + pdata->nfeBP = 0; + + /* Allocate memory for saved banded Jacobian approximation. */ + pdata->savedJ = NULL; + pdata->savedJ = SUNBandMatrixStorage(N, mup, mlp, mup, ark_mem->sunctx); + if (pdata->savedJ == NULL) { + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBANDPRE", + "ARKBandPrecInit", MSG_BP_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + /* Allocate memory for banded preconditioner. */ + storagemu = SUNMIN(N-1, mup+mlp); + pdata->savedP = NULL; + pdata->savedP = SUNBandMatrixStorage(N, mup, mlp, storagemu, ark_mem->sunctx); + if (pdata->savedP == NULL) { + SUNMatDestroy(pdata->savedJ); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBANDPRE", + "ARKBandPrecInit", MSG_BP_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + /* Allocate memory for banded linear solver */ + pdata->LS = NULL; + pdata->LS = SUNLinSol_Band(ark_mem->tempv1, pdata->savedP, ark_mem->sunctx); + if (pdata->LS == NULL) { + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBANDPRE", + "ARKBandPrecInit", MSG_BP_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + /* allocate memory for temporary N_Vectors */ + pdata->tmp1 = NULL; + if (!arkAllocVec(ark_mem, ark_mem->tempv1, &(pdata->tmp1))) { + SUNLinSolFree(pdata->LS); + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBANDPRE", + "ARKBandPrecInit", MSG_BP_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + pdata->tmp2 = NULL; + if (!arkAllocVec(ark_mem, ark_mem->tempv1, &(pdata->tmp2))) { + SUNLinSolFree(pdata->LS); + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + arkFreeVec(ark_mem, &(pdata->tmp1)); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBANDPRE", + "ARKBandPrecInit", MSG_BP_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + /* initialize band linear solver object */ + retval = SUNLinSolInitialize(pdata->LS); + if (retval != SUNLS_SUCCESS) { + SUNLinSolFree(pdata->LS); + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + arkFreeVec(ark_mem, &(pdata->tmp1)); + arkFreeVec(ark_mem, &(pdata->tmp2)); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_SUNLS_FAIL, "ARKBANDPRE", + "ARKBandPrecInit", MSG_BP_SUNLS_FAIL); + return(ARKLS_SUNLS_FAIL); + } + + /* make sure s_P_data is free from any previous allocations */ + if (arkls_mem->pfree) + arkls_mem->pfree(ark_mem); + + /* Point to the new P_data field in the LS memory */ + arkls_mem->P_data = pdata; + + /* Attach the pfree function */ + arkls_mem->pfree = ARKBandPrecFree; + + /* Attach preconditioner solve and setup functions */ + retval = arkLSSetPreconditioner(arkode_mem, + ARKBandPrecSetup, + ARKBandPrecSolve); + return(retval); +} + + +int ARKBandPrecGetWorkSpace(void *arkode_mem, long int *lenrwBP, + long int *leniwBP) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + ARKBandPrecData pdata; + sunindextype lrw1, liw1; + long int lrw, liw; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "ARKBandPrecGetWorkSpace", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Return immediately if ARKBandPrecData is NULL */ + if (arkls_mem->P_data == NULL) { + arkProcessError(ark_mem, ARKLS_PMEM_NULL, "ARKBANDPRE", + "ARKBandPrecGetWorkSpace", MSG_BP_PMEM_NULL); + return(ARKLS_PMEM_NULL); + } + pdata = (ARKBandPrecData) arkls_mem->P_data; + + /* sum space requirements for all objects in pdata */ + *leniwBP = 4; + *lenrwBP = 0; + if (ark_mem->tempv1->ops->nvspace) { + N_VSpace(ark_mem->tempv1, &lrw1, &liw1); + *leniwBP += 2*liw1; + *lenrwBP += 2*lrw1; + } + if (pdata->savedJ->ops->space) { + retval = SUNMatSpace(pdata->savedJ, &lrw, &liw); + if (retval == 0) { + *leniwBP += liw; + *lenrwBP += lrw; + } + } + if (pdata->savedP->ops->space) { + retval = SUNMatSpace(pdata->savedP, &lrw, &liw); + if (retval == 0) { + *leniwBP += liw; + *lenrwBP += lrw; + } + } + if (pdata->LS->ops->space) { + retval = SUNLinSolSpace(pdata->LS, &lrw, &liw); + if (retval == SUNLS_SUCCESS) { + *leniwBP += liw; + *lenrwBP += lrw; + } + } + + return(ARKLS_SUCCESS); +} + + +int ARKBandPrecGetNumRhsEvals(void *arkode_mem, long int *nfevalsBP) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + ARKBandPrecData pdata; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "ARKBandPrecGetNumRhsEvals", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Return immediately if ARKBandPrecData is NULL */ + if (arkls_mem->P_data == NULL) { + arkProcessError(ark_mem, ARKLS_PMEM_NULL, "ARKBANDPRE", + "ARKBandPrecGetNumRhsEvals", MSG_BP_PMEM_NULL); + return(ARKLS_PMEM_NULL); + } + pdata = (ARKBandPrecData) arkls_mem->P_data; + + /* set output */ + *nfevalsBP = pdata->nfeBP; + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKBandPrecSetup: + + Together ARKBandPrecSetup and ARKBandPrecSolve use a banded + difference quotient Jacobian to create a preconditioner. + ARKBandPrecSetup calculates a new J, if necessary, then + calculates P = I - gamma*J, and does an LU factorization of P. + + The parameters of ARKBandPrecSetup are as follows: + + t is the current value of the independent variable. + + y is the current value of the dependent variable vector, + namely the predicted value of y(t). + + fy is the vector f(t,y). + + jok is an input flag indicating whether Jacobian-related + data needs to be recomputed, as follows: + jok == SUNFALSE means recompute Jacobian-related data + from scratch. + jok == SUNTRUE means that Jacobian data from the + previous PrecSetup call will be reused + (with the current value of gamma). + A ARKBandPrecSetup call with jok == SUNTRUE should only + occur after a call with jok == SUNFALSE. + + *jcurPtr is a pointer to an output integer flag which is + set by ARKBandPrecond as follows: + *jcurPtr = SUNTRUE if Jacobian data was recomputed. + *jcurPtr = SUNFALSE if Jacobian data was not recomputed, + but saved data was reused. + + gamma is the scalar appearing in the Newton matrix. + + bp_data is a pointer to preconditoner data (set by ARKBandPrecInit) + + The value to be returned by the ARKBandPrecSetup function is + 0 if successful, or + 1 if the band factorization failed. +---------------------------------------------------------------*/ +static int ARKBandPrecSetup(realtype t, N_Vector y, N_Vector fy, + booleantype jok, booleantype *jcurPtr, + realtype gamma, void *bp_data) +{ + ARKBandPrecData pdata; + ARKodeMem ark_mem; + int retval; + + /* Assume matrix and lpivots have already been allocated. */ + pdata = (ARKBandPrecData) bp_data; + + ark_mem = (ARKodeMem) pdata->arkode_mem; + + if (jok) { + + /* If jok = SUNTRUE, use saved copy of J. */ + *jcurPtr = SUNFALSE; + retval = SUNMatCopy(pdata->savedJ, pdata->savedP); + if (retval < 0) { + arkProcessError(ark_mem, -1, "ARKBANDPRE", + "ARKBandPrecSetup", MSG_BP_SUNMAT_FAIL); + return(-1); + } + if (retval > 0) { + return(1); + } + + } else { + + /* If jok = SUNFALSE, call ARKBandPDQJac for new J value. */ + *jcurPtr = SUNTRUE; + retval = SUNMatZero(pdata->savedJ); + if (retval < 0) { + arkProcessError(ark_mem, -1, "ARKBANDPRE", + "ARKBandPrecSetup", MSG_BP_SUNMAT_FAIL); + return(-1); + } + if (retval > 0) { + return(1); + } + + retval = ARKBandPDQJac(pdata, t, y, fy, + pdata->tmp1, pdata->tmp2); + if (retval < 0) { + arkProcessError(ark_mem, -1, "ARKBANDPRE", + "ARKBandPrecSetup", MSG_BP_RHSFUNC_FAILED); + return(-1); + } + if (retval > 0) { + return(1); + } + + retval = SUNMatCopy(pdata->savedJ, pdata->savedP); + if (retval < 0) { + arkProcessError(ark_mem, -1, "ARKBANDPRE", + "ARKBandPrecSetup", MSG_BP_SUNMAT_FAIL); + return(-1); + } + if (retval > 0) { + return(1); + } + + } + + /* Scale and add identity to get savedP = I - gamma*J. */ + retval = SUNMatScaleAddI(-gamma, pdata->savedP); + if (retval) { + arkProcessError(ark_mem, -1, "ARKBANDPRE", + "ARKBandPrecSetup", MSG_BP_SUNMAT_FAIL); + return(-1); + } + + /* Do LU factorization of matrix and return error flag */ + retval = SUNLinSolSetup_Band(pdata->LS, pdata->savedP); + return(retval); +} + + +/*--------------------------------------------------------------- + ARKBandPrecSolve: + + ARKBandPrecSolve solves a linear system P z = r, where P is the + matrix computed by ARKBandPrecond. + + The parameters of ARKBandPrecSolve used here are as follows: + + r is the right-hand side vector of the linear system. + + bp_data is a pointer to preconditoner data (set by ARKBandPrecInit) + + z is the output vector computed by ARKBandPrecSolve. + + The value returned by the ARKBandPrecSolve function is always 0, + indicating success. +---------------------------------------------------------------*/ +static int ARKBandPrecSolve(realtype t, N_Vector y, N_Vector fy, + N_Vector r, N_Vector z, + realtype gamma, realtype delta, + int lr, void *bp_data) +{ + ARKBandPrecData pdata; + int retval; + + /* Assume matrix and linear solver have already been allocated. */ + pdata = (ARKBandPrecData) bp_data; + + /* Call banded solver object to do the work */ + retval = SUNLinSolSolve(pdata->LS, pdata->savedP, z, r, ZERO); + return(retval); +} + + +/*--------------------------------------------------------------- + ARKBandPrecFree: + + Frees data associated with the ARKBand preconditioner. +---------------------------------------------------------------*/ +static int ARKBandPrecFree(ARKodeMem ark_mem) +{ + ARKLsMem arkls_mem; + void* ark_step_lmem; + ARKBandPrecData pdata; + + /* Return immediately if ARKodeMem, ARKLsMem or ARKBandPrecData are NULL */ + if (ark_mem == NULL) return(0); + ark_step_lmem = ark_mem->step_getlinmem((void*) ark_mem); + if (ark_step_lmem == NULL) return(0); + arkls_mem = (ARKLsMem) ark_step_lmem; + if (arkls_mem->P_data == NULL) return(0); + pdata = (ARKBandPrecData) arkls_mem->P_data; + + SUNLinSolFree(pdata->LS); + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + arkFreeVec(ark_mem, &(pdata->tmp1)); + arkFreeVec(ark_mem, &(pdata->tmp2)); + + free(pdata); + pdata = NULL; + + return(0); +} + + +/*--------------------------------------------------------------- + ARKBandPDQJac: + + This routine generates a banded difference quotient approximation to + the Jacobian of f(t,y). It assumes that a band matrix of type + SUNDlsMat is stored column-wise, and that elements within each column + are contiguous. This makes it possible to get the address of a column + of J via the macro SUNDLS_BAND_COL and to write a simple for loop to set + each of the elements of a column in succession. +---------------------------------------------------------------*/ +static int ARKBandPDQJac(ARKBandPrecData pdata, + realtype t, N_Vector y, N_Vector fy, + N_Vector ftemp, N_Vector ytemp) +{ + ARKodeMem ark_mem; + ARKRhsFn fi; + realtype fnorm, minInc, inc, inc_inv, yj, srur, conj; + sunindextype group, i, j, width, ngroups, i1, i2; + realtype *col_j, *ewt_data, *fy_data, *ftemp_data; + realtype *y_data, *ytemp_data, *cns_data; + int retval; + + ark_mem = (ARKodeMem) pdata->arkode_mem; + + /* Access implicit RHS function */ + fi = NULL; + fi = ark_mem->step_getimplicitrhs((void*) ark_mem); + if (fi == NULL) return(-1); + + /* Obtain pointers to the data for various vectors */ + ewt_data = N_VGetArrayPointer(ark_mem->ewt); + fy_data = N_VGetArrayPointer(fy); + ftemp_data = N_VGetArrayPointer(ftemp); + y_data = N_VGetArrayPointer(y); + ytemp_data = N_VGetArrayPointer(ytemp); + cns_data = (ark_mem->constraintsSet) ? + N_VGetArrayPointer(ark_mem->constraints) : NULL; + + /* Load ytemp with y = predicted y vector. */ + N_VScale(ONE, y, ytemp); + + /* Set minimum increment based on uround and norm of f. */ + srur = SUNRsqrt(ark_mem->uround); + fnorm = N_VWrmsNorm(fy, ark_mem->rwt); + minInc = (fnorm != ZERO) ? + (MIN_INC_MULT * SUNRabs(ark_mem->h) * + ark_mem->uround * pdata->N * fnorm) : ONE; + + /* Set bandwidth and number of column groups for band differencing. */ + width = pdata->ml + pdata->mu + 1; + ngroups = SUNMIN(width, pdata->N); + + for (group = 1; group <= ngroups; group++) { + + /* Increment all y_j in group. */ + for(j = group-1; j < pdata->N; j += width) { + inc = SUNMAX(srur*SUNRabs(y_data[j]), minInc/ewt_data[j]); + yj = y_data[j]; + + /* Adjust sign(inc) again if yj has an inequality constraint. */ + if (ark_mem->constraintsSet) { + conj = cns_data[j]; + if (SUNRabs(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} + else if (SUNRabs(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} + } + + ytemp_data[j] += inc; + } + + /* Evaluate f with incremented y. */ + retval = fi(t, ytemp, ftemp, ark_mem->user_data); + pdata->nfeBP++; + if (retval != 0) return(retval); + + /* Restore ytemp, then form and load difference quotients. */ + for (j = group-1; j < pdata->N; j += width) { + yj = y_data[j]; + ytemp_data[j] = y_data[j]; + col_j = SUNBandMatrix_Column(pdata->savedJ,j); + inc = SUNMAX(srur*SUNRabs(y_data[j]), minInc/ewt_data[j]); + + /* Adjust sign(inc) as before. */ + if (ark_mem->constraintsSet) { + conj = cns_data[j]; + if (SUNRabs(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} + else if (SUNRabs(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} + } + + inc_inv = ONE/inc; + i1 = SUNMAX(0, j-pdata->mu); + i2 = SUNMIN(j+pdata->ml, pdata->N-1); + for (i=i1; i <= i2; i++) + SM_COLUMN_ELEMENT_B(col_j,i,j) = + inc_inv * (ftemp_data[i] - fy_data[i]); + } + } + + return(0); +} + + +/*--------------------------------------------------------------- + EOF +---------------------------------------------------------------*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_bandpre_impl.h b/lib/sundials_6.1.1/src/arkode/arkode_bandpre_impl.h new file mode 100644 index 00000000000..ca3d5bc46e3 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_bandpre_impl.h @@ -0,0 +1,72 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * Implementation header file for the ARKBANDPRE module. + *--------------------------------------------------------------*/ + +#ifndef _ARKBANDPRE_IMPL_H +#define _ARKBANDPRE_IMPL_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*--------------------------------------------------------------- + Type: ARKBandPrecData +---------------------------------------------------------------*/ + +typedef struct ARKBandPrecDataRec { + + /* Data set by user in ARKBandPrecInit */ + sunindextype N; + sunindextype ml, mu; + + /* Data set by ARKBandPrecSetup */ + SUNMatrix savedJ; + SUNMatrix savedP; + SUNLinearSolver LS; + N_Vector tmp1; + N_Vector tmp2; + + /* Rhs calls */ + long int nfeBP; + + /* Pointer to arkode_mem */ + void *arkode_mem; + +} *ARKBandPrecData; + + +/*--------------------------------------------------------------- + ARKBANDPRE error messages +---------------------------------------------------------------*/ + +#define MSG_BP_MEM_NULL "Integrator memory is NULL." +#define MSG_BP_LMEM_NULL "Linear solver memory is NULL. The SPILS interface must be attached." +#define MSG_BP_MEM_FAIL "A memory request failed." +#define MSG_BP_BAD_NVECTOR "A required vector operation is not implemented." +#define MSG_BP_SUNMAT_FAIL "An error arose from a SUNBandMatrix routine." +#define MSG_BP_SUNLS_FAIL "An error arose from a SUNBandLinearSolver routine." +#define MSG_BP_PMEM_NULL "Band preconditioner memory is NULL. ARKBandPrecInit must be called." +#define MSG_BP_RHSFUNC_FAILED "The right-hand side routine failed in an unrecoverable manner." + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/src/arkode/arkode_bbdpre.c b/lib/sundials_6.1.1/src/arkode/arkode_bbdpre.c new file mode 100644 index 00000000000..02de4e4358e --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_bbdpre.c @@ -0,0 +1,687 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * This file contains implementations of routines for a + * band-block-diagonal preconditioner, i.e. a block-diagonal + * matrix with banded blocks, for use with ARKode, the ARKLS + * linear solver interface, and the MPI-parallel implementation + * of NVECTOR. + *--------------------------------------------------------------*/ + +#include +#include + +#include "arkode_impl.h" +#include "arkode_bbdpre_impl.h" +#include "arkode_ls_impl.h" +#include +#include + + +#define MIN_INC_MULT RCONST(1000.0) +#define ZERO RCONST(0.0) +#define ONE RCONST(1.0) + + +/* Prototypes of functions ARKBBDPrecSetup and ARKBBDPrecSolve */ +static int ARKBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, + booleantype jok, booleantype *jcurPtr, + realtype gamma, void *bbd_data); +static int ARKBBDPrecSolve(realtype t, N_Vector y, N_Vector fy, + N_Vector r, N_Vector z, + realtype gamma, realtype delta, + int lr, void *bbd_data); + +/* Prototype for ARKBBDPrecFree */ +static int ARKBBDPrecFree(ARKodeMem ark_mem); + +/* Prototype for difference quotient Jacobian calculation routine */ +static int ARKBBDDQJac(ARKBBDPrecData pdata, realtype t, + N_Vector y, N_Vector gy, + N_Vector ytemp, N_Vector gtemp); + + +/*--------------------------------------------------------------- + User-Callable Functions: initialization, reinit and free +---------------------------------------------------------------*/ +int ARKBBDPrecInit(void *arkode_mem, sunindextype Nlocal, + sunindextype mudq, sunindextype mldq, + sunindextype mukeep, sunindextype mlkeep, + realtype dqrely, + ARKLocalFn gloc, ARKCommFn cfn) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + ARKBBDPrecData pdata; + sunindextype muk, mlk, storage_mu, lrw1, liw1; + long int lrw, liw; + int retval; + + /* access ARKMilsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "ARKBBDPrecInit", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Test compatibility of NVECTOR package with the BBD preconditioner */ + if(ark_mem->tempv1->ops->nvgetarraypointer == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKBBDPRE", + "ARKBBDPrecInit", MSG_BBD_BAD_NVECTOR); + return(ARKLS_ILL_INPUT); + } + + /* Allocate data memory */ + pdata = NULL; + pdata = (ARKBBDPrecData) malloc(sizeof *pdata); + if (pdata == NULL) { + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBBDPRE", + "ARKBBDPrecInit", MSG_BBD_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + /* Set pointers to gloc and cfn; load half-bandwidths */ + pdata->arkode_mem = arkode_mem; + pdata->gloc = gloc; + pdata->cfn = cfn; + pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0,mudq)); + pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0,mldq)); + muk = SUNMIN(Nlocal-1, SUNMAX(0,mukeep)); + mlk = SUNMIN(Nlocal-1, SUNMAX(0,mlkeep)); + pdata->mukeep = muk; + pdata->mlkeep = mlk; + + /* Allocate memory for saved Jacobian */ + pdata->savedJ = SUNBandMatrixStorage(Nlocal, muk, mlk, muk, ark_mem->sunctx); + if (pdata->savedJ == NULL) { + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBBDPRE", + "ARKBBDPrecInit", MSG_BBD_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + /* Allocate memory for preconditioner matrix */ + storage_mu = SUNMIN(Nlocal-1, muk + mlk); + pdata->savedP = NULL; + pdata->savedP = SUNBandMatrixStorage(Nlocal, muk, mlk, storage_mu, ark_mem->sunctx); + if (pdata->savedP == NULL) { + SUNMatDestroy(pdata->savedJ); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBBDPRE", + "ARKBBDPrecInit", MSG_BBD_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + /* Allocate memory for temporary N_Vectors */ + + pdata->zlocal = NULL; + pdata->zlocal = N_VNewEmpty_Serial(Nlocal, ark_mem->sunctx); + if (pdata->zlocal == NULL) { + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBBDPRE", + "ARKBBDPrecInit", MSG_BBD_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + pdata->rlocal = NULL; + pdata->rlocal = N_VNewEmpty_Serial(Nlocal, ark_mem->sunctx); + if (pdata->rlocal == NULL) { + N_VDestroy(pdata->zlocal); + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBBDPRE", + "ARKBBDPrecInit", MSG_BBD_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + pdata->tmp1 = NULL; + if (!arkAllocVec(ark_mem, ark_mem->tempv1, &(pdata->tmp1))) { + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBBDPRE", + "ARKBBDPrecInit", MSG_BBD_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + pdata->tmp2 = NULL; + if (!arkAllocVec(ark_mem, ark_mem->tempv1, &(pdata->tmp2))) { + arkFreeVec(ark_mem, &(pdata->tmp1)); + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBBDPRE", + "ARKBBDPrecInit", MSG_BBD_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + pdata->tmp3 = NULL; + if (!arkAllocVec(ark_mem, ark_mem->tempv1, &(pdata->tmp3))) { + arkFreeVec(ark_mem, &(pdata->tmp1)); + arkFreeVec(ark_mem, &(pdata->tmp2)); + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBBDPRE", + "ARKBBDPrecInit", MSG_BBD_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + /* Allocate memory for banded linear solver */ + pdata->LS = NULL; + pdata->LS = SUNLinSol_Band(pdata->rlocal, pdata->savedP, ark_mem->sunctx); + if (pdata->LS == NULL) { + arkFreeVec(ark_mem, &(pdata->tmp1)); + arkFreeVec(ark_mem, &(pdata->tmp2)); + arkFreeVec(ark_mem, &(pdata->tmp3)); + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKBBDPRE", + "ARKBBDPrecInit", MSG_BBD_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + + /* initialize band linear solver object */ + retval = SUNLinSolInitialize(pdata->LS); + if (pdata->LS == NULL) { + arkFreeVec(ark_mem, &(pdata->tmp1)); + arkFreeVec(ark_mem, &(pdata->tmp2)); + arkFreeVec(ark_mem, &(pdata->tmp3)); + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + SUNLinSolFree(pdata->LS); + free(pdata); pdata = NULL; + arkProcessError(ark_mem, ARKLS_SUNLS_FAIL, "ARKBBDPRE", + "ARKBBDPrecInit", MSG_BBD_SUNLS_FAIL); + return(ARKLS_SUNLS_FAIL); + } + + /* Set dqrely based on input dqrely (0 implies default). */ + pdata->dqrely = (dqrely > ZERO) ? + dqrely : SUNRsqrt(ark_mem->uround); + + /* Store Nlocal to be used in ARKBBDPrecSetup */ + pdata->n_local = Nlocal; + + /* Set work space sizes and initialize nge */ + pdata->rpwsize = 0; + pdata->ipwsize = 0; + if (ark_mem->tempv1->ops->nvspace) { + N_VSpace(ark_mem->tempv1, &lrw1, &liw1); + pdata->rpwsize += 3*lrw1; + pdata->ipwsize += 3*liw1; + } + if (pdata->rlocal->ops->nvspace) { + N_VSpace(pdata->rlocal, &lrw1, &liw1); + pdata->rpwsize += 2*lrw1; + pdata->ipwsize += 2*liw1; + } + if (pdata->savedJ->ops->space) { + retval = SUNMatSpace(pdata->savedJ, &lrw, &liw); + pdata->rpwsize += lrw; + pdata->ipwsize += liw; + } + if (pdata->savedP->ops->space) { + retval = SUNMatSpace(pdata->savedP, &lrw, &liw); + pdata->rpwsize += lrw; + pdata->ipwsize += liw; + } + if (pdata->LS->ops->space) { + retval = SUNLinSolSpace(pdata->LS, &lrw, &liw); + pdata->rpwsize += lrw; + pdata->ipwsize += liw; + } + pdata->nge = 0; + + /* make sure P_data is free from any previous allocations */ + if (arkls_mem->pfree) + arkls_mem->pfree(ark_mem); + + /* Point to the new P_data field in the LS memory */ + arkls_mem->P_data = pdata; + + /* Attach the pfree function */ + arkls_mem->pfree = ARKBBDPrecFree; + + /* Attach preconditioner solve and setup functions */ + retval = arkLSSetPreconditioner(arkode_mem, + ARKBBDPrecSetup, + ARKBBDPrecSolve); + + return(retval); +} + + +/*-------------------------------------------------------------*/ +int ARKBBDPrecReInit(void *arkode_mem, sunindextype mudq, + sunindextype mldq, realtype dqrely) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + ARKBBDPrecData pdata; + sunindextype Nlocal; + int retval; + + /* access ARKMilsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "ARKBBDPrecReInit", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Return immediately ARKBBDPrecData is NULL */ + if (arkls_mem->P_data == NULL) { + arkProcessError(ark_mem, ARKLS_PMEM_NULL, "ARKBBDPRE", + "ARKBBDPrecReInit", MSG_BBD_PMEM_NULL); + return(ARKLS_PMEM_NULL); + } + pdata = (ARKBBDPrecData) arkls_mem->P_data; + + /* Load half-bandwidths */ + Nlocal = pdata->n_local; + pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0,mudq)); + pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0,mldq)); + + /* Set dqrely based on input dqrely (0 implies default). */ + pdata->dqrely = (dqrely > ZERO) ? + dqrely : SUNRsqrt(ark_mem->uround); + + /* Re-initialize nge */ + pdata->nge = 0; + + return(ARKLS_SUCCESS); +} + + +/*-------------------------------------------------------------*/ +int ARKBBDPrecGetWorkSpace(void *arkode_mem, + long int *lenrwBBDP, + long int *leniwBBDP) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + ARKBBDPrecData pdata; + int retval; + + /* access ARKMilsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "ARKBBDPrecGetWorkSpace", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Return immediately ARKBBDPrecData is NULL */ + if (arkls_mem->P_data == NULL) { + arkProcessError(ark_mem, ARKLS_PMEM_NULL, "ARKBBDPRE", + "ARKBBDPrecGetWorkSpace", MSG_BBD_PMEM_NULL); + return(ARKLS_PMEM_NULL); + } + pdata = (ARKBBDPrecData) arkls_mem->P_data; + + /* set outputs */ + *lenrwBBDP = pdata->rpwsize; + *leniwBBDP = pdata->ipwsize; + + return(ARKLS_SUCCESS); +} + + +/*-------------------------------------------------------------*/ +int ARKBBDPrecGetNumGfnEvals(void *arkode_mem, + long int *ngevalsBBDP) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + ARKBBDPrecData pdata; + int retval; + + /* access ARKMilsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "ARKBBDPrecGetNumGfnEvals", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Return immediately if ARKBBDPrecData is NULL */ + if (arkls_mem->P_data == NULL) { + arkProcessError(ark_mem, ARKLS_PMEM_NULL, "ARKBBDPRE", + "ARKBBDPrecGetNumGfnEvals", MSG_BBD_PMEM_NULL); + return(ARKLS_PMEM_NULL); + } + pdata = (ARKBBDPrecData) arkls_mem->P_data; + + /* set output */ + *ngevalsBBDP = pdata->nge; + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + ARKBBDPrecSetup: + + ARKBBDPrecSetup generates and factors a banded block of the + preconditioner matrix on each processor, via calls to the + user-supplied gloc and cfn functions. It uses difference + quotient approximations to the Jacobian elements. + + ARKBBDPrecSetup calculates a new J, if necessary, then + calculates P = M - gamma*J, and does an LU factorization of P. + + The parameters of ARKBBDPrecSetup used here are as follows: + + t is the current value of the independent variable. + + y is the current value of the dependent variable vector, + namely the predicted value of y(t). + + fy is the vector f(t,y). + + jok is an input flag indicating whether Jacobian-related + data needs to be recomputed, as follows: + jok == SUNFALSE means recompute Jacobian-related data + from scratch. + jok == SUNTRUE means that Jacobian data from the + previous ARKBBDPrecon call can be reused + (with the current value of gamma). + A ARKBBDPrecon call with jok == SUNTRUE should only occur + after a call with jok == SUNFALSE. + + jcurPtr is a pointer to an output integer flag which is + set by ARKBBDPrecon as follows: + *jcurPtr = SUNTRUE if Jacobian data was recomputed. + *jcurPtr = SUNFALSE if Jacobian data was not recomputed, + but saved data was reused. + + gamma is the scalar appearing in the Newton matrix. + + bbd_data is a pointer to the preconditioner data set by + ARKBBDPrecInit + + Return value: + The value returned by this ARKBBDPrecSetup function is the int + 0 if successful, + 1 for a recoverable error (step will be retried). +---------------------------------------------------------------*/ +static int ARKBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, + booleantype jok, booleantype *jcurPtr, + realtype gamma, void *bbd_data) +{ + ARKBBDPrecData pdata; + ARKodeMem ark_mem; + int retval; + + pdata = (ARKBBDPrecData) bbd_data; + + ark_mem = (ARKodeMem) pdata->arkode_mem; + + /* If jok = SUNTRUE, use saved copy of J */ + if (jok) { + *jcurPtr = SUNFALSE; + retval = SUNMatCopy(pdata->savedJ, pdata->savedP); + if (retval < 0) { + arkProcessError(ark_mem, -1, "ARKBBDPRE", + "ARKBBDPrecSetup", MSG_BBD_SUNMAT_FAIL); + return(-1); + } + if (retval > 0) { + return(1); + } + + /* Otherwise call ARKBBDDQJac for new J value */ + } else { + + *jcurPtr = SUNTRUE; + retval = SUNMatZero(pdata->savedJ); + if (retval < 0) { + arkProcessError(ark_mem, -1, "ARKBBDPRE", + "ARKBBDPrecSetup", MSG_BBD_SUNMAT_FAIL); + return(-1); + } + if (retval > 0) { + return(1); + } + + retval = ARKBBDDQJac(pdata, t, y, pdata->tmp1, + pdata->tmp2, pdata->tmp3); + if (retval < 0) { + arkProcessError(ark_mem, -1, "ARKBBDPRE", "ARKBBDPrecSetup", + MSG_BBD_FUNC_FAILED); + return(-1); + } + if (retval > 0) { + return(1); + } + + retval = SUNMatCopy(pdata->savedJ, pdata->savedP); + if (retval < 0) { + arkProcessError(ark_mem, -1, "ARKBBDPRE", + "ARKBBDPrecSetup", MSG_BBD_SUNMAT_FAIL); + return(-1); + } + if (retval > 0) { + return(1); + } + + } + + /* Scale and add I to get P = I - gamma*J */ + retval = SUNMatScaleAddI(-gamma, pdata->savedP); + if (retval) { + arkProcessError(ark_mem, -1, "ARKBBDPRE", + "ARKBBDPrecSetup", MSG_BBD_SUNMAT_FAIL); + return(-1); + } + + /* Do LU factorization of matrix and return error flag */ + retval = SUNLinSolSetup_Band(pdata->LS, pdata->savedP); + return(retval); +} + + +/*--------------------------------------------------------------- + ARKBBDPrecSolve: + + ARKBBDPrecSolve solves a linear system P z = r, with the + band-block-diagonal preconditioner matrix P generated and + factored by ARKBBDPrecSetup. + + The parameters of ARKBBDPrecSolve used here are as follows: + + r is the right-hand side vector of the linear system. + + bbd_data is a pointer to the preconditioner data set by + ARKBBDPrecInit. + + z is the output vector computed by ARKBBDPrecSolve. + + The value returned by the ARKBBDPrecSolve function is the same + as the value returned from the linear solver object. +---------------------------------------------------------------*/ +static int ARKBBDPrecSolve(realtype t, N_Vector y, N_Vector fy, + N_Vector r, N_Vector z, + realtype gamma, realtype delta, + int lr, void *bbd_data) +{ + int retval; + ARKBBDPrecData pdata; + + pdata = (ARKBBDPrecData) bbd_data; + + /* Attach local data arrays for r and z to rlocal and zlocal */ + N_VSetArrayPointer(N_VGetArrayPointer(r), pdata->rlocal); + N_VSetArrayPointer(N_VGetArrayPointer(z), pdata->zlocal); + + /* Call banded solver object to do the work */ + retval = SUNLinSolSolve(pdata->LS, pdata->savedP, pdata->zlocal, + pdata->rlocal, ZERO); + + /* Detach local data arrays from rlocal and zlocal */ + N_VSetArrayPointer(NULL, pdata->rlocal); + N_VSetArrayPointer(NULL, pdata->zlocal); + + return(retval); +} + + +/*-------------------------------------------------------------*/ +static int ARKBBDPrecFree(ARKodeMem ark_mem) +{ + ARKLsMem arkls_mem; + void* ark_step_lmem; + ARKBBDPrecData pdata; + + /* Return immediately if ARKodeMem, ARKLsMem or ARKBandPrecData are NULL */ + if (ark_mem == NULL) return(0); + ark_step_lmem = ark_mem->step_getlinmem((void*) ark_mem); + if (ark_step_lmem == NULL) return(0); + arkls_mem = (ARKLsMem) ark_step_lmem; + if (arkls_mem->P_data == NULL) return(0); + pdata = (ARKBBDPrecData) arkls_mem->P_data; + + SUNLinSolFree(pdata->LS); + arkFreeVec(ark_mem, &(pdata->tmp1)); + arkFreeVec(ark_mem, &(pdata->tmp2)); + arkFreeVec(ark_mem, &(pdata->tmp3)); + N_VDestroy(pdata->zlocal); + N_VDestroy(pdata->rlocal); + SUNMatDestroy(pdata->savedP); + SUNMatDestroy(pdata->savedJ); + + free(pdata); + pdata = NULL; + + return(0); +} + + +/*--------------------------------------------------------------- + ARKBBDDQJac: + + This routine generates a banded difference quotient approximation + to the local block of the Jacobian of g(t,y). It assumes that a + band matrix of type SUNMatrix is stored columnwise, and that + elements within each column are contiguous. All matrix elements + are generated as difference quotients, by way of calls to the + user routine gloc. By virtue of the band structure, the number + of these calls is bandwidth + 1, where bandwidth = mldq + mudq + 1. + But the band matrix kept has bandwidth = mlkeep + mukeep + 1. + This routine also assumes that the local elements of a vector are + stored contiguously. +---------------------------------------------------------------*/ +static int ARKBBDDQJac(ARKBBDPrecData pdata, realtype t, + N_Vector y, N_Vector gy, + N_Vector ytemp, N_Vector gtemp) +{ + ARKodeMem ark_mem; + realtype gnorm, minInc, inc, inc_inv, yj, conj; + sunindextype group, i, j, width, ngroups, i1, i2; + realtype *y_data, *ewt_data, *gy_data, *gtemp_data; + realtype *ytemp_data, *col_j, *cns_data; + int retval; + + ark_mem = (ARKodeMem) pdata->arkode_mem; + + /* Load ytemp with y = predicted solution vector */ + N_VScale(ONE, y, ytemp); + + /* Call cfn and gloc to get base value of g(t,y) */ + if (pdata->cfn != NULL) { + retval = pdata->cfn(pdata->n_local, t, y, ark_mem->user_data); + if (retval != 0) return(retval); + } + + retval = pdata->gloc(pdata->n_local, t, ytemp, gy, + ark_mem->user_data); + pdata->nge++; + if (retval != 0) return(retval); + + /* Obtain pointers to the data for various vectors */ + y_data = N_VGetArrayPointer(y); + gy_data = N_VGetArrayPointer(gy); + ewt_data = N_VGetArrayPointer(ark_mem->ewt); + ytemp_data = N_VGetArrayPointer(ytemp); + gtemp_data = N_VGetArrayPointer(gtemp); + cns_data = (ark_mem->constraintsSet) ? + N_VGetArrayPointer(ark_mem->constraints) : NULL; + + /* Set minimum increment based on uround and norm of g */ + gnorm = N_VWrmsNorm(gy, ark_mem->rwt); + minInc = (gnorm != ZERO) ? + (MIN_INC_MULT * SUNRabs(ark_mem->h) * + ark_mem->uround * pdata->n_local * gnorm) : ONE; + + /* Set bandwidth and number of column groups for band differencing */ + width = pdata->mldq + pdata->mudq + 1; + ngroups = SUNMIN(width, pdata->n_local); + + /* Loop over groups */ + for (group=1; group <= ngroups; group++) { + + /* Increment all y_j in group */ + for(j=group-1; j < pdata->n_local; j+=width) { + inc = SUNMAX(pdata->dqrely*SUNRabs(y_data[j]), minInc/ewt_data[j]); + yj = y_data[j]; + + /* Adjust sign(inc) again if yj has an inequality constraint. */ + if (ark_mem->constraintsSet) { + conj = cns_data[j]; + if (SUNRabs(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} + else if (SUNRabs(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} + } + + ytemp_data[j] += inc; + } + + /* Evaluate g with incremented y */ + retval = pdata->gloc(pdata->n_local, t, ytemp, gtemp, + ark_mem->user_data); + pdata->nge++; + if (retval != 0) return(retval); + + /* Restore ytemp, then form and load difference quotients */ + for (j=group-1; j < pdata->n_local; j+=width) { + yj = y_data[j]; + ytemp_data[j] = y_data[j]; + col_j = SUNBandMatrix_Column(pdata->savedJ,j); + inc = SUNMAX(pdata->dqrely*SUNRabs(y_data[j]), minInc/ewt_data[j]); + + if (ark_mem->constraintsSet) { + conj = cns_data[j]; + if (SUNRabs(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} + else if (SUNRabs(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} + } + + inc_inv = ONE/inc; + i1 = SUNMAX(0, j-pdata->mukeep); + i2 = SUNMIN(j+pdata->mlkeep, pdata->n_local-1); + for (i=i1; i <= i2; i++) + SM_COLUMN_ELEMENT_B(col_j,i,j) = + inc_inv * (gtemp_data[i] - gy_data[i]); + } + } + + return(0); +} + + + +/*--------------------------------------------------------------- + EOF +---------------------------------------------------------------*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_bbdpre_impl.h b/lib/sundials_6.1.1/src/arkode/arkode_bbdpre_impl.h new file mode 100644 index 00000000000..1127a362243 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_bbdpre_impl.h @@ -0,0 +1,81 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * Implementation header file for the ARKBBDPRE module. + *--------------------------------------------------------------*/ + +#ifndef _ARKBBDPRE_IMPL_H +#define _ARKBBDPRE_IMPL_H + +#include +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/*--------------------------------------------------------------- + Type: ARKBBDPrecData +---------------------------------------------------------------*/ +typedef struct ARKBBDPrecDataRec { + + /* passed by user to ARKBBDPrecAlloc and used by PrecSetup/PrecSolve */ + sunindextype mudq, mldq, mukeep, mlkeep; + realtype dqrely; + ARKLocalFn gloc; + ARKCommFn cfn; + + /* set by ARKBBDPrecSetup and used by ARKBBDPrecSolve */ + SUNMatrix savedJ; + SUNMatrix savedP; + SUNLinearSolver LS; + N_Vector tmp1; + N_Vector tmp2; + N_Vector tmp3; + N_Vector zlocal; + N_Vector rlocal; + + /* set by ARKBBDPrecAlloc and used by ARKBBDPrecSetup */ + sunindextype n_local; + + /* available for optional output */ + long int rpwsize; + long int ipwsize; + long int nge; + + /* pointer to arkode_mem */ + void *arkode_mem; + +} *ARKBBDPrecData; + + +/*--------------------------------------------------------------- + ARKBBDPRE error messages +---------------------------------------------------------------*/ + +#define MSG_BBD_MEM_NULL "Integrator memory is NULL." +#define MSG_BBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." +#define MSG_BBD_MEM_FAIL "A memory request failed." +#define MSG_BBD_BAD_NVECTOR "A required vector operation is not implemented." +#define MSG_BBD_SUNMAT_FAIL "An error arose from a SUNBandMatrix routine." +#define MSG_BBD_SUNLS_FAIL "An error arose from a SUNBandLinearSolver routine." +#define MSG_BBD_PMEM_NULL "BBD peconditioner memory is NULL. ARKBBDPrecInit must be called." +#define MSG_BBD_FUNC_FAILED "The gloc or cfn routine failed in an unrecoverable manner." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/src/arkode/arkode_butcher.c b/lib/sundials_6.1.1/src/arkode/arkode_butcher.c new file mode 100644 index 00000000000..cbfa1dd9309 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_butcher.c @@ -0,0 +1,2135 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 Butcher table structure + * for the ARKode infrastructure. + *--------------------------------------------------------------*/ + +#include +#include + +#include "arkode_impl.h" +#include + + +/* tolerance for checking order conditions */ +#define TOL (SUNRsqrt(UNIT_ROUNDOFF)) + +/* Private utility functions for checking method order */ +static int __mv(realtype **A, realtype *x, int s, realtype *b); +static int __vv(realtype *x, realtype *y, int s, realtype *z); +static int __vp(realtype *x, int l, int s, realtype *z); +static int __dot(realtype *x, realtype *y, int s, realtype *d); +static booleantype __rowsum(realtype **A, realtype *c, int s); +static booleantype __order1(realtype *b, int s); +static booleantype __order2(realtype *b, realtype *c, int s); +static booleantype __order3a(realtype *b, realtype *c1, realtype *c2, int s); +static booleantype __order3b(realtype *b, realtype **A, realtype *c, int s); +static booleantype __order4a(realtype *b, realtype *c1, realtype *c2, realtype *c3, int s); +static booleantype __order4b(realtype *b, realtype *c1, realtype **A, realtype *c2, int s); +static booleantype __order4c(realtype *b, realtype **A, realtype *c1, realtype *c2, int s); +static booleantype __order4d(realtype *b, realtype **A1, realtype **A2, realtype *c, int s); +static booleantype __order5a(realtype *b, realtype *c1, realtype *c2, realtype *c3, realtype *c4, int s); +static booleantype __order5b(realtype *b, realtype *c1, realtype *c2, realtype **A, realtype *c3, int s); +static booleantype __order5c(realtype *b, realtype **A1, realtype *c1, realtype **A2, realtype *c2, int s); +static booleantype __order5d(realtype *b, realtype *c1, realtype **A, realtype *c2, realtype *c3, int s); +static booleantype __order5e(realtype *b, realtype **A, realtype *c1, realtype *c2, realtype *c3, int s); +static booleantype __order5f(realtype *b, realtype *c1, realtype **A1, realtype **A2, realtype *c2, int s); +static booleantype __order5g(realtype *b, realtype **A1, realtype *c1, realtype **A2, realtype *c2, int s); +static booleantype __order5h(realtype *b, realtype **A1, realtype **A2, realtype *c1, realtype *c2, int s); +static booleantype __order5i(realtype *b, realtype **A1, realtype **A2, realtype **A3, realtype *c, int s); +static booleantype __order6a(realtype *b, realtype *c1, realtype *c2, realtype *c3, realtype *c4, realtype *c5, int s); +static booleantype __order6b(realtype *b, realtype *c1, realtype *c2, realtype *c3, realtype **A, realtype *c4, int s); +static booleantype __order6c(realtype *b, realtype *c1, realtype **A1, realtype *c2, realtype **A2, realtype *c3, int s); +static booleantype __order6d(realtype *b, realtype *c1, realtype *c2, realtype **A, realtype *c3, realtype *c4, int s); +static booleantype __order6e(realtype *b, realtype *c1, realtype *c2, realtype **A1, realtype **A2, realtype *c3, int s); +static booleantype __order6f(realtype *b, realtype **A1, realtype **A2, realtype *c1, realtype **A3, realtype *c2, int s); +static booleantype __order6g(realtype *b, realtype *c1, realtype **A, realtype *c2, realtype *c3, realtype *c4, int s); +static booleantype __order6h(realtype *b, realtype *c1, realtype **A1, realtype *c2, realtype **A2, realtype *c3, int s); +static booleantype __order6i(realtype *b, realtype *c1, realtype **A1, realtype **A2, realtype *c2, realtype *c3, int s); +static booleantype __order6j(realtype *b, realtype *c1, realtype **A1, realtype **A2, realtype **A3, realtype *c2, int s); +static booleantype __order6k(realtype *b, realtype **A, realtype *c1, realtype *c2, realtype *c3, realtype *c4, int s); +static booleantype __order6l(realtype *b, realtype **A1, realtype *c1, realtype *c2, realtype **A2, realtype *c3, int s); +static booleantype __order6m(realtype *b, realtype **A1, realtype **A2, realtype *c1, realtype **A3, realtype *c2, int s); +static booleantype __order6n(realtype *b, realtype **A1, realtype *c1, realtype **A2, realtype *c2, realtype *c3, int s); +static booleantype __order6o(realtype *b, realtype **A1, realtype *c1, realtype **A2, realtype **A3, realtype *c2, int s); +static booleantype __order6p(realtype *b, realtype **A1, realtype **A2, realtype *c1, realtype *c2, realtype *c3, int s); +static booleantype __order6q(realtype *b, realtype **A1, realtype **A2, realtype *c1, realtype **A3, realtype *c2, int s); +static booleantype __order6r(realtype *b, realtype **A1, realtype **A2, realtype **A3, realtype *c1, realtype *c2, int s); +static booleantype __order6s(realtype *b, realtype **A1, realtype **A2, realtype **A3, realtype **A4, realtype *c, int s); +static int __ButcherSimplifyingAssumptions(realtype **A, realtype *b, realtype *c, int s); + + +/*--------------------------------------------------------------- + Routine to allocate an empty Butcher table structure + ---------------------------------------------------------------*/ +ARKodeButcherTable ARKodeButcherTable_Alloc(int stages, booleantype embedded) +{ + int i; + ARKodeButcherTable B; + + /* Check for legal 'stages' value */ + if (stages < 1) return(NULL); + + /* Allocate Butcher table structure */ + B = NULL; + B = (ARKodeButcherTable) malloc(sizeof(struct ARKodeButcherTableMem)); + if (B == NULL) return(NULL); + + /* initialize pointers in B structure to NULL */ + B->A = NULL; + B->b = NULL; + B->c = NULL; + B->d = NULL; + + /* set stages into B structure */ + B->stages = stages; + + /* + * Allocate fields within Butcher table structure + */ + + /* allocate rows of A */ + B->A = (realtype **) calloc( stages, sizeof(realtype*) ); + if (B->A == NULL) { ARKodeButcherTable_Free(B); return(NULL); } + + /* initialize each row of A to NULL */ + for (i=0; iA[i] = NULL; + + /* allocate columns of A */ + for (i=0; iA[i] = (realtype *) calloc( stages, sizeof(realtype) ); + if (B->A[i] == NULL) { ARKodeButcherTable_Free(B); return(NULL); } + } + + B->b = (realtype *) calloc( stages, sizeof(realtype) ); + if (B->b == NULL) { ARKodeButcherTable_Free(B); return(NULL); } + + B->c = (realtype *) calloc( stages, sizeof(realtype) ); + if (B->c == NULL) { ARKodeButcherTable_Free(B); return(NULL); } + + if (embedded) { + B->d = (realtype *) calloc( stages, sizeof(realtype) ); + if (B->d == NULL) { ARKodeButcherTable_Free(B); return(NULL); } + } + + /* initialize order parameters */ + B->q = 0; + B->p = 0; + + return(B); +} + + +/*--------------------------------------------------------------- + Routine to allocate and fill a Butcher table structure + ---------------------------------------------------------------*/ +ARKodeButcherTable ARKodeButcherTable_Create(int s, int q, int p, realtype *c, + realtype *A, realtype *b, + realtype *d) +{ + int i, j; + ARKodeButcherTable B; + booleantype embedded; + + /* Check for legal number of stages */ + if (s < 1) return(NULL); + + /* Does the table have an embedding? */ + embedded = (d != NULL) ? SUNTRUE : SUNFALSE; + + /* Allocate Butcher table structure */ + B = ARKodeButcherTable_Alloc(s, embedded); + if (B == NULL) return(NULL); + + /* set the relevant parameters */ + B->stages = s; + B->q = q; + B->p = p; + + for (i=0; ic[i] = c[i]; + B->b[i] = b[i]; + for (j=0; jA[i][j] = A[i*s + j]; + } + } + + if (embedded) + for (i=0; id[i] = d[i]; + + return(B); +} + + +/*--------------------------------------------------------------- + Routine to copy a Butcher table structure + ---------------------------------------------------------------*/ +ARKodeButcherTable ARKodeButcherTable_Copy(ARKodeButcherTable B) +{ + int i, j, s; + ARKodeButcherTable Bcopy; + booleantype embedded; + + /* Check for legal input */ + if (B == NULL) return(NULL); + + /* Get the number of stages */ + s = B->stages; + + /* Does the table have an embedding? */ + embedded = (B->d != NULL) ? SUNTRUE : SUNFALSE; + + /* Allocate Butcher table structure */ + Bcopy = ARKodeButcherTable_Alloc(s, embedded); + if (Bcopy == NULL) return(NULL); + + /* set the relevant parameters */ + Bcopy->stages = B->stages; + Bcopy->q = B->q; + Bcopy->p = B->p; + + /* Copy Butcher table */ + for (i=0; ic[i] = B->c[i]; + Bcopy->b[i] = B->b[i]; + for (j=0; jA[i][j] = B->A[i][j]; + } + } + + if (embedded) + for (i=0; id[i] = B->d[i]; + + return(Bcopy); +} + + +/*--------------------------------------------------------------- + Routine to query the Butcher table structure workspace size + ---------------------------------------------------------------*/ +void ARKodeButcherTable_Space(ARKodeButcherTable B, sunindextype *liw, + sunindextype *lrw) +{ + /* initialize outputs and return if B is not allocated */ + *liw = 0; *lrw = 0; + if (B == NULL) return; + + /* fill outputs based on B */ + *liw = 3; + if (B->d != NULL) { + *lrw = B->stages * (B->stages + 3); + } else { + *lrw = B->stages * (B->stages + 2); + } +} + + +/*--------------------------------------------------------------- + Routine to free a Butcher table structure + ---------------------------------------------------------------*/ +void ARKodeButcherTable_Free(ARKodeButcherTable B) +{ + int i; + + /* Free each field within Butcher table structure, and then + free structure itself */ + if (B != NULL) { + if (B->d != NULL) free(B->d); + if (B->c != NULL) free(B->c); + if (B->b != NULL) free(B->b); + if (B->A != NULL) { + for (i=0; istages; i++) + if (B->A[i] != NULL) free(B->A[i]); + free(B->A); + } + + free(B); + } +} + + +/*--------------------------------------------------------------- + Routine to print a Butcher table structure + ---------------------------------------------------------------*/ +void ARKodeButcherTable_Write(ARKodeButcherTable B, FILE *outfile) +{ + int i, j; + + /* check for vaild table */ + if (B == NULL) return; + if (B->A == NULL) return; + for (i=0; istages; i++) + if (B->A[i] == NULL) return; + if (B->c == NULL) return; + if (B->b == NULL) return; + + STAN_SUNDIALS_FPRINTF(outfile, " A = \n"); + for (i=0; istages; i++) { + STAN_SUNDIALS_FPRINTF(outfile, " "); + for (j=0; jstages; j++) + STAN_SUNDIALS_FPRINTF(outfile, "%"RSYM" ", B->A[i][j]); + STAN_SUNDIALS_FPRINTF(outfile, "\n"); + } + + STAN_SUNDIALS_FPRINTF(outfile, " c = "); + for (i=0; istages; i++) + STAN_SUNDIALS_FPRINTF(outfile, "%"RSYM" ", B->c[i]); + STAN_SUNDIALS_FPRINTF(outfile, "\n"); + + STAN_SUNDIALS_FPRINTF(outfile, " b = "); + for (i=0; istages; i++) + STAN_SUNDIALS_FPRINTF(outfile, "%"RSYM" ", B->b[i]); + STAN_SUNDIALS_FPRINTF(outfile, "\n"); + + if (B->d != NULL) { + STAN_SUNDIALS_FPRINTF(outfile, " d = "); + for (i=0; istages; i++) + STAN_SUNDIALS_FPRINTF(outfile, "%"RSYM" ", B->d[i]); + STAN_SUNDIALS_FPRINTF(outfile, "\n"); + } +} + + +/*--------------------------------------------------------------- + Routine to determine the analytical order of accuracy for a + specified Butcher table. We check the analytical [necessary] + order conditions up through order 6. After that, we revert to + the [sufficient] Butcher simplifying assumptions. + + Inputs: + B: Butcher table to check + outfile: file pointer to print results; if NULL then no + outputs are printed + + Outputs: + q: measured order of accuracy for method + p: measured order of accuracy for embedding [0 if not present] + + Return values: + 0 (success): internal {q,p} values match analytical order + 1 (warning): internal {q,p} values are lower than analytical + order, or method achieves maximum order possible with this + routine and internal {q,p} are higher. + -1 (failure): internal p and q values are higher than analytical + order + -2 (failure): NULL-valued B (or critical contents) + + Note: for embedded methods, if the return flags for p and q would + differ, failure takes precedence over warning, which takes + precedence over success. + ---------------------------------------------------------------*/ +int ARKodeButcherTable_CheckOrder(ARKodeButcherTable B, int *q, int *p, FILE *outfile) +{ + /* local variables */ + int q_SA, p_SA, i, s; + realtype **A, *b, *c, *d; + booleantype alltrue; + (*q) = (*p) = 0; + + /* verify non-NULL Butcher table structure and contents */ + if (B == NULL) return(-2); + if (B->stages < 1) return(-2); + if (B->A == NULL) return(-2); + for (i=0; istages; i++) + if (B->A[i] == NULL) return(-2); + if (B->c == NULL) return(-2); + if (B->b == NULL) return(-2); + + /* set shortcuts for Butcher table components */ + A = B->A; + b = B->b; + c = B->c; + d = B->d; + s = B->stages; + + /* check method order */ + if (outfile) STAN_SUNDIALS_FPRINTF(outfile,"ARKodeButcherTable_CheckOrder:\n"); + + /* row sum condition */ + if (__rowsum(A, c, s)) { + (*q) = 0; + } else { + (*q) = -1; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails row sum condition\n"); + } + /* order 1 condition */ + if ((*q) == 0) { + if (__order1(b, s)) { + (*q) = 1; + } else { + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 1 condition\n"); + } + } + /* order 2 condition */ + if ((*q) == 1) { + if (__order2(b, c, s)) { + (*q) = 2; + } else { + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 2 condition\n"); + } + } + /* order 3 conditions */ + if ((*q) == 2) { + alltrue = SUNTRUE; + if (!__order3a(b, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 3 condition A\n"); + } + if (!__order3b(b, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 3 condition B\n"); + } + if (alltrue) (*q) = 3; + } + /* order 4 conditions */ + if ((*q) == 3) { + alltrue = SUNTRUE; + if (!__order4a(b, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 4 condition A\n"); + } + if (!__order4b(b, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 4 condition B\n"); + } + if (!__order4c(b, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 4 condition C\n"); + } + if (!__order4d(b, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 4 condition D\n"); + } + if (alltrue) (*q) = 4; + } + /* order 5 conditions */ + if ((*q) == 4) { + alltrue = SUNTRUE; + if (!__order5a(b, c, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 condition A\n"); + } + if (!__order5b(b, c, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 condition B\n"); + } + if (!__order5c(b, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 condition C\n"); + } + if (!__order5d(b, c, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 condition D\n"); + } + if (!__order5e(b, A, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 condition E\n"); + } + if (!__order5f(b, c, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 condition F\n"); + } + if (!__order5g(b, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 condition G\n"); + } + if (!__order5h(b, A, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 condition H\n"); + } + if (!__order5i(b, A, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 condition I\n"); + } + if (alltrue) (*q) = 5; + } + /* order 6 conditions */ + if ((*q) == 5) { + alltrue = SUNTRUE; + if (!__order6a(b, c, c, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition A\n"); + } + if (!__order6b(b, c, c, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition B\n"); + } + if (!__order6c(b, c, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition C\n"); + } + if (!__order6d(b, c, c, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition D\n"); + } + if (!__order6e(b, c, c, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition E\n"); + } + if (!__order6f(b, A, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition F\n"); + } + if (!__order6g(b, c, A, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition G\n"); + } + if (!__order6h(b, c, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition H\n"); + } + if (!__order6i(b, c, A, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition I\n"); + } + if (!__order6j(b, c, A, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition J\n"); + } + if (!__order6k(b, A, c, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition K\n"); + } + if (!__order6l(b, A, c, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition L\n"); + } + if (!__order6m(b, A, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition M\n"); + } + if (!__order6n(b, A, c, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition N\n"); + } + if (!__order6o(b, A, c, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition O\n"); + } + if (!__order6p(b, A, A, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition P\n"); + } + if (!__order6q(b, A, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition Q\n"); + } + if (!__order6r(b, A, A, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition R\n"); + } + if (!__order6s(b, A, A, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 condition S\n"); + } + if (alltrue) (*q) = 6; + } + /* higher order conditions (via simplifying assumptions) */ + if ((*q) == 6) { + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method order >= 6; reverting to simplifying assumptions\n"); + q_SA = __ButcherSimplifyingAssumptions(A, b, c, s); + (*q) = SUNMAX((*q), q_SA); + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method order = %i\n", (*q)); + } + + /* check embedding order */ + if (d) { + if (outfile) STAN_SUNDIALS_FPRINTF(outfile,"\n"); + b = d; + + /* row sum condition */ + if (__rowsum(A, c, s)) { + (*p) = 0; + } else { + (*p) = -1; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails row sum condition\n"); + } + /* order 1 condition */ + if ((*p) == 0) { + if (__order1(b, s)) { + (*p) = 1; + } else { + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 1 condition\n"); + } + } + /* order 2 condition */ + if ((*p) == 1) { + if (__order2(b, c, s)) { + (*p) = 2; + } else { + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 2 condition\n"); + } + } + /* order 3 conditions */ + if ((*p) == 2) { + alltrue = SUNTRUE; + if (!__order3a(b, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 3 condition A\n"); + } + if (!__order3b(b, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 3 condition B\n"); + } + if (alltrue) (*p) = 3; + } + /* order 4 conditions */ + if ((*p) == 3) { + alltrue = SUNTRUE; + if (!__order4a(b, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 4 condition A\n"); + } + if (!__order4b(b, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 4 condition B\n"); + } + if (!__order4c(b, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 4 condition C\n"); + } + if (!__order4d(b, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 4 condition D\n"); + } + if (alltrue) (*p) = 4; + } + /* order 5 conditions */ + if ((*p) == 4) { + alltrue = SUNTRUE; + if (!__order5a(b, c, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 condition A\n"); + } + if (!__order5b(b, c, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 condition B\n"); + } + if (!__order5c(b, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 condition C\n"); + } + if (!__order5d(b, c, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 condition D\n"); + } + if (!__order5e(b, A, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 condition E\n"); + } + if (!__order5f(b, c, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 condition F\n"); + } + if (!__order5g(b, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 condition G\n"); + } + if (!__order5h(b, A, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 condition H\n"); + } + if (!__order5i(b, A, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 condition I\n"); + } + if (alltrue) (*p) = 5; + } + /* order 6 conditions */ + if ((*p) == 5) { + alltrue = SUNTRUE; + if (!__order6a(b, c, c, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition A\n"); + } + if (!__order6b(b, c, c, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition B\n"); + } + if (!__order6c(b, c, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition C\n"); + } + if (!__order6d(b, c, c, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition D\n"); + } + if (!__order6e(b, c, c, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition E\n"); + } + if (!__order6f(b, A, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition F\n"); + } + if (!__order6g(b, c, A, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition G\n"); + } + if (!__order6h(b, c, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition H\n"); + } + if (!__order6i(b, c, A, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition I\n"); + } + if (!__order6j(b, c, A, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition J\n"); + } + if (!__order6k(b, A, c, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition K\n"); + } + if (!__order6l(b, A, c, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition L\n"); + } + if (!__order6m(b, A, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition M\n"); + } + if (!__order6n(b, A, c, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition N\n"); + } + if (!__order6o(b, A, c, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition O\n"); + } + if (!__order6p(b, A, A, c, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition P\n"); + } + if (!__order6q(b, A, A, c, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition Q\n"); + } + if (!__order6r(b, A, A, A, c, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition R\n"); + } + if (!__order6s(b, A, A, A, A, c, s)) { + alltrue = SUNFALSE; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 condition S\n"); + } + if (alltrue) (*p) = 6; + } + /* higher order conditions (via simplifying assumptions) */ + if ((*p) == 6) { + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding order >= 6; reverting to simplifying assumptions\n"); + p_SA = __ButcherSimplifyingAssumptions(A, b, c, s); + (*p) = SUNMAX((*p), p_SA); + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding order = %i\n", (*p)); + } + } + + /* compare results against stored values and return */ + + /* check failure modes first */ + if (((*q) < B->q) && ((*q) < 6)) return(-1); + if (d) + if (((*p) < B->p) && ((*p) < 6)) return(-1); + + /* check warning modes */ + if ((*q) > B->q) return(1); + if (d) + if ((*p) > B->p) return(1); + if (((*q) < B->q) && ((*q) >= 6)) return(1); + if (d) + if (((*p) < B->p) && ((*p) >= 6)) return(1); + + /* return success */ + return(0); +} + + +/*--------------------------------------------------------------- + Routine to determine the analytical order of accuracy for a + specified pair of Butcher tables in an ARK pair. We check the + analytical order conditions up through order 6. + + Inputs: + B1, B2: Butcher tables to check + outfile: file pointer to print results; if NULL then no + outputs are printed + + Outputs: + q: measured order of accuracy for method + p: measured order of accuracy for embedding [0 if not present] + + Return values: + 0 (success): completed checks + 1 (warning): internal {q,p} values are lower than analytical + order, or method achieves maximum order possible with this + routine and internal {q,p} are higher. + -1 (failure): NULL-valued B1, B2 (or critical contents) + + Note: for embedded methods, if the return flags for p and q would + differ, warning takes precedence over success. + ---------------------------------------------------------------*/ +int ARKodeButcherTable_CheckARKOrder(ARKodeButcherTable B1, + ARKodeButcherTable B2, + int *q, int *p, FILE *outfile) +{ + /* local variables */ + int i, j, k, l, m, n, s; + booleantype alltrue; + realtype **A[2], *b[2], *c[2], *d[2]; + (*q) = (*p) = 0; + + /* verify non-NULL Butcher table structure and contents */ + if (B1 == NULL) return(-1); + if (B1->stages < 1) return(-1); + if (B1->A == NULL) return(-1); + for (i=0; istages; i++) + if (B1->A[i] == NULL) return(-1); + if (B1->c == NULL) return(-1); + if (B1->b == NULL) return(-1); + if (B2 == NULL) return(-1); + if (B2->stages < 1) return(-1); + if (B2->A == NULL) return(-1); + for (i=0; istages; i++) + if (B2->A[i] == NULL) return(-1); + if (B2->c == NULL) return(-1); + if (B2->b == NULL) return(-1); + if (B1->stages != B2->stages) return(-1); + + /* set shortcuts for Butcher table components */ + A[0] = B1->A; + b[0] = B1->b; + c[0] = B1->c; + d[0] = B1->d; + A[1] = B2->A; + b[1] = B2->b; + c[1] = B2->c; + d[1] = B1->d; + s = B1->stages; + + /* check method order */ + if (outfile) STAN_SUNDIALS_FPRINTF(outfile,"ARKodeButcherTable_CheckARKOrder:\n"); + + /* row sum conditions */ + if (__rowsum(A[0], c[0], s) && __rowsum(A[1], c[1], s)) { + (*q) = 0; + } else { + (*q) = -1; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails row sum conditions\n"); + } + /* order 1 conditions */ + if ((*q) == 0) { + if (__order1(b[0], s) && __order1(b[1], s)) { + (*q) = 1; + } else { + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 1 conditions\n"); + } + } + /* order 2 conditions */ + if ((*q) == 1) { + alltrue = SUNTRUE; + for (i=0; i<2; i++) + for (j=0; j<2; j++) + alltrue = (alltrue && __order2(b[i], c[j], s)); + if (alltrue) { + (*q) = 2; + } else { + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 2 conditions\n"); + } + } + /* order 3 conditions */ + if ((*q) == 2) { + alltrue = SUNTRUE; + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + alltrue = (alltrue && __order3a(b[i], c[j], c[k], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 3 conditions A\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + alltrue = (alltrue && __order3b(b[i], A[j], c[k], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 3 conditions B\n"); + if (alltrue) (*q) = 3; + } + /* order 4 conditions */ + if ((*q) == 3) { + alltrue = SUNTRUE; + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + alltrue = (alltrue && __order4a(b[i], c[j], c[k], c[l], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 4 conditions A\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + alltrue = (alltrue && __order4b(b[i], c[j], A[k], c[l], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 4 conditions B\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + alltrue = (alltrue && __order4c(b[i], A[j], c[k], c[l], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 4 conditions C\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + alltrue = (alltrue && __order4d(b[i], A[j], A[k], c[l], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 4 conditions D\n"); + if (alltrue) (*q) = 4; + } + /* order 5 conditions */ + if ((*q) == 4) { + alltrue = SUNTRUE; + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5a(b[i], c[j], c[k], c[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 conditions A\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5b(b[i], c[j], c[k], A[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 conditions B\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5c(b[i], A[j], c[k], A[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 conditions C\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5d(b[i], c[j], A[k], c[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 conditions D\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5e(b[i], A[j], c[k], c[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 conditions E\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5f(b[i], c[j], A[k], A[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 conditions F\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5g(b[i], A[j], c[k], A[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 conditions G\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5h(b[i], A[j], A[k], c[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 conditions H\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5i(b[i], A[j], A[k], A[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 5 conditions I\n"); + if (alltrue) (*q) = 5; + } + /* order 6 conditions */ + if ((*q) == 5) { + alltrue = SUNTRUE; + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6a(b[i], c[j], c[k], c[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions A\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6b(b[i], c[j], c[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions B\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6c(b[i], c[j], A[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions C\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6d(b[i], c[j], c[k], A[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions D\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6e(b[i], c[j], c[k], A[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions E\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6f(b[i], A[j], A[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions F\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6g(b[i], c[j], A[k], c[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions G\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6h(b[i], c[j], A[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions H\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6i(b[i], c[j], A[k], A[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions I\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6j(b[i], c[j], A[k], A[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions J\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6k(b[i], A[j], c[k], c[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions K\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6l(b[i], A[j], c[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions L\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6m(b[i], A[j], A[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions M\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6n(b[i], A[j], c[k], A[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions N\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6o(b[i], A[j], c[k], A[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions O\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6p(b[i], A[j], A[k], c[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions P\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6q(b[i], A[j], A[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions Q\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6r(b[i], A[j], A[k], A[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions R\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6s(b[i], A[j], A[k], A[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," method fails order 6 conditions S\n"); + if (alltrue) (*q) = 6; + } + + /* check embedding order */ + if (d[0] && d[1]) { + if (outfile) STAN_SUNDIALS_FPRINTF(outfile,"\n"); + + /* row sum conditions */ + if (__rowsum(A[0], c[0], s) && __rowsum(A[1], c[1], s)) { + (*p) = 0; + } else { + (*p) = -1; + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails row sum conditions\n"); + } + /* order 1 conditions */ + if ((*p) == 0) { + if (__order1(d[0], s) && __order1(d[1], s)) { + (*p) = 1; + } else { + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 1 conditions\n"); + } + } + /* order 2 conditions */ + if ((*p) == 1) { + alltrue = SUNTRUE; + for (i=0; i<2; i++) + for (j=0; j<2; j++) + alltrue = (alltrue && __order2(d[i], c[j], s)); + if (alltrue) { + (*p) = 2; + } else { + if (outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 2 conditions\n"); + } + } + /* order 3 conditions */ + if ((*p) == 2) { + alltrue = SUNTRUE; + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + alltrue = (alltrue && __order3a(d[i], c[j], c[k], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 3 conditions A\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + alltrue = (alltrue && __order3b(d[i], A[j], c[k], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 3 conditions B\n"); + if (alltrue) (*p) = 3; + } + /* order 4 conditions */ + if ((*p) == 3) { + alltrue = SUNTRUE; + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + alltrue = (alltrue && __order4a(d[i], c[j], c[k], c[l], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 4 conditions A\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + alltrue = (alltrue && __order4b(d[i], c[j], A[k], c[l], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 4 conditions B\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + alltrue = (alltrue && __order4c(d[i], A[j], c[k], c[l], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 4 conditions C\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + alltrue = (alltrue && __order4d(d[i], A[j], A[k], c[l], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 4 conditions D\n"); + if (alltrue) (*p) = 4; + } + /* order 5 conditions */ + if ((*p) == 4) { + alltrue = SUNTRUE; + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5a(d[i], c[j], c[k], c[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 conditions A\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5b(d[i], c[j], c[k], A[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 conditions B\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5c(d[i], A[j], c[k], A[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 conditions C\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5d(d[i], c[j], A[k], c[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 conditions D\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5e(d[i], A[j], c[k], c[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 conditions E\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5f(d[i], c[j], A[k], A[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 conditions F\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5g(d[i], A[j], c[k], A[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 conditions G\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5h(d[i], A[j], A[k], c[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 conditions H\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + alltrue = (alltrue && __order5i(d[i], A[j], A[k], A[l], c[m], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 5 conditions I\n"); + if (alltrue) (*p) = 5; + } + /* order 6 conditions */ + if ((*p) == 5) { + alltrue = SUNTRUE; + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6a(d[i], c[j], c[k], c[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions A\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6b(d[i], c[j], c[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions B\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6c(d[i], c[j], A[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions C\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6d(d[i], c[j], c[k], A[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions D\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6e(d[i], c[j], c[k], A[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions E\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6f(d[i], A[j], A[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions F\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6g(d[i], c[j], A[k], c[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions G\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6h(d[i], c[j], A[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions H\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6i(d[i], c[j], A[k], A[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions I\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6j(d[i], c[j], A[k], A[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions J\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6k(d[i], A[j], c[k], c[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions K\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6l(d[i], A[j], c[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions L\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6m(d[i], A[j], A[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions M\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6n(d[i], A[j], c[k], A[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions N\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6o(d[i], A[j], c[k], A[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions O\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6p(d[i], A[j], A[k], c[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions P\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6q(d[i], A[j], A[k], c[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions Q\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6r(d[i], A[j], A[k], A[l], c[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions R\n"); + for (i=0; i<2; i++) + for (j=0; j<2; j++) + for (k=0; k<2; k++) + for (l=0; l<2; l++) + for (m=0; m<2; m++) + for (n=0; n<2; n++) + alltrue = (alltrue && __order6s(d[i], A[j], A[k], A[l], A[m], c[n], s)); + if ( (!alltrue) && outfile) STAN_SUNDIALS_FPRINTF(outfile," embedding fails order 6 conditions S\n"); + if (alltrue) (*p) = 6; + } + } + + /* compare results against stored values and return */ + + /* check warning modes */ + if ((*q) > B1->q) return(1); + if ((*q) > B2->q) return(1); + if (d[0] && d[1]) { + if ((*p) > B1->p) return(1); + if ((*p) > B2->p) return(1); + } + if (((*q) < B1->q) && ((*q) == 6)) return(1); + if (((*q) < B2->q) && ((*q) == 6)) return(1); + if (d[0] && d[1]) { + if (((*p) < B1->p) && ((*p) == 6)) return(1); + if (((*p) < B2->p) && ((*p) == 6)) return(1); + } + + /* return success */ + return(0); +} + + +/*--------------------------------------------------------------- + Private utility routines for checking method order + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + Utility routine to compute small dense matrix-vector product + b = A*x + Here A is (s x s), x and b are (s x 1). Returns 0 on success, + nonzero on failure. + ---------------------------------------------------------------*/ +static int __mv(realtype **A, realtype *x, int s, realtype *b) +{ + int i, j; + if ((A == NULL) || (x == NULL) || (b == NULL) || (s < 1)) + return(1); + for (i=0; i TOL) + return(SUNFALSE); + } + return(SUNTRUE); +} + +/* b'*e = 1 */ +static booleantype __order1(realtype *b, int s) +{ + int i; + realtype err = RCONST(1.0); + for (i=0; i TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*c = 1/2 */ +static booleantype __order2(realtype *b, realtype *c, int s) +{ + realtype bc; + if (__dot(b,c,s,&bc)) return(SUNFALSE); + return (SUNRabs(bc - RCONST(0.5)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*(c1.*c2) = 1/3 */ +static booleantype __order3a(realtype *b, realtype *c1, realtype *c2, int s) +{ + realtype bcc; + realtype *tmp = calloc( s, sizeof(realtype) ); + if (__vv(c1,c2,s,tmp)) { free(tmp); return(SUNFALSE); } + if (__dot(b,tmp,s,&bcc)) return(SUNFALSE); + free(tmp); + return (SUNRabs(bcc - RCONST(1.0)/RCONST(3.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*(A*c) = 1/6 */ +static booleantype __order3b(realtype *b, realtype **A, realtype *c, int s) +{ + realtype bAc; + realtype *tmp = calloc( s, sizeof(realtype) ); + if (__mv(A,c,s,tmp)) { free(tmp); return(SUNFALSE); } + if (__dot(b,tmp,s,&bAc)) return(SUNFALSE); + free(tmp); + return (SUNRabs(bAc - RCONST(1.0)/RCONST(6.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*(c1.*c2.*c3) = 1/4 */ +static booleantype __order4a(realtype *b, realtype *c1, realtype *c2, realtype *c3, int s) +{ + realtype bccc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c1,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c3,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bccc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bccc - RCONST(0.25)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* (b.*c1)'*(A*c2) = 1/8 */ +static booleantype __order4b(realtype *b, realtype *c1, realtype **A, realtype *c2, int s) +{ + realtype bcAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(b,c1,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A,c2,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(tmp1,tmp2,s,&bcAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bcAc - RCONST(0.125)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A*(c1.*c2) = 1/12 */ +static booleantype __order4c(realtype *b, realtype **A, realtype *c1, realtype *c2, int s) +{ + realtype bAcc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c1,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bAcc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAcc - RCONST(1.0)/RCONST(12.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A1*A2*c = 1/24 */ +static booleantype __order4d(realtype *b, realtype **A1, realtype **A2, realtype *c, int s) +{ + realtype bAAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__mv(A2,c,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bAAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAAc - RCONST(1.0)/RCONST(24.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*(c1.*c2.*c3.*c4) = 1/5 */ +static booleantype __order5a(realtype *b, realtype *c1, realtype *c2, realtype *c3, realtype *c4, int s) +{ + realtype bcccc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c1,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c3,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c4,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp1,s,&bcccc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bcccc - RCONST(0.2)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* (b.*c1.*c2)'*(A*c3) = 1/10 */ +static booleantype __order5b(realtype *b, realtype *c1, realtype *c2, realtype **A, realtype *c3, int s) +{ + realtype bccAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c1,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(b,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A,c3,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(tmp1,tmp2,s,&bccAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bccAc - RCONST(0.1)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*((A1*c1).*(A2*c2)) = 1/20 */ +static booleantype __order5c(realtype *b, realtype **A1, realtype *c1, realtype **A2, realtype *c2, int s) +{ + realtype bAcAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + realtype *tmp3 = calloc( s, sizeof(realtype) ); + if (__mv(A1,c1,s,tmp1)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__mv(A2,c2,s,tmp2)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__vv(tmp1,tmp2,s,tmp3)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__dot(b,tmp3,s,&bAcAc)) return(SUNFALSE); + free(tmp1); free(tmp2); free(tmp3); + return (SUNRabs(bAcAc - RCONST(0.05)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* (b.*c1)'*A*(c2.*c3) = 1/15 */ +static booleantype __order5d(realtype *b, realtype *c1, realtype **A, realtype *c2, realtype *c3, int s) +{ + realtype bcAcc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c2,c3,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(b,c1,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(tmp1,tmp2,s,&bcAcc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bcAcc - RCONST(1.0)/RCONST(15.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A*(c1.*c2.*c3) = 1/20 */ +static booleantype __order5e(realtype *b, realtype **A, realtype *c1, realtype *c2, realtype *c3, int s) +{ + realtype bAccc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c1,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c3,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp1,s,&bAccc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAccc - RCONST(0.05)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* (b.*c1)'*A1*A2*c2 = 1/30 */ +static booleantype __order5f(realtype *b, realtype *c1, realtype **A1, realtype **A2, realtype *c2, int s) +{ + realtype bcAAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__mv(A2,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(b,c1,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(tmp1,tmp2,s,&bcAAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bcAAc - RCONST(1.0)/RCONST(30.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A1*(c1.*(A2*c2)) = 1/40 */ +static booleantype __order5g(realtype *b, realtype **A1, realtype *c1, realtype **A2, realtype *c2, int s) +{ + realtype bAcAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__mv(A2,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp1,s,&bAcAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAcAc - RCONST(1.0)/RCONST(40.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A1*A2*(c1.*c2) = 1/60 */ +static booleantype __order5h(realtype *b, realtype **A1, realtype **A2, realtype *c1, realtype *c2, int s) +{ + realtype bAAcc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c1,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A2,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp1,s,&bAAcc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAAcc - RCONST(1.0)/RCONST(60.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A1*A2*A3*c = 1/120 */ +static booleantype __order5i(realtype *b, realtype **A1, realtype **A2, realtype **A3, realtype *c, int s) +{ + realtype bAAAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__mv(A3,c,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A2,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp1,s,&bAAAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAAAc - RCONST(1.0)/RCONST(120.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*(c1.*c2.*c3.*c4.*c5) = 1/6 */ +static booleantype __order6a(realtype *b, realtype *c1, realtype *c2, realtype *c3, realtype *c4, realtype *c5, int s) +{ + realtype bccccc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c1,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c3,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c4,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c5,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bccccc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bccccc - RCONST(1.0)/RCONST(6.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* (b.*c1.*c2.*c3)'*(A*c4) = 1/12 */ +static booleantype __order6b(realtype *b, realtype *c1, realtype *c2, realtype *c3, realtype **A, realtype *c4, int s) +{ + realtype bcccAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(b,c1,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c2,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c3,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A,c4,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(tmp1,tmp2,s,&bcccAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bcccAc - RCONST(1.0)/RCONST(12.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*(c1.*(A1*c2).*(A2*c3)) = 1/24 */ +static booleantype __order6c(realtype *b, realtype *c1, realtype **A1, realtype *c2, realtype **A2, realtype *c3, int s) +{ + realtype bcAc2; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + realtype *tmp3 = calloc( s, sizeof(realtype) ); + if (__mv(A2,c3,s,tmp1)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__mv(A1,c2,s,tmp2)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__vv(tmp1,tmp2,s,tmp3)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__vv(c1,tmp3,s,tmp1)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__dot(b,tmp1,s,&bcAc2)) return(SUNFALSE); + free(tmp1); free(tmp2); free(tmp3); + return (SUNRabs(bcAc2 - RCONST(1.0)/RCONST(24.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* (b.*c1.*c2)'*A*(c3.*c4) = 1/18 */ +static booleantype __order6d(realtype *b, realtype *c1, realtype *c2, realtype **A, realtype *c3, realtype *c4, int s) +{ + realtype bccAcc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + realtype *tmp3 = calloc( s, sizeof(realtype) ); + if (__vv(c3,c4,s,tmp1)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__mv(A,tmp1,s,tmp2)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__vv(c1,c2,s,tmp1)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__vv(b,tmp1,s,tmp3)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__dot(tmp2,tmp3,s,&bccAcc)) return(SUNFALSE); + free(tmp1); free(tmp2); free(tmp3); + return (SUNRabs(bccAcc - RCONST(1.0)/RCONST(18.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* (b.*(c1.*c2))'*A1*A2*c3 = 1/36 */ +static booleantype __order6e(realtype *b, realtype *c1, realtype *c2, realtype **A1, realtype **A2, realtype *c3, int s) +{ + realtype bccAAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + realtype *tmp3 = calloc( s, sizeof(realtype) ); + if (__vv(c1,c2,s,tmp1)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__vv(b,tmp1,s,tmp2)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__mv(A2,c3,s,tmp1)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__mv(A1,tmp1,s,tmp3)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__dot(tmp2,tmp3,s,&bccAAc)) return(SUNFALSE); + free(tmp1); free(tmp2); free(tmp3); + return (SUNRabs(bccAAc - RCONST(1.0)/RCONST(36.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*((A1*A2*c1).*(A3*c2)) = 1/72 */ +static booleantype __order6f(realtype *b, realtype **A1, realtype **A2, realtype *c1, realtype **A3, realtype *c2, int s) +{ + realtype bAAcAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + realtype *tmp3 = calloc( s, sizeof(realtype) ); + if (__mv(A2,c1,s,tmp1)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__mv(A1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__mv(A3,c2,s,tmp1)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__vv(tmp1,tmp2,s,tmp3)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__dot(b,tmp3,s,&bAAcAc)) return(SUNFALSE); + free(tmp1); free(tmp2); free(tmp3); + return (SUNRabs(bAAcAc - RCONST(1.0)/RCONST(72.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*(c1.*(A*(c2.*c3.*c4))) = 1/24 */ +static booleantype __order6g(realtype *b, realtype *c1, realtype **A, realtype *c2, realtype *c3, realtype *c4, int s) +{ + realtype bcAccc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c2,c3,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c4,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bcAccc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bcAccc - RCONST(1.0)/RCONST(24.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*(c1.*(A1*(c2.*(A2*c3)))) = 1/48 */ +static booleantype __order6h(realtype *b, realtype *c1, realtype **A1, realtype *c2, realtype **A2, realtype *c3, int s) +{ + realtype bcAcAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__mv(A2,c3,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c2,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bcAcAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bcAcAc - RCONST(1.0)/RCONST(48.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*(c1.*(A1*A2*(c2.*c3))) = 1/72 */ +static booleantype __order6i(realtype *b, realtype *c1, realtype **A1, realtype **A2, realtype *c2, realtype *c3, int s) +{ + realtype bcAAcc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c2,c3,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A2,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bcAAcc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bcAAcc - RCONST(1.0)/RCONST(72.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*(c1.*(A1*A2*A3*c2)) = 1/144 */ +static booleantype __order6j(realtype *b, realtype *c1, realtype **A1, realtype **A2, realtype **A3, realtype *c2, int s) +{ + realtype bcAAAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__mv(A3,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A2,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bcAAAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bcAAAc - RCONST(1.0)/RCONST(144.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A*(c1.*c2.*c3.*c4) = 1/30 */ +static booleantype __order6k(realtype *b, realtype **A, realtype *c1, realtype *c2, realtype *c3, realtype *c4, int s) +{ + realtype bAcccc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c1,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c3,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c4,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bAcccc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAcccc - RCONST(1.0)/RCONST(30.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A1*(c1.*c2.*(A2*c3)) = 1/60 */ +static booleantype __order6l(realtype *b, realtype **A1, realtype *c1, realtype *c2, realtype **A2, realtype *c3, int s) +{ + realtype bAccAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__mv(A2,c3,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c2,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c1,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bAccAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAccAc - RCONST(1.0)/RCONST(60.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A1*((A2*c1).*(A3*c2)) = 1/120 */ +static booleantype __order6m(realtype *b, realtype **A1, realtype **A2, realtype *c1, realtype **A3, realtype *c2, int s) +{ + realtype bAAcAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + realtype *tmp3 = calloc( s, sizeof(realtype) ); + if (__mv(A3,c2,s,tmp1)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__mv(A2,c1,s,tmp2)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__vv(tmp1,tmp2,s,tmp3)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp3,s,tmp1)) { free(tmp1); free(tmp2); free(tmp3); return(SUNFALSE); } + if (__dot(b,tmp1,s,&bAAcAc)) return(SUNFALSE); + free(tmp1); free(tmp2); free(tmp3); + return (SUNRabs(bAAcAc - RCONST(1.0)/RCONST(120.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A1*(c1.*(A2*(c2.*c3))) = 1/90 */ +static booleantype __order6n(realtype *b, realtype **A1, realtype *c1, realtype **A2, realtype *c2, realtype *c3, int s) +{ + realtype bAcAcc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c2,c3,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A2,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c1,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bAcAcc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAcAcc - RCONST(1.0)/RCONST(90.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A1*(c1.*(A2*A3*c2)) = 1/180 */ +static booleantype __order6o(realtype *b, realtype **A1, realtype *c1, realtype **A2, realtype **A3, realtype *c2, int s) +{ + realtype bAcAAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__mv(A3,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A2,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c1,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bAcAAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAcAAc - RCONST(1.0)/RCONST(180.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A1*A2*(c1.*c2.*c3) = 1/120 */ +static booleantype __order6p(realtype *b, realtype **A1, realtype **A2, realtype *c1, realtype *c2, realtype *c3, int s) +{ + realtype bAAccc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c1,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c3,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A2,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bAAccc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAAccc - RCONST(1.0)/RCONST(120.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A1*A2*(c1.*(A3*c2)) = 1/240 */ +static booleantype __order6q(realtype *b, realtype **A1, realtype **A2, realtype *c1, realtype **A3, realtype *c2, int s) +{ + realtype bAAcAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__mv(A3,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__vv(c1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A2,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bAAcAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAAcAc - RCONST(1.0)/RCONST(240.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A1*A2*A3*(c1.*c2) = 1/360 */ +static booleantype __order6r(realtype *b, realtype **A1, realtype **A2, realtype **A3, realtype *c1, realtype *c2, int s) +{ + realtype bAAAcc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__vv(c1,c2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A3,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A2,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bAAAcc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAAAcc - RCONST(1.0)/RCONST(360.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + +/* b'*A1*A2*A3*A4*c = 1/720 */ +static booleantype __order6s(realtype *b, realtype **A1, realtype **A2, realtype **A3, realtype **A4, realtype *c, int s) +{ + realtype bAAAAc; + realtype *tmp1 = calloc( s, sizeof(realtype) ); + realtype *tmp2 = calloc( s, sizeof(realtype) ); + if (__mv(A4,c,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A2,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A2,tmp2,s,tmp1)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__mv(A1,tmp1,s,tmp2)) { free(tmp1); free(tmp2); return(SUNFALSE); } + if (__dot(b,tmp2,s,&bAAAAc)) return(SUNFALSE); + free(tmp1); free(tmp2); + return (SUNRabs(bAAAAc - RCONST(1.0)/RCONST(720.0)) > TOL) ? SUNFALSE : SUNTRUE; +} + + +/*--------------------------------------------------------------- + Utility routine to check Butcher's simplifying assumptions. + Returns the maximum predicted order. + ---------------------------------------------------------------*/ +static int __ButcherSimplifyingAssumptions(realtype **A, realtype *b, realtype *c, int s) +{ + int P, Q, R, i, j, k, q; + realtype RHS, LHS; + booleantype alltrue; + realtype *tmp = calloc( s, sizeof(realtype) ); + + /* B(P) */ + P = 0; + for (i=1; i<1000; i++) { + if (__vp(c,i-1,s,tmp)) { free(tmp); return(0); } + if (__dot(b,tmp,s,&LHS)) { free(tmp); return(0); } + RHS = RCONST(1.0)/i; + if (SUNRabs(RHS-LHS) > TOL) + break; + P++; + } + + /* C(Q) */ + Q = 0; + for (k=1; k<1000; k++) { + alltrue = SUNTRUE; + for (i=0; i TOL) { + alltrue = SUNFALSE; + break; + } + } + if (alltrue) { + Q++; + } else { + break; + } + } + + /* D(R) */ + R = 0; + for (k=1; k<1000; k++) { + alltrue = SUNTRUE; + for (j=0; j TOL) { + alltrue = SUNFALSE; + break; + } + } + if (alltrue) { + R++; + } else { + break; + } + } + + /* determine q, clean up and return */ + q = 0; + for (i=1; i<=P; i++) { + if ((q > Q+R+1) || (q > 2*Q+2)) + break; + q++; + } + free(tmp); + return(q); +} + +/*--------------------------------------------------------------- + EOF + ---------------------------------------------------------------*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_butcher_dirk.c b/lib/sundials_6.1.1/src/arkode/arkode_butcher_dirk.c new file mode 100644 index 00000000000..a8dd7130c7e --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_butcher_dirk.c @@ -0,0 +1,618 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 built-in DIRK Butcher + * tables. + *--------------------------------------------------------------*/ + +#include +#include + +#include "arkode_impl.h" +#include +#include + + +/*--------------------------------------------------------------- + Returns Butcher table structure for pre-set DIRK methods. + + Input: imeth -- integer key for the desired method (see below) + + Allowed 'method' names and properties (those in an ARK pair are + marked with a *). All method names are of the form + _s_p_q. The method 'type' is one of + SDIRK -- singly-diagonally implicit Runge Kutta + ESDIRK -- explicit [1st stage] singly-diagonally implicit Runge Kutta + The 'A-stable' and 'L-stable' columns are based on numerical estimates + of each property. + + The 'QP' column denotes whether the coefficients of the method are known + precisely enough for use in quad precision (128-bit) calculations. + + imeth type A-stable L-stable QP + ---------------------------------------------------------- + ARKODE_SDIRK_2_1_2 SDIRK Y N Y + ARKODE_BILLINGTON_3_3_2 SDIRK N N N + ARKODE_TRBDF2_3_3_2 ESDIRK N N Y + ARKODE_KVAERNO_4_2_3 ESDIRK Y Y N + ARKODE_ARK324L2SA_DIRK_4_2_3* ESDIRK Y Y N + ARKODE_CASH_5_2_4 SDIRK Y Y N + ARKODE_CASH_5_3_4 SDIRK Y Y N + ARKODE_SDIRK_5_3_4 SDIRK Y Y Y + ARKODE_KVAERNO_5_3_4 ESDIRK Y N N + ARKODE_ARK436L2SA_DIRK_6_3_4* ESDIRK Y Y N + ARKODE_ARK437L2SA_DIRK_7_3_4* ESDIRK Y Y N + ARKODE_KVAERNO_7_4_5 ESDIRK Y Y N + ARKODE_ARK548L2SA_DIRK_8_4_5* ESDIRK Y Y N + ARKODE_ARK548L2SAb_DIRK_8_4_5* ESDIRK Y Y N + ---------------------------------------------------------- + + ---------------------------------------------------------------*/ +ARKodeButcherTable ARKodeButcherTable_LoadDIRK(ARKODE_DIRKTableID imethod) +{ + + ARKodeButcherTable B; + B = NULL; + + /* fill in coefficients based on method name */ + switch(imethod) { + + case(ARKODE_SDIRK_2_1_2): /* SDIRK-2-1 (A,B stable) */ + B = ARKodeButcherTable_Alloc(2, SUNTRUE); + B->q = 2; + B->p = 1; + + B->A[0][0] = RCONST(1.0); + B->A[1][0] = RCONST(-1.0); + B->A[1][1] = RCONST(1.0); + + B->b[0] = RCONST(0.5); + B->b[1] = RCONST(0.5); + + B->d[0] = RCONST(1.0); + + B->c[0] = RCONST(1.0); + B->c[1] = RCONST(0.0); + break; + + case(ARKODE_BILLINGTON_3_3_2): /* Billington-SDIRK */ + B = ARKodeButcherTable_Alloc(3, SUNTRUE); + B->q = 2; + B->p = 3; + + B->A[0][0] = RCONST(0.292893218813); + B->A[1][0] = RCONST(0.798989873223); + B->A[1][1] = RCONST(0.292893218813); + B->A[2][0] = RCONST(0.740789228841); + B->A[2][1] = RCONST(0.259210771159); + B->A[2][2] = RCONST(0.292893218813); + + B->d[0] = RCONST(0.691665115992); + B->d[1] = RCONST(0.503597029883); + B->d[2] = RCONST(-0.195262145876); + + B->b[0] = RCONST(0.740789228840); + B->b[1] = RCONST(0.259210771159); + + B->c[0] = RCONST(0.292893218813); + B->c[1] = RCONST(1.091883092037); + B->c[2] = RCONST(1.292893218813); + break; + + case(ARKODE_TRBDF2_3_3_2): /* TRBDF2-ESDIRK */ + B = ARKodeButcherTable_Alloc(3, SUNTRUE); + B->q = 2; + B->p = 3; + + B->A[1][0] = (RCONST(2.0)-SUNRsqrt(RCONST(2.0)))/RCONST(2.0); + B->A[1][1] = (RCONST(2.0)-SUNRsqrt(RCONST(2.0)))/RCONST(2.0); + B->A[2][0] = SUNRsqrt(RCONST(2.0))/RCONST(4.0); + B->A[2][1] = SUNRsqrt(RCONST(2.0))/RCONST(4.0); + B->A[2][2] = (RCONST(2.0)-SUNRsqrt(RCONST(2.0)))/RCONST(2.0); + + B->d[0] = (RCONST(1.0)-SUNRsqrt(RCONST(2.0))/RCONST(4.0))/RCONST(3.0); + B->d[1] = (RCONST(3.0)*SUNRsqrt(RCONST(2.0))/RCONST(4.0)+RCONST(1.0))/RCONST(3.0); + B->d[2] = (RCONST(2.0)-SUNRsqrt(RCONST(2.0)))/RCONST(6.0); + + B->b[0] = SUNRsqrt(RCONST(2.0))/RCONST(4.0); + B->b[1] = SUNRsqrt(RCONST(2.0))/RCONST(4.0); + B->b[2] = (RCONST(2.0)-SUNRsqrt(RCONST(2.0)))/RCONST(2.0); + + B->c[1] = RCONST(2.0)-SUNRsqrt(RCONST(2.0)); + B->c[2] = RCONST(1.0); + break; + + case(ARKODE_KVAERNO_4_2_3): /* Kvaerno(4,2,3)-ESDIRK */ + B = ARKodeButcherTable_Alloc(4, SUNTRUE); + B->q = 3; + B->p = 2; + B->A[1][0] = RCONST(0.4358665215); + B->A[1][1] = RCONST(0.4358665215); + B->A[2][0] = RCONST(0.490563388419108); + B->A[2][1] = RCONST(0.073570090080892); + B->A[2][2] = RCONST(0.4358665215); + B->A[3][0] = RCONST(0.308809969973036); + B->A[3][1] = RCONST(1.490563388254106); + B->A[3][2] = RCONST(-1.235239879727145); + B->A[3][3] = RCONST(0.4358665215); + + B->b[0] = RCONST(0.308809969973036); + B->b[1] = RCONST(1.490563388254106); + B->b[2] = RCONST(-1.235239879727145); + B->b[3] = RCONST(0.4358665215); + + B->d[0] = RCONST(0.490563388419108); + B->d[1] = RCONST(0.073570090080892); + B->d[2] = RCONST(0.4358665215); + + B->c[1] = RCONST(0.871733043); + B->c[2] = RCONST(1.0); + B->c[3] = RCONST(1.0); + break; + + case(ARKODE_ARK324L2SA_DIRK_4_2_3): /* ARK3(2)4L[2]SA-ESDIRK */ + B = ARKodeButcherTable_Alloc(4, SUNTRUE); + B->q = 3; + B->p = 2; + B->A[1][0] = RCONST(1767732205903.0)/RCONST(4055673282236.0); + B->A[1][1] = RCONST(1767732205903.0)/RCONST(4055673282236.0); + B->A[2][0] = RCONST(2746238789719.0)/RCONST(10658868560708.0); + B->A[2][1] = RCONST(-640167445237.0)/RCONST(6845629431997.0); + B->A[2][2] = RCONST(1767732205903.0)/RCONST(4055673282236.0); + B->A[3][0] = RCONST(1471266399579.0)/RCONST(7840856788654.0); + B->A[3][1] = RCONST(-4482444167858.0)/RCONST(7529755066697.0); + B->A[3][2] = RCONST(11266239266428.0)/RCONST(11593286722821.0); + B->A[3][3] = RCONST(1767732205903.0)/RCONST(4055673282236.0); + + B->b[0] = RCONST(1471266399579.0)/RCONST(7840856788654.0); + B->b[1] = RCONST(-4482444167858.0)/RCONST(7529755066697.0); + B->b[2] = RCONST(11266239266428.0)/RCONST(11593286722821.0); + B->b[3] = RCONST(1767732205903.0)/RCONST(4055673282236.0); + + B->d[0] = RCONST(2756255671327.0)/RCONST(12835298489170.0); + B->d[1] = RCONST(-10771552573575.0)/RCONST(22201958757719.0); + B->d[2] = RCONST(9247589265047.0)/RCONST(10645013368117.0); + B->d[3] = RCONST(2193209047091.0)/RCONST(5459859503100.0); + + B->c[1] = RCONST(1767732205903.0)/RCONST(2027836641118.0); + B->c[2] = RCONST(3.0)/RCONST(5.0); + B->c[3] = RCONST(1.0); + break; + + case(ARKODE_CASH_5_2_4): /* Cash(5,2,4)-SDIRK */ + B = ARKodeButcherTable_Alloc(5, SUNTRUE); + B->q = 4; + B->p = 2; + B->A[0][0] = RCONST(0.435866521508); + B->A[1][0] = RCONST(-1.13586652150); + B->A[1][1] = RCONST(0.435866521508); + B->A[2][0] = RCONST(1.08543330679); + B->A[2][1] = RCONST(-0.721299828287); + B->A[2][2] = RCONST(0.435866521508); + B->A[3][0] = RCONST(0.416349501547); + B->A[3][1] = RCONST(0.190984004184); + B->A[3][2] = RCONST(-0.118643265417); + B->A[3][3] = RCONST(0.435866521508); + B->A[4][0] = RCONST(0.896869652944); + B->A[4][1] = RCONST(0.0182725272734); + B->A[4][2] = RCONST(-0.0845900310706); + B->A[4][3] = RCONST(-0.266418670647); + B->A[4][4] = RCONST(0.435866521508); + + B->b[0] = RCONST(0.896869652944); + B->b[1] = RCONST(0.0182725272734); + B->b[2] = RCONST(-0.0845900310706); + B->b[3] = RCONST(-0.266418670647); + B->b[4] = RCONST(0.435866521508); + + B->d[0] = (RCONST(-0.7)-RCONST(0.5))/(RCONST(-0.7)-RCONST(0.435866521508)); + B->d[1] = (RCONST(0.5)-RCONST(0.435866521508))/(RCONST(-0.7)-RCONST(0.435866521508)); + + B->c[0] = RCONST(0.435866521508); + B->c[1] = RCONST(-0.7); + B->c[2] = RCONST(0.8); + B->c[3] = RCONST(0.924556761814); + B->c[4] = RCONST(1.0); + break; + + case(ARKODE_CASH_5_3_4): /* Cash(5,3,4)-SDIRK */ + B = ARKodeButcherTable_Alloc(5, SUNTRUE); + B->q = 4; + B->p = 3; + B->A[0][0] = RCONST(0.435866521508); + B->A[1][0] = RCONST(-1.13586652150); + B->A[1][1] = RCONST(0.435866521508); + B->A[2][0] = RCONST(1.08543330679); + B->A[2][1] = RCONST(-0.721299828287); + B->A[2][2] = RCONST(0.435866521508); + B->A[3][0] = RCONST(0.416349501547); + B->A[3][1] = RCONST(0.190984004184); + B->A[3][2] = RCONST(-0.118643265417); + B->A[3][3] = RCONST(0.435866521508); + B->A[4][0] = RCONST(0.896869652944); + B->A[4][1] = RCONST(0.0182725272734); + B->A[4][2] = RCONST(-0.0845900310706); + B->A[4][3] = RCONST(-0.266418670647); + B->A[4][4] = RCONST(0.435866521508); + + B->b[0] = RCONST(0.896869652944); + B->b[1] = RCONST(0.0182725272734); + B->b[2] = RCONST(-0.0845900310706); + B->b[3] = RCONST(-0.266418670647); + B->b[4] = RCONST(0.435866521508); + + B->d[0] = RCONST(0.776691932910); + B->d[1] = RCONST(0.0297472791484); + B->d[2] = RCONST(-0.0267440239074); + B->d[3] = RCONST(0.220304811849); + + B->c[0] = RCONST(0.435866521508); + B->c[1] = RCONST(-0.7); + B->c[2] = RCONST(0.8); + B->c[3] = RCONST(0.924556761814); + B->c[4] = RCONST(1.0); + break; + + case(ARKODE_SDIRK_5_3_4): /* SDIRK-5-4 */ + B = ARKodeButcherTable_Alloc(5, SUNTRUE); + B->q = 4; + B->p = 3; + B->A[0][0] = RCONST(0.25); + B->A[1][0] = RCONST(0.5); + B->A[1][1] = RCONST(0.25); + B->A[2][0] = RCONST(17.0)/RCONST(50.0); + B->A[2][1] = RCONST(-1.0)/RCONST(25.0); + B->A[2][2] = RCONST(0.25); + B->A[3][0] = RCONST(371.0)/RCONST(1360.0); + B->A[3][1] = RCONST(-137.0)/RCONST(2720.0); + B->A[3][2] = RCONST(15.0)/RCONST(544.0); + B->A[3][3] = RCONST(0.25); + B->A[4][0] = RCONST(25.0)/RCONST(24.0); + B->A[4][1] = RCONST(-49.0)/RCONST(48.0); + B->A[4][2] = RCONST(125.0)/RCONST(16.0); + B->A[4][3] = RCONST(-85.0)/RCONST(12.0); + B->A[4][4] = RCONST(0.25); + + B->b[0] = RCONST(25.0)/RCONST(24.0); + B->b[1] = RCONST(-49.0)/RCONST(48.0); + B->b[2] = RCONST(125.0)/RCONST(16.0); + B->b[3] = RCONST(-85.0)/RCONST(12.0); + B->b[4] = RCONST(0.25); + + B->d[0] = RCONST(59.0)/RCONST(48.0); + B->d[1] = RCONST(-17.0)/RCONST(96.0); + B->d[2] = RCONST(225.0)/RCONST(32.0); + B->d[3] = RCONST(-85.0)/RCONST(12.0); + + B->c[0] = RCONST(0.25); + B->c[1] = RCONST(0.75); + B->c[2] = RCONST(11.0)/RCONST(20.0); + B->c[3] = RCONST(0.5); + B->c[4] = RCONST(1.0); + break; + + case(ARKODE_KVAERNO_5_3_4): /* Kvaerno(5,3,4)-ESDIRK */ + B = ARKodeButcherTable_Alloc(5, SUNTRUE); + B->q = 4; + B->p = 3; + B->A[1][0] = RCONST(0.4358665215); + B->A[1][1] = RCONST(0.4358665215); + B->A[2][0] = RCONST(0.140737774731968); + B->A[2][1] = RCONST(-0.108365551378832); + B->A[2][2] = RCONST(0.4358665215); + B->A[3][0] = RCONST(0.102399400616089); + B->A[3][1] = RCONST(-0.376878452267324); + B->A[3][2] = RCONST(0.838612530151233); + B->A[3][3] = RCONST(0.4358665215); + B->A[4][0] = RCONST(0.157024897860995); + B->A[4][1] = RCONST(0.117330441357768); + B->A[4][2] = RCONST(0.61667803039168); + B->A[4][3] = RCONST(-0.326899891110444); + B->A[4][4] = RCONST(0.4358665215); + + B->b[0] = RCONST(0.157024897860995); + B->b[1] = RCONST(0.117330441357768); + B->b[2] = RCONST(0.61667803039168); + B->b[3] = RCONST(-0.326899891110444); + B->b[4] = RCONST(0.4358665215); + + B->d[0] = RCONST(0.102399400616089); + B->d[1] = RCONST(-0.376878452267324); + B->d[2] = RCONST(0.838612530151233); + B->d[3] = RCONST(0.4358665215); + + B->c[1] = RCONST(0.871733043); + B->c[2] = RCONST(0.468238744853136); + B->c[3] = RCONST(1.0); + B->c[4] = RCONST(1.0); + break; + + case(ARKODE_ARK436L2SA_DIRK_6_3_4): /* ARK4(3)6L[2]SA-ESDIRK */ + B = ARKodeButcherTable_Alloc(6, SUNTRUE); + B->q = 4; + B->p = 3; + B->A[1][0] = RCONST(1.0)/RCONST(4.0); + B->A[1][1] = RCONST(1.0)/RCONST(4.0); + B->A[2][0] = RCONST(8611.0)/RCONST(62500.0); + B->A[2][1] = RCONST(-1743.0)/RCONST(31250.0); + B->A[2][2] = RCONST(1.0)/RCONST(4.0); + B->A[3][0] = RCONST(5012029.0)/RCONST(34652500.0); + B->A[3][1] = RCONST(-654441.0)/RCONST(2922500.0); + B->A[3][2] = RCONST(174375.0)/RCONST(388108.0); + B->A[3][3] = RCONST(1.0)/RCONST(4.0); + B->A[4][0] = RCONST(15267082809.0)/RCONST(155376265600.0); + B->A[4][1] = RCONST(-71443401.0)/RCONST(120774400.0); + B->A[4][2] = RCONST(730878875.0)/RCONST(902184768.0); + B->A[4][3] = RCONST(2285395.0)/RCONST(8070912.0); + B->A[4][4] = RCONST(1.0)/RCONST(4.0); + B->A[5][0] = RCONST(82889.0)/RCONST(524892.0); + B->A[5][2] = RCONST(15625.0)/RCONST(83664.0); + B->A[5][3] = RCONST(69875.0)/RCONST(102672.0); + B->A[5][4] = RCONST(-2260.0)/RCONST(8211.0); + B->A[5][5] = RCONST(1.0)/RCONST(4.0); + + B->b[0] = RCONST(82889.0)/RCONST(524892.0); + B->b[2] = RCONST(15625.0)/RCONST(83664.0); + B->b[3] = RCONST(69875.0)/RCONST(102672.0); + B->b[4] = RCONST(-2260.0)/RCONST(8211.0); + B->b[5] = RCONST(1.0)/RCONST(4.0); + + B->c[1] = RCONST(1.0)/RCONST(2.0); + B->c[2] = RCONST(83.0)/RCONST(250.0); + B->c[3] = RCONST(31.0)/RCONST(50.0); + B->c[4] = RCONST(17.0)/RCONST(20.0); + B->c[5] = RCONST(1.0); + + B->d[0] = RCONST(4586570599.0)/RCONST(29645900160.0); + B->d[2] = RCONST(178811875.0)/RCONST(945068544.0); + B->d[3] = RCONST(814220225.0)/RCONST(1159782912.0); + B->d[4] = RCONST(-3700637.0)/RCONST(11593932.0); + B->d[5] = RCONST(61727.0)/RCONST(225920.0); + break; + + case(ARKODE_ARK437L2SA_DIRK_7_3_4): /* ARK4(3)7L[2]SA-ESDIRK */ + B = ARKodeButcherTable_Alloc(7, SUNTRUE); + B->q = 4; + B->p = 3; + + B->A[1][0] = RCONST(1235.0)/RCONST(10000.0); + B->A[1][1] = RCONST(1235.0)/RCONST(10000.0); + B->A[2][0] = RCONST(624185399699.0)/RCONST(4186980696204.0); + B->A[2][1] = RCONST(624185399699.0)/RCONST(4186980696204.0); + B->A[2][2] = RCONST(1235.0)/RCONST(10000.0); + B->A[3][0] = RCONST(1258591069120.0)/RCONST(10082082980243.0); + B->A[3][1] = RCONST(1258591069120.0)/RCONST(10082082980243.0); + B->A[3][2] = RCONST(-322722984531.0)/RCONST(8455138723562.0); + B->A[3][3] = RCONST(1235.0)/RCONST(10000.0); + B->A[4][0] = RCONST(-436103496990.0)/RCONST(5971407786587.0); + B->A[4][1] = RCONST(-436103496990.0)/RCONST(5971407786587.0); + B->A[4][2] = RCONST(-2689175662187.0)/RCONST(11046760208243.0); + B->A[4][3] = RCONST(4431412449334.0)/RCONST(12995360898505.0); + B->A[4][4] = RCONST(1235.0)/RCONST(10000.0); + B->A[5][0] = RCONST(-2207373168298.0)/RCONST(14430576638973.0); + B->A[5][1] = RCONST(-2207373168298.0)/RCONST(14430576638973.0); + B->A[5][2] = RCONST(242511121179.0)/RCONST(3358618340039.0); + B->A[5][3] = RCONST(3145666661981.0)/RCONST(7780404714551.0); + B->A[5][4] = RCONST(5882073923981.0)/RCONST(14490790706663.0); + B->A[5][5] = RCONST(1235.0)/RCONST(10000.0); + B->A[6][2] = RCONST(9164257142617.0)/RCONST(17756377923965.0); + B->A[6][3] = RCONST(-10812980402763.0)/RCONST(74029279521829.0); + B->A[6][4] = RCONST(1335994250573.0)/RCONST(5691609445217.0); + B->A[6][5] = RCONST(2273837961795.0)/RCONST(8368240463276.0); + B->A[6][6] = RCONST(1235.0)/RCONST(10000.0); + + B->b[2] = RCONST(9164257142617.0)/RCONST(17756377923965.0); + B->b[3] = RCONST(-10812980402763.0)/RCONST(74029279521829.0); + B->b[4] = RCONST(1335994250573.0)/RCONST(5691609445217.0); + B->b[5] = RCONST(2273837961795.0)/RCONST(8368240463276.0); + B->b[6] = RCONST(1235.0)/RCONST(10000.0); + + B->c[1] = RCONST(247.0)/RCONST(1000.0); + B->c[2] = RCONST(4276536705230.0)/RCONST(10142255878289.0); + B->c[3] = RCONST(67.0)/RCONST(200.0); + B->c[4] = RCONST(3.0)/RCONST(40.0); + B->c[5] = RCONST(7.0)/RCONST(10.0); + B->c[6] = RCONST(1.0); + + B->d[2] = RCONST(4469248916618.0)/RCONST(8635866897933.0); + B->d[3] = RCONST(-621260224600.0)/RCONST(4094290005349.0); + B->d[4] = RCONST(696572312987.0)/RCONST(2942599194819.0); + B->d[5] = RCONST(1532940081127.0)/RCONST(5565293938103.0); + B->d[6] = RCONST(2441.0)/RCONST(20000.0); + break; + + case(ARKODE_KVAERNO_7_4_5): /* Kvaerno(7,4,5)-ESDIRK */ + B = ARKodeButcherTable_Alloc(7, SUNTRUE); + B->q = 5; + B->p = 4; + B->A[1][0] = RCONST(0.26); + B->A[1][1] = RCONST(0.26); + B->A[2][0] = RCONST(0.13); + B->A[2][1] = RCONST(0.84033320996790809); + B->A[2][2] = RCONST(0.26); + B->A[3][0] = RCONST(0.22371961478320505); + B->A[3][1] = RCONST(0.47675532319799699); + B->A[3][2] = RCONST(-0.06470895363112615); + B->A[3][3] = RCONST(0.26); + B->A[4][0] = RCONST(0.16648564323248321); + B->A[4][1] = RCONST(0.10450018841591720); + B->A[4][2] = RCONST(0.03631482272098715); + B->A[4][3] = RCONST(-0.13090704451073998); + B->A[4][4] = RCONST(0.26); + B->A[5][0] = RCONST(0.13855640231268224); + B->A[5][2] = RCONST(-0.04245337201752043); + B->A[5][3] = RCONST(0.02446657898003141); + B->A[5][4] = RCONST(0.61943039072480676); + B->A[5][5] = RCONST(0.26); + B->A[6][0] = RCONST(0.13659751177640291); + B->A[6][2] = RCONST(-0.05496908796538376); + B->A[6][3] = RCONST(-0.04118626728321046); + B->A[6][4] = RCONST(0.62993304899016403); + B->A[6][5] = RCONST(0.06962479448202728); + B->A[6][6] = RCONST(0.26); + + B->b[0] = RCONST(0.13659751177640291); + B->b[2] = RCONST(-0.05496908796538376); + B->b[3] = RCONST(-0.04118626728321046); + B->b[4] = RCONST(0.62993304899016403); + B->b[5] = RCONST(0.06962479448202728); + B->b[6] = RCONST(0.26); + + B->d[0] = RCONST(0.13855640231268224); + B->d[2] = RCONST(-0.04245337201752043); + B->d[3] = RCONST(0.02446657898003141); + B->d[4] = RCONST(0.61943039072480676); + B->d[5] = RCONST(0.26); + + B->c[1] = RCONST(0.52); + B->c[2] = RCONST(1.230333209967908); + B->c[3] = RCONST(0.895765984350076); + B->c[4] = RCONST(0.436393609858648); + B->c[5] = RCONST(1.0); + B->c[6] = RCONST(1.0); + break; + + case(ARKODE_ARK548L2SA_DIRK_8_4_5): /* ARK5(4)8L[2]SA-ESDIRK */ + B = ARKodeButcherTable_Alloc(8, SUNTRUE); + B->q = 5; + B->p = 4; + B->A[1][0] = RCONST(41.0)/RCONST(200.0); + B->A[1][1] = RCONST(41.0)/RCONST(200.0); + B->A[2][0] = RCONST(41.0)/RCONST(400.0); + B->A[2][1] = RCONST(-567603406766.0)/RCONST(11931857230679.0); + B->A[2][2] = RCONST(41.0)/RCONST(200.0); + B->A[3][0] = RCONST(683785636431.0)/RCONST(9252920307686.0); + B->A[3][2] = RCONST(-110385047103.0)/RCONST(1367015193373.0); + B->A[3][3] = RCONST(41.0)/RCONST(200.0); + B->A[4][0] = RCONST(3016520224154.0)/RCONST(10081342136671.0); + B->A[4][2] = RCONST(30586259806659.0)/RCONST(12414158314087.0); + B->A[4][3] = RCONST(-22760509404356.0)/RCONST(11113319521817.0); + B->A[4][4] = RCONST(41.0)/RCONST(200.0); + B->A[5][0] = RCONST(218866479029.0)/RCONST(1489978393911.0); + B->A[5][2] = RCONST(638256894668.0)/RCONST(5436446318841.0); + B->A[5][3] = RCONST(-1179710474555.0)/RCONST(5321154724896.0); + B->A[5][4] = RCONST(-60928119172.0)/RCONST(8023461067671.0); + B->A[5][5] = RCONST(41.0)/RCONST(200.0); + B->A[6][0] = RCONST(1020004230633.0)/RCONST(5715676835656.0); + B->A[6][2] = RCONST(25762820946817.0)/RCONST(25263940353407.0); + B->A[6][3] = RCONST(-2161375909145.0)/RCONST(9755907335909.0); + B->A[6][4] = RCONST(-211217309593.0)/RCONST(5846859502534.0); + B->A[6][5] = RCONST(-4269925059573.0)/RCONST(7827059040749.0); + B->A[6][6] = RCONST(41.0)/RCONST(200.0); + B->A[7][0] = RCONST(-872700587467.0)/RCONST(9133579230613.0); + B->A[7][3] = RCONST(22348218063261.0)/RCONST(9555858737531.0); + B->A[7][4] = RCONST(-1143369518992.0)/RCONST(8141816002931.0); + B->A[7][5] = RCONST(-39379526789629.0)/RCONST(19018526304540.0); + B->A[7][6] = RCONST(32727382324388.0)/RCONST(42900044865799.0); + B->A[7][7] = RCONST(41.0)/RCONST(200.0); + + B->b[0] = RCONST(-872700587467.0)/RCONST(9133579230613.0); + B->b[3] = RCONST(22348218063261.0)/RCONST(9555858737531.0); + B->b[4] = RCONST(-1143369518992.0)/RCONST(8141816002931.0); + B->b[5] = RCONST(-39379526789629.0)/RCONST(19018526304540.0); + B->b[6] = RCONST(32727382324388.0)/RCONST(42900044865799.0); + B->b[7] = RCONST(41.0)/RCONST(200.0); + + B->d[0] = RCONST(-975461918565.0)/RCONST(9796059967033.0); + B->d[3] = RCONST(78070527104295.0)/RCONST(32432590147079.0); + B->d[4] = RCONST(-548382580838.0)/RCONST(3424219808633.0); + B->d[5] = RCONST(-33438840321285.0)/RCONST(15594753105479.0); + B->d[6] = RCONST(3629800801594.0)/RCONST(4656183773603.0); + B->d[7] = RCONST(4035322873751.0)/RCONST(18575991585200.0); + + B->c[1] = RCONST(41.0)/RCONST(100.0); + B->c[2] = RCONST(2935347310677.0)/RCONST(11292855782101.0); + B->c[3] = RCONST(1426016391358.0)/RCONST(7196633302097.0); + B->c[4] = RCONST(92.0)/RCONST(100.0); + B->c[5] = RCONST(24.0)/RCONST(100.0); + B->c[6] = RCONST(3.0)/RCONST(5.0); + B->c[7] = RCONST(1.0); + break; + + case(ARKODE_ARK548L2SAb_DIRK_8_4_5): /* ARK5(4)8L[2]SAb-ESDIRK */ + B = ARKodeButcherTable_Alloc(8, SUNTRUE); + B->q = 5; + B->p = 4; + B->A[1][0] = RCONST(2.0)/RCONST(9.0); + B->A[1][1] = RCONST(2.0)/RCONST(9.0); + B->A[2][0] = RCONST(2366667076620.0)/RCONST(8822750406821.0); + B->A[2][1] = RCONST(2366667076620.0)/RCONST(8822750406821.0); + B->A[2][2] = RCONST(2.0)/RCONST(9.0); + B->A[3][0] = RCONST(-257962897183.0)/RCONST(4451812247028.0); + B->A[3][1] = RCONST(-257962897183.0)/RCONST(4451812247028.0); + B->A[3][2] = RCONST(128530224461.0)/RCONST(14379561246022.0); + B->A[3][3] = RCONST(2.0)/RCONST(9.0); + B->A[4][0] = RCONST(-486229321650.0)/RCONST(11227943450093.0); + B->A[4][1] = RCONST(-486229321650.0)/RCONST(11227943450093.0); + B->A[4][2] = RCONST(-225633144460.0)/RCONST(6633558740617.0); + B->A[4][3] = RCONST(1741320951451.0)/RCONST(6824444397158.0); + B->A[4][4] = RCONST(2.0)/RCONST(9.0); + B->A[5][0] = RCONST(621307788657.0)/RCONST(4714163060173.0); + B->A[5][1] = RCONST(621307788657.0)/RCONST(4714163060173.0); + B->A[5][2] = RCONST(-125196015625.0)/RCONST(3866852212004.0); + B->A[5][3] = RCONST(940440206406.0)/RCONST(7593089888465.0); + B->A[5][4] = RCONST(961109811699.0)/RCONST(6734810228204.0); + B->A[5][5] = RCONST(2.0)/RCONST(9.0); + B->A[6][0] = RCONST(2036305566805.0)/RCONST(6583108094622.0); + B->A[6][1] = RCONST(2036305566805.0)/RCONST(6583108094622.0); + B->A[6][2] = RCONST(-3039402635899.0)/RCONST(4450598839912.0); + B->A[6][3] = RCONST(-1829510709469.0)/RCONST(31102090912115.0); + B->A[6][4] = RCONST(-286320471013.0)/RCONST(6931253422520.0); + B->A[6][5] = RCONST(8651533662697.0)/RCONST(9642993110008.0); + B->A[6][6] = RCONST(2.0)/RCONST(9.0); + B->A[7][2] = RCONST(3517720773327.0)/RCONST(20256071687669.0); + B->A[7][3] = RCONST(4569610470461.0)/RCONST(17934693873752.0); + B->A[7][4] = RCONST(2819471173109.0)/RCONST(11655438449929.0); + B->A[7][5] = RCONST(3296210113763.0)/RCONST(10722700128969.0); + B->A[7][6] = RCONST(-1142099968913.0)/RCONST(5710983926999.0); + B->A[7][7] = RCONST(2.0)/RCONST(9.0); + + B->b[2] = RCONST(3517720773327.0)/RCONST(20256071687669.0); + B->b[3] = RCONST(4569610470461.0)/RCONST(17934693873752.0); + B->b[4] = RCONST(2819471173109.0)/RCONST(11655438449929.0); + B->b[5] = RCONST(3296210113763.0)/RCONST(10722700128969.0); + B->b[6] = RCONST(-1142099968913.0)/RCONST(5710983926999.0); + B->b[7] = RCONST(2.0)/RCONST(9.0); + + B->d[2] = RCONST(520639020421.0)/RCONST(8300446712847.0); + B->d[3] = RCONST(4550235134915.0)/RCONST(17827758688493.0); + B->d[4] = RCONST(1482366381361.0)/RCONST(6201654941325.0); + B->d[5] = RCONST(5551607622171.0)/RCONST(13911031047899.0); + B->d[6] = RCONST(-5266607656330.0)/RCONST(36788968843917.0); + B->d[7] = RCONST(1074053359553.0)/RCONST(5740751784926.0); + + B->c[1] = RCONST(4.0)/RCONST(9.0); + B->c[2] = RCONST(6456083330201.0)/RCONST(8509243623797.0); + B->c[3] = RCONST(1632083962415.0)/RCONST(14158861528103.0); + B->c[4] = RCONST(6365430648612.0)/RCONST(17842476412687.0); + B->c[5] = RCONST(18.0)/RCONST(25.0); + B->c[6] = RCONST(191.0)/RCONST(200.0); + B->c[7] = RCONST(1.0); + break; + + default: + + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode", + "ARKodeButcherTable_LoadDIRK", + "Unknown Butcher table"); + return(NULL); + + } + + return(B); +} + + +/*--------------------------------------------------------------- + EOF + ---------------------------------------------------------------*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_butcher_erk.c b/lib/sundials_6.1.1/src/arkode/arkode_butcher_erk.c new file mode 100644 index 00000000000..8f6dd28d0a6 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_butcher_erk.c @@ -0,0 +1,705 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 built-in ERK Butcher + * tables. + *--------------------------------------------------------------*/ + +#include +#include + +#include "arkode_impl.h" +#include +#include + + +/*--------------------------------------------------------------- + Returns Butcher table structure for pre-set Runge Kutta methods. + + Input: imeth -- integer key for the desired method (see below) + + Allowed 'method' names and properties are listed in the table + below. Methods with an embedding have names are of the form + _s_p_q where s is the number of stages, p us the embedding + order, and q is the method order. Similarly, fixed step methods + have names of the form _s_q. + + Methods in an ARK pair are marked with a *. + + Methods that satisfy the additional third order multirate + infinitesimal step condition and are suppored by the MRIStep + module (c_i > c_{i-1} and c_s != 1) are marked with a ^. + + The 'QP' column denotes whether the coefficients of the method + are known precisely enough for use in quad precision (128-bit) + calculations. + + imeth QP + -------------------------------- + ARKODE_HEUN_EULER_2_1_2 Y + ARKODE_BOGACKI_SHAMPINE_4_2_3 Y + ARKODE_ARK324L2SA_ERK_4_2_3* N + ARKODE_ZONNEVELD_5_3_4 Y + ARKODE_ARK436L2SA_ERK_6_3_4* N + ARKODE_ARK437L2SA_ERK_7_3_4* N + ARKODE_SAYFY_ABURUB_6_3_4 N + ARKODE_CASH_KARP_6_4_5 Y + ARKODE_FEHLBERG_6_4_5 Y + ARKODE_DORMAND_PRINCE_7_4_5 Y + ARKODE_ARK548L2SA_ERK_8_4_5* N + ARKODE_ARK548L2SAb_ERK_8_4_5* N + ARKODE_VERNER_8_5_6 Y + ARKODE_FEHLBERG_13_7_8 Y + -------------------------------- + ARKODE_KNOTH_WOLKE_3_3^ Y + -------------------------------- + + ---------------------------------------------------------------*/ +ARKodeButcherTable ARKodeButcherTable_LoadERK(ARKODE_ERKTableID imethod) +{ + + ARKodeButcherTable B; + B = NULL; + + /* fill in coefficients based on method name */ + switch(imethod) { + + /* ========================================================== + * METHODS WITH EMBEDDINGS + * ========================================================*/ + + case(ARKODE_HEUN_EULER_2_1_2): /* Heun-Euler-ERK */ + B = ARKodeButcherTable_Alloc(2, SUNTRUE); + B->q = 2; + B->p = 1; + + B->A[1][0] = RCONST(1.0); + + B->b[0] = RCONST(1.0)/RCONST(2.0); + B->b[1] = RCONST(1.0)/RCONST(2.0); + + B->d[0] = RCONST(1.0); + + B->c[1] = RCONST(1.0); + break; + + case(ARKODE_BOGACKI_SHAMPINE_4_2_3): /* Bogacki-Shampine-ERK */ + B = ARKodeButcherTable_Alloc(4, SUNTRUE); + B->q = 3; + B->p = 2; + B->A[1][0] = RCONST(1.0)/RCONST(2.0); + B->A[2][1] = RCONST(3.0)/RCONST(4.0); + B->A[3][0] = RCONST(2.0)/RCONST(9.0); + B->A[3][1] = RCONST(1.0)/RCONST(3.0); + B->A[3][2] = RCONST(4.0)/RCONST(9.0); + + B->b[0] = RCONST(2.0)/RCONST(9.0); + B->b[1] = RCONST(1.0)/RCONST(3.0); + B->b[2] = RCONST(4.0)/RCONST(9.0); + + B->d[0] = RCONST(7.0)/RCONST(24.0); + B->d[1] = RCONST(1.0)/RCONST(4.0); + B->d[2] = RCONST(1.0)/RCONST(3.0); + B->d[3] = RCONST(1.0)/RCONST(8.0); + + B->c[1] = RCONST(1.0)/RCONST(2.0); + B->c[2] = RCONST(3.0)/RCONST(4.0); + B->c[3] = RCONST(1.0); + break; + + case(ARKODE_ARK324L2SA_ERK_4_2_3): /* ARK3(2)4L[2]SA-ERK */ + B = ARKodeButcherTable_Alloc(4, SUNTRUE); + B->q = 3; + B->p = 2; + B->A[1][0] = RCONST(1767732205903.0)/RCONST(2027836641118.0); + B->A[2][0] = RCONST(5535828885825.0)/RCONST(10492691773637.0); + B->A[2][1] = RCONST(788022342437.0)/RCONST(10882634858940.0); + B->A[3][0] = RCONST(6485989280629.0)/RCONST(16251701735622.0); + B->A[3][1] = RCONST(-4246266847089.0)/RCONST(9704473918619.0); + B->A[3][2] = RCONST(10755448449292.0)/RCONST(10357097424841.0); + + B->b[0] = RCONST(1471266399579.0)/RCONST(7840856788654.0); + B->b[1] = RCONST(-4482444167858.0)/RCONST(7529755066697.0); + B->b[2] = RCONST(11266239266428.0)/RCONST(11593286722821.0); + B->b[3] = RCONST(1767732205903.0)/RCONST(4055673282236.0); + + B->d[0] = RCONST(2756255671327.0)/RCONST(12835298489170.0); + B->d[1] = RCONST(-10771552573575.0)/RCONST(22201958757719.0); + B->d[2] = RCONST(9247589265047.0)/RCONST(10645013368117.0); + B->d[3] = RCONST(2193209047091.0)/RCONST(5459859503100.0); + + B->c[1] = RCONST(1767732205903.0)/RCONST(2027836641118.0); + B->c[2] = RCONST(3.0)/RCONST(5.0); + B->c[3] = RCONST(1.0); + break; + + case(ARKODE_ZONNEVELD_5_3_4): /* Zonneveld */ + B = ARKodeButcherTable_Alloc(5, SUNTRUE); + B->q = 4; + B->p = 3; + B->A[1][0] = RCONST(0.5); + B->A[2][1] = RCONST(0.5); + B->A[3][2] = RCONST(1.0); + B->A[4][0] = RCONST(5.0)/RCONST(32.0); + B->A[4][1] = RCONST(7.0)/RCONST(32.0); + B->A[4][2] = RCONST(13.0)/RCONST(32.0); + B->A[4][3] = RCONST(-1.0)/RCONST(32.0); + + B->b[0] = RCONST(1.0)/RCONST(6.0); + B->b[1] = RCONST(1.0)/RCONST(3.0); + B->b[2] = RCONST(1.0)/RCONST(3.0); + B->b[3] = RCONST(1.0)/RCONST(6.0); + + B->d[0] = RCONST(-1.0)/RCONST(2.0); + B->d[1] = RCONST(7.0)/RCONST(3.0); + B->d[2] = RCONST(7.0)/RCONST(3.0); + B->d[3] = RCONST(13.0)/RCONST(6.0); + B->d[4] = RCONST(-16.0)/RCONST(3.0); + + B->c[1] = RCONST(0.5); + B->c[2] = RCONST(0.5); + B->c[3] = RCONST(1.0); + B->c[4] = RCONST(0.75); + break; + + case(ARKODE_ARK436L2SA_ERK_6_3_4): /* ARK4(3)6L[2]SA-ERK */ + B = ARKodeButcherTable_Alloc(6, SUNTRUE); + B->q = 4; + B->p = 3; + B->A[1][0] = RCONST(0.5); + B->A[2][0] = RCONST(13861.0)/RCONST(62500.0); + B->A[2][1] = RCONST(6889.0)/RCONST(62500.0); + B->A[3][0] = RCONST(-116923316275.0)/RCONST(2393684061468.0); + B->A[3][1] = RCONST(-2731218467317.0)/RCONST(15368042101831.0); + B->A[3][2] = RCONST(9408046702089.0)/RCONST(11113171139209.0); + B->A[4][0] = RCONST(-451086348788.0)/RCONST(2902428689909.0); + B->A[4][1] = RCONST(-2682348792572.0)/RCONST(7519795681897.0); + B->A[4][2] = RCONST(12662868775082.0)/RCONST(11960479115383.0); + B->A[4][3] = RCONST(3355817975965.0)/RCONST(11060851509271.0); + B->A[5][0] = RCONST(647845179188.0)/RCONST(3216320057751.0); + B->A[5][1] = RCONST(73281519250.0)/RCONST(8382639484533.0); + B->A[5][2] = RCONST(552539513391.0)/RCONST(3454668386233.0); + B->A[5][3] = RCONST(3354512671639.0)/RCONST(8306763924573.0); + B->A[5][4] = RCONST(4040.0)/RCONST(17871.0); + + B->b[0] = RCONST(82889.0)/RCONST(524892.0); + B->b[2] = RCONST(15625.0)/RCONST(83664.0); + B->b[3] = RCONST(69875.0)/RCONST(102672.0); + B->b[4] = RCONST(-2260.0)/RCONST(8211.0); + B->b[5] = RCONST(1.0)/RCONST(4.0); + + B->d[0] = RCONST(4586570599.0)/RCONST(29645900160.0); + B->d[2] = RCONST(178811875.0)/RCONST(945068544.0); + B->d[3] = RCONST(814220225.0)/RCONST(1159782912.0); + B->d[4] = RCONST(-3700637.0)/RCONST(11593932.0); + B->d[5] = RCONST(61727.0)/RCONST(225920.0); + + B->c[1] = RCONST(1.0)/RCONST(2.0); + B->c[2] = RCONST(83.0)/RCONST(250.0); + B->c[3] = RCONST(31.0)/RCONST(50.0); + B->c[4] = RCONST(17.0)/RCONST(20.0); + B->c[5] = RCONST(1.0); + break; + + case(ARKODE_ARK437L2SA_ERK_7_3_4): /* ARK4(3)7L[2]SA-ERK */ + B = ARKodeButcherTable_Alloc(7, SUNTRUE); + B->q = 4; + B->p = 3; + B->A[1][0] = RCONST(247.0)/RCONST(1000.0); + B->A[2][0] = RCONST(247.0)/RCONST(4000.0); + B->A[2][1] = RCONST(2694949928731.0)/RCONST(7487940209513.0); + B->A[3][0] = RCONST(464650059369.0)/RCONST(8764239774964.0); + B->A[3][1] = RCONST(878889893998.0)/RCONST(2444806327765.0); + B->A[3][2] = RCONST(-952945855348.0)/RCONST(12294611323341.0); + B->A[4][0] = RCONST(476636172619.0)/RCONST(8159180917465.0); + B->A[4][1] = RCONST(-1271469283451.0)/RCONST(7793814740893.0); + B->A[4][2] = RCONST(-859560642026.0)/RCONST(4356155882851.0); + B->A[4][3] = RCONST(1723805262919.0)/RCONST(4571918432560.0); + B->A[5][0] = RCONST(6338158500785.0)/RCONST(11769362343261.0); + B->A[5][1] = RCONST(-4970555480458.0)/RCONST(10924838743837.0); + B->A[5][2] = RCONST(3326578051521.0)/RCONST(2647936831840.0); + B->A[5][3] = RCONST(-880713585975.0)/RCONST(1841400956686.0); + B->A[5][4] = RCONST(-1428733748635.0)/RCONST(8843423958496.0); + B->A[6][0] = RCONST(760814592956.0)/RCONST(3276306540349.0); + B->A[6][1] = RCONST(760814592956.0)/RCONST(3276306540349.0); + B->A[6][2] = RCONST(-47223648122716.0)/RCONST(6934462133451.0); + B->A[6][3] = RCONST(71187472546993.0)/RCONST(9669769126921.0); + B->A[6][4] = RCONST(-13330509492149.0)/RCONST(9695768672337.0); + B->A[6][5] = RCONST(11565764226357.0)/RCONST(8513123442827.0); + + B->b[2] = RCONST(9164257142617.0)/RCONST(17756377923965.0); + B->b[3] = RCONST(-10812980402763.0)/RCONST(74029279521829.0); + B->b[4] = RCONST(1335994250573.0)/RCONST(5691609445217.0); + B->b[5] = RCONST(2273837961795.0)/RCONST(8368240463276.0); + B->b[6] = RCONST(247.0)/RCONST(2000.0); + + B->d[2] = RCONST(4469248916618.0)/RCONST(8635866897933.0); + B->d[3] = RCONST(-621260224600.0)/RCONST(4094290005349.0); + B->d[4] = RCONST(696572312987.0)/RCONST(2942599194819.0); + B->d[5] = RCONST(1532940081127.0)/RCONST(5565293938103.0); + B->d[6] = RCONST(2441.0)/RCONST(20000.0); + + B->c[1] = RCONST(247.0)/RCONST(1000.0); + B->c[2] = RCONST(4276536705230.0)/RCONST(10142255878289.0); + B->c[3] = RCONST(67.0)/RCONST(200.0); + B->c[4] = RCONST(3.0)/RCONST(40.0); + B->c[5] = RCONST(7.0)/RCONST(10.0); + B->c[6] = RCONST(1.0); + break; + + case(ARKODE_SAYFY_ABURUB_6_3_4): /* Sayfy-Aburub-4-3-ERK */ + B = ARKodeButcherTable_Alloc(6, SUNTRUE); + B->q = 4; + B->p = 3; + B->A[1][0] = RCONST(1.0)/RCONST(2.0); + B->A[2][0] = RCONST(-1.0); + B->A[2][1] = RCONST(2.0); + B->A[3][0] = RCONST(1.0)/RCONST(6.0); + B->A[3][1] = RCONST(2.0)/RCONST(3.0); + B->A[3][2] = RCONST(1.0)/RCONST(6.0); + B->A[4][0] = RCONST(0.137); + B->A[4][1] = RCONST(0.226); + B->A[4][2] = RCONST(0.137); + B->A[5][0] = RCONST(0.452); + B->A[5][1] = RCONST(-0.904); + B->A[5][2] = RCONST(-0.548); + B->A[5][4] = RCONST(2.0); + + B->b[0] = RCONST(1.0)/RCONST(6.0); + B->b[1] = RCONST(1.0)/RCONST(3.0); + B->b[2] = RCONST(1.0)/RCONST(12.0); + B->b[3] = RCONST(0.0); + B->b[4] = RCONST(1.0)/RCONST(3.0); + B->b[5] = RCONST(1.0)/RCONST(12.0); + + B->d[0] = RCONST(1.0)/RCONST(6.0); + B->d[1] = RCONST(2.0)/RCONST(3.0); + B->d[2] = RCONST(1.0)/RCONST(6.0); + + B->c[1] = RCONST(1.0)/RCONST(2.0); + B->c[2] = RCONST(1.0); + B->c[3] = RCONST(1.0); + B->c[4] = RCONST(1.0)/RCONST(2.0); + B->c[5] = RCONST(1.0); + break; + + case(ARKODE_CASH_KARP_6_4_5): /* Cash-Karp-ERK */ + B = ARKodeButcherTable_Alloc(6, SUNTRUE); + B->q = 5; + B->p = 4; + B->A[1][0] = RCONST(1.0)/RCONST(5.0); + B->A[2][0] = RCONST(3.0)/RCONST(40.0); + B->A[2][1] = RCONST(9.0)/RCONST(40.0); + B->A[3][0] = RCONST(3.0)/RCONST(10.0); + B->A[3][1] = RCONST(-9.0)/RCONST(10.0); + B->A[3][2] = RCONST(6.0)/RCONST(5.0); + B->A[4][0] = RCONST(-11.0)/RCONST(54.0); + B->A[4][1] = RCONST(5.0)/RCONST(2.0); + B->A[4][2] = RCONST(-70.0)/RCONST(27.0); + B->A[4][3] = RCONST(35.0)/RCONST(27.0); + B->A[5][0] = RCONST(1631.0)/RCONST(55296.0); + B->A[5][1] = RCONST(175.0)/RCONST(512.0); + B->A[5][2] = RCONST(575.0)/RCONST(13824.0); + B->A[5][3] = RCONST(44275.0)/RCONST(110592.0); + B->A[5][4] = RCONST(253.0)/RCONST(4096.0); + + B->b[0] = RCONST(37.0)/RCONST(378.0); + B->b[2] = RCONST(250.0)/RCONST(621.0); + B->b[3] = RCONST(125.0)/RCONST(594.0); + B->b[5] = RCONST(512.0)/RCONST(1771.0); + + B->d[0] = RCONST(2825.0)/RCONST(27648.0); + B->d[2] = RCONST(18575.0)/RCONST(48384.0); + B->d[3] = RCONST(13525.0)/RCONST(55296.0); + B->d[4] = RCONST(277.0)/RCONST(14336.0); + B->d[5] = RCONST(1.0)/RCONST(4.0); + + B->c[1] = RCONST(1.0)/RCONST(5.0); + B->c[2] = RCONST(3.0)/RCONST(10.0); + B->c[3] = RCONST(3.0)/RCONST(5.0); + B->c[4] = RCONST(1.0); + B->c[5] = RCONST(7.0)/RCONST(8.0); + break; + + case(ARKODE_FEHLBERG_6_4_5): /* Fehlberg-ERK */ + B = ARKodeButcherTable_Alloc(6, SUNTRUE); + B->q = 5; + B->p = 4; + B->A[1][0] = RCONST(1.0)/RCONST(4.0); + B->A[2][0] = RCONST(3.0)/RCONST(32.0); + B->A[2][1] = RCONST(9.0)/RCONST(32.0); + B->A[3][0] = RCONST(1932.0)/RCONST(2197.0); + B->A[3][1] = RCONST(-7200.0)/RCONST(2197.0); + B->A[3][2] = RCONST(7296.0)/RCONST(2197.0); + B->A[4][0] = RCONST(439.0)/RCONST(216.0); + B->A[4][1] = RCONST(-8.0); + B->A[4][2] = RCONST(3680.0)/RCONST(513.0); + B->A[4][3] = RCONST(-845.0)/RCONST(4104.0); + B->A[5][0] = RCONST(-8.0)/RCONST(27.0); + B->A[5][1] = RCONST(2.0); + B->A[5][2] = RCONST(-3544.0)/RCONST(2565.0); + B->A[5][3] = RCONST(1859.0)/RCONST(4104.0); + B->A[5][4] = RCONST(-11.0)/RCONST(40.0); + + B->b[0] = RCONST(16.0)/RCONST(135.0); + B->b[2] = RCONST(6656.0)/RCONST(12825.0); + B->b[3] = RCONST(28561.0)/RCONST(56430.0); + B->b[4] = RCONST(-9.0)/RCONST(50.0); + B->b[5] = RCONST(2.0)/RCONST(55.0); + + B->d[0] = RCONST(25.0)/RCONST(216.0); + B->d[2] = RCONST(1408.0)/RCONST(2565.0); + B->d[3] = RCONST(2197.0)/RCONST(4104.0); + B->d[4] = RCONST(-1.0)/RCONST(5.0); + + B->c[1] = RCONST(1.0)/RCONST(4.0); + B->c[2] = RCONST(3.0)/RCONST(8.0); + B->c[3] = RCONST(12.0)/RCONST(13.0); + B->c[4] = RCONST(1.0); + B->c[5] = RCONST(1.0)/RCONST(2.0); + break; + + case(ARKODE_DORMAND_PRINCE_7_4_5): /* Dormand-Prince-ERK */ + B = ARKodeButcherTable_Alloc(7, SUNTRUE); + B->q = 5; + B->p = 4; + B->A[1][0] = RCONST(1.0)/RCONST(5.0); + B->A[2][0] = RCONST(3.0)/RCONST(40.0); + B->A[2][1] = RCONST(9.0)/RCONST(40.0); + B->A[3][0] = RCONST(44.0)/RCONST(45.0); + B->A[3][1] = RCONST(-56.0)/RCONST(15.0); + B->A[3][2] = RCONST(32.0)/RCONST(9.0); + B->A[4][0] = RCONST(19372.0)/RCONST(6561.0); + B->A[4][1] = RCONST(-25360.0)/RCONST(2187.0); + B->A[4][2] = RCONST(64448.0)/RCONST(6561.0); + B->A[4][3] = RCONST(-212.0)/RCONST(729.0); + B->A[5][0] = RCONST(9017.0)/RCONST(3168.0); + B->A[5][1] = RCONST(-355.0)/RCONST(33.0); + B->A[5][2] = RCONST(46732.0)/RCONST(5247.0); + B->A[5][3] = RCONST(49.0)/RCONST(176.0); + B->A[5][4] = RCONST(-5103.0)/RCONST(18656.0); + B->A[6][0] = RCONST(35.0)/RCONST(384.0); + B->A[6][2] = RCONST(500.0)/RCONST(1113.0); + B->A[6][3] = RCONST(125.0)/RCONST(192.0); + B->A[6][4] = RCONST(-2187.0)/RCONST(6784.0); + B->A[6][5] = RCONST(11.0)/RCONST(84.0); + + B->b[0] = RCONST(35.0)/RCONST(384.0); + B->b[2] = RCONST(500.0)/RCONST(1113.0); + B->b[3] = RCONST(125.0)/RCONST(192.0); + B->b[4] = RCONST(-2187.0)/RCONST(6784.0); + B->b[5] = RCONST(11.0)/RCONST(84.0); + + B->d[0] = RCONST(5179.0)/RCONST(57600.0); + B->d[2] = RCONST(7571.0)/RCONST(16695.0); + B->d[3] = RCONST(393.0)/RCONST(640.0); + B->d[4] = RCONST(-92097.0)/RCONST(339200.0); + B->d[5] = RCONST(187.0)/RCONST(2100.0); + B->d[6] = RCONST(1.0)/RCONST(40.0); + + B->c[1] = RCONST(1.0)/RCONST(5.0); + B->c[2] = RCONST(3.0)/RCONST(10.0); + B->c[3] = RCONST(4.0)/RCONST(5.0); + B->c[4] = RCONST(8.0)/RCONST(9.0); + B->c[5] = RCONST(1.0); + B->c[6] = RCONST(1.0); + break; + + case(ARKODE_ARK548L2SA_ERK_8_4_5): /* ARK5(4)8L[2]SA-ERK */ + B = ARKodeButcherTable_Alloc(8, SUNTRUE); + B->q = 5; + B->p = 4; + B->A[1][0] = RCONST(41.0)/RCONST(100.0); + B->A[2][0] = RCONST(367902744464.0)/RCONST(2072280473677.0); + B->A[2][1] = RCONST(677623207551.0)/RCONST(8224143866563.0); + B->A[3][0] = RCONST(1268023523408.0)/RCONST(10340822734521.0); + B->A[3][2] = RCONST(1029933939417.0)/RCONST(13636558850479.0); + B->A[4][0] = RCONST(14463281900351.0)/RCONST(6315353703477.0); + B->A[4][2] = RCONST(66114435211212.0)/RCONST(5879490589093.0); + B->A[4][3] = RCONST(-54053170152839.0)/RCONST(4284798021562.0); + B->A[5][0] = RCONST(14090043504691.0)/RCONST(34967701212078.0); + B->A[5][2] = RCONST(15191511035443.0)/RCONST(11219624916014.0); + B->A[5][3] = RCONST(-18461159152457.0)/RCONST(12425892160975.0); + B->A[5][4] = RCONST(-281667163811.0)/RCONST(9011619295870.0); + B->A[6][0] = RCONST(19230459214898.0)/RCONST(13134317526959.0); + B->A[6][2] = RCONST(21275331358303.0)/RCONST(2942455364971.0); + B->A[6][3] = RCONST(-38145345988419.0)/RCONST(4862620318723.0); + B->A[6][4] = RCONST(-1.0)/RCONST(8.0); + B->A[6][5] = RCONST(-1.0)/RCONST(8.0); + B->A[7][0] = RCONST(-19977161125411.0)/RCONST(11928030595625.0); + B->A[7][2] = RCONST(-40795976796054.0)/RCONST(6384907823539.0); + B->A[7][3] = RCONST(177454434618887.0)/RCONST(12078138498510.0); + B->A[7][4] = RCONST(782672205425.0)/RCONST(8267701900261.0); + B->A[7][5] = RCONST(-69563011059811.0)/RCONST(9646580694205.0); + B->A[7][6] = RCONST(7356628210526.0)/RCONST(4942186776405.0); + + B->b[0] = RCONST(-872700587467.0)/RCONST(9133579230613.0); + B->b[3] = RCONST(22348218063261.0)/RCONST(9555858737531.0); + B->b[4] = RCONST(-1143369518992.0)/RCONST(8141816002931.0); + B->b[5] = RCONST(-39379526789629.0)/RCONST(19018526304540.0); + B->b[6] = RCONST(32727382324388.0)/RCONST(42900044865799.0); + B->b[7] = RCONST(41.0)/RCONST(200.0); + + B->d[0] = RCONST(-975461918565.0)/RCONST(9796059967033.0); + B->d[3] = RCONST(78070527104295.0)/RCONST(32432590147079.0); + B->d[4] = RCONST(-548382580838.0)/RCONST(3424219808633.0); + B->d[5] = RCONST(-33438840321285.0)/RCONST(15594753105479.0); + B->d[6] = RCONST(3629800801594.0)/RCONST(4656183773603.0); + B->d[7] = RCONST(4035322873751.0)/RCONST(18575991585200.0); + + B->c[1] = RCONST(41.0)/RCONST(100.0); + B->c[2] = RCONST(2935347310677.0)/RCONST(11292855782101.0); + B->c[3] = RCONST(1426016391358.0)/RCONST(7196633302097.0); + B->c[4] = RCONST(92.0)/RCONST(100.0); + B->c[5] = RCONST(24.0)/RCONST(100.0); + B->c[6] = RCONST(3.0)/RCONST(5.0); + B->c[7] = RCONST(1.0); + break; + + case(ARKODE_ARK548L2SAb_ERK_8_4_5): /* ARK5(4)8L[2]SAb-ERK */ + B = ARKodeButcherTable_Alloc(8, SUNTRUE); + B->q = 5; + B->p = 4; + B->A[1][0] = RCONST(4.0)/RCONST(9.0); + B->A[2][0] = RCONST(1.0)/RCONST(9.0); + B->A[2][1] = RCONST(1183333538310.0)/RCONST(1827251437969.0); + B->A[3][0] = RCONST(895379019517.0)/RCONST(9750411845327.0); + B->A[3][1] = RCONST(477606656805.0)/RCONST(13473228687314.0); + B->A[3][2] = RCONST(-112564739183.0)/RCONST(9373365219272.0); + B->A[4][0] = RCONST(-4458043123994.0)/RCONST(13015289567637.0); + B->A[4][1] = RCONST(-2500665203865.0)/RCONST(9342069639922.0); + B->A[4][2] = RCONST(983347055801.0)/RCONST(8893519644487.0); + B->A[4][3] = RCONST(2185051477207.0)/RCONST(2551468980502.0); + B->A[5][0] = RCONST(-167316361917.0)/RCONST(17121522574472.0); + B->A[5][1] = RCONST(1605541814917.0)/RCONST(7619724128744.0); + B->A[5][2] = RCONST(991021770328.0)/RCONST(13052792161721.0); + B->A[5][3] = RCONST(2342280609577.0)/RCONST(11279663441611.0); + B->A[5][4] = RCONST(3012424348531.0)/RCONST(12792462456678.0); + B->A[6][0] = RCONST(6680998715867.0)/RCONST(14310383562358.0); + B->A[6][1] = RCONST(5029118570809.0)/RCONST(3897454228471.0); + B->A[6][2] = RCONST(2415062538259.0)/RCONST(6382199904604.0); + B->A[6][3] = RCONST(-3924368632305.0)/RCONST(6964820224454.0); + B->A[6][4] = RCONST(-4331110370267.0)/RCONST(15021686902756.0); + B->A[6][5] = RCONST(-3944303808049.0)/RCONST(11994238218192.0); + B->A[7][0] = RCONST(2193717860234.0)/RCONST(3570523412979.0); + B->A[7][1] = RCONST(2193717860234.0)/RCONST(3570523412979.0); + B->A[7][2] = RCONST(5952760925747.0)/RCONST(18750164281544.0); + B->A[7][3] = RCONST(-4412967128996.0)/RCONST(6196664114337.0); + B->A[7][4] = RCONST(4151782504231.0)/RCONST(36106512998704.0); + B->A[7][5] = RCONST(572599549169.0)/RCONST(6265429158920.0); + B->A[7][6] = RCONST(-457874356192.0)/RCONST(11306498036315.0); + + B->b[2] = RCONST(3517720773327.0)/RCONST(20256071687669.0); + B->b[3] = RCONST(4569610470461.0)/RCONST(17934693873752.0); + B->b[4] = RCONST(2819471173109.0)/RCONST(11655438449929.0); + B->b[5] = RCONST(3296210113763.0)/RCONST(10722700128969.0); + B->b[6] = RCONST(-1142099968913.0)/RCONST(5710983926999.0); + B->b[7] = RCONST(2.0)/RCONST(9.0); + + B->d[2] = RCONST(520639020421.0)/RCONST(8300446712847.0); + B->d[3] = RCONST(4550235134915.0)/RCONST(17827758688493.0); + B->d[4] = RCONST(1482366381361.0)/RCONST(6201654941325.0); + B->d[5] = RCONST(5551607622171.0)/RCONST(13911031047899.0); + B->d[6] = RCONST(-5266607656330.0)/RCONST(36788968843917.0); + B->d[7] = RCONST(1074053359553.0)/RCONST(5740751784926.0); + + B->c[1] = RCONST(4.0)/RCONST(9.0); + B->c[2] = RCONST(6456083330201.0)/RCONST(8509243623797.0); + B->c[3] = RCONST(1632083962415.0)/RCONST(14158861528103.0); + B->c[4] = RCONST(6365430648612.0)/RCONST(17842476412687.0); + B->c[5] = RCONST(18.0)/RCONST(25.0); + B->c[6] = RCONST(191.0)/RCONST(200.0); + B->c[7] = RCONST(1.0); + break; + + case(ARKODE_VERNER_8_5_6): /* Verner-6-5 */ + B = ARKodeButcherTable_Alloc(8, SUNTRUE); + B->q = 6; + B->p = 5; + B->A[1][0] = RCONST(1.0)/RCONST(6.0); + B->A[2][0] = RCONST(4.0)/RCONST(75.0); + B->A[2][1] = RCONST(16.0)/RCONST(75.0); + B->A[3][0] = RCONST(5.0)/RCONST(6.0); + B->A[3][1] = RCONST(-8.0)/RCONST(3.0); + B->A[3][2] = RCONST(5.0)/RCONST(2.0); + B->A[4][0] = RCONST(-165.0)/RCONST(64.0); + B->A[4][1] = RCONST(55.0)/RCONST(6.0); + B->A[4][2] = RCONST(-425.0)/RCONST(64.0); + B->A[4][3] = RCONST(85.0)/RCONST(96.0); + B->A[5][0] = RCONST(12.0)/RCONST(5.0); + B->A[5][1] = RCONST(-8.0); + B->A[5][2] = RCONST(4015.0)/RCONST(612.0); + B->A[5][3] = RCONST(-11.0)/RCONST(36.0); + B->A[5][4] = RCONST(88.0)/RCONST(255.0); + B->A[6][0] = RCONST(-8263.0)/RCONST(15000.0); + B->A[6][1] = RCONST(124.0)/RCONST(75.0); + B->A[6][2] = RCONST(-643.0)/RCONST(680.0); + B->A[6][3] = RCONST(-81.0)/RCONST(250.0); + B->A[6][4] = RCONST(2484.0)/RCONST(10625.0); + B->A[7][0] = RCONST(3501.0)/RCONST(1720.0); + B->A[7][1] = RCONST(-300.0)/RCONST(43.0); + B->A[7][2] = RCONST(297275.0)/RCONST(52632.0); + B->A[7][3] = RCONST(-319.0)/RCONST(2322.0); + B->A[7][4] = RCONST(24068.0)/RCONST(84065.0); + B->A[7][6] = RCONST(3850.0)/RCONST(26703.0); + + B->b[0] = RCONST(3.0)/RCONST(40.0); + B->b[2] = RCONST(875.0)/RCONST(2244.0); + B->b[3] = RCONST(23.0)/RCONST(72.0); + B->b[4] = RCONST(264.0)/RCONST(1955.0); + B->b[6] = RCONST(125.0)/RCONST(11592.0); + B->b[7] = RCONST(43.0)/RCONST(616.0); + + B->d[0] = RCONST(13.0)/RCONST(160.0); + B->d[2] = RCONST(2375.0)/RCONST(5984.0); + B->d[3] = RCONST(5.0)/RCONST(16.0); + B->d[4] = RCONST(12.0)/RCONST(85.0); + B->d[5] = RCONST(3.0)/RCONST(44.0); + + B->c[0] = RCONST(0.0); + B->c[1] = RCONST(1.0)/RCONST(6.0); + B->c[2] = RCONST(4.0)/RCONST(15.0); + B->c[3] = RCONST(2.0)/RCONST(3.0); + B->c[4] = RCONST(5.0)/RCONST(6.0); + B->c[5] = RCONST(1.0); + B->c[6] = RCONST(1.0)/RCONST(15.0); + B->c[7] = RCONST(1.0); + break; + + case(ARKODE_FEHLBERG_13_7_8): /* Fehlberg-8-7 */ + B = ARKodeButcherTable_Alloc(13, SUNTRUE); + B->q = 8; + B->p = 7; + B->A[1][0] = RCONST(2.0)/RCONST(27.0); + B->A[2][0] = RCONST(1.0)/RCONST(36.0); + B->A[2][1] = RCONST(1.0)/RCONST(12.0); + B->A[3][0] = RCONST(1.0)/RCONST(24.0); + B->A[3][2] = RCONST(1.0)/RCONST(8.0); + B->A[4][0] = RCONST(5.0)/RCONST(12.0); + B->A[4][2] = RCONST(-25.0)/RCONST(16.0); + B->A[4][3] = RCONST(25.0)/RCONST(16.0); + B->A[5][0] = RCONST(1.0)/RCONST(20.0); + B->A[5][3] = RCONST(1.0)/RCONST(4.0); + B->A[5][4] = RCONST(1.0)/RCONST(5.0); + B->A[6][0] = RCONST(-25.0)/RCONST(108.0); + B->A[6][3] = RCONST(125.0)/RCONST(108.0); + B->A[6][4] = RCONST(-65.0)/RCONST(27.0); + B->A[6][5] = RCONST(125.0)/RCONST(54.0); + B->A[7][0] = RCONST(31.0)/RCONST(300.0); + B->A[7][4] = RCONST(61.0)/RCONST(225.0); + B->A[7][5] = RCONST(-2.0)/RCONST(9.0); + B->A[7][6] = RCONST(13.0)/RCONST(900.0); + B->A[8][0] = RCONST(2.0); + B->A[8][3] = RCONST(-53.0)/RCONST(6.0); + B->A[8][4] = RCONST(704.0)/RCONST(45.0); + B->A[8][5] = RCONST(-107.0)/RCONST(9.0); + B->A[8][6] = RCONST(67.0)/RCONST(90.0); + B->A[8][7] = RCONST(3.0); + B->A[9][0] = RCONST(-91.0)/RCONST(108.0); + B->A[9][3] = RCONST(23.0)/RCONST(108.0); + B->A[9][4] = RCONST(-976.0)/RCONST(135.0); + B->A[9][5] = RCONST(311.0)/RCONST(54.0); + B->A[9][6] = RCONST(-19.0)/RCONST(60.0); + B->A[9][7] = RCONST(17.0)/RCONST(6.0); + B->A[9][8] = RCONST(-1.0)/RCONST(12.0); + B->A[10][0] = RCONST(2383.0)/RCONST(4100.0); + B->A[10][3] = RCONST(-341.0)/RCONST(164.0); + B->A[10][4] = RCONST(4496.0)/RCONST(1025.0); + B->A[10][5] = RCONST(-301.0)/RCONST(82.0); + B->A[10][6] = RCONST(2133.0)/RCONST(4100.0); + B->A[10][7] = RCONST(45.0)/RCONST(82.0); + B->A[10][8] = RCONST(45.0)/RCONST(164.0); + B->A[10][9] = RCONST(18.0)/RCONST(41.0); + B->A[11][0] = RCONST(3.0)/RCONST(205.0); + B->A[11][5] = RCONST(-6.0)/RCONST(41.0); + B->A[11][6] = RCONST(-3.0)/RCONST(205.0); + B->A[11][7] = RCONST(-3.0)/RCONST(41.0); + B->A[11][8] = RCONST(3.0)/RCONST(41.0); + B->A[11][9] = RCONST(6.0)/RCONST(41.0); + B->A[12][0] = RCONST(-1777.0)/RCONST(4100.0); + B->A[12][3] = RCONST(-341.0)/RCONST(164.0); + B->A[12][4] = RCONST(4496.0)/RCONST(1025.0); + B->A[12][5] = RCONST(-289.0)/RCONST(82.0); + B->A[12][6] = RCONST(2193.0)/RCONST(4100.0); + B->A[12][7] = RCONST(51.0)/RCONST(82.0); + B->A[12][8] = RCONST(33.0)/RCONST(164.0); + B->A[12][9] = RCONST(12.0)/RCONST(41.0); + B->A[12][11] = RCONST(1.0); + + B->b[5] = RCONST(34.0)/RCONST(105.0); + B->b[6] = RCONST(9.0)/RCONST(35.0); + B->b[7] = RCONST(9.0)/RCONST(35.0); + B->b[8] = RCONST(9.0)/RCONST(280.0); + B->b[9] = RCONST(9.0)/RCONST(280.0); + B->b[11] = RCONST(41.0)/RCONST(840.0); + B->b[12] = RCONST(41.0)/RCONST(840.0); + + B->d[0] = RCONST(41.0)/RCONST(840.0); + B->d[5] = RCONST(34.0)/RCONST(105.0); + B->d[6] = RCONST(9.0)/RCONST(35.0); + B->d[7] = RCONST(9.0)/RCONST(35.0); + B->d[8] = RCONST(9.0)/RCONST(280.0); + B->d[9] = RCONST(9.0)/RCONST(280.0); + B->d[10] = RCONST(41.0)/RCONST(840.0); + + B->c[1] = RCONST(2.0)/RCONST(27.0); + B->c[2] = RCONST(1.0)/RCONST(9.0); + B->c[3] = RCONST(1.0)/RCONST(6.0); + B->c[4] = RCONST(5.0)/RCONST(12.0); + B->c[5] = RCONST(1.0)/RCONST(2.0); + B->c[6] = RCONST(5.0)/RCONST(6.0); + B->c[7] = RCONST(1.0)/RCONST(6.0); + B->c[8] = RCONST(2.0)/RCONST(3.0); + B->c[9] = RCONST(1.0)/RCONST(3.0); + B->c[10] = RCONST(1.0); + B->c[12] = RCONST(1.0); + break; + + /* ========================================================== + * FIXED STEP METHODS + * ========================================================*/ + + case(ARKODE_KNOTH_WOLKE_3_3): /* Knoth-Wolke-ERK */ + B = ARKodeButcherTable_Alloc(3, SUNFALSE); + B->q = 3; + B->p = 0; + B->A[1][0] = RCONST(1.0)/RCONST(3.0); + B->A[2][0] = RCONST(-3.0)/RCONST(16.0); + B->A[2][1] = RCONST(15.0)/RCONST(16.0); + + B->b[0] = RCONST(1.0)/RCONST(6.0); + B->b[1] = RCONST(3.0)/RCONST(10.0); + B->b[2] = RCONST(8.0)/RCONST(15.0); + + B->d = NULL; + + B->c[1] = RCONST(1.0)/RCONST(3.0); + B->c[2] = RCONST(3.0)/RCONST(4.0); + break; + + default: + + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode", + "ARKodeButcherTable_LoadERK", + "Unknown Butcher table"); + return(NULL); + + } + + return(B); +} + + +/*--------------------------------------------------------------- + EOF + ---------------------------------------------------------------*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_erkstep.c b/lib/sundials_6.1.1/src/arkode/arkode_erkstep.c new file mode 100644 index 00000000000..49756f7b691 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_erkstep.c @@ -0,0 +1,1128 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 ERK time stepper + * module. + *--------------------------------------------------------------*/ + +#include +#include +#include + +#include "arkode_impl.h" +#include "arkode_erkstep_impl.h" +#include "arkode_interp_impl.h" +#include +#include + + +/*=============================================================== + SHORTCUTS + ===============================================================*/ + +#define ARK_PROFILER ark_mem->sunctx->profiler + +/*=============================================================== + ERKStep Exported functions -- Required + ===============================================================*/ + +void* ERKStepCreate(ARKRhsFn f, realtype t0, N_Vector y0, SUNContext sunctx) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + booleantype nvectorOK; + int retval; + + /* Check that f is supplied */ + if (f == NULL) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::ERKStep", + "ERKStepCreate", MSG_ARK_NULL_F); + return(NULL); + } + + /* Check for legal input parameters */ + if (y0 == NULL) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::ERKStep", + "ERKStepCreate", MSG_ARK_NULL_Y0); + return(NULL); + } + + if (!sunctx) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::ERKStep", + "ERKStepCreate", MSG_ARK_NULL_SUNCTX); + return(NULL); + } + + /* Test if all required vector operations are implemented */ + nvectorOK = erkStep_CheckNVector(y0); + if (!nvectorOK) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::ERKStep", + "ERKStepCreate", MSG_ARK_BAD_NVECTOR); + return(NULL); + } + + /* Create ark_mem structure and set default values */ + ark_mem = arkCreate(sunctx); + if (ark_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepCreate", MSG_ARK_NO_MEM); + return(NULL); + } + + /* Allocate ARKodeERKStepMem structure, and initialize to zero */ + step_mem = NULL; + step_mem = (ARKodeERKStepMem) malloc(sizeof(struct ARKodeERKStepMemRec)); + if (step_mem == NULL) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::ERKStep", + "ERKStepCreate", MSG_ARK_ARKMEM_FAIL); + return(NULL); + } + memset(step_mem, 0, sizeof(struct ARKodeERKStepMemRec)); + + /* Attach step_mem structure and function pointers to ark_mem */ + ark_mem->step_init = erkStep_Init; + ark_mem->step_fullrhs = erkStep_FullRHS; + ark_mem->step = erkStep_TakeStep; + ark_mem->step_mem = (void*) step_mem; + + /* Set default values for ERKStep optional inputs */ + retval = ERKStepSetDefaults((void *) ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::ERKStep", "ERKStepCreate", + "Error setting default solver options"); + return(NULL); + } + + /* Allocate the general ERK stepper vectors using y0 as a template */ + /* NOTE: F, cvals and Xvecs will be allocated later on + (based on the number of ERK stages) */ + + /* Copy the input parameters into ARKode state */ + step_mem->f = f; + + /* Update the ARKode workspace requirements -- UPDATE */ + ark_mem->liw += 41; /* fcn/data ptr, int, long int, sunindextype, booleantype */ + ark_mem->lrw += 10; + + /* Initialize all the counters */ + step_mem->nfe = 0; + + /* Initialize main ARKode infrastructure */ + retval = arkInit(ark_mem, t0, y0, FIRST_INIT); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::ERKStep", "ERKStepCreate", + "Unable to initialize main ARKode infrastructure"); + return(NULL); + } + + return((void *)ark_mem); +} + + +/*--------------------------------------------------------------- + ERKStepResize: + + This routine resizes the memory within the ERKStep module. + It first resizes the main ARKode infrastructure memory, and + then resizes its own data. + ---------------------------------------------------------------*/ +int ERKStepResize(void *arkode_mem, N_Vector y0, realtype hscale, + realtype t0, ARKVecResizeFn resize, void *resize_data) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + sunindextype lrw1, liw1, lrw_diff, liw_diff; + int i, retval; + + /* access ARKodeERKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepReSize", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Determing change in vector sizes */ + lrw1 = liw1 = 0; + if (y0->ops->nvspace != NULL) + N_VSpace(y0, &lrw1, &liw1); + lrw_diff = lrw1 - ark_mem->lrw1; + liw_diff = liw1 - ark_mem->liw1; + ark_mem->lrw1 = lrw1; + ark_mem->liw1 = liw1; + + /* resize ARKode infrastructure memory */ + retval = arkResize(ark_mem, y0, hscale, t0, resize, resize_data); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::ERKStep", "ERKStepResize", + "Unable to resize main ARKode infrastructure"); + return(retval); + } + + /* Resize the RHS vectors */ + for (i=0; istages; i++) { + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &step_mem->F[i])) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::ERKStep", "ERKStepResize", + "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ERKStepReInit: + + This routine re-initializes the ERKStep module to solve a new + problem of the same size as was previously solved. This routine + should also be called when the problem dynamics or desired solvers + have changed dramatically, so that the problem integration should + resume as if started from scratch. + + Note all internal counters are set to 0 on re-initialization. + ---------------------------------------------------------------*/ +int ERKStepReInit(void* arkode_mem, ARKRhsFn f, realtype t0, N_Vector y0) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + int retval; + + /* access ARKodeERKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepReInit", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Check if ark_mem was allocated */ + if (ark_mem->MallocDone == SUNFALSE) { + arkProcessError(ark_mem, ARK_NO_MALLOC, "ARKode::ERKStep", + "ERKStepReInit", MSG_ARK_NO_MALLOC); + return(ARK_NO_MALLOC); + } + + /* Check that f is supplied */ + if (f == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ERKStep", + "ERKStepReInit", MSG_ARK_NULL_F); + return(ARK_ILL_INPUT); + } + + /* Check for legal input parameters */ + if (y0 == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ERKStep", + "ERKStepReInit", MSG_ARK_NULL_Y0); + return(ARK_ILL_INPUT); + } + + /* Copy the input parameters into ARKode state */ + step_mem->f = f; + + /* Initialize main ARKode infrastructure */ + retval = arkInit(arkode_mem, t0, y0, FIRST_INIT); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::ERKStep", "ERKStepReInit", + "Unable to initialize main ARKode infrastructure"); + return(retval); + } + + /* Initialize all the counters */ + step_mem->nfe = 0; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ERKStepReset: + + This routine resets the ERKStep module state to solve the same + problem from the given time with the input state (all counter + values are retained). + ---------------------------------------------------------------*/ +int ERKStepReset(void* arkode_mem, realtype tR, N_Vector yR) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + int retval; + + /* access ARKodeERKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepReset", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Initialize main ARKode infrastructure */ + retval = arkInit(ark_mem, tR, yR, RESET_INIT); + + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::ERKStep", "ERKStepReset", + "Unable to initialize main ARKode infrastructure"); + return(retval); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ERKStepSStolerances, ERKStepSVtolerances, ERKStepWFtolerances: + + These routines set integration tolerances (wrappers for general + ARKode utility routines) + ---------------------------------------------------------------*/ +int ERKStepSStolerances(void *arkode_mem, realtype reltol, realtype abstol) +{ + /* unpack ark_mem, call arkSStolerances, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepSStolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkSStolerances(ark_mem, reltol, abstol)); +} + + +int ERKStepSVtolerances(void *arkode_mem, realtype reltol, N_Vector abstol) +{ + /* unpack ark_mem, call arkSVtolerances, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepSVtolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkSVtolerances(ark_mem, reltol, abstol)); +} + + +int ERKStepWFtolerances(void *arkode_mem, ARKEwtFn efun) +{ + /* unpack ark_mem, call arkWFtolerances, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepWFtolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkWFtolerances(ark_mem, efun)); +} + + +int ERKStepRootInit(void *arkode_mem, int nrtfn, ARKRootFn g) +{ + /* unpack ark_mem, call arkRootInit, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepRootInit", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkRootInit(ark_mem, nrtfn, g)); +} + + +int ERKStepEvolve(void *arkode_mem, realtype tout, N_Vector yout, + realtype *tret, int itask) +{ + /* unpack ark_mem, call arkEvolve, and return */ + int retval; + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepEvolve", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + SUNDIALS_MARK_FUNCTION_BEGIN(ARK_PROFILER); + retval = arkEvolve(ark_mem, tout, yout, tret, itask); + SUNDIALS_MARK_FUNCTION_END(ARK_PROFILER); + return(retval); +} + + +int ERKStepGetDky(void *arkode_mem, realtype t, int k, N_Vector dky) +{ + /* unpack ark_mem, call arkGetDky, and return */ + int retval; + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepGetDky", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + SUNDIALS_MARK_FUNCTION_BEGIN(ARK_PROFILER); + retval = arkGetDky(ark_mem, t, k, dky); + SUNDIALS_MARK_FUNCTION_END(ARK_PROFILER); + return(retval); +} + + +/*--------------------------------------------------------------- + ERKStepFree frees all ERKStep memory, and then calls an ARKode + utility routine to free the ARKode infrastructure memory. + ---------------------------------------------------------------*/ +void ERKStepFree(void **arkode_mem) +{ + int j; + sunindextype Bliw, Blrw; + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + + /* nothing to do if arkode_mem is already NULL */ + if (*arkode_mem == NULL) return; + + /* conditional frees on non-NULL ERKStep module */ + ark_mem = (ARKodeMem) (*arkode_mem); + if (ark_mem->step_mem != NULL) { + + step_mem = (ARKodeERKStepMem) ark_mem->step_mem; + + /* free the Butcher table */ + if (step_mem->B != NULL) { + ARKodeButcherTable_Space(step_mem->B, &Bliw, &Blrw); + ARKodeButcherTable_Free(step_mem->B); + step_mem->B = NULL; + ark_mem->liw -= Bliw; + ark_mem->lrw -= Blrw; + } + + /* free the RHS vectors */ + if (step_mem->F != NULL) { + for(j=0; jstages; j++) + arkFreeVec(ark_mem, &step_mem->F[j]); + free(step_mem->F); + step_mem->F = NULL; + ark_mem->liw -= step_mem->stages; + } + + /* free the reusable arrays for fused vector interface */ + if (step_mem->cvals != NULL) { + free(step_mem->cvals); + step_mem->cvals = NULL; + ark_mem->lrw -= (step_mem->stages + 1); + } + if (step_mem->Xvecs != NULL) { + free(step_mem->Xvecs); + step_mem->Xvecs = NULL; + ark_mem->liw -= (step_mem->stages + 1); + } + + /* free the time stepper module itself */ + free(ark_mem->step_mem); + ark_mem->step_mem = NULL; + + } + + /* free memory for overall ARKode infrastructure */ + arkFree(arkode_mem); +} + + +/*--------------------------------------------------------------- + ERKStepPrintMem: + + This routine outputs the memory from the ERKStep structure and + the main ARKode infrastructure to a specified file pointer + (useful when debugging). + ---------------------------------------------------------------*/ +void ERKStepPrintMem(void* arkode_mem, FILE* outfile) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + int retval; + +#ifdef SUNDIALS_DEBUG_PRINTVEC + int i; +#endif + + /* access ARKodeERKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepPrintMem", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return; + + /* output data from main ARKode infrastructure */ + arkPrintMem(ark_mem, outfile); + + /* output integer quantities */ + STAN_SUNDIALS_FPRINTF(outfile,"ERKStep: q = %i\n", step_mem->q); + STAN_SUNDIALS_FPRINTF(outfile,"ERKStep: p = %i\n", step_mem->p); + STAN_SUNDIALS_FPRINTF(outfile,"ERKStep: stages = %i\n", step_mem->stages); + + /* output long integer quantities */ + STAN_SUNDIALS_FPRINTF(outfile,"ERKStep: nfe = %li\n", step_mem->nfe); + + /* output realtype quantities */ + STAN_SUNDIALS_FPRINTF(outfile,"ERKStep: Butcher table:\n"); + ARKodeButcherTable_Write(step_mem->B, outfile); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + /* output vector quantities */ + for (i=0; istages; i++) { + STAN_SUNDIALS_FPRINTF(outfile,"ERKStep: F[%i]:\n", i); + N_VPrintFile(step_mem->F[i], outfile); + } +#endif +} + + + +/*=============================================================== + ERKStep Private functions + ===============================================================*/ + +/*--------------------------------------------------------------- + Interface routines supplied to ARKode + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + erkStep_Init: + + This routine is called just prior to performing internal time + steps (after all user "set" routines have been called) from + within arkInitialSetup. + + With initialization types FIRST_INIT this routine: + - sets/checks the ARK Butcher tables to be used + - allocates any memory that depends on the number of ARK + stages, method order, or solver options + - sets the call_fullrhs flag + + With other initialization types, this routine does nothing. + ---------------------------------------------------------------*/ +int erkStep_Init(void* arkode_mem, int init_type) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + int retval, j; + + /* access ARKodeERKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "erkStep_Init", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* immediately return if resize or reset */ + if (init_type == RESIZE_INIT || init_type == RESET_INIT) + return(ARK_SUCCESS); + + /* enforce use of arkEwtSmallReal if using a fixed step size + and an internal error weight function */ + if ( ark_mem->fixedstep && !ark_mem->user_efun ) { + ark_mem->user_efun = SUNFALSE; + ark_mem->efun = arkEwtSetSmallReal; + ark_mem->e_data = ark_mem; + } + + /* Create Butcher table (if not already set) */ + retval = erkStep_SetButcherTable(ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ERKStep", "erkStep_Init", + "Could not create Butcher table"); + return(ARK_ILL_INPUT); + } + + /* Check that Butcher table are OK */ + retval = erkStep_CheckButcherTable(ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ERKStep", + "erkStep_Init", "Error in Butcher table"); + return(ARK_ILL_INPUT); + } + + /* Retrieve/store method and embedding orders now that table is finalized */ + step_mem->q = ark_mem->hadapt_mem->q = step_mem->B->q; + step_mem->p = ark_mem->hadapt_mem->p = step_mem->B->p; + + /* Ensure that if adaptivity is enabled, then method includes embedding coefficients */ + if (!ark_mem->fixedstep && (step_mem->p == 0)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ERKStep", "erkStep_Init", + "Adaptive timestepping cannot be performed without embedding coefficients"); + return(ARK_ILL_INPUT); + } + + /* Allocate ARK RHS vector memory, update storage requirements */ + /* Allocate F[0] ... F[stages-1] if needed */ + if (step_mem->F == NULL) + step_mem->F = (N_Vector *) calloc(step_mem->stages, sizeof(N_Vector)); + for (j=0; jstages; j++) { + if (!arkAllocVec(ark_mem, ark_mem->ewt, &(step_mem->F[j]))) + return(ARK_MEM_FAIL); + } + ark_mem->liw += step_mem->stages; /* pointers */ + + /* Allocate reusable arrays for fused vector interface */ + if (step_mem->cvals == NULL) { + step_mem->cvals = (realtype *) calloc(step_mem->stages+1, sizeof(realtype)); + if (step_mem->cvals == NULL) return(ARK_MEM_FAIL); + ark_mem->lrw += (step_mem->stages + 1); + } + if (step_mem->Xvecs == NULL) { + step_mem->Xvecs = (N_Vector *) calloc(step_mem->stages+1, sizeof(N_Vector)); + if (step_mem->Xvecs == NULL) return(ARK_MEM_FAIL); + ark_mem->liw += (step_mem->stages + 1); /* pointers */ + } + + /* Limit interpolant degree based on method order (use negative + argument to specify update instead of overwrite) */ + if (ark_mem->interp != NULL) { + retval = arkInterpSetDegree(ark_mem, ark_mem->interp, -(step_mem->q-1)); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ERKStep", "erkStep_Init", + "Unable to update interpolation polynomial degree"); + return(ARK_ILL_INPUT); + } + } + + /* Signal to shared arkode module that fullrhs is required after each step */ + ark_mem->call_fullrhs = SUNTRUE; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + erkStep_FullRHS: + + This is just a wrapper to call the user-supplied RHS function, + f(t,y). + + This will be called in one of three 'modes': + ARK_FULLRHS_START -> called at the beginning of a simulation + or after post processing at step + ARK_FULLRHS_END -> called at the end of a successful step + ARK_FULLRHS_OTHER -> called elsewhere (e.g. for dense output) + + If it is called in ARK_FULLRHS_START mode, we store the vectors + f(t,y) in F[0] for possible reuse in the first stage of the + subsequent time step. + + If it is called in ARK_FULLRHS_END mode and the method coefficients + support it, we may just copy vectors F[stages] to fill f instead + of calling f(). + + ARK_FULLRHS_OTHER mode is only called for dense output in-between + steps, so we strive to store the intermediate parts so that they + do not interfere with the other two modes. + ---------------------------------------------------------------*/ +int erkStep_FullRHS(void* arkode_mem, realtype t, N_Vector y, N_Vector f, + int mode) +{ + int retval; + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + booleantype recomputeRHS; + + /* access ARKodeERKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "erkStep_FullRHS", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* perform RHS functions contingent on 'mode' argument */ + switch(mode) { + + /* ARK_FULLRHS_START: called at the beginning of a simulation + Store the vectors f(t,y) in F[0] for possible reuse + in the first stage of the subsequent time step */ + case ARK_FULLRHS_START: + + /* call f */ + retval = step_mem->f(t, y, step_mem->F[0], ark_mem->user_data); + step_mem->nfe++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::ERKStep", + "erkStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + + /* copy RHS vector into output */ + N_VScale(ONE, step_mem->F[0], f); + + break; + + + /* ARK_FULLRHS_END: called at the end of a successful step + If the method coefficients support it, we just copy the last stage RHS + vectors to fill f instead of calling f(t,y). + Copy the results to F[0] if the coefficients support it. */ + case ARK_FULLRHS_END: + + /* determine if explicit RHS function needs to be recomputed */ + recomputeRHS = SUNFALSE; + if (SUNRabs(step_mem->B->c[step_mem->stages - 1] - ONE) > TINY) + recomputeRHS = SUNTRUE; + + /* base RHS calls on recomputeRHS argument */ + if (recomputeRHS) { + + /* call f */ + retval = step_mem->f(t, y, step_mem->F[0], ark_mem->user_data); + step_mem->nfe++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::ERKStep", + "erkStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + + } else { + N_VScale(ONE, step_mem->F[step_mem->stages-1], step_mem->F[0]); + } + + /* copy RHS vector into output */ + N_VScale(ONE, step_mem->F[0], f); + + break; + + /* ARK_FULLRHS_OTHER: called for dense output in-between steps + store the intermediate calculations in such a way as to not + interfere with the other two modes */ + case ARK_FULLRHS_OTHER: + + /* call f */ + retval = step_mem->f(t, y, f, ark_mem->user_data); + step_mem->nfe++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::ERKStep", + "erkStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + + break; + + default: + /* return with RHS failure if unknown mode is passed */ + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::ERKStep", + "erkStep_FullRHS", "Unknown full RHS mode"); + return(ARK_RHSFUNC_FAIL); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + erkStep_TakeStep: + + This routine serves the primary purpose of the ERKStep module: + it performs a single ERK step (with embedding, if possible). + + The output variable dsmPtr should contain estimate of the + weighted local error if an embedding is present; otherwise it + should be 0. + + The input/output variable nflagPtr is used to gauge convergence + of any algebraic solvers within the step. As this routine + involves no algebraic solve, it is set to 0 (success). + + 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 erkStep_TakeStep(void* arkode_mem, realtype *dsmPtr, int *nflagPtr) +{ + int retval, is, js, nvec; + realtype* cvals; + N_Vector* Xvecs; + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + + /* initialize algebraic solver convergence flag to success */ + *nflagPtr = ARK_SUCCESS; + + /* access ARKodeERKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "erkStep_TakeStep", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* local shortcuts for fused vector operations */ + cvals = step_mem->cvals; + Xvecs = step_mem->Xvecs; + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" ERKStep step %li, stage 0, h = %"RSYM", t_n = %"RSYM"\n", + ark_mem->nst, ark_mem->h, ark_mem->tcur); +#endif + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" ERKStep stage 0 solution:\n"); + N_VPrint(ark_mem->ycur); + STAN_SUNDIALS_PRINTF(" ERKStep stage RHS F[0]:\n"); + N_VPrint(step_mem->F[0]); +#endif + + /* Loop over internal stages to the step; since the method is explicit + the first stage RHS is just the full RHS from the start of the step */ + for (is=1; isstages; is++) { + + /* Set current stage time(s) */ + ark_mem->tcur = ark_mem->tn + step_mem->B->c[is]*ark_mem->h; + +#ifdef SUNDIALS_DEBUG + STAN_SUNDIALS_PRINTF(" ERKStep step %li, stage %i, h = %"RSYM", t_n = %"RSYM"\n", + ark_mem->nst, is, ark_mem->h, ark_mem->tcur); +#endif + + /* Solver diagnostics reporting */ + if (ark_mem->report) + STAN_SUNDIALS_FPRINTF(ark_mem->diagfp, "ERKStep step %li %"RSYM" %i %"RSYM"\n", + ark_mem->nst, ark_mem->h, is, ark_mem->tcur); + + /* Set ycur to current stage solution */ + nvec = 0; + for (js=0; jsh * step_mem->B->A[is][js]; + Xvecs[nvec] = step_mem->F[js]; + nvec += 1; + } + cvals[nvec] = ONE; + Xvecs[nvec] = ark_mem->yn; + nvec += 1; + + /* call fused vector operation to do the work */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, ark_mem->ycur); + if (retval != 0) return(ARK_VECTOROP_ERR); + + /* apply user-supplied stage postprocessing function (if supplied) */ + if (ark_mem->ProcessStage != NULL) { + retval = ark_mem->ProcessStage(ark_mem->tcur, + ark_mem->ycur, + ark_mem->user_data); + if (retval != 0) return(ARK_POSTPROCESS_STAGE_FAIL); + } + + /* compute updated RHS */ + retval = step_mem->f(ark_mem->tcur, ark_mem->ycur, + step_mem->F[is], ark_mem->user_data); + step_mem->nfe++; + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(ARK_UNREC_RHSFUNC_ERR); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" ERKStep stage RHS F[%i]:\n",is); + N_VPrint(step_mem->F[is]); +#endif + + } /* loop over stages */ + + /* compute time-evolved solution (in ark_ycur), error estimate (in dsm) */ + retval = erkStep_ComputeSolutions(ark_mem, dsmPtr); + if (retval < 0) return(retval); + +#ifdef SUNDIALS_DEBUG + STAN_SUNDIALS_PRINTF(" ERKStep error estimate = %"RSYM"\n", *dsmPtr); +#endif +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" ERKStep updated solution:\n"); + N_VPrint(ark_mem->ycur); +#endif + + /* Solver diagnostics reporting */ + if (ark_mem->report) + STAN_SUNDIALS_FPRINTF(ark_mem->diagfp, "ERKStep etest %li %"RSYM" %"RSYM"\n", + ark_mem->nst, ark_mem->h, *dsmPtr); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + Internal utility routines + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + erkStep_AccessStepMem: + + Shortcut routine to unpack ark_mem and step_mem structures from + void* pointer. If either is missing it returns ARK_MEM_NULL. + ---------------------------------------------------------------*/ +int erkStep_AccessStepMem(void* arkode_mem, const char *fname, + ARKodeMem *ark_mem, ARKodeERKStepMem *step_mem) +{ + + /* access ARKodeMem structure */ + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ERKStep", + fname, MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + *ark_mem = (ARKodeMem) arkode_mem; + if ((*ark_mem)->step_mem==NULL) { + arkProcessError(*ark_mem, ARK_MEM_NULL, "ARKode::ERKStep", + fname, MSG_ERKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + *step_mem = (ARKodeERKStepMem) (*ark_mem)->step_mem; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + erkStep_CheckNVector: + + This routine checks if all required vector operations are + present. If any of them is missing it returns SUNFALSE. + ---------------------------------------------------------------*/ +booleantype erkStep_CheckNVector(N_Vector tmpl) +{ + if ( (tmpl->ops->nvclone == NULL) || + (tmpl->ops->nvdestroy == NULL) || + (tmpl->ops->nvlinearsum == NULL) || + (tmpl->ops->nvconst == NULL) || + (tmpl->ops->nvscale == NULL) || + (tmpl->ops->nvwrmsnorm == NULL) ) + return(SUNFALSE); + return(SUNTRUE); +} + + +/*--------------------------------------------------------------- + erkStep_SetButcherTable + + This routine determines the ERK method to use, based on the + desired accuracy. + ---------------------------------------------------------------*/ +int erkStep_SetButcherTable(ARKodeMem ark_mem) +{ + int etable; + ARKodeERKStepMem step_mem; + sunindextype Bliw, Blrw; + + /* access ARKodeERKStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ERKStep", + "erkStep_SetButcherTable", MSG_ERKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeERKStepMem) ark_mem->step_mem; + + /* if table has already been specified, just return */ + if (step_mem->B != NULL) + return(ARK_SUCCESS); + + /* initialize table number to illegal values */ + etable = -1; + + /* select method based on order */ + switch (step_mem->q) { + case(2): + etable = ERKSTEP_DEFAULT_2; + break; + case(3): + etable = ERKSTEP_DEFAULT_3; + break; + case(4): + etable = ERKSTEP_DEFAULT_4; + break; + case(5): + etable = ERKSTEP_DEFAULT_5; + break; + case(6): + etable = ERKSTEP_DEFAULT_6; + break; + case(7): + case(8): + etable = ERKSTEP_DEFAULT_8; + break; + default: /* no available method, set default */ + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ERKStep", + "erkStep_SetButcherTable", + "No explicit method at requested order, using q=6."); + etable = ERKSTEP_DEFAULT_6; + break; + } + + if (etable > -1) + step_mem->B = ARKodeButcherTable_LoadERK(etable); + + /* note Butcher table space requirements */ + ARKodeButcherTable_Space(step_mem->B, &Bliw, &Blrw); + ark_mem->liw += Bliw; + ark_mem->lrw += Blrw; + + /* set [redundant] stored values for stage numbers and method orders */ + if (step_mem->B != NULL) { + step_mem->stages = step_mem->B->stages; + step_mem->q = step_mem->B->q; + step_mem->p = step_mem->B->p; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + erkStep_CheckButcherTable + + This routine runs through the explicit Butcher table to ensure + that it meets all necessary requirements, including: + strictly lower-triangular (ERK) + method order q > 0 (all) + embedding order q > 0 (all -- if adaptive time-stepping enabled) + stages > 0 (all) + + Returns ARK_SUCCESS if tables pass, ARK_INVALID_TABLE otherwise. + ---------------------------------------------------------------*/ +int erkStep_CheckButcherTable(ARKodeMem ark_mem) +{ + int i, j; + booleantype okay; + ARKodeERKStepMem step_mem; + realtype tol = RCONST(1.0e-12); + + /* access ARKodeERKStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ERKStep", + "erkStep_CheckButcherTable", MSG_ERKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeERKStepMem) ark_mem->step_mem; + + /* check that stages > 0 */ + if (step_mem->stages < 1) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ERKStep", + "erkStep_CheckButcherTable", + "stages < 1!"); + return(ARK_INVALID_TABLE); + } + + /* check that method order q > 0 */ + if (step_mem->q < 1) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ERKStep", + "erkStep_CheckButcherTable", + "method order < 1!"); + return(ARK_INVALID_TABLE); + } + + /* check that embedding order p > 0 */ + if ((step_mem->p < 1) && (!ark_mem->fixedstep)) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ERKStep", + "erkStep_CheckButcherTable", + "embedding order < 1!"); + return(ARK_INVALID_TABLE); + } + + /* check that embedding exists */ + if ((step_mem->p > 0) && (!ark_mem->fixedstep)) { + if (step_mem->B->d == NULL) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ERKStep", + "erkStep_CheckButcherTable", + "no embedding!"); + return(ARK_INVALID_TABLE); + } + } + + /* check that ERK table is strictly lower triangular */ + okay = SUNTRUE; + for (i=0; istages; i++) + for (j=i; jstages; j++) + if (SUNRabs(step_mem->B->A[i][j]) > tol) + okay = SUNFALSE; + if (!okay) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::ERKStep", + "erkStep_CheckButcherTable", + "Ae Butcher table is implicit!"); + return(ARK_INVALID_TABLE); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + erkStep_ComputeSolutions + + This routine calculates the final RK solution using the existing + data. This solution is placed directly in ark_ycur. This routine + also computes the error estimate ||y-ytilde||_WRMS, where ytilde + is the embedded solution, and the norm weights come from + ark_ewt. This norm value is returned. The vector form of this + estimated error (y-ytilde) is stored in ark_tempv1, in case the + calling routine wishes to examine the error locations. + + Note: at this point in the step, the vector ark_tempv1 may be + used as a temporary vector. + ---------------------------------------------------------------*/ +int erkStep_ComputeSolutions(ARKodeMem ark_mem, realtype *dsmPtr) +{ + /* local data */ + int retval, j, nvec; + N_Vector y, yerr; + realtype* cvals; + N_Vector* Xvecs; + ARKodeERKStepMem step_mem; + + /* access ARKodeERKStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ERKStep", + "erkStep_ComputeSolutions", MSG_ERKSTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeERKStepMem) ark_mem->step_mem; + + /* set N_Vector shortcuts */ + y = ark_mem->ycur; + yerr = ark_mem->tempv1; + + /* local shortcuts for fused vector operations */ + cvals = step_mem->cvals; + Xvecs = step_mem->Xvecs; + + /* initialize output */ + *dsmPtr = ZERO; + + + /* Compute time step solution */ + /* set arrays for fused vector operation */ + nvec = 0; + for (j=0; jstages; j++) { + cvals[nvec] = ark_mem->h * step_mem->B->b[j]; + Xvecs[nvec] = step_mem->F[j]; + nvec += 1; + } + cvals[nvec] = ONE; + Xvecs[nvec] = ark_mem->yn; + nvec += 1; + + /* call fused vector operation to do the work */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, y); + if (retval != 0) return(ARK_VECTOROP_ERR); + + /* Compute yerr (if step adaptivity enabled) */ + if (!ark_mem->fixedstep) { + + /* set arrays for fused vector operation */ + nvec = 0; + for (j=0; jstages; j++) { + cvals[nvec] = ark_mem->h * (step_mem->B->b[j] - step_mem->B->d[j]); + Xvecs[nvec] = step_mem->F[j]; + nvec += 1; + } + + /* call fused vector operation to do the work */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, yerr); + if (retval != 0) return(ARK_VECTOROP_ERR); + + /* fill error norm */ + *dsmPtr = N_VWrmsNorm(yerr, ark_mem->ewt); + } + + return(ARK_SUCCESS); +} + +/*=============================================================== + EOF + ===============================================================*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_erkstep_impl.h b/lib/sundials_6.1.1/src/arkode/arkode_erkstep_impl.h new file mode 100644 index 00000000000..c9d9a9b6407 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_erkstep_impl.h @@ -0,0 +1,97 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * Implementation header file for ARKode's ERK time stepper + * module. + *--------------------------------------------------------------*/ + +#ifndef _ARKODE_ERKSTEP_IMPL_H +#define _ARKODE_ERKSTEP_IMPL_H + +#include +#include "arkode_impl.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*=============================================================== + ERK time step module constants -- move many items here from + arkode_impl.h + ===============================================================*/ + + + +/*=============================================================== + ERK time step module data structure + ===============================================================*/ + +/*--------------------------------------------------------------- + Types : struct ARKodeERKStepMemRec, ARKodeERKStepMem + --------------------------------------------------------------- + The type ARKodeERKStepMem is type pointer to struct + ARKodeERKStepMemRec. This structure contains fields to + perform an explicit Runge-Kutta time step. + ---------------------------------------------------------------*/ +typedef struct ARKodeERKStepMemRec { + + /* ERK problem specification */ + ARKRhsFn f; /* y' = f(t,y) */ + + /* ARK method storage and parameters */ + N_Vector *F; /* explicit RHS at each stage */ + int q; /* method order */ + int p; /* embedding order */ + int stages; /* number of stages */ + ARKodeButcherTable B; /* ERK Butcher table */ + + /* Counters */ + long int nfe; /* num fe calls */ + + /* Reusable arrays for fused vector operations */ + realtype* cvals; + N_Vector* Xvecs; + +} *ARKodeERKStepMem; + + +/*=============================================================== + ERK time step module private function prototypes + ===============================================================*/ + +/* Interface routines supplied to ARKode */ +int erkStep_Init(void* arkode_mem, int init_type); +int erkStep_FullRHS(void* arkode_mem, realtype t, + N_Vector y, N_Vector f, int mode); +int erkStep_TakeStep(void* arkode_mem, realtype *dsmPtr, int *nflagPtr); + +/* Internal utility routines */ +int erkStep_AccessStepMem(void* arkode_mem, const char *fname, + ARKodeMem *ark_mem, ARKodeERKStepMem *step_mem); +booleantype erkStep_CheckNVector(N_Vector tmpl); +int erkStep_SetButcherTable(ARKodeMem ark_mem); +int erkStep_CheckButcherTable(ARKodeMem ark_mem); +int erkStep_ComputeSolutions(ARKodeMem ark_mem, realtype *dsm); + +/*=============================================================== + Reusable ERKStep Error Messages + ===============================================================*/ + +/* Initialization and I/O error messages */ +#define MSG_ERKSTEP_NO_MEM "Time step module memory is NULL." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/src/arkode/arkode_erkstep_io.c b/lib/sundials_6.1.1/src/arkode/arkode_erkstep_io.c new file mode 100644 index 00000000000..97e4f23fe41 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_erkstep_io.c @@ -0,0 +1,535 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * This is the implementation file for the optional input and + * output functions for the ARKode ERKStep time stepper module. + * + * NOTE: many functions currently in arkode_io.c will move here, + * with slightly different names. The code transition will be + * minimal, but the documentation changes will be significant. + *--------------------------------------------------------------*/ + +#include +#include + +#include "arkode_erkstep_impl.h" +#include +#include + + +/*=============================================================== + ERKStep Optional input functions (wrappers for generic ARKode + utility routines). All are documented in arkode_io.c. + ===============================================================*/ +int ERKStepSetDenseOrder(void *arkode_mem, int dord) { + return(ERKStepSetInterpolantDegree(arkode_mem, dord)); } +int ERKStepSetInterpolantDegree(void *arkode_mem, int degree) { + if (degree < 0) degree = ARK_INTERP_MAX_DEGREE; + return(arkSetInterpolantDegree(arkode_mem, degree)); } +int ERKStepSetInterpolantType(void *arkode_mem, int itype) { + return(arkSetInterpolantType(arkode_mem, itype)); } +int ERKStepSetErrHandlerFn(void *arkode_mem, ARKErrHandlerFn ehfun, + void *eh_data) { + return(arkSetErrHandlerFn(arkode_mem, ehfun, eh_data)); } +int ERKStepSetErrFile(void *arkode_mem, FILE *errfp) { + return(arkSetErrFile(arkode_mem, errfp)); } +int ERKStepSetUserData(void *arkode_mem, void *user_data) { + return(arkSetUserData(arkode_mem, user_data)); } +int ERKStepSetDiagnostics(void *arkode_mem, FILE *diagfp) { + return(arkSetDiagnostics(arkode_mem, diagfp)); } +int ERKStepSetMaxNumSteps(void *arkode_mem, long int mxsteps) { + return(arkSetMaxNumSteps(arkode_mem, mxsteps)); } +int ERKStepSetMaxHnilWarns(void *arkode_mem, int mxhnil) { + return(arkSetMaxHnilWarns(arkode_mem, mxhnil)); } +int ERKStepSetInitStep(void *arkode_mem, realtype hin) { + return(arkSetInitStep(arkode_mem, hin)); } +int ERKStepSetMinStep(void *arkode_mem, realtype hmin) { + return(arkSetMinStep(arkode_mem, hmin)); } +int ERKStepSetMaxStep(void *arkode_mem, realtype hmax) { + return(arkSetMaxStep(arkode_mem, hmax)); } +int ERKStepSetStopTime(void *arkode_mem, realtype tstop) { + return(arkSetStopTime(arkode_mem, tstop)); } +int ERKStepSetRootDirection(void *arkode_mem, int *rootdir) { + return(arkSetRootDirection(arkode_mem, rootdir)); } +int ERKStepSetNoInactiveRootWarn(void *arkode_mem) { + return(arkSetNoInactiveRootWarn(arkode_mem)); } +int ERKStepSetConstraints(void *arkode_mem, N_Vector constraints) { + return(arkSetConstraints(arkode_mem, constraints)); } +int ERKStepSetMaxNumConstrFails(void *arkode_mem, int maxfails) { + return(arkSetMaxNumConstrFails(arkode_mem, maxfails)); } +int ERKStepSetPostprocessStepFn(void *arkode_mem, + ARKPostProcessFn ProcessStep) { + return(arkSetPostprocessStepFn(arkode_mem, ProcessStep)); } +int ERKStepSetPostprocessStageFn(void *arkode_mem, + ARKPostProcessFn ProcessStage) { + return(arkSetPostprocessStageFn(arkode_mem, ProcessStage)); } +int ERKStepSetCFLFraction(void *arkode_mem, realtype cfl_frac) { + return(arkSetCFLFraction(arkode_mem, cfl_frac)); } +int ERKStepSetSafetyFactor(void *arkode_mem, realtype safety) { + return(arkSetSafetyFactor(arkode_mem, safety)); } +int ERKStepSetErrorBias(void *arkode_mem, realtype bias) { + return(arkSetErrorBias(arkode_mem, bias)); } +int ERKStepSetMaxGrowth(void *arkode_mem, realtype mx_growth) { + return(arkSetMaxGrowth(arkode_mem, mx_growth)); } +int ERKStepSetMinReduction(void *arkode_mem, realtype eta_min) { + return(arkSetMinReduction(arkode_mem, eta_min)); } +int ERKStepSetFixedStepBounds(void *arkode_mem, realtype lb, realtype ub) { + return(arkSetFixedStepBounds(arkode_mem, lb, ub)); } +int ERKStepSetAdaptivityMethod(void *arkode_mem, int imethod, int idefault, + int pq, realtype adapt_params[3]) { + return(arkSetAdaptivityMethod(arkode_mem, imethod, idefault, pq, adapt_params)); } +int ERKStepSetAdaptivityFn(void *arkode_mem, ARKAdaptFn hfun, void *h_data) { + return(arkSetAdaptivityFn(arkode_mem, hfun, h_data)); } +int ERKStepSetMaxFirstGrowth(void *arkode_mem, realtype etamx1) { + return(arkSetMaxFirstGrowth(arkode_mem, etamx1)); } +int ERKStepSetMaxEFailGrowth(void *arkode_mem, realtype etamxf) { + return(arkSetMaxEFailGrowth(arkode_mem, etamxf)); } +int ERKStepSetSmallNumEFails(void *arkode_mem, int small_nef) { + return(arkSetSmallNumEFails(arkode_mem, small_nef)); } +int ERKStepSetStabilityFn(void *arkode_mem, ARKExpStabFn EStab, void *estab_data) { + return(arkSetStabilityFn(arkode_mem, EStab, estab_data)); } +int ERKStepSetMaxErrTestFails(void *arkode_mem, int maxnef) { + return(arkSetMaxErrTestFails(arkode_mem, maxnef)); } +int ERKStepSetFixedStep(void *arkode_mem, realtype hfixed) { + return(arkSetFixedStep(arkode_mem, hfixed)); } + + +/*=============================================================== + ERKStep Optional output functions (wrappers for generic ARKode + utility routines). All are documented in arkode_io.c. + ===============================================================*/ + +int ERKStepGetNumStepAttempts(void *arkode_mem, long int *nstep_attempts) { + return(arkGetNumStepAttempts(arkode_mem, nstep_attempts)); } +int ERKStepGetNumSteps(void *arkode_mem, long int *nsteps) { + return(arkGetNumSteps(arkode_mem, nsteps)); } +int ERKStepGetActualInitStep(void *arkode_mem, realtype *hinused) { + return(arkGetActualInitStep(arkode_mem, hinused)); } +int ERKStepGetLastStep(void *arkode_mem, realtype *hlast) { + return(arkGetLastStep(arkode_mem, hlast)); } +int ERKStepGetCurrentStep(void *arkode_mem, realtype *hcur) { + return(arkGetCurrentStep(arkode_mem, hcur)); } +int ERKStepGetCurrentTime(void *arkode_mem, realtype *tcur) { + return(arkGetCurrentTime(arkode_mem, tcur)); } +int ERKStepGetTolScaleFactor(void *arkode_mem, realtype *tolsfact) { + return(arkGetTolScaleFactor(arkode_mem, tolsfact)); } +int ERKStepGetErrWeights(void *arkode_mem, N_Vector eweight) { + return(arkGetErrWeights(arkode_mem, eweight)); } +int ERKStepGetWorkSpace(void *arkode_mem, long int *lenrw, long int *leniw) { + return(arkGetWorkSpace(arkode_mem, lenrw, leniw)); } +int ERKStepGetNumGEvals(void *arkode_mem, long int *ngevals) { + return(arkGetNumGEvals(arkode_mem, ngevals)); } +int ERKStepGetRootInfo(void *arkode_mem, int *rootsfound) { + return(arkGetRootInfo(arkode_mem, rootsfound)); } +int ERKStepGetStepStats(void *arkode_mem, long int *nsteps, + realtype *hinused, realtype *hlast, + realtype *hcur, realtype *tcur) { + return(arkGetStepStats(arkode_mem, nsteps, hinused, hlast, hcur, tcur)); } +int ERKStepGetNumConstrFails(void *arkode_mem, long int *nconstrfails) { + return(arkGetNumConstrFails(arkode_mem, nconstrfails)); } +int ERKStepGetNumExpSteps(void *arkode_mem, long int *nsteps) { + return(arkGetNumExpSteps(arkode_mem, nsteps)); } +int ERKStepGetNumAccSteps(void *arkode_mem, long int *nsteps) { + return(arkGetNumAccSteps(arkode_mem, nsteps)); } +int ERKStepGetNumErrTestFails(void *arkode_mem, long int *netfails) { + return(arkGetNumErrTestFails(arkode_mem, netfails)); } +char *ERKStepGetReturnFlagName(long int flag) { + return(arkGetReturnFlagName(flag)); } + + +/*=============================================================== + ERKStep optional input functions -- stepper-specific + ===============================================================*/ + +/*--------------------------------------------------------------- + ERKStepSetDefaults: + + Resets all ERKStep optional inputs to their default values. + Does not change problem-defining function pointers or + user_data pointer. + ---------------------------------------------------------------*/ +int ERKStepSetDefaults(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepSetDefaults", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Set default ARKode infrastructure parameters */ + retval = arkSetDefaults(arkode_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepSetDefaults", + "Error setting ARKode infrastructure defaults"); + return(retval); + } + + /* Set default values for integrator optional inputs + (overwrite some adaptivity params for ERKStep use) */ + step_mem->q = Q_DEFAULT; /* method order */ + step_mem->p = 0; /* embedding order */ + ark_mem->hadapt_mem->etamxf = RCONST(0.3); /* max change on error-failed step */ + ark_mem->hadapt_mem->imethod = ARK_ADAPT_PI; /* PI controller */ + ark_mem->hadapt_mem->safety = RCONST(0.99); /* step adaptivity safety factor */ + ark_mem->hadapt_mem->bias = RCONST(1.2); /* step adaptivity error bias */ + ark_mem->hadapt_mem->growth = RCONST(25.0); /* step adaptivity growth factor */ + ark_mem->hadapt_mem->k1 = RCONST(0.8); /* step adaptivity parameter */ + ark_mem->hadapt_mem->k2 = RCONST(0.31); /* step adaptivity parameter */ + step_mem->stages = 0; /* no stages */ + step_mem->B = NULL; /* no Butcher table */ + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ERKStepSetOrder: + + Specifies the method order + ---------------------------------------------------------------*/ +int ERKStepSetOrder(void *arkode_mem, int ord) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + sunindextype Blrw, Bliw; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepSetOrder", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set user-provided value, or default, depending on argument */ + if (ord <= 0) { + step_mem->q = Q_DEFAULT; + } else { + step_mem->q = ord; + } + + /* clear Butcher tables, since user is requesting a change in method + or a reset to defaults. Tables will be set in ARKInitialSetup. */ + step_mem->stages = 0; + step_mem->p = 0; + + ARKodeButcherTable_Space(step_mem->B, &Bliw, &Blrw); + ARKodeButcherTable_Free(step_mem->B); + step_mem->B = NULL; + ark_mem->liw -= Bliw; + ark_mem->lrw -= Blrw; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ERKStepSetTable: + + Specifies to use a customized Butcher table for the explicit + portion of the system. + + If d==NULL, then the method is automatically flagged as a + fixed-step method; a user MUST also call either + ERKStepSetFixedStep or ERKStepSetInitStep to set the desired + time step size. + ---------------------------------------------------------------*/ +int ERKStepSetTable(void *arkode_mem, ARKodeButcherTable B) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + sunindextype Blrw, Bliw; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepSetTable", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* check for legal inputs */ + if (B == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepSetTable", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + + /* clear any existing parameters and Butcher tables */ + step_mem->stages = 0; + step_mem->q = 0; + step_mem->p = 0; + + ARKodeButcherTable_Space(step_mem->B, &Bliw, &Blrw); + ARKodeButcherTable_Free(step_mem->B); + step_mem->B = NULL; + ark_mem->liw -= Bliw; + ark_mem->lrw -= Blrw; + + /* set the relevant parameters */ + step_mem->stages = B->stages; + step_mem->q = B->q; + step_mem->p = B->p; + + /* copy the table into step memory */ + step_mem->B = ARKodeButcherTable_Copy(B); + if (step_mem->B == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepSetTable", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + + ARKodeButcherTable_Space(step_mem->B, &Bliw, &Blrw); + ark_mem->liw += Bliw; + ark_mem->lrw += Blrw; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ERKStepSetTableNum: + + Specifies to use a pre-existing Butcher table for the problem, + based on the integer flag passed to ARKodeButcherTable_LoadERK() + within the file arkode_butcher_erk.c. + ---------------------------------------------------------------*/ +int ERKStepSetTableNum(void *arkode_mem, ARKODE_ERKTableID itable) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + sunindextype Blrw, Bliw; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepSetTableNum", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* check that argument specifies an explicit table */ + if (itableARKODE_MAX_ERK_NUM) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepSetTableNum", + "Illegal ERK table number"); + return(ARK_ILL_INPUT); + } + + /* clear any existing parameters and Butcher tables */ + step_mem->stages = 0; + step_mem->q = 0; + step_mem->p = 0; + + ARKodeButcherTable_Space(step_mem->B, &Bliw, &Blrw); + ARKodeButcherTable_Free(step_mem->B); + step_mem->B = NULL; + ark_mem->liw -= Bliw; + ark_mem->lrw -= Blrw; + + /* fill in table based on argument */ + step_mem->B = ARKodeButcherTable_LoadERK(itable); + if (step_mem->B == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepSetTableNum", + "Error setting table with that index"); + return(ARK_ILL_INPUT); + } + step_mem->stages = step_mem->B->stages; + step_mem->q = step_mem->B->q; + step_mem->p = step_mem->B->p; + + ARKodeButcherTable_Space(step_mem->B, &Bliw, &Blrw); + ark_mem->liw += Bliw; + ark_mem->lrw += Blrw; + + return(ARK_SUCCESS); +} + + +/*=============================================================== + ERKStep optional output functions -- stepper-specific + ===============================================================*/ + +/*--------------------------------------------------------------- + ERKStepGetNumRhsEvals: + + Returns the current number of calls to fe and fi + ---------------------------------------------------------------*/ +int ERKStepGetNumRhsEvals(void *arkode_mem, long int *fevals) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepGetNumRhsEvals", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* get values from step_mem */ + *fevals = step_mem->nfe; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ERKStepGetCurrentButcherTable: + + Sets pointers to the Butcher table currently in use. + ---------------------------------------------------------------*/ +int ERKStepGetCurrentButcherTable(void *arkode_mem, + ARKodeButcherTable *B) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepGetCurrentButcherTable", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* get tables from step_mem */ + *B = step_mem->B; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ERKStepGetEstLocalErrors: (updated to the correct vector, but + need to verify that it is unchanged between filling the + estimated error and the end of the time step) + + Returns an estimate of the local error + ---------------------------------------------------------------*/ +int ERKStepGetEstLocalErrors(void *arkode_mem, N_Vector ele) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepGetEstLocalErrors", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* copy vector to output */ + N_VScale(ONE, ark_mem->tempv1, ele); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ERKStepGetTimestepperStats: + + Returns integrator statistics + ---------------------------------------------------------------*/ +int ERKStepGetTimestepperStats(void *arkode_mem, long int *expsteps, + long int *accsteps, long int *attempts, + long int *fevals, long int *netfails) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepGetTimestepperStats", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set expsteps and accsteps from adaptivity structure */ + *expsteps = ark_mem->hadapt_mem->nst_exp; + *accsteps = ark_mem->hadapt_mem->nst_acc; + + /* set remaining outputs */ + *attempts = ark_mem->nst_attempts; + *fevals = step_mem->nfe; + *netfails = ark_mem->netf; + + return(ARK_SUCCESS); +} + + +/*=============================================================== + ERKStep parameter output + ===============================================================*/ + +/*--------------------------------------------------------------- + ERKStepWriteParameters: + + Outputs all solver parameters to the provided file pointer. + ---------------------------------------------------------------*/ +int ERKStepWriteParameters(void *arkode_mem, FILE *fp) +{ + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + int retval; + + /* access ARKodeARKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepWriteParameters", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* output ARKode infrastructure parameters first */ + retval = arkWriteParameters(arkode_mem, fp); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepWriteParameters", + "Error writing ARKode infrastructure parameters"); + return(retval); + } + + /* print integrator parameters to file */ + STAN_SUNDIALS_FPRINTF(fp, "ERKStep time step module parameters:\n"); + STAN_SUNDIALS_FPRINTF(fp, " Method order %i\n",step_mem->q); + STAN_SUNDIALS_FPRINTF(fp, "\n"); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + ERKStepWriteButcher: + + Outputs Butcher tables to the provided file pointer. + ---------------------------------------------------------------*/ +int ERKStepWriteButcher(void *arkode_mem, FILE *fp) +{ + int retval; + ARKodeMem ark_mem; + ARKodeERKStepMem step_mem; + + /* access ARKodeARKStepMem structure */ + retval = erkStep_AccessStepMem(arkode_mem, "ERKStepWriteButcher", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* check that Butcher table is non-NULL (otherwise report error) */ + if (step_mem->B == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::ERKStep", + "ERKStepWriteButcher", "Butcher table memory is NULL"); + return(ARK_MEM_NULL); + } + + /* print Butcher table to file */ + STAN_SUNDIALS_FPRINTF(fp, "\nERKStep Butcher table (stages = %i):\n", step_mem->stages); + ARKodeButcherTable_Write(step_mem->B, fp); + STAN_SUNDIALS_FPRINTF(fp, "\n"); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + EOF + ---------------------------------------------------------------*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_impl.h b/lib/sundials_6.1.1/src/arkode/arkode_impl.h new file mode 100644 index 00000000000..c4eb48eebce --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_impl.h @@ -0,0 +1,1122 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * Implementation header file for the main ARKode integrator. + *--------------------------------------------------------------*/ + +#ifndef _ARKODE_IMPL_H +#define _ARKODE_IMPL_H + +#include +#include +#include +#include "arkode_adapt_impl.h" +#include "arkode_root_impl.h" +#include +#include +#include "sundials_context_impl.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +#if defined(SUNDIALS_EXTENDED_PRECISION) +#define RSYM ".32Lg" +#define RSYMW "41.32Lg" +#else +#define RSYM ".16g" +#define RSYMW "23.16g" +#endif + +/*=============================================================== + ARKode Private Constants + ===============================================================*/ + +/* Basic ARKode defaults */ +#define Q_DEFAULT 4 /* method order */ +#define MXSTEP_DEFAULT 500 /* max steps between returns */ +#define MAXNEF 7 /* max number of error failures */ +#define MAXNCF 10 /* max number of convergence failures */ +#define MAXCONSTRFAILS 10 /* max number of constraint failures */ +#define MXHNIL 10 /* max number of t+h==h warnings */ + +/* Numeric constants */ +#define ZERO RCONST(0.0) /* real 0.0 */ +#define TINY RCONST(1.0e-10) /* small number */ +#define TENTH RCONST(0.1) /* real 0.1 */ +#define HALF RCONST(0.5) /* real 0.5 */ +#define ONE RCONST(1.0) /* real 1.0 */ +#define TWO RCONST(2.0) /* real 2.0 */ +#define FOUR RCONST(4.0) /* real 4.0 */ +#define FIVE RCONST(5.0) /* real 5.0 */ + +/* Control constants for tolerances */ +#define ARK_SS 0 +#define ARK_SV 1 +#define ARK_WF 2 + + +/*=============================================================== + ARKode Routine-Specific Constants + ===============================================================*/ + +/*--------------------------------------------------------------- + Initialization types + ---------------------------------------------------------------*/ +#define FIRST_INIT 0 /* first step (re-)initialization */ +#define RESET_INIT 1 /* reset initialization */ +#define RESIZE_INIT 2 /* resize initialization */ + +/*--------------------------------------------------------------- + Control constants for lower-level time-stepping functions + ---------------------------------------------------------------*/ +#define PREDICT_AGAIN +3 +#define CONV_FAIL +4 +#define TRY_AGAIN +5 +#define FIRST_CALL +6 +#define PREV_CONV_FAIL +7 +#define PREV_ERR_FAIL +8 +#define RHSFUNC_RECVR +9 +#define CONSTR_RECVR +10 + +/*--------------------------------------------------------------- + Return values for lower-level rootfinding functions + ---------------------------------------------------------------*/ +#define RTFOUND +1 +#define CLOSERT +3 + + +/*--------------------------------------------------------------- + Algorithmic constants + --------------------------------------------------------------- + ARKodeGetDky and arkStep: FUZZ_FACTOR + + arkHin: H0_LBFACTOR, H0_UBFACTOR, H0_BIAS and H0_ITERS + + time comparison factors: + ONEPSM safety factor for floating point comparisons + ONEMSM safety factor for floating point comparisons + ---------------------------------------------------------------*/ +#define FUZZ_FACTOR RCONST(100.0) + +#define H0_LBFACTOR RCONST(100.0) +#define H0_UBFACTOR RCONST(0.1) +#define H0_BIAS HALF +#define H0_ITERS 4 + +#define ONEPSM RCONST(1.000001) +#define ONEMSM RCONST(0.999999) + + +/*=============================================================== + ARKode Interface function definitions + ===============================================================*/ + +/* NOTE: documentation for the purpose of these functions is + located at the end of this file */ + +/* linear solver interface functions */ +typedef int (*ARKLinsolInitFn)(void* arkode_mem); +typedef int (*ARKLinsolSetupFn)(void* arkode_mem, int convfail, + realtype tpred, N_Vector ypred, + N_Vector fpred, + booleantype *jcurPtr, + N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3); +typedef int (*ARKLinsolSolveFn)(void* arkode_mem, N_Vector b, + realtype tcur, N_Vector ycur, + N_Vector fcur, realtype client_tol, + int mnewt); +typedef int (*ARKLinsolFreeFn)(void* arkode_mem); + +/* mass-matrix solver interface functions */ +typedef int (*ARKMassInitFn)(void *arkode_mem); +typedef int (*ARKMassSetupFn)(void *arkode_mem, realtype t, + N_Vector vtemp1, N_Vector vtemp2, + N_Vector vtemp3); +typedef int (*ARKMassMultFn)(void *arkode_mem, N_Vector v, + N_Vector Mv); +typedef int (*ARKMassSolveFn)(void *arkode_mem, N_Vector b, + realtype client_tol); +typedef int (*ARKMassFreeFn)(void *arkode_mem); + +/* time stepper interface functions */ +typedef int (*ARKTimestepInitFn)(void* arkode_mem, int init_type); +typedef int (*ARKTimestepAttachLinsolFn)(void* arkode_mem, + ARKLinsolInitFn linit, + ARKLinsolSetupFn lsetup, + ARKLinsolSolveFn lsolve, + ARKLinsolFreeFn lfree, + SUNLinearSolver_Type lsolve_type, + void *lmem); +typedef int (*ARKTimestepAttachMasssolFn)(void* arkode_mem, + ARKMassInitFn minit, + ARKMassSetupFn msetup, + ARKMassMultFn mmult, + ARKMassSolveFn msolve, + ARKMassFreeFn mfree, + booleantype time_dep, + SUNLinearSolver_Type msolve_type, + void *mass_mem); +typedef void (*ARKTimestepDisableLSetup)(void* arkode_mem); +typedef void (*ARKTimestepDisableMSetup)(void* arkode_mem); +typedef void* (*ARKTimestepGetLinMemFn)(void* arkode_mem); +typedef void* (*ARKTimestepGetMassMemFn)(void* arkode_mem); +typedef ARKRhsFn (*ARKTimestepGetImplicitRHSFn)(void* arkode_mem); +typedef int (*ARKTimestepGetGammasFn)(void* arkode_mem, + realtype *gamma, + realtype *gamrat, + booleantype **jcur, + booleantype *dgamma_fail); +typedef int (*ARKTimestepFullRHSFn)(void* arkode_mem, realtype t, + N_Vector y, N_Vector f, int mode); +typedef int (*ARKTimestepStepFn)(void* arkode_mem, realtype *dsm, + int *nflag); + + +/*=============================================================== + ARKode interpolation module definition + ===============================================================*/ + +/* Forward reference for pointer to ARKInterp_Ops object */ +typedef struct _generic_ARKInterpOps *ARKInterpOps; + +/* Forward reference for pointer to ARKInterp object */ +typedef struct _generic_ARKInterp *ARKInterp; + +/* Structure containing function pointers to interpolation operations */ +struct _generic_ARKInterpOps { + int (*resize)(void* arkode_mem, ARKInterp interp, + ARKVecResizeFn resize, void *resize_data, + sunindextype lrw_diff, sunindextype liw_diff, + N_Vector tmpl); + void (*free)(void* arkode_mem, ARKInterp interp); + void (*print)(ARKInterp interp, FILE *outfile); + int (*setdegree)(void *arkode_mem, ARKInterp interp, int degree); + int (*init)(void* arkode_mem, ARKInterp interp, realtype tnew); + int (*update)(void* arkode_mem, ARKInterp interp, realtype tnew); + int (*evaluate)(void* arkode_mem, ARKInterp interp, + realtype tau, int d, int order, N_Vector yout); +}; + +/* An interpolation module consists of an implementation-dependent 'content' + structure, and a pointer to a structure of implementation-dependent operations. */ +struct _generic_ARKInterp { + void *content; + ARKInterpOps ops; +}; + +/* ARKInterp module functions */ +int arkInterpResize(void* arkode_mem, ARKInterp interp, + ARKVecResizeFn resize, void *resize_data, + sunindextype lrw_diff, sunindextype liw_diff, + N_Vector tmpl); +void arkInterpFree(void* arkode_mem, ARKInterp interp); +void arkInterpPrintMem(ARKInterp interp, FILE *outfile); +int arkInterpSetDegree(void *arkode_mem, ARKInterp interp, int degree); +int arkInterpInit(void* arkode_mem, ARKInterp interp, realtype tnew); +int arkInterpUpdate(void* arkode_mem, ARKInterp interp, realtype tnew); +int arkInterpEvaluate(void* arkode_mem, ARKInterp interp, + realtype tau, int d, int order, N_Vector yout); + + +/*=============================================================== + ARKode data structures + ===============================================================*/ + +/*--------------------------------------------------------------- + Types : struct ARKodeMassMemRec, ARKodeMassMem + --------------------------------------------------------------- + The type ARKodeMassMem is type pointer to struct + ARKodeMassMemRec. This structure contains data pertaining to + the use of a non-identity mass matrix. + ---------------------------------------------------------------*/ +typedef struct ARKodeMassMemRec { + + /* mass matrix linear solver interface function pointers */ + ARKMassInitFn minit; + ARKMassSetupFn msetup; + ARKMassMultFn mmult; + ARKMassSolveFn msolve; + ARKMassFreeFn mfree; + void* sol_mem; /* mass matrix solver interface data */ + int msolve_type; /* mass matrix interface type: + 0=iterative; 1=direct; 2=custom */ + +} *ARKodeMassMem; + + +/*--------------------------------------------------------------- + Types : struct ARKodeMemRec, ARKodeMem + --------------------------------------------------------------- + The type ARKodeMem is type pointer to struct ARKodeMemRec. + This structure contains fields to keep track of problem state. + ---------------------------------------------------------------*/ +typedef struct ARKodeMemRec { + + SUNContext sunctx; + + realtype uround; /* machine unit roundoff */ + + /* Problem specification data */ + void *user_data; /* user ptr passed to supplied functions */ + int itol; /* itol = ARK_SS (scalar, default), + ARK_SV (vector), + ARK_WF (user weight function) */ + int ritol; /* itol = ARK_SS (scalar, default), + ARK_SV (vector), + ARK_WF (user weight function) */ + realtype reltol; /* relative tolerance */ + realtype Sabstol; /* scalar absolute solution tolerance */ + N_Vector Vabstol; /* vector absolute solution tolerance */ + booleantype atolmin0; /* flag indicating that min(abstol) = 0 */ + realtype SRabstol; /* scalar absolute residual tolerance */ + N_Vector VRabstol; /* vector absolute residual tolerance */ + booleantype Ratolmin0; /* flag indicating that min(Rabstol) = 0 */ + booleantype user_efun; /* SUNTRUE if user sets efun */ + ARKEwtFn efun; /* function to set ewt */ + void *e_data; /* user pointer passed to efun */ + booleantype user_rfun; /* SUNTRUE if user sets rfun */ + ARKRwtFn rfun; /* function to set rwt */ + void *r_data; /* user pointer passed to rfun */ + booleantype constraintsSet; /* check inequality constraints */ + + /* Time stepper module */ + ARKTimestepAttachLinsolFn step_attachlinsol; + ARKTimestepAttachMasssolFn step_attachmasssol; + ARKTimestepDisableLSetup step_disablelsetup; + ARKTimestepDisableMSetup step_disablemsetup; + ARKTimestepGetLinMemFn step_getlinmem; + ARKTimestepGetMassMemFn step_getmassmem; + ARKTimestepGetImplicitRHSFn step_getimplicitrhs; + ARKMassMultFn step_mmult; + ARKTimestepGetGammasFn step_getgammas; + ARKTimestepInitFn step_init; + ARKTimestepFullRHSFn step_fullrhs; + ARKTimestepStepFn step; + void *step_mem; + + /* N_Vector storage */ + N_Vector ewt; /* error weight vector */ + N_Vector rwt; /* residual weight vector */ + booleantype rwt_is_ewt; /* SUNTRUE if rwt is a pointer to ewt */ + N_Vector ycur; /* pointer to user-provided solution memory; used + as evolving solution by the timestepper modules */ + N_Vector yn; /* solution from the last successful step */ + N_Vector fn; /* full IVP right-hand side from last step */ + N_Vector tempv1; /* temporary storage vectors (for local use and by */ + N_Vector tempv2; /* time-stepping modules) */ + N_Vector tempv3; + N_Vector tempv4; + + N_Vector constraints; /* vector of inequality constraint options */ + + /* Temporal interpolation module */ + ARKInterp interp; + + /* Tstop information */ + booleantype tstopset; + realtype tstop; + + /* Time step data */ + realtype hin; /* initial step size */ + realtype h; /* current step size */ + realtype hmin; /* |h| >= hmin */ + realtype hmax_inv; /* |h| <= 1/hmax_inv */ + realtype hprime; /* next actual step size to be used */ + realtype next_h; /* next dynamical step size (only used in + getCurrenStep); note that this could + overtake tstop */ + realtype eta; /* eta = hprime / h */ + realtype tcur; /* current internal value of t + (changes with each stage) */ + realtype tretlast; /* value of tret last returned by ARKode */ + booleantype fixedstep; /* flag to disable temporal adaptivity */ + ARKodeHAdaptMem hadapt_mem; /* time step adaptivity structure */ + + + /* Limits and various solver parameters */ + long int mxstep; /* max number of internal steps for one user call */ + int mxhnil; /* max number of warning messages issued to the + user that t+h == t for the next internal step */ + int maxconstrfails; /* max number of constraint check failures */ + int maxnef; /* max error test fails in one step */ + int maxncf; /* max num alg. solver conv. fails in one step */ + + /* Counters */ + long int nst_attempts; /* number of attempted steps */ + long int nst; /* number of internal steps taken */ + int nhnil; /* number of messages issued to the user that + t+h == t for the next iternal step */ + long int ncfn; /* num corrector convergence failures */ + long int netf; /* num error test failures */ + long int nconstrfails; /* number of constraint failures */ + + /* Diagnostic output */ + booleantype report; /* flag to enable/disable diagnostic output */ + FILE *diagfp; /* diagnostic outputs are sent to diagfp */ + + /* Space requirements for ARKode */ + sunindextype lrw1; /* no. of realtype words in 1 N_Vector */ + sunindextype liw1; /* no. of integer words in 1 N_Vector */ + long int lrw; /* no. of realtype words in ARKode work vectors */ + long int liw; /* no. of integer words in ARKode work vectors */ + + /* Saved Values */ + realtype h0u; /* actual initial stepsize */ + realtype tn; /* time of last successful step */ + realtype hold; /* last successful h value used */ + realtype tolsf; /* tolerance scale factor (suggestion to user) */ + booleantype VabstolMallocDone; + booleantype VRabstolMallocDone; + booleantype MallocDone; + booleantype initsetup; /* denotes a call to InitialSetup is needed */ + int init_type; /* initialization type (see constants above) */ + booleantype firststage; /* denotes first stage in simulation */ + booleantype initialized; /* denotes arkInitialSetup has been done */ + booleantype call_fullrhs; /* denotes fn needs updating after each step */ + + /* Error handler function and error ouput file */ + ARKErrHandlerFn ehfun; /* error messages are handled by ehfun */ + void *eh_data; /* data pointer passed to ehfun */ + FILE *errfp; /* ARKode error messages are sent to errfp */ + + /* Rootfinding Data */ + ARKodeRootMem root_mem; /* root-finding structure */ + + /* User-supplied step solution post-processing function */ + ARKPostProcessFn ProcessStep; + void* ps_data; /* pointer to user_data */ + + /* User-supplied stage solution post-processing function */ + ARKPostProcessFn ProcessStage; + + /* XBraid interface variables */ + booleantype force_pass; /* when true the step attempt loop will ignore the + return value (kflag) from arkCheckTemporalError + and set kflag = ARK_SUCCESS to force the step + attempt to always pass (if a solver failure did + not occur before the error test). */ + int last_kflag; /* last value of the return flag (kflag) from a call + to arkCheckTemporalError. This is only set when + force_pass is true and is used by the XBraid + interface to determine if a time step passed or + failed the time step error test. */ +} *ARKodeMem; + + + +/*=============================================================== + Interface To Linear Solvers + ===============================================================*/ + +/*--------------------------------------------------------------- + Communication between ARKode and a ARKode Linear Solver + ----------------------------------------------------------------- + convfail (input to lsetup) + + ARK_NO_FAILURES : Either this is the first lsetup call for + this step, or the local error test failed on + the previous attempt at this step (but the + Newton iteration converged). + + ARK_FAIL_BAD_J : This value is passed to lsetup if + + (a) The previous Newton corrector iteration + did not converge and the linear solver's + setup routine indicated that its Jacobian- + related data is not current + or + (b) During the previous Newton corrector + iteration, the linear solver's solve + routine failed in a recoverable manner + and the linear solver's setup routine + indicated that its Jacobian-related data + is not current. + + ARK_FAIL_OTHER : During the current internal step try, the + previous Newton iteration failed to converge + even though the linear solver was using + current Jacobian-related data. + --------------------------------------------------------------*/ + +/* Constants for convfail (input to lsetup) */ +#define ARK_NO_FAILURES 0 +#define ARK_FAIL_BAD_J 1 +#define ARK_FAIL_OTHER 2 + +/*--------------------------------------------------------------- + ARKLinsolInitFn + --------------------------------------------------------------- + This function should complete initializations for a specific + ARKode linear solver interface, such as counters and statistics. + This should return 0 if it has successfully initialized the + ARKode linear solver interface and a negative value otherwise. + If an error does occur, an appropriate message should be sent + to the error handler function. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKLinsolSetupFn + --------------------------------------------------------------- + This function should prepare the linear solver interface for + subsequent calls to the ARKLinsolSolveFn routine. It may + recompute Jacobian-related data is it deems necessary. Its + parameters are as follows: + + arkode_mem - void* problem memory pointer of type ARKodeMem. See + the typedef earlier in this file. + + convfail - a flag to indicate any problem that occurred during + the solution of the nonlinear equation on the + current time step for which the linear solver is + being used. This flag can be used to help decide + whether the Jacobian data kept by a ARKode linear + solver needs to be updated or not. + Its possible values have been documented above. + + tpred - the time for the current ARKode internal step. + + ypred - the predicted y vector for the current ARKode internal + step. + + fpred - f(tpred, ypred). + + jcurPtr - a pointer to a boolean to be filled in by lsetup. + The function should set *jcurPtr=SUNTRUE if its Jacobian + data is current after the call and should set + *jcurPtr=SUNFALSE if its Jacobian data is not current. + Note: If lsetup calls for re-evaluation of + Jacobian data (based on convfail and ARKode state + data), it should return *jcurPtr=SUNTRUE always; + otherwise an infinite loop can result. + + vtemp1 - temporary N_Vector provided for use by lsetup. + + vtemp3 - temporary N_Vector provided for use by lsetup. + + vtemp3 - temporary N_Vector provided for use by lsetup. + + This routine should return 0 if successful, a positive value + for a recoverable error, and a negative value for an + unrecoverable error. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKLinsolSolveFn + --------------------------------------------------------------- + This routine must solve the linear equation P x = b, where + P is some approximation to (M - gamma J), M is the system mass + matrix, J = (df/dy)(tcur,ycur), and the RHS vector b is input. The + N-vector ycur contains the solver's current approximation to + y(tcur) and the vector fcur contains the N_Vector f(tcur,ycur). + The input client_tol contains the desired accuracy (in the wrms + norm) of the routine calling the solver; the ARKDLS solver + ignores this value and the ARKSPILS solver tightens it by the + factor eplifac. The input mnewt is the current nonlinear + iteration index (ignored by ARKDLS, used by ARKSPILS). + + Additional vectors that are set within the ARKode memory + structure, and that may be of use within an iterative linear + solver, include: + + ewt - the error weight vector (scaling for solution vector) + + rwt - the residual weight vector (scaling for rhs vector) + + The solution is to be returned in the vector b. This should + return a positive value for a recoverable error and a + negative value for an unrecoverable error. Success is + indicated by a 0 return value. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKLinsolFreeFn + --------------------------------------------------------------- + This should free up any memory allocated by the linear solver + interface. This routine is called once a problem has been + completed and the linear solver is no longer needed. It should + return 0 upon success, or a nonzero on failure. + ---------------------------------------------------------------*/ + + + +/*--------------------------------------------------------------- + ARKMassInitFn + --------------------------------------------------------------- + This function should complete initializations for a specific + mass matrix linear solver interface, such as counters and + statistics. A function of this type should return 0 if it + has successfully initialized the mass matrix linear solver and + a negative value otherwise. If an error does occur, an + appropriate message should be sent to the error handler function. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKMassSetupFn + --------------------------------------------------------------- + This should prepare the mass matrix solver interface for + subsequent calls to the ARKMassMultFn and ARKMassSolveFn + routines. It may recompute mass matrix related data is it deems + necessary. Its parameters are as follows: + + arkode_mem - void* problem memory pointer of type ARKodeMem. See + the typedef earlier in this file. + t - the 'time' at which to setup the mass matrix + vtemp1, vtemp2, vtemp3 - temporary N_Vectors + + This routine should return 0 if successful, and a negative + value for an unrecoverable error. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKMassMultFn + --------------------------------------------------------------- + This must compute the matrix-vector product, z = M*v, where M is + the system mass matrix the vector v is input, and the vector z + is output. The mmult routine returns a positive value for a + recoverable error and a negative value for an unrecoverable + error. Success is indicated by a 0 return value. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKMassSolveFn + --------------------------------------------------------------- + This must solve the linear equation M x = b, where M is the + system mass matrix, and the RHS vector b is input. The + realtype client_tol contains the desired accuracy (in the wrms + norm) of the routine calling the solver; the ARKDLS solver + ignore this value and the ARKSPILS solver tightens it by the + factor eplifac. The solution is to be returned in the vector b. + + Additional vectors that are set within the ARKode memory + structure, and that may be of use within an iterative linear + solver, include: + + ewt - the error weight vector (scaling for solution vector) + + rwt - the residual weight vector (scaling for rhs vector) + + This routine should return a positive value for a recoverable + error and a negative value for an unrecoverable error. Success + is indicated by a 0 return value. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKMassFreeFn + --------------------------------------------------------------- + This should free up any memory allocated by the mass matrix + solver interface. This routine is called once a problem has been + completed and the solver is no longer needed. It should return + 0 upon success, or a nonzero on failure. + ---------------------------------------------------------------*/ + + + + +/*=============================================================== + Interface to Time Steppers + ===============================================================*/ + +/*--------------------------------------------------------------- + ARKTimestepAttachLinsolFn + --------------------------------------------------------------- + This routine should attach the various set of system linear + solver interface routines, linear solver interface data + structure, and system linear solver type to the ARKode time + stepping module pointed to in ark_mem->step_mem. This will + be called by the ARKode linear solver interface. + + This routine should return 0 if it has successfully attached + these items and a negative value otherwise. If an error does + occur, an appropriate message should be sent to the ARKode + error handler function. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKTimestepAttachMasssolFn + --------------------------------------------------------------- + This routine should attach the various set of mass matrix + linear solver interface routines, data structure, mass matrix + type, and solver type to the ARKode time stepping module + pointed to in ark_mem->step_mem. This will be called by the + ARKode linear solver interface. + + This routine should return 0 if it has successfully attached + these items, and a negative value otherwise. If an error does + occur, an appropriate message should be sent to the ARKode + error handler function. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKTimestepDisableLSetup + --------------------------------------------------------------- + This routine should NULLify any ARKLinsolSetupFn function + pointer stored in the ARKode time stepping module (initially set + in a call to ARKTimestepAttachLinsolFn). + + This routine has no return value. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKTimestepDisableMSetup + --------------------------------------------------------------- + This routine should NULLify any ARKMassSetupFn function pointer + stored in the ARKode time stepping module (initially set in a + call to ARKTimestepAttachMasssolFn). + + This routine has no return value. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKTimestepGetLinMemFn + --------------------------------------------------------------- + This routine should return the linear solver memory structure + used by the ARKode time stepping module pointed to in + ark_mem->step_mem. This will be called by the ARKode linear + solver interface. + + This routine should return NULL if no linear solver memory + structure is attached. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKTimestepGetMassMemFn + --------------------------------------------------------------- + This routine should return the mass matrix linear solver memory + structure used by the ARKode time stepping module pointed to in + ark_mem->step_mem. This will be called the ARKode mass matrix + solver interface. + + This routine should return NULL if no mass matrix solver memory + structure is attached. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKTimestepGetImplicitRHSFn + --------------------------------------------------------------- + This routine should return the implicit RHS function pointer for + the current nonlinear solve (if there are multiple); it is used + inside the linear solver interfaces for approximation of + Jacobian matrix elements and/or matrix-vector products. + + This routine should return NULL if no implicit RHS function is + active. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKTimestepGetGammasFn + --------------------------------------------------------------- + This routine should fill the current value of gamma, the ratio + of the current gamma value to the gamma value when the + Jacobian/preconditioner was last updated, a pointer to the + time step module internal booleantype variable indicating + whether the preconditioner is current, and a logic value + indicating whether the gamma value is sufficiently stale + to cause recomputation of Jacobian/preconditioner data. Here, + gamma is the coefficient preceding the RHS Jacobian + matrix, J, in the full nonlinear system Jacobian, + A = M - gamma*J. + + The time step module must contain a booleantype variable to + provide for the boolentype pointer (jcur). This is only used + by iterative linear solvers, so could be NULL for time step + modules that only work with direct linear solvers. Optionally, + the value of this parameter could be set to SUNFALSE prior to + return from the ARKTimestepGetGammasFn to force recalculation + of preconditioner information. + + The value of the logic flag is used as follows: if a previous + Newton iteration failed due to a bad Jacobian/preconditioner, + and this flag is SUNFALSE, this will trigger recalculation of + the Jacobian/preconditioner. + + This routine should return 0 if it has successfully attached + these items, and a negative value otherwise. If an error does + occur, an appropriate message should be sent to the ARKode + error handler function. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKTimestepInitFn + --------------------------------------------------------------- + This routine is called just prior to performing internal time + steps (after all user "set" routines have been called) from + within arkInitialSetup. It should complete initializations for + a specific ARKode time stepping module, such as verifying + compatibility of user-specified linear and nonlinear solver + objects. The input init_type flag indicates if the call is + for (re-)initializing, resizing, or resetting the problem. + + This routine should return 0 if it has successfully initialized + the ARKode time stepper module and a negative value otherwise. + If an error does occur, an appropriate message should be sent + to the error handler function. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKTimestepFullRHSFn + --------------------------------------------------------------- + This routine must compute the full ODE right-hand side function + at the inputs (t,y), and store the result in the N_Vector f. + Depending on the type of stepper, this may be just the single + ODE RHS function supplied (e.g. ERK, DIRK, IRK), or it may be + the sum of many ODE RHS functions (e.g. ARK, MRI). The 'mode' + indicates where this routine is called: + ARK_FULLRHS_START -> called at the beginning of a simulation + ARK_FULLRHS_END -> called at the end of a successful step + ARK_FULLRHS_OTHER -> called elsewhere (e.g. for dense output) + It is recommended that the stepper use the mode information to + maximize reuse between calls to this function and RHS + evaluations inside the stepper itself. + + This routine should return 0 if successful, and a negative value + otherwise. If an error does occur, an appropriate message + should be sent to the error handler function. + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + ARKTimestepStepFn + --------------------------------------------------------------- + This routine serves the primary purpose of any ARKode + time-stepping module: it performs a single time step of the + method (with embedding, if possible). + + It is assumed that this routine uses/modifies general problem + data directly out of the main ARKodeMem structure, but that all + method-specific data be stored in the step-module-specific data + structure. Relevant items in the ARKodeMem structure for this + purpose include: + - tcur -- the current "t" value + - ycur -- the current "y" value on input; should hold the + time-evolved solution on output + - h -- the suggested/maximum "h" value to use; if the step + eventually completes with a smaller "h" value, then that + should be stored here + - tn -- "t" value at end of the last successful step + - nst -- the counter for overall successful steps + - user_data -- the (void *) pointer returned to user for + RHS calls + - report / diagfp -- if any diagnostic information is + to be saved to disk, the report flag indicates whether + this is enabled, and diagfp provides the file pointer + where this information should be written + + The output variable dsmPtr should contain estimate of the + weighted local error if an embedding is present; otherwise it + should be 0. + + The input/output variable nflagPtr is used to gauge convergence + of any algebraic solvers within the step. At the start of a new + time step, this will initially have the value FIRST_CALL. On + return from this function, nflagPtr should have a value: + 0 => algebraic solve completed successfully + >0 => solve did not converge at this step size + (but may with a smaller stepsize) + <0 => solve encountered an unrecoverable failure + + 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 + ---------------------------------------------------------------*/ + + +/*=============================================================== + ARKode PROTOTYPE FUNCTIONS (MAY BE REPLACED BY USER) + ===============================================================*/ + +/* Prototype of internal rwtSet function */ +int arkRwtSet(N_Vector ycur, N_Vector weight, void *data); + +/* Prototype of internal errHandler function */ +void arkErrHandler(int error_code, const char *module, + const char *function, char *msg, void *data); + +/* Prototype of internal explicit stability estimation function */ +int arkExpStab(N_Vector y, realtype t, realtype *hstab, void *user_data); + +/*=============================================================== + HIGH LEVEL ERROR HANDLER, USED THROUGHOUT ARKode + ===============================================================*/ + +void arkProcessError(ARKodeMem ark_mem, int error_code, + const char *module, const char *fname, + const char *msgfmt, ...); + +/*=============================================================== + ARKode PRIVATE FUNCTION PROTOTYPES + ===============================================================*/ +#ifdef __GNUC__ +#define SUNDIALS_UNUSED __attribute__ ((unused)) +#else +#define SUNDIALS_UNUSED +#endif + +int arkInit(ARKodeMem ark_mem, realtype t0, N_Vector y0, int init_type); +booleantype arkAllocVec(ARKodeMem ark_mem, N_Vector tmpl, N_Vector *v); +booleantype arkAllocVecArray(int count, N_Vector tmpl, N_Vector **v, + sunindextype lrw1, long int *lrw, + sunindextype liw1, long int *liw); +void arkFreeVec(ARKodeMem ark_mem, N_Vector *v); +void arkFreeVecArray(int count, N_Vector **v, + sunindextype lrw1, long int *lrw, + sunindextype liw1, long int *liw); +booleantype arkResizeVec(ARKodeMem ark_mem, + ARKVecResizeFn resize, + void *resize_data, + sunindextype lrw_diff, + sunindextype liw_diff, + N_Vector tmpl, + N_Vector *v); +booleantype arkResizeVecArray(ARKVecResizeFn resize, void *resize_data, + int count, N_Vector tmpl, N_Vector **v, + sunindextype lrw_diff, long int *lrw, + sunindextype liw_diff, long int *liw); +void arkPrintMem(ARKodeMem ark_mem, FILE *outfile); +booleantype arkCheckTimestepper(ARKodeMem ark_mem); +booleantype arkCheckNvector(N_Vector tmpl); +booleantype arkAllocVectors(ARKodeMem ark_mem, + N_Vector tmpl); +booleantype arkResizeVectors(ARKodeMem ark_mem, + ARKVecResizeFn resize, + void *resize_data, + sunindextype lrw_diff, + sunindextype liw_diff, + N_Vector tmpl); +void arkFreeVectors(ARKodeMem ark_mem); + +int arkInitialSetup(ARKodeMem ark_mem, realtype tout); +int arkStopTests(ARKodeMem ark_mem, realtype tout, N_Vector yout, + realtype *tret, int itask, int *ier); +int arkHin(ARKodeMem ark_mem, realtype tout); +realtype arkUpperBoundH0(ARKodeMem ark_mem, + realtype tdist); +int arkYddNorm(ARKodeMem ark_mem, realtype hg, + realtype *yddnrm); + +int arkCompleteStep(ARKodeMem ark_mem, realtype dsm); +int arkHandleFailure(ARKodeMem ark_mem,int flag); + +int arkEwtSetSS(N_Vector ycur, N_Vector weight, void* arkode_mem); +int arkEwtSetSV(N_Vector ycur, N_Vector weight, void* arkode_mem); +int arkEwtSetSmallReal(N_Vector ycur, N_Vector weight, void* arkode_mem); +int arkRwtSetSS(ARKodeMem ark_mem, N_Vector My, + N_Vector weight); +int arkRwtSetSV(ARKodeMem ark_mem, N_Vector My, + N_Vector weight); + +ARKodeMem arkCreate(SUNContext sunctx); +int arkResize(ARKodeMem ark_mem, N_Vector ynew, realtype hscale, + realtype t0, ARKVecResizeFn resize, void *resize_data); +int arkSStolerances(ARKodeMem ark_mem, realtype reltol, realtype abstol); +int arkSVtolerances(ARKodeMem ark_mem, realtype reltol, N_Vector abstol); +int arkWFtolerances(ARKodeMem ark_mem, ARKEwtFn efun); +int arkResStolerance(ARKodeMem ark_mem, realtype rabstol); +int arkResVtolerance(ARKodeMem ark_mem, N_Vector rabstol); +int arkResFtolerance(ARKodeMem ark_mem, ARKRwtFn rfun); +int arkRootInit(ARKodeMem ark_mem, int nrtfn, ARKRootFn g); +int arkEvolve(ARKodeMem ark_mem, realtype tout, N_Vector yout, + realtype *tret, int itask); +int arkGetDky(ARKodeMem ark_mem, realtype t, int k, N_Vector dky); +void arkFree(void **arkode_mem); + +int arkWriteParameters(ARKodeMem ark_mem, FILE *fp); +int arkPredict_MaximumOrder(ARKodeMem ark_mem, realtype tau, + N_Vector yguess); +int arkPredict_VariableOrder(ARKodeMem ark_mem, realtype tau, + N_Vector yguess); +int arkPredict_CutoffOrder(ARKodeMem ark_mem, realtype tau, + N_Vector yguess); +int arkPredict_Bootstrap(ARKodeMem ark_mem, realtype hj, + realtype tau, int nvec, realtype *cvals, + N_Vector *Xvecs, N_Vector yguess); +int arkCheckConvergence(ARKodeMem ark_mem, int *nflagPtr, int *ncfPtr); +int arkCheckConstraints(ARKodeMem ark_mem, int *nflag, int *constrfails); +int arkCheckTemporalError(ARKodeMem ark_mem, int *nflagPtr, int *nefPtr, + realtype dsm); +int arkAccessHAdaptMem(void* arkode_mem, const char *fname, + ARKodeMem *ark_mem, ARKodeHAdaptMem *hadapt_mem); + +int arkSetDefaults(void *arkode_mem); +int arkSetDenseOrder(void *arkode_mem, int dord); +int arkSetInterpolantType(void *arkode_mem, int itype); +int arkSetInterpolantDegree(void *arkode_mem, int degree); +int arkSetErrHandlerFn(void *arkode_mem, + ARKErrHandlerFn ehfun, + void *eh_data); +int arkSetErrFile(void *arkode_mem, FILE *errfp); +int arkSetUserData(void *arkode_mem, void *user_data); +int arkSetDiagnostics(void *arkode_mem, FILE *diagfp); +int arkSetMaxNumSteps(void *arkode_mem, long int mxsteps); +int arkSetMaxHnilWarns(void *arkode_mem, int mxhnil); +int arkSetInitStep(void *arkode_mem, realtype hin); +int arkSetMinStep(void *arkode_mem, realtype hmin); +int arkSetMaxStep(void *arkode_mem, realtype hmax); +int arkSetStopTime(void *arkode_mem, realtype tstop); +int arkSetFixedStep(void *arkode_mem, realtype hfixed); +int arkSetRootDirection(void *arkode_mem, int *rootdir); +int arkSetNoInactiveRootWarn(void *arkode_mem); +int arkSetPostprocessStepFn(void *arkode_mem, + ARKPostProcessFn ProcessStep); +int arkSetPostprocessStageFn(void *arkode_mem, + ARKPostProcessFn ProcessStage); +int arkSetConstraints(void *arkode_mem, N_Vector constraints); +int arkSetMaxNumConstrFails(void *arkode_mem, int maxfails); +int arkSetCFLFraction(void *arkode_mem, realtype cfl_frac); +int arkSetSafetyFactor(void *arkode_mem, realtype safety); +int arkSetErrorBias(void *arkode_mem, realtype bias); +int arkSetMaxGrowth(void *arkode_mem, realtype mx_growth); +int arkSetMinReduction(void *arkode_mem, realtype eta_min); +int arkSetFixedStepBounds(void *arkode_mem, realtype lb, realtype ub); +int arkSetAdaptivityMethod(void *arkode_mem, int imethod, int idefault, + int pq, realtype adapt_params[3]); +int arkSetAdaptivityFn(void *arkode_mem, ARKAdaptFn hfun, void *h_data); +int arkSetMaxFirstGrowth(void *arkode_mem, realtype etamx1); +int arkSetMaxEFailGrowth(void *arkode_mem, realtype etamxf); +int arkSetSmallNumEFails(void *arkode_mem, int small_nef); +int arkSetMaxCFailGrowth(void *arkode_mem, realtype etacf); +int arkSetStabilityFn(void *arkode_mem, ARKExpStabFn EStab, void *estab_data); +int arkSetMaxErrTestFails(void *arkode_mem, int maxnef); +int arkSetMaxConvFails(void *arkode_mem, int maxncf); +int arkGetWorkSpace(void *arkode_mem, long int *lenrw, long int *leniw); +int arkGetNumStepAttempts(void *arkode_mem, long int *nstep_attempts); +int arkGetNumSteps(void *arkode_mem, long int *nsteps); +int arkGetActualInitStep(void *arkode_mem, realtype *hinused); +int arkGetLastStep(void *arkode_mem, realtype *hlast); +int arkGetCurrentStep(void *arkode_mem, realtype *hcur); +int arkGetCurrentState(void *arkode_mem, N_Vector *ycur); +int arkGetCurrentTime(void *arkode_mem, realtype *tcur); +int arkGetTolScaleFactor(void *arkode_mem, realtype *tolsfac); +int arkGetErrWeights(void *arkode_mem, N_Vector eweight); +int arkGetResWeights(void *arkode_mem, N_Vector rweight); +int arkGetNumGEvals(void *arkode_mem, long int *ngevals); +int arkGetRootInfo(void *arkode_mem, int *rootsfound); +int arkGetNumConstrFails(void *arkode_mem, long int *nconstrfails); +int arkGetNumExpSteps(void *arkode_mem, long int *nsteps); +int arkGetNumAccSteps(void *arkode_mem, long int *nsteps); +int arkGetNumErrTestFails(void *arkode_mem, long int *netfails); +int arkGetStepStats(void *arkode_mem, long int *nsteps, + realtype *hinused, realtype *hlast, + realtype *hcur, realtype *tcur); +char *arkGetReturnFlagName(long int flag); + + +/* XBraid interface functions */ +int arkSetForcePass(void *arkode_mem, booleantype force_pass); +int arkGetLastKFlag(void *arkode_mem, int *last_kflag); + + +/*=============================================================== + Reusable ARKode Error Messages + ===============================================================*/ + +#if defined(SUNDIALS_EXTENDED_PRECISION) + +#define MSG_TIME "t = %Lg" +#define MSG_TIME_H "t = %Lg and h = %Lg" +#define MSG_TIME_INT "t = %Lg is not between tcur - hold = %Lg and tcur = %Lg." +#define MSG_TIME_TOUT "tout = %Lg" +#define MSG_TIME_TSTOP "tstop = %Lg" + +#elif defined(SUNDIALS_DOUBLE_PRECISION) + +#define MSG_TIME "t = %lg" +#define MSG_TIME_H "t = %lg and h = %lg" +#define MSG_TIME_INT "t = %lg is not between tcur - hold = %lg and tcur = %lg." +#define MSG_TIME_TOUT "tout = %lg" +#define MSG_TIME_TSTOP "tstop = %lg" + +#else + +#define MSG_TIME "t = %g" +#define MSG_TIME_H "t = %g and h = %g" +#define MSG_TIME_INT "t = %g is not between tcur - hold = %g and tcur = %g." +#define MSG_TIME_TOUT "tout = %g" +#define MSG_TIME_TSTOP "tstop = %g" + +#endif + +/* Initialization and I/O error messages */ +#define MSG_ARK_NO_MEM "arkode_mem = NULL illegal." +#define MSG_ARK_ARKMEM_FAIL "Allocation of arkode_mem failed." +#define MSG_ARK_MEM_FAIL "A memory request failed." +#define MSG_ARK_NO_MALLOC "Attempt to call before ARKodeInit." +#define MSG_ARK_BAD_HMIN_HMAX "Inconsistent step size limits: hmin > hmax." +#define MSG_ARK_BAD_RELTOL "reltol < 0 illegal." +#define MSG_ARK_BAD_ABSTOL "abstol has negative component(s) (illegal)." +#define MSG_ARK_NULL_ABSTOL "abstol = NULL illegal." +#define MSG_ARK_BAD_RABSTOL "rabstol has negative component(s) (illegal)." +#define MSG_ARK_NULL_RABSTOL "rabstol = NULL illegal." +#define MSG_ARK_NULL_Y0 "y0 = NULL illegal." +#define MSG_ARK_Y0_FAIL_CONSTR "y0 fails to satisfy constraints." +#define MSG_ARK_NULL_F "Must specify at least one of fe, fi (both NULL)." +#define MSG_ARK_NULL_G "g = NULL illegal." +#define MSG_ARK_BAD_NVECTOR "A required vector operation is not implemented." +#define MSG_ARK_BAD_CONSTR "Illegal values in constraints vector." +#define MSG_ARK_NULL_DKY "dky = NULL illegal." +#define MSG_ARK_BAD_T "Illegal value for t." MSG_TIME_INT +#define MSG_ARK_NO_ROOT "Rootfinding was not initialized." + +/* ARKode Error Messages */ +#define MSG_ARK_YOUT_NULL "yout = NULL illegal." +#define MSG_ARK_TRET_NULL "tret = NULL illegal." +#define MSG_ARK_BAD_EWT "Initial ewt has component(s) equal to zero (illegal)." +#define MSG_ARK_EWT_NOW_BAD "At " MSG_TIME ", a component of ewt has become <= 0." +#define MSG_ARK_BAD_RWT "Initial rwt has component(s) equal to zero (illegal)." +#define MSG_ARK_RWT_NOW_BAD "At " MSG_TIME ", a component of rwt has become <= 0." +#define MSG_ARK_BAD_ITASK "Illegal value for itask." +#define MSG_ARK_BAD_H0 "h0 and tout - t0 inconsistent." +#define MSG_ARK_BAD_TOUT "Trouble interpolating at " MSG_TIME_TOUT ". tout too far back in direction of integration" +#define MSG_ARK_EWT_FAIL "The user-provide EwtSet function failed." +#define MSG_ARK_EWT_NOW_FAIL "At " MSG_TIME ", the user-provide EwtSet function failed." +#define MSG_ARK_RWT_FAIL "The user-provide RwtSet function failed." +#define MSG_ARK_RWT_NOW_FAIL "At " MSG_TIME ", the user-provide RwtSet function failed." +#define MSG_ARK_LINIT_FAIL "The linear solver's init routine failed." +#define MSG_ARK_HNIL_DONE "The above warning has been issued mxhnil times and will not be issued again for this problem." +#define MSG_ARK_TOO_CLOSE "tout too close to t0 to start integration." +#define MSG_ARK_MAX_STEPS "At " MSG_TIME ", mxstep steps taken before reaching tout." +#define MSG_ARK_TOO_MUCH_ACC "At " MSG_TIME ", too much accuracy requested." +#define MSG_ARK_HNIL "Internal " MSG_TIME_H " are such that t + h = t on the next step. The solver will continue anyway." +#define MSG_ARK_ERR_FAILS "At " MSG_TIME_H ", the error test failed repeatedly or with |h| = hmin." +#define MSG_ARK_CONV_FAILS "At " MSG_TIME_H ", the solver convergence test failed repeatedly or with |h| = hmin." +#define MSG_ARK_SETUP_FAILED "At " MSG_TIME ", the setup routine failed in an unrecoverable manner." +#define MSG_ARK_SOLVE_FAILED "At " MSG_TIME ", the solve routine failed in an unrecoverable manner." +#define MSG_ARK_FAILED_CONSTR "At " MSG_TIME ", unable to satisfy inequality constraints." +#define MSG_ARK_RHSFUNC_FAILED "At " MSG_TIME ", the right-hand side routine failed in an unrecoverable manner." +#define MSG_ARK_RHSFUNC_UNREC "At " MSG_TIME ", the right-hand side failed in a recoverable manner, but no recovery is possible." +#define MSG_ARK_RHSFUNC_REPTD "At " MSG_TIME " repeated recoverable right-hand side function errors." +#define MSG_ARK_RTFUNC_FAILED "At " MSG_TIME ", the rootfinding routine failed in an unrecoverable manner." +#define MSG_ARK_CLOSE_ROOTS "Root found at and very near " MSG_TIME "." +#define MSG_ARK_BAD_TSTOP "The value " MSG_TIME_TSTOP " is behind current " MSG_TIME " in the direction of integration." +#define MSG_ARK_INACTIVE_ROOTS "At the end of the first step, there are still some root functions identically 0. This warning will not be issued again." +#define MSG_ARK_RESIZE_FAIL "Error in user-supplied resize() function." +#define MSG_ARK_MASSINIT_FAIL "The mass matrix solver's init routine failed." +#define MSG_ARK_MASSSETUP_FAIL "The mass matrix solver's setup routine failed." +#define MSG_ARK_MASSSOLVE_FAIL "The mass matrix solver failed." +#define MSG_ARK_NLS_FAIL "At " MSG_TIME " the nonlinear solver failed in an unrecoverable manner." +#define MSG_ARK_USER_PREDICT_FAIL "At " MSG_TIME " the user-supplied predictor failed in an unrecoverable manner." +#define MSG_ARKADAPT_NO_MEM "Adaptivity memory structure not allocated." +#define MSG_ARK_VECTOROP_ERR "At " MSG_TIME ", a vector operation failed." +#define MSG_ARK_INNERSTEP_FAILED "At " MSG_TIME ", the inner stepper failed in an unrecoverable manner." +#define MSG_ARK_POSTPROCESS_STEP_FAIL "At " MSG_TIME ", the step postprocessing routine failed in an unrecoverable manner." +#define MSG_ARK_POSTPROCESS_STAGE_FAIL "At " MSG_TIME ", the stage postprocessing routine failed in an unrecoverable manner." +#define MSG_ARK_NULL_SUNCTX "sunctx = NULL illegal." +#define MSG_ARK_CONTEXT_MISMATCH "Outer and inner steppers have different contexts." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/src/arkode/arkode_interp.c b/lib/sundials_6.1.1/src/arkode/arkode_interp.c new file mode 100644 index 00000000000..1f1b3490690 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_interp.c @@ -0,0 +1,1347 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 temporal + * interpolation utility. + *--------------------------------------------------------------*/ + +#include +#include +#include +#include +#include + +#include "arkode_impl.h" +#include "arkode_interp_impl.h" +#include +#include + + +/*--------------------------------------------------------------- + Section I: generic ARKInterp functions provided by all + interpolation modules + ---------------------------------------------------------------*/ + +int arkInterpResize(void* arkode_mem, ARKInterp interp, + ARKVecResizeFn resize, void *resize_data, + sunindextype lrw_diff, sunindextype liw_diff, + N_Vector tmpl) +{ + if (interp == NULL) return(ARK_SUCCESS); + return((int) interp->ops->resize(arkode_mem, interp, + resize, resize_data, + lrw_diff, liw_diff, tmpl)); +} + +void arkInterpFree(void* arkode_mem, ARKInterp interp) +{ + if (interp == NULL) return; + interp->ops->free(arkode_mem, interp); + return; +} + +void arkInterpPrintMem(ARKInterp interp, FILE *outfile) +{ + if (interp == NULL) return; + interp->ops->print(interp, outfile); + return; +} + +int arkInterpSetDegree(void* arkode_mem, ARKInterp interp, + int degree) +{ + if (interp == NULL) return(ARK_SUCCESS); + return((int) interp->ops->setdegree(arkode_mem, interp, degree)); +} + +int arkInterpInit(void* arkode_mem, ARKInterp interp, + realtype tnew) +{ + if (interp == NULL) return(ARK_SUCCESS); + return((int) interp->ops->init(arkode_mem, interp, tnew)); +} + +int arkInterpUpdate(void* arkode_mem, ARKInterp interp, realtype tnew) +{ + if (interp == NULL) return(ARK_SUCCESS); + return((int) interp->ops->update(arkode_mem, interp, tnew)); +} + +int arkInterpEvaluate(void* arkode_mem, ARKInterp interp, + realtype tau, int d, int order, N_Vector yout) +{ + if (interp == NULL) return(ARK_SUCCESS); + return((int) interp->ops->evaluate(arkode_mem, interp, + tau, d, order, yout)); +} + + + +/*--------------------------------------------------------------- + Section II: Hermite interpolation module implementation + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + arkInterpCreate_Hermite: + + This routine creates an ARKInterp structure, through + cloning an input template N_Vector. This returns a non-NULL + structure if no errors occurred, or a NULL value otherwise. + ---------------------------------------------------------------*/ +ARKInterp arkInterpCreate_Hermite(void* arkode_mem, int degree) +{ + ARKInterp interp; + ARKInterpContent_Hermite content; + ARKInterpOps ops; + ARKodeMem ark_mem; + + /* access ARKodeMem structure */ + if (arkode_mem == NULL) return(NULL); + ark_mem = (ARKodeMem) arkode_mem; + + /* check for valid degree */ + if (degree < 0 || degree > ARK_INTERP_MAX_DEGREE) return(NULL); + + /* allocate overall structure */ + interp = NULL; + interp = (ARKInterp) malloc(sizeof *interp); + if (interp == NULL) return(NULL); + + /* allocate ops structure and set entries */ + ops = NULL; + ops = (ARKInterpOps) malloc(sizeof *ops); + if (ops == NULL) { free(interp); return(NULL); } + ops->resize = arkInterpResize_Hermite; + ops->free = arkInterpFree_Hermite; + ops->print = arkInterpPrintMem_Hermite; + ops->setdegree = arkInterpSetDegree_Hermite; + ops->init = arkInterpInit_Hermite; + ops->update = arkInterpUpdate_Hermite; + ops->evaluate = arkInterpEvaluate_Hermite; + + /* create content, and initialize everything to zero/NULL */ + content = NULL; + content = (ARKInterpContent_Hermite) malloc(sizeof *content); + if (content == NULL) { free(ops); free(interp); return(NULL); } + memset(content, 0, sizeof(struct _ARKInterpContent_Hermite)); + + /* attach ops and content structures to overall structure */ + interp->ops = ops; + interp->content = content; + + /* fill content */ + + /* initialize local N_Vectors to NULL */ + content->fold = NULL; + content->yold = NULL; + content->fa = NULL; + content->fb = NULL; + + /* set maximum interpolant degree */ + content->degree = SUNMIN(ARK_INTERP_MAX_DEGREE, degree); + + /* set ynew and fnew pointers to ark_mem->yn and ark_mem->fn, respectively */ + content->ynew = ark_mem->yn; + content->fnew = ark_mem->fn; + + /* update workspace sizes */ + ark_mem->lrw += 2; + ark_mem->liw += 5; + + /* initialize time values */ + content->told = ark_mem->tcur; + content->tnew = ark_mem->tcur; + content->h = RCONST(0.0); + + return(interp); +} + + +/*--------------------------------------------------------------- + arkInterpResize_Hermite: + + This routine resizes the internal vectors. + ---------------------------------------------------------------*/ +int arkInterpResize_Hermite(void* arkode_mem, ARKInterp interp, + ARKVecResizeFn resize, void *resize_data, + sunindextype lrw_diff, sunindextype liw_diff, + N_Vector y0) +{ + ARKodeMem ark_mem; + + /* access ARKodeMem structure */ + if (arkode_mem == NULL) return(ARK_MEM_NULL); + ark_mem = (ARKodeMem) arkode_mem; + + /* resize vectors */ + if (interp == NULL) return(ARK_SUCCESS); + + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &HINT_FOLD(interp))) + return(ARK_MEM_FAIL); + + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &HINT_YOLD(interp))) + return(ARK_MEM_FAIL); + + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &HINT_FA(interp))) + return(ARK_MEM_FAIL); + + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &HINT_FB(interp))) + return(ARK_MEM_FAIL); + + /* update ynew and fnew pointers */ + HINT_YNEW(interp) = ark_mem->yn; + HINT_FNEW(interp) = ark_mem->fn; + + /* reinitialize time values */ + HINT_TOLD(interp) = ark_mem->tcur; + HINT_TNEW(interp) = ark_mem->tcur; + HINT_H(interp) = RCONST(0.0); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkInterpFree_Hermite: + + This routine frees the Hermite ARKInterp structure. + ---------------------------------------------------------------*/ +void arkInterpFree_Hermite(void* arkode_mem, ARKInterp interp) +{ + ARKodeMem ark_mem; + + /* access ARKodeMem structure */ + if (arkode_mem == NULL) return; + ark_mem = (ARKodeMem) arkode_mem; + + /* if interpolation structure is NULL, just return */ + if (interp == NULL) return; + + /* free content */ + if (interp->content != NULL) { + if (HINT_FOLD(interp) != NULL) { + arkFreeVec(ark_mem, &(HINT_FOLD(interp))); + HINT_FOLD(interp) = NULL; + } + if (HINT_YOLD(interp) != NULL) { + arkFreeVec(ark_mem, &(HINT_YOLD(interp))); + HINT_YOLD(interp) = NULL; + } + if (HINT_FA(interp) != NULL) { + arkFreeVec(ark_mem, &(HINT_FA(interp))); + HINT_FA(interp) = NULL; + } + if (HINT_FB(interp) != NULL) { + arkFreeVec(ark_mem, &(HINT_FB(interp))); + HINT_FB(interp) = NULL; + } + + /* update work space sizes */ + ark_mem->lrw -= 2; + ark_mem->liw -= 5; + + free(interp->content); + interp->content = NULL; + } + + /* free ops and interpolation structures */ + if (interp->ops) { + free(interp->ops); + interp->ops = NULL; + } + free(interp); + interp = NULL; + + return; +} + + +/*--------------------------------------------------------------- + arkInterpPrintMem_Hermite + + This routine outputs the Hermite temporal interpolation memory + structure to a specified file pointer. + ---------------------------------------------------------------*/ +void arkInterpPrintMem_Hermite(ARKInterp interp, FILE *outfile) +{ + if (interp != NULL) { + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Hermite): degree = %d\n", HINT_DEGREE(interp)); + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Hermite): told = %"RSYM"\n", HINT_TOLD(interp)); + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Hermite): tnew = %"RSYM"\n", HINT_TNEW(interp)); + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Hermite): h = %"RSYM"\n", HINT_H(interp)); +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Hermite): fold:\n"); + N_VPrintFile(HINT_FOLD(interp), outfile); + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Hermite): fnew:\n"); + N_VPrintFile(HINT_FNEW(interp), outfile); + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Hermite): yold:\n"); + N_VPrintFile(HINT_YOLD(interp), outfile); + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Hermite): ynew:\n"); + N_VPrintFile(HINT_YNEW(interp), outfile); + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Hermite): fa:\n"); + N_VPrintFile(HINT_FA(interp), outfile); + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Hermite): fb:\n"); + N_VPrintFile(HINT_FB(interp), outfile); +#endif + } +} + + +/*--------------------------------------------------------------- + arkInterpSetDegree_Hermite + + This routine sets a supplied interpolation degree. If the + argument is positive, then we require that + 0 <= degree <= ARK_INTERP_MAX_DEGREE + and use this value as the user-specified (or default) degree. + + If the argument is negative, then we assume that this has been + called by a time-step module to limit the interpolant degree + based on the temporal method order. In this case we set the + Hermite polynomial degree to be the minimum of (-degree), + ARK_INTERP_MAX_DEGREE, and the previously-set value [i.e., in + case the user has already specified use of a lower-degree + polynomial]. + + Return values: + ARK_MEM_NULL -- if either arkode_mem or interp are NULL + ARK_ILL_INPUT -- if the input is outside of allowable bounds + ARK_INTERP_FAIL -- if the interpolation module has already + been initialized, + ARK_SUCCESS -- successful completion. + ---------------------------------------------------------------*/ +int arkInterpSetDegree_Hermite(void* arkode_mem, ARKInterp interp, + int degree) +{ + ARKodeMem ark_mem; + + /* access ARKodeMem structure */ + if (arkode_mem == NULL) return(ARK_MEM_NULL); + ark_mem = (ARKodeMem) arkode_mem; + + /* if this degree is already stored, just return */ + if (abs(degree) == HINT_DEGREE(interp)) return(ARK_SUCCESS); + + /* on positive degree, check for allowable value and overwrite stored degree */ + if (degree >= 0) { + if (degree > ARK_INTERP_MAX_DEGREE) { + arkProcessError(ark_mem, ARK_INTERP_FAIL, "ARKode", + "arkInterpSetDegree_Hermite", + "Illegal degree specified."); + return(ARK_ILL_INPUT); + } + + HINT_DEGREE(interp) = degree; + return(ARK_SUCCESS); + } + + /* on negative degree, check for allowable value and update stored degree */ + degree = -degree; + if (degree > ARK_INTERP_MAX_DEGREE) degree = ARK_INTERP_MAX_DEGREE; + HINT_DEGREE(interp) = SUNMIN(HINT_DEGREE(interp), degree); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkInterpInit_Hermite + + This routine performs the following steps: + 1. Sets tnew and told to the input time + 2. Allocates any missing/needed N_Vector storage (for reinit) + 3. Copies ark_mem->yn into yold + 4. Calls the full RHS routine to fill fnew + 5. Copies fnew into fold + ---------------------------------------------------------------*/ +int arkInterpInit_Hermite(void* arkode_mem, ARKInterp interp, + realtype tnew) +{ + ARKodeMem ark_mem; + + /* access ARKodeMem structure */ + if (arkode_mem == NULL) return(ARK_MEM_NULL); + ark_mem = (ARKodeMem) arkode_mem; + + /* initialize time values */ + HINT_TOLD(interp) = tnew; + HINT_TNEW(interp) = tnew; + HINT_H(interp) = RCONST(0.0); + + /* allocate vectors based on interpolant degree */ + if (HINT_FOLD(interp) == NULL) + if (!arkAllocVec(ark_mem, ark_mem->yn, &(HINT_FOLD(interp)))) { + arkInterpFree(ark_mem, interp); return(ARK_MEM_FAIL); + } + if (HINT_YOLD(interp) == NULL) + if (!arkAllocVec(ark_mem, ark_mem->yn, &(HINT_YOLD(interp)))) { + arkInterpFree(ark_mem, interp); return(ARK_MEM_FAIL); + } + if ((HINT_DEGREE(interp) > 3) && (HINT_FA(interp) == NULL)) { + if (!arkAllocVec(ark_mem, ark_mem->yn, &(HINT_FA(interp)))) { + arkInterpFree(ark_mem, interp); return(ARK_MEM_FAIL); + } + } + if ((HINT_DEGREE(interp) > 4) && (HINT_FB(interp) == NULL)) { + if (!arkAllocVec(ark_mem, ark_mem->yn, &(HINT_FB(interp)))) { + arkInterpFree(ark_mem, interp); return(ARK_MEM_FAIL); + } + } + + /* copy current solution into yold */ + N_VScale(ONE, ark_mem->yn, HINT_YOLD(interp)); + + /* copy fnew into fold */ + N_VScale(ONE, HINT_FNEW(interp), HINT_FOLD(interp)); + + /* signal that fullrhs is required after each step */ + ark_mem->call_fullrhs = SUNTRUE; + + /* return with success */ + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkInterpUpdate_Hermite + + This routine copies ynew into yold, and fnew into fold, so that + yold and fold contain the previous values. + ---------------------------------------------------------------*/ +int arkInterpUpdate_Hermite(void* arkode_mem, ARKInterp interp, realtype tnew) +{ + ARKodeMem ark_mem; + + /* access ARKodeMem structure */ + if (arkode_mem == NULL) return(ARK_MEM_NULL); + ark_mem = (ARKodeMem) arkode_mem; + + /* copy ynew and fnew into yold and fold, respectively */ + N_VScale(ONE, HINT_YNEW(interp), HINT_YOLD(interp)); + N_VScale(ONE, HINT_FNEW(interp), HINT_FOLD(interp)); + + /* update time values */ + HINT_TOLD(interp) = HINT_TNEW(interp); + HINT_TNEW(interp) = tnew; + HINT_H(interp) = ark_mem->h; + + /* return with success */ + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkInterpEvaluate_Hermite + + This routine evaluates a temporal interpolation/extrapolation + based on the data in the interpolation structure: + yold = y(told) + ynew = y(tnew) + fold = f(told, yold) + fnew = f(told, ynew) + This typically consists of using a cubic Hermite interpolating + formula with this data. If greater polynomial degree than 3 is + requested, then we can bootstrap up to a 5th-order interpolant. + For lower order interpolants than cubic, we use: + {yold,ynew,fnew} for quadratic + {yold,ynew} for linear + {0.5*(yold+ynew)} for constant. + + Derivatives have lower accuracy than the interpolant + itself, losing one order per derivative. We will provide + derivatives up to d = min(5,q). + + The input 'tau' specifies the time at which to evaluate the Hermite + polynomial. The formula for tau is defined using the + most-recently-completed solution interval [told,tnew], and is + given by: + t = tnew + tau*(tnew-told), + where h = tnew-told, i.e. values -1 q) { + N_VConst(ZERO, yout); + return(ARK_SUCCESS); + } + + /* build polynomial based on order */ + switch (q) { + + case(0): /* constant interpolant, yout = 0.5*(yn+yp) */ + N_VLinearSum(HALF, HINT_YOLD(interp), HALF, HINT_YNEW(interp), yout); + break; + + case(1): /* linear interpolant */ + if (d == 0) { + a0 = -tau; + a1 = ONE+tau; + } else { /* d=1 */ + a0 = -ONE/h; + a1 = ONE/h; + } + N_VLinearSum(a0, HINT_YOLD(interp), a1, HINT_YNEW(interp), yout); + break; + + case(2): /* quadratic interpolant */ + if (d == 0) { + a[0] = tau2; + a[1] = ONE - tau2; + a[2] = h*(tau2 + tau); + } else if (d == 1) { + a[0] = TWO*tau/h; + a[1] = -TWO*tau/h; + a[2] = (ONE + TWO*tau); + } else { /* d == 2 */ + a[0] = TWO/h/h; + a[1] = -TWO/h/h; + a[2] = TWO/h; + } + X[0] = HINT_YOLD(interp); + X[1] = HINT_YNEW(interp); + X[2] = HINT_FNEW(interp); + retval = N_VLinearCombination(3, a, X, yout); + if (retval != 0) return(ARK_VECTOROP_ERR); + break; + + case(3): /* cubic interpolant */ + if (d == 0) { + a[0] = THREE*tau2 + TWO*tau3; + a[1] = ONE - THREE*tau2 - TWO*tau3; + a[2] = h*(tau2 + tau3); + a[3] = h*(tau + TWO*tau2 + tau3); + } else if (d == 1) { + a[0] = SIX*(tau + tau2)/h; + a[1] = -SIX*(tau + tau2)/h; + a[2] = TWO*tau + THREE*tau2; + a[3] = ONE + FOUR*tau + THREE*tau2; + } else if (d == 2) { + a[0] = SIX*(ONE + TWO*tau)/h2; + a[1] = -SIX*(ONE + TWO*tau)/h2; + a[2] = (TWO + SIX*tau)/h; + a[3] = (FOUR + SIX*tau)/h; + } else { /* d == 3 */ + a[0] = TWELVE/h3; + a[1] = -TWELVE/h3; + a[2] = SIX/h2; + a[3] = SIX/h2; + } + X[0] = HINT_YOLD(interp); + X[1] = HINT_YNEW(interp); + X[2] = HINT_FOLD(interp); + X[3] = HINT_FNEW(interp); + retval = N_VLinearCombination(4, a, X, yout); + if (retval != 0) return(ARK_VECTOROP_ERR); + break; + + case(4): /* quartic interpolant */ + + /* first, evaluate cubic interpolant at tau=-1/3 */ + tval = -ONE/THREE; + retval = arkInterpEvaluate(arkode_mem, interp, tval, 0, 3, yout); + if (retval != 0) return(ARK_RHSFUNC_FAIL); + + /* second, evaluate RHS at tau=-1/3, storing the result in fa */ + tval = HINT_TNEW(interp) - h/THREE; + retval = ark_mem->step_fullrhs(ark_mem, tval, yout, HINT_FA(interp), + ARK_FULLRHS_OTHER); + if (retval != 0) return(ARK_RHSFUNC_FAIL); + + /* evaluate desired function */ + if (d == 0) { + a[0] = -SIX*tau2 - RCONST(16.0)*tau3 - RCONST(9.0)*tau4; + a[1] = ONE + SIX*tau2 + RCONST(16.0)*tau3 + RCONST(9.0)*tau4; + a[2] = h*FOURTH*(-FIVE*tau2 - RCONST(14.0)*tau3 - RCONST(9.0)*tau4); + a[3] = h*(tau + TWO*tau2 + tau3); + a[4] = h*RCONST(27.0)*FOURTH*(-tau4 - TWO*tau3 - tau2); + } else if (d == 1) { + a[0] = (-TWELVE*tau - RCONST(48.0)*tau2 - RCONST(36.0)*tau3)/h; + a[1] = (TWELVE*tau + RCONST(48.0)*tau2 + RCONST(36.0)*tau3)/h; + a[2] = HALF*(-FIVE*tau - RCONST(21.0)*tau2 - RCONST(18.0)*tau3); + a[3] = (ONE + FOUR*tau + THREE*tau2); + a[4] = -RCONST(27.0)*HALF*(TWO*tau3 + THREE*tau2 + tau); + } else if (d == 2) { + a[0] = (-TWELVE - RCONST(96.0)*tau - RCONST(108.0)*tau2)/h2; + a[1] = (TWELVE + RCONST(96.0)*tau + RCONST(108.0)*tau2)/h2; + a[2] = (-FIVE*HALF - RCONST(21.0)*tau - RCONST(27.0)*tau2)/h; + a[3] = (FOUR + SIX*tau)/h; + a[4] = (-RCONST(27.0)*HALF - RCONST(81.0)*tau - RCONST(81.0)*tau2)/h; + } else if (d == 3) { + a[0] = (-RCONST(96.0) - RCONST(216.0)*tau)/h3; + a[1] = (RCONST(96.0) + RCONST(216.0)*tau)/h3; + a[2] = (-RCONST(21.0) - RCONST(54.0)*tau)/h2; + a[3] = SIX/h2; + a[4] = (-RCONST(81.0) - RCONST(162.0)*tau)/h2; + } else { /* d == 4 */ + a[0] = -RCONST(216.0)/h4; + a[1] = RCONST(216.0)/h4; + a[2] = -RCONST(54.0)/h3; + a[3] = ZERO; + a[4] = -RCONST(162.0)/h3; + } + X[0] = HINT_YOLD(interp); + X[1] = HINT_YNEW(interp); + X[2] = HINT_FOLD(interp); + X[3] = HINT_FNEW(interp); + X[4] = HINT_FA(interp); + retval = N_VLinearCombination(5, a, X, yout); + if (retval != 0) return(ARK_VECTOROP_ERR); + break; + + case(5): /* quintic interpolant */ + + /* first, evaluate quartic interpolant at tau=-1/3 */ + tval = -ONE/THREE; + retval = arkInterpEvaluate(arkode_mem, interp, tval, 0, 4, yout); + if (retval != 0) return(ARK_RHSFUNC_FAIL); + + /* second, evaluate RHS at tau=-1/3, storing the result in fa */ + tval = HINT_TNEW(interp) - h/THREE; + retval = ark_mem->step_fullrhs(ark_mem, tval, yout, HINT_FA(interp), + ARK_FULLRHS_OTHER); + if (retval != 0) return(ARK_RHSFUNC_FAIL); + + /* third, evaluate quartic interpolant at tau=-2/3 */ + tval = -TWO/THREE; + retval = arkInterpEvaluate(arkode_mem, interp, tval, 0, 4, yout); + if (retval != 0) return(ARK_RHSFUNC_FAIL); + + /* fourth, evaluate RHS at tau=-2/3, storing the result in fb */ + tval = HINT_TNEW(interp) - h*TWO/THREE; + retval = ark_mem->step_fullrhs(ark_mem, tval, yout, HINT_FB(interp), + ARK_FULLRHS_OTHER); + if (retval != 0) return(ARK_RHSFUNC_FAIL); + + /* evaluate desired function */ + if (d == 0) { + a[0] = RCONST(54.0)*tau5 + RCONST(135.0)*tau4 + RCONST(110.0)*tau3 + RCONST(30.0)*tau2; + a[1] = ONE - a[0]; + a[2] = h/FOUR*(RCONST(27.0)*tau5 + RCONST(63.0)*tau4 + RCONST(49.0)*tau3 + RCONST(13.0)*tau2); + a[3] = h/FOUR*(RCONST(27.0)*tau5 + RCONST(72.0)*tau4 + RCONST(67.0)*tau3 + RCONST(26.0)*tau2 + FOUR*tau); + a[4] = h/FOUR*(RCONST(81.0)*tau5 + RCONST(189.0)*tau4 + RCONST(135.0)*tau3 + RCONST(27.0)*tau2); + a[5] = h/FOUR*(RCONST(81.0)*tau5 + RCONST(216.0)*tau4 + RCONST(189.0)*tau3 + RCONST(54.0)*tau2); + } else if (d == 1) { + a[0] = (RCONST(270.0)*tau4 + RCONST(540.0)*tau3 + RCONST(330.0)*tau2 + RCONST(60.0)*tau)/h; + a[1] = -a[0]; + a[2] = (RCONST(135.0)*tau4 + RCONST(252.0)*tau3 + RCONST(147.0)*tau2 + RCONST(26.0)*tau)/FOUR; + a[3] = (RCONST(135.0)*tau4 + RCONST(288.0)*tau3 + RCONST(201.0)*tau2 + RCONST(52.0)*tau + FOUR)/FOUR; + a[4] = (RCONST(405.0)*tau4 + RCONST(4.0)*189*tau3 + RCONST(405.0)*tau2 + RCONST(54.0)*tau)/FOUR; + a[5] = (RCONST(405.0)*tau4 + RCONST(864.0)*tau3 + RCONST(567.0)*tau2 + RCONST(108.0)*tau)/FOUR; + } else if (d == 2) { + a[0] = (RCONST(1080.0)*tau3 + RCONST(1620.0)*tau2 + RCONST(660.0)*tau + RCONST(60.0))/h2; + a[1] = -a[0]; + a[2] = (RCONST(270.0)*tau3 + RCONST(378.0)*tau2 + RCONST(147.0)*tau + RCONST(13.0))/(TWO*h); + a[3] = (RCONST(270.0)*tau3 + RCONST(432.0)*tau2 + RCONST(201.0)*tau + RCONST(26.0))/(TWO*h); + a[4] = (RCONST(810.0)*tau3 + RCONST(1134.0)*tau2 + RCONST(405.0)*tau + RCONST(27.0))/(TWO*h); + a[5] = (RCONST(810.0)*tau3 + RCONST(1296.0)*tau2 + RCONST(567.0)*tau + RCONST(54.0))/(TWO*h); + } else if (d == 3) { + a[0] = (RCONST(3240.0)*tau2 + RCONST(3240.0)*tau + RCONST(660.0))/h3; + a[1] = -a[0]; + a[2] = (RCONST(810.0)*tau2 + RCONST(756.0)*tau + RCONST(147.0))/(TWO*h2); + a[3] = (RCONST(810.0)*tau2 + RCONST(864.0)*tau + RCONST(201.0))/(TWO*h2); + a[4] = (RCONST(2430.0)*tau2 + RCONST(2268.0)*tau + RCONST(405.0))/(TWO*h2); + a[5] = (RCONST(2430.0)*tau2 + RCONST(2592.0)*tau + RCONST(567.0))/(TWO*h2); + } else if (d == 4) { + a[0] = (RCONST(6480.0)*tau + RCONST(3240.0))/h4; + a[1] = -a[0]; + a[2] = (RCONST(810.0)*tau + RCONST(378.0))/h3; + a[3] = (RCONST(810.0)*tau + RCONST(432.0))/h3; + a[4] = (RCONST(2430.0)*tau + RCONST(1134.0))/h3; + a[5] = (RCONST(2430.0)*tau + RCONST(1296.0))/h3; + } else { /* d == 5 */ + a[0] = RCONST(6480.0)/h5; + a[1] = -a[0]; + a[2] = RCONST(810.0)/h4; + a[3] = a[2]; + a[4] = RCONST(2430.0)/h4; + a[5] = a[4]; + } + X[0] = HINT_YOLD(interp); + X[1] = HINT_YNEW(interp); + X[2] = HINT_FOLD(interp); + X[3] = HINT_FNEW(interp); + X[4] = HINT_FA(interp); + X[5] = HINT_FB(interp); + retval = N_VLinearCombination(6, a, X, yout); + if (retval != 0) return(ARK_VECTOROP_ERR); + break; + + default: + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkInterpEvaluate_Hermite", + "Illegal polynomial order"); + return (ARK_ILL_INPUT); + } + + return(ARK_SUCCESS); +} + + + + +/*--------------------------------------------------------------- + Section III: Lagrange interpolation module implementation + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + arkInterpCreate_Lagrange: + + This routine creates an ARKInterp structure, through + cloning an input template N_Vector. This returns a non-NULL + structure if no errors occurred, or a NULL value otherwise. + ---------------------------------------------------------------*/ +ARKInterp arkInterpCreate_Lagrange(void* arkode_mem, int degree) +{ + ARKInterp interp; + ARKInterpContent_Lagrange content; + ARKInterpOps ops; + ARKodeMem ark_mem; + + /* access ARKodeMem structure */ + if (arkode_mem == NULL) return(NULL); + ark_mem = (ARKodeMem) arkode_mem; + + /* check for valid degree */ + if (degree < 0 || degree > ARK_INTERP_MAX_DEGREE) return(NULL); + + /* allocate overall structure */ + interp = NULL; + interp = (ARKInterp) malloc(sizeof *interp); + if (interp == NULL) return(NULL); + + /* allocate ops structure and set entries */ + ops = NULL; + ops = (ARKInterpOps) malloc(sizeof *ops); + if (ops == NULL) { free(interp); return(NULL); } + ops->resize = arkInterpResize_Lagrange; + ops->free = arkInterpFree_Lagrange; + ops->print = arkInterpPrintMem_Lagrange; + ops->setdegree = arkInterpSetDegree_Lagrange; + ops->init = arkInterpInit_Lagrange; + ops->update = arkInterpUpdate_Lagrange; + ops->evaluate = arkInterpEvaluate_Lagrange; + + /* create content, and initialize everything to zero/NULL */ + content = NULL; + content = (ARKInterpContent_Lagrange) malloc(sizeof *content); + if (content == NULL) { free(ops); free(interp); return(NULL); } + memset(content, 0, sizeof(struct _ARKInterpContent_Lagrange)); + + /* attach ops and content structures to overall structure */ + interp->ops = ops; + interp->content = content; + + /* fill content */ + + /* maximum/current history length */ + content->nmax = SUNMIN(degree+1, ARK_INTERP_MAX_DEGREE+1); /* respect maximum possible */ + content->nmaxalloc = 0; + content->nhist = 0; + + /* initialize time/solution history arrays to NULL */ + content->thist = NULL; + content->yhist = NULL; + + /* initial t roundoff value */ + content->tround = FUZZ_FACTOR*ark_mem->uround; + + /* update workspace sizes */ + ark_mem->lrw += content->nmax + 1; + ark_mem->liw += content->nmax + 2; + + return(interp); +} + + +/*--------------------------------------------------------------- + arkInterpResize_Lagrange: + + This routine resizes the internal vectors. + ---------------------------------------------------------------*/ +int arkInterpResize_Lagrange(void* arkode_mem, ARKInterp I, + ARKVecResizeFn resize, void *resize_data, + sunindextype lrw_diff, sunindextype liw_diff, + N_Vector y0) +{ + int i; + ARKodeMem ark_mem; + + /* access ARKodeMem structure */ + if (arkode_mem == NULL) return(ARK_MEM_NULL); + ark_mem = (ARKodeMem) arkode_mem; + + /* resize vectors */ + if (I == NULL) return(ARK_SUCCESS); + if (LINT_YHIST(I) != NULL) { + for (i=0; icontent != NULL) { + if (LINT_YHIST(I) != NULL) { + for (i=0; ilrw -= (LINT_NMAX(I) + 1); + ark_mem->liw -= (LINT_NMAX(I) + 2); + + free(I->content); + I->content = NULL; + } + + /* free ops and interpolation structures */ + if (I->ops) { + free(I->ops); + I->ops = NULL; + } + free(I); + I = NULL; + + return; +} + + +/*--------------------------------------------------------------- + arkInterpPrintMem_Lagrange + + This routine outputs the Lagrange temporal interpolation memory + structure to a specified file pointer. + ---------------------------------------------------------------*/ +void arkInterpPrintMem_Lagrange(ARKInterp I, FILE *outfile) +{ + int i; + if (I != NULL) { + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Lagrange): nmax = %i\n", LINT_NMAX(I)); + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Lagrange): nhist = %i\n", LINT_NHIST(I)); + if (LINT_THIST(I) != NULL) { + STAN_SUNDIALS_FPRINTF(outfile, "arkode_interp (Lagrange): thist ="); + for (i=0; i= 0) { + if (degree > ARK_INTERP_MAX_DEGREE) { + arkProcessError(ark_mem, ARK_INTERP_FAIL, "ARKode", + "arkInterpSetDegree_Lagrange", + "Illegal degree specified."); + return(ARK_ILL_INPUT); + } + + LINT_NMAX(I) = degree+1; + return(ARK_SUCCESS); + } + + /* on negative degree, check for allowable value and update stored degree */ + degree = -degree; + if (degree > ARK_INTERP_MAX_DEGREE) degree = ARK_INTERP_MAX_DEGREE; + LINT_NMAX(I) = SUNMIN(LINT_NMAX(I), degree+1); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkInterpInit_Lagrange + + This routine performs the following steps: + 1. allocates any missing/needed (t,y) history arrays + 2. zeros out stored (t,y) history + 3. copies current (t,y) from main ARKode memory into history + 4. updates the 'active' history counter to 1 + ---------------------------------------------------------------*/ +int arkInterpInit_Lagrange(void* arkode_mem, ARKInterp I, + realtype tnew) +{ + int i; + ARKodeMem ark_mem; + + /* access ARKodeMem structure */ + if (arkode_mem == NULL) return(ARK_MEM_NULL); + ark_mem = (ARKodeMem) arkode_mem; + + /* check if storage has increased since the last init */ + if (LINT_NMAX(I) > LINT_NMAXALLOC(I)) { + if (LINT_THIST(I) != NULL) { + free(LINT_THIST(I)); + LINT_THIST(I) = NULL; + } + if (LINT_YHIST(I) != NULL) { + for (i=0; iyn, &(LINT_YJ(I,i)))) { + arkInterpFree(ark_mem, I); return(ARK_MEM_FAIL); + } + } + } + + /* update allocated size if necesary */ + if (LINT_NMAX(I) > LINT_NMAXALLOC(I)) + LINT_NMAXALLOC(I) = LINT_NMAX(I); + + /* zero out history (to be safe) */ + for (i=0; iyn, LINT_YJ(I,0)); + LINT_NHIST(I) = 1; + + /* return with success */ + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkInterpUpdate_Lagrange + + If the current time is 'different enough' from the stored + values, then this routine performs the following steps: + 1. shifts the t-history array values, and prepends the current + time + 2. shifts the y-history pointers, and copies the current state + into the first history vector + Otherwise it just returns with success. + ---------------------------------------------------------------*/ +int arkInterpUpdate_Lagrange(void* arkode_mem, ARKInterp I, realtype tnew) +{ + int i; + ARKodeMem ark_mem; + realtype tdiff; + N_Vector ytmp; + int nhist, nmax; + realtype *thist; + N_Vector *yhist; + + /* access ARKodeMem structure */ + if (arkode_mem == NULL) return(ARK_MEM_NULL); + ark_mem = (ARKodeMem) arkode_mem; + + /* set readability shortcuts */ + nhist = LINT_NHIST(I); + nmax = LINT_NMAX(I); + thist = LINT_THIST(I); + yhist = LINT_YHIST(I); + + /* update t roundoff value */ + LINT_TROUND(I) = FUZZ_FACTOR*ark_mem->uround * + (SUNRabs(ark_mem->tcur) + SUNRabs(ark_mem->h)); + + /* determine if tnew differs sufficiently from stored values */ + tdiff = SUNRabs(tnew - thist[0]); + for (i=1; i0; i--) { + thist[i] = thist[i-1]; + yhist[i] = yhist[i-1]; + } + yhist[0] = ytmp; + + /* copy tnew and ycur into first entry of history arrays */ + thist[0] = tnew; + N_VScale(ONE, ark_mem->ycur, yhist[0]); + + /* update 'nhist' (first few steps) */ + LINT_NHIST(I) = nhist = SUNMIN(nhist+1, nmax); + + /* return with success */ + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkInterpEvaluate_Lagrange + + This routine evaluates a temporal interpolation/extrapolation + based on the stored solution data in the interpolation structure. + + Derivatives have lower accuracy than the interpolant + itself, losing one order per derivative. This module can provide + up to 3rd derivatives. + + The input 'tau' specifies the time at which to evaluate the + Lagrange polynomial. The formula for tau is defined using the + most-recently-completed solution interval [t1,t0], and is + given by: + t = t0 + tau*(t0-t1), + here t0 and t1 are the 2 most-recent entries in the 'thist' + array within the interpolation structure. Thus values + -(nhist-1) <= tau < = 0 + provide interpolation, others result in extrapolation (assuming + fixed step sizes, otherwise the stated lower bound is only + approximate). + ---------------------------------------------------------------*/ +int arkInterpEvaluate_Lagrange(void* arkode_mem, ARKInterp I, + realtype tau, int deriv, int degree, + N_Vector yout) +{ + /* local variables */ + int q, retval, i, j; + realtype tval; + realtype a[6]; + N_Vector X[6]; + ARKodeMem ark_mem; + int nhist; + realtype *thist; + N_Vector *yhist; + + /* access ARKodeMem structure */ + if (arkode_mem == NULL) return(ARK_MEM_NULL); + ark_mem = (ARKodeMem) arkode_mem; + + /* set readability shortcuts */ + nhist = LINT_NHIST(I); + thist = LINT_THIST(I); + yhist = LINT_YHIST(I); + + /* determine polynomial degree q */ + q = SUNMAX(degree, 0); /* respect lower bound */ + q = SUNMIN(q, nhist-1); /* respect max possible */ + + /* error on illegal deriv */ + if ((deriv < 0) || (deriv > 3)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkInterpEvaluate_Lagrange", + "Requested illegal derivative."); + return (ARK_ILL_INPUT); + } + + /* if deriv is too high, just return zeros */ + if (deriv > q) { + N_VConst(ZERO, yout); + return(ARK_SUCCESS); + } + + /* if constant interpolant is requested, just return ynew */ + if (q == 0) { + N_VScale(ONE, yhist[0], yout); + return(ARK_SUCCESS); + } + + /* convert from tau back to t (both tnew and told are valid since q>0 => NHIST>1) */ + tval = thist[0] + tau*(thist[0]-thist[1]); + + /* linear interpolant */ + if (q == 1) { + if (deriv == 0) { + a[0] = LBasis(I,0,tval); + a[1] = LBasis(I,1,tval); + } else { /* deriv == 1 */ + a[0] = LBasisD(I,0,tval); + a[1] = LBasisD(I,1,tval); + } + N_VLinearSum(a[0], yhist[0], a[1], yhist[1], yout); + return(ARK_SUCCESS); + } + + /* higher-degree interpolant */ + /* initialize arguments for N_VLinearCombination */ + for (i=0; i +#include +#include "arkode_impl.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*=============================================================== + ARKode temporal interpolation constants + ===============================================================*/ + +/* Numeric constants */ +#define FOURTH RCONST(0.25) +#define THREE RCONST(3.0) +#define SIX RCONST(6.0) +#define TWELVE RCONST(12.0) + + + +/*=============================================================== + ARKode Hermite Temporal Interpolation Data Structure + ===============================================================*/ + +/* Hermite interpolation structure */ + +struct _ARKInterpContent_Hermite { + int degree; /* maximum interpolant degree to use */ + N_Vector fold; /* f(t,y) at beginning of last successful step */ + N_Vector fnew; /* f(t,y) at end of last successful step */ + N_Vector yold; /* y at beginning of last successful step */ + N_Vector ynew; /* y at end of last successful step */ + N_Vector fa; /* f(t,y) used in higher-order interpolation */ + N_Vector fb; /* f(t,y) used in higher-order interpolation */ + realtype told; /* t at beginning of last successful step */ + realtype tnew; /* t at end of last successful step */ + realtype h; /* last successful step size */ +}; + +typedef struct _ARKInterpContent_Hermite *ARKInterpContent_Hermite; + + +/* Hermite structure accessor macros */ + +#define HINT_CONTENT(I) ( (ARKInterpContent_Hermite)(I->content) ) +#define HINT_DEGREE(I) ( HINT_CONTENT(I)->degree ) +#define HINT_FOLD(I) ( HINT_CONTENT(I)->fold ) +#define HINT_FNEW(I) ( HINT_CONTENT(I)->fnew ) +#define HINT_YOLD(I) ( HINT_CONTENT(I)->yold ) +#define HINT_YNEW(I) ( HINT_CONTENT(I)->ynew ) +#define HINT_FA(I) ( HINT_CONTENT(I)->fa ) +#define HINT_FB(I) ( HINT_CONTENT(I)->fb ) +#define HINT_TOLD(I) ( HINT_CONTENT(I)->told ) +#define HINT_TNEW(I) ( HINT_CONTENT(I)->tnew ) +#define HINT_H(I) ( HINT_CONTENT(I)->h ) + + +/* Hermite structure operations */ + +ARKInterp arkInterpCreate_Hermite(void* arkode_mem, int degree); + +int arkInterpResize_Hermite(void* arkode_mem, ARKInterp interp, + ARKVecResizeFn resize, void *resize_data, + sunindextype lrw_diff, sunindextype liw_diff, + N_Vector tmpl); +void arkInterpFree_Hermite(void* arkode_mem, ARKInterp interp); +void arkInterpPrintMem_Hermite(ARKInterp interp, FILE *outfile); +int arkInterpSetDegree_Hermite(void *arkode_mem, ARKInterp interp, int degree); +int arkInterpInit_Hermite(void* arkode_mem, ARKInterp interp, + realtype tnew); +int arkInterpUpdate_Hermite(void* arkode_mem, ARKInterp interp, realtype tnew); +int arkInterpEvaluate_Hermite(void* arkode_mem, ARKInterp interp, + realtype tau, int d, int order, N_Vector yout); + + + + + +/*=============================================================== + ARKode Lagrange Temporal Interpolation Data Structure + ===============================================================*/ + +/* Lagrange interpolation structure */ + +struct _ARKInterpContent_Lagrange { + int nmax; /* number of previous solutions to use */ + int nmaxalloc; /* vectors allocated for previous solutions */ + N_Vector *yhist; /* previous solution vectors */ + realtype *thist; /* 't' values associated with yhist */ + int nhist; /* number of 'active' vectors in yhist */ + realtype tround; /* unit roundoff for 't' values */ +}; + +typedef struct _ARKInterpContent_Lagrange *ARKInterpContent_Lagrange; + + +/* Lagrange structure accessor macros */ + +#define LINT_CONTENT(I) ( (ARKInterpContent_Lagrange)(I->content) ) +#define LINT_NMAX(I) ( LINT_CONTENT(I)->nmax ) +#define LINT_NMAXALLOC(I) ( LINT_CONTENT(I)->nmaxalloc ) +#define LINT_YHIST(I) ( LINT_CONTENT(I)->yhist ) +#define LINT_THIST(I) ( LINT_CONTENT(I)->thist ) +#define LINT_YJ(I,j) ( (LINT_YHIST(I))[j] ) +#define LINT_TJ(I,j) ( (LINT_THIST(I))[j] ) +#define LINT_NHIST(I) ( LINT_CONTENT(I)->nhist ) +#define LINT_TROUND(I) ( LINT_CONTENT(I)->tround ) + + +/* Lagrange structure operations */ + +ARKInterp arkInterpCreate_Lagrange(void* arkode_mem, int degree); + +int arkInterpResize_Lagrange(void* arkode_mem, ARKInterp interp, + ARKVecResizeFn resize, void *resize_data, + sunindextype lrw_diff, sunindextype liw_diff, + N_Vector tmpl); +void arkInterpFree_Lagrange(void* arkode_mem, ARKInterp interp); +void arkInterpPrintMem_Lagrange(ARKInterp interp, FILE *outfile); +int arkInterpSetDegree_Lagrange(void *arkode_mem, ARKInterp interp, int degree); +int arkInterpInit_Lagrange(void* arkode_mem, ARKInterp interp, + realtype tnew); +int arkInterpUpdate_Lagrange(void* arkode_mem, ARKInterp interp, realtype tnew); +int arkInterpEvaluate_Lagrange(void* arkode_mem, ARKInterp interp, + realtype tau, int d, int order, N_Vector yout); + + +/* Lagrange structure utility routines */ +realtype LBasis(ARKInterp interp, int idx, realtype t); +realtype LBasisD(ARKInterp interp, int idx, realtype t); +realtype LBasisD2(ARKInterp interp, int idx, realtype t); +realtype LBasisD3(ARKInterp interp, int idx, realtype t); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/src/arkode/arkode_io.c b/lib/sundials_6.1.1/src/arkode/arkode_io.c new file mode 100644 index 00000000000..8a8881c0f36 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_io.c @@ -0,0 +1,1880 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * This is the implementation file for the optional input and + * output functions for the ARKode infrastructure; these routines + * should not be called directly by the user; instead they are + * provided as utility routines for ARKode time-step modules + * to use. + *--------------------------------------------------------------*/ + +#include +#include + +#include "arkode_impl.h" +#include "arkode_interp_impl.h" +#include +#include + + +/*=============================================================== + ARKode optional input utility functions + ===============================================================*/ + +/*--------------------------------------------------------------- + arkSetDefaults: + + Resets all optional inputs to ARKode default values. Does not + change problem-defining function pointers fe and fi or + user_data pointer. Also leaves alone any data + structures/options related to root-finding (those can be reset + using ARKodeRootInit) or post-processing a step (ProcessStep). + ---------------------------------------------------------------*/ +int arkSetDefaults(void *arkode_mem) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetDefaults", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* Set default values for integrator optional inputs */ + ark_mem->fixedstep = SUNFALSE; /* default to use adaptive steps */ + ark_mem->reltol = RCONST(1.e-4); /* relative tolerance */ + ark_mem->itol = ARK_SS; /* scalar-scalar solution tolerances */ + ark_mem->ritol = ARK_SS; /* scalar-scalar residual tolerances */ + ark_mem->Sabstol = RCONST(1.e-9); /* solution absolute tolerance */ + ark_mem->atolmin0 = SUNFALSE; /* min(abstol) > 0 */ + ark_mem->SRabstol = RCONST(1.e-9); /* residual absolute tolerance */ + ark_mem->Ratolmin0 = SUNFALSE; /* min(Rabstol) > 0 */ + ark_mem->user_efun = SUNFALSE; /* no user-supplied ewt function */ + ark_mem->efun = arkEwtSetSS; /* built-in scalar-scalar ewt function */ + ark_mem->e_data = ark_mem; /* ewt function data */ + ark_mem->user_rfun = SUNFALSE; /* no user-supplied rwt function */ + ark_mem->rfun = arkRwtSet; /* built-in rwt function */ + ark_mem->r_data = ark_mem; /* rwt function data */ + ark_mem->ehfun = arkErrHandler; /* default error handler fn */ + ark_mem->eh_data = ark_mem; /* error handler data */ + ark_mem->errfp = stderr; /* output stream for errors */ + ark_mem->mxstep = MXSTEP_DEFAULT; /* max number of steps */ + ark_mem->mxhnil = MXHNIL; /* max warns of t+h==t */ + ark_mem->maxnef = MAXNEF; /* max error test fails */ + ark_mem->maxncf = MAXNCF; /* max convergence fails */ + ark_mem->maxconstrfails = MAXCONSTRFAILS; /* max number of constraint fails */ + ark_mem->hin = ZERO; /* determine initial step on-the-fly */ + ark_mem->hmin = ZERO; /* no minimum step size */ + ark_mem->hmax_inv = ZERO; /* no maximum step size */ + ark_mem->tstopset = SUNFALSE; /* no stop time set */ + ark_mem->tstop = ZERO; /* no fixed stop time */ + ark_mem->diagfp = NULL; /* no solver diagnostics file */ + ark_mem->report = SUNFALSE; /* don't report solver diagnostics */ + ark_mem->hadapt_mem->etamx1 = ETAMX1; /* max change on first step */ + ark_mem->hadapt_mem->etamxf = ETAMXF; /* max change on error-failed step */ + ark_mem->hadapt_mem->etamin = ETAMIN; /* min bound on time step reduction */ + ark_mem->hadapt_mem->small_nef = SMALL_NEF; /* num error fails before ETAMXF enforced */ + ark_mem->hadapt_mem->etacf = ETACF; /* max change on convergence failure */ + ark_mem->hadapt_mem->HAdapt = NULL; /* step adaptivity fn */ + ark_mem->hadapt_mem->HAdapt_data = NULL; /* step adaptivity data */ + ark_mem->hadapt_mem->imethod = ARK_ADAPT_PID; /* PID controller */ + ark_mem->hadapt_mem->cfl = CFLFAC; /* explicit stability factor */ + ark_mem->hadapt_mem->safety = SAFETY; /* step adaptivity safety factor */ + ark_mem->hadapt_mem->bias = BIAS; /* step adaptivity error bias */ + ark_mem->hadapt_mem->growth = GROWTH; /* step adaptivity growth factor */ + ark_mem->hadapt_mem->lbound = HFIXED_LB; /* step adaptivity no-change lower bound */ + ark_mem->hadapt_mem->ubound = HFIXED_UB; /* step adaptivity no-change upper bound */ + ark_mem->hadapt_mem->k1 = AD0_K1; /* step adaptivity parameter */ + ark_mem->hadapt_mem->k2 = AD0_K2; /* step adaptivity parameter */ + ark_mem->hadapt_mem->k3 = AD0_K3; /* step adaptivity parameter */ + ark_mem->hadapt_mem->pq = SUNFALSE; /* use embedding order */ + ark_mem->hadapt_mem->expstab = arkExpStab; /* internal explicit stability fn */ + ark_mem->hadapt_mem->estab_data = NULL; /* no explicit stability fn data */ + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetInterpolantType: + + Specifies use of the Lagrange or Hermite interpolation modules. + itype == ARK_INTERP_HERMITE specifies the Hermite (nonstiff) + interpolation module. + itype == ARK_INTERP_LAGRANGE specifies the Lagrange (stiff) + interpolation module. + + Return values: + ARK_SUCCESS on success. + ARK_MEM_NULL on NULL-valued arkode_mem input. + ARK_MEM_FAIL if the interpolation module cannot be allocated. + ARK_ILL_INPUT if the itype argument is not recognized. + ---------------------------------------------------------------*/ +int arkSetInterpolantType(void *arkode_mem, int itype) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetInterpolantType", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* check for legal itype input */ + if ((itype != ARK_INTERP_HERMITE) && (itype != ARK_INTERP_LAGRANGE)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSetInterpolantType", + "Illegal interpolation type input."); + return(ARK_ILL_INPUT); + } + + /* do not change type once the module has been initialized */ + if (ark_mem->initialized) { + arkProcessError(ark_mem, ARK_INTERP_FAIL, "ARKode", + "arkSetInterpolantType", + "Type cannot be specified after module initialization."); + return(ARK_ILL_INPUT); + } + + /* delete any existing interpolation module */ + if (ark_mem->interp != NULL) { + arkInterpFree(ark_mem, ark_mem->interp); + ark_mem->interp = NULL; + } + + /* create requested interpolation module, initially specifying + the maximum possible interpolant degree. */ + if (itype == ARK_INTERP_HERMITE) { + ark_mem->interp = arkInterpCreate_Hermite(arkode_mem, ARK_INTERP_MAX_DEGREE); + } else { + ark_mem->interp = arkInterpCreate_Lagrange(arkode_mem, ARK_INTERP_MAX_DEGREE); + } + if (ark_mem->interp == NULL) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", "arkSetInterpolantType", + "Unable to allocate interpolation structure"); + return(ARK_MEM_FAIL); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetInterpolantDegree: + + Specifies the polynomial degree for the dense output + interpolation module. + + Return values: + ARK_SUCCESS on success. + ARK_MEM_NULL on NULL-valued arkode_mem input or nonexistent + interpolation module. + ARK_INTERP_FAIL if the interpolation module is already + initialized. + ARK_ILL_INPUT if the degree is illegal. + ---------------------------------------------------------------*/ +int arkSetInterpolantDegree(void *arkode_mem, int degree) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetInterpolantDegree", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + if (ark_mem->interp == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", + "arkSetInterpolantDegree", + "Interpolation module is not yet allocated"); + return(ARK_MEM_NULL); + } + + /* do not change degree once the module has been initialized */ + if (ark_mem->initialized) { + arkProcessError(ark_mem, ARK_INTERP_FAIL, "ARKode", + "arkSetInterpolantType", + "Degree cannot be specified after module initialization."); + return(ARK_ILL_INPUT); + } + + /* pass 'degree' to interpolation module, returning its value */ + return(arkInterpSetDegree(ark_mem, ark_mem->interp, degree)); +} + + +/*--------------------------------------------------------------- + arkSetErrHandlerFn: + + Specifies the error handler function + ---------------------------------------------------------------*/ +int arkSetErrHandlerFn(void *arkode_mem, ARKErrHandlerFn ehfun, + void *eh_data) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetErrHandlerFn", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* set user-provided values, or defaults, depending on argument */ + if (ehfun == NULL) { + ark_mem->ehfun = arkErrHandler; + ark_mem->eh_data = ark_mem; + } else { + ark_mem->ehfun = ehfun; + ark_mem->eh_data = eh_data; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetErrFile: + + Specifies the FILE pointer for output (NULL means no messages) + ---------------------------------------------------------------*/ +int arkSetErrFile(void *arkode_mem, FILE *errfp) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetErrFile", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + ark_mem->errfp = errfp; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetUserData: + + Specifies the user data pointer for f + ---------------------------------------------------------------*/ +int arkSetUserData(void *arkode_mem, void *user_data) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetUserData", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + ark_mem->user_data = user_data; + + /* Set data for efun */ + if (ark_mem->user_efun) + ark_mem->e_data = user_data; + + /* Set data for rfun */ + if (ark_mem->user_rfun) + ark_mem->r_data = user_data; + + /* Set data for root finding */ + if (ark_mem->root_mem != NULL) + ark_mem->root_mem->root_data = user_data; + + /* Set data for post-processing a step */ + if (ark_mem->ProcessStep != NULL) + ark_mem->ps_data = user_data; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetDiagnostics: + + Specifies to enable solver diagnostics, and specifies the FILE + pointer for output (diagfp==NULL disables output) + ---------------------------------------------------------------*/ +int arkSetDiagnostics(void *arkode_mem, FILE *diagfp) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetDiagnostics", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + ark_mem->diagfp = diagfp; + if (diagfp != NULL) { + ark_mem->report = SUNTRUE; + } else { + ark_mem->report = SUNFALSE; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetMaxNumSteps: + + Specifies the maximum number of integration steps + ---------------------------------------------------------------*/ +int arkSetMaxNumSteps(void *arkode_mem, long int mxsteps) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetMaxNumSteps", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* Passing mxsteps=0 sets the default. Passing mxsteps<0 disables the test. */ + if (mxsteps == 0) + ark_mem->mxstep = MXSTEP_DEFAULT; + else + ark_mem->mxstep = mxsteps; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetMaxHnilWarns: + + Specifies the maximum number of warnings for small h + ---------------------------------------------------------------*/ +int arkSetMaxHnilWarns(void *arkode_mem, int mxhnil) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetMaxHnilWarns", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* Passing mxhnil=0 sets the default, otherwise use input. */ + if (mxhnil == 0) { + ark_mem->mxhnil = 10; + } else { + ark_mem->mxhnil = mxhnil; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetInitStep: + + Specifies the initial step size + ---------------------------------------------------------------*/ +int arkSetInitStep(void *arkode_mem, realtype hin) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetInitStep", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* Passing hin=0 sets the default, otherwise use input. */ + if (hin == ZERO) { + ark_mem->hin = ZERO; + } else { + ark_mem->hin = hin; + } + + /* Clear previous initial step */ + ark_mem->h0u = ZERO; + + /* Clear error and step size history */ + ark_mem->hadapt_mem->ehist[0] = ONE; + ark_mem->hadapt_mem->ehist[1] = ONE; + ark_mem->hadapt_mem->hhist[0] = ZERO; + ark_mem->hadapt_mem->hhist[1] = ZERO; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetMinStep: + + Specifies the minimum step size + ---------------------------------------------------------------*/ +int arkSetMinStep(void *arkode_mem, realtype hmin) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetMinStep", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* Passing a value <= 0 sets hmin = 0 */ + if (hmin <= ZERO) { + ark_mem->hmin = ZERO; + return(ARK_SUCCESS); + } + + /* check that hmin and hmax are agreeable */ + if (hmin * ark_mem->hmax_inv > ONE) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSetMinStep", MSG_ARK_BAD_HMIN_HMAX); + return(ARK_ILL_INPUT); + } + + /* set the value */ + ark_mem->hmin = hmin; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetMaxStep: + + Specifies the maximum step size + ---------------------------------------------------------------*/ +int arkSetMaxStep(void *arkode_mem, realtype hmax) +{ + realtype hmax_inv; + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetMaxStep", MSG_ARK_NO_MEM); + return (ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* Passing a value <= 0 sets hmax = infinity */ + if (hmax <= ZERO) { + ark_mem->hmax_inv = ZERO; + return(ARK_SUCCESS); + } + + /* check that hmax and hmin are agreeable */ + hmax_inv = ONE/hmax; + if (hmax_inv * ark_mem->hmin > ONE) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSetMaxStep", MSG_ARK_BAD_HMIN_HMAX); + return(ARK_ILL_INPUT); + } + + /* set the value */ + ark_mem->hmax_inv = hmax_inv; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetStopTime: + + Specifies the time beyond which the integration is not to proceed. + ---------------------------------------------------------------*/ +int arkSetStopTime(void *arkode_mem, realtype tstop) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetStopTime", MSG_ARK_NO_MEM); + return (ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* If ARKode was called at least once, test if tstop is legal + (i.e. if it was not already passed). + If arkSetStopTime is called before the first call to ARKode, + tstop will be checked in ARKode. */ + if (ark_mem->nst > 0) { + if ( (tstop - ark_mem->tcur) * ark_mem->h < ZERO ) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSetStopTime", MSG_ARK_BAD_TSTOP, + tstop, ark_mem->tcur); + return(ARK_ILL_INPUT); + } + } + + ark_mem->tstop = tstop; + ark_mem->tstopset = SUNTRUE; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetFixedStep: + + Specifies to use a fixed time step size instead of performing + any form of temporal adaptivity. ARKode will use this step size + for all steps (unless tstop is set, in which case it may need to + modify that last step approaching tstop. If any solver failure + occurs in the timestepping module, ARKode will typically + immediately return with an error message indicating that the + selected step size cannot be used. + + Any nonzero argument will result in the use of that fixed step + size; an argument of 0 will re-enable temporal adaptivity. + ---------------------------------------------------------------*/ +int arkSetFixedStep(void *arkode_mem, realtype hfixed) +{ + int retval; + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetFixedStep", MSG_ARK_NO_MEM); + return (ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* re-attach internal error weight functions if necessary */ + if ((hfixed == ZERO) && (!ark_mem->user_efun)) { + if (ark_mem->itol == ARK_SV && ark_mem->Vabstol != NULL) + retval = arkSVtolerances(ark_mem, ark_mem->reltol, ark_mem->Vabstol); + else + retval = arkSStolerances(ark_mem, ark_mem->reltol, ark_mem->Sabstol); + if (retval != ARK_SUCCESS) return(retval); + } + + /* set ark_mem entry */ + if (hfixed != ZERO) { + ark_mem->fixedstep = SUNTRUE; + ark_mem->hin = hfixed; + } else { + ark_mem->fixedstep = SUNFALSE; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetRootDirection: + + Specifies the direction of zero-crossings to be monitored. + The default is to monitor both crossings. + ---------------------------------------------------------------*/ +int arkSetRootDirection(void *arkode_mem, int *rootdir) +{ + ARKodeMem ark_mem; + ARKodeRootMem ark_root_mem; + int i; + + if (arkode_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetRootDirection", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + if (ark_mem->root_mem == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", + "arkSetRootDirection", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_root_mem = (ARKodeRootMem) ark_mem->root_mem; + + if (ark_root_mem->nrtfn == 0) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSetRootDirection", MSG_ARK_NO_ROOT); + return(ARK_ILL_INPUT); + } + for(i=0; inrtfn; i++) + ark_root_mem->rootdir[i] = rootdir[i]; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetNoInactiveRootWarn: + + Disables issuing a warning if some root function appears + to be identically zero at the beginning of the integration + ---------------------------------------------------------------*/ +int arkSetNoInactiveRootWarn(void *arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeRootMem ark_root_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetNoInactiveRootWarn", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + if (ark_mem->root_mem == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", + "arkSetNoInactiveRootWarn", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_root_mem = (ARKodeRootMem) ark_mem->root_mem; + ark_root_mem->mxgnull = 0; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetPostprocessStepFn: + + Specifies a user-provided step postprocessing function having + type ARKPostProcessFn. A NULL input function disables step + postprocessing. + + IF THE SUPPLIED FUNCTION MODIFIES ANY OF THE ACTIVE STATE DATA, + THEN ALL THEORETICAL GUARANTEES OF SOLUTION ACCURACY AND + STABILITY ARE LOST. + ---------------------------------------------------------------*/ +int arkSetPostprocessStepFn(void *arkode_mem, + ARKPostProcessFn ProcessStep) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetPostprocessStepFn", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* NULL argument sets default, otherwise set inputs */ + ark_mem->ProcessStep = ProcessStep; + ark_mem->ps_data = ark_mem->user_data; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetPostprocessStageFn: + + Specifies a user-provided stage postprocessing function having + type ARKPostProcessFn. A NULL input function disables + stage postprocessing. + + IF THE SUPPLIED FUNCTION MODIFIES ANY OF THE ACTIVE STATE DATA, + THEN ALL THEORETICAL GUARANTEES OF SOLUTION ACCURACY AND + STABILITY ARE LOST. + ---------------------------------------------------------------*/ +int arkSetPostprocessStageFn(void *arkode_mem, + ARKPostProcessFn ProcessStage) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetPostprocessStageFn", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* NULL argument sets default, otherwise set inputs */ + ark_mem->ProcessStage = ProcessStage; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetConstraints: + + Activates or Deactivates inequality constraint checking. + ---------------------------------------------------------------*/ +int arkSetConstraints(void *arkode_mem, N_Vector constraints) +{ + realtype temptest; + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetConstraints", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* If there are no constraints, destroy data structures */ + if (constraints == NULL) { + arkFreeVec(ark_mem, &ark_mem->constraints); + ark_mem->constraintsSet = SUNFALSE; + return(ARK_SUCCESS); + } + + /* Test if required vector ops. are defined */ + if (constraints->ops->nvdiv == NULL || + constraints->ops->nvmaxnorm == NULL || + constraints->ops->nvcompare == NULL || + constraints->ops->nvconstrmask == NULL || + constraints->ops->nvminquotient == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetConstraints", MSG_ARK_BAD_NVECTOR); + return(ARK_ILL_INPUT); + } + + /* Check the constraints vector */ + temptest = N_VMaxNorm(constraints); + if ((temptest > RCONST(2.5)) || (temptest < HALF)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::ARKStep", + "ARKStepSetConstraints", MSG_ARK_BAD_CONSTR); + return(ARK_ILL_INPUT); + } + + /* Allocate the internal constrains vector (if necessary) */ + if (!arkAllocVec(ark_mem, constraints, &ark_mem->constraints)) + return(ARK_MEM_FAIL); + + /* Load the constraints vector */ + N_VScale(ONE, constraints, ark_mem->constraints); + ark_mem->constraintsSet = SUNTRUE; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetMaxNumConstrFails: + + Set max number of allowed constraint failures in a step before + returning an error + ---------------------------------------------------------------*/ +int arkSetMaxNumConstrFails(void *arkode_mem, int maxfails) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetMaxNumConstrFails", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* Passing maxfails = 0 sets the default, otherwise set to input */ + if (maxfails <= 0) + ark_mem->maxconstrfails = MAXCONSTRFAILS; + else + ark_mem->maxconstrfails = maxfails; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetCFLFraction: + + Specifies the safety factor to use on the maximum explicitly- + stable step size. Allowable values must be within the open + interval (0,1). A non-positive input implies a reset to + the default value. + ---------------------------------------------------------------*/ +int arkSetCFLFraction(void *arkode_mem, realtype cfl_frac) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetCFLFraction", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* check for allowable parameters */ + if (cfl_frac >= ONE) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSetCFLFraction", "Illegal CFL fraction"); + return(ARK_ILL_INPUT); + } + + /* set positive-valued parameters, otherwise set default */ + if (cfl_frac <= ZERO) { + hadapt_mem->cfl = CFLFAC; + } else { + hadapt_mem->cfl = cfl_frac; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetSafetyFactor: + + Specifies the safety factor to use on the error-based predicted + time step size. Allowable values must be within the open + interval (0,1). A non-positive input implies a reset to the + default value. + ---------------------------------------------------------------*/ +int arkSetSafetyFactor(void *arkode_mem, realtype safety) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetSafetyFactor", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* check for allowable parameters */ + if (safety >= ONE) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSetSafetyFactor", "Illegal safety factor"); + return(ARK_ILL_INPUT); + } + + /* set positive-valued parameters, otherwise set default */ + if (safety <= ZERO) { + hadapt_mem->safety = SAFETY; + } else { + hadapt_mem->safety = safety; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetErrorBias: + + Specifies the error bias to use when performing adaptive-step + error control. Allowable values must be >= 1.0. Any illegal + value implies a reset to the default value. + ---------------------------------------------------------------*/ +int arkSetErrorBias(void *arkode_mem, realtype bias) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetErrorBias", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set allowed value, otherwise set default */ + if (bias < ONE) { + hadapt_mem->bias = BIAS; + } else { + hadapt_mem->bias = bias; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetMaxGrowth: + + Specifies the maximum step size growth factor to be allowed + between successive integration steps. Note: the first step uses + a separate maximum growth factor. Allowable values must be + > 1.0. Any illegal value implies a reset to the default. + ---------------------------------------------------------------*/ +int arkSetMaxGrowth(void *arkode_mem, realtype mx_growth) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetMaxGrowth", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set allowed value, otherwise set default */ + if (mx_growth <= ONE) { + hadapt_mem->growth = GROWTH; + } else { + hadapt_mem->growth = mx_growth; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetMinReduction: + + Specifies the minimum possible step size reduction factor to be + allowed between successive integration steps. Allowable values + must be > 0.0 and < 1.0. Any illegal value implies a reset to + the default. + ---------------------------------------------------------------*/ +int arkSetMinReduction(void *arkode_mem, realtype eta_min) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetMinReduction", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set allowed value, otherwise set default */ + if (eta_min >= ONE || eta_min <= ZERO) { + hadapt_mem->etamin = ETAMIN; + } else { + hadapt_mem->etamin = eta_min; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetFixedStepBounds: + + Specifies the step size growth interval within which the step + size will remain unchanged. Allowable values must enclose the + value 1.0. Any illegal interval implies a reset to the default. + ---------------------------------------------------------------*/ +int arkSetFixedStepBounds(void *arkode_mem, realtype lb, realtype ub) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetFixedStepBounds", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set allowable interval, otherwise set defaults */ + if ((lb <= ONE) && (ub >= ONE)) { + hadapt_mem->lbound = lb; + hadapt_mem->ubound = ub; + } else { + hadapt_mem->lbound = HFIXED_LB; + hadapt_mem->ubound = HFIXED_UB; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetAdaptivityMethod: + + Specifies the built-in time step adaptivity algorithm (and + optionally, its associated parameters) to use. All parameters + will be checked for validity when used by the solver. + ---------------------------------------------------------------*/ +int arkSetAdaptivityMethod(void *arkode_mem, int imethod, int idefault, + int pq, realtype adapt_params[3]) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetAdaptivityMethod", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* check for allowable parameters */ + if ((imethod > ARK_ADAPT_IMEX_GUS) || (imethod < ARK_ADAPT_PID)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkSetAdaptivityMethod", "Illegal imethod"); + return(ARK_ILL_INPUT); + } + + /* set adaptivity method */ + hadapt_mem->imethod = imethod; + + /* set flag whether to use p (embedding, 0) or q (method, 1) order */ + hadapt_mem->pq = (pq != 0); + + /* set method parameters */ + if (idefault == 1) { + switch (hadapt_mem->imethod) { + case (ARK_ADAPT_PID): + hadapt_mem->k1 = AD0_K1; + hadapt_mem->k2 = AD0_K2; + hadapt_mem->k3 = AD0_K3; break; + case (ARK_ADAPT_PI): + hadapt_mem->k1 = AD1_K1; + hadapt_mem->k2 = AD1_K2; break; + case (ARK_ADAPT_I): + hadapt_mem->k1 = AD2_K1; break; + case (ARK_ADAPT_EXP_GUS): + hadapt_mem->k1 = AD3_K1; + hadapt_mem->k2 = AD3_K2; break; + case (ARK_ADAPT_IMP_GUS): + hadapt_mem->k1 = AD4_K1; + hadapt_mem->k2 = AD4_K2; break; + case (ARK_ADAPT_IMEX_GUS): + hadapt_mem->k1 = AD5_K1; + hadapt_mem->k2 = AD5_K2; + hadapt_mem->k3 = AD5_K3; break; + } + } else { + hadapt_mem->k1 = adapt_params[0]; + hadapt_mem->k2 = adapt_params[1]; + hadapt_mem->k3 = adapt_params[2]; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetAdaptivityFn: + + Specifies the user-provided time step adaptivity function to use. + ---------------------------------------------------------------*/ +int arkSetAdaptivityFn(void *arkode_mem, ARKAdaptFn hfun, void *h_data) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetAdaptivityFn", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* NULL hfun sets default, otherwise set inputs */ + if (hfun == NULL) { + hadapt_mem->HAdapt = NULL; + hadapt_mem->HAdapt_data = NULL; + hadapt_mem->imethod = ARK_ADAPT_PID; + } else { + hadapt_mem->HAdapt = hfun; + hadapt_mem->HAdapt_data = h_data; + hadapt_mem->imethod = ARK_ADAPT_CUSTOM; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetMaxFirstGrowth: + + Specifies the user-provided time step adaptivity constant + etamx1. Legal values are greater than 1.0. Illegal values + imply a reset to the default value. + ---------------------------------------------------------------*/ +int arkSetMaxFirstGrowth(void *arkode_mem, realtype etamx1) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetMaxFirstGrowth", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if argument legal set it, otherwise set default */ + if (etamx1 <= ONE) { + hadapt_mem->etamx1 = ETAMX1; + } else { + hadapt_mem->etamx1 = etamx1; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetMaxEFailGrowth: + + Specifies the user-provided time step adaptivity constant + etamxf. Legal values are in the interval (0,1]. Illegal values + imply a reset to the default value. + ---------------------------------------------------------------*/ +int arkSetMaxEFailGrowth(void *arkode_mem, realtype etamxf) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetMaxEFailGrowth", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if argument legal set it, otherwise set default */ + if ((etamxf <= ZERO) || (etamxf > ONE)) { + hadapt_mem->etamxf = ETAMXF; + } else { + hadapt_mem->etamxf = etamxf; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetSmallNumEFails: + + Specifies the user-provided time step adaptivity constant + small_nef. Legal values are > 0. Illegal values + imply a reset to the default value. + ---------------------------------------------------------------*/ +int arkSetSmallNumEFails(void *arkode_mem, int small_nef) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetSmallNumEFails", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if argument legal set it, otherwise set default */ + if (small_nef <= 0) { + hadapt_mem->small_nef = SMALL_NEF; + } else { + hadapt_mem->small_nef = small_nef; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetMaxCFailGrowth: + + Specifies the user-provided time step adaptivity constant + etacf. Legal values are in the interval (0,1]. Illegal values + imply a reset to the default value. + ---------------------------------------------------------------*/ +int arkSetMaxCFailGrowth(void *arkode_mem, realtype etacf) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetMaxCFailGrowth", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if argument legal set it, otherwise set default */ + if ((etacf <= ZERO) || (etacf > ONE)) { + hadapt_mem->etacf = ETACF; + } else { + hadapt_mem->etacf = etacf; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetStabilityFn: + + Specifies the user-provided explicit time step stability + function to use. A NULL input function implies a reset to + the default function (empty). + ---------------------------------------------------------------*/ +int arkSetStabilityFn(void *arkode_mem, ARKExpStabFn EStab, void *estab_data) +{ + int retval; + ARKodeHAdaptMem hadapt_mem; + ARKodeMem ark_mem; + retval = arkAccessHAdaptMem(arkode_mem, "arkSetStabilityFn", + &ark_mem, &hadapt_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* NULL argument sets default, otherwise set inputs */ + if (EStab == NULL) { + hadapt_mem->expstab = arkExpStab; + hadapt_mem->estab_data = ark_mem; + } else { + hadapt_mem->expstab = EStab; + hadapt_mem->estab_data = estab_data; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetMaxErrTestFails: + + Specifies the maximum number of error test failures during one + step try. A non-positive input implies a reset to + the default value. + ---------------------------------------------------------------*/ +int arkSetMaxErrTestFails(void *arkode_mem, int maxnef) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetMaxErrTestFails", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* argument <= 0 sets default, otherwise set input */ + if (maxnef <= 0) { + ark_mem->maxnef = MAXNEF; + } else { + ark_mem->maxnef = maxnef; + } + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkSetMaxConvFails: + + Specifies the maximum number of nonlinear convergence failures + during one step try. A non-positive input implies a reset to + the default value. + ---------------------------------------------------------------*/ +int arkSetMaxConvFails(void *arkode_mem, int maxncf) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetMaxConvFails", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + /* argument <= 0 sets default, otherwise set input */ + if (maxncf <= 0) { + ark_mem->maxncf = MAXNCF; + } else { + ark_mem->maxncf = maxncf; + } + return(ARK_SUCCESS); +} + + + +/*=============================================================== + ARKode optional output utility functions + ===============================================================*/ + +/*--------------------------------------------------------------- + arkGetNumStepAttempts: + + Returns the current number of steps attempted by the solver + ---------------------------------------------------------------*/ +int arkGetNumStepAttempts(void *arkode_mem, long int *nstep_attempts) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetNumStepAttempts", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *nstep_attempts = ark_mem->nst_attempts; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetNumSteps: + + Returns the current number of integration steps + ---------------------------------------------------------------*/ +int arkGetNumSteps(void *arkode_mem, long int *nsteps) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetNumSteps", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *nsteps = ark_mem->nst; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetActualInitStep: + + Returns the step size used on the first step + ---------------------------------------------------------------*/ +int arkGetActualInitStep(void *arkode_mem, realtype *hinused) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetActualInitStep", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *hinused = ark_mem->h0u; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetLastStep: + + Returns the step size used on the last successful step + ---------------------------------------------------------------*/ +int arkGetLastStep(void *arkode_mem, realtype *hlast) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetLastStep", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *hlast = ark_mem->hold; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetCurrentStep: + + Returns the step size to be attempted on the next step + ---------------------------------------------------------------*/ +int arkGetCurrentStep(void *arkode_mem, realtype *hcur) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetCurrentStep", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *hcur = ark_mem->next_h; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetCurrentState: + + Returns the current solution (before or after as step) or + stage value (during step solve). + ---------------------------------------------------------------*/ +int arkGetCurrentState(void *arkode_mem, N_Vector *state) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetCurrentState", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *state = ark_mem->ycur; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetCurrentTime: + + Returns the current value of the independent variable + ---------------------------------------------------------------*/ +int arkGetCurrentTime(void *arkode_mem, realtype *tcur) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetCurrentTime", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *tcur = ark_mem->tcur; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetTolScaleFactor: + + Returns a suggested factor for scaling tolerances + ---------------------------------------------------------------*/ +int arkGetTolScaleFactor(void *arkode_mem, realtype *tolsfact) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetTolScaleFactor", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *tolsfact = ark_mem->tolsf; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetErrWeights: + + This routine returns the current error weight vector. + ---------------------------------------------------------------*/ +int arkGetErrWeights(void *arkode_mem, N_Vector eweight) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetErrWeights", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + N_VScale(ONE, ark_mem->ewt, eweight); + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetResWeights: + + This routine returns the current residual weight vector. + ---------------------------------------------------------------*/ +int arkGetResWeights(void *arkode_mem, N_Vector rweight) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetResWeights", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + N_VScale(ONE, ark_mem->rwt, rweight); + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetWorkSpace: + + Returns integrator work space requirements + ---------------------------------------------------------------*/ +int arkGetWorkSpace(void *arkode_mem, long int *lenrw, long int *leniw) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetWorkSpace", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *leniw = ark_mem->liw; + *lenrw = ark_mem->lrw; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetNumGEvals: + + Returns the current number of calls to g (for rootfinding) + ---------------------------------------------------------------*/ +int arkGetNumGEvals(void *arkode_mem, long int *ngevals) +{ + ARKodeMem ark_mem; + ARKodeRootMem ark_root_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetNumGEvals", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + if (ark_mem->root_mem == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", + "arkGetNumGEvals", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_root_mem = (ARKodeRootMem) ark_mem->root_mem; + *ngevals = ark_root_mem->nge; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetRootInfo: + + Returns pointer to array rootsfound showing roots found + ---------------------------------------------------------------*/ +int arkGetRootInfo(void *arkode_mem, int *rootsfound) +{ + int i; + ARKodeMem ark_mem; + ARKodeRootMem ark_root_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetRootInfo", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + if (ark_mem->root_mem == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode", + "arkGetRootInfo", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_root_mem = (ARKodeRootMem) ark_mem->root_mem; + for (i=0; inrtfn; i++) + rootsfound[i] = ark_root_mem->iroots[i]; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetStepStats: + + Returns step statistics + ---------------------------------------------------------------*/ +int arkGetStepStats(void *arkode_mem, long int *nsteps, + realtype *hinused, realtype *hlast, + realtype *hcur, realtype *tcur) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetStepStats", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *nsteps = ark_mem->nst; + *hinused = ark_mem->h0u; + *hlast = ark_mem->hold; + *hcur = ark_mem->next_h; + *tcur = ark_mem->tcur; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetNumConstrFails: + + Returns the current number of constraint fails + ---------------------------------------------------------------*/ +int arkGetNumConstrFails(void *arkode_mem, long int *nconstrfails) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetNumConstrFails", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *nconstrfails = ark_mem->nconstrfails; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetNumExpSteps: + + Returns the current number of stability-limited steps + ---------------------------------------------------------------*/ +int arkGetNumExpSteps(void *arkode_mem, long int *nsteps) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetNumExpSteps", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *nsteps = ark_mem->hadapt_mem->nst_exp; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetNumAccSteps: + + Returns the current number of accuracy-limited steps + ---------------------------------------------------------------*/ +int arkGetNumAccSteps(void *arkode_mem, long int *nsteps) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetNumAccSteps", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *nsteps = ark_mem->hadapt_mem->nst_acc; + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetNumErrTestFails: + + Returns the current number of error test failures + ---------------------------------------------------------------*/ +int arkGetNumErrTestFails(void *arkode_mem, long int *netfails) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetNumErrTestFails", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *netfails = ark_mem->netf; + return(ARK_SUCCESS); +} + +/*-----------------------------------------------------------------*/ + +char *arkGetReturnFlagName(long int flag) +{ + char *name; + name = (char *)malloc(27*sizeof(char)); + + switch(flag) { + case ARK_SUCCESS: + sprintf(name,"ARK_SUCCESS"); + break; + case ARK_TSTOP_RETURN: + sprintf(name,"ARK_TSTOP_RETURN"); + break; + case ARK_ROOT_RETURN: + sprintf(name,"ARK_ROOT_RETURN"); + break; + case ARK_TOO_MUCH_WORK: + sprintf(name,"ARK_TOO_MUCH_WORK"); + break; + case ARK_TOO_MUCH_ACC: + sprintf(name,"ARK_TOO_MUCH_ACC"); + break; + case ARK_ERR_FAILURE: + sprintf(name,"ARK_ERR_FAILURE"); + break; + case ARK_CONV_FAILURE: + sprintf(name,"ARK_CONV_FAILURE"); + break; + case ARK_LINIT_FAIL: + sprintf(name,"ARK_LINIT_FAIL"); + break; + case ARK_LSETUP_FAIL: + sprintf(name,"ARK_LSETUP_FAIL"); + break; + case ARK_LSOLVE_FAIL: + sprintf(name,"ARK_LSOLVE_FAIL"); + break; + case ARK_RHSFUNC_FAIL: + sprintf(name,"ARK_RHSFUNC_FAIL"); + break; + case ARK_FIRST_RHSFUNC_ERR: + sprintf(name,"ARK_FIRST_RHSFUNC_ERR"); + break; + case ARK_REPTD_RHSFUNC_ERR: + sprintf(name,"ARK_REPTD_RHSFUNC_ERR"); + break; + case ARK_UNREC_RHSFUNC_ERR: + sprintf(name,"ARK_UNREC_RHSFUNC_ERR"); + break; + case ARK_RTFUNC_FAIL: + sprintf(name,"ARK_RTFUNC_FAIL"); + break; + case ARK_LFREE_FAIL: + sprintf(name,"ARK_LFREE_FAIL"); + break; + case ARK_MASSINIT_FAIL: + sprintf(name,"ARK_MASSINIT_FAIL"); + break; + case ARK_MASSSETUP_FAIL: + sprintf(name,"ARK_MASSSETUP_FAIL"); + break; + case ARK_MASSSOLVE_FAIL: + sprintf(name,"ARK_MASSSOLVE_FAIL"); + break; + case ARK_MASSFREE_FAIL: + sprintf(name,"ARK_MASSFREE_FAIL"); + break; + case ARK_MASSMULT_FAIL: + sprintf(name,"ARK_MASSMULT_FAIL"); + break; + case ARK_MEM_FAIL: + sprintf(name,"ARK_MEM_FAIL"); + break; + case ARK_MEM_NULL: + sprintf(name,"ARK_MEM_NULL"); + break; + case ARK_ILL_INPUT: + sprintf(name,"ARK_ILL_INPUT"); + break; + case ARK_NO_MALLOC: + sprintf(name,"ARK_NO_MALLOC"); + break; + case ARK_BAD_K: + sprintf(name,"ARK_BAD_K"); + break; + case ARK_BAD_T: + sprintf(name,"ARK_BAD_T"); + break; + case ARK_BAD_DKY: + sprintf(name,"ARK_BAD_DKY"); + break; + case ARK_TOO_CLOSE: + sprintf(name,"ARK_TOO_CLOSE"); + break; + case ARK_POSTPROCESS_STEP_FAIL: + sprintf(name,"ARK_POSTPROCESS_STEP_FAIL"); + break; + case ARK_POSTPROCESS_STAGE_FAIL: + sprintf(name,"ARK_POSTPROCESS_STAGE_FAIL"); + break; + case ARK_VECTOROP_ERR: + sprintf(name,"ARK_VECTOROP_ERR"); + break; + case ARK_NLS_INIT_FAIL: + sprintf(name,"ARK_NLS_INIT_FAIL"); + break; + case ARK_NLS_SETUP_FAIL: + sprintf(name,"ARK_NLS_SETUP_FAIL"); + break; + case ARK_NLS_OP_ERR: + sprintf(name,"ARK_NLS_OP_ERR"); + break; + case ARK_INNERSTEP_ATTACH_ERR: + sprintf(name,"ARK_INNERSTEP_ATTACH_ERR"); + break; + case ARK_INNERSTEP_FAIL: + sprintf(name,"ARK_INNERSTEP_FAIL"); + break; + default: + sprintf(name,"NONE"); + } + + return(name); +} + + + +/*=============================================================== + ARKode parameter output utility routine + ===============================================================*/ + +/*--------------------------------------------------------------- + arkodeWriteParameters: + + Outputs all solver parameters to the provided file pointer. + ---------------------------------------------------------------*/ +int arkWriteParameters(ARKodeMem ark_mem, FILE *fp) +{ + if (ark_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkWriteParameters", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + + /* print integrator parameters to file */ + STAN_SUNDIALS_FPRINTF(fp, "ARKode solver parameters:\n"); + if (ark_mem->hmin != ZERO) + STAN_SUNDIALS_FPRINTF(fp, " Minimum step size = %" RSYM"\n",ark_mem->hmin); + if (ark_mem->hmax_inv != ZERO) + STAN_SUNDIALS_FPRINTF(fp, " Maximum step size = %" RSYM"\n",ONE/ark_mem->hmax_inv); + if (ark_mem->fixedstep) + STAN_SUNDIALS_FPRINTF(fp, " Fixed time-stepping enabled\n"); + if (ark_mem->itol == ARK_WF) { + STAN_SUNDIALS_FPRINTF(fp, " User provided error weight function\n"); + } else { + STAN_SUNDIALS_FPRINTF(fp, " Solver relative tolerance = %" RSYM"\n", ark_mem->reltol); + if (ark_mem->itol == ARK_SS) { + STAN_SUNDIALS_FPRINTF(fp, " Solver absolute tolerance = %" RSYM"\n", ark_mem->Sabstol); + } else { + STAN_SUNDIALS_FPRINTF(fp, " Vector-valued solver absolute tolerance\n"); + } + } + if (!ark_mem->rwt_is_ewt) { + if (ark_mem->ritol == ARK_WF) { + STAN_SUNDIALS_FPRINTF(fp, " User provided residual weight function\n"); + } else { + if (ark_mem->ritol == ARK_SS) { + STAN_SUNDIALS_FPRINTF(fp, " Absolute residual tolerance = %" RSYM"\n", ark_mem->SRabstol); + } else { + STAN_SUNDIALS_FPRINTF(fp, " Vector-valued residual absolute tolerance\n"); + } + } + } + if (ark_mem->hin != ZERO) + STAN_SUNDIALS_FPRINTF(fp, " Initial step size = %" RSYM"\n",ark_mem->hin); + STAN_SUNDIALS_FPRINTF(fp, "\n"); + STAN_SUNDIALS_FPRINTF(fp, " Maximum step increase (first step) = %"RSYM"\n", + ark_mem->hadapt_mem->etamx1); + STAN_SUNDIALS_FPRINTF(fp, " Step reduction factor on multiple error fails = %"RSYM"\n", + ark_mem->hadapt_mem->etamxf); + STAN_SUNDIALS_FPRINTF(fp, " Minimum error fails before above factor is used = %i\n", + ark_mem->hadapt_mem->small_nef); + STAN_SUNDIALS_FPRINTF(fp, " Step reduction factor on nonlinear convergence failure = %"RSYM"\n", + ark_mem->hadapt_mem->etacf); + STAN_SUNDIALS_FPRINTF(fp, " Explicit safety factor = %"RSYM"\n", + ark_mem->hadapt_mem->cfl); + if (ark_mem->hadapt_mem->HAdapt == NULL) { + STAN_SUNDIALS_FPRINTF(fp, " Time step adaptivity method %i\n", ark_mem->hadapt_mem->imethod); + STAN_SUNDIALS_FPRINTF(fp, " Safety factor = %"RSYM"\n", ark_mem->hadapt_mem->safety); + STAN_SUNDIALS_FPRINTF(fp, " Bias factor = %"RSYM"\n", ark_mem->hadapt_mem->bias); + STAN_SUNDIALS_FPRINTF(fp, " Growth factor = %"RSYM"\n", ark_mem->hadapt_mem->growth); + STAN_SUNDIALS_FPRINTF(fp, " Step growth lower bound = %"RSYM"\n", ark_mem->hadapt_mem->lbound); + STAN_SUNDIALS_FPRINTF(fp, " Step growth upper bound = %"RSYM"\n", ark_mem->hadapt_mem->ubound); + STAN_SUNDIALS_FPRINTF(fp, " k1 = %"RSYM"\n", ark_mem->hadapt_mem->k1); + STAN_SUNDIALS_FPRINTF(fp, " k2 = %"RSYM"\n", ark_mem->hadapt_mem->k2); + STAN_SUNDIALS_FPRINTF(fp, " k3 = %"RSYM"\n", ark_mem->hadapt_mem->k3); + if (ark_mem->hadapt_mem->expstab == arkExpStab) { + STAN_SUNDIALS_FPRINTF(fp, " Default explicit stability function\n"); + } else { + STAN_SUNDIALS_FPRINTF(fp, " User provided explicit stability function\n"); + } + } else { + STAN_SUNDIALS_FPRINTF(fp, " User provided time step adaptivity function\n"); + } + + STAN_SUNDIALS_FPRINTF(fp, " Maximum number of error test failures = %i\n",ark_mem->maxnef); + STAN_SUNDIALS_FPRINTF(fp, " Maximum number of convergence test failures = %i\n",ark_mem->maxncf); + + return(ARK_SUCCESS); +} + + +/*=============================================================== + ARKODE + XBraid interface utility functions + ===============================================================*/ + + +/*--------------------------------------------------------------- + arkSetForcePass: + + Ignore the value of kflag after the temporal error test and + force the step to pass. + ---------------------------------------------------------------*/ +int arkSetForcePass(void *arkode_mem, booleantype force_pass) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkSetForcePass", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + ark_mem->force_pass = force_pass; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkGetLastKFlag: + + The last kflag value retured by the temporal error test. + ---------------------------------------------------------------*/ +int arkGetLastKFlag(void *arkode_mem, int *last_kflag) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkGetLastKFlag", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + *last_kflag = ark_mem->last_kflag; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + EOF + ---------------------------------------------------------------*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_ls.c b/lib/sundials_6.1.1/src/arkode/arkode_ls.c new file mode 100644 index 00000000000..cf787623389 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_ls.c @@ -0,0 +1,3293 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * Implementation file for ARKode's linear solver interface. + *---------------------------------------------------------------*/ + +#include +#include +#include +#include "arkode_impl.h" +#include "arkode_ls_impl.h" +#include +#include +#include +#include + +/* constants */ +#define MIN_INC_MULT RCONST(1000.0) +#define MAX_DQITERS 3 /* max. # of attempts to recover in DQ J*v */ +#define ZERO RCONST(0.0) +#define PT25 RCONST(0.25) +#define ONE RCONST(1.0) + +/* Prototypes for internal functions */ +static int arkLsLinSys(realtype t, N_Vector y, N_Vector fy, SUNMatrix A, + SUNMatrix M, booleantype jok, booleantype *jcur, + realtype gamma, void *user_data, N_Vector tmp1, + N_Vector tmp2, N_Vector tmp3); + +/*=============================================================== + ARKLS utility routines (called by time-stepper modules) + ===============================================================*/ + +/*--------------------------------------------------------------- + arkLSSetLinearSolver specifies the linear solver. + ---------------------------------------------------------------*/ +int arkLSSetLinearSolver(void *arkode_mem, SUNLinearSolver LS, + SUNMatrix A) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + SUNLinearSolver_Type LSType; + booleantype iterative; /* is the solver iterative? */ + booleantype matrixbased; /* is a matrix structure used? */ + + /* Return immediately if either arkode_mem or LS inputs are NULL */ + if (arkode_mem == NULL) { + arkProcessError(NULL, ARKLS_MEM_NULL, "ARKLS", + "arkLSSetLinearSolver", MSG_LS_ARKMEM_NULL); + return(ARKLS_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + if (LS == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetLinearSolver", + "LS must be non-NULL"); + return(ARKLS_ILL_INPUT); + } + + /* Test if solver is compatible with LS interface */ + if ( (LS->ops->gettype == NULL) || (LS->ops->solve == NULL) ) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetLinearSolver", + "LS object is missing a required operation"); + return(ARKLS_ILL_INPUT); + } + + /* Retrieve the LS type */ + LSType = SUNLinSolGetType(LS); + + /* Set flags based on LS type */ + iterative = (LSType != SUNLINEARSOLVER_DIRECT); + matrixbased = ((LSType != SUNLINEARSOLVER_ITERATIVE) && + (LSType != SUNLINEARSOLVER_MATRIX_EMBEDDED)); + + /* Test if vector is compatible with LS interface */ + if ( (ark_mem->tempv1->ops->nvconst == NULL) || + (ark_mem->tempv1->ops->nvwrmsnorm == NULL) ) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetLinearSolver", MSG_LS_BAD_NVECTOR); + return(ARKLS_ILL_INPUT); + } + + /* Ensure that A is NULL when LS is matrix-embedded */ + if ((LSType == SUNLINEARSOLVER_MATRIX_EMBEDDED) && (A != NULL)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetLinearSolver", + "Incompatible inputs: matrix-embedded LS requires NULL matrix"); + return(ARKLS_ILL_INPUT); + } + + /* Check for compatible LS type, matrix and "atimes" support */ + if (iterative) { + + if (ark_mem->tempv1->ops->nvgetlength == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetLinearSolver", MSG_LS_BAD_NVECTOR); + return(ARKLS_ILL_INPUT); + } + + if (!matrixbased && (LSType != SUNLINEARSOLVER_MATRIX_EMBEDDED) && + (LS->ops->setatimes == NULL)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetLinearSolver", + "Incompatible inputs: iterative LS must support ATimes routine"); + return(ARKLS_ILL_INPUT); + } + + if (matrixbased && (A == NULL)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetLinearSolver", + "Incompatible inputs: matrix-iterative LS requires non-NULL matrix"); + return(ARKLS_ILL_INPUT); + } + + } else if (A == NULL) { + + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetLinearSolver", + "Incompatible inputs: direct LS requires non-NULL matrix"); + return(ARKLS_ILL_INPUT); + + } + + /* Test whether time stepper module is supplied, with required routines */ + if ( (ark_mem->step_attachlinsol == NULL) || + (ark_mem->step_getlinmem == NULL) || + (ark_mem->step_getimplicitrhs == NULL) || + (ark_mem->step_getgammas == NULL) ) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetLinearSolver", + "Missing time step module or associated routines"); + return(ARKLS_ILL_INPUT); + } + + /* Allocate memory for ARKLsMemRec */ + arkls_mem = NULL; + arkls_mem = (ARKLsMem) malloc(sizeof(struct ARKLsMemRec)); + if (arkls_mem == NULL) { + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKLS", + "arkLSSetLinearSolver", MSG_LS_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + memset(arkls_mem, 0, sizeof(struct ARKLsMemRec)); + + /* set SUNLinearSolver pointer */ + arkls_mem->LS = LS; + + /* Linear solver type information */ + arkls_mem->iterative = iterative; + arkls_mem->matrixbased = matrixbased; + + /* Set defaults for Jacobian-related fields */ + if (A != NULL) { + arkls_mem->jacDQ = SUNTRUE; + arkls_mem->jac = arkLsDQJac; + arkls_mem->J_data = ark_mem; + } else { + arkls_mem->jacDQ = SUNFALSE; + arkls_mem->jac = NULL; + arkls_mem->J_data = NULL; + } + + arkls_mem->jtimesDQ = SUNTRUE; + arkls_mem->jtsetup = NULL; + arkls_mem->jtimes = arkLsDQJtimes; + arkls_mem->Jt_data = ark_mem; + arkls_mem->Jt_f = ark_mem->step_getimplicitrhs(arkode_mem); + + if (arkls_mem->Jt_f == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetLinearSolver", + "Time step module is missing implicit RHS fcn"); + free(arkls_mem); arkls_mem = NULL; + return(ARKLS_ILL_INPUT); + } + + arkls_mem->user_linsys = SUNFALSE; + arkls_mem->linsys = arkLsLinSys; + arkls_mem->A_data = ark_mem; + + /* Set defaults for preconditioner-related fields */ + arkls_mem->pset = NULL; + arkls_mem->psolve = NULL; + arkls_mem->pfree = NULL; + arkls_mem->P_data = ark_mem->user_data; + + /* Initialize counters */ + arkLsInitializeCounters(arkls_mem); + + /* Set default values for the rest of the LS parameters */ + arkls_mem->msbj = ARKLS_MSBJ; + arkls_mem->jbad = SUNTRUE; + arkls_mem->eplifac = ARKLS_EPLIN; + arkls_mem->last_flag = ARKLS_SUCCESS; + + /* If LS supports ATimes, attach ARKLs routine */ + if (LS->ops->setatimes) { + retval = SUNLinSolSetATimes(LS, ark_mem, arkLsATimes); + if (retval != SUNLS_SUCCESS) { + arkProcessError(ark_mem, ARKLS_SUNLS_FAIL, "ARKLS", + "arkLSSetLinearSolver", + "Error in calling SUNLinSolSetATimes"); + free(arkls_mem); arkls_mem = NULL; + return(ARKLS_SUNLS_FAIL); + } + } + + /* If LS supports preconditioning, initialize pset/psol to NULL */ + if (LS->ops->setpreconditioner) { + retval = SUNLinSolSetPreconditioner(LS, ark_mem, NULL, NULL); + if (retval != SUNLS_SUCCESS) { + arkProcessError(ark_mem, ARKLS_SUNLS_FAIL, "ARKLS", + "arkLSSetLinearSolver", + "Error in calling SUNLinSolSetPreconditioner"); + free(arkls_mem); arkls_mem = NULL; + return(ARKLS_SUNLS_FAIL); + } + } + + /* When using a SUNMatrix object, store pointer to A and initialize savedJ */ + if (A != NULL) { + arkls_mem->A = A; + arkls_mem->savedJ = NULL; /* allocated in arkLsInitialize */ + } + + /* Allocate memory for ytemp and x */ + if (!arkAllocVec(ark_mem, ark_mem->tempv1, &(arkls_mem->ytemp))) { + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKLS", + "arkLSSetLinearSolver", MSG_LS_MEM_FAIL); + free(arkls_mem); arkls_mem = NULL; + return(ARKLS_MEM_FAIL); + } + + if (!arkAllocVec(ark_mem, ark_mem->tempv1, &(arkls_mem->x))) { + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKLS", + "arkLSSetLinearSolver", MSG_LS_MEM_FAIL); + arkFreeVec(ark_mem, &(arkls_mem->ytemp)); + free(arkls_mem); arkls_mem = NULL; + return(ARKLS_MEM_FAIL); + } + + /* For iterative LS, compute default norm conversion factor */ + if (iterative) + arkls_mem->nrmfac = SUNRsqrt( N_VGetLength(arkls_mem->ytemp) ); + + /* For matrix-based LS, enable solution scaling */ + if (matrixbased) + arkls_mem->scalesol = SUNTRUE; + else + arkls_mem->scalesol = SUNFALSE; + + /* Attach ARKLs interface to time stepper module */ + retval = ark_mem->step_attachlinsol(arkode_mem, arkLsInitialize, + arkLsSetup, arkLsSolve, + arkLsFree, LSType, arkls_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKLS", "arkLSSetLinearSolver", + "Failed to attach to time stepper module"); + N_VDestroy(arkls_mem->x); + N_VDestroy(arkls_mem->ytemp); + free(arkls_mem); arkls_mem = NULL; + return(retval); + } + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSSetMassLinearSolver specifies the iterative mass-matrix + linear solver and user-supplied routine to perform the + mass-matrix-vector product. + ---------------------------------------------------------------*/ +int arkLSSetMassLinearSolver(void *arkode_mem, SUNLinearSolver LS, + SUNMatrix M, booleantype time_dep) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + SUNLinearSolver_Type LSType; + booleantype iterative; /* is the solver iterative? */ + booleantype matrixbased; /* is a matrix structure used? */ + + /* Return immediately if either arkode_mem or LS inputs are NULL */ + if (arkode_mem == NULL) { + arkProcessError(NULL, ARKLS_MEM_NULL, "ARKLS", + "arkLSSetMassLinearSolver", + MSG_LS_ARKMEM_NULL); + return(ARKLS_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + if (LS == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetMassLinearSolver", + "LS must be non-NULL"); + return(ARKLS_ILL_INPUT); + } + + /* Test if solver is compatible with LS interface */ + if ( (LS->ops->gettype == NULL) || (LS->ops->solve == NULL) ) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetMassLinearSolver", + "LS object is missing a required operation"); + return(ARKLS_ILL_INPUT); + } + + /* Retrieve the LS type */ + LSType = SUNLinSolGetType(LS); + + /* Set flags based on LS type */ + iterative = (LSType != SUNLINEARSOLVER_DIRECT); + matrixbased = ((LSType != SUNLINEARSOLVER_ITERATIVE) && + (LSType != SUNLINEARSOLVER_MATRIX_EMBEDDED)); + + /* Test if vector is compatible with LS interface */ + if ( (ark_mem->tempv1->ops->nvconst == NULL) || + (ark_mem->tempv1->ops->nvwrmsnorm == NULL) ){ + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetMassLinearSolver", MSG_LS_BAD_NVECTOR); + return(ARKLS_ILL_INPUT); + } + + /* Ensure that M is NULL when LS is matrix-embedded */ + if ((LSType == SUNLINEARSOLVER_MATRIX_EMBEDDED) && (M != NULL)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetMassLinearSolver", + "Incompatible inputs: matrix-embedded LS requires NULL matrix"); + return(ARKLS_ILL_INPUT); + } + + /* Check for compatible LS type, matrix and "atimes" support */ + if (iterative) { + + if (ark_mem->tempv1->ops->nvgetlength == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetLinearSolver", MSG_LS_BAD_NVECTOR); + return(ARKLS_ILL_INPUT); + } + + if (!matrixbased && (LSType != SUNLINEARSOLVER_MATRIX_EMBEDDED) && + (LS->ops->setatimes == NULL)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetMassLinearSolver", + "Incompatible inputs: iterative LS must support ATimes routine"); + return(ARKLS_ILL_INPUT); + } + + if (matrixbased && (M == NULL)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetMassLinearSolver", + "Incompatible inputs: matrix-iterative LS requires non-NULL matrix"); + return(ARKLS_ILL_INPUT); + } + + } else if (M == NULL) { + + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetMassLinearSolver", + "Incompatible inputs: direct LS requires non-NULL matrix"); + return(ARKLS_ILL_INPUT); + + } + + /* Test whether time stepper module is supplied, with required routines */ + if ( (ark_mem->step_attachmasssol == NULL) || + (ark_mem->step_getmassmem == NULL) ) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetMassLinearSolver", + "Missing time step module or associated routines"); + return(ARKLS_ILL_INPUT); + } + + /* Allocate memory for ARKLsMemRec */ + arkls_mem = NULL; + arkls_mem = (ARKLsMassMem) malloc(sizeof(struct ARKLsMassMemRec)); + if (arkls_mem == NULL) { + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKLS", + "arkLSSetMassLinearSolver", MSG_LS_MEM_FAIL); + return(ARKLS_MEM_FAIL); + } + memset(arkls_mem, 0, sizeof(struct ARKLsMassMemRec)); + + /* set SUNLinearSolver pointer */ + arkls_mem->LS = LS; + + /* Linear solver type information */ + arkls_mem->iterative = iterative; + arkls_mem->matrixbased = matrixbased; + + /* Set flag indicating time-dependence */ + arkls_mem->time_dependent = time_dep; + + /* Set mass-matrix routines to NULL */ + arkls_mem->mass = NULL; + arkls_mem->M_data = NULL; + arkls_mem->mtsetup = NULL; + arkls_mem->mtimes = NULL; + arkls_mem->mt_data = NULL; + + /* Set defaults for preconditioner-related fields */ + arkls_mem->pset = NULL; + arkls_mem->psolve = NULL; + arkls_mem->pfree = NULL; + arkls_mem->P_data = ark_mem->user_data; + + /* Initialize counters */ + arkLsInitializeMassCounters(arkls_mem); + + /* Set default values for the rest of the LS parameters */ + arkls_mem->eplifac = ARKLS_EPLIN; + arkls_mem->last_flag = ARKLS_SUCCESS; + + /* If LS supports ATimes, attach ARKLs routine */ + if (LS->ops->setatimes) { + retval = SUNLinSolSetATimes(LS, ark_mem, NULL); + if (retval != SUNLS_SUCCESS) { + arkProcessError(ark_mem, ARKLS_SUNLS_FAIL, "ARKLS", + "arkLSSetMassLinearSolver", + "Error in calling SUNLinSolSetATimes"); + free(arkls_mem); arkls_mem = NULL; + return(ARKLS_SUNLS_FAIL); + } + } + + /* If LS supports preconditioning, initialize pset/psol to NULL */ + if (LS->ops->setpreconditioner) { + retval = SUNLinSolSetPreconditioner(LS, ark_mem, NULL, NULL); + if (retval != SUNLS_SUCCESS) { + arkProcessError(ark_mem, ARKLS_SUNLS_FAIL, "ARKLS", + "arkLSSetMassLinearSolver", + "Error in calling SUNLinSolSetPreconditioner"); + free(arkls_mem); arkls_mem = NULL; + return(ARKLS_SUNLS_FAIL); + } + } + + /* When using a non-NULL SUNMatrix object, store pointer to M and, for direct + linear solvers, create M_lu to store the factorization of M */ + if (M != NULL) { + arkls_mem->M = M; + if (!iterative) { + arkls_mem->M_lu = SUNMatClone(M); + if (arkls_mem->M_lu == NULL) { + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKLS", + "arkLSSetMassLinearSolver", MSG_LS_MEM_FAIL); + free(arkls_mem); arkls_mem = NULL; + return(ARKLS_MEM_FAIL); + } + } else { + arkls_mem->M_lu = M; + } + } + + /* Allocate memory for x */ + if (!arkAllocVec(ark_mem, ark_mem->tempv1, &(arkls_mem->x))) { + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKLS", + "arkLSSetMassLinearSolver", MSG_LS_MEM_FAIL); + if (!iterative) SUNMatDestroy(arkls_mem->M_lu); + free(arkls_mem); arkls_mem = NULL; + return(ARKLS_MEM_FAIL); + } + + /* For iterative LS, compute default norm conversion factor */ + if (iterative) + arkls_mem->nrmfac = SUNRsqrt( N_VGetLength(arkls_mem->x) ); + + /* Attach ARKLs interface to time stepper module */ + retval = ark_mem->step_attachmasssol(arkode_mem, arkLsMassInitialize, + arkLsMassSetup, arkLsMTimes, + arkLsMassSolve, arkLsMassFree, + time_dep, LSType, arkls_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKLS", "arkLSSetMassLinearSolver", + "Failed to attach to time stepper module"); + N_VDestroy(arkls_mem->x); + if (!iterative) SUNMatDestroy(arkls_mem->M_lu); + free(arkls_mem); arkls_mem = NULL; + return(retval); + } + + return(ARKLS_SUCCESS); +} + + +/*=============================================================== + Optional input/output (called by time-stepper modules) + ===============================================================*/ + +/*--------------------------------------------------------------- + arkLSSetJacFn specifies the Jacobian function. + ---------------------------------------------------------------*/ +int arkLSSetJacFn(void *arkode_mem, ARKLsJacFn jac) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSSetJacFn", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* return with failure if jac cannot be used */ + if ((jac != NULL) && (arkls_mem->A == NULL)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetJacFn", + "Jacobian routine cannot be supplied for NULL SUNMatrix"); + return(ARKLS_ILL_INPUT); + } + + /* set the Jacobian routine pointer, and update relevant flags */ + if (jac != NULL) { + arkls_mem->jacDQ = SUNFALSE; + arkls_mem->jac = jac; + arkls_mem->J_data = ark_mem->user_data; + } else { + arkls_mem->jacDQ = SUNTRUE; + arkls_mem->jac = arkLsDQJac; + arkls_mem->J_data = ark_mem; + } + + /* ensure the internal linear system function is used */ + arkls_mem->user_linsys = SUNFALSE; + arkls_mem->linsys = arkLsLinSys; + arkls_mem->A_data = ark_mem; + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSSetMassFn specifies the mass matrix function. + ---------------------------------------------------------------*/ +int arkLSSetMassFn(void *arkode_mem, ARKLsMassFn mass) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSSetMassFn", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* return with failure if mass cannot be used */ + if (mass == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetMassFn", + "Mass-matrix routine must be non-NULL"); + return(ARKLS_ILL_INPUT); + } + if (arkls_mem->M == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetMassFn", + "Mass-matrix routine cannot be supplied for NULL SUNMatrix"); + return(ARKLS_ILL_INPUT); + } + + /* set mass matrix routine pointer and return */ + arkls_mem->mass = mass; + arkls_mem->M_data = ark_mem->user_data; + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSSetEpsLin specifies the nonlinear -> linear tolerance + scale factor. + ---------------------------------------------------------------*/ +int arkLSSetEpsLin(void *arkode_mem, realtype eplifac) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; store input and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSSetEpsLin", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + arkls_mem->eplifac = (eplifac <= ZERO) ? ARKLS_EPLIN : eplifac; + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSSetNormFactor sets or computes the factor to use when + converting from the integrator tolerance (WRMS norm) to the + linear solver tolerance (L2 norm). + ---------------------------------------------------------------*/ +int arkLSSetNormFactor(void *arkode_mem, realtype nrmfac) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; store input and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSSetNormFactor", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + if (nrmfac > ZERO) { + /* set user-provided factor */ + arkls_mem->nrmfac = nrmfac; + } else if (nrmfac < ZERO) { + /* compute factor for WRMS norm with dot product */ + N_VConst(ONE, ark_mem->tempv1); + arkls_mem->nrmfac = SUNRsqrt(N_VDotProd(ark_mem->tempv1, ark_mem->tempv1)); + } else { + /* compute default factor for WRMS norm from vector legnth */ + arkls_mem->nrmfac = SUNRsqrt(N_VGetLength(ark_mem->tempv1)); + } + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSSetJacEvalFrequency specifies the frequency for + recomputing the Jacobian matrix and/or preconditioner. + ---------------------------------------------------------------*/ +int arkLSSetJacEvalFrequency(void *arkode_mem, long int msbj) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; store input and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSSetJacEvalFrequency", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + arkls_mem->msbj = (msbj <= ZERO) ? ARKLS_MSBJ : msbj; + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSSetLinearSolutionScaling enables or disables scaling the + linear solver solution to account for changes in gamma. + ---------------------------------------------------------------*/ +int arkLSSetLinearSolutionScaling(void *arkode_mem, booleantype onoff) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; store input and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSSetLinearSolutionScaling", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* check for valid solver type */ + if (!(arkls_mem->matrixbased)) return(ARKLS_ILL_INPUT); + + /* set solution scaling flag */ + arkls_mem->scalesol = onoff; + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSSetPreconditioner specifies the user-supplied + preconditioner setup and solve routines. + ---------------------------------------------------------------*/ +int arkLSSetPreconditioner(void *arkode_mem, + ARKLsPrecSetupFn psetup, + ARKLsPrecSolveFn psolve) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + SUNPSetupFn arkls_psetup; + SUNPSolveFn arkls_psolve; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSSetPreconditioner", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* issue error if LS object does not allow user-supplied preconditioning */ + if (arkls_mem->LS->ops->setpreconditioner == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetPreconditioner", + "SUNLinearSolver object does not support user-supplied preconditioning"); + return(ARKLS_ILL_INPUT); + } + + /* store function pointers for user-supplied routines */ + arkls_mem->pset = psetup; + arkls_mem->psolve = psolve; + + /* notify linear solver to call ARKLs interface routines */ + arkls_psetup = (psetup == NULL) ? NULL : arkLsPSetup; + arkls_psolve = (psolve == NULL) ? NULL : arkLsPSolve; + retval = SUNLinSolSetPreconditioner(arkls_mem->LS, ark_mem, + arkls_psetup, arkls_psolve); + if (retval != SUNLS_SUCCESS) { + arkProcessError(ark_mem, ARKLS_SUNLS_FAIL, "ARKLS", + "arkLSSetPreconditioner", + "Error in calling SUNLinSolSetPreconditioner"); + return(ARKLS_SUNLS_FAIL); + } + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSSetJacTimes specifies the user-supplied Jacobian-vector + product setup and multiply routines. + ---------------------------------------------------------------*/ +int arkLSSetJacTimes(void *arkode_mem, + ARKLsJacTimesSetupFn jtsetup, + ARKLsJacTimesVecFn jtimes) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSSetJacTimes", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* issue error if LS object does not allow user-supplied ATimes */ + if (arkls_mem->LS->ops->setatimes == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetJacTimes", + "SUNLinearSolver object does not support user-supplied ATimes routine"); + return(ARKLS_ILL_INPUT); + } + + /* store function pointers for user-supplied routines in ARKLs + interface (NULL jtimes implies use of DQ default) */ + if (jtimes != NULL) { + arkls_mem->jtimesDQ = SUNFALSE; + arkls_mem->jtsetup = jtsetup; + arkls_mem->jtimes = jtimes; + arkls_mem->Jt_data = ark_mem->user_data; + } else { + arkls_mem->jtimesDQ = SUNTRUE; + arkls_mem->jtsetup = NULL; + arkls_mem->jtimes = arkLsDQJtimes; + arkls_mem->Jt_data = ark_mem; + arkls_mem->Jt_f = ark_mem->step_getimplicitrhs(arkode_mem); + + if (arkls_mem->Jt_f == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetJacTimes", + "Time step module is missing implicit RHS fcn"); + return(ARKLS_ILL_INPUT); + } + } + + return(ARKLS_SUCCESS); +} + +/*--------------------------------------------------------------- + arkLSSetJacTimesRhsFn specifies an alternative user-supplied + ODE right-hand side function to use in the internal finite + difference Jacobian-vector product. + ---------------------------------------------------------------*/ +int arkLSSetJacTimesRhsFn(void *arkode_mem, ARKRhsFn jtimesRhsFn) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSSetJacTimesRhsFn", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* check if using internal finite difference approximation */ + if (!(arkls_mem->jtimesDQ)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetJacTimesRhsFn", + "Internal finite-difference Jacobian-vector product is disabled."); + return(ARKLS_ILL_INPUT); + } + + /* store function pointers for RHS function (NULL implies use ODE RHS) */ + if (jtimesRhsFn != NULL) { + arkls_mem->Jt_f = jtimesRhsFn; + } else { + arkls_mem->Jt_f = ark_mem->step_getimplicitrhs(arkode_mem); + + if (arkls_mem->Jt_f == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetJacTimesRhsFn", + "Time step module is missing implicit RHS fcn"); + return(ARKLS_ILL_INPUT); + } + } + + return(ARKLS_SUCCESS); +} + + +/* arkLSSetLinSysFn specifies the linear system setup function. */ +int arkLSSetLinSysFn(void *arkode_mem, ARKLsLinSysFn linsys) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSSetJacFn", + &ark_mem, &arkls_mem); + if (retval != ARKLS_SUCCESS) return(retval); + + /* return with failure if linsys cannot be used */ + if ((linsys != NULL) && (arkls_mem->A == NULL)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLSSetLinSysFn", + "Linear system setup routine cannot be supplied for NULL SUNMatrix"); + return(ARKLS_ILL_INPUT); + } + + /* set the linear system routine pointer, and update relevant flags */ + if (linsys != NULL) { + arkls_mem->user_linsys = SUNTRUE; + arkls_mem->linsys = linsys; + arkls_mem->A_data = ark_mem->user_data; + } else { + arkls_mem->user_linsys = SUNFALSE; + arkls_mem->linsys = arkLsLinSys; + arkls_mem->A_data = ark_mem; + } + + return(ARKLS_SUCCESS); +} + + +/* arkLSSetUserData sets user_data pointers in arkLS */ +int arkLSSetUserData(void *arkode_mem, void* user_data) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSSetUserData", + &ark_mem, &arkls_mem); + if (retval != ARKLS_SUCCESS) return(retval); + + /* Set data for Jacobian */ + if (!arkls_mem->jacDQ) + arkls_mem->J_data = user_data; + + /* Set data for Jtimes */ + if (!arkls_mem->jtimesDQ) + arkls_mem->Jt_data = user_data; + + /* Set data for LinSys */ + if (arkls_mem->user_linsys) + arkls_mem->A_data = user_data; + + /* Set data for Preconditioner */ + arkls_mem->P_data = user_data; + + return(ARKLS_SUCCESS); +} + +/*--------------------------------------------------------------- + arkLSGetWorkSpace returns the length of workspace allocated for + the ARKLS linear solver interface. + ---------------------------------------------------------------*/ +int arkLSGetWorkSpace(void *arkode_mem, long int *lenrw, + long int *leniw) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + sunindextype lrw1, liw1; + long int lrw, liw; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSGetWorkSpace", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* start with fixed sizes plus vector/matrix pointers */ + *lenrw = 3; + *leniw = 30; + + /* add NVector sizes */ + if (arkls_mem->x->ops->nvspace) { + N_VSpace(arkls_mem->x, &lrw1, &liw1); + *lenrw += 2*lrw1; + *leniw += 2*liw1; + } + + /* add SUNMatrix size (only account for the one owned by Ls interface) */ + if (arkls_mem->savedJ) + if (arkls_mem->savedJ->ops->space) { + retval = SUNMatSpace(arkls_mem->savedJ, &lrw, &liw); + if (retval == 0) { + *lenrw += lrw; + *leniw += liw; + } + } + + /* add LS sizes */ + if (arkls_mem->LS->ops->space) { + retval = SUNLinSolSpace(arkls_mem->LS, &lrw, &liw); + if (retval == SUNLS_SUCCESS) { + *lenrw += lrw; + *leniw += liw; + } + } + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumJacEvals returns the number of Jacobian evaluations + ---------------------------------------------------------------*/ +int arkLSGetNumJacEvals(void *arkode_mem, long int *njevals) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; set output value and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSGetNumJacEvals", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *njevals = arkls_mem->nje; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumRhsEvals returns the number of calls to the ODE + function needed for the DQ Jacobian approximation or J*v product + approximation. + ---------------------------------------------------------------*/ +int arkLSGetNumRhsEvals(void *arkode_mem, long int *nfevalsLS) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; set output value and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSGetNumRhsEvals", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *nfevalsLS = arkls_mem->nfeDQ; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumPrecEvals returns the number of calls to the + user- or ARKode-supplied preconditioner setup routine. + ---------------------------------------------------------------*/ +int arkLSGetNumPrecEvals(void *arkode_mem, long int *npevals) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; set output value and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSGetNumPrecEvals", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *npevals = arkls_mem->npe; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumPrecSolves returns the number of calls to the + user- or ARKode-supplied preconditioner solve routine. + ---------------------------------------------------------------*/ +int arkLSGetNumPrecSolves(void *arkode_mem, long int *npsolves) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; set output value and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSGetNumPrecSolves", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *npsolves = arkls_mem->nps; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumLinIters returns the number of linear iterations + (if accessible from the LS object). + ---------------------------------------------------------------*/ +int arkLSGetNumLinIters(void *arkode_mem, long int *nliters) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; set output value and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSGetNumLinIters", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *nliters = arkls_mem->nli; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumConvFails returns the number of linear solver + convergence failures (as reported by the LS object). + ---------------------------------------------------------------*/ +int arkLSGetNumConvFails(void *arkode_mem, long int *nlcfails) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; set output value and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSGetNumConvFails", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *nlcfails = arkls_mem->ncfl; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumJTSetupEvals returns the number of calls to the + user-supplied Jacobian-vector product setup routine. + ---------------------------------------------------------------*/ +int arkLSGetNumJTSetupEvals(void *arkode_mem, long int *njtsetups) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; set output value and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSGetNumJTSetupEvals", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *njtsetups = arkls_mem->njtsetup; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumJtimesEvals returns the number of calls to the + Jacobian-vector product multiply routine. + ---------------------------------------------------------------*/ +int arkLSGetNumJtimesEvals(void *arkode_mem, long int *njvevals) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; set output value and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSGetNumJtimesEvals", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *njvevals = arkls_mem->njtimes; + return(ARKLS_SUCCESS); +} + +/*--------------------------------------------------------------- + arkLSGetNumMassMatvecSetups returns the number of calls to the + mass matrix-vector setup routine. + ---------------------------------------------------------------*/ +int arkLSGetNumMassMatvecSetups(void *arkode_mem, long int *nmvsetups) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKMassMem structure; set output value and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSGetNumMassMatvecSetups", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *nmvsetups = arkls_mem->nmvsetup; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetLastFlag returns the last flag set in a ARKLS + function. + ---------------------------------------------------------------*/ +int arkLSGetLastFlag(void *arkode_mem, long int *flag) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure; set output value and return */ + retval = arkLs_AccessLMem(arkode_mem, "arkLSGetLastFlag", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *flag = arkls_mem->last_flag; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetReturnFlagName translates from the integer error code + returned by an ARKLs routine to the corresponding string + equivalent for that flag + ---------------------------------------------------------------*/ +char *arkLSGetReturnFlagName(long int flag) +{ + char *name = (char *)malloc(30*sizeof(char)); + + switch(flag) { + case ARKLS_SUCCESS: + sprintf(name,"ARKLS_SUCCESS"); + break; + case ARKLS_MEM_NULL: + sprintf(name,"ARKLS_MEM_NULL"); + break; + case ARKLS_LMEM_NULL: + sprintf(name,"ARKLS_LMEM_NULL"); + break; + case ARKLS_ILL_INPUT: + sprintf(name,"ARKLS_ILL_INPUT"); + break; + case ARKLS_MEM_FAIL: + sprintf(name,"ARKLS_MEM_FAIL"); + break; + case ARKLS_MASSMEM_NULL: + sprintf(name,"ARKLS_MASSMEM_NULL"); + break; + case ARKLS_JACFUNC_UNRECVR: + sprintf(name,"ARKLS_JACFUNC_UNRECVR"); + break; + case ARKLS_JACFUNC_RECVR: + sprintf(name,"ARKLS_JACFUNC_RECVR"); + break; + case ARKLS_MASSFUNC_UNRECVR: + sprintf(name,"ARKLS_MASSFUNC_UNRECVR"); + break; + case ARKLS_MASSFUNC_RECVR: + sprintf(name,"ARKLS_MASSFUNC_RECVR"); + break; + case ARKLS_SUNMAT_FAIL: + sprintf(name,"ARKLS_SUNMAT_FAIL"); + break; + case ARKLS_SUNLS_FAIL: + sprintf(name,"ARKLS_SUNLS_FAIL"); + break; + default: + sprintf(name,"NONE"); + } + + return(name); +} + + +/*--------------------------------------------------------------- + arkLSSetMassEpsLin specifies the nonlinear -> linear tolerance + scale factor for mass matrix linear systems. + ---------------------------------------------------------------*/ +int arkLSSetMassEpsLin(void *arkode_mem, realtype eplifac) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure; store input and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSSetMassEpsLin", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + arkls_mem->eplifac = (eplifac <= ZERO) ? ARKLS_EPLIN : eplifac; + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSSetMassNormFactor sets or computes the factor to use when + converting from the integrator tolerance (WRMS norm) to the + linear solver tolerance (L2 norm). + ---------------------------------------------------------------*/ +int arkLSSetMassNormFactor(void *arkode_mem, realtype nrmfac) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMem structure; store input and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSSetMassNormFactor", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + if (nrmfac > ZERO) { + /* set user-provided factor */ + arkls_mem->nrmfac = nrmfac; + } else if (nrmfac < ZERO) { + /* compute factor for WRMS norm with dot product */ + N_VConst(ONE, ark_mem->tempv1); + arkls_mem->nrmfac = SUNRsqrt(N_VDotProd(ark_mem->tempv1, ark_mem->tempv1)); + } else { + /* compute default factor for WRMS norm from vector legnth */ + arkls_mem->nrmfac = SUNRsqrt(N_VGetLength(ark_mem->tempv1)); + } + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSSetMassPreconditioner specifies the user-supplied + preconditioner setup and solve routines. + ---------------------------------------------------------------*/ +int arkLSSetMassPreconditioner(void *arkode_mem, + ARKLsMassPrecSetupFn psetup, + ARKLsMassPrecSolveFn psolve) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + SUNPSetupFn arkls_mpsetup; + SUNPSolveFn arkls_mpsolve; + int retval; + + /* access ARKLsMassMem structure */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSSetMassPreconditioner", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* issue error if LS object does not allow user-supplied preconditioning */ + if (arkls_mem->LS->ops->setpreconditioner == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetMassPreconditioner", + "SUNLinearSolver object does not support user-supplied preconditioning"); + return(ARKLS_ILL_INPUT); + } + + /* store function pointers for user-supplied routines in ARKLs interface */ + arkls_mem->pset = psetup; + arkls_mem->psolve = psolve; + + /* notify linear solver to call ARKLs interface routines */ + arkls_mpsetup = (psetup == NULL) ? NULL : arkLsMPSetup; + arkls_mpsolve = (psolve == NULL) ? NULL : arkLsMPSolve; + retval = SUNLinSolSetPreconditioner(arkls_mem->LS, ark_mem, + arkls_mpsetup, arkls_mpsolve); + if (retval != SUNLS_SUCCESS) { + arkProcessError(ark_mem, ARKLS_SUNLS_FAIL, "ARKLS", + "arkLSSetMassPreconditioner", + "Error in calling SUNLinSolSetPreconditioner"); + return(ARKLS_SUNLS_FAIL); + } + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSSetMassTimes specifies the user-supplied mass + matrix-vector product setup and multiply routines. + ---------------------------------------------------------------*/ +int arkLSSetMassTimes(void *arkode_mem, + ARKLsMassTimesSetupFn mtsetup, + ARKLsMassTimesVecFn mtimes, + void *mtimes_data) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSSetMassTimes", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* issue error if mtimes function is unusable */ + if (mtimes == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetMassTimes", + "non-NULL mtimes function must be supplied"); + return(ARKLS_ILL_INPUT); + } + + /* issue error if LS object does not allow user-supplied ATimes */ + if (arkls_mem->LS->ops->setatimes == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLSSetMassTimes", + "SUNLinearSolver object does not support user-supplied ATimes routine"); + return(ARKLS_ILL_INPUT); + } + + /* store pointers for user-supplied routines and data structure + in ARKLs interface */ + arkls_mem->mtsetup = mtsetup; + arkls_mem->mtimes = mtimes; + arkls_mem->mt_data = mtimes_data; + + /* notify linear solver to call ARKLs interface routine */ + retval = SUNLinSolSetATimes(arkls_mem->LS, ark_mem, arkLsMTimes); + if (retval != SUNLS_SUCCESS) { + arkProcessError(ark_mem, ARKLS_SUNLS_FAIL, "ARKLS", + "arkLSSetMassTimes", + "Error in calling SUNLinSolSetATimes"); + return(ARKLS_SUNLS_FAIL); + } + + return(ARKLS_SUCCESS); +} + + +/* arkLSMassSetUserData sets user_data pointers in arkLSMass */ +int arkLSSetMassUserData(void *arkode_mem, void* user_data) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSSetMassUserData", + &ark_mem, &arkls_mem); + if (retval != ARKLS_SUCCESS) return(retval); + + /* Set data for mass matrix */ + if (arkls_mem->mass != NULL) + arkls_mem->M_data = user_data; + + /* Data for Mtimes is set in arkLSSetMassTimes */ + + /* Set data for Preconditioner */ + arkls_mem->P_data = user_data; + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetMassWorkSpace + ---------------------------------------------------------------*/ +int arkLSGetMassWorkSpace(void *arkode_mem, long int *lenrw, + long int *leniw) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + sunindextype lrw1, liw1; + long int lrw, liw; + int retval; + + /* access ARKLsMassMem structure */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSGetMassWorkSpace", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* start with fixed sizes plus vector/matrix pointers */ + *lenrw = 2; + *leniw = 23; + + /* add NVector sizes */ + if (ark_mem->tempv1->ops->nvspace) { + N_VSpace(ark_mem->tempv1, &lrw1, &liw1); + *lenrw += lrw1; + *leniw += liw1; + } + + /* add SUNMatrix size (only account for the one owned by Ls interface) */ + if (!(arkls_mem->iterative) && arkls_mem->M_lu) + if (arkls_mem->M_lu->ops->space) { + retval = SUNMatSpace(arkls_mem->M_lu, &lrw, &liw); + if (retval == 0) { + *lenrw += lrw; + *leniw += liw; + } + } + + /* add LS sizes */ + if (arkls_mem->LS->ops->space) { + retval = SUNLinSolSpace(arkls_mem->LS, &lrw, &liw); + if (retval == SUNLS_SUCCESS) { + *lenrw += lrw; + *leniw += liw; + } + } + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumMassSetups returns the number of mass matrix + solver 'setup' calls + ---------------------------------------------------------------*/ +int arkLSGetNumMassSetups(void *arkode_mem, long int *nmsetups) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure; set output value and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSGetNumMassSetups", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *nmsetups = arkls_mem->nmsetups; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumMassMult returns the number of calls to the user- + supplied or internal mass matrix-vector product multiply routine. + ---------------------------------------------------------------*/ +int arkLSGetNumMassMult(void *arkode_mem, long int *nmvevals) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure; set output value and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSGetNumMassMult", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *nmvevals = arkls_mem->nmtimes; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumMassSolves returns the number of mass matrix + solver 'solve' calls + ---------------------------------------------------------------*/ +int arkLSGetNumMassSolves(void *arkode_mem, long int *nmsolves) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure; set output value and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSGetNumMassSolves", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *nmsolves = arkls_mem->nmsolves; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumMassPrecEvals returns the number of calls to the + user- or ARKode-supplied preconditioner setup routine. + ---------------------------------------------------------------*/ +int arkLSGetNumMassPrecEvals(void *arkode_mem, long int *npevals) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure; set output value and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSGetNumMassPrecEvals", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *npevals = arkls_mem->npe; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumMassPrecSolves returns the number of calls to the + user- or ARKode-supplied preconditioner solve routine. + ---------------------------------------------------------------*/ +int arkLSGetNumMassPrecSolves(void *arkode_mem, long int *npsolves) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure; set output value and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSGetNumMassPrecSolves", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *npsolves = arkls_mem->nps; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumMassIters returns the number of mass matrix solver + linear iterations (if accessible from the LS object). + ---------------------------------------------------------------*/ +int arkLSGetNumMassIters(void *arkode_mem, long int *nmiters) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure; set output value and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSGetNumMassIters", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *nmiters = arkls_mem->nli; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumMassConvFails returns the number of linear solver + convergence failures (as reported by the LS object). + ---------------------------------------------------------------*/ +int arkLSGetNumMassConvFails(void *arkode_mem, long int *nmcfails) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure; set output value and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSGetNumMassConvFails", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *nmcfails = arkls_mem->ncfl; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetMassMatrix returns the current mass matrix. + ---------------------------------------------------------------*/ +int arkLSGetCurrentMassMatrix(void *arkode_mem, SUNMatrix *M) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure; set output value and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSGetCurrentMassMatrix", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *M = arkls_mem->M; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetNumMTSetups returns the number of calls to the + user-supplied mass matrix-vector product setup routine. + ---------------------------------------------------------------*/ +int arkLSGetNumMTSetups(void *arkode_mem, long int *nmtsetups) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure; set output value and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSGetNumMTSetups", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *nmtsetups = arkls_mem->nmtsetup; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLSGetLastMassFlag returns the last flag set in a ARKLS + function. + ---------------------------------------------------------------*/ +int arkLSGetLastMassFlag(void *arkode_mem, long int *flag) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure; set output value and return */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLSGetLastMassFlag", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + *flag = arkls_mem->last_flag; + return(ARKLS_SUCCESS); +} + + +/*=============================================================== + ARKLS Private functions + ===============================================================*/ + +/*--------------------------------------------------------------- + arkLsATimes: + + This routine generates the matrix-vector product z = Av, where + A = M - gamma*J. The product M*v is obtained either by calling + the mtimes routine or by just using v (if M=I). The product + J*v is obtained by calling the jtimes routine. It is then scaled + by -gamma and added to M*v to obtain A*v. The return value is + the same as the values returned by jtimes and mtimes -- + 0 if successful, nonzero otherwise. + ---------------------------------------------------------------*/ +int arkLsATimes(void *arkode_mem, N_Vector v, N_Vector z) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + void* ark_step_massmem; + int retval; + realtype gamma, gamrat; + booleantype dgamma_fail, *jcur; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLsATimes", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Access mass matrix solver (if it exists) */ + ark_step_massmem = NULL; + if (ark_mem->step_getmassmem != NULL) + ark_step_massmem = ark_mem->step_getmassmem(arkode_mem); + + /* get gamma values from time step module */ + retval = ark_mem->step_getgammas(arkode_mem, &gamma, &gamrat, + &jcur, &dgamma_fail); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKLS", "arkLsATimes", + "An error occurred in ark_step_getgammas"); + return(retval); + } + + /* call Jacobian-times-vector product routine + (either user-supplied or internal DQ) */ + retval = arkls_mem->jtimes(v, z, + arkls_mem->tcur, + arkls_mem->ycur, + arkls_mem->fcur, + arkls_mem->Jt_data, + arkls_mem->ytemp); + arkls_mem->njtimes++; + if (retval != 0) return(retval); + + /* Compute mass matrix vector product and add to result */ + if (ark_step_massmem != NULL) { + retval = arkLsMTimes(arkode_mem, v, arkls_mem->ytemp); + if (retval != 0) return(retval); + N_VLinearSum(ONE, arkls_mem->ytemp, -gamma, z, z); + } else { + N_VLinearSum(ONE, v, -gamma, z, z); + } + + return(0); +} + +/*--------------------------------------------------------------- + arkLsPSetup: + + This routine interfaces between the generic iterative linear + solvers and the user's psetup routine. It passes to psetup all + required state information from arkode_mem. Its return value + is the same as that returned by psetup. Note that the generic + iterative linear solvers guarantee that arkLsPSetup will only + be called in the case that the user's psetup routine is non-NULL. + ---------------------------------------------------------------*/ +int arkLsPSetup(void *arkode_mem) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + realtype gamma, gamrat; + booleantype dgamma_fail, *jcur; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLsPSetup", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* get gamma values from time step module */ + retval = ark_mem->step_getgammas(arkode_mem, &gamma, &gamrat, + &jcur, &dgamma_fail); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKLS", "arkLsPSetup", + "An error occurred in ark_step_getgammas"); + return(retval); + } + + /* Call user pset routine to update preconditioner and possibly + reset jcur (pass !jbad as update suggestion) */ + retval = arkls_mem->pset(arkls_mem->tcur, + arkls_mem->ycur, + arkls_mem->fcur, + !(arkls_mem->jbad), + jcur, gamma, + arkls_mem->P_data); + return(retval); +} + +/*--------------------------------------------------------------- + arkLsPSolve: + + This routine interfaces between the generic SUNLinSolSolve + routine and the user's psolve routine. It passes to psolve all + required state information from arkode_mem. Its return value + is the same as that returned by psolve. Note that the generic + SUNLinSol solver guarantees that arkLsPSolve will not be + called in the case in which preconditioning is not done. This + is the only case in which the user's psolve routine is allowed + to be NULL. + ---------------------------------------------------------------*/ +int arkLsPSolve(void *arkode_mem, N_Vector r, N_Vector z, + realtype tol, int lr) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + realtype gamma, gamrat; + booleantype dgamma_fail, *jcur; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLsPSolve", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* get gamma values from time step module */ + retval = ark_mem->step_getgammas(arkode_mem, &gamma, &gamrat, + &jcur, &dgamma_fail); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKLS", "arkLsPSolve", + "An error occurred in ark_step_getgammas"); + return(retval); + } + + /* call the user-supplied psolve routine, and accumulate count */ + retval = arkls_mem->psolve(arkls_mem->tcur, + arkls_mem->ycur, + arkls_mem->fcur, r, z, + gamma, tol, lr, + arkls_mem->P_data); + arkls_mem->nps++; + return(retval); +} + +/*--------------------------------------------------------------- + arkLsMTimes: + + This routine generates the matrix-vector product z = Mv, where + M is the system mass matrix, by calling the user-supplied mtimes + routine. The return value is the same as the value returned + by mtimes -- 0 if successful, nonzero otherwise. + ---------------------------------------------------------------*/ +int arkLsMTimes(void *arkode_mem, N_Vector v, N_Vector z) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLsMTimes", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* perform multiply by either calling the user-supplied routine + (default), or asking the SUNMatrix to do the multiply */ + if (arkls_mem->mtimes) { + + /* call user-supplied mtimes routine, increment counter and return */ + retval = arkls_mem->mtimes(v, z, ark_mem->tcur, + arkls_mem->mt_data); + if (retval == 0) { + arkls_mem->nmtimes++; + } else { + arkProcessError(ark_mem, retval, "ARKLS", "arkLsMTimes", + "Error in user mass matrix-vector product routine"); + } + return(retval); + + } else if (arkls_mem->M) { + + /* try to ask SUNMatrix to do the multiply; increment counter and return */ + if (arkls_mem->M->ops->matvec) { + retval = SUNMatMatvec(arkls_mem->M, v, z); + if (retval == 0) { + arkls_mem->nmtimes++; + } else { + arkProcessError(ark_mem, retval, "ARKLS", "arkLsMTimes", + "Error in SUNMatrix mass matrix-vector product routine"); + } + return(retval); + } + + } + + /* if we made it here, then no matrix-vector product is available */ + arkProcessError(ark_mem, retval, "ARKLS", "arkLsMTimes", + "Missing mass matrix-vector product routine"); + return(-1); +} + + +/*--------------------------------------------------------------- + arkLsMPSetup: + + This routine interfaces between the generic linear solver and + the user's mass matrix psetup routine. It passes to psetup all + required state information from arkode_mem. Its return value + is the same as that returned by psetup. Note that the generic + linear solvers guarantee that arkLsMPSetup will only be + called if the user's psetup routine is non-NULL. + ---------------------------------------------------------------*/ +int arkLsMPSetup(void *arkode_mem) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLsMPSetup", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* only proceed if the mass matrix is time-independent or if + pset has not been called previously */ + if (!arkls_mem->time_dependent && arkls_mem->npe) + return(0); + + /* call user-supplied pset routine and increment counter */ + retval = arkls_mem->pset(ark_mem->tcur, arkls_mem->P_data); + arkls_mem->npe++; + return(retval); +} + + +/*--------------------------------------------------------------- + arkLsMPSolve: + + This routine interfaces between the generic LS routine and the + user's mass matrix psolve routine. It passes to psolve all + required state information from arkode_mem. Its return value is + the same as that returned by psolve. Note that the generic + solver guarantees that arkLsMPSolve will not be called in the + case in which preconditioning is not done. This is the only case + in which the user's psolve routine is allowed to be NULL. + ---------------------------------------------------------------*/ +int arkLsMPSolve(void *arkode_mem, N_Vector r, N_Vector z, + realtype tol, int lr) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLsMPSolve", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* call the user-supplied psolve routine, and accumulate count */ + retval = arkls_mem->psolve(ark_mem->tcur, r, z, tol, + lr, arkls_mem->P_data); + arkls_mem->nps++; + return(retval); +} + + +/*--------------------------------------------------------------- + arkLsDQJac: + + This routine is a wrapper for the Dense and Band + implementations of the difference quotient Jacobian + approximation routines. + ---------------------------------------------------------------*/ +int arkLsDQJac(realtype t, N_Vector y, N_Vector fy, + SUNMatrix Jac, void *arkode_mem, N_Vector tmp1, + N_Vector tmp2, N_Vector tmp3) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + ARKRhsFn fi; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLsDQJac", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* verify that Jac is non-NULL */ + if (Jac == NULL) { + arkProcessError(ark_mem, ARKLS_LMEM_NULL, "ARKLS", + "arkLsDQJac", "SUNMatrix is NULL"); + return(ARKLS_LMEM_NULL); + } + + /* Access implicit RHS function */ + fi = ark_mem->step_getimplicitrhs((void*) ark_mem); + if (fi == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLsDQJac", + "Time step module is missing implicit RHS fcn"); + return(ARKLS_ILL_INPUT); + } + + /* Verify that N_Vector supports required routines */ + if (ark_mem->tempv1->ops->nvcloneempty == NULL || + ark_mem->tempv1->ops->nvwrmsnorm == NULL || + ark_mem->tempv1->ops->nvlinearsum == NULL || + ark_mem->tempv1->ops->nvdestroy == NULL || + ark_mem->tempv1->ops->nvscale == NULL || + ark_mem->tempv1->ops->nvgetarraypointer == NULL || + ark_mem->tempv1->ops->nvsetarraypointer == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLsDQJac", MSG_LS_BAD_NVECTOR); + return(ARKLS_ILL_INPUT); + } + + /* Call the matrix-structure-specific DQ approximation routine */ + if (SUNMatGetID(Jac) == SUNMATRIX_DENSE) { + retval = arkLsDenseDQJac(t, y, fy, Jac, ark_mem, arkls_mem, + fi, tmp1); + } else if (SUNMatGetID(Jac) == SUNMATRIX_BAND) { + retval = arkLsBandDQJac(t, y, fy, Jac, ark_mem, arkls_mem, + fi, tmp1, tmp2); + } else { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLsDQJac", + "arkLsDQJac not implemented for this SUNMatrix type!"); + retval = ARKLS_ILL_INPUT; + } + return(retval); +} + +/*--------------------------------------------------------------- + arkLsDenseDQJac: + + This routine generates a dense difference quotient approximation + to the Jacobian of f(t,y). It assumes a dense SUNMatrix input + (stored column-wise, and that elements within each column are + contiguous). The address of the jth column of J is obtained via + the function SUNDenseMatrix_Column() and this pointer is + associated with an N_Vector using the + N_VGetArrayPointer/N_VSetArrayPointer functions. Finally, the + actual computation of the jth column of the Jacobian is done + with a call to N_VLinearSum. + ---------------------------------------------------------------*/ +int arkLsDenseDQJac(realtype t, N_Vector y, N_Vector fy, + SUNMatrix Jac, ARKodeMem ark_mem, + ARKLsMem arkls_mem, ARKRhsFn fi, + N_Vector tmp1) +{ + realtype fnorm, minInc, inc, inc_inv, yjsaved, srur, conj; + realtype *y_data, *ewt_data, *cns_data; + N_Vector ftemp, jthCol; + sunindextype j, N; + int retval = 0; + + /* access matrix dimension */ + N = SUNDenseMatrix_Columns(Jac); + + /* Rename work vector for readibility */ + ftemp = tmp1; + + /* Create an empty vector for matrix column calculations */ + jthCol = N_VCloneEmpty(tmp1); + + /* Obtain pointers to the data for various vectors */ + ewt_data = N_VGetArrayPointer(ark_mem->ewt); + y_data = N_VGetArrayPointer(y); + cns_data = (ark_mem->constraintsSet) ? + N_VGetArrayPointer(ark_mem->constraints) : NULL; + + /* Set minimum increment based on uround and norm of f */ + srur = SUNRsqrt(ark_mem->uround); + fnorm = N_VWrmsNorm(fy, ark_mem->rwt); + minInc = (fnorm != ZERO) ? + (MIN_INC_MULT * SUNRabs(ark_mem->h) * ark_mem->uround * N * fnorm) : ONE; + + for (j = 0; j < N; j++) { + + /* Generate the jth col of J(tn,y) */ + N_VSetArrayPointer(SUNDenseMatrix_Column(Jac,j), jthCol); + + yjsaved = y_data[j]; + inc = SUNMAX(srur*SUNRabs(yjsaved), minInc/ewt_data[j]); + + /* Adjust sign(inc) if y_j has an inequality constraint. */ + if (ark_mem->constraintsSet) { + conj = cns_data[j]; + if (SUNRabs(conj) == ONE) {if ((yjsaved+inc)*conj < ZERO) inc = -inc;} + else if (SUNRabs(conj) == TWO) {if ((yjsaved+inc)*conj <= ZERO) inc = -inc;} + } + + y_data[j] += inc; + + retval = fi(t, y, ftemp, ark_mem->user_data); + arkls_mem->nfeDQ++; + if (retval != 0) break; + + y_data[j] = yjsaved; + + inc_inv = ONE/inc; + N_VLinearSum(inc_inv, ftemp, -inc_inv, fy, jthCol); + + } + + /* Destroy jthCol vector */ + N_VSetArrayPointer(NULL, jthCol); /* SHOULDN'T BE NEEDED */ + N_VDestroy(jthCol); + + return(retval); +} + + +/*--------------------------------------------------------------- + arkLsBandDQJac: + + This routine generates a banded difference quotient approximation + to the Jacobian of f(t,y). It assumes a band SUNMatrix input + (stored column-wise, and that elements within each column are + contiguous). This makes it possible to get the address + of a column of J via the function SUNBandMatrix_Column() and to + write a simple for loop to set each of the elements of a column + in succession. + ---------------------------------------------------------------*/ +int arkLsBandDQJac(realtype t, N_Vector y, N_Vector fy, + SUNMatrix Jac, ARKodeMem ark_mem, + ARKLsMem arkls_mem, ARKRhsFn fi, + N_Vector tmp1, N_Vector tmp2) +{ + N_Vector ftemp, ytemp; + realtype fnorm, minInc, inc, inc_inv, srur, conj; + realtype *col_j, *ewt_data, *fy_data, *ftemp_data, *y_data, *ytemp_data; + realtype *cns_data; + sunindextype group, i, j, width, ngroups, i1, i2; + sunindextype N, mupper, mlower; + int retval = 0; + + /* access matrix dimensions */ + N = SUNBandMatrix_Columns(Jac); + mupper = SUNBandMatrix_UpperBandwidth(Jac); + mlower = SUNBandMatrix_LowerBandwidth(Jac); + + /* Rename work vectors for use as temporary values of y and f */ + ftemp = tmp1; + ytemp = tmp2; + + /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp */ + ewt_data = N_VGetArrayPointer(ark_mem->ewt); + fy_data = N_VGetArrayPointer(fy); + ftemp_data = N_VGetArrayPointer(ftemp); + y_data = N_VGetArrayPointer(y); + ytemp_data = N_VGetArrayPointer(ytemp); + cns_data = (ark_mem->constraintsSet) ? + N_VGetArrayPointer(ark_mem->constraints) : NULL; + + /* Load ytemp with y = predicted y vector */ + N_VScale(ONE, y, ytemp); + + /* Set minimum increment based on uround and norm of f */ + srur = SUNRsqrt(ark_mem->uround); + fnorm = N_VWrmsNorm(fy, ark_mem->rwt); + minInc = (fnorm != ZERO) ? + (MIN_INC_MULT * SUNRabs(ark_mem->h) * ark_mem->uround * N * fnorm) : ONE; + + /* Set bandwidth and number of column groups for band differencing */ + width = mlower + mupper + 1; + ngroups = SUNMIN(width, N); + + /* Loop over column groups. */ + for (group=1; group <= ngroups; group++) { + + /* Increment all y_j in group */ + for(j=group-1; j < N; j+=width) { + inc = SUNMAX(srur*SUNRabs(y_data[j]), minInc/ewt_data[j]); + + /* Adjust sign(inc) if yj has an inequality constraint. */ + if (ark_mem->constraintsSet) { + conj = cns_data[j]; + if (SUNRabs(conj) == ONE) {if ((ytemp_data[j]+inc)*conj < ZERO) inc = -inc;} + else if (SUNRabs(conj) == TWO) {if ((ytemp_data[j]+inc)*conj <= ZERO) inc = -inc;} + } + + ytemp_data[j] += inc; + } + + /* Evaluate f with incremented y */ + retval = fi(ark_mem->tcur, ytemp, ftemp, ark_mem->user_data); + arkls_mem->nfeDQ++; + if (retval != 0) break; + + /* Restore ytemp, then form and load difference quotients */ + for (j=group-1; j < N; j+=width) { + ytemp_data[j] = y_data[j]; + col_j = SUNBandMatrix_Column(Jac, j); + inc = SUNMAX(srur*SUNRabs(y_data[j]), minInc/ewt_data[j]); + + /* Adjust sign(inc) as before. */ + if (ark_mem->constraintsSet) { + conj = cns_data[j]; + if (SUNRabs(conj) == ONE) {if ((ytemp_data[j]+inc)*conj < ZERO) inc = -inc;} + else if (SUNRabs(conj) == TWO) {if ((ytemp_data[j]+inc)*conj <= ZERO) inc = -inc;} + } + + inc_inv = ONE/inc; + i1 = SUNMAX(0, j-mupper); + i2 = SUNMIN(j+mlower, N-1); + for (i=i1; i <= i2; i++) + SM_COLUMN_ELEMENT_B(col_j,i,j) = inc_inv * (ftemp_data[i] - fy_data[i]); + } + } + + return(retval); +} + + +/*--------------------------------------------------------------- + arkLsDQJtimes: + + This routine generates a difference quotient approximation to + the Jacobian-vector product fi_y(t,y) * v. The approximation is + Jv = [fi(y + v*sig) - fi(y)]/sig, where sig = 1 / ||v||_WRMS, + i.e. the WRMS norm of v*sig is 1. + ---------------------------------------------------------------*/ +int arkLsDQJtimes(N_Vector v, N_Vector Jv, realtype t, + N_Vector y, N_Vector fy, void *arkode_mem, + N_Vector work) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + realtype sig, siginv; + int iter, retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLsDQJtimes", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Initialize perturbation to 1/||v|| */ + sig = ONE/N_VWrmsNorm(v, ark_mem->ewt); + + for (iter=0; iterJt_f(t, work, Jv, ark_mem->user_data); + arkls_mem->nfeDQ++; + if (retval == 0) break; + if (retval < 0) return(-1); + + /* If fi failed recoverably, shrink sig and retry */ + sig *= PT25; + + } + + /* If retval still isn't 0, return with a recoverable failure */ + if (retval > 0) return(+1); + + /* Replace Jv by (Jv - fy)/sig */ + siginv = ONE/sig; + N_VLinearSum(siginv, Jv, -siginv, fy, Jv); + + return(0); +} + + +/*----------------------------------------------------------------- + arkLsLinSys + + Setup the linear system A = I - gamma J or A = M - gamma J + -----------------------------------------------------------------*/ +static int arkLsLinSys(realtype t, N_Vector y, N_Vector fy, SUNMatrix A, + SUNMatrix M, booleantype jok, booleantype *jcur, + realtype gamma, void *arkode_mem, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLsLinSys", + &ark_mem, &arkls_mem); + if (retval != ARKLS_SUCCESS) return(retval); + + /* Check if Jacobian needs to be updated */ + if (jok) { + + /* Use saved copy of J */ + *jcur = SUNFALSE; + + /* Overwrite linear system matrix with saved J */ + retval = SUNMatCopy(arkls_mem->savedJ, A); + if (retval) { + arkProcessError(ark_mem, ARKLS_SUNMAT_FAIL, "ARKLS", "arkLsSetup", + MSG_LS_SUNMAT_FAILED); + arkls_mem->last_flag = ARKLS_SUNMAT_FAIL; + return(arkls_mem->last_flag); + } + + } else { + + /* Call jac() routine to update J */ + *jcur = SUNTRUE; + + /* Clear the linear system matrix if necessary (direct linear solvers) */ + if (!(arkls_mem->iterative)) { + retval = SUNMatZero(A); + if (retval) { + arkProcessError(ark_mem, ARKLS_SUNMAT_FAIL, "ARKLS", + "arkLsSetup", MSG_LS_SUNMAT_FAILED); + arkls_mem->last_flag = ARKLS_SUNMAT_FAIL; + return(arkls_mem->last_flag); + } + } + + /* Compute new Jacobian matrix */ + retval = arkls_mem->jac(t, y, fy, A, arkls_mem->J_data, + vtemp1, vtemp2, vtemp3); + if (retval < 0) { + arkProcessError(ark_mem, ARKLS_JACFUNC_UNRECVR, "ARKLS", + "arkLsSetup", MSG_LS_JACFUNC_FAILED); + arkls_mem->last_flag = ARKLS_JACFUNC_UNRECVR; + return(-1); + } + if (retval > 0) { + arkls_mem->last_flag = ARKLS_JACFUNC_RECVR; + return(1); + } + + /* Update saved copy of the Jacobian matrix */ + retval = SUNMatCopy(A, arkls_mem->savedJ); + if (retval) { + arkProcessError(ark_mem, ARKLS_SUNMAT_FAIL, "ARKLS", + "arkLsSetup", MSG_LS_SUNMAT_FAILED); + arkls_mem->last_flag = ARKLS_SUNMAT_FAIL; + return(arkls_mem->last_flag); + } + + } + + /* Perform linear combination A = I - gamma*J or A = M - gamma*J */ + if (M == NULL) + retval = SUNMatScaleAddI(-gamma, A); + else + retval = SUNMatScaleAdd(-gamma, A, M); + + /* Check matrix operation return value */ + if (retval) { + arkProcessError(ark_mem, ARKLS_SUNMAT_FAIL, "ARKLS", "arkLsSetup", + MSG_LS_SUNMAT_FAILED); + arkls_mem->last_flag = ARKLS_SUNMAT_FAIL; + return(arkls_mem->last_flag); + } + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLsInitialize performs remaining initializations specific + to the linear solver interface (and solver itself) + ---------------------------------------------------------------*/ +int arkLsInitialize(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + ARKLsMassMem arkls_massmem; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLsInitialize", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* access ARKLsMassMem (if applicable) */ + arkls_massmem = NULL; + if (ark_mem->step_getmassmem != NULL) + if (ark_mem->step_getmassmem(arkode_mem) != NULL) { + retval = arkLs_AccessMassMem(arkode_mem, "arkLsInitialize", + &ark_mem, &arkls_massmem); + if (retval != ARK_SUCCESS) return(retval); + } + + /* Test for valid combinations of matrix & Jacobian routines: */ + if (arkls_mem->A != NULL) { + + /* Matrix-based case */ + + if (!arkls_mem->user_linsys) { + + /* Internal linear system function, reset pointers (just in case) */ + arkls_mem->linsys = arkLsLinSys; + arkls_mem->A_data = ark_mem; + + /* Check if an internal or user-supplied Jacobian function is used */ + if (arkls_mem->jacDQ) { + + /* Internal difference quotient Jacobian. Check that A is dense or band, + otherwise return an error */ + retval = 0; + if (arkls_mem->A->ops->getid) { + + if ( (SUNMatGetID(arkls_mem->A) == SUNMATRIX_DENSE) || + (SUNMatGetID(arkls_mem->A) == SUNMATRIX_BAND) ) { + arkls_mem->jac = arkLsDQJac; + arkls_mem->J_data = ark_mem; + } else { + retval++; + } + + } else { + retval++; + } + if (retval) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLsInitialize", + "No Jacobian constructor available for SUNMatrix type"); + arkls_mem->last_flag = ARKLS_ILL_INPUT; + return(ARKLS_ILL_INPUT); + } + } + + /* Allocate internally saved Jacobian if not already done */ + if (arkls_mem->savedJ == NULL) { + arkls_mem->savedJ = SUNMatClone(arkls_mem->A); + if (arkls_mem->savedJ == NULL) { + arkProcessError(ark_mem, ARKLS_MEM_FAIL, "ARKLS", + "arkLsInitialize", MSG_LS_MEM_FAIL); + arkls_mem->last_flag = ARKLS_MEM_FAIL; + return(ARKLS_MEM_FAIL); + } + } + + } /* end matrix-based case */ + + } else { + + /* Matrix-free case: ensure 'jac' and 'linsys' function pointers are NULL */ + arkls_mem->jacDQ = SUNFALSE; + arkls_mem->jac = NULL; + arkls_mem->J_data = NULL; + + arkls_mem->user_linsys = SUNFALSE; + arkls_mem->linsys = NULL; + arkls_mem->A_data = NULL; + + } + + + /* Test for valid combination of system matrix and mass matrix (if applicable) */ + if (arkls_massmem) { + + /* A and M must both be NULL or non-NULL */ + if ( (arkls_mem->A==NULL) ^ (arkls_massmem->M==NULL) ) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLsInitialize", + "Cannot combine NULL and non-NULL System and mass matrices"); + arkls_mem->last_flag = ARKLS_ILL_INPUT; + return(ARKLS_ILL_INPUT); + } + + /* If A is non-NULL, A and M must have matching types (if accessible) */ + if (arkls_mem->A) { + retval = 0; + if ((arkls_mem->A->ops->getid==NULL) ^ (arkls_massmem->M->ops->getid==NULL)) + retval++; + if (arkls_mem->A->ops->getid) + if (SUNMatGetID(arkls_mem->A) != SUNMatGetID(arkls_massmem->M)) + retval++; + if (retval) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLsInitialize", + "System and mass matrices have incompatible types"); + arkls_mem->last_flag = ARKLS_ILL_INPUT; + return(ARKLS_ILL_INPUT); + } + } + + /* If either system or mass matrix solver is matrix-embedded, then both must be */ + if ((SUNLinSolGetType(arkls_mem->LS) == SUNLINEARSOLVER_MATRIX_EMBEDDED) && + (SUNLinSolGetType(arkls_massmem->LS) != SUNLINEARSOLVER_MATRIX_EMBEDDED)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLsInitialize", + "mismatched matrix-embedded LS types (system and mass must match)"); + arkls_mem->last_flag = ARKLS_ILL_INPUT; + return(ARKLS_ILL_INPUT); + } + if ((SUNLinSolGetType(arkls_mem->LS) != SUNLINEARSOLVER_MATRIX_EMBEDDED) && + (SUNLinSolGetType(arkls_massmem->LS) == SUNLINEARSOLVER_MATRIX_EMBEDDED)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLsInitialize", + "mismatched matrix-embedded LS types (system and mass must match)"); + arkls_mem->last_flag = ARKLS_ILL_INPUT; + return(ARKLS_ILL_INPUT); + } + } + + /* reset counters */ + arkLsInitializeCounters(arkls_mem); + + /* Set Jacobian-vector product related fields, based on jtimesDQ */ + if (arkls_mem->jtimesDQ) { + arkls_mem->jtsetup = NULL; + arkls_mem->jtimes = arkLsDQJtimes; + arkls_mem->Jt_data = ark_mem; + } + + /* If A is NULL and psetup is not present, then arkLsSetup does + not need to be called, so set the lsetup function to NULL (if possible) */ + if ( (arkls_mem->A == NULL) && + (arkls_mem->pset == NULL) && + (ark_mem->step_disablelsetup != NULL) ) + ark_mem->step_disablelsetup(arkode_mem); + + /* When using a matrix-embedded linear solver, disable lsetup call and solution scaling */ + if (SUNLinSolGetType(arkls_mem->LS) == SUNLINEARSOLVER_MATRIX_EMBEDDED) { + ark_mem->step_disablelsetup(arkode_mem); + arkls_mem->scalesol = SUNFALSE; + } + + /* Call LS initialize routine, and return result */ + arkls_mem->last_flag = SUNLinSolInitialize(arkls_mem->LS); + return(arkls_mem->last_flag); +} + + +/*--------------------------------------------------------------- + arkLsSetup conditionally calls the LS 'setup' routine. + + When using a SUNMatrix object, this determines whether + to update a Jacobian matrix (or use a stored version), based + on heuristics regarding previous convergence issues, the number + of time steps since it was last updated, etc.; it then creates + the system matrix from this, the 'gamma' factor and the + mass/identity matrix, + A = M-gamma*J. + + This routine then calls the LS 'setup' routine with A. + ---------------------------------------------------------------*/ +int arkLsSetup(void* arkode_mem, int convfail, realtype tpred, + N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) +{ + ARKodeMem ark_mem = NULL; + ARKLsMem arkls_mem = NULL; + void* ark_step_massmem = NULL; + SUNMatrix M = NULL; + realtype gamma, gamrat; + booleantype dgamma_fail, *jcur; + int retval; + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLsSetup", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Immediately return when using matrix-embedded linear solver */ + if (SUNLinSolGetType(arkls_mem->LS) == SUNLINEARSOLVER_MATRIX_EMBEDDED) { + arkls_mem->last_flag = ARKLS_SUCCESS; + return(arkls_mem->last_flag); + } + + /* Set ARKLs time and N_Vector pointers to current time, + solution and rhs */ + arkls_mem->tcur = tpred; + arkls_mem->ycur = ypred; + arkls_mem->fcur = fpred; + + /* get gamma values from time step module */ + arkls_mem->last_flag = ark_mem->step_getgammas(arkode_mem, &gamma, &gamrat, + &jcur, &dgamma_fail); + if (arkls_mem->last_flag) { + arkProcessError(ark_mem, arkls_mem->last_flag, "ARKLS", "arkLsSetup", + "An error occurred in ark_step_getgammas"); + return(arkls_mem->last_flag); + } + + /* Use initsetup, gamma/gammap, and convfail to set J/P eval. flag jok; + Note: the "ARK_FAIL_BAD_J" test is asking whether the nonlinear + solver converged due to a bad system Jacobian AND our gamma was + fine, indicating that the J and/or P were invalid */ + arkls_mem->jbad = (ark_mem->initsetup) || + (ark_mem->nst >= arkls_mem->nstlj + arkls_mem->msbj) || + ((convfail == ARK_FAIL_BAD_J) && (!dgamma_fail)) || + (convfail == ARK_FAIL_OTHER); + + /* Check for mass matrix module and setup mass matrix */ + if (ark_mem->step_getmassmem) + ark_step_massmem = ark_mem->step_getmassmem(arkode_mem); + + if (ark_step_massmem) { + + /* Set shortcut to the mass matrix (NULL if matrix-free) */ + M = ((ARKLsMassMem) ark_step_massmem)->M; + + /* Setup mass matrix linear solver (including recomputation of mass matrix) */ + arkls_mem->last_flag = arkLsMassSetup(arkode_mem, tpred, vtemp1, vtemp2, vtemp3); + if (arkls_mem->last_flag) { + arkProcessError(ark_mem, ARKLS_SUNMAT_FAIL, "ARKLS", "arkLsSetup", + "Error setting up mass-matrix linear solver"); + return(arkls_mem->last_flag); + } + + } + + /* Setup the linear system if necessary */ + if (arkls_mem->A != NULL) { + + /* Update J if appropriate and evaluate A = I-gamma*J or A = M-gamma*J */ + retval = arkls_mem->linsys(tpred, ypred, fpred, arkls_mem->A, M, + !(arkls_mem->jbad), jcurPtr, gamma, + arkls_mem->A_data, vtemp1, vtemp2, vtemp3); + + /* Update J eval count and step when J was last updated */ + if (*jcurPtr) { + arkls_mem->nje++; + arkls_mem->nstlj = ark_mem->nst; + } + + /* Check linsys() return value and return if necessary */ + if (retval != ARKLS_SUCCESS) { + if (arkls_mem->user_linsys) { + if (retval < 0) { + arkProcessError(ark_mem, ARKLS_JACFUNC_UNRECVR, "ARKLS", + "arkLsSetup", MSG_LS_JACFUNC_FAILED); + arkls_mem->last_flag = ARKLS_JACFUNC_UNRECVR; + return(-1); + } else { + arkls_mem->last_flag = ARKLS_JACFUNC_RECVR; + return(1); + } + } else { + return(retval); + } + } + + } else { + + /* Matrix-free case, set jcur to jbad */ + *jcurPtr = arkls_mem->jbad; + + } + + /* Call LS setup routine -- the LS may call arkLsPSetup, who will + pass the heuristic suggestions above to the user code(s) */ + arkls_mem->last_flag = SUNLinSolSetup(arkls_mem->LS, arkls_mem->A); + + /* If the SUNMatrix was NULL, update heuristics flags */ + if (arkls_mem->A == NULL) { + + /* If user set jcur to SUNTRUE, increment npe and save nst value */ + if (*jcurPtr) { + arkls_mem->npe++; + arkls_mem->nstlj = ark_mem->nst; + } + + /* Update jcurPtr flag if we suggested an update */ + if (arkls_mem->jbad) *jcurPtr = SUNTRUE; + } + + return(arkls_mem->last_flag); +} + + +/*--------------------------------------------------------------- + arkLsSolve: interfaces between ARKode and the generic + SUNLinearSolver object LS, by setting the appropriate tolerance + and scaling vectors, calling the solver, and accumulating + statistics from the solve for use/reporting by ARKode. + + When using a non-NULL SUNMatrix, this will additionally scale + the solution appropriately when gamrat != 1. + ---------------------------------------------------------------*/ +int arkLsSolve(void* arkode_mem, N_Vector b, realtype tnow, + N_Vector ynow, N_Vector fnow, realtype eRNrm, int mnewt) +{ + realtype bnorm, resnorm; + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + realtype gamma, gamrat, delta, deltar, rwt_mean; + booleantype dgamma_fail, *jcur; + long int nps_inc; + int nli_inc, retval; + + + /* access ARKLsMem structure */ + retval = arkLs_AccessLMem(arkode_mem, "arkLsSolve", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Set scalar tcur and vectors ycur and fcur for use by the + Atimes and Psolve interface routines */ + arkls_mem->tcur = tnow; + arkls_mem->ycur = ynow; + arkls_mem->fcur = fnow; + + /* If the linear solver is iterative: + test norm(b), if small, return x = 0 or x = b; + set linear solver tolerance (in left/right scaled 2-norm) */ + if (arkls_mem->iterative) { + deltar = arkls_mem->eplifac * eRNrm; + bnorm = N_VWrmsNorm(b, ark_mem->rwt); + if (bnorm <= deltar) { + if (mnewt > 0) N_VConst(ZERO, b); + arkls_mem->last_flag = ARKLS_SUCCESS; + return(arkls_mem->last_flag); + } + /* Adjust tolerance for 2-norm */ + delta = deltar * arkls_mem->nrmfac; + } else { + delta = bnorm = ZERO; + } + + /* Set scaling vectors for LS to use (if applicable) */ + if (arkls_mem->LS->ops->setscalingvectors) { + retval = SUNLinSolSetScalingVectors(arkls_mem->LS, + ark_mem->rwt, + ark_mem->ewt); + if (retval != SUNLS_SUCCESS) { + arkProcessError(ark_mem, ARKLS_SUNLS_FAIL, "ARKLS", "arkLsSolve", + "Error in call to SUNLinSolSetScalingVectors"); + arkls_mem->last_flag = ARKLS_SUNLS_FAIL; + return(arkls_mem->last_flag); + } + + /* If solver is iterative and does not support scaling vectors, update the + tolerance in an attempt to account for ewt/rwt vectors. We make the + following assumptions: + 1. rwt_i = rwt_mean, for i=0,...,n-1 (i.e. the residual units are identical) + 2. the linear solver uses a basic 2-norm to measure convergence + Hence (using the notation from sunlinsol_spgmr.h, with S = diag(rwt)), + || bbar - Abar xbar ||_2 < tol + <=> || S b - S A x ||_2 < tol + <=> || S (b - A x) ||_2 < tol + <=> \sum_{i=0}^{n-1} (rwt_i (b - A x)_i)^2 < tol^2 + <=> rwt_mean^2 \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 + <=> \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 / rwt_mean^2 + <=> || b - A x ||_2 < tol / rwt_mean + So we compute rwt_mean = ||rwt||_RMS and scale the desired tolerance accordingly. */ + } else if (arkls_mem->iterative) { + + N_VConst(ONE, arkls_mem->x); + rwt_mean = N_VWrmsNorm(ark_mem->rwt, arkls_mem->x); + delta /= rwt_mean; + + } + + /* Set initial guess x = 0 to LS */ + N_VConst(ZERO, arkls_mem->x); + + /* Set zero initial guess flag */ + retval = SUNLinSolSetZeroGuess(arkls_mem->LS, SUNTRUE); + if (retval != SUNLS_SUCCESS) return(-1); + + /* Store previous nps value in nps_inc */ + nps_inc = arkls_mem->nps; + + /* If a user-provided jtsetup routine is supplied, call that here */ + if (arkls_mem->jtsetup) { + arkls_mem->last_flag = arkls_mem->jtsetup(tnow, ynow, fnow, + arkls_mem->Jt_data); + arkls_mem->njtsetup++; + if (arkls_mem->last_flag) { + arkProcessError(ark_mem, arkls_mem->last_flag, "ARKLS", + "arkLsSolve", MSG_LS_JTSETUP_FAILED); + return(arkls_mem->last_flag); + } + } + + /* Call solver, and copy x to b */ + retval = SUNLinSolSolve(arkls_mem->LS, arkls_mem->A, + arkls_mem->x, b, delta); + N_VScale(ONE, arkls_mem->x, b); + + /* If using a direct or matrix-iterative solver, scale the correction to + account for change in gamma (this is only beneficial if M==I) */ + if (arkls_mem->scalesol) { + arkls_mem->last_flag = ark_mem->step_getgammas(arkode_mem, &gamma, &gamrat, + &jcur, &dgamma_fail); + if (arkls_mem->last_flag != ARK_SUCCESS) { + arkProcessError(ark_mem, arkls_mem->last_flag, "ARKLS", "arkLsSolve", + "An error occurred in ark_step_getgammas"); + return(arkls_mem->last_flag); + } + if (gamrat != ONE) N_VScale(TWO/(ONE + gamrat), b, b); + } + + /* Retrieve statistics from iterative linear solvers */ + resnorm = ZERO; + nli_inc = 0; + if (arkls_mem->iterative) { + if (arkls_mem->LS->ops->resnorm) + resnorm = SUNLinSolResNorm(arkls_mem->LS); + if (arkls_mem->LS->ops->numiters) + nli_inc = SUNLinSolNumIters(arkls_mem->LS); + } + + /* Increment counters nli and ncfl */ + arkls_mem->nli += nli_inc; + if (retval != SUNLS_SUCCESS) arkls_mem->ncfl++; + + /* Log solver statistics to diagnostics file (if requested) */ + if (ark_mem->report) + STAN_SUNDIALS_FPRINTF(ark_mem->diagfp, "ARKLS kry %"RSYM" %"RSYM" %i %i\n", + bnorm, resnorm, nli_inc, (int) (arkls_mem->nps - nps_inc)); + + /* Interpret solver return value */ + arkls_mem->last_flag = retval; + + switch(retval) { + + case SUNLS_SUCCESS: + return(0); + break; + case SUNLS_RES_REDUCED: + /* allow reduction but not solution on first nonlinear iteration, + otherwise return with a recoverable failure */ + if (mnewt == 0) return(0); + else return(1); + break; + case SUNLS_CONV_FAIL: + case SUNLS_ATIMES_FAIL_REC: + case SUNLS_PSOLVE_FAIL_REC: + case SUNLS_PACKAGE_FAIL_REC: + case SUNLS_QRFACT_FAIL: + case SUNLS_LUFACT_FAIL: + return(1); + break; + case SUNLS_MEM_NULL: + case SUNLS_ILL_INPUT: + case SUNLS_MEM_FAIL: + case SUNLS_GS_FAIL: + case SUNLS_QRSOL_FAIL: + return(-1); + break; + case SUNLS_PACKAGE_FAIL_UNREC: + arkProcessError(ark_mem, SUNLS_PACKAGE_FAIL_UNREC, "ARKLS", + "arkLsSolve", + "Failure in SUNLinSol external package"); + return(-1); + break; + case SUNLS_ATIMES_FAIL_UNREC: + arkProcessError(ark_mem, SUNLS_ATIMES_FAIL_UNREC, "ARKLS", + "arkLsSolve", MSG_LS_JTIMES_FAILED); + return(-1); + break; + case SUNLS_PSOLVE_FAIL_UNREC: + arkProcessError(ark_mem, SUNLS_PSOLVE_FAIL_UNREC, "ARKLS", + "arkLsSolve", MSG_LS_PSOLVE_FAILED); + return(-1); + break; + } + + return(0); +} + + +/*--------------------------------------------------------------- + arkLsFree frees memory associates with the ARKLs system + solver interface. + ---------------------------------------------------------------*/ +int arkLsFree(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKLsMem arkls_mem; + void* ark_step_lmem; + + /* Return immediately if ARKodeMem, ARKLsMem are NULL */ + if (arkode_mem == NULL) return (ARKLS_SUCCESS); + ark_mem = (ARKodeMem) arkode_mem; + ark_step_lmem = ark_mem->step_getlinmem(arkode_mem); + if (ark_step_lmem == NULL) return(ARKLS_SUCCESS); + arkls_mem = (ARKLsMem) ark_step_lmem; + + /* Free N_Vector memory */ + if (arkls_mem->ytemp) { + N_VDestroy(arkls_mem->ytemp); + arkls_mem->ytemp = NULL; + } + if (arkls_mem->x) { + N_VDestroy(arkls_mem->x); + arkls_mem->x = NULL; + } + + /* Free savedJ memory */ + if (arkls_mem->savedJ) { + SUNMatDestroy(arkls_mem->savedJ); + arkls_mem->savedJ = NULL; + } + + /* Nullify other N_Vector pointers */ + arkls_mem->ycur = NULL; + arkls_mem->fcur = NULL; + + /* Nullify other SUNMatrix pointer */ + arkls_mem->A = NULL; + + /* Free preconditioner memory (if applicable) */ + if (arkls_mem->pfree) arkls_mem->pfree(ark_mem); + + /* free ARKLs interface structure */ + free(arkls_mem); + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLsMassInitialize performs remaining initializations specific + to the mass matrix solver interface (and solver itself) + ---------------------------------------------------------------*/ +int arkLsMassInitialize(void *arkode_mem) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + int retval; + + /* access ARKLsMassMem structure */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLsMassInitialize", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* reset counters */ + arkLsInitializeMassCounters(arkls_mem); + + /* perform checks for matrix-based mass system */ + if (arkls_mem->M != NULL) { + /* check for user-provided mass matrix constructor */ + if (arkls_mem->mass == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLsMassInitialize", + "Missing user-provided mass-matrix routine"); + arkls_mem->last_flag = ARKLS_ILL_INPUT; + return(arkls_mem->last_flag); + } + /* check that someone can perform matrix-vector product */ + if ((arkls_mem->mtimes == NULL) && (arkls_mem->M->ops->matvec == NULL)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLsMassInitialize", + "No available mass matrix-vector product routine"); + arkls_mem->last_flag = ARKLS_ILL_INPUT; + return(arkls_mem->last_flag); + } + } + + /* perform checks for matrix-free mass system */ + if ((arkls_mem->M == NULL) && (arkls_mem->mtimes == NULL) && + (SUNLinSolGetType(arkls_mem->LS) != SUNLINEARSOLVER_MATRIX_EMBEDDED)) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", "arkLsMassInitialize", + "Missing user-provided mass matrix-vector product routine"); + arkls_mem->last_flag = ARKLS_ILL_INPUT; + return(arkls_mem->last_flag); + } + + /* ensure that a mass matrix solver exists */ + if (arkls_mem->LS == NULL) { + arkProcessError(ark_mem, ARKLS_ILL_INPUT, "ARKLS", + "arkLsMassInitialize", + "Missing SUNLinearSolver object"); + arkls_mem->last_flag = ARKLS_ILL_INPUT; + return(arkls_mem->last_flag); + } + + /* if M is NULL and neither pset or mtsetup are present, then + arkLsMassSetup does not need to be called, so set the + msetup function to NULL */ + if ( (arkls_mem->M == NULL) && + (arkls_mem->pset == NULL) && + (arkls_mem->mtsetup == NULL) && + (ark_mem->step_disablemsetup != NULL) ) + ark_mem->step_disablemsetup(arkode_mem); + + /* When using a matrix-embedded linear solver, disable lsetup call */ + if (SUNLinSolGetType(arkls_mem->LS) == SUNLINEARSOLVER_MATRIX_EMBEDDED) + ark_mem->step_disablemsetup(arkode_mem); + + /* Call LS initialize routine */ + arkls_mem->last_flag = SUNLinSolInitialize(arkls_mem->LS); + return(arkls_mem->last_flag); +} + + +/*--------------------------------------------------------------- + arkLsMassSetup calls the LS 'setup' routine. + ---------------------------------------------------------------*/ +int arkLsMassSetup(void *arkode_mem, realtype t, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + booleantype call_mtsetup, call_mvsetup, call_lssetup; + int retval; + + /* access ARKLsMassMem structure */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLsMassSetup", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Immediately return when using matrix-embedded linear solver */ + if (SUNLinSolGetType(arkls_mem->LS) == SUNLINEARSOLVER_MATRIX_EMBEDDED) { + arkls_mem->last_flag = ARKLS_SUCCESS; + return(arkls_mem->last_flag); + } + + /* if the most recent setup essentially matches the current time, + just return with success */ + if (SUNRabs(arkls_mem->msetuptime - t) < FUZZ_FACTOR*ark_mem->uround) { + arkls_mem->last_flag = ARKLS_SUCCESS; + return(arkls_mem->last_flag); + } + + /* Determine whether to call user-provided mtsetup routine */ + call_mtsetup = SUNFALSE; + if ( (arkls_mem->mtsetup) && + (arkls_mem->time_dependent || (arkls_mem->nmtsetup == 0)) ) + call_mtsetup = SUNTRUE; + + /* call user-provided mtsetup routine if applicable */ + if (call_mtsetup) { + arkls_mem->last_flag = arkls_mem->mtsetup(t, arkls_mem->mt_data); + arkls_mem->nmtsetup++; + arkls_mem->msetuptime = t; + if (arkls_mem->last_flag != 0) { + arkProcessError(ark_mem, arkls_mem->last_flag, "ARKLS", + "arkLsMassSetup", MSG_LS_MTSETUP_FAILED); + return(arkls_mem->last_flag); + } + } + + /* Perform user-facing setup based on whether this is matrix-free */ + if (arkls_mem->M == NULL) { + + /*** matrix-free -- only call LS setup if preconditioner setup exists ***/ + call_lssetup = (arkls_mem->pset != NULL); + /*** matrix-free -- dont call matvec setup ***/ + call_mvsetup = SUNFALSE; + + } else { + + /*** matrix-based ***/ + + /* If mass matrix is not time dependent, and if it has been set up + previously, then just reuse existing matrix and factorization */ + if (!arkls_mem->time_dependent && (arkls_mem->nmsetups > 0)) { + arkls_mem->last_flag = ARKLS_SUCCESS; + return(arkls_mem->last_flag); + } + + /* Clear the mass matrix if necessary (direct linear solvers) */ + if (!(arkls_mem->iterative)) { + retval = SUNMatZero(arkls_mem->M); + if (retval) { + arkProcessError(ark_mem, ARKLS_SUNMAT_FAIL, "ARKLS", + "arkLsMassSetup", MSG_LS_SUNMAT_FAILED); + arkls_mem->last_flag = ARKLS_SUNMAT_FAIL; + return(arkls_mem->last_flag); + } + } + + /* Call user-supplied routine to fill the mass matrix */ + retval = arkls_mem->mass(t, arkls_mem->M, arkls_mem->M_data, + vtemp1, vtemp2, vtemp3); + arkls_mem->msetuptime = t; + if (retval < 0) { + arkProcessError(ark_mem, ARKLS_MASSFUNC_UNRECVR, "ARKLS", + "arkLsMassSetup", MSG_LS_MASSFUNC_FAILED); + arkls_mem->last_flag = ARKLS_MASSFUNC_UNRECVR; + return(-1); + } + if (retval > 0) { + arkls_mem->last_flag = ARKLS_MASSFUNC_RECVR; + return(1); + } + + /* Copy M into M_lu for factorization (direct linear solvers) */ + if (!(arkls_mem->iterative)) { + retval = SUNMatCopy(arkls_mem->M, arkls_mem->M_lu); + if (retval) { + arkProcessError(ark_mem, ARKLS_SUNMAT_FAIL, "ARKLS", + "arkLsMassSetup", MSG_LS_SUNMAT_FAILED); + arkls_mem->last_flag = ARKLS_SUNMAT_FAIL; + return(arkls_mem->last_flag); + } + } + + /* signal call to matvec setup routine only if the user didn't provide + mtimes and the SUNMatrix implements the matvecsetup routine */ + if ((!arkls_mem->mtimes) && (arkls_mem->M->ops->matvecsetup)) + call_mvsetup = SUNTRUE; + else + call_mvsetup = SUNFALSE; + + /* signal call to LS setup routine */ + call_lssetup = SUNTRUE; + + } + + /* Call matvec setup routine if applicable */ + if (call_mvsetup) { + retval = SUNMatMatvecSetup(arkls_mem->M); + arkls_mem->nmvsetup++; + if (retval) { + arkProcessError(ark_mem, ARKLS_SUNMAT_FAIL, "ARKLS", + "arkLsMassSetup", MSG_LS_SUNMAT_FAILED); + arkls_mem->last_flag = ARKLS_SUNMAT_FAIL; + return(arkls_mem->last_flag); + } + } + + /* Call LS setup routine if applicable, and return */ + if (call_lssetup) { + arkls_mem->last_flag = SUNLinSolSetup(arkls_mem->LS, + arkls_mem->M_lu); + arkls_mem->nmsetups++; + } + + return(arkls_mem->last_flag); +} + + +/*--------------------------------------------------------------- + arkLsMassSolve: interfaces between ARKode and the generic + SUNLinearSolver object LS, by setting the appropriate tolerance + and scaling vectors, calling the solver, and accumulating + statistics from the solve for use/reporting by ARKode. + ---------------------------------------------------------------*/ +int arkLsMassSolve(void *arkode_mem, N_Vector b, realtype nlscoef) +{ + realtype resnorm, delta, rwt_mean; + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + long int nps_inc; + int nli_inc, retval; + + /* access ARKLsMassMem structure */ + retval = arkLs_AccessMassMem(arkode_mem, "arkLsMassSolve", + &ark_mem, &arkls_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Set input tolerance for iterative solvers (in 2-norm) */ + if (arkls_mem->iterative) { + delta = arkls_mem->eplifac * nlscoef * arkls_mem->nrmfac; + } else { + delta = ZERO; + } + + /* Set initial guess x = 0 for LS */ + N_VConst(ZERO, arkls_mem->x); + + /* Set scaling vectors for LS to use (if applicable) */ + if (arkls_mem->LS->ops->setscalingvectors) { + retval = SUNLinSolSetScalingVectors(arkls_mem->LS, + ark_mem->rwt, + ark_mem->ewt); + if (retval != SUNLS_SUCCESS) { + arkProcessError(ark_mem, ARKLS_SUNLS_FAIL, "ARKLS", "arkLsMassSolve", + "Error in call to SUNLinSolSetScalingVectors"); + arkls_mem->last_flag = ARKLS_SUNLS_FAIL; + return(arkls_mem->last_flag); + } + + /* If solver is iterative and does not support scaling vectors, update the + tolerance in an attempt to account for rwt vector. We make the + following assumptions: + 1. rwt_i = rwt_mean, for i=0,...,n-1 (i.e. the solution units are identical) + 2. the linear solver uses a basic 2-norm to measure convergence + Hence (using the notation from sunlinsol_spgmr.h, with S = diag(rwt)), + || bbar - Abar xbar ||_2 < tol + <=> || S b - S A x ||_2 < tol + <=> || S (b - A x) ||_2 < tol + <=> \sum_{i=0}^{n-1} (rwt_i (b - A x)_i)^2 < tol^2 + <=> rwt_mean^2 \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 + <=> \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 / rwt_mean^2 + <=> || b - A x ||_2 < tol / rwt_mean + So we compute rwt_mean = ||rwt||_RMS and scale the desired tolerance accordingly. */ + } else if (arkls_mem->iterative) { + + N_VConst(ONE, arkls_mem->x); + rwt_mean = N_VWrmsNorm(ark_mem->rwt, arkls_mem->x); + delta /= rwt_mean; + + } + + /* Set initial guess x = 0 for LS */ + N_VConst(ZERO, arkls_mem->x); + + /* Set zero initial guess flag */ + retval = SUNLinSolSetZeroGuess(arkls_mem->LS, SUNTRUE); + if (retval != SUNLS_SUCCESS) return(-1); + + /* Store previous nps value in nps_inc */ + nps_inc = arkls_mem->nps; + + /* Call solver, copy x to b, and increment mass solver counter */ + retval = SUNLinSolSolve(arkls_mem->LS, arkls_mem->M_lu, + arkls_mem->x, b, delta); + N_VScale(ONE, arkls_mem->x, b); + arkls_mem->nmsolves++; + + /* Retrieve statistics from iterative linear solvers */ + resnorm = ZERO; + nli_inc = 0; + if (arkls_mem->iterative) { + if (arkls_mem->LS->ops->resnorm) + resnorm = SUNLinSolResNorm(arkls_mem->LS); + if (arkls_mem->LS->ops->numiters) + nli_inc = SUNLinSolNumIters(arkls_mem->LS); + } + + /* Increment counters nli and ncfl */ + arkls_mem->nli += nli_inc; + if (retval != SUNLS_SUCCESS) arkls_mem->ncfl++; + + /* Log solver statistics to diagnostics file (if requested) */ + if (ark_mem->report) + STAN_SUNDIALS_FPRINTF(ark_mem->diagfp, "ARKLS mass %"RSYM" %i %i\n", + resnorm, nli_inc, (int) (arkls_mem->nps - nps_inc)); + + /* Interpret solver return value */ + arkls_mem->last_flag = retval; + + switch(retval) { + + case SUNLS_SUCCESS: + return(0); + break; + case SUNLS_RES_REDUCED: + case SUNLS_CONV_FAIL: + case SUNLS_ATIMES_FAIL_REC: + case SUNLS_PSOLVE_FAIL_REC: + case SUNLS_PACKAGE_FAIL_REC: + case SUNLS_QRFACT_FAIL: + case SUNLS_LUFACT_FAIL: + return(1); + break; + case SUNLS_MEM_NULL: + case SUNLS_ILL_INPUT: + case SUNLS_MEM_FAIL: + case SUNLS_GS_FAIL: + case SUNLS_QRSOL_FAIL: + return(-1); + break; + case SUNLS_PACKAGE_FAIL_UNREC: + arkProcessError(ark_mem, SUNLS_PACKAGE_FAIL_UNREC, "ARKLS", + "arkLsMassSolve", + "Failure in SUNLinSol external package"); + return(-1); + break; + case SUNLS_ATIMES_FAIL_UNREC: + arkProcessError(ark_mem, SUNLS_ATIMES_FAIL_UNREC, "ARKLS", + "arkLsMassSolve", MSG_LS_MTIMES_FAILED); + return(-1); + break; + case SUNLS_PSOLVE_FAIL_UNREC: + arkProcessError(ark_mem, SUNLS_PSOLVE_FAIL_UNREC, "ARKLS", + "arkLsMassSolve", MSG_LS_PSOLVE_FAILED); + return(-1); + break; + } + + return(0); +} + + +/*--------------------------------------------------------------- + arkLsMassFree frees memory associates with the ARKLs mass + matrix solver interface. + ---------------------------------------------------------------*/ +int arkLsMassFree(void *arkode_mem) +{ + ARKodeMem ark_mem; + ARKLsMassMem arkls_mem; + void* ark_step_massmem; + + /* Return immediately if ARKodeMem, ARKLsMassMem are NULL */ + if (arkode_mem == NULL) return (ARKLS_SUCCESS); + ark_mem = (ARKodeMem) arkode_mem; + ark_step_massmem = ark_mem->step_getmassmem(arkode_mem); + if (ark_step_massmem == NULL) return(ARKLS_SUCCESS); + arkls_mem = (ARKLsMassMem) ark_step_massmem; + + /* detach ARKLs interface routines from LS object (ignore return values) */ + if (arkls_mem->LS) { + if (arkls_mem->LS->ops) { + if (arkls_mem->LS->ops->setatimes) + SUNLinSolSetATimes(arkls_mem->LS, NULL, NULL); + + if (arkls_mem->LS->ops->setpreconditioner) + SUNLinSolSetPreconditioner(arkls_mem->LS, NULL, NULL, NULL); + } + } + + /* Free N_Vector memory */ + if (arkls_mem->x) { + N_VDestroy(arkls_mem->x); + arkls_mem->x = NULL; + } + + /* Free M_lu memory (direct linear solvers) */ + if (!(arkls_mem->iterative) && arkls_mem->M_lu) { + SUNMatDestroy(arkls_mem->M_lu); + } + arkls_mem->M_lu = NULL; + + /* Nullify other N_Vector pointers */ + arkls_mem->ycur = NULL; + + /* Nullify other SUNMatrix pointer */ + arkls_mem->M = NULL; + + /* Free preconditioner memory (if applicable) */ + if (arkls_mem->pfree) + arkls_mem->pfree(ark_mem); + + /* free ARKLs interface structure */ + free(arkls_mem); + + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkLsInitializeCounters and arkLsInitializeMassCounters: + + These routines reset all counters from an ARKLsMem or + ARKLsMassMem structure. + ---------------------------------------------------------------*/ +int arkLsInitializeCounters(ARKLsMem arkls_mem) +{ + arkls_mem->nje = 0; + arkls_mem->nfeDQ = 0; + arkls_mem->nstlj = 0; + arkls_mem->npe = 0; + arkls_mem->nli = 0; + arkls_mem->nps = 0; + arkls_mem->ncfl = 0; + arkls_mem->njtsetup = 0; + arkls_mem->njtimes = 0; + return(0); +} + +int arkLsInitializeMassCounters(ARKLsMassMem arkls_mem) +{ + arkls_mem->nmsetups = 0; + arkls_mem->nmsolves = 0; + arkls_mem->nmtsetup = 0; + arkls_mem->nmtimes = 0; + arkls_mem->nmvsetup = 0; + arkls_mem->npe = 0; + arkls_mem->nli = 0; + arkls_mem->nps = 0; + arkls_mem->ncfl = 0; + arkls_mem->msetuptime = -BIG_REAL; + return(0); +} + + +/*--------------------------------------------------------------- + arkLs_AccessLMem and arkLs_AccessMassMem: + + Shortcut routines to unpack ark_mem, ls_mem and mass_mem + structures from void* pointer. If any is missing it returns + ARKLS_MEM_NULL, ARKLS_LMEM_NULL or ARKLS_MASSMEM_NULL. + ---------------------------------------------------------------*/ +int arkLs_AccessLMem(void* arkode_mem, const char *fname, + ARKodeMem *ark_mem, ARKLsMem *arkls_mem) +{ + void* ark_step_lmem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARKLS_MEM_NULL, "ARKLS", + fname, MSG_LS_ARKMEM_NULL); + return(ARKLS_MEM_NULL); + } + *ark_mem = (ARKodeMem) arkode_mem; + ark_step_lmem = (*ark_mem)->step_getlinmem(arkode_mem); + if (ark_step_lmem==NULL) { + arkProcessError(*ark_mem, ARKLS_LMEM_NULL, "ARKLS", + fname, MSG_LS_LMEM_NULL); + return(ARKLS_LMEM_NULL); + } + *arkls_mem = (ARKLsMem) ark_step_lmem; + return(ARKLS_SUCCESS); +} + +int arkLs_AccessMassMem(void* arkode_mem, const char *fname, + ARKodeMem *ark_mem, ARKLsMassMem *arkls_mem) +{ + void* ark_step_massmem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARKLS_MEM_NULL, "ARKLS", + fname, MSG_LS_ARKMEM_NULL); + return(ARKLS_MEM_NULL); + } + *ark_mem = (ARKodeMem) arkode_mem; + ark_step_massmem = (*ark_mem)->step_getmassmem(arkode_mem); + if (ark_step_massmem==NULL) { + arkProcessError(*ark_mem, ARKLS_MASSMEM_NULL, "ARKLS", + fname, MSG_LS_MASSMEM_NULL); + return(ARKLS_MASSMEM_NULL); + } + *arkls_mem = (ARKLsMassMem) ark_step_massmem; + return(ARKLS_SUCCESS); +} + + +/*--------------------------------------------------------------- + EOF + ---------------------------------------------------------------*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_ls_impl.h b/lib/sundials_6.1.1/src/arkode/arkode_ls_impl.h new file mode 100644 index 00000000000..ab52f38b99f --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_ls_impl.h @@ -0,0 +1,340 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * Implementation header file for ARKode's linear solver interface. + *--------------------------------------------------------------*/ + +#ifndef _ARKLS_IMPL_H +#define _ARKLS_IMPL_H + +#include +#include "arkode_impl.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + +/*--------------------------------------------------------------- + ARKLS solver constants: + + ARKLS_MSBJ default maximum number of steps between Jacobian / + preconditioner evaluations + + ARKLS_EPLIN default value for factor by which the tolerance + on the nonlinear iteration is multiplied to get + a tolerance on the linear iteration + ---------------------------------------------------------------*/ +#define ARKLS_MSBJ 51 +#define ARKLS_EPLIN RCONST(0.05) + + +/*--------------------------------------------------------------- + Types: ARKLsMemRec, ARKLsMem + + The type ARKLsMem is pointer to a ARKLsMemRec. + ---------------------------------------------------------------*/ +typedef struct ARKLsMemRec { + + /* Linear solver type information */ + booleantype iterative; /* is the solver iterative? */ + booleantype matrixbased; /* is a matrix structure used? */ + + /* Jacobian construction & storage */ + booleantype jacDQ; /* SUNTRUE if using internal DQ Jacobian approx. */ + ARKLsJacFn jac; /* Jacobian routine to be called */ + void *J_data; /* user data is passed to jac */ + booleantype jbad; /* heuristic suggestion for pset */ + + /* Matrix-based solver, scale solution to account for change in gamma */ + booleantype scalesol; + + /* Iterative solver tolerance */ + realtype eplifac; /* nonlinear -> linear tol scaling factor */ + realtype nrmfac; /* integrator -> LS norm conversion factor */ + + /* Linear solver, matrix and vector objects/pointers */ + SUNLinearSolver LS; /* generic linear solver object */ + SUNMatrix A; /* A = M - gamma * df/dy */ + SUNMatrix savedJ; /* savedJ = old Jacobian */ + N_Vector ytemp; /* temp vector passed to jtimes and psolve */ + N_Vector x; /* solution vector used by SUNLinearSolver */ + N_Vector ycur; /* ptr to current y vector in ARKLs solve */ + N_Vector fcur; /* ptr to current fcur = fI(tcur, ycur) */ + + /* Statistics and associated parameters */ + long int msbj; /* max num steps between jac/pset calls */ + realtype tcur; /* 'time' for current ARKLs solve */ + long int nje; /* no. of calls to jac */ + long int nfeDQ; /* no. of calls to f due to DQ Jacobian or J*v + approximations */ + long int nstlj; /* value of nst at the last jac/pset call */ + long int npe; /* npe = total number of pset calls */ + long int nli; /* nli = total number of linear iterations */ + long int nps; /* nps = total number of psolve calls */ + long int ncfl; /* ncfl = total number of convergence failures */ + long int njtsetup; /* njtsetup = total number of calls to jtsetup */ + long int njtimes; /* njtimes = total number of calls to jtimes */ + + /* Preconditioner computation + (a) user-provided: + - P_data == user_data + - pfree == NULL (the user dealocates memory for user_data) + (b) internal preconditioner module + - P_data == arkode_mem + - pfree == set by the prec. module and called in ARKodeFree */ + ARKLsPrecSetupFn pset; + ARKLsPrecSolveFn psolve; + int (*pfree)(ARKodeMem ark_mem); + void *P_data; + + /* Jacobian times vector computation + (a) jtimes function provided by the user: + - Jt_data == user_data + - jtimesDQ == SUNFALSE + (b) internal jtimes + - Jt_data == arkode_mem + - jtimesDQ == SUNTRUE */ + booleantype jtimesDQ; + ARKLsJacTimesSetupFn jtsetup; + ARKLsJacTimesVecFn jtimes; + ARKRhsFn Jt_f; + void *Jt_data; + + + /* Linear system setup function + * (a) user-provided linsys function: + * - user_linsys = SUNTRUE + * - A_data = user_data + * (b) internal linsys function: + * - user_linsys = SUNFALSE + * - A_data = cvode_mem */ + booleantype user_linsys; + ARKLsLinSysFn linsys; + void* A_data; + + int last_flag; /* last error flag returned by any function */ + +} *ARKLsMem; + + +/*--------------------------------------------------------------- + Types: ARKLsMassMemRec, ARKLsMassMem + + The type ARKLsMassMem is pointer to a ARKLsMassMemRec. + ---------------------------------------------------------------*/ +typedef struct ARKLsMassMemRec { + + /* Linear solver type information */ + booleantype iterative; /* is the solver iterative? */ + booleantype matrixbased; /* is a matrix structure used? */ + + /* Mass matrix construction & storage */ + ARKLsMassFn mass; /* user-provided mass matrix routine to call */ + SUNMatrix M; /* mass matrix structure */ + SUNMatrix M_lu; /* mass matrix structure for LU decomposition */ + void* M_data; /* user data pointer */ + + /* Iterative solver tolerance */ + realtype eplifac; /* nonlinear -> linear tol scaling factor */ + realtype nrmfac; /* integrator -> LS norm conversion factor */ + + /* Statistics and associated parameters */ + booleantype time_dependent; /* flag whether M depends on t */ + realtype msetuptime; /* "t" value at last msetup call */ + long int nmsetups; /* total # mass matrix-solver setups */ + long int nmsolves; /* total # mass matrix-solver solves */ + long int nmtsetup; /* total # calls to mtsetup */ + long int nmtimes; /* total # calls to mtimes */ + long int nmvsetup; /* total # calls to matvec setup */ + long int npe; /* total # pset calls */ + long int nli; /* total # linear iterations */ + long int nps; /* total # psolve calls */ + long int ncfl; /* total # convergence failures */ + + /* Linear solver, matrix and vector objects/pointers */ + SUNLinearSolver LS; /* generic linear solver object */ + N_Vector x; /* solution vector used by SUNLinearSolver */ + N_Vector ycur; /* ptr to ARKode current y vector */ + + /* Preconditioner computation + (a) user-provided: + - P_data == user_data + - pfree == NULL (the user dealocates memory for user_data) + (b) internal preconditioner module + - P_data == arkode_mem + - pfree == set by the prec. module and called in ARKodeFree */ + ARKLsMassPrecSetupFn pset; + ARKLsMassPrecSolveFn psolve; + int (*pfree)(ARKodeMem ark_mem); + void *P_data; + + /* Mass matrix times vector setup and product routines, data */ + ARKLsMassTimesSetupFn mtsetup; + ARKLsMassTimesVecFn mtimes; + void *mt_data; + + int last_flag; /* last error flag returned by any function */ + +} *ARKLsMassMem; + + +/*--------------------------------------------------------------- + Prototypes of internal functions + ---------------------------------------------------------------*/ + +/* Interface routines called by system SUNLinearSolver */ +int arkLsATimes(void* arkode_mem, N_Vector v, N_Vector z); +int arkLsPSetup(void* arkode_mem); +int arkLsPSolve(void* arkode_mem, N_Vector r, N_Vector z, + realtype tol, int lr); + +/* Interface routines called by mass SUNLinearSolver */ +int arkLsMTimes(void* arkode_mem, N_Vector v, N_Vector z); +int arkLsMPSetup(void* arkode_mem); +int arkLsMPSolve(void* arkode_mem, N_Vector r, N_Vector z, + realtype tol, int lr); + +/* Difference quotient approximation for Jac times vector */ +int arkLsDQJtimes(N_Vector v, N_Vector Jv, realtype t, + N_Vector y, N_Vector fy, void* data, + N_Vector work); + +/* Difference-quotient Jacobian approximation routines */ +int arkLsDQJac(realtype t, N_Vector y, N_Vector fy, + SUNMatrix Jac, void* data, N_Vector tmp1, + N_Vector tmp2, N_Vector tmp3); +int arkLsDenseDQJac(realtype t, N_Vector y, N_Vector fy, + SUNMatrix Jac, ARKodeMem ark_mem, + ARKLsMem arkls_mem, ARKRhsFn fi, N_Vector tmp1); +int arkLsBandDQJac(realtype t, N_Vector y, N_Vector fy, + SUNMatrix Jac, ARKodeMem ark_mem, + ARKLsMem arkls_mem, ARKRhsFn fi, + N_Vector tmp1, N_Vector tmp2); + +/* Generic linit/lsetup/lsolve/lfree interface routines for ARKode to call */ +int arkLsInitialize(void* arkode_mem); + +int arkLsSetup(void* arkode_mem, int convfail, realtype tpred, + N_Vector ypred, N_Vector fpred, booleantype* jcurPtr, + N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); + +int arkLsSolve(void* arkode_mem, N_Vector b, realtype tcur, + N_Vector ycur, N_Vector fcur, realtype eRnrm, int mnewt); + +int arkLsFree(void* arkode_mem); + +/* Generic minit/msetup/mmult/msolve/mfree routines for ARKode to call */ +int arkLsMassInitialize(void* arkode_mem); + +int arkLsMassSetup(void* arkode_mem, realtype t, N_Vector vtemp1, + N_Vector vtemp2, N_Vector vtemp3); + +int arkLsMassMult(void* arkode_mem, N_Vector v, N_Vector Mv); + +int arkLsMassSolve(void* arkode_mem, N_Vector b, realtype nlscoef); + +int arkLsMassFree(void* arkode_mem); + +/* Auxilliary functions */ +int arkLsInitializeCounters(ARKLsMem arkls_mem); + +int arkLsInitializeMassCounters(ARKLsMassMem arkls_mem); + +int arkLs_AccessLMem(void* arkode_mem, const char* fname, + ARKodeMem* ark_mem, ARKLsMem* arkls_mem); + +int arkLs_AccessMassMem(void* arkode_mem, const char* fname, + ARKodeMem* ark_mem, ARKLsMassMem* arkls_mem); + +/* Set/get routines called by time-stepper module */ +int arkLSSetLinearSolver(void* arkode_mem, SUNLinearSolver LS, SUNMatrix A); + +int arkLSSetMassLinearSolver(void* arkode_mem, SUNLinearSolver LS, + SUNMatrix M, booleantype time_dep); + +int arkLSSetJacFn(void* arkode_mem, ARKLsJacFn jac); +int arkLSSetMassFn(void* arkode_mem, ARKLsMassFn mass); +int arkLSSetEpsLin(void* arkode_mem, realtype eplifac); +int arkLSSetMassEpsLin(void* arkode_mem, realtype eplifac); +int arkLSSetNormFactor(void* arkode_mem, realtype nrmfac); +int arkLSSetMassNormFactor(void* arkode_mem, realtype nrmfac); +int arkLSSetJacEvalFrequency(void* arkode_mem, long int msbj); +int arkLSSetLinearSolutionScaling(void* arkode_mem, booleantype onoff); +int arkLSSetPreconditioner(void* arkode_mem, ARKLsPrecSetupFn psetup, + ARKLsPrecSolveFn psolve); +int arkLSSetMassPreconditioner(void* arkode_mem, ARKLsMassPrecSetupFn psetup, + ARKLsMassPrecSolveFn psolve); +int arkLSSetJacTimes(void* arkode_mem, ARKLsJacTimesSetupFn jtsetup, + ARKLsJacTimesVecFn jtimes); +int arkLSSetJacTimesRhsFn(void *arkode_mem, ARKRhsFn jtimesRhsFn); +int arkLSSetMassTimes(void* arkode_mem, ARKLsMassTimesSetupFn msetup, + ARKLsMassTimesVecFn mtimes, void* mtimes_data); +int arkLSSetLinSysFn(void* arkode_mem, ARKLsLinSysFn linsys); + +int arkLSSetUserData(void *arkode_mem, void* user_data); +int arkLSSetMassUserData(void *arkode_mem, void* user_data); + +int arkLSGetWorkSpace(void* arkode_mem, long int* lenrwLS, long int* leniwLS); +int arkLSGetNumJacEvals(void* arkode_mem, long int* njevals); +int arkLSGetNumPrecEvals(void* arkode_mem, long int* npevals); +int arkLSGetNumPrecSolves(void* arkode_mem, long int* npsolves); +int arkLSGetNumLinIters(void* arkode_mem, long int* nliters); +int arkLSGetNumConvFails(void* arkode_mem, long int* nlcfails); +int arkLSGetNumJTSetupEvals(void* arkode_mem, long int* njtsetups); +int arkLSGetNumJtimesEvals(void* arkode_mem, long int* njvevals); +int arkLSGetNumRhsEvals(void* arkode_mem, long int* nfevalsLS); +int arkLSGetLastFlag(void* arkode_mem, long int* flag); + +int arkLSGetMassWorkSpace(void* arkode_mem, long int* lenrwMLS, + long int* leniwMLS); +int arkLSGetNumMassSetups(void* arkode_mem, long int* nmsetups); +int arkLSGetNumMassMult(void* arkode_mem, long int* nmvevals); +int arkLSGetNumMassMatvecSetups(void *arkode_mem, long int *nmvsetups); +int arkLSGetNumMassSolves(void* arkode_mem, long int* nmsolves); +int arkLSGetNumMassPrecEvals(void* arkode_mem, long int* nmpevals); +int arkLSGetNumMassPrecSolves(void* arkode_mem, long int* nmpsolves); +int arkLSGetNumMassIters(void* arkode_mem, long int* nmiters); +int arkLSGetNumMassConvFails(void* arkode_mem, long int* nmcfails); +int arkLSGetNumMTSetups(void* arkode_mem, long int* nmtsetups); +int arkLSGetCurrentMassMatrix(void* arkode_mem, SUNMatrix *M); +int arkLSGetLastMassFlag(void* arkode_mem, long int* flag); + +char* arkLSGetReturnFlagName(long int flag); + +/*--------------------------------------------------------------- + Error Messages + ---------------------------------------------------------------*/ +#define MSG_LS_ARKMEM_NULL "Integrator memory is NULL." +#define MSG_LS_MEM_FAIL "A memory request failed." +#define MSG_LS_BAD_NVECTOR "A required vector operation is not implemented." +#define MSG_LS_BAD_LSTYPE "Incompatible linear solver type." +#define MSG_LS_LMEM_NULL "Linear solver memory is NULL." +#define MSG_LS_MASSMEM_NULL "Mass matrix solver memory is NULL." +#define MSG_LS_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." + +#define MSG_LS_PSET_FAILED "The preconditioner setup routine failed in an unrecoverable manner." +#define MSG_LS_PSOLVE_FAILED "The preconditioner solve routine failed in an unrecoverable manner." +#define MSG_LS_JTSETUP_FAILED "The Jacobian x vector setup routine failed in an unrecoverable manner." +#define MSG_LS_JTIMES_FAILED "The Jacobian x vector routine failed in an unrecoverable manner." +#define MSG_LS_MTSETUP_FAILED "The mass matrix x vector setup routine failed in an unrecoverable manner." +#define MSG_LS_MTIMES_FAILED "The mass matrix x vector routine failed in an unrecoverable manner." + +#define MSG_LS_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." +#define MSG_LS_MASSFUNC_FAILED "The mass matrix routine failed in an unrecoverable manner." +#define MSG_LS_SUNMAT_FAILED "A SUNMatrix routine failed in an unrecoverable manner." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/src/arkode/arkode_mri_tables.c b/lib/sundials_6.1.1/src/arkode/arkode_mri_tables.c new file mode 100644 index 00000000000..263b2e0d14f --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_mri_tables.c @@ -0,0 +1,1080 @@ +/* --------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * Daniel R. Reynolds @ SMU + * --------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 MRIStepCoupling tables. + * ---------------------------------------------------------------------------*/ + +#include +#include +#include + +#include "arkode_impl.h" +#include "arkode_mristep_impl.h" +#include + + +/* =========================================================================== + * Exported Functions + * ===========================================================================*/ + + +/*--------------------------------------------------------------- + Returns MRIStepCoupling table structure for pre-set MRI methods. + + Input: imeth -- integer key for the desired method (see below) + + Allowed 'method' names and properties are listed in the table + below. + + The 'type' column denotes whether the method is explicit (E), + or solve-decoupled implicit (ID). + + The 'QP' column denotes whether the coefficients of the method + are known precisely enough for use in quad precision (128-bit) + calculations. + + imeth order type QP + ------------------------------------------------ + ARKODE_MIS_KW3 3 E Y + ARKODE_MRI_GARK_ERK33a 3 E Y + ARKODE_MRI_GARK_ERK45a 4 E Y + ARKODE_MRI_GARK_IRK21a 2 ID Y + ARKODE_MRI_GARK_ESDIRK34a 3 ID Y + ARKODE_MRI_GARK_ESDIRK46a 4 ID Y + ARKODE_IMEX_MRI_GARK3a 3 ID Y + ARKODE_IMEX_MRI_GARK3b 3 ID Y + ARKODE_IMEX_MRI_GARK4 4 ID Y + ------------------------------------------------ + + ---------------------------------------------------------------*/ +MRIStepCoupling MRIStepCoupling_LoadTable(ARKODE_MRITableID imethod) +{ + + MRIStepCoupling C = NULL; + ARKodeButcherTable B = NULL; + realtype beta; + + /* fill in coefficients based on method name */ + switch(imethod) { + + case(ARKODE_MIS_KW3): + /* Schlegel et al., JCAM 226:345-357, 2009 */ + B = ARKodeButcherTable_LoadERK(ARKODE_KNOTH_WOLKE_3_3); + C = MRIStepCoupling_MIStoMRI(B, 3, 0); + ARKodeButcherTable_Free(B); + break; + + case(ARKODE_MRI_GARK_ERK33a): + /* A. Sandu, SINUM 57:2300-2327, 2019 */ + C = MRIStepCoupling_Alloc(2, 4, MRISTEP_EXPLICIT); + + C->q = 3; + C->p = 0; + + C->c[1] = ONE/RCONST(3.0); + C->c[2] = TWO/RCONST(3.0); + C->c[3] = ONE; + + C->W[0][1][0] = ONE/RCONST(3.0); + C->W[0][2][0] = -ONE/RCONST(3.0); + C->W[0][2][1] = TWO/RCONST(3.0); + C->W[0][3][1] = -TWO/RCONST(3.0); + C->W[0][3][2] = ONE; + + C->W[1][3][0] = ONE/TWO; + C->W[1][3][2] = -ONE/TWO; + + break; + + case(ARKODE_MRI_GARK_ERK45a): + /* A. Sandu, SINUM 57:2300-2327, 2019 */ + C = MRIStepCoupling_Alloc(2, 6, MRISTEP_EXPLICIT); + + C->q = 4; + C->p = 0; + + C->c[1] = RCONST(0.2); + C->c[2] = RCONST(0.4); + C->c[3] = RCONST(0.6); + C->c[4] = RCONST(0.8); + C->c[5] = ONE; + + C->W[0][1][0] = RCONST(0.2); + C->W[0][2][0] = -RCONST(53.0)/RCONST(16.0); + C->W[0][2][1] = RCONST(281.0)/RCONST(80.0); + C->W[0][3][0] = -RCONST(36562993.0)/RCONST(71394880.0); + C->W[0][3][1] = RCONST(34903117.0)/RCONST(17848720.0); + C->W[0][3][2] = -RCONST(88770499.0)/RCONST(71394880.0); + C->W[0][4][0] = -RCONST(7631593.0)/RCONST(71394880.0); + C->W[0][4][1] = -RCONST(166232021.0)/RCONST(35697440.0); + C->W[0][4][2] = RCONST(6068517.0)/RCONST(1519040.0); + C->W[0][4][3] = RCONST(8644289.0)/RCONST(8924360.0); + C->W[0][5][0] = RCONST(277061.0)/RCONST(303808.0); + C->W[0][5][1] = -RCONST(209323.0)/RCONST(1139280.0); + C->W[0][5][2] = -RCONST(1360217.0)/RCONST(1139280.0); + C->W[0][5][3] = -RCONST(148789.0)/RCONST(56964.0); + C->W[0][5][4] = RCONST(147889.0)/RCONST(45120.0); + + C->W[1][2][0] = RCONST(503.0)/RCONST(80.0); + C->W[1][2][1] = -RCONST(503.0)/RCONST(80.0); + C->W[1][3][0] = -RCONST(1365537.0)/RCONST(35697440.0); + C->W[1][3][1] = RCONST(4963773.0)/RCONST(7139488.0); + C->W[1][3][2] = -RCONST(1465833.0)/RCONST(2231090.0); + C->W[1][4][0] = RCONST(66974357.0)/RCONST(35697440.0); + C->W[1][4][1] = RCONST(21445367.0)/RCONST(7139488.0); + C->W[1][4][2] = -RCONST(3.0); + C->W[1][4][3] = -RCONST(8388609.0)/RCONST(4462180.0); + C->W[1][5][0] = -RCONST(18227.0)/RCONST(7520.0); + C->W[1][5][1] = TWO; + C->W[1][5][2] = ONE; + C->W[1][5][3] = RCONST(5.0); + C->W[1][5][4] = -RCONST(41933.0)/RCONST(7520.0); + + break; + + case(ARKODE_MRI_GARK_IRK21a): + /* A. Sandu, SINUM 57:2300-2327, 2019 */ + B = ARKodeButcherTable_Alloc(3, SUNFALSE); + + B->q=2; + + B->c[1] = ONE; + B->c[2] = ONE; + + B->A[1][0] = ONE; + B->A[2][0] = RCONST(0.5); + B->A[2][2] = RCONST(0.5); + + B->b[0] = RCONST(0.5); + B->b[2] = RCONST(0.5); + + C = MRIStepCoupling_MIStoMRI(B, 2, 0); + ARKodeButcherTable_Free(B); + + break; + + case(ARKODE_MRI_GARK_ESDIRK34a): + /* A. Sandu, SINUM 57:2300-2327, 2019 */ + C = MRIStepCoupling_Alloc(1, 7, MRISTEP_IMPLICIT); + + beta = RCONST(0.4358665215084589994160194511935568425); + + C->q = 3; + C->p = 0; + + C->c[1] = ONE/RCONST(3.0); + C->c[2] = ONE/RCONST(3.0); + C->c[3] = TWO/RCONST(3.0); + C->c[4] = TWO/RCONST(3.0); + C->c[5] = ONE; + C->c[6] = ONE; + + C->G[0][1][0] = ONE/RCONST(3.0); + C->G[0][2][0] = -beta; + C->G[0][2][2] = beta; + C->G[0][3][0] = RCONST(-0.3045790611944504970424837655380884888); + C->G[0][3][2] = RCONST(0.6379123945277838303758170988714218222); + C->G[0][4][0] = RCONST(0.2116913105640266601676536489364004869); + C->G[0][4][2] = RCONST(-0.6475578320724856595836731001299573294); + C->G[0][4][4] = beta; + C->G[0][5][0] = RCONST(0.4454209388055495029575162344619115112); + C->G[0][5][2] = RCONST(0.8813784805616198280398949036456491923); + C->G[0][5][4] = RCONST(-0.9934660860338359976640778047742273701); + C->G[0][6][0] = -beta; + C->G[0][6][6] = beta; + + break; + + case(ARKODE_MRI_GARK_ESDIRK46a): + /* A. Sandu, SINUM 57:2300-2327, 2019 */ + C = MRIStepCoupling_Alloc(2, 11, MRISTEP_IMPLICIT); + + C->q = 4; + C->p = 0; + + C->c[1] = ONE/RCONST(5.0); + C->c[2] = ONE/RCONST(5.0); + C->c[3] = TWO/RCONST(5.0); + C->c[4] = TWO/RCONST(5.0); + C->c[5] = RCONST(3.0)/RCONST(5.0); + C->c[6] = RCONST(3.0)/RCONST(5.0); + C->c[7] = RCONST(4.0)/RCONST(5.0); + C->c[8] = RCONST(4.0)/RCONST(5.0); + C->c[9] = ONE; + C->c[10] = ONE; + + C->G[0][1][0] = ONE/RCONST(5.0); + C->G[0][2][0] = -ONE/RCONST(4.0); + C->G[0][2][2] = ONE/RCONST(4.0); + C->G[0][3][0] = RCONST(1771023115159.0)/RCONST(1929363690800.0); + C->G[0][3][2] = -RCONST(1385150376999.0)/RCONST(1929363690800.0); + C->G[0][4][0] = RCONST(914009.0)/RCONST(345800.0); + C->G[0][4][2] = -RCONST(1000459.0)/RCONST(345800.0); + C->G[0][4][4] = ONE/RCONST(4.0); + C->G[0][5][0] = RCONST(18386293581909.0)/RCONST(36657910125200.0); + C->G[0][5][2] = RCONST(5506531089.0)/RCONST(80566835440.0); + C->G[0][5][4] = -RCONST(178423463189.0)/RCONST(482340922700.0); + C->G[0][6][0] = RCONST(36036097.0)/RCONST(8299200.0); + C->G[0][6][2] = RCONST(4621.0)/RCONST(118560.0); + C->G[0][6][4] = -RCONST(38434367.0)/RCONST(8299200.0); + C->G[0][6][6] = ONE/RCONST(4.0); + C->G[0][7][0] = -RCONST(247809665162987.0)/RCONST(146631640500800.0); + C->G[0][7][2] = RCONST(10604946373579.0)/RCONST(14663164050080.0); + C->G[0][7][4] = RCONST(10838126175385.0)/RCONST(5865265620032.0); + C->G[0][7][6] = -RCONST(24966656214317.0)/RCONST(36657910125200.0); + C->G[0][8][0] = RCONST(38519701.0)/RCONST(11618880.0); + C->G[0][8][2] = RCONST(10517363.0)/RCONST(9682400.0); + C->G[0][8][4] = -RCONST(23284701.0)/RCONST(19364800.0); + C->G[0][8][6] = -RCONST(10018609.0)/RCONST(2904720.0); + C->G[0][8][8] = ONE/RCONST(4.0); + C->G[0][9][0] = -RCONST(52907807977903.0)/RCONST(33838070884800.0); + C->G[0][9][2] = RCONST(74846944529257.0)/RCONST(73315820250400.0); + C->G[0][9][4] = RCONST(365022522318171.0)/RCONST(146631640500800.0); + C->G[0][9][6] = -RCONST(20513210406809.0)/RCONST(109973730375600.0); + C->G[0][9][8] = -RCONST(2918009798.0)/RCONST(1870301537.0); + C->G[0][10][0] = RCONST(19.0)/RCONST(100.0); + C->G[0][10][2] = -RCONST(73.0)/RCONST(300.0); + C->G[0][10][4] = RCONST(127.0)/RCONST(300.0); + C->G[0][10][6] = RCONST(127.0)/RCONST(300.0); + C->G[0][10][8] = -RCONST(313.0)/RCONST(300.0); + C->G[0][10][10] = ONE/RCONST(4.0); + + C->G[1][3][0] = -RCONST(1674554930619.0)/RCONST(964681845400.0); + C->G[1][3][2] = RCONST(1674554930619.0)/RCONST(964681845400.0); + C->G[1][4][0] = -RCONST(1007739.0)/RCONST(172900.0); + C->G[1][4][2] = RCONST(1007739.0)/RCONST(172900.0); + C->G[1][5][0] = -RCONST(8450070574289.0)/RCONST(18328955062600.0); + C->G[1][5][2] = -RCONST(39429409169.0)/RCONST(40283417720.0); + C->G[1][5][4] = RCONST(173621393067.0)/RCONST(120585230675.0); + C->G[1][6][0] = -RCONST(122894383.0)/RCONST(16598400.0); + C->G[1][6][2] = RCONST(14501.0)/RCONST(237120.0); + C->G[1][6][4] = RCONST(121879313.0)/RCONST(16598400.0); + C->G[1][7][0] = RCONST(32410002731287.0)/RCONST(15434909526400.0); + C->G[1][7][2] = -RCONST(46499276605921.0)/RCONST(29326328100160.0); + C->G[1][7][4] = -RCONST(34914135774643.0)/RCONST(11730531240064.0); + C->G[1][7][6] = RCONST(45128506783177.0)/RCONST(18328955062600.0); + C->G[1][8][0] = -RCONST(128357303.0)/RCONST(23237760.0); + C->G[1][8][2] = -RCONST(35433927.0)/RCONST(19364800.0); + C->G[1][8][4] = RCONST(71038479.0)/RCONST(38729600.0); + C->G[1][8][6] = RCONST(8015933.0)/RCONST(1452360.0); + C->G[1][9][0] = RCONST(136721604296777.0)/RCONST(67676141769600.0); + C->G[1][9][2] = -RCONST(349632444539303.0)/RCONST(146631640500800.0); + C->G[1][9][4] = -RCONST(1292744859249609.0)/RCONST(293263281001600.0); + C->G[1][9][6] = RCONST(8356250416309.0)/RCONST(54986865187800.0); + C->G[1][9][8] = RCONST(17282943803.0)/RCONST(3740603074.0); + C->G[1][10][0] = RCONST(3.0)/RCONST(25.0); + C->G[1][10][2] = -RCONST(29.0)/RCONST(300.0); + C->G[1][10][4] = RCONST(71.0)/RCONST(300.0); + C->G[1][10][6] = RCONST(71.0)/RCONST(300.0); + C->G[1][10][8] = -RCONST(149.0)/RCONST(300.0); + + break; + + case(ARKODE_IMEX_MRI_GARK3a): + /* R. Chinomona & D. Reynolds SINUM 43(5):A3082-A3113, 2021 */ + C = MRIStepCoupling_Alloc(1, 8, MRISTEP_IMEX); + + beta = RCONST(0.4358665215084589994160194511935568425); + + C->q = 3; + C->p = 0; + + C->c[1] = beta; + C->c[2] = beta; + C->c[3] = RCONST(0.7179332607542294997080097255967784213); + C->c[4] = RCONST(0.7179332607542294997080097255967784213); + C->c[5] = ONE; + C->c[6] = ONE; + C->c[7] = ONE; + + C->W[0][1][0] = beta; + C->W[0][3][0] = -RCONST(0.5688715801234400928465032925317932021); + C->W[0][3][2] = RCONST(0.8509383193692105931384935669350147809); + C->W[0][4][0] = RCONST(0.454283944643608855878770886900124654); + C->W[0][4][2] = -RCONST(0.454283944643608855878770886900124654); + C->W[0][5][0] = -RCONST(0.4271371821005074011706645050390732474); + C->W[0][5][2] = RCONST(0.1562747733103380821014660497037023496); + C->W[0][5][4] = RCONST(0.5529291480359398193611887297385924765); + C->W[0][7][0] = RCONST(0.105858296071879638722377459477184953); + C->W[0][7][2] = RCONST(0.655567501140070250975288954324730635); + C->W[0][7][4] = -RCONST(1.197292318720408889113685864995472431); + C->W[0][7][6] = beta; + + C->G[0][1][0] = beta; + C->G[0][2][0] = -beta; + C->G[0][2][2] = beta; + C->G[0][3][0] = -RCONST(0.4103336962288525014599513720161078937); + C->G[0][3][2] = RCONST(0.6924004354746230017519416464193294724); + C->G[0][4][0] = RCONST(0.4103336962288525014599513720161078937); + C->G[0][4][2] = -RCONST(0.8462002177373115008759708232096647362); + C->G[0][4][4] = beta; + C->G[0][5][0] = beta; + C->G[0][5][2] = RCONST(0.9264299099302395700444874096601015328); + C->G[0][5][4] = -RCONST(1.080229692192928069168516586450436797); + C->G[0][6][0] = -beta; + C->G[0][6][6] = beta; + + break; + + case(ARKODE_IMEX_MRI_GARK3b): + /* R. Chinomona & D. Reynolds SINUM 43(5):A3082-A3113, 2021 */ + C = MRIStepCoupling_Alloc(1, 8, MRISTEP_IMEX); + + beta = RCONST(0.4358665215084589994160194511935568425); + + C->q = 3; + C->p = 0; + + C->c[1] = beta; + C->c[2] = beta; + C->c[3] = RCONST(0.7179332607542294997080097255967784213); + C->c[4] = RCONST(0.7179332607542294997080097255967784213); + C->c[5] = ONE; + C->c[6] = ONE; + C->c[7] = ONE; + + C->W[0][1][0] = beta; + C->W[0][3][0] = -RCONST(0.1750145285570467590610670000018749059); + C->W[0][3][2] = RCONST(0.4570812678028172593530572744050964846); + C->W[0][4][0] = RCONST(0.06042689307721552209333459437020635774); + C->W[0][4][2] = -RCONST(0.06042689307721552209333459437020635774); + C->W[0][5][0] = RCONST(0.1195213959425454440038786034027936869); + C->W[0][5][2] = -RCONST(1.84372522668966191789853395029629765); + C->W[0][5][4] = RCONST(2.006270569992886974186645621296725542); + C->W[0][6][0] = -RCONST(0.5466585780430528451745431084418669343); + C->W[0][6][2] = RCONST(2.0); + C->W[0][6][4] = -RCONST(1.453341421956947154825456891558133066); + C->W[0][7][0] = RCONST(0.105858296071879638722377459477184953); + C->W[0][7][2] = RCONST(0.655567501140070250975288954324730635); + C->W[0][7][4] = -RCONST(1.197292318720408889113685864995472431); + C->W[0][7][6] = beta; + + C->G[0][1][0] = beta; + C->G[0][2][0] = -beta; + C->G[0][2][2] = beta; + C->G[0][3][0] = RCONST(0.0414273753564414837153799230278275639); + C->G[0][3][2] = RCONST(0.2406393638893290165766103513753940148); + C->G[0][4][0] = -RCONST(0.0414273753564414837153799230278275639); + C->G[0][4][2] = -RCONST(0.3944391461520175157006395281657292786); + C->G[0][4][4] = beta; + C->G[0][5][0] = RCONST(0.1123373143006047802633543416889605123); + C->G[0][5][2] = RCONST(1.051807513648115027700693049638099167); + C->G[0][5][4] = -RCONST(0.8820780887029493076720571169238381009); + C->G[0][6][0] = -RCONST(0.1123373143006047802633543416889605123); + C->G[0][6][2] = -RCONST(0.1253776037178754576562056399779976346); + C->G[0][6][4] = -RCONST(0.1981516034899787614964594695265986957); + C->G[0][6][6] = beta; + + break; + + case(ARKODE_IMEX_MRI_GARK4): + /* R. Chinomona & D. Reynolds SINUM 43(5):A3082-A3113, 2021 */ + C = MRIStepCoupling_Alloc(2, 12, MRISTEP_IMEX); + + C->q = 4; + C->p = 0; + + C->c[1] = RCONST(0.5); + C->c[2] = RCONST(0.5); + C->c[3] = RCONST(0.625); + C->c[4] = RCONST(0.625); + C->c[5] = RCONST(0.75); + C->c[6] = RCONST(0.75); + C->c[7] = RCONST(0.875); + C->c[8] = RCONST(0.875); + C->c[9] = ONE; + C->c[10] = ONE; + C->c[11] = ONE; + + C->W[0][1][0] = RCONST(0.5); + C->W[0][3][0] = -RCONST(1.91716534363662868878172216064946905); + C->W[0][3][2] = RCONST(2.04216534363662868878172216064946905); + C->W[0][4][0] = -RCONST(0.4047510318011059426979159070469904691); + C->W[0][4][2] = RCONST(0.4047510318011059426979159070469904691); + C->W[0][5][0] = RCONST(11.45146602249221636665698028602631728); + C->W[0][5][2] = -RCONST(30.21075747526504271440647815573950607); + C->W[0][5][4] = RCONST(18.88429145277282634774949786971318879); + C->W[0][6][0] = -RCONST(0.7090335647602614506847116729463301439); + C->W[0][6][2] = RCONST(1.03030720858751876652616190884004718); + C->W[0][6][4] = -RCONST(0.3212736438272573158414502358937170357); + C->W[0][7][0] = -RCONST(29.99548716455828439840910684944199275); + C->W[0][7][2] = RCONST(37.60598277499180180536489685624385701); + C->W[0][7][4] = RCONST(0.3212736438272573158414502358937170357); + C->W[0][7][6] = -RCONST(7.806769254260774722797240242695581295); + C->W[0][8][0] = RCONST(3.104665054272962116338769391849124223); + C->W[0][8][2] = -RCONST(2.430325019757162297132065927415566359); + C->W[0][8][4] = -RCONST(1.905479301151524635219201659483842131); + C->W[0][8][6] = RCONST(1.231139266635724816012498195050284266); + C->W[0][9][0] = -RCONST(2.424429547752047869875875914355514008); + C->W[0][9][2] = RCONST(2.430325019757162297132065927415566359); + C->W[0][9][4] = RCONST(1.905479301151524635219201659483842131); + C->W[0][9][6] = -RCONST(1.231139266635724816012498195050284266); + C->W[0][9][8] = -RCONST(0.555235506520914246462893477493610215); + C->W[0][10][0] = -RCONST(0.01044135044479748590294518945165354204); + C->W[0][10][2] = RCONST(0.07260303614655074505152104505488141613); + C->W[0][10][4] = -RCONST(0.1288275951677260952239454098576424313); + C->W[0][10][6] = RCONST(0.1129355350093823566139440107122154084); + C->W[0][10][8] = -RCONST(0.04626962554340952053857445645780085125); + C->W[0][11][0] = -RCONST(0.8108522787762101328175789228607932098); + C->W[0][11][2] = RCONST(0.2560073199220492435001562192140882299); + C->W[0][11][4] = RCONST(0.8068294072697527893665866422787819475); + C->W[0][11][6] = -RCONST(0.4557148228721823795105894821742761164); + C->W[0][11][8] = -RCONST(0.04626962554340952053857445645780085125); + C->W[0][11][10] = RCONST(0.25); + + C->W[1][3][0] = RCONST(4.084330687273257377563444321298938099); + C->W[1][3][2] = -RCONST(4.084330687273257377563444321298938099); + C->W[1][5][0] = -RCONST(21.84342998138222084791812875795865363); + C->W[1][5][2] = RCONST(59.61201288692787354341712449738503121); + C->W[1][5][4] = -RCONST(37.76858290554565269549899573942637758); + C->W[1][7][0] = RCONST(61.65904145863709169818763704477664579); + C->W[1][7][2] = -RCONST(77.27257996715864114378211753016780838); + C->W[1][7][6] = RCONST(15.61353850852154944559448048539116259); + C->W[1][9][0] = -RCONST(1.11047101304182849292578695498722043); + C->W[1][9][8] = RCONST(1.11047101304182849292578695498722043); + + C->G[0][1][0] = RCONST(0.5); + C->G[0][2][0] = -RCONST(0.25); + C->G[0][2][2] = RCONST(0.25); + C->G[0][3][0] = -RCONST(3.977281248108488183067033851462278892); + C->G[0][3][2] = RCONST(4.102281248108488183067033851462278892); + C->G[0][4][0] = -RCONST(0.06905388741401691232724147084809374064); + C->G[0][4][2] = -RCONST(0.1809461125859830876727585291519062594); + C->G[0][4][4] = RCONST(0.25); + C->G[0][5][0] = -RCONST(1.761767663757920528863378964822412405); + C->G[0][5][2] = RCONST(2.694524698377298610155338150791461384); + C->G[0][5][4] = -RCONST(0.8077570346193780812919591859690489783); + C->G[0][6][0] = RCONST(0.5558721791553969487305081009588084962); + C->G[0][6][2] = -RCONST(0.6799140501579995013958501527883486949); + C->G[0][6][4] = -RCONST(0.1259581289973974473346579481704598013); + C->G[0][6][6] = RCONST(0.25); + C->G[0][7][0] = -RCONST(5.840176028724955954446426657541065113); + C->G[0][7][2] = RCONST(8.174456684291915089191270805710716374); + C->G[0][7][4] = RCONST(0.1259581289973974473346579481704598013); + C->G[0][7][6] = -RCONST(2.335238784564356582079502096340111063); + C->G[0][8][0] = -RCONST(1.906792645167811808094759305036052304); + C->G[0][8][2] = -RCONST(1.547057811385123933632984579249388443); + C->G[0][8][4] = RCONST(4.129888013149350305954491738020313225); + C->G[0][8][6] = -RCONST(0.9260375565964145642267478537348724775); + C->G[0][8][8] = RCONST(0.25); + C->G[0][9][0] = RCONST(3.337028151688726054557652782529662519); + C->G[0][9][2] = RCONST(1.547057811385123933632984579249388443); + C->G[0][9][4] = -RCONST(4.129888013149350305954491738020313225); + C->G[0][9][6] = RCONST(0.9260375565964145642267478537348724775); + C->G[0][9][8] = -RCONST(1.555235506520914246462893477493610215); + C->G[0][10][0] = -RCONST(0.8212936292210076187205241123124467518); + C->G[0][10][2] = RCONST(0.328610356068599988551677264268969646); + C->G[0][10][4] = RCONST(0.6780018121020266941426412324211395162); + C->G[0][10][6] = -RCONST(0.3427792878628000228966454714620607079); + C->G[0][10][8] = -RCONST(0.0925392510868190410771489129156017025); + C->G[0][10][10] = RCONST(0.25); + + C->G[1][3][0] = RCONST(8.704562496216976366134067702924557783); + C->G[1][3][2] = -RCONST(8.704562496216976366134067702924557783); + C->G[1][5][0] = RCONST(3.911643102343874882381240871341012292); + C->G[1][5][2] = -RCONST(5.027157171582631044965159243279110249); + C->G[1][5][4] = RCONST(1.115514069238756162583918371938097957); + C->G[1][7][0] = RCONST(10.81860769913911801143183711316451323); + C->G[1][7][2] = -RCONST(14.98908526826783117559084130584473536); + C->G[1][7][6] = RCONST(4.170477569128713164159004192680222125); + C->G[1][9][0] = -RCONST(2.61047101304182849292578695498722043); + C->G[1][9][8] = RCONST(2.61047101304182849292578695498722043); + + break; + + default: + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode", + "MRIStepCoupling_LoadTable", + "Unknown coupling table"); + return(NULL); + } + + return(C); +} + + +/*--------------------------------------------------------------- + Routine to allocate an empty MRIStepCoupling structure + ---------------------------------------------------------------*/ +MRIStepCoupling MRIStepCoupling_Alloc(int nmat, int stages, + MRISTEP_METHOD_TYPE type) +{ + int i, j; + MRIStepCoupling MRIC = NULL; + + /* Check for legal input values */ + if (nmat < 1 || stages < 1) return(NULL); + + /* ------------------------------------------ + * Allocate and initialize coupling structure + * ------------------------------------------ */ + + MRIC = (MRIStepCoupling) malloc(sizeof(struct MRIStepCouplingMem)); + if (!MRIC) return(NULL); + + MRIC->nmat = nmat; + MRIC->stages = stages; + MRIC->q = 0; + MRIC->p = 0; + MRIC->c = NULL; + MRIC->W = NULL; + MRIC->G = NULL; + + /* -------------------------------------------- + * Allocate abscissae and coupling coefficients + * -------------------------------------------- */ + + MRIC->c = (realtype *) calloc( stages, sizeof(realtype) ); + if (!(MRIC->c)) { MRIStepCoupling_Free(MRIC); return(NULL); } + + if (type == MRISTEP_EXPLICIT || type == MRISTEP_IMEX) { + + /* allocate W matrices */ + MRIC->W = (realtype ***) calloc( nmat, sizeof(realtype**) ); + if (!(MRIC->W)) { MRIStepCoupling_Free(MRIC); return(NULL); } + + /* allocate rows of each matrix in W */ + for (i=0; iW[i] = NULL; + MRIC->W[i] = (realtype **) calloc( stages, sizeof(realtype*) ); + if (!(MRIC->W[i])) { MRIStepCoupling_Free(MRIC); return(NULL); } + } + + /* allocate columns of each matrix in W */ + for (i=0; iW[i][j] = NULL; + MRIC->W[i][j] = (realtype *) calloc( stages, sizeof(realtype) ); + if (!(MRIC->W[i][j])) { MRIStepCoupling_Free(MRIC); return(NULL); } + } + } + + if (type == MRISTEP_IMPLICIT || type == MRISTEP_IMEX) { + + /* allocate G matrices */ + MRIC->G = (realtype ***) calloc( nmat, sizeof(realtype**) ); + if (!(MRIC->G)) { MRIStepCoupling_Free(MRIC); return(NULL); } + + /* allocate rows of each matrix in G */ + for (i=0; iG[i] = NULL; + MRIC->G[i] = (realtype **) calloc( stages, sizeof(realtype*) ); + if (!(MRIC->G[i])) { MRIStepCoupling_Free(MRIC); return(NULL); } + } + + /* allocate columns of each matrix in G */ + for (i=0; iG[i][j] = NULL; + MRIC->G[i][j] = (realtype *) calloc( stages, sizeof(realtype) ); + if (!(MRIC->G[i][j])) { MRIStepCoupling_Free(MRIC); return(NULL); } + } + } + + return(MRIC); +} + + +/*--------------------------------------------------------------- + Routine to allocate and fill a MRIStepCoupling structure + ---------------------------------------------------------------*/ +MRIStepCoupling MRIStepCoupling_Create(int nmat, int stages, int q, int p, + realtype *W, realtype *G, realtype *c) +{ + int i, j, k; + MRISTEP_METHOD_TYPE type; + MRIStepCoupling MRIC = NULL; + + /* Check for legal inputs */ + if (nmat < 1 || stages < 1 || !c) return(NULL); + + /* Check for method coefficients and set method type */ + if (W && G) + type = MRISTEP_IMEX; + else if (W && !G) + type = MRISTEP_EXPLICIT; + else if (!W && G) + type = MRISTEP_IMPLICIT; + else + return(NULL); + + /* Allocate MRIStepCoupling structure */ + MRIC = MRIStepCoupling_Alloc(nmat, stages, type); + if (!MRIC) return(NULL); + + /* ------------------------- + * Copy the inputs into MRIC + * ------------------------- */ + + /* Method and embedding order */ + MRIC->q = q; + MRIC->p = p; + + /* Abscissae */ + for (i=0; ic[i] = c[i]; + + /* Coupling coefficients stored as 1D arrays of length nmat * stages * stages, + with each stages * stages matrix stored in C (row-major) order */ + if (type == MRISTEP_EXPLICIT || type == MRISTEP_IMEX) { + for (k = 0; k < nmat; k++) + for (i = 0; i < stages; i++) + for (j = 0; j < stages; j++) + MRIC->W[k][i][j] = W[stages * (stages * k + i) + j]; + } + if (type == MRISTEP_IMPLICIT || type == MRISTEP_IMEX) { + for (k = 0; k < nmat; k++) + for (i = 0; i < stages; i++) + for (j = 0; j < stages; j++) + MRIC->G[k][i][j] = G[stages * (stages * k + i) + j]; + } + + return(MRIC); +} + + +/*--------------------------------------------------------------- + Construct the MRI coupling matrix for an MIS method based on + a given 'slow' Butcher table. + ---------------------------------------------------------------*/ +MRIStepCoupling MRIStepCoupling_MIStoMRI(ARKodeButcherTable B, + int q, int p) +{ + int i, j, stages; + booleantype padding; + realtype Asum; + realtype ***C; + MRISTEP_METHOD_TYPE type; + MRIStepCoupling MRIC; + + const realtype tol = RCONST(100.0) * UNIT_ROUNDOFF; + + /* Check that input table is non-NULL */ + if (!B) return(NULL); + + /* ----------------------------------- + * Check that the input table is valid + * ----------------------------------- */ + + /* First stage is just old solution */ + Asum = SUNRabs(B->c[0]); + for (j=0; jstages; j++) + Asum += SUNRabs(B->A[0][j]); + if (Asum > tol) return(NULL); + + /* Last stage exceeds 1 */ + if (B->c[B->stages-1] > ONE+tol) return(NULL); + + /* All stages are sorted */ + for (j=1; jstages; j++) + if ((B->c[j] - B->c[j-1]) < -tol) return(NULL); + + /* Each stage at most diagonally implicit */ + Asum = ZERO; + for (i=0; istages; i++) + for (j=i+1; jstages; j++) + Asum += SUNRabs(B->A[i][j]); + if (Asum > tol) return(NULL); + + /* ----------------------------------------- + * determine whether the table needs padding + * ----------------------------------------- */ + + padding = SUNFALSE; + + /* Last stage time should equal 1 */ + if (SUNRabs(B->c[B->stages-1] - ONE) > tol) + padding = SUNTRUE; + + /* Last row of A should equal b */ + for (j=0; jstages; j++) { + if (SUNRabs(B->A[B->stages-1][j] - B->b[j]) > tol) + padding = SUNTRUE; + } + stages = (padding) ? B->stages+1 : B->stages; + + /* ------------------------- + * determine the method type + * ------------------------- */ + + /* Check if the table is strictly lower triangular (explicit) */ + type = MRISTEP_EXPLICIT; + + for (i=0; istages; i++) + for (j=i; jstages; j++) + if (SUNRabs(B->A[i][j]) > tol) + type = MRISTEP_IMPLICIT; + + /* ---------------------------- + * construct coupling structure + * ---------------------------- */ + + MRIC = MRIStepCoupling_Alloc(1, stages, type); + if (!MRIC) return(NULL); + + /* Copy method/embedding orders */ + MRIC->q = q; + MRIC->p = p; + + /* Copy abscissae, padding if needed */ + for (i=0; istages; i++) + MRIC->c[i] = B->c[i]; + + if (padding) + MRIC->c[stages-1] = ONE; + + /* Construct the coupling table */ + if (type == MRISTEP_EXPLICIT) + C = MRIC->W; + else + C = MRIC->G; + + /* First row is identically zero */ + for (i=0; istages; i++) + for (j=0; jstages; j++) + C[0][i][j] = B->A[i][j] - B->A[i-1][j]; + + /* Padded row = b(:) - A(end,:) */ + if (padding) + for (j=0; jstages; j++) + C[0][stages-1][j] = B->b[j] - B->A[B->stages-1][j]; + + return(MRIC); +} + + +/*--------------------------------------------------------------- + Routine to copy a MRIStepCoupling structure + ---------------------------------------------------------------*/ +MRIStepCoupling MRIStepCoupling_Copy(MRIStepCoupling MRIC) +{ + int i, j, k, nmat, stages; + MRISTEP_METHOD_TYPE type; + MRIStepCoupling MRICcopy; + + /* Check for legal input */ + if (!MRIC) return(NULL); + + /* Check for method coefficients and set method type */ + if (MRIC->W && MRIC->G) + type = MRISTEP_IMEX; + else if (MRIC->W && !(MRIC->G)) + type = MRISTEP_EXPLICIT; + else if (!(MRIC->W) && MRIC->G) + type = MRISTEP_IMPLICIT; + else + return(NULL); + + /* Check for stage times */ + if (!(MRIC->c)) return(NULL); + + /* Get the number of coupling matrices and stages */ + nmat = MRIC->nmat; + stages = MRIC->stages; + + /* Allocate coupling structure */ + MRICcopy = MRIStepCoupling_Alloc(nmat, stages, type); + if (!MRICcopy) return(NULL); + + /* Copy method and embedding orders */ + MRICcopy->q = MRIC->q; + MRICcopy->p = MRIC->p; + + /* Copy abscissae */ + for (i=0; ic[i] = MRIC->c[i]; + + /* Copy explicit coupling matrices W */ + if (MRIC->W) + for (k = 0; k < nmat; k++) + for (i = 0; i < stages; i++) + for (j = 0; j < stages; j++) + MRICcopy->W[k][i][j] = MRIC->W[k][i][j]; + + /* Copy implicit coupling matrices G */ + if (MRIC->G) + for (k = 0; k < nmat; k++) + for (i = 0; i < stages; i++) + for (j = 0; j < stages; j++) + MRICcopy->G[k][i][j] = MRIC->G[k][i][j]; + + return(MRICcopy); +} + + +/*--------------------------------------------------------------- + Routine to query the MRIStepCoupling structure workspace size + ---------------------------------------------------------------*/ +void MRIStepCoupling_Space(MRIStepCoupling MRIC, sunindextype *liw, + sunindextype *lrw) +{ + /* initialize outputs and return if MRIC is not allocated */ + *liw = 0; + *lrw = 0; + if (!MRIC) return; + + /* fill outputs based on MRIC */ + *liw = 4; + if (MRIC->c) + *lrw += MRIC->stages; + if (MRIC->W) + *lrw += MRIC->nmat * MRIC->stages * MRIC->stages; + if (MRIC->G) + *lrw += MRIC->nmat * MRIC->stages * MRIC->stages; +} + + +/*--------------------------------------------------------------- + Routine to free a MRIStepCoupling structure + ---------------------------------------------------------------*/ +void MRIStepCoupling_Free(MRIStepCoupling MRIC) +{ + int k, i; + + /* Free each field within MRIStepCoupling structure, and then + free structure itself */ + if (MRIC) { + + if (MRIC->c) + free(MRIC->c); + + if (MRIC->W) { + for (k=0; knmat; k++) + if (MRIC->W[k]) { + for (i=0; istages; i++) + if (MRIC->W[k][i]) { + free(MRIC->W[k][i]); + MRIC->W[k][i] = NULL; + } + free(MRIC->W[k]); + MRIC->W[k] = NULL; + } + free(MRIC->W); + } + + if (MRIC->G) { + for (k=0; knmat; k++) + if (MRIC->G[k]) { + for (i=0; istages; i++) + if (MRIC->G[k][i]) { + free(MRIC->G[k][i]); + MRIC->G[k][i] = NULL; + } + free(MRIC->G[k]); + MRIC->G[k] = NULL; + } + free(MRIC->G); + } + + free(MRIC); + } +} + + +/*--------------------------------------------------------------- + Routine to print a MRIStepCoupling structure + ---------------------------------------------------------------*/ +void MRIStepCoupling_Write(MRIStepCoupling MRIC, FILE *outfile) +{ + int i, j, k; + + /* check for vaild coupling structure */ + if (!MRIC) return; + if (!(MRIC->G)) return; + + if (MRIC->W) { + for (i = 0; i < MRIC->nmat; i++) { + if (!(MRIC->W[i])) return; + for (j = 0; j < MRIC->stages; j++) + if (!(MRIC->W[i][j])) return; + } + } + + if (MRIC->G) { + for (i = 0; i < MRIC->nmat; i++) { + if (!(MRIC->G[i])) return; + for (j = 0; j < MRIC->stages; j++) + if (!(MRIC->G[i][j])) return; + } + } + + if (!(MRIC->c)) return; + + STAN_SUNDIALS_FPRINTF(outfile, " nmat = %i\n", MRIC->nmat); + STAN_SUNDIALS_FPRINTF(outfile, " stages = %i\n", MRIC->stages); + STAN_SUNDIALS_FPRINTF(outfile, " method order (q) = %i\n", MRIC->q); + STAN_SUNDIALS_FPRINTF(outfile, " embedding order (p) = %i\n", MRIC->p); + + STAN_SUNDIALS_FPRINTF(outfile, " c = "); + for (i = 0; i < MRIC->stages; i++) + STAN_SUNDIALS_FPRINTF(outfile, "%"RSYM" ", MRIC->c[i]); + STAN_SUNDIALS_FPRINTF(outfile, "\n"); + + if (MRIC->W) { + for (k = 0; k < MRIC->nmat; k++) { + STAN_SUNDIALS_FPRINTF(outfile, " W[%i] = \n", k); + for (i = 0; i < MRIC->stages; i++){ + STAN_SUNDIALS_FPRINTF(outfile, " "); + for (j = 0; j < MRIC->stages; j++) + STAN_SUNDIALS_FPRINTF(outfile, "%"RSYMW" ", MRIC->W[k][i][j]); + STAN_SUNDIALS_FPRINTF(outfile, "\n"); + } + STAN_SUNDIALS_FPRINTF(outfile, "\n"); + } + } + + if (MRIC->G) { + for (k = 0; k < MRIC->nmat; k++) { + STAN_SUNDIALS_FPRINTF(outfile, " G[%i] = \n", k); + for (i = 0; i < MRIC->stages; i++) { + STAN_SUNDIALS_FPRINTF(outfile, " "); + for (j = 0; j < MRIC->stages; j++) + STAN_SUNDIALS_FPRINTF(outfile, "%"RSYMW" ", MRIC->G[k][i][j]); + STAN_SUNDIALS_FPRINTF(outfile, "\n"); + } + STAN_SUNDIALS_FPRINTF(outfile, "\n"); + } + } +} + + +/* =========================================================================== + * Private Functions + * ===========================================================================*/ + + +/* --------------------------------------------------------------------------- + * Stage type identifier: returns one of the constants + * + * MRISTAGE_ERK_FAST -- standard MIS-like stage + * MRISTAGE_ERK_NOFAST -- standard ERK stage + * MRISTAGE_DIRK_NOFAST -- standard DIRK stage + * MRISTAGE_DIRK_FAST -- coupled DIRK + MIS-like stage + * + * for each nontrivial stage in an MRI-like method. Otherwise (i.e., stage is + * not in [1,MRIC->stages-1]), returns ARK_INVALID_TABLE (<0). + * + * The stage type is determined by 2 factors: + * (a) Sum |MRIC->G[:][is][is]| (nonzero => DIRK) + * (b) MRIC->c[is] - MRIC->c[is-1] (nonzero => fast) + * ---------------------------------------------------------------------------*/ + +int mriStepCoupling_GetStageType(MRIStepCoupling MRIC, int is) +{ + int i; + realtype Gabs, cdiff; + const realtype tol = RCONST(100.0) * UNIT_ROUNDOFF; + + if ((is < 1) || (is >= MRIC->stages)) return ARK_INVALID_TABLE; + + /* sum of stage diagonal entries across implicit tables */ + Gabs = ZERO; + if (MRIC->G) + for (i = 0; i < MRIC->nmat; i++) + Gabs += SUNRabs(MRIC->G[i][is][is]); + + /* abscissae difference */ + cdiff = MRIC->c[is] - MRIC->c[is-1]; + + if (Gabs > tol) { /* DIRK */ + if (cdiff > tol) { /* Fast */ + return(MRISTAGE_DIRK_FAST); + } else { + return(MRISTAGE_DIRK_NOFAST); + } + } else { /* ERK */ + if (cdiff > tol) { /* Fast */ + return(MRISTAGE_ERK_FAST); + } else { + return(MRISTAGE_ERK_NOFAST); + } + } +} + + +/* --------------------------------------------------------------------------- + * Computes the stage RHS vector storage maps. With repeated abscissae the + * first stage of the pair generally corresponds to a column of zeros and so + * does not need to be computed and stored. The stage_map indicate if the RHS + * needs to be computed and where to store it i.e., stage_map[i] > -1. + * ---------------------------------------------------------------------------*/ + +int mriStepCoupling_GetStageMap(MRIStepCoupling MRIC, + int* stage_map, + int* nstages_stored) +{ + int i, j, k, idx; + realtype Wsum, Gsum; + const realtype tol = RCONST(100.0) * UNIT_ROUNDOFF; + + /* ---------------------- + * Check for valid inputs + * ---------------------- */ + + if (!MRIC) return(ARK_ILL_INPUT); + if (!(MRIC->W) && !(MRIC->G)) return(ARK_ILL_INPUT); + if (!stage_map || !nstages_stored) return(ARK_ILL_INPUT); + + /* ------------------- + * Compute storage map + * ------------------- */ + + /* Number of stage RHS vectors stored */ + *nstages_stored = 0; + + /* Initial storage index */ + idx = 0; + + /* Check if a stage corresponds to a column of zeros for all coupling + * matrices by computing the column sums */ + for (j = 0; j < MRIC->stages; j++) { + + Wsum = ZERO; + Gsum = ZERO; + + if (MRIC->W) + for (k = 0; k < MRIC->nmat; k++) + for (i = 0; i < MRIC->stages; i++) + Wsum += SUNRabs(MRIC->W[k][i][j]); + + if (MRIC->G) + for (k = 0; k < MRIC->nmat; k++) + for (i = 0; i < MRIC->stages; i++) + Gsum += SUNRabs(MRIC->G[k][i][j]); + + if (Wsum > tol || Gsum > tol) { + stage_map[j] = idx; + idx++; + } else { + stage_map[j] = -1; + } + } + + /* Check and set number of stage RHS vectors stored */ + if (idx < 1) return(ARK_ILL_INPUT); + + *nstages_stored = idx; + + return(ARK_SUCCESS); +} + + +/*=============================================================== + EOF + ===============================================================*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_mri_tables_impl.h b/lib/sundials_6.1.1/src/arkode/arkode_mri_tables_impl.h new file mode 100644 index 00000000000..eaf406dfe18 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_mri_tables_impl.h @@ -0,0 +1,39 @@ +/* --------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * --------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * --------------------------------------------------------------------------- + * Implementation header file for the main ARKODE integrator. + * ---------------------------------------------------------------------------*/ + +#ifndef _ARKODE_MRI_TABLES_IMPL_H +#define _ARKODE_MRI_TABLES_IMPL_H + +#include "arkode_mristep_impl.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* Returns the stage type (implicit/explicit + fast/nofast) */ +int mriStepCoupling_GetStageType(MRIStepCoupling MRIC, int is); + +/* Returns index maps for where to store stage RHS evaluations */ +int mriStepCoupling_GetStageMap(MRIStepCoupling MRIC, int* stage_map, + int* nstored_stages); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/src/arkode/arkode_mristep.c b/lib/sundials_6.1.1/src/arkode/arkode_mristep.c new file mode 100644 index 00000000000..484c029817a --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_mristep.c @@ -0,0 +1,2833 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * Daniel R. Reynolds @ SMU + * Rujeko Chinomona @ SMU + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 MRI time stepper module. + * ---------------------------------------------------------------------------*/ + +#include +#include +#include + +#include "arkode_impl.h" +#include "arkode_mristep_impl.h" +#include "arkode_interp_impl.h" +#include +#include + + +/*=============================================================== + SHORTCUTS + ===============================================================*/ + +#define ARK_PROFILER ark_mem->sunctx->profiler + +/*=============================================================== + MRIStep Exported functions -- Required + ===============================================================*/ + +/*--------------------------------------------------------------- + Create MRIStep integrator memory struct + ---------------------------------------------------------------*/ +void* MRIStepCreate(ARKRhsFn fse, ARKRhsFn fsi, realtype t0, N_Vector y0, + MRIStepInnerStepper stepper, SUNContext sunctx) +{ + ARKodeMem ark_mem; /* outer ARKode memory */ + ARKodeMRIStepMem step_mem; /* outer stepper memory */ + SUNNonlinearSolver NLS; /* default nonlin solver */ + booleantype nvectorOK; + int retval; + + /* Check that at least one of fse, fsi is supplied and is to be used*/ + if (fse == NULL && fsi == NULL) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepCreate", MSG_ARK_NULL_F); + return(NULL); + } + + /* Check that y0 is supplied */ + if (y0 == NULL) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepCreate", MSG_ARK_NULL_Y0); + return(NULL); + } + + /* Check that stepper is supplied */ + if (stepper == NULL) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepCreate", + "The inner stepper memory is NULL"); + return(NULL); + } + + /* Check that context is supplied */ + if (!sunctx) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepCreate", MSG_ARK_NULL_SUNCTX); + return(NULL); + } + + /* Test if all required vector operations are implemented */ + nvectorOK = mriStep_CheckNVector(y0); + if (!nvectorOK) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepCreate", MSG_ARK_BAD_NVECTOR); + return(NULL); + } + + /* Create ark_mem structure and set default values */ + ark_mem = arkCreate(sunctx); + if (ark_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::MRIStep", + "MRIStepCreate", MSG_ARK_NO_MEM); + return(NULL); + } + + /* Allocate ARKodeMRIStepMem structure, and initialize to zero */ + step_mem = NULL; + step_mem = (ARKodeMRIStepMem) malloc(sizeof(struct ARKodeMRIStepMemRec)); + if (step_mem == NULL) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepCreate", MSG_ARK_ARKMEM_FAIL); + MRIStepFree((void**) &ark_mem); return(NULL); + } + memset(step_mem, 0, sizeof(struct ARKodeMRIStepMemRec)); + + /* Attach step_mem structure and function pointers to ark_mem */ + ark_mem->step_attachlinsol = mriStep_AttachLinsol; + ark_mem->step_disablelsetup = mriStep_DisableLSetup; + ark_mem->step_getlinmem = mriStep_GetLmem; + ark_mem->step_getimplicitrhs = mriStep_GetImplicitRHS; + ark_mem->step_getgammas = mriStep_GetGammas; + ark_mem->step_init = mriStep_Init; + ark_mem->step_fullrhs = mriStep_FullRHS; + ark_mem->step = mriStep_TakeStep; + ark_mem->step_mem = (void*) step_mem; + + /* Set default values for MRIStep optional inputs */ + retval = MRIStepSetDefaults((void *) ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::MRIStep", + "MRIStepCreate", + "Error setting default solver options"); + MRIStepFree((void**) &ark_mem); return(NULL); + } + + /* Allocate the general MRI stepper vectors using y0 as a template */ + /* NOTE: Fse, Fsi, inner_forcing, cvals, Xvecs, sdata, zpred and zcor will + be allocated later on (based on the MRI method) */ + + /* Copy the slow RHS functions into stepper memory */ + step_mem->fse = fse; + step_mem->fsi = fsi; + + /* Set implicit/explicit problem based on function pointers */ + step_mem->explicit_rhs = (fse == NULL) ? SUNFALSE : SUNTRUE; + step_mem->implicit_rhs = (fsi == NULL) ? SUNFALSE : SUNTRUE; + + /* Update the ARKode workspace requirements */ + ark_mem->liw += 42; /* fcn/data ptr, int, long int, sunindextype, booleantype */ + ark_mem->lrw += 10; + + /* Create a default Newton NLS object (just in case; will be deleted if + the user attaches a nonlinear solver) */ + step_mem->NLS = NULL; + step_mem->ownNLS = SUNFALSE; + + if (step_mem->implicit_rhs) { + NLS = SUNNonlinSol_Newton(y0, ark_mem->sunctx); + if (!NLS) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepCreate", "Error creating default Newton solver"); + MRIStepFree((void**) &ark_mem); return(NULL); + } + retval = MRIStepSetNonlinearSolver(ark_mem, NLS); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepCreate", "Error attaching default Newton solver"); + MRIStepFree((void**) &ark_mem); return(NULL); + } + step_mem->ownNLS = SUNTRUE; + } + + /* Set the linear solver addresses to NULL (we check != NULL later) */ + step_mem->linit = NULL; + step_mem->lsetup = NULL; + step_mem->lsolve = NULL; + step_mem->lfree = NULL; + step_mem->lmem = NULL; + + /* Initialize all the counters */ + step_mem->nfse = 0; + step_mem->nfsi = 0; + step_mem->nsetups = 0; + step_mem->nstlp = 0; + step_mem->nls_iters = 0; + + /* Initialize fused op work space */ + step_mem->cvals = NULL; + step_mem->Xvecs = NULL; + + /* Initialize pre and post inner evolve functions */ + step_mem->pre_inner_evolve = NULL; + step_mem->post_inner_evolve = NULL; + + /* Initialize main ARKode infrastructure (allocates vectors) */ + retval = arkInit(ark_mem, t0, y0, FIRST_INIT); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::MRIStep", "MRIStepCreate", + "Unable to initialize main ARKode infrastructure"); + MRIStepFree((void**) &ark_mem); return(NULL); + } + + /* Attach the inner stepper memory */ + step_mem->stepper = stepper; + + /* Check for required stepper functions */ + retval = mriStepInnerStepper_HasRequiredOps(step_mem->stepper); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepCreate", + "A required inner stepper function is NULL"); + MRIStepFree((void**) &ark_mem); + return(NULL); + } + + /* return ARKode memory */ + return((void*) ark_mem); +} + + +/*--------------------------------------------------------------- + MRIStepResize: + + This routine resizes the memory within the MRIStep module. + It first resizes the main ARKode infrastructure memory, and + then resizes its own data. + ---------------------------------------------------------------*/ +int MRIStepResize(void *arkode_mem, N_Vector y0, realtype t0, + ARKVecResizeFn resize, void *resize_data) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + SUNNonlinearSolver NLS; + sunindextype lrw1, liw1, lrw_diff, liw_diff; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepResize", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Determing change in vector sizes */ + lrw1 = liw1 = 0; + if (y0->ops->nvspace != NULL) + N_VSpace(y0, &lrw1, &liw1); + lrw_diff = lrw1 - ark_mem->lrw1; + liw_diff = liw1 - ark_mem->liw1; + ark_mem->lrw1 = lrw1; + ark_mem->liw1 = liw1; + + /* resize ARKode infrastructure memory (use hscale = 1.0) */ + retval = arkResize(ark_mem, y0, RCONST(1.0), t0, resize, resize_data); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::MRIStep", "MRIStepResize", + "Unable to resize main ARKode infrastructure"); + return(retval); + } + + /* Resize Fse */ + if (step_mem->Fse) { + if (!arkResizeVecArray(resize, resize_data, + step_mem->nstages_stored, y0, &(step_mem->Fse), + lrw_diff, &(ark_mem->lrw), + liw_diff, &(ark_mem->liw))) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepResize", "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + } + + /* Resize Fsi */ + if (step_mem->Fsi) { + if (!arkResizeVecArray(resize, resize_data, + step_mem->nstages_stored, y0, &(step_mem->Fsi), + lrw_diff, &(ark_mem->lrw), + liw_diff, &(ark_mem->liw))) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepResize", "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + } + + /* Resize the nonlinear solver interface vectors (if applicable) */ + if (step_mem->sdata != NULL) + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &step_mem->sdata)) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepResize", "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + if (step_mem->zpred != NULL) + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &step_mem->zpred)) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepResize", "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + if (step_mem->zcor != NULL) + if (!arkResizeVec(ark_mem, resize, resize_data, lrw_diff, + liw_diff, y0, &step_mem->zcor)) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepResize", "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + + /* If a NLS object was previously used, destroy and recreate default Newton + NLS object (can be replaced by user-defined object if desired) */ + if ((step_mem->NLS != NULL) && (step_mem->ownNLS)) { + + /* destroy existing NLS object */ + retval = SUNNonlinSolFree(step_mem->NLS); + if (retval != ARK_SUCCESS) return(retval); + step_mem->NLS = NULL; + step_mem->ownNLS = SUNFALSE; + + /* create new Newton NLS object */ + NLS = SUNNonlinSol_Newton(y0, ark_mem->sunctx); + if (NLS == NULL) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepResize", "Error creating default Newton solver"); + return(ARK_MEM_FAIL); + } + + /* attach new Newton NLS object to MRIStep */ + retval = MRIStepSetNonlinearSolver(ark_mem, NLS); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepResize", "Error attaching default Newton solver"); + return(ARK_MEM_FAIL); + } + step_mem->ownNLS = SUNTRUE; + + } + + /* Resize the inner stepper vectors */ + retval = mriStepInnerStepper_Resize(step_mem->stepper, resize, resize_data, + lrw_diff, liw_diff, y0); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepResize", "Unable to resize vector"); + return(ARK_MEM_FAIL); + } + + /* reset nonlinear solver counters */ + if (step_mem->NLS != NULL) step_mem->nsetups = 0; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepReInit: + + This routine re-initializes the MRIStep module to solve a new + problem of the same size as was previously solved (all counter + values are set to 0). + + NOTE: the inner stepper needs to be reinitialized before + calling this function. + ---------------------------------------------------------------*/ +int MRIStepReInit(void* arkode_mem, ARKRhsFn fse, ARKRhsFn fsi, realtype t0, + N_Vector y0) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + SUNNonlinearSolver NLS; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepReInit", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Check if ark_mem was allocated */ + if (ark_mem->MallocDone == SUNFALSE) { + arkProcessError(ark_mem, ARK_NO_MALLOC, "ARKode::MRIStep", + "MRIStepReInit", MSG_ARK_NO_MALLOC); + return(ARK_NO_MALLOC); + } + + /* Check that at least one of fse, fsi is supplied and is to be used */ + if (fse == NULL && fsi == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepReInit", MSG_ARK_NULL_F); + return(ARK_ILL_INPUT); + } + + /* Check that y0 is supplied */ + if (y0 == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepReInit", MSG_ARK_NULL_Y0); + return(ARK_ILL_INPUT); + } + + /* Set implicit/explicit problem based on function pointers */ + step_mem->explicit_rhs = (fse == NULL) ? SUNFALSE : SUNTRUE; + step_mem->implicit_rhs = (fsi == NULL) ? SUNFALSE : SUNTRUE; + + /* Create a default Newton NLS object (just in case; will be deleted if + the user attaches a nonlinear solver) */ + if (step_mem->implicit_rhs && !(step_mem->NLS)) { + NLS = SUNNonlinSol_Newton(y0, ark_mem->sunctx); + if (!NLS) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepReInit", "Error creating default Newton solver"); + MRIStepFree((void**) &ark_mem); return(ARK_MEM_FAIL); + } + retval = MRIStepSetNonlinearSolver(ark_mem, NLS); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepReInit", "Error attaching default Newton solver"); + MRIStepFree((void**) &ark_mem); return(ARK_MEM_FAIL); + } + step_mem->ownNLS = SUNTRUE; + } + + /* ReInitialize main ARKode infrastructure */ + retval = arkInit(arkode_mem, t0, y0, FIRST_INIT); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::MRIStep", "MRIStepReInit", + "Unable to reinitialize main ARKode infrastructure"); + return(retval); + } + + /* Copy the input parameters into ARKode state */ + step_mem->fse = fse; + step_mem->fsi = fsi; + + /* Initialize all the counters */ + step_mem->nfse = 0; + step_mem->nfsi = 0; + step_mem->nsetups = 0; + step_mem->nstlp = 0; + step_mem->nls_iters = 0; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepReset: + + This routine resets the MRIStep module state to solve the same + problem from the given time with the input state (all counter + values are retained). + ---------------------------------------------------------------*/ +int MRIStepReset(void* arkode_mem, realtype tR, N_Vector yR) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepReset", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Initialize main ARKode infrastructure */ + retval = arkInit(ark_mem, tR, yR, RESET_INIT); + + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, retval, "ARKode::MRIStep", "MRIStepReset", + "Unable to initialize main ARKode infrastructure"); + return(retval); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSStolerances, MRIStepSVtolerances, MRIStepWFtolerances: + + These routines set integration tolerances (wrappers for general + ARKode utility routines) + ---------------------------------------------------------------*/ +int MRIStepSStolerances(void *arkode_mem, realtype reltol, realtype abstol) +{ + /* unpack ark_mem, call arkSStolerances, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::MRIStep", + "MRIStepSStolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkSStolerances(ark_mem, reltol, abstol)); +} + +int MRIStepSVtolerances(void *arkode_mem, realtype reltol, N_Vector abstol) +{ + /* unpack ark_mem, call arkSVtolerances, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::MRIStep", + "MRIStepSVtolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkSVtolerances(ark_mem, reltol, abstol)); +} + +int MRIStepWFtolerances(void *arkode_mem, ARKEwtFn efun) +{ + /* unpack ark_mem, call arkWFtolerances, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::MRIStep", + "MRIStepWFtolerances", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkWFtolerances(ark_mem, efun)); +} + + +/*--------------------------------------------------------------- + MRIStepRootInit: + + Initialize (attach) a rootfinding problem to the stepper + (wrappers for general ARKode utility routine) + ---------------------------------------------------------------*/ +int MRIStepRootInit(void *arkode_mem, int nrtfn, ARKRootFn g) +{ + /* unpack ark_mem, call arkRootInit, and return */ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::MRIStep", + "MRIStepRootInit", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + return(arkRootInit(ark_mem, nrtfn, g)); +} + + +/*--------------------------------------------------------------- + MRIStepEvolve: + + This is the main time-integration driver (wrappers for general + ARKode utility routine) + ---------------------------------------------------------------*/ +int MRIStepEvolve(void *arkode_mem, realtype tout, N_Vector yout, + realtype *tret, int itask) +{ + /* unpack ark_mem, call arkEvolve, and return */ + int retval; + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::MRIStep", + "MRIStepEvolve", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + SUNDIALS_MARK_FUNCTION_BEGIN(ARK_PROFILER); + retval = arkEvolve(ark_mem, tout, yout, tret, itask); + SUNDIALS_MARK_FUNCTION_END(ARK_PROFILER); + return(retval); +} + + +/*--------------------------------------------------------------- + MRIStepGetDky: + + This returns interpolated output of the solution or its + derivatives over the most-recently-computed step (wrapper for + generic ARKode utility routine) + ---------------------------------------------------------------*/ +int MRIStepGetDky(void *arkode_mem, realtype t, int k, N_Vector dky) +{ + /* unpack ark_mem, call arkGetDky, and return */ + int retval; + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::MRIStep", + "MRIStepGetDky", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + SUNDIALS_MARK_FUNCTION_BEGIN(ARK_PROFILER); + retval = arkGetDky(ark_mem, t, k, dky); + SUNDIALS_MARK_FUNCTION_END(ARK_PROFILER); + return(retval); +} + +/*--------------------------------------------------------------- + MRIStepComputeState: + + Computes y based on the current prediction and given correction. + ---------------------------------------------------------------*/ +int MRIStepComputeState(void *arkode_mem, N_Vector zcor, N_Vector z) +{ + int retval; + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepComputeState", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + N_VLinearSum(ONE, step_mem->zpred, ONE, zcor, z); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepFree frees all MRIStep memory, and then calls an ARKode + utility routine to free the ARKode infrastructure memory. + ---------------------------------------------------------------*/ +void MRIStepFree(void **arkode_mem) +{ + sunindextype Cliw, Clrw; + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + + /* nothing to do if arkode_mem is already NULL */ + if (*arkode_mem == NULL) return; + + /* conditional frees on non-NULL MRIStep module */ + ark_mem = (ARKodeMem) (*arkode_mem); + if (ark_mem->step_mem != NULL) { + + step_mem = (ARKodeMRIStepMem) ark_mem->step_mem; + + /* free the coupling structure and derived quantities */ + if (step_mem->MRIC != NULL) { + MRIStepCoupling_Space(step_mem->MRIC, &Cliw, &Clrw); + MRIStepCoupling_Free(step_mem->MRIC); + step_mem->MRIC = NULL; + ark_mem->liw -= Cliw; + ark_mem->lrw -= Clrw; + if (step_mem->stagetypes) { + free(step_mem->stagetypes); + step_mem->stagetypes = NULL; + ark_mem->liw -= step_mem->stages; + } + if (step_mem->stage_map) { + free(step_mem->stage_map); + step_mem->stage_map = NULL; + ark_mem->liw -= step_mem->stages; + } + if (step_mem->Ae_row) { + free(step_mem->Ae_row); + step_mem->Ae_row = NULL; + ark_mem->lrw -= step_mem->stages; + } + if (step_mem->Ai_row) { + free(step_mem->Ai_row); + step_mem->Ai_row = NULL; + ark_mem->lrw -= step_mem->stages; + } + } + + /* free the nonlinear solver memory (if applicable) */ + if ((step_mem->NLS != NULL) && (step_mem->ownNLS)) { + SUNNonlinSolFree(step_mem->NLS); + step_mem->ownNLS = SUNFALSE; + } + step_mem->NLS = NULL; + + /* free the linear solver memory */ + if (step_mem->lfree != NULL) { + step_mem->lfree((void *) ark_mem); + step_mem->lmem = NULL; + } + + /* free the sdata, zpred and zcor vectors */ + if (step_mem->sdata != NULL) { + arkFreeVec(ark_mem, &step_mem->sdata); + step_mem->sdata = NULL; + } + if (step_mem->zpred != NULL) { + arkFreeVec(ark_mem, &step_mem->zpred); + step_mem->zpred = NULL; + } + if (step_mem->zcor != NULL) { + arkFreeVec(ark_mem, &step_mem->zcor); + step_mem->zcor = NULL; + } + + /* free the RHS vectors */ + if (step_mem->Fse) { + arkFreeVecArray(step_mem->nstages_stored, &(step_mem->Fse), + ark_mem->lrw1, &(ark_mem->lrw), + ark_mem->liw1, &(ark_mem->liw)); + } + + if (step_mem->Fsi) { + arkFreeVecArray(step_mem->nstages_stored, &(step_mem->Fsi), + ark_mem->lrw1, &(ark_mem->lrw), + ark_mem->liw1, &(ark_mem->liw)); + } + + /* free the reusable arrays for fused vector interface */ + if (step_mem->cvals != NULL) { + free(step_mem->cvals); + step_mem->cvals = NULL; + ark_mem->lrw -= (step_mem->nfusedopvecs); + } + if (step_mem->Xvecs != NULL) { + free(step_mem->Xvecs); + step_mem->Xvecs = NULL; + ark_mem->liw -= (step_mem->nfusedopvecs); + } + step_mem->nfusedopvecs = 0; + + /* free the time stepper module itself */ + free(ark_mem->step_mem); + ark_mem->step_mem = NULL; + } + + /* free memory for overall ARKode infrastructure */ + arkFree(arkode_mem); +} + + +/*--------------------------------------------------------------- + MRIStepPrintMem: + + This routine outputs the memory from the MRIStep structure and + the main ARKode infrastructure to a specified file pointer + (useful when debugging). + ---------------------------------------------------------------*/ +void MRIStepPrintMem(void* arkode_mem, FILE* outfile) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int i, retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepPrintMem", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return; + + /* if outfile==NULL, set it to stdout */ + if (outfile == NULL) outfile = stdout; + + /* output data from main ARKode infrastructure */ + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep Slow Stepper Mem:\n"); + arkPrintMem(ark_mem, outfile); + + /* output integer quantities */ + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: q = %i\n", step_mem->q); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: p = %i\n", step_mem->p); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: istage = %i\n", step_mem->istage); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: stages = %i\n", step_mem->stages); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: maxcor = %i\n", step_mem->maxcor); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: msbp = %i\n", step_mem->msbp); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: predictor = %i\n", step_mem->predictor); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: convfail = %i\n", step_mem->convfail); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: stagetypes ="); + for (i=0; istages; i++) + STAN_SUNDIALS_FPRINTF(outfile," %i",step_mem->stagetypes[i]); + STAN_SUNDIALS_FPRINTF(outfile,"\n"); + + /* output long integer quantities */ + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: nfse = %li\n", step_mem->nfse); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: nfsi = %li\n", step_mem->nfsi); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: nsetups = %li\n", step_mem->nsetups); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: nstlp = %li\n", step_mem->nstlp); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: nls_iters = %li\n", step_mem->nls_iters); + + /* output boolean quantities */ + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: user_linear = %i\n", step_mem->linear); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: user_linear_timedep = %i\n", step_mem->linear_timedep); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: user_explicit = %i\n", step_mem->explicit_rhs); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: user_implicit = %i\n", step_mem->implicit_rhs); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: jcur = %i\n", step_mem->jcur); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: ownNLS = %i\n", step_mem->ownNLS); + + /* output realtype quantities */ + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: Coupling structure:\n"); + MRIStepCoupling_Write(step_mem->MRIC, outfile); + + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: gamma = %"RSYM"\n", step_mem->gamma); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: gammap = %"RSYM"\n", step_mem->gammap); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: gamrat = %"RSYM"\n", step_mem->gamrat); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: crate = %"RSYM"\n", step_mem->crate); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: delp = %"RSYM"\n", step_mem->delp); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: eRNrm = %"RSYM"\n", step_mem->eRNrm); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: nlscoef = %"RSYM"\n", step_mem->nlscoef); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: crdown = %"RSYM"\n", step_mem->crdown); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: rdiv = %"RSYM"\n", step_mem->rdiv); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: dgmax = %"RSYM"\n", step_mem->dgmax); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: Ae_row ="); + for (i=0; instages_stored; i++) + STAN_SUNDIALS_FPRINTF(outfile," %"RSYM,step_mem->Ae_row[i]); + STAN_SUNDIALS_FPRINTF(outfile,"\n"); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: Ai_row ="); + for (i=0; instages_stored; i++) + STAN_SUNDIALS_FPRINTF(outfile," %"RSYM,step_mem->Ai_row[i]); + STAN_SUNDIALS_FPRINTF(outfile,"\n"); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + /* output vector quantities */ + STAN_SUNDIALS_FPRINTF(outfile, "MRIStep: sdata:\n"); + N_VPrintFile(step_mem->sdata, outfile); + STAN_SUNDIALS_FPRINTF(outfile, "MRIStep: zpred:\n"); + N_VPrintFile(step_mem->zpred, outfile); + STAN_SUNDIALS_FPRINTF(outfile, "MRIStep: zcor:\n"); + N_VPrintFile(step_mem->zcor, outfile); + if (step_mem->Fse) + for (i=0; instages_stored; i++) { + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: Fse[%i]:\n", i); + N_VPrintFile(step_mem->Fse[i], outfile); + } + if (step_mem->Fsi) + for (i=0; instages_stored; i++) { + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: Fsi[%i]:\n", i); + N_VPrintFile(step_mem->Fsi[i], outfile); + } +#endif + + /* print the inner stepper memory */ + mriStepInnerStepper_PrintMem(step_mem->stepper, outfile); + + return; +} + + + +/*=============================================================== + MRIStep Private functions + ===============================================================*/ + +/*--------------------------------------------------------------- + Interface routines supplied to ARKode + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + mriStep_AttachLinsol: + + This routine attaches the various set of system linear solver + interface routines, data structure, and solver type to the + MRIStep module. + ---------------------------------------------------------------*/ +int mriStep_AttachLinsol(void* arkode_mem, ARKLinsolInitFn linit, + ARKLinsolSetupFn lsetup, + ARKLinsolSolveFn lsolve, + ARKLinsolFreeFn lfree, + SUNLinearSolver_Type lsolve_type, + void *lmem) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_AttachLinsol", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* free any existing system solver */ + if (step_mem->lfree != NULL) step_mem->lfree(arkode_mem); + + /* Attach the provided routines, data structure and solve type */ + step_mem->linit = linit; + step_mem->lsetup = lsetup; + step_mem->lsolve = lsolve; + step_mem->lfree = lfree; + step_mem->lmem = lmem; + + /* Reset all linear solver counters */ + step_mem->nsetups = 0; + step_mem->nstlp = 0; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_DisableLSetup: + + This routine NULLifies the lsetup function pointer in the + MRIStep module. + ---------------------------------------------------------------*/ +void mriStep_DisableLSetup(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_DisableLSetup", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return; + + /* nullify the lsetup function pointer */ + step_mem->lsetup = NULL; +} + + +/*--------------------------------------------------------------- + mriStep_GetLmem: + + This routine returns the system linear solver interface memory + structure, lmem. + ---------------------------------------------------------------*/ +void* mriStep_GetLmem(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure, and return lmem */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_GetLmem", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(NULL); + return(step_mem->lmem); +} + + +/*--------------------------------------------------------------- + mriStep_GetImplicitRHS: + + This routine returns the implicit RHS function pointer, fi. + ---------------------------------------------------------------*/ +ARKRhsFn mriStep_GetImplicitRHS(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure, and return fi */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_GetImplicitRHS", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(NULL); + if (step_mem->implicit_rhs) { + return(step_mem->fsi); + } else { + return(NULL); + } +} + + +/*--------------------------------------------------------------- + mriStep_GetGammas: + + This routine fills the current value of gamma, and states + whether the gamma ratio fails the dgmax criteria. + ---------------------------------------------------------------*/ +int mriStep_GetGammas(void* arkode_mem, realtype *gamma, + realtype *gamrat, booleantype **jcur, + booleantype *dgamma_fail) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_GetGammas", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set outputs */ + *gamma = step_mem->gamma; + *gamrat = step_mem->gamrat; + *jcur = &step_mem->jcur; + *dgamma_fail = (SUNRabs(*gamrat - ONE) >= step_mem->dgmax); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_Init: + + This routine is called just prior to performing internal time + steps (after all user "set" routines have been called) from + within arkInitialSetup. + + With initialization types FIRST_INIT this routine: + - sets/checks the ARK Butcher tables to be used + - allocates any memory that depends on the number of ARK + stages, method order, or solver options + - sets the call_fullrhs flag + + With other initialization types, this routine does nothing. + ---------------------------------------------------------------*/ +int mriStep_Init(void* arkode_mem, int init_type) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval, j; + booleantype reset_efun; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_Init", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* immediately return if reset */ + if (init_type == RESET_INIT) return(ARK_SUCCESS); + + /* initializations/checks for (re-)initialization call */ + if (init_type == FIRST_INIT) { + + /* enforce use of arkEwtSmallReal if using a fixed step size for + an explicit method and an internal error weight function */ + reset_efun = SUNTRUE; + if ( step_mem->implicit_rhs ) reset_efun = SUNFALSE; + if ( ark_mem->user_efun ) reset_efun = SUNFALSE; + if (reset_efun) { + ark_mem->user_efun = SUNFALSE; + ark_mem->efun = arkEwtSetSmallReal; + ark_mem->e_data = ark_mem; + } + + /* assume fixed outer step size */ + if (!ark_mem->fixedstep) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", "mriStep_Init", + "Adaptive outer time stepping is not currently supported"); + return(ARK_ILL_INPUT); + } + + /* Create coupling structure (if not already set) */ + retval = mriStep_SetCoupling(ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", "mriStep_Init", + "Could not create coupling table"); + return(ARK_ILL_INPUT); + } + + /* Check that coupling structure is OK */ + retval = mriStep_CheckCoupling(ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "mriStep_Init", "Error in coupling table"); + return(ARK_ILL_INPUT); + } + + /* Retrieve/store method and embedding orders now that tables are finalized */ + step_mem->stages = step_mem->MRIC->stages; + step_mem->q = step_mem->MRIC->q; + step_mem->p = step_mem->MRIC->p; + + /* allocate/fill derived quantities from MRIC structure */ + + /* stage map */ + if (step_mem->stage_map) { + free(step_mem->stage_map); + step_mem->stage_map = NULL; + ark_mem->liw -= step_mem->stages; + } + step_mem->stage_map = (int *) calloc(step_mem->stages, sizeof(int)); + ark_mem->liw += step_mem->stages; + + retval = mriStepCoupling_GetStageMap(step_mem->MRIC, + step_mem->stage_map, + &(step_mem->nstages_stored)); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "mriStep_Init", "Error in coupling table"); + return(ARK_ILL_INPUT); + } + + /* stage types */ + if (step_mem->stagetypes) { + free(step_mem->stagetypes); + step_mem->stagetypes = NULL; + ark_mem->liw -= step_mem->stages; + } + step_mem->stagetypes = (int *) calloc(step_mem->stages, sizeof(int)); + ark_mem->liw += step_mem->stages; + for (j=0; jstages; j++) + step_mem->stagetypes[j] = mriStepCoupling_GetStageType(step_mem->MRIC, j); + + /* explicit RK coefficient row */ + if (step_mem->Ae_row) { + free(step_mem->Ae_row); + step_mem->Ae_row = NULL; + ark_mem->lrw -= step_mem->stages; + } + step_mem->Ae_row = (realtype *) calloc(step_mem->stages, + sizeof(realtype)); + ark_mem->lrw += step_mem->stages; + + /* implicit RK coefficient row */ + if (step_mem->Ai_row) { + free(step_mem->Ai_row); + step_mem->Ai_row = NULL; + ark_mem->lrw -= step_mem->stages; + } + step_mem->Ai_row = (realtype *) calloc(step_mem->stages, + sizeof(realtype)); + ark_mem->lrw += step_mem->stages; + + /* Allocate MRI RHS vector memory, update storage requirements */ + /* Allocate Fse[0] ... Fse[nstages_stored - 1] if needed */ + if (step_mem->explicit_rhs) { + if (!arkAllocVecArray(step_mem->nstages_stored, + ark_mem->ewt, &(step_mem->Fse), + ark_mem->lrw1, &(ark_mem->lrw), + ark_mem->liw1, &(ark_mem->liw))) + return(ARK_MEM_FAIL); + } + + /* Allocate Fsi[0] ... Fsi[nstages_stored - 1] if needed */ + if (step_mem->implicit_rhs) { + if (!arkAllocVecArray(step_mem->nstages_stored, + ark_mem->ewt, &(step_mem->Fsi), + ark_mem->lrw1, &(ark_mem->lrw), + ark_mem->liw1, &(ark_mem->liw))) + return(ARK_MEM_FAIL); + } + + /* if any slow stage is implicit, allocate sdata, zpred, zcor vectors; + if all stages explicit, free default NLS object, and detach all + linear solver routines. Note: step_mem->implicit_rhs will only equal + SUNTRUE if an implicit table has been user-provided. */ + if (step_mem->implicit_rhs) { + if (!arkAllocVec(ark_mem, ark_mem->ewt, &(step_mem->sdata))) + return(ARK_MEM_FAIL); + if (!arkAllocVec(ark_mem, ark_mem->ewt, &(step_mem->zpred))) + return(ARK_MEM_FAIL); + if (!arkAllocVec(ark_mem, ark_mem->ewt, &(step_mem->zcor))) + return(ARK_MEM_FAIL); + } else { + if ((step_mem->NLS != NULL) && (step_mem->ownNLS)) { + SUNNonlinSolFree(step_mem->NLS); + step_mem->NLS = NULL; + step_mem->ownNLS = SUNFALSE; + } + step_mem->linit = NULL; + step_mem->lsetup = NULL; + step_mem->lsolve = NULL; + step_mem->lfree = NULL; + step_mem->lmem = NULL; + } + + /* Allocate reusable arrays for fused vector interface */ + step_mem->nfusedopvecs = 2*step_mem->stages + 2; + if (step_mem->cvals == NULL) { + step_mem->cvals = (realtype *) calloc(step_mem->nfusedopvecs, sizeof(realtype)); + if (step_mem->cvals == NULL) return(ARK_MEM_FAIL); + ark_mem->lrw += (step_mem->nfusedopvecs); + } + if (step_mem->Xvecs == NULL) { + step_mem->Xvecs = (N_Vector *) calloc(step_mem->nfusedopvecs, sizeof(N_Vector)); + if (step_mem->Xvecs == NULL) return(ARK_MEM_FAIL); + ark_mem->liw += (step_mem->nfusedopvecs); /* pointers */ + } + + /* Allocate inner stepper data */ + retval = mriStepInnerStepper_AllocVecs(step_mem->stepper, + step_mem->MRIC->nmat, ark_mem->ewt); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", "mriStep_Init", + "Error allocating inner stepper memory"); + return(ARK_MEM_FAIL); + } + + /* Limit interpolant degree based on method order (use negative + argument to specify update instead of overwrite) */ + if (ark_mem->interp != NULL) { + retval = arkInterpSetDegree(ark_mem, ark_mem->interp, -(step_mem->q-1)); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", "mriStep_Init", + "Unable to update interpolation polynomial degree"); + return(ARK_ILL_INPUT); + } + } + + } + + /* Call linit (if it exists) */ + if (step_mem->linit) { + retval = step_mem->linit(ark_mem); + if (retval != 0) { + arkProcessError(ark_mem, ARK_LINIT_FAIL, "ARKode::MRIStep", "mriStep_Init", + MSG_ARK_LINIT_FAIL); + return(ARK_LINIT_FAIL); + } + } + + /* Initialize the nonlinear solver object (if it exists) */ + if (step_mem->NLS) { + retval = mriStep_NlsInit(ark_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_NLS_INIT_FAIL, "ARKode::MRIStep", "mriStep_Init", + "Unable to initialize SUNNonlinearSolver object"); + return(ARK_NLS_INIT_FAIL); + } + } + + /* Signal to shared arkode module that fullrhs is required after each step */ + ark_mem->call_fullrhs = SUNTRUE; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_FullRHS: + + This is just a wrapper to call the user-supplied RHS functions, + f(t,y) = fse(t,y) + fsi(t,y) + ff(t,y). + + This will be called in one of three 'modes': + ARK_FULLRHS_START -> called at the beginning of a simulation + or after post processing at step + ARK_FULLRHS_END -> called at the end of a successful step + ARK_FULLRHS_OTHER -> called elsewhere (e.g. for dense output) + + If it is called in ARK_FULLRHS_START mode, we store the vectors + f(t,y) in F[0] for possible reuse in the first stage of the + subsequent time step. + + If it is called in ARK_FULLRHS_END mode, we reevauate f(t,y). At + this time no checks are made to see if the method coefficient + support copying vectors F[stages] to fill f instead of calling f(). + + ARK_FULLRHS_OTHER mode is only called for dense output in-between + steps, so we strive to store the intermediate parts so that they + do not interfere with the other two modes. + ---------------------------------------------------------------*/ +int mriStep_FullRHS(void* arkode_mem, realtype t, N_Vector y, N_Vector f, + int mode) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_FullRHS", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* perform RHS functions contingent on 'mode' argument */ + switch(mode) { + + /* ARK_FULLRHS_START: called at the beginning of a simulation + Store the vector fs(t,y) in F[0] for possible reuse + in the first stage of the subsequent time step */ + case ARK_FULLRHS_START: + + /* call fse if the problem has an explicit component */ + if (step_mem->explicit_rhs) { + retval = step_mem->fse(t, y, step_mem->Fse[0], ark_mem->user_data); + step_mem->nfse++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::MRIStep", + "mriStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + } + + /* call fsi if the problem has an implicit component */ + if (step_mem->implicit_rhs) { + retval = step_mem->fsi(t, y, step_mem->Fsi[0], ark_mem->user_data); + step_mem->nfsi++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::MRIStep", + "mriStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + } + + /* call ff (force new RHS computation) */ + retval = mriStepInnerStepper_FullRhs(step_mem->stepper, t, y, f, + ARK_FULLRHS_OTHER); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::MRIStep", + "mriStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + + /* combine RHS vectors into output */ + if (step_mem->explicit_rhs && step_mem->implicit_rhs) { /* ImEx */ + N_VLinearSum(ONE, step_mem->Fse[0], ONE, f, f); + N_VLinearSum(ONE, step_mem->Fsi[0], ONE, f, f); + } else { + if (step_mem->implicit_rhs) { /* implicit */ + N_VLinearSum(ONE, step_mem->Fsi[0], ONE, f, f); + } else { /* explicit */ + N_VLinearSum(ONE, step_mem->Fse[0], ONE, f, f); + } + } + + break; + + + /* ARK_FULLRHS_END: called at the end of a successful step + This always recomputes the full RHS (i.e., this is the + same as case 0). */ + case ARK_FULLRHS_END: + + /* call fse if the problem has an explicit component */ + if (step_mem->explicit_rhs) { + retval = step_mem->fse(t, y, step_mem->Fse[0], ark_mem->user_data); + step_mem->nfse++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::MRIStep", + "mriStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + } + + /* call fsi if the problem has an implicit component */ + if (step_mem->implicit_rhs) { + retval = step_mem->fsi(t, y, step_mem->Fsi[0], ark_mem->user_data); + step_mem->nfsi++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::MRIStep", + "mriStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + } + + /* call ff (force new RHS computation) */ + retval = mriStepInnerStepper_FullRhs(step_mem->stepper, t, y, f, + ARK_FULLRHS_OTHER); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::MRIStep", + "mriStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + + /* combine RHS vectors into output */ + if (step_mem->explicit_rhs && step_mem->implicit_rhs) { /* ImEx */ + N_VLinearSum(ONE, step_mem->Fse[0], ONE, f, f); + N_VLinearSum(ONE, step_mem->Fsi[0], ONE, f, f); + } else { + if (step_mem->implicit_rhs) { /* implicit */ + N_VLinearSum(ONE, step_mem->Fsi[0], ONE, f, f); + } else { /* explicit */ + N_VLinearSum(ONE, step_mem->Fse[0], ONE, f, f); + } + } + break; + + /* ARK_FULLRHS_OTHER: called for dense output in-between steps + store the intermediate calculations in such a way as to not + interfere with the other two modes */ + case ARK_FULLRHS_OTHER: + + /* call fse if the problem has an explicit component (store in ark_tempv2) */ + if (step_mem->explicit_rhs) { + retval = step_mem->fse(t, y, ark_mem->tempv2, ark_mem->user_data); + step_mem->nfse++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::MRIStep", + "mriStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + } + + /* call fsi if the problem has an implicit component (store in sdata) */ + if (step_mem->implicit_rhs) { + retval = step_mem->fsi(t, y, step_mem->sdata, ark_mem->user_data); + step_mem->nfsi++; + if (retval != 0) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::MRIStep", + "mriStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + } + + + /* call ff (force new RHS computation) */ + retval = mriStepInnerStepper_FullRhs(step_mem->stepper, t, y, f, + ARK_FULLRHS_OTHER); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::MRIStep", + "mriStep_FullRHS", MSG_ARK_RHSFUNC_FAILED, t); + return(ARK_RHSFUNC_FAIL); + } + + /* combine RHS vectors into output */ + if (step_mem->explicit_rhs && step_mem->implicit_rhs) { /* ImEx */ + N_VLinearSum(ONE, ark_mem->tempv2, ONE, f, f); + N_VLinearSum(ONE, step_mem->sdata, ONE, f, f); + } else { /* implicit */ + if (step_mem->implicit_rhs) { + N_VLinearSum(ONE, step_mem->sdata, ONE, f, f); + } else { /* explicit */ + N_VLinearSum(ONE, ark_mem->tempv2, ONE, f, f); + } + } + + break; + + default: + /* return with RHS failure if unknown mode is passed */ + arkProcessError(ark_mem, ARK_RHSFUNC_FAIL, "ARKode::MRIStep", + "mriStep_FullRHS", "Unknown full RHS mode"); + return(ARK_RHSFUNC_FAIL); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_TakeStep: + + This routine serves the primary purpose of the MRIStep module: + it performs a single MRI step (with embedding, if possible). + + The output variable dsmPtr should contain estimate of the + weighted local error if an embedding is present; otherwise it + should be 0. + + The input/output variable nflagPtr is used to gauge convergence + of any algebraic solvers within the step. At the start of a new + time step, this will initially have the value FIRST_CALL. On + return from this function, nflagPtr should have a value: + 0 => algebraic solve completed successfully + >0 => solve did not converge at this step size + (but may with a smaller stepsize) + <0 => solve encountered an unrecoverable failure + + 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 mriStep_TakeStep(void* arkode_mem, realtype *dsmPtr, int *nflagPtr) +{ + ARKodeMem ark_mem; /* outer ARKode memory */ + ARKodeMRIStepMem step_mem; /* outer stepper memory */ + int is; /* current stage index */ + int retval; /* reusable return flag */ + + /* initialize algebraic solver convergence flag to success; + error estimate to zero */ + *nflagPtr = ARK_SUCCESS; + *dsmPtr = ZERO; + + /* access the MRIStep mem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_TakeStep", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + +#ifdef SUNDIALS_DEBUG + STAN_SUNDIALS_PRINTF(" MRIStep step %li, stage 0, h = %"RSYM", t_n = %"RSYM"\n", + ark_mem->nst, ark_mem->h, ark_mem->tcur); +#endif + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" MRIStep slow stage 0 solution:\n"); + N_VPrint(ark_mem->ycur); + if (step_mem->explicit_rhs) + { + STAN_SUNDIALS_PRINTF(" MRIStep slow stage RHS Fe[0]:\n"); + N_VPrint(step_mem->Fse[0]); + } + if (step_mem->implicit_rhs) + { + STAN_SUNDIALS_PRINTF(" MRIStep slow stage RHS Fi[0]:\n"); + N_VPrint(step_mem->Fsi[0]); + } +#endif + + /* call nonlinear solver setup if it exists */ + if (step_mem->NLS) + if ((step_mem->NLS)->ops->setup) { + N_VConst(ZERO, ark_mem->tempv3); /* set guess to 0 for predictor-corrector form */ + retval = SUNNonlinSolSetup(step_mem->NLS, ark_mem->tempv3, ark_mem); + if (retval < 0) return(ARK_NLS_SETUP_FAIL); + if (retval > 0) return(ARK_NLS_SETUP_RECVR); + } + + /* The first stage is the previous time-step solution, so its RHS + is the [already-computed] slow RHS from the start of the step */ + + /* Loop over remaining stages */ + for (is = 1; is < step_mem->stages; is++) { + + /* Set current stage time */ + ark_mem->tcur = ark_mem->tn + step_mem->MRIC->c[is]*ark_mem->h; + +#ifdef SUNDIALS_DEBUG + STAN_SUNDIALS_PRINTF(" ------------------------------------" + "----------------------------------------\n"); + STAN_SUNDIALS_PRINTF(" MRIStep step %li, stage %i, h = %"RSYM", t_n = %"RSYM"\n", + ark_mem->nst, is, ark_mem->h, ark_mem->tcur); +#endif + + /* Solver diagnostics reporting */ + if (ark_mem->report) + STAN_SUNDIALS_FPRINTF(ark_mem->diagfp, "MRIStep step %li %"RSYM" %i %"RSYM"\n", + ark_mem->nst, ark_mem->h, is, ark_mem->tcur); + + /* Determine current stage type, and call corresponding routine; the + vector ark_mem->ycur stores the previous stage solution on input, and + should store the result of this stage solution on output. */ + switch (step_mem->stagetypes[is]) { + case(MRISTAGE_ERK_FAST): + retval = mriStep_StageERKFast(ark_mem, step_mem, is); + break; + case(MRISTAGE_ERK_NOFAST): + retval = mriStep_StageERKNoFast(ark_mem, step_mem, is); + break; + case(MRISTAGE_DIRK_NOFAST): + retval = mriStep_StageDIRKNoFast(ark_mem, step_mem, is, nflagPtr); + break; + case(MRISTAGE_DIRK_FAST): + retval = mriStep_StageDIRKFast(ark_mem, step_mem, is, nflagPtr); + break; + } + if (retval != ARK_SUCCESS) return(retval); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" MRIStep slow stage %i solution:\n",is); + N_VPrint(ark_mem->ycur); +#endif + + /* apply user-supplied stage postprocessing function (if supplied) */ + if (ark_mem->ProcessStage != NULL) { + retval = ark_mem->ProcessStage(ark_mem->tcur, + ark_mem->ycur, + ark_mem->user_data); + if (retval != 0) return(ARK_POSTPROCESS_STAGE_FAIL); + } + + /* conditionally reset the inner integrator with the modified stage solution */ + if ( (step_mem->stagetypes[is] != MRISTAGE_ERK_FAST) || + (ark_mem->ProcessStage != NULL) ) { + retval = mriStepInnerStepper_Reset(step_mem->stepper, + ark_mem->tcur, ark_mem->ycur); + if (retval != ARK_SUCCESS) return(ARK_INNERSTEP_FAIL); + } + + /* Compute updated slow RHS except at last stage which is the new solution. + * The new solution RHS evaluation happens in arkCompleteStep */ + if (is < step_mem->stages - 1 && step_mem->stage_map[is] > -1) { + /* store explicit slow rhs */ + if (step_mem->explicit_rhs) { + retval = step_mem->fse(ark_mem->tcur, ark_mem->ycur, + step_mem->Fse[step_mem->stage_map[is]], + ark_mem->user_data); + step_mem->nfse++; + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(ARK_UNREC_RHSFUNC_ERR); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" MRIStep slow stage RHS Fe[%i]:\n",is); + N_VPrint(step_mem->Fse[step_mem->stage_map[is]]); +#endif + } + + /* store implicit slow rhs */ + if (step_mem->implicit_rhs) { + retval = step_mem->fsi(ark_mem->tcur, ark_mem->ycur, + step_mem->Fsi[step_mem->stage_map[is]], + ark_mem->user_data); + step_mem->nfsi++; + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(ARK_UNREC_RHSFUNC_ERR); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" MRIStep slow stage RHS Fi[%i]:\n",is); + N_VPrint(step_mem->Fsi[step_mem->stage_map[is]]); +#endif + } + } /* compute slow RHS */ + } /* loop over stages */ + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" MRIStep updated solution:\n"); + N_VPrint(ark_mem->ycur); +#endif + + /* Solver diagnostics reporting */ + if (ark_mem->report) + STAN_SUNDIALS_FPRINTF(ark_mem->diagfp, "MRIStep etest %li %"RSYM" %"RSYM"\n", + ark_mem->nst, ark_mem->h, *dsmPtr); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + Internal utility routines + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + mriStep_AccessStepMem: + + Shortcut routine to unpack ark_mem and step_mem structures from + void* pointer. If either is missing it returns ARK_MEM_NULL. + ---------------------------------------------------------------*/ +int mriStep_AccessStepMem(void* arkode_mem, const char *fname, + ARKodeMem *ark_mem, ARKodeMRIStepMem *step_mem) +{ + + /* access ARKodeMem structure */ + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::MRIStep", + fname, MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + *ark_mem = (ARKodeMem) arkode_mem; + if ((*ark_mem)->step_mem==NULL) { + arkProcessError(*ark_mem, ARK_MEM_NULL, "ARKode::MRIStep", + fname, MSG_MRISTEP_NO_MEM); + return(ARK_MEM_NULL); + } + *step_mem = (ARKodeMRIStepMem) (*ark_mem)->step_mem; + return(ARK_SUCCESS); +} + + + +/*--------------------------------------------------------------- + mriStep_CheckNVector: + + This routine checks if all required vector operations are + present. If any of them is missing it returns SUNFALSE. + ---------------------------------------------------------------*/ +booleantype mriStep_CheckNVector(N_Vector tmpl) +{ + if ( (tmpl->ops->nvclone == NULL) || + (tmpl->ops->nvdestroy == NULL) || + (tmpl->ops->nvlinearsum == NULL) || + (tmpl->ops->nvconst == NULL) || + (tmpl->ops->nvscale == NULL) || + (tmpl->ops->nvwrmsnorm == NULL) ) + return(SUNFALSE); + return(SUNTRUE); +} + + +/*--------------------------------------------------------------- + mriStep_SetCoupling + + This routine determines the MRI method to use, based on the + desired accuracy. + ---------------------------------------------------------------*/ +int mriStep_SetCoupling(ARKodeMem ark_mem) +{ + ARKodeMRIStepMem step_mem; + sunindextype Cliw, Clrw; + + /* access ARKodeMRIStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::MRIStep", + "mriStep_SetCoupling", MSG_MRISTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeMRIStepMem) ark_mem->step_mem; + + /* if coupling has already been specified, just return */ + if (step_mem->MRIC != NULL) return(ARK_SUCCESS); + + /* select method based on order and type */ + + /**** ImEx methods ****/ + if (step_mem->implicit_rhs && step_mem->explicit_rhs) { + + switch (step_mem->q) { + case 3: + step_mem->MRIC = MRIStepCoupling_LoadTable(MRISTEP_DEFAULT_IMEX_SD_3); + break; + case 4: + step_mem->MRIC = MRIStepCoupling_LoadTable(MRISTEP_DEFAULT_IMEX_SD_4); + break; + default: + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "mriStep_SetCoupling", + "No MRI method at requested order, using q=3."); + step_mem->MRIC = MRIStepCoupling_LoadTable(MRISTEP_DEFAULT_IMEX_SD_3); + break; + } + + /**** implicit methods ****/ + } else if (step_mem->implicit_rhs) { + + switch (step_mem->q) { + case 2: + step_mem->MRIC = MRIStepCoupling_LoadTable(MRISTEP_DEFAULT_IMPL_SD_3); + break; + case 3: + step_mem->MRIC = MRIStepCoupling_LoadTable(MRISTEP_DEFAULT_IMPL_SD_3); + break; + case 4: + step_mem->MRIC = MRIStepCoupling_LoadTable(MRISTEP_DEFAULT_IMPL_SD_4); + break; + default: + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "mriStep_SetCoupling", + "No MRI method at requested order, using q=3."); + step_mem->MRIC = MRIStepCoupling_LoadTable(MRISTEP_DEFAULT_IMPL_SD_3); + break; + } + + /**** explicit methods ****/ + } else { + + switch (step_mem->q) { + case 3: + step_mem->MRIC = MRIStepCoupling_LoadTable(MRISTEP_DEFAULT_EXPL_3); + break; + case 4: + step_mem->MRIC = MRIStepCoupling_LoadTable(MRISTEP_DEFAULT_EXPL_4); + break; + default: + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "mriStep_SetCoupling", + "No MRI method at requested order, using q=3."); + step_mem->MRIC = MRIStepCoupling_LoadTable(MRISTEP_DEFAULT_EXPL_3); + break; + } + + } + + if (step_mem->MRIC == NULL) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::MRIStep", + "mriStep_SetCoupling", + "An error occurred in constructing coupling table."); + return(ARK_INVALID_TABLE); + } + + /* note coupling structure space requirements */ + MRIStepCoupling_Space(step_mem->MRIC, &Cliw, &Clrw); + ark_mem->liw += Cliw; + ark_mem->lrw += Clrw; + + /* set [redundant] stored values for stage numbers and + method/embedding orders */ + step_mem->stages = step_mem->MRIC->stages; + step_mem->q = step_mem->MRIC->q; + step_mem->p = step_mem->MRIC->p; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_CheckCoupling + + This routine runs through the MRI coupling structure to ensure + that it meets all necessary requirements, including: + sorted abscissae, with c[0] = 0 and c[end] = 1 + lower-triangular (i.e., ERK or DIRK) + all DIRK stages are solve-decoupled [temporarily] + method order q > 0 (all) + stages > 0 (all) + + Returns ARK_SUCCESS if it passes, ARK_INVALID_TABLE otherwise. + ---------------------------------------------------------------*/ +int mriStep_CheckCoupling(ARKodeMem ark_mem) +{ + int i, j, k; + booleantype okay; + ARKodeMRIStepMem step_mem; + realtype Gabs, Wabs; + const realtype tol = RCONST(100.0)*UNIT_ROUNDOFF; + + /* access ARKodeMRIStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::MRIStep", + "mriStep_CheckCoupling", MSG_MRISTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeMRIStepMem) ark_mem->step_mem; + + /* check that stages > 0 */ + if (step_mem->MRIC->stages < 1) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::MRIStep", + "mriStep_CheckCoupling", "stages < 1!"); + return(ARK_INVALID_TABLE); + } + + /* check that method order q > 0 */ + if (step_mem->MRIC->q < 1) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::MRIStep", + "mriStep_CheckCoupling", "method order < 1"); + return(ARK_INVALID_TABLE); + } + + /* check that embedding order p > 0 (if adaptive) */ + if ((step_mem->MRIC->p < 1) && (!ark_mem->fixedstep)) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::MRIStep", + "mriStep_CheckCoupling", "embedding order < 1"); + return(ARK_INVALID_TABLE); + } + + /* Check that the matrices are defined appropriately */ + if (step_mem->implicit_rhs && step_mem->explicit_rhs) { + /* ImEx */ + if (!(step_mem->MRIC->W) || !(step_mem->MRIC->G)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "mriStep_CheckCoupling", + "Invalid coupling table for an IMEX problem!"); + return(ARK_ILL_INPUT); + } + } else if (step_mem->explicit_rhs) { + /* Explicit */ + if (!(step_mem->MRIC->W) || step_mem->MRIC->G) { + arkProcessError(ark_mem,ARK_ILL_INPUT, "ARKode::MRIStep", + "mriStep_CheckCoupling", + "Invalid coupling table for an explicit problem!"); + return(ARK_ILL_INPUT); + } + } else { + /* Implicit */ + if (step_mem->MRIC->W || !(step_mem->MRIC->G)) { + arkProcessError(ark_mem,ARK_ILL_INPUT, "ARKode::MRIStep", + "mriStep_CheckCoupling", + "Invalid coupling table fro an implicit problem!"); + return(ARK_ILL_INPUT); + } + } + + /* Check that W tables are strictly lower triangular */ + if (step_mem->MRIC->W) { + Wabs = RCONST(0.0); + for (k=0; kMRIC->nmat; k++) + for (i=0; iMRIC->stages; i++) + for (j=i; jMRIC->stages; j++) + Wabs += SUNRabs(step_mem->MRIC->W[k][i][j]); + if (Wabs > tol) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::MRIStep", + "mriStep_CheckCoupling", + "Coupling can be up to ERK (at most)!"); + return(ARK_INVALID_TABLE); + } + } + + /* Check that G tables are lower triangular */ + if (step_mem->MRIC->G) { + Gabs = RCONST(0.0); + for (k=0; kMRIC->nmat; k++) + for (i=0; iMRIC->stages; i++) + for (j=i+1; jMRIC->stages; j++) + Gabs += SUNRabs(step_mem->MRIC->G[k][i][j]); + if (Gabs > tol) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::MRIStep", + "mriStep_CheckCoupling", + "Coupling can be up to DIRK (at most)!"); + return(ARK_INVALID_TABLE); + } + } + + /* Check that no stage has MRISTAGE_DIRK_FAST type (for now) */ + okay = SUNTRUE; + for (i=0; iMRIC->stages; i++) + if (mriStepCoupling_GetStageType(step_mem->MRIC, i) == MRISTAGE_DIRK_FAST) + okay = SUNFALSE; + if (!okay) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::MRIStep", + "mriStep_CheckCoupling", + "solve-coupled DIRK stages not currently supported"); + return(ARK_INVALID_TABLE); + } + + /* check that stage times are sorted */ + okay = SUNTRUE; + for (i=1; iMRIC->stages; i++) { + if ((step_mem->MRIC->c[i] - step_mem->MRIC->c[i-1]) < -tol) + okay = SUNFALSE; + } + if (!okay) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::MRIStep", + "mriStep_CheckCoupling", + "Stage times must be sorted."); + return(ARK_INVALID_TABLE); + } + + /* check that the first stage is just the old step solution */ + Gabs = SUNRabs(step_mem->MRIC->c[0]); + for (k=0; kMRIC->nmat; k++) + for (j=0; jMRIC->stages; j++) { + if (step_mem->MRIC->W) + Gabs += SUNRabs(step_mem->MRIC->W[k][0][j]); + if (step_mem->MRIC->G) + Gabs += SUNRabs(step_mem->MRIC->G[k][0][j]); + } + if (Gabs > tol) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::MRIStep", + "mriStep_CheckCoupling", + "First stage must equal old solution."); + return(ARK_INVALID_TABLE); + } + + /* check that the last stage is at the final time */ + if (SUNRabs(ONE - step_mem->MRIC->c[step_mem->MRIC->stages-1]) > tol) { + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::MRIStep", + "mriStep_CheckCoupling", + "Final stage time must be equal 1."); + return(ARK_INVALID_TABLE); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_StageERKFast + + This routine performs a single MRI stage with explicit slow + time scale and fast time scale that requires evolution. + ---------------------------------------------------------------*/ +int mriStep_StageERKFast(ARKodeMem ark_mem, + ARKodeMRIStepMem step_mem, int is) +{ + realtype cdiff; /* stage time increment */ + realtype t0; /* start time for stage */ + int retval; /* reusable return flag */ + +#ifdef SUNDIALS_DEBUG + STAN_SUNDIALS_PRINTF(" MRIStep ERK fast stage\n"); +#endif + + /* Set initial time for fast evolution */ + t0 = ark_mem->tn + step_mem->MRIC->c[is-1]*ark_mem->h; + + /* compute the inner forcing */ + cdiff = step_mem->MRIC->c[is] - step_mem->MRIC->c[is-1]; + retval = mriStep_ComputeInnerForcing(step_mem, is, cdiff); + if (retval != ARK_SUCCESS) return(retval); + + /* Set inner forcing time normalization constants */ + step_mem->stepper->tshift = t0; + step_mem->stepper->tscale = cdiff * ark_mem->h; + + /* pre inner evolve function (if supplied) */ + if (step_mem->pre_inner_evolve) { + retval = step_mem->pre_inner_evolve(t0, step_mem->stepper->forcing, + step_mem->stepper->nforcing, + ark_mem->user_data); + if (retval != 0) return(ARK_OUTERTOINNER_FAIL); + } + + /* advance inner method in time */ + retval = mriStepInnerStepper_Evolve(step_mem->stepper, t0, ark_mem->tcur, + ark_mem->ycur); + if (retval < 0) return(ARK_INNERSTEP_FAIL); + + /* post inner evolve function (if supplied) */ + if (step_mem->post_inner_evolve) { + retval = step_mem->post_inner_evolve(ark_mem->tcur, ark_mem->ycur, + ark_mem->user_data); + if (retval != 0) return(ARK_INNERTOOUTER_FAIL); + } + + /* return with success */ + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_StageERKNoFast + + This routine performs a single MRI stage with explicit slow + time scale only (no fast time scale evolution). + ---------------------------------------------------------------*/ +int mriStep_StageERKNoFast(ARKodeMem ark_mem, + ARKodeMRIStepMem step_mem, int is) +{ + int retval, j, nvec; + +#ifdef SUNDIALS_DEBUG + STAN_SUNDIALS_PRINTF(" MRIStep ERK stage\n"); +#endif + + /* determine effective ERK coefficients (store in cvals) */ + retval = mriStep_RKCoeffs(step_mem->MRIC, is, step_mem->stage_map, + step_mem->Ae_row, step_mem->Ai_row); + if (retval != ARK_SUCCESS) { return(retval); } + + /* call fused vector operation to perform ERK update */ + step_mem->cvals[0] = ONE; + step_mem->Xvecs[0] = ark_mem->ycur; + nvec = 1; + for (j = 0; j < is; j++) { + if (step_mem->explicit_rhs && step_mem->stage_map[j] > -1) { + step_mem->cvals[nvec] = ark_mem->h * + step_mem->Ae_row[step_mem->stage_map[j]]; + step_mem->Xvecs[nvec] = step_mem->Fse[step_mem->stage_map[j]]; + nvec += 1; + } + if (step_mem->implicit_rhs && step_mem->stage_map[j] > -1) { + step_mem->cvals[nvec] = ark_mem->h * + step_mem->Ai_row[step_mem->stage_map[j]]; + step_mem->Xvecs[nvec] = step_mem->Fsi[step_mem->stage_map[j]]; + nvec += 1; + } + } + /* Is there a case where we have an explicit update with Fsi? */ + + retval = N_VLinearCombination(nvec, step_mem->cvals, + step_mem->Xvecs, ark_mem->ycur); + if (retval != 0) return(ARK_VECTOROP_ERR); + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_StageDIRKFast + + This routine performs a single stage of a "solve coupled" + MRI method, i.e. a stage that is DIRK on the slow time scale + and involves evolution of the fast time scale, in a + fully-coupled fashion. + ---------------------------------------------------------------*/ +int mriStep_StageDIRKFast(ARKodeMem ark_mem, ARKodeMRIStepMem step_mem, + int is, int *nflagPtr) +{ +#ifdef SUNDIALS_DEBUG + STAN_SUNDIALS_PRINTF(" MRIStep DIRK fast stage\n"); +#endif + + /* this is not currently implemented */ + arkProcessError(ark_mem, ARK_INVALID_TABLE, "ARKode::MRIStep", + "mriStep_StageDIRKFast", + "This routine is not yet implemented."); + return(ARK_INVALID_TABLE); +} + + +/*--------------------------------------------------------------- + mriStep_StageDIRKNoFast + + This routine performs a single MRI stage with implicit slow + time scale only (no fast time scale evolution). + ---------------------------------------------------------------*/ +int mriStep_StageDIRKNoFast(ARKodeMem ark_mem, ARKodeMRIStepMem step_mem, + int is, int *nflagPtr) +{ + int retval; + +#ifdef SUNDIALS_DEBUG + STAN_SUNDIALS_PRINTF(" MRIStep DIRK stage\n"); +#endif + + /* store current stage index */ + step_mem->istage = is; + + /* Call predictor for current stage solution (result placed in zpred) */ + retval = mriStep_Predict(ark_mem, is, step_mem->zpred); + if (retval != ARK_SUCCESS) return (retval); + + /* If a user-supplied predictor routine is provided, call that here + Note that mriStep_Predict is *still* called, so this user-supplied + routine can just 'clean up' the built-in prediction, if desired. */ + if (step_mem->stage_predict) { + retval = step_mem->stage_predict(ark_mem->tcur, step_mem->zpred, + ark_mem->user_data); + if (retval < 0) return(ARK_USER_PREDICT_FAIL); + if (retval > 0) return(TRY_AGAIN); + } + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" MRIStep predictor:\n"); + N_VPrint(step_mem->zpred); +#endif + + /* determine effective DIRK coefficients (store in cvals) */ + retval = mriStep_RKCoeffs(step_mem->MRIC, is, step_mem->stage_map, + step_mem->Ae_row, step_mem->Ai_row); + if (retval != ARK_SUCCESS) { return(retval); } + + /* Set up data for evaluation of DIRK stage residual (data stored in sdata) */ + retval = mriStep_StageSetup(ark_mem); + if (retval != ARK_SUCCESS) return (retval); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" MRIStep rhs data:\n"); + N_VPrint(step_mem->sdata); +#endif + + /* perform implicit solve (result is stored in ark_mem->ycur); return + with positive value on anything but success */ + *nflagPtr = mriStep_Nls(ark_mem, *nflagPtr); + if (*nflagPtr != ARK_SUCCESS) return(TRY_AGAIN); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_ComputeInnerForcing + + Constructs the 'coefficient' vectors for the forcing polynomial + for a 'fast' outer MRI stage i: + + p_i(theta) = sum_{k=0}^{n-1} forcing[k] * theta^k + + where theta = (t - t0) / (cdiff*h) is the mapped 'time' for + each 'fast' MRIStep evolution, with: + * t0 -- the start of this outer MRIStep stage + * cdiff*h, the temporal width of this MRIStep stage + * n -- shorthand for MRIC->nmat + + explicit and solve-decoupled implicit or IMEX MRI-based methods + define this forcing polynomial for each outer stage i > 0: + + p_i(theta) = w_i,0(theta) * fse_0 + ... + w_i,{i-1}(theta) * fse_{i-1} + + g_i,0(theta) * fsi_0 + ... + g_i,{i-1}(theta) * fsi_{i-1} + + where + + w_i,j(theta) = w_0,i,j + w_1,i,j * theta + ... + w_n,i,j * theta^{n-1}, + w_k,i,j = 1/cdiff * MRIC->W[k][i][j] + + and + + g_i,j(theta) = g_0,i,j + g_1,i,j * theta + ... + g_n,i,j * theta^{n-1}, + g_k,i,j = 1/cdiff * MRIC->G[k][i][j] + + Converting to the appropriate form, we have + + p_i(theta) = ( w_0,i,0 * fse_0 + ... + w_0,i,{i-1} * fse_{i-1} + + g_0,i,0 * fsi_0 + ... + g_0,i,{i-1} * fsi_{i-1} ) * theta^0 + + ( w_1,i,0 * fse_0 + ... + w_1,i,{i-1} * fse_{i-1} + + g_1,i,0 * fsi_0 + ... + g_1,i,{i-1} * fsi_{i-1} ) * theta^1 + . + . + . + + ( w_n,i,0 * fse_0 + ... + w_n,i,{i-1} * fse_{i-1} + + g_n,i,0 * fsi_0 + ... + g_n,i,{i-1} * fsi_{i-1} ) * theta^{n-1} + + Thus we define the forcing vectors for k = 0,...,nmat - 1 + + forcing[k] = w_k,i,0 * fse_0 + ... + w_k,i,{i-1} * fse_{i-1} + + g_k,i,0 * fsi_0 + ... + g_k,i,{i-1} * fsi_{i-1} + + = 1 / cdiff * + ( W[k][i][0] * fse_0 + ... + W[k][i][i-1] * fse_{i-1} + + ( G[k][i][0] * fsi_0 + ... + G[k][i][i-1] * fsi_{i-1} ) + + This routine additionally returns a success/failure flag: + ARK_SUCCESS -- successful evaluation + ---------------------------------------------------------------*/ + +int mriStep_ComputeInnerForcing(ARKodeMRIStepMem step_mem, + int stage, realtype cdiff) +{ + realtype rcdiff; + int j, k, nmat, nstore, retval; + realtype* cvals; + N_Vector* Xvecs; + + /* local shortcuts for fused vector operations */ + cvals = step_mem->cvals; + Xvecs = step_mem->Xvecs; + + /* compute inner forcing vectors (assumes cdiff != 0) */ + nstore = 0; + for (j = 0; j < stage; j++) { + if (step_mem->explicit_rhs && step_mem->stage_map[j] > -1) { + Xvecs[nstore] = step_mem->Fse[step_mem->stage_map[j]]; + nstore += 1; + } + if (step_mem->implicit_rhs && step_mem->stage_map[j] > -1) { + Xvecs[nstore] = step_mem->Fsi[step_mem->stage_map[j]]; + nstore += 1; + } + } + + nmat = step_mem->MRIC->nmat; + rcdiff = ONE / cdiff; + + for (k = 0; k < nmat; k++) { + nstore = 0; + for (j = 0; j < stage; j++) { + if (step_mem->stage_map[j] > -1) { + if (step_mem->explicit_rhs && step_mem->implicit_rhs) { + /* ImEx */ + cvals[nstore] = rcdiff * step_mem->MRIC->W[k][stage][j]; + nstore += 1; + cvals[nstore] = rcdiff * step_mem->MRIC->G[k][stage][j]; + nstore += 1; + } else if (step_mem->explicit_rhs) { + /* explicit only */ + cvals[nstore] = rcdiff * step_mem->MRIC->W[k][stage][j]; + nstore += 1; + } else { + /* implicit only */ + cvals[nstore] = rcdiff * step_mem->MRIC->G[k][stage][j]; + nstore += 1; + } + } + } + + retval = N_VLinearCombination(nstore, cvals, Xvecs, + step_mem->stepper->forcing[k]); + if (retval != 0) return(ARK_VECTOROP_ERR); + } + +#ifdef SUNDIALS_DEBUG_PRINTVEC + for (k = 0; k < nmat; k++) { + STAN_SUNDIALS_PRINTF(" MRIStep forcing[%i]:\n", k); + N_VPrint(step_mem->stepper->forcing[k]); + } +#endif + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + Compute/return the 'effective' RK coefficients for a 'nofast' + stage. It is assumed that the array 'A' has already been + allocated to have length MRIC->stages. + ---------------------------------------------------------------*/ + +int mriStep_RKCoeffs(MRIStepCoupling MRIC, int is, int *stage_map, + realtype *Ae_row, realtype *Ai_row) +{ + int j, k; + realtype kconst; + + if (is < 1 || is >= MRIC->stages || !stage_map || !Ae_row || !Ai_row) + return ARK_INVALID_TABLE; + + /* initialize RK coefficient array */ + for (j = 0; j < MRIC->stages; j++) { + Ae_row[j] = ZERO; + Ai_row[j] = ZERO; + } + + /* compute RK coefficients */ + for (k = 0; k < MRIC->nmat; k++) { + kconst = ONE/(k+ONE); + if (MRIC->W) { + for (j = 0; j < is; j++) + if (stage_map[j] > -1) + Ae_row[stage_map[j]] += (MRIC->W[k][is][j] * kconst); + } + if (MRIC->G) { + for (j = 0; j <= is; j++) + if (stage_map[j] > -1) + Ai_row[stage_map[j]] += (MRIC->G[k][is][j] * kconst); + } + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_Predict + + This routine computes the prediction for a specific internal + stage solution, storing the result in yguess. The + prediction is done using the interpolation structure in + extrapolation mode, hence stages "far" from the previous time + interval are predicted using lower order polynomials than the + "nearby" stages. + ---------------------------------------------------------------*/ +int mriStep_Predict(ARKodeMem ark_mem, int istage, N_Vector yguess) +{ + int i, retval, jstage, nvec; + realtype tau; + realtype h; + ARKodeMRIStepMem step_mem; + realtype* cvals; + N_Vector* Xvecs; + + /* access ARKodeMRIStepMem structure */ + if (ark_mem->step_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::MRIStep", + "mriStep_Predict", MSG_MRISTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeMRIStepMem) ark_mem->step_mem; + + /* verify that interpolation structure is provided */ + if ((ark_mem->interp == NULL) && (step_mem->predictor > 0)) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::MRIStep", + "mriStep_Predict", + "Interpolation structure is NULL"); + return(ARK_MEM_NULL); + } + + /* local shortcuts for use with fused vector operations */ + cvals = step_mem->cvals; + Xvecs = step_mem->Xvecs; + + /* if the first step (or if resized), use initial condition as guess */ + if (ark_mem->initsetup) { + N_VScale(ONE, ark_mem->yn, yguess); + return(ARK_SUCCESS); + } + + /* set evaluation time tau as relative shift from previous successful time */ + tau = step_mem->MRIC->c[istage]*ark_mem->h/ark_mem->hold; + + /* use requested predictor formula */ + switch (step_mem->predictor) { + + case 1: + + /***** Interpolatory Predictor 1 -- all to max order *****/ + retval = arkPredict_MaximumOrder(ark_mem, tau, yguess); + if (retval != ARK_ILL_INPUT) return(retval); + break; + + case 2: + + /***** Interpolatory Predictor 2 -- decrease order w/ increasing level of extrapolation *****/ + retval = arkPredict_VariableOrder(ark_mem, tau, yguess); + if (retval != ARK_ILL_INPUT) return(retval); + break; + + case 3: + + /***** Cutoff predictor: max order interpolatory output for stages "close" + to previous step, first-order predictor for subsequent stages *****/ + retval = arkPredict_CutoffOrder(ark_mem, tau, yguess); + if (retval != ARK_ILL_INPUT) return(retval); + break; + + case 4: + + /***** Bootstrap predictor: if any previous stage in step has nonzero c_i, + construct a quadratic Hermite interpolant for prediction; otherwise + use the trivial predictor. The actual calculations are performed in + arkPredict_Bootstrap, but here we need to determine the appropriate + stage, c_j, to use. *****/ + + /* determine if any previous stages in step meet criteria */ + jstage = -1; + for (i=0; iMRIC->c[i] != ZERO) ? i : jstage; + + /* if using the trivial predictor, break */ + if (jstage == -1) break; + + /* find the "optimal" previous stage to use */ + for (i=0; iMRIC->c[i] > step_mem->MRIC->c[jstage]) && + (step_mem->MRIC->c[i] != ZERO) && step_mem->stage_map[i] > -1) + jstage = i; + + /* set stage time, stage RHS and interpolation values */ + h = ark_mem->h * step_mem->MRIC->c[jstage]; + tau = ark_mem->h * step_mem->MRIC->c[istage]; + nvec = 0; + if (step_mem->implicit_rhs) { /* Implicit piece */ + cvals[nvec] = ONE; + Xvecs[nvec] = step_mem->Fsi[step_mem->stage_map[jstage]]; + nvec += 1; + } + if (step_mem->explicit_rhs) { /* Explicit piece */ + cvals[nvec] = ONE; + Xvecs[nvec] = step_mem->Fse[step_mem->stage_map[jstage]]; + nvec += 1; + } + + /* call predictor routine */ + retval = arkPredict_Bootstrap(ark_mem, h, tau, nvec, cvals, Xvecs, yguess); + if (retval != ARK_ILL_INPUT) return(retval); + break; + + } + + /* if we made it here, use the trivial predictor (previous step solution) */ + N_VScale(ONE, ark_mem->yn, yguess); + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_StageSetup + + This routine sets up the stage data for computing the + solve-decoupled MRI stage residual, along with the step- and + method-related factors gamma, gammap and gamrat. + + At the ith stage, we compute the residual vector for + z=z_i=zp+zc: + r = z - z_{i-1} - h*sum_{j=0}^{i} A(i,j)*F(z_j) + r = (zp + zc) - z_{i-1} - h*sum_{j=0}^{i} A(i,j)*F(z_j) + r = (zc - gamma*F(z)) - data, + where data = (z_{i-1} - zp + h*sum_{j=0}^{i-1} A(i,j)*F(z_j)) + corresponds to existing information. This routine computes + this 'data' vector and stores in step_mem->sdata. + + Note: on input, this row A(i,:) is already stored in rkcoeffs. + ---------------------------------------------------------------*/ +int mriStep_StageSetup(ARKodeMem ark_mem) +{ + /* local data */ + ARKodeMRIStepMem step_mem; + int retval, i, j, nvec; + realtype* cvals; + N_Vector* Xvecs; + + /* access ARKodeMRIStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::MRIStep", + "mriStep_StageSetup", MSG_MRISTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeMRIStepMem) ark_mem->step_mem; + + /* Set shortcut to current stage index */ + i = step_mem->istage; + + /* local shortcuts for fused vector operations */ + cvals = step_mem->cvals; + Xvecs = step_mem->Xvecs; + + /* Update gamma (if the method contains an implicit component) */ + step_mem->gamma = ark_mem->h * step_mem->Ai_row[step_mem->stage_map[i]]; + + if (ark_mem->firststage) + step_mem->gammap = step_mem->gamma; + step_mem->gamrat = (ark_mem->firststage) ? + ONE : step_mem->gamma / step_mem->gammap; /* protect x/x != 1.0 */ + + /* set cvals and Xvecs for setting stage data */ + cvals[0] = ONE; + Xvecs[0] = ark_mem->ycur; + cvals[1] = -ONE; + Xvecs[1] = step_mem->zpred; + nvec = 2; + + for (j = 0; j < i; j++) { + if (step_mem->explicit_rhs && step_mem->stage_map[j] > -1) { + cvals[nvec] = ark_mem->h * step_mem->Ae_row[step_mem->stage_map[j]]; + Xvecs[nvec] = step_mem->Fse[step_mem->stage_map[j]]; + nvec += 1; + } + if (step_mem->implicit_rhs && step_mem->stage_map[j] > -1) { + cvals[nvec] = ark_mem->h * step_mem->Ai_row[step_mem->stage_map[j]]; + Xvecs[nvec] = step_mem->Fsi[step_mem->stage_map[j]]; + nvec += 1; + } + } + + /* call fused vector operation to do the work */ + retval = N_VLinearCombination(nvec, cvals, Xvecs, step_mem->sdata); + if (retval != 0) return(ARK_VECTOROP_ERR); + + /* return with success */ + return (ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + User-callable functions for a custom inner integrator + ---------------------------------------------------------------*/ + + +int MRIStepInnerStepper_Create(SUNContext sunctx, MRIStepInnerStepper *stepper) +{ + if (!sunctx) return ARK_ILL_INPUT; + + *stepper = NULL; + *stepper = (MRIStepInnerStepper) malloc(sizeof(**stepper)); + if (*stepper == NULL) { + arkProcessError(NULL, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepInnerStepper_Create", + MSG_ARK_ARKMEM_FAIL); + return(ARK_MEM_FAIL); + } + memset(*stepper, 0, sizeof(**stepper)); + + (*stepper)->ops = + (MRIStepInnerStepper_Ops) malloc(sizeof(*((*stepper)->ops))); + if ((*stepper)->ops == NULL) { + arkProcessError(NULL, ARK_MEM_FAIL, "ARKode::MRIStep", + "MRIStepInnerStepper_Create", + MSG_ARK_ARKMEM_FAIL); + free(*stepper); + return(ARK_MEM_FAIL); + } + memset((*stepper)->ops, 0, sizeof(*((*stepper)->ops))); + + /* initialize stepper data */ + (*stepper)->last_flag = ARK_SUCCESS; + (*stepper)->sunctx = sunctx; + + return(ARK_SUCCESS); +} + + +int MRIStepInnerStepper_Free(MRIStepInnerStepper *stepper) +{ + if (*stepper == NULL) return ARK_SUCCESS; + + /* free the inner forcing and fused op workspace vector */ + mriStepInnerStepper_FreeVecs(*stepper); + + /* free inner stepper mem */ + free(*stepper); + *stepper = NULL; + + return(ARK_SUCCESS); +} + + +int MRIStepInnerStepper_SetContent(MRIStepInnerStepper stepper, + void *content) +{ + if (stepper == NULL) + { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepInnerStepper_SetContent", + "Inner stepper memory is NULL"); + return ARK_ILL_INPUT; + } + stepper->content = content; + + return ARK_SUCCESS; +} + + +int MRIStepInnerStepper_GetContent(MRIStepInnerStepper stepper, + void **content) +{ + if (stepper == NULL) + { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepInnerStepper_GetContent", + "Inner stepper memory is NULL"); + return ARK_ILL_INPUT; + } + *content = stepper->content; + + return ARK_SUCCESS; +} + + +int MRIStepInnerStepper_SetEvolveFn(MRIStepInnerStepper stepper, + MRIStepInnerEvolveFn fn) +{ + if (stepper == NULL) + { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepInnerStepper_SetEvolveFn", + "Inner stepper memory is NULL"); + return ARK_ILL_INPUT; + } + + if (stepper->ops == NULL) + { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepInnerStepper_SetEvolveFn", + "Inner stepper operations structure is NULL"); + return ARK_ILL_INPUT; + } + + stepper->ops->evolve = fn; + + return ARK_SUCCESS; +} + + +int MRIStepInnerStepper_SetFullRhsFn(MRIStepInnerStepper stepper, + MRIStepInnerFullRhsFn fn) +{ + if (stepper == NULL) + { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepInnerStepper_SetFullRhsFn", + "Inner stepper memory is NULL"); + return ARK_ILL_INPUT; + } + + if (stepper->ops == NULL) + { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepInnerStepper_SetFullRhsFn", + "Inner stepper operations structure is NULL"); + return ARK_ILL_INPUT; + } + + stepper->ops->fullrhs = fn; + + return ARK_SUCCESS; +} + + +int MRIStepInnerStepper_SetResetFn(MRIStepInnerStepper stepper, + MRIStepInnerResetFn fn) +{ + if (stepper == NULL) + { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepInnerStepper_SetResetFn", + "Inner stepper memory is NULL"); + return ARK_ILL_INPUT; + } + + if (stepper->ops == NULL) + { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepInnerStepper_SetResetFn", + "Inner stepper operations structure is NULL"); + return ARK_ILL_INPUT; + } + + stepper->ops->reset = fn; + + return ARK_SUCCESS; +} + + +int MRIStepInnerStepper_AddForcing(MRIStepInnerStepper stepper, + realtype t, N_Vector f) +{ + realtype tau, taui; + int i; + + if (stepper == NULL) + { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepInnerStepper_AddForcing", + "Inner stepper memory is NULL"); + return ARK_ILL_INPUT; + } + + /* always append the constant forcing term */ + stepper->vals[0] = ONE; + stepper->vecs[0] = f; + + /* compute normalized time tau and initialize tau^i */ + tau = (t - stepper->tshift) / (stepper->tscale); + taui = ONE; + + for (i = 0; i < stepper->nforcing; i++) { + stepper->vals[i+1] = taui; + stepper->vecs[i+1] = stepper->forcing[i]; + taui *= tau; + } + + N_VLinearCombination(stepper->nforcing + 1, + stepper->vals, + stepper->vecs, + f); + + return ARK_SUCCESS; +} + + +int MRIStepInnerStepper_GetForcingData(MRIStepInnerStepper stepper, + realtype *tshift, realtype *tscale, + N_Vector **forcing, int *nforcing) +{ + if (stepper == NULL) + { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepInnerStepper_GetForcingData", + "Inner stepper memory is NULL"); + return ARK_ILL_INPUT; + } + + *tshift = stepper->tshift; + *tscale = stepper->tscale; + *forcing = stepper->forcing; + *nforcing = stepper->nforcing; + + return ARK_SUCCESS; +} + + +/*--------------------------------------------------------------- + Internal inner integrator functions + ---------------------------------------------------------------*/ + + +/* Check for required operations */ +int mriStepInnerStepper_HasRequiredOps(MRIStepInnerStepper stepper) +{ + if (stepper == NULL) return ARK_ILL_INPUT; + if (stepper->ops == NULL) return ARK_ILL_INPUT; + + if (stepper->ops->evolve && stepper->ops->fullrhs) + return ARK_SUCCESS; + else + return ARK_ILL_INPUT; +} + + +/* Evolve the inner (fast) ODE */ +int mriStepInnerStepper_Evolve(MRIStepInnerStepper stepper, + realtype t0, realtype tout, N_Vector y) +{ + if (stepper == NULL) return ARK_ILL_INPUT; + if (stepper->ops == NULL) return ARK_ILL_INPUT; + if (stepper->ops->evolve == NULL) return ARK_ILL_INPUT; + + stepper->last_flag = stepper->ops->evolve(stepper, t0, tout, y); + return stepper->last_flag; +} + + +/* 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. */ +int mriStepInnerStepper_FullRhs(MRIStepInnerStepper stepper, + realtype t, N_Vector y, N_Vector f, + int mode) +{ + if (stepper == NULL) return ARK_ILL_INPUT; + if (stepper->ops == NULL) return ARK_ILL_INPUT; + if (stepper->ops->fullrhs == NULL) return ARK_ILL_INPUT; + + stepper->last_flag = stepper->ops->fullrhs(stepper, t, y, f, mode); + return stepper->last_flag; +} + + +/* Reset the inner (fast) stepper state */ +int mriStepInnerStepper_Reset(MRIStepInnerStepper stepper, + realtype tR, N_Vector yR) +{ + if (stepper == NULL) return ARK_ILL_INPUT; + if (stepper->ops == NULL) return ARK_ILL_INPUT; + + if (stepper->ops->reset) { + stepper->last_flag = stepper->ops->reset(stepper, tR, yR); + return stepper->last_flag; + } else { + /* assume stepper uses input state and does not need to be reset */ + return ARK_SUCCESS; + } +} + + +/* Allocate MRI forcing and fused op workspace vectors if necessary */ +int mriStepInnerStepper_AllocVecs(MRIStepInnerStepper stepper, int count, + N_Vector tmpl) +{ + sunindextype lrw1, liw1; + + if (stepper == NULL) return ARK_ILL_INPUT; + + /* Set space requirements for one N_Vector */ + if (tmpl->ops->nvspace) { + N_VSpace(tmpl, &lrw1, &liw1); + } else { + lrw1 = 0; + liw1 = 0; + } + stepper->lrw1 = lrw1; + stepper->liw1 = liw1; + + /* Set the number of forcing vectors and allocate vectors */ + stepper->nforcing = count; + + if (!arkAllocVecArray(count, + tmpl, &(stepper->forcing), + stepper->lrw1, &(stepper->lrw), + stepper->liw1, &(stepper->liw))) { + mriStepInnerStepper_FreeVecs(stepper); + return(ARK_MEM_FAIL); + } + + /* Allocate fused operation workspace arrays */ + if (stepper->vecs == NULL) { + stepper->vecs = (N_Vector *) calloc(count + 1, sizeof(N_Vector)); + if (stepper->vecs == NULL) { + mriStepInnerStepper_FreeVecs(stepper); + return(ARK_MEM_FAIL); + } + } + + if (stepper->vals == NULL) { + stepper->vals = (realtype *) calloc(count + 1, sizeof(realtype)); + if (stepper->vals == NULL) { + mriStepInnerStepper_FreeVecs(stepper); + return(ARK_MEM_FAIL); + } + } + + return(ARK_SUCCESS); +} + + +/* Resize MRI forcing and fused op workspace vectors if necessary */ +int mriStepInnerStepper_Resize(MRIStepInnerStepper stepper, + ARKVecResizeFn resize, void* resize_data, + sunindextype lrw_diff, sunindextype liw_diff, + N_Vector tmpl) +{ + int retval; + + if (stepper == NULL) return ARK_ILL_INPUT; + + retval = arkResizeVecArray(resize, resize_data, + stepper->nforcing, tmpl, &(stepper->forcing), + lrw_diff, &(stepper->lrw), + liw_diff, &(stepper->liw)); + if (retval != ARK_SUCCESS) return(ARK_MEM_FAIL); + + return(ARK_SUCCESS); +} + + +/* Free MRI forcing and fused op workspace vectors if necessary */ +int mriStepInnerStepper_FreeVecs(MRIStepInnerStepper stepper) +{ + if (stepper == NULL) return ARK_ILL_INPUT; + + arkFreeVecArray(stepper->nforcing, &(stepper->forcing), + stepper->lrw1, &(stepper->lrw), + stepper->liw1, &(stepper->liw)); + + if (stepper->vecs != NULL) { + free(stepper->vecs); + stepper->vecs = NULL; + } + + if (stepper->vals != NULL) { + free(stepper->vals); + stepper->vals = NULL; + } + + return(ARK_SUCCESS); +} + + +/* Print forcing vectors to output file */ +void mriStepInnerStepper_PrintMem(MRIStepInnerStepper stepper, + FILE* outfile) +{ +#ifdef SUNDIALS_DEBUG_PRINTVEC + int i; +#endif + if (stepper == NULL) return; + + /* output data from the inner stepper */ + STAN_SUNDIALS_FPRINTF(outfile,"MRIStepInnerStepper Mem:\n"); + STAN_SUNDIALS_FPRINTF(outfile,"MRIStepInnerStepper: inner_nforcing = %i\n", + stepper->nforcing); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + if (stepper->forcing != NULL) { + for (i = 0; i < stepper->nforcing; i++) { + STAN_SUNDIALS_FPRINTF(outfile,"MRIStep: inner_forcing[%i]:\n", i); + N_VPrintFile(stepper->forcing[i], outfile); + } + } +#endif + + return; +} + +/*=============================================================== + EOF + ===============================================================*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_mristep_impl.h b/lib/sundials_6.1.1/src/arkode/arkode_mristep_impl.h new file mode 100644 index 00000000000..4ab7921267f --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_mristep_impl.h @@ -0,0 +1,271 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * Implementation header file for ARKode's MRI time stepper module. + * ---------------------------------------------------------------------------*/ + +#ifndef _ARKODE_MRISTEP_IMPL_H +#define _ARKODE_MRISTEP_IMPL_H + +/* Public header file */ +#include "arkode/arkode_mristep.h" + +/* Private header files */ +#include "arkode_impl.h" +#include "arkode_ls_impl.h" +#include "arkode_mri_tables_impl.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* Stage type identifiers */ +#define MRISTAGE_ERK_FAST 0 +#define MRISTAGE_ERK_NOFAST 1 +#define MRISTAGE_DIRK_NOFAST 2 +#define MRISTAGE_DIRK_FAST 3 + +/* Implicit solver constants (duplicate from arkode_arkstep_impl.h) */ +#define MAXCOR 3 /* max number of nonlinear iterations */ +#define CRDOWN RCONST(0.3) /* constant to estimate the convergence + rate for the nonlinear equation */ +#define DGMAX RCONST(0.2) /* if |gamma/gammap-1| > DGMAX then call lsetup */ +#define RDIV RCONST(2.3) /* declare divergence if ratio del/delp > RDIV */ +#define MSBP 20 /* max no. of steps between lsetup calls */ +#define NLSCOEF RCONST(0.1) + +/*=============================================================== + MRI time step module data structure + ===============================================================*/ + +/*--------------------------------------------------------------- + The type ARKodeMRIStepMem is type pointer to struct + ARKodeMRIStepMemRec. This structure contains fields to + perform a MRI time step. + ---------------------------------------------------------------*/ +typedef struct ARKodeMRIStepMemRec { + + /* MRI problem specification */ + ARKRhsFn fse; /* y' = fse(t,y) + fsi(t,y) + ff(t,y) */ + ARKRhsFn fsi; + booleantype linear; /* SUNTRUE if fi is linear */ + booleantype linear_timedep; /* SUNTRUE if dfi/dy depends on t */ + booleantype explicit_rhs; /* SUNTRUE if fse is provided */ + booleantype implicit_rhs; /* SUNTRUE if fsi is provided */ + + /* Outer RK method storage and parameters */ + N_Vector *Fse; /* explicit RHS at each stage */ + N_Vector *Fsi; /* implicit RHS at each stage */ + MRIStepCoupling MRIC; /* slow->fast coupling table */ + int q; /* method order */ + int p; /* embedding order */ + int stages; /* total number of stages */ + int nstages_stored; /* total number of stage RHS vectors stored */ + int *stage_map; /* index map for storing stage RHS vectors */ + int *stagetypes; /* type flags for stages */ + realtype *Ae_row; /* equivalent explicit RK coeffs */ + realtype *Ai_row; /* equivalent implicit RK coeffs */ + + /* Algebraic solver data and parameters */ + N_Vector sdata; /* old stage data in residual */ + N_Vector zpred; /* predicted stage solution */ + N_Vector zcor; /* stage correction */ + int istage; /* current stage index */ + SUNNonlinearSolver NLS; /* generic SUNNonlinearSolver object */ + booleantype ownNLS; /* flag indicating ownership of NLS */ + ARKRhsFn nls_fsi; /* fsi(t,y) used in the nonlinear solver */ + realtype gamma; /* gamma = h * A(i,i) */ + realtype gammap; /* gamma at the last setup call */ + realtype gamrat; /* gamma / gammap */ + realtype dgmax; /* call lsetup if |gamma/gammap-1| >= dgmax */ + int predictor; /* implicit prediction method to use */ + realtype crdown; /* nonlinear conv rate estimation constant */ + realtype rdiv; /* nonlin divergence if del/delp > rdiv */ + realtype crate; /* estimated nonlin convergence rate */ + realtype delp; /* norm of previous nonlinear solver update */ + realtype eRNrm; /* estimated residual norm, used in nonlin + and linear solver convergence tests */ + realtype nlscoef; /* coefficient in nonlin. convergence test */ + + int msbp; /* positive => max # steps between lsetup + negative => call at each Newton iter */ + long int nstlp; /* step number of last setup call */ + + int maxcor; /* max num iterations for solving the + nonlinear equation */ + int convfail; /* NLS fail flag (for interface routines) */ + booleantype jcur; /* is Jacobian info for lin solver current? */ + ARKStagePredictFn stage_predict; /* User-supplied stage predictor */ + + /* Linear Solver Data */ + ARKLinsolInitFn linit; + ARKLinsolSetupFn lsetup; + ARKLinsolSolveFn lsolve; + ARKLinsolFreeFn lfree; + void *lmem; + + /* Inner stepper */ + MRIStepInnerStepper stepper; + + /* User-supplied pre and post inner evolve functions */ + MRIStepPreInnerFn pre_inner_evolve; + MRIStepPostInnerFn post_inner_evolve; + + /* Counters */ + long int nfse; /* num fse calls */ + long int nfsi; /* num fsi calls */ + long int nsetups; /* num linear solver setup calls */ + long int nls_iters; /* num nonlinear solver iters */ + int nfusedopvecs; /* length of cvals and Xvecs arrays */ + + /* Reusable arrays for fused vector operations */ + realtype* cvals; + N_Vector* Xvecs; + +} *ARKodeMRIStepMem; + + +/*=============================================================== + MRI innter time stepper data structure + ===============================================================*/ + +typedef struct _MRIStepInnerStepper_Ops *MRIStepInnerStepper_Ops; + +struct _MRIStepInnerStepper_Ops +{ + MRIStepInnerEvolveFn evolve; + MRIStepInnerFullRhsFn fullrhs; + MRIStepInnerResetFn reset; +}; + +struct _MRIStepInnerStepper +{ + /* stepper specific content and operations */ + void* content; + MRIStepInnerStepper_Ops ops; + + /* stepper context */ + SUNContext sunctx; + + /* base class data */ + N_Vector* forcing; /* array of forcing vectors */ + int nforcing; /* number of forcing vectors */ + int last_flag; /* last stepper return flag */ + realtype tshift; /* time normalization shift */ + realtype tscale; /* time normalization scaling */ + + /* fused op workspace */ + realtype* vals; + N_Vector* vecs; + + /* Space requirements */ + sunindextype lrw1; /* no. of realtype words in 1 N_Vector */ + sunindextype liw1; /* no. of integer words in 1 N_Vector */ + long int lrw; /* no. of realtype words in ARKode work vectors */ + long int liw; /* no. of integer words in ARKode work vectors */ +}; + + +/*=============================================================== + MRI time step module private function prototypes + ===============================================================*/ + +/* Interface routines supplied to ARKode */ +int mriStep_AttachLinsol(void* arkode_mem, ARKLinsolInitFn linit, + ARKLinsolSetupFn lsetup, + ARKLinsolSolveFn lsolve, + ARKLinsolFreeFn lfree, + SUNLinearSolver_Type lsolve_type, + void *lmem); +void mriStep_DisableLSetup(void* arkode_mem); +int mriStep_Init(void* arkode_mem, int init_type); +void* mriStep_GetLmem(void* arkode_mem); +ARKRhsFn mriStep_GetImplicitRHS(void* arkode_mem); +int mriStep_GetGammas(void* arkode_mem, realtype *gamma, + realtype *gamrat, booleantype **jcur, + booleantype *dgamma_fail); +int mriStep_FullRHS(void* arkode_mem, realtype t, + N_Vector y, N_Vector f, int mode); +int mriStep_TakeStep(void* arkode_mem, realtype *dsmPtr, int *nflagPtr); + +/* Internal utility routines */ +int mriStep_AccessStepMem(void* arkode_mem, const char *fname, + ARKodeMem *ark_mem, ARKodeMRIStepMem *step_mem); +booleantype mriStep_CheckNVector(N_Vector tmpl); +int mriStep_SetCoupling(ARKodeMem ark_mem); +int mriStep_CheckCoupling(ARKodeMem ark_mem); +int mriStep_StageERKFast(ARKodeMem ark_mem, ARKodeMRIStepMem step_mem, + int is); +int mriStep_StageERKNoFast(ARKodeMem ark_mem, ARKodeMRIStepMem step_mem, + int is); +int mriStep_StageDIRKFast(ARKodeMem ark_mem, ARKodeMRIStepMem step_mem, + int is, int *nflagPtr); +int mriStep_StageDIRKNoFast(ARKodeMem ark_mem, ARKodeMRIStepMem step_mem, + int is, int *nflagPtr); +int mriStep_Predict(ARKodeMem ark_mem, int istage, N_Vector yguess); +int mriStep_StageSetup(ARKodeMem ark_mem); +int mriStep_NlsInit(ARKodeMem ark_mem); +int mriStep_Nls(ARKodeMem ark_mem, int nflag); + +/* private functions passed to nonlinear solver */ +int mriStep_NlsResidual(N_Vector yy, N_Vector res, void* arkode_mem); +int mriStep_NlsFPFunction(N_Vector yy, N_Vector res, void* arkode_mem); +int mriStep_NlsLSetup(booleantype jbad, booleantype* jcur, void* arkode_mem); +int mriStep_NlsLSolve(N_Vector delta, void* arkode_mem); +int mriStep_NlsConvTest(SUNNonlinearSolver NLS, N_Vector y, N_Vector del, + realtype tol, N_Vector ewt, void* arkode_mem); + + +/* Inner stepper functions */ +int mriStepInnerStepper_HasRequiredOps(MRIStepInnerStepper stepper); +int mriStepInnerStepper_Evolve(MRIStepInnerStepper stepper, + realtype t0, realtype tout, N_Vector y); +int mriStepInnerStepper_FullRhs(MRIStepInnerStepper stepper, + realtype t, N_Vector y, N_Vector f, + int mode); +int mriStepInnerStepper_Reset(MRIStepInnerStepper stepper, + realtype tR, N_Vector yR); +int mriStepInnerStepper_AllocVecs(MRIStepInnerStepper stepper, int count, + N_Vector tmpl); +int mriStepInnerStepper_Resize(MRIStepInnerStepper stepper, + ARKVecResizeFn resize, void* resize_data, + sunindextype lrw_diff, sunindextype liw_diff, + N_Vector tmpl); +int mriStepInnerStepper_FreeVecs(MRIStepInnerStepper stepper); +void mriStepInnerStepper_PrintMem(MRIStepInnerStepper stepper, + FILE* outfile); + +/* Compute forcing for inner stepper */ +int mriStep_ComputeInnerForcing(ARKodeMRIStepMem step_mem, int stage, + realtype cdiff); + +/* Return effective RK coefficients (nofast stage) */ +int mriStep_RKCoeffs(MRIStepCoupling MRIC, int is, int *stage_map, + realtype *Ae_row, realtype *Ai_row); + +/*=============================================================== + Reusable MRIStep Error Messages + ===============================================================*/ + +/* Initialization and I/O error messages */ +#define MSG_MRISTEP_NO_MEM "Time step module memory is NULL." +#define MSG_NLS_INIT_FAIL "The nonlinear solver's init routine failed." +#define MSG_MRISTEP_NO_COUPLING "The MRIStepCoupling is NULL." + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/src/arkode/arkode_mristep_io.c b/lib/sundials_6.1.1/src/arkode/arkode_mristep_io.c new file mode 100644 index 00000000000..5404a293d5e --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_mristep_io.c @@ -0,0 +1,934 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * Daniel R. Reynolds @ SMU + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * ----------------------------------------------------------------------------- + * This is the implementation file for the optional input and output functions + * for the ARKode MRIStep time stepper module. + * ---------------------------------------------------------------------------*/ + +#include +#include + +#include "arkode_mristep_impl.h" +#include +#include + + +/*=============================================================== + MRIStep Optional input functions (wrappers for generic ARKode + utility routines). All are documented in arkode_io.c. + ===============================================================*/ +int MRIStepSetDenseOrder(void *arkode_mem, int dord) { + return(MRIStepSetInterpolantDegree(arkode_mem, dord)); } +int MRIStepSetInterpolantDegree(void *arkode_mem, int degree) { + if (degree < 0) degree = ARK_INTERP_MAX_DEGREE; + return(arkSetInterpolantDegree(arkode_mem, degree)); } +int MRIStepSetInterpolantType(void *arkode_mem, int itype) { + return(arkSetInterpolantType(arkode_mem, itype)); } +int MRIStepSetErrHandlerFn(void *arkode_mem, ARKErrHandlerFn ehfun, + void *eh_data) { + return(arkSetErrHandlerFn(arkode_mem, ehfun, eh_data)); } +int MRIStepSetErrFile(void *arkode_mem, FILE *errfp) { + return(arkSetErrFile(arkode_mem, errfp)); } +int MRIStepSetDiagnostics(void *arkode_mem, FILE *diagfp) { + return(arkSetDiagnostics(arkode_mem, diagfp)); } +int MRIStepSetMaxNumSteps(void *arkode_mem, long int mxsteps) { + return(arkSetMaxNumSteps(arkode_mem, mxsteps)); } +int MRIStepSetMaxHnilWarns(void *arkode_mem, int mxhnil) { + return(arkSetMaxHnilWarns(arkode_mem, mxhnil)); } +int MRIStepSetStopTime(void *arkode_mem, realtype tstop) { + return(arkSetStopTime(arkode_mem, tstop)); } +int MRIStepSetRootDirection(void *arkode_mem, int *rootdir) { + return(arkSetRootDirection(arkode_mem, rootdir)); } +int MRIStepSetNoInactiveRootWarn(void *arkode_mem) { + return(arkSetNoInactiveRootWarn(arkode_mem)); } +int MRIStepSetPostprocessStepFn(void *arkode_mem, + ARKPostProcessFn ProcessStep) { + return(arkSetPostprocessStepFn(arkode_mem, ProcessStep)); } +int MRIStepSetPostprocessStageFn(void *arkode_mem, + ARKPostProcessFn ProcessStage) { + return(arkSetPostprocessStageFn(arkode_mem, ProcessStage)); } + + +/*--------------------------------------------------------------- + These wrappers for ARKLs module 'set' routines all are + documented in arkode_mristep.h. + ---------------------------------------------------------------*/ +int MRIStepSetLinearSolver(void *arkode_mem, SUNLinearSolver LS, + SUNMatrix A) { + return(arkLSSetLinearSolver(arkode_mem, LS, A)); } +int MRIStepSetJacFn(void *arkode_mem, ARKLsJacFn jac) { + return(arkLSSetJacFn(arkode_mem, jac)); } +int MRIStepSetJacEvalFrequency(void *arkode_mem, long int msbj) { + return(arkLSSetJacEvalFrequency(arkode_mem, msbj)); } +int MRIStepSetLinearSolutionScaling(void *arkode_mem, booleantype onoff) { + return(arkLSSetLinearSolutionScaling(arkode_mem, onoff)); } +int MRIStepSetEpsLin(void *arkode_mem, realtype eplifac) { + return(arkLSSetEpsLin(arkode_mem, eplifac)); } +int MRIStepSetLSNormFactor(void *arkode_mem, realtype nrmfac) { + return(arkLSSetNormFactor(arkode_mem, nrmfac)); } +int MRIStepSetPreconditioner(void *arkode_mem, ARKLsPrecSetupFn psetup, + ARKLsPrecSolveFn psolve) { + return(arkLSSetPreconditioner(arkode_mem, psetup, psolve)); } +int MRIStepSetJacTimes(void *arkode_mem, ARKLsJacTimesSetupFn jtsetup, + ARKLsJacTimesVecFn jtimes) { + return(arkLSSetJacTimes(arkode_mem, jtsetup, jtimes)); } +int MRIStepSetJacTimesRhsFn(void *arkode_mem, ARKRhsFn jtimesRhsFn) { + return(arkLSSetJacTimesRhsFn(arkode_mem, jtimesRhsFn)); } +int MRIStepSetLinSysFn(void *arkode_mem, ARKLsLinSysFn linsys) { + return(arkLSSetLinSysFn(arkode_mem, linsys)); } + + +/*=============================================================== + MRIStep Optional output functions (wrappers for generic ARKode + utility routines). All are documented in arkode_io.c. + ===============================================================*/ +int MRIStepGetNumSteps(void *arkode_mem, long int *nssteps) { + return(arkGetNumSteps(arkode_mem, nssteps)); } +int MRIStepGetLastStep(void *arkode_mem, realtype *hlast) { + return(arkGetLastStep(arkode_mem, hlast)); } +int MRIStepGetCurrentTime(void *arkode_mem, realtype *tcur) { + return(arkGetCurrentTime(arkode_mem, tcur)); } +int MRIStepGetCurrentState(void *arkode_mem, N_Vector *state) { + return(arkGetCurrentState(arkode_mem, state)); } +int MRIStepGetTolScaleFactor(void *arkode_mem, realtype *tolsfact) { + return(arkGetTolScaleFactor(arkode_mem, tolsfact)); } +int MRIStepGetErrWeights(void *arkode_mem, N_Vector eweight) { + return(arkGetErrWeights(arkode_mem, eweight)); } +int MRIStepGetNumGEvals(void *arkode_mem, long int *ngevals) { + return(arkGetNumGEvals(arkode_mem, ngevals)); } +int MRIStepGetRootInfo(void *arkode_mem, int *rootsfound) { + return(arkGetRootInfo(arkode_mem, rootsfound)); } +char *MRIStepGetReturnFlagName(long int flag) { + return(arkGetReturnFlagName(flag)); } + +/*--------------------------------------------------------------- + These wrappers for ARKLs module 'get' routines all are + documented in arkode_mristep.h. + ---------------------------------------------------------------*/ +int MRIStepGetLinWorkSpace(void *arkode_mem, long int *lenrwLS, long int *leniwLS) { + return(arkLSGetWorkSpace(arkode_mem, lenrwLS, leniwLS)); } +int MRIStepGetNumJacEvals(void *arkode_mem, long int *njevals) { + return(arkLSGetNumJacEvals(arkode_mem, njevals)); } +int MRIStepGetNumPrecEvals(void *arkode_mem, long int *npevals) { + return(arkLSGetNumPrecEvals(arkode_mem, npevals)); } +int MRIStepGetNumPrecSolves(void *arkode_mem, long int *npsolves) { + return(arkLSGetNumPrecSolves(arkode_mem, npsolves)); } +int MRIStepGetNumLinIters(void *arkode_mem, long int *nliters) { + return(arkLSGetNumLinIters(arkode_mem, nliters)); } +int MRIStepGetNumLinConvFails(void *arkode_mem, long int *nlcfails) { + return(arkLSGetNumConvFails(arkode_mem, nlcfails)); } +int MRIStepGetNumJTSetupEvals(void *arkode_mem, long int *njtsetups) { + return(arkLSGetNumJTSetupEvals(arkode_mem, njtsetups)); } +int MRIStepGetNumJtimesEvals(void *arkode_mem, long int *njvevals) { + return(arkLSGetNumJtimesEvals(arkode_mem, njvevals)); } +int MRIStepGetNumLinRhsEvals(void *arkode_mem, long int *nfevalsLS) { + return(arkLSGetNumRhsEvals(arkode_mem, nfevalsLS)); } +int MRIStepGetLastLinFlag(void *arkode_mem, long int *flag) { + return(arkLSGetLastFlag(arkode_mem, flag)); } +char *MRIStepGetLinReturnFlagName(long int flag) { + return(arkLSGetReturnFlagName(flag)); } + + + +/*=============================================================== + MRIStep optional input functions -- stepper-specific + ===============================================================*/ + +/*--------------------------------------------------------------- + MRIStepSetUserData: + + Wrapper for generic arkSetUserData and arkLSSetUserData + routines. + ---------------------------------------------------------------*/ +int MRIStepSetUserData(void *arkode_mem, void *user_data) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetUserData", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set user_data in ARKode mem */ + retval = arkSetUserData(arkode_mem, user_data); + if (retval != ARK_SUCCESS) return(retval); + + /* set user data in ARKodeLS mem */ + if (step_mem->lmem != NULL) { + retval = arkLSSetUserData(arkode_mem, user_data); + if (retval != ARKLS_SUCCESS) return(retval); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetDefaults: + + Resets all MRIStep optional inputs to their default values. + Does not change problem-defining function pointers or + user_data pointer. + ---------------------------------------------------------------*/ +int MRIStepSetDefaults(void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetDefaults", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Set default values for integrator optional inputs */ + step_mem->q = 3; /* method order */ + step_mem->p = 0; /* embedding order */ + step_mem->predictor = 0; /* trivial predictor */ + step_mem->linear = SUNFALSE; /* nonlinear problem */ + step_mem->linear_timedep = SUNTRUE; /* dfs/dy depends on t */ + step_mem->maxcor = MAXCOR; /* max nonlinear iters/stage */ + step_mem->nlscoef = NLSCOEF; /* nonlinear tolerance coefficient */ + step_mem->crdown = CRDOWN; /* nonlinear convergence estimate coeff. */ + step_mem->rdiv = RDIV; /* nonlinear divergence tolerance */ + step_mem->dgmax = DGMAX; /* max gamma change before recomputing J or P */ + step_mem->msbp = MSBP; /* max steps between updates to J or P */ + step_mem->stages = 0; /* no stages */ + step_mem->istage = 0; /* current stage index */ + step_mem->MRIC = NULL; /* no slow->fast coupling */ + step_mem->NLS = NULL; /* no nonlinear solver object */ + step_mem->jcur = SUNFALSE; + step_mem->convfail = ARK_NO_FAILURES; + step_mem->stage_predict = NULL; /* no user-supplied stage predictor */ + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetLinear: + + Specifies that the implicit slow function, fs(t,y), is linear + in y, and to tighten the linear solver tolerances while taking + only one Newton iteration. DO NOT USE IN COMBINATION WITH THE + FIXED-POINT SOLVER. Automatically tightens DeltaGammaMax + to ensure that step size changes cause Jacobian recomputation. + + The argument should be 1 or 0, where 1 indicates that the + Jacobian of fs with respect to y depends on time, and + 0 indicates that it is not time dependent. Alternately, when + using an iterative linear solver this flag denotes time + dependence of the preconditioner. + ---------------------------------------------------------------*/ +int MRIStepSetLinear(void *arkode_mem, int timedepend) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetLinear", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set parameters */ + step_mem->linear = SUNTRUE; + step_mem->linear_timedep = (timedepend == 1); + step_mem->dgmax = RCONST(100.0)*UNIT_ROUNDOFF; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetNonlinear: + + Specifies that the implicit slow function, fs(t,y), is + nonlinear in y. Used to undo a previous call to + MRIStepSetLinear. Automatically loosens DeltaGammaMax back to + default value. + ---------------------------------------------------------------*/ +int MRIStepSetNonlinear(void *arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetNonlinear", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set parameters */ + step_mem->linear = SUNFALSE; + step_mem->linear_timedep = SUNTRUE; + step_mem->dgmax = DGMAX; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetCoupling: + + Specifies to use a customized coupling structure for the slow + portion of the system. + ---------------------------------------------------------------*/ +int MRIStepSetCoupling(void *arkode_mem, MRIStepCoupling MRIC) +{ + int retval; + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + sunindextype Tlrw, Tliw; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetCoupling", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* check for illegal inputs */ + if (MRIC == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::MRIStep", + "MRIStepSetCoupling", MSG_MRISTEP_NO_COUPLING); + return(ARK_ILL_INPUT); + } + + /* clear any existing parameters and coupling structure */ + step_mem->stages = 0; + step_mem->q = 0; + step_mem->p = 0; + MRIStepCoupling_Space(step_mem->MRIC, &Tliw, &Tlrw); + MRIStepCoupling_Free(step_mem->MRIC); + step_mem->MRIC = NULL; + ark_mem->liw -= Tliw; + ark_mem->lrw -= Tlrw; + + /* set the relevant parameters */ + step_mem->stages = MRIC->stages; + step_mem->q = MRIC->q; + step_mem->p = MRIC->p; + + /* copy the coupling structure in step memory */ + step_mem->MRIC = MRIStepCoupling_Copy(MRIC); + if (step_mem->MRIC == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::MRIStep", + "MRIStepSetCoupling", MSG_MRISTEP_NO_COUPLING); + return(ARK_MEM_NULL); + } + MRIStepCoupling_Space(step_mem->MRIC, &Tliw, &Tlrw); + ark_mem->liw += Tliw; + ark_mem->lrw += Tlrw; + + return(ARK_SUCCESS); +} + +/*--------------------------------------------------------------- + MRIStepSetPreInnerFn: + + Sets the user-supplied function called BEFORE the inner evolve + ---------------------------------------------------------------*/ +int MRIStepSetPreInnerFn(void *arkode_mem, MRIStepPreInnerFn prefn) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetDefaults", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Set pre inner evolve function */ + step_mem->pre_inner_evolve = prefn; + + return(ARK_SUCCESS); +} + +/*--------------------------------------------------------------- + MRIStepSetPostInnerFn: + + Sets the user-supplied function called AFTER the inner evolve + ---------------------------------------------------------------*/ +int MRIStepSetPostInnerFn(void *arkode_mem, MRIStepPostInnerFn postfn) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetDefaults", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Set pre inner evolve function */ + step_mem->post_inner_evolve = postfn; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetFixedStep: + + Wrapper for generic arkSetFixedStep routine. Additionally + enforces current MRIStep constraint for fixed time-stepping. + ---------------------------------------------------------------*/ +int MRIStepSetFixedStep(void *arkode_mem, realtype hsfixed) +{ + ARKodeMem ark_mem; + if (arkode_mem==NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode::MRIStep", + "MRIStepSetFixedStep", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + + if (hsfixed == ZERO) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepSetFixedStep", + "MRIStep does not support adaptive steps at this time."); + return(ARK_ILL_INPUT); + } + + /* call generic routine for remaining work */ + return(arkSetFixedStep(ark_mem, hsfixed)); +} + + +/*--------------------------------------------------------------- + MRIStepSetNonlinCRDown: + + Specifies the user-provided nonlinear convergence constant + crdown. Legal values are strictly positive; illegal values + imply a reset to the default. + ---------------------------------------------------------------*/ +int MRIStepSetNonlinCRDown(void *arkode_mem, realtype crdown) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetNonlinCRDown", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if argument legal set it, otherwise set default */ + if (crdown <= ZERO) { + step_mem->crdown = CRDOWN; + } else { + step_mem->crdown = crdown; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetNonlinRDiv: + + Specifies the user-provided nonlinear convergence constant + rdiv. Legal values are strictly positive; illegal values + imply a reset to the default. + ---------------------------------------------------------------*/ +int MRIStepSetNonlinRDiv(void *arkode_mem, realtype rdiv) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetNonlinRDiv", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if argument legal set it, otherwise set default */ + if (rdiv <= ZERO) { + step_mem->rdiv = RDIV; + } else { + step_mem->rdiv = rdiv; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetDeltaGammaMax: + + Specifies the user-provided linear setup decision constant + dgmax. Legal values are strictly positive; illegal values imply + a reset to the default. + ---------------------------------------------------------------*/ +int MRIStepSetDeltaGammaMax(void *arkode_mem, realtype dgmax) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetDeltaGammaMax", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if argument legal set it, otherwise set default */ + if (dgmax <= ZERO) { + step_mem->dgmax = DGMAX; + } else { + step_mem->dgmax = dgmax; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetLSetupFrequency: + + Specifies the user-provided linear setup decision constant + msbp. Positive values give the frequency for calling lsetup; + negative values imply recomputation of lsetup at each nonlinear + solve; a zero value implies a reset to the default. + ---------------------------------------------------------------*/ +int MRIStepSetLSetupFrequency(void *arkode_mem, int msbp) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetLSetupFrequency", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if argument legal set it, otherwise set default */ + if (msbp == 0) { + step_mem->msbp = MSBP; + } else { + step_mem->msbp = msbp; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetPredictorMethod: + + Specifies the method to use for predicting implicit solutions. + Non-default choices are {1,2,3,4}, all others will use default + (trivial) predictor. + ---------------------------------------------------------------*/ +int MRIStepSetPredictorMethod(void *arkode_mem, int pred_method) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetPredictorMethod", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Deprecate option 4 */ + if (pred_method == 4) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", "MRIStepSetPredictorMethod", + "Predictor option 4 is deprecated, and will be removed in an upcoming release"); + } + + /* set parameter */ + step_mem->predictor = pred_method; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetMaxNonlinIters: + + Specifies the maximum number of nonlinear iterations during + one solve. A non-positive input implies a reset to the + default value. + ---------------------------------------------------------------*/ +int MRIStepSetMaxNonlinIters(void *arkode_mem, int maxcor) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetMaxNonlinIters", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Return error message if no NLS module is present */ + if (step_mem->NLS == NULL) { + arkProcessError(ark_mem, ARK_NLS_OP_ERR, "ARKode::MRIStep", + "MRIStepSetMaxNonlinIters", + "No SUNNonlinearSolver object is present"); + return(ARK_ILL_INPUT); + } + + /* argument <= 0 sets default, otherwise set input */ + if (maxcor <= 0) { + step_mem->maxcor = MAXCOR; + } else { + step_mem->maxcor = maxcor; + } + + /* send argument to NLS structure */ + retval = SUNNonlinSolSetMaxIters(step_mem->NLS, step_mem->maxcor); + if (retval != SUN_NLS_SUCCESS) { + arkProcessError(ark_mem, ARK_NLS_OP_ERR, "ARKode::MRIStep", + "MRIStepSetMaxNonlinIters", + "Error setting maxcor in SUNNonlinearSolver object"); + return(ARK_NLS_OP_ERR); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetNonlinConvCoef: + + Specifies the coefficient in the nonlinear solver convergence + test. A non-positive input implies a reset to the default value. + ---------------------------------------------------------------*/ +int MRIStepSetNonlinConvCoef(void *arkode_mem, realtype nlscoef) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetNonlinConvCoef", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* argument <= 0 sets default, otherwise set input */ + if (nlscoef <= ZERO) { + step_mem->nlscoef = NLSCOEF; + } else { + step_mem->nlscoef = nlscoef; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetStagePredictFn: Specifies a user-provided step + predictor function having type ARKStagePredictFn. A + NULL input function disables calls to this routine. + ---------------------------------------------------------------*/ +int MRIStepSetStagePredictFn(void *arkode_mem, + ARKStagePredictFn PredictStage) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure and set function pointer */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetStagePredictFn", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* override predictor method 5 if non-NULL PredictStage is supplied */ + if ((step_mem->predictor == 5) && (PredictStage != NULL)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepSetStagePredictFn", + "User-supplied predictor is incompatible with predictor method 5"); + return(ARK_ILL_INPUT); + } + + step_mem->stage_predict = PredictStage; + return(ARK_SUCCESS); +} + + +/*=============================================================== + MRIStep optional output functions -- stepper-specific + ===============================================================*/ + + +int MRIStepGetWorkSpace(void *arkode_mem, long int *lenrw, long int *leniw) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepGetLastInnerStepFlag", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Get ARKODE workspace */ + retval = arkGetWorkSpace(arkode_mem, lenrw, leniw); + if (retval) return retval; + + /* Get the inner stepper workspace */ + *lenrw += step_mem->stepper->lrw; + *leniw += step_mem->stepper->liw; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepGetLastInnerStepFlag: + + Returns the last return value from the inner stepper. + ---------------------------------------------------------------*/ +int MRIStepGetLastInnerStepFlag(void *arkode_mem, int *flag) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepGetLastInnerStepFlag", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* get the last return value from the inner stepper */ + *flag = step_mem->stepper->last_flag; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepGetCurrentGamma: Returns the current value of gamma + ---------------------------------------------------------------*/ +int MRIStepGetCurrentGamma(void *arkode_mem, realtype *gamma) +{ + int retval; + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + retval = mriStep_AccessStepMem(arkode_mem, NULL, &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + *gamma = step_mem->gamma; + return(retval); +} + + +/*--------------------------------------------------------------- + MRIStepGetNumRhsEvals: + + Returns the current number of calls to fse and fsi + ---------------------------------------------------------------*/ +int MRIStepGetNumRhsEvals(void *arkode_mem, long int *nfse_evals, long int *nfsi_evals) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepGetNumRhsEvals", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* get number of fse and fsi evals from step_mem */ + *nfse_evals = step_mem->nfse; + *nfsi_evals = step_mem->nfsi; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepGetNumLinSolvSetups: + + Returns the current number of calls to the lsetup routine + ---------------------------------------------------------------*/ +int MRIStepGetNumLinSolvSetups(void *arkode_mem, long int *nlinsetups) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepGetNumLinSolvSetups", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* get value from step_mem */ + *nlinsetups = step_mem->nsetups; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepGetNumNonlinSolvIters: + + Returns the current number of nonlinear solver iterations + ---------------------------------------------------------------*/ +int MRIStepGetNumNonlinSolvIters(void *arkode_mem, long int *nniters) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepGetNumNonlinSolvIters", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + *nniters = step_mem->nls_iters; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepGetNumNonlinSolvConvFails: + + Returns the current number of nonlinear solver convergence fails + ---------------------------------------------------------------*/ +int MRIStepGetNumNonlinSolvConvFails(void *arkode_mem, long int *nncfails) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepGetNumNonlinSolvConvFails", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* set output from step_mem */ + *nncfails = ark_mem->ncfn; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepGetNonlinSolvStats: + + Returns nonlinear solver statistics + ---------------------------------------------------------------*/ +int MRIStepGetNonlinSolvStats(void *arkode_mem, long int *nniters, + long int *nncfails) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepGetNonlinSolvStats", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + *nniters = step_mem->nls_iters; + *nncfails = ark_mem->ncfn; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepGetCurrentCoupling: + + Sets pointer to the slow coupling structure currently in use. + ---------------------------------------------------------------*/ +int MRIStepGetCurrentCoupling(void *arkode_mem, MRIStepCoupling *MRIC) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepGetCurrentCoupling", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* get coupling structure from step_mem */ + *MRIC = step_mem->MRIC; + + return(ARK_SUCCESS); +} + + +/*=============================================================== + MRIStep parameter output + ===============================================================*/ + +/*--------------------------------------------------------------- + MRIStepWriteParameters: + + Outputs all solver parameters to the provided file pointer. + ---------------------------------------------------------------*/ +int MRIStepWriteParameters(void *arkode_mem, FILE *fp) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepWriteParameters", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* output ARKode infrastructure parameters first */ + retval = arkWriteParameters(arkode_mem, fp); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::MRIStep", + "MRIStepWriteParameters", + "Error writing ARKode infrastructure parameters"); + return(retval); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepWriteCoupling: + + Outputs coupling structure to the provided file pointer. + ---------------------------------------------------------------*/ +int MRIStepWriteCoupling(void *arkode_mem, FILE *fp) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepWriteCoupling", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* check that coupling structure is non-NULL (otherwise report error) */ + if (step_mem->MRIC == NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::MRIStep", + "MRIStepWriteCoupling", "Coupling structure is NULL"); + return(ARK_MEM_NULL); + } + + /* write coupling structure to specified file */ + STAN_SUNDIALS_FPRINTF(fp, "\nMRIStep coupling structure:\n"); + MRIStepCoupling_Write(step_mem->MRIC, fp); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + EOF + ---------------------------------------------------------------*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_mristep_nls.c b/lib/sundials_6.1.1/src/arkode/arkode_mristep_nls.c new file mode 100644 index 00000000000..05254961ace --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_mristep_nls.c @@ -0,0 +1,603 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 interface between MRIStep and the + * SUNNonlinearSolver object + *--------------------------------------------------------------*/ + +#include +#include +#include + +#include "arkode_impl.h" +#include "arkode_mristep_impl.h" +#include + + +/*=============================================================== + Exported functions + ===============================================================*/ + +/*--------------------------------------------------------------- + MRIStepSetNonlinearSolver: + + This routine attaches a SUNNonlinearSolver object to the MRIStep + module. + ---------------------------------------------------------------*/ +int MRIStepSetNonlinearSolver(void *arkode_mem, SUNNonlinearSolver NLS) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetNonlinearSolver", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* Return immediately if NLS input is NULL */ + if (NLS == NULL) { + arkProcessError(NULL, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepSetNonlinearSolver", + "The NLS input must be non-NULL"); + return(ARK_ILL_INPUT); + } + + /* check for required nonlinear solver functions */ + if ( (NLS->ops->gettype == NULL) || + (NLS->ops->solve == NULL) || + (NLS->ops->setsysfn == NULL) ) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "MRIStepSetNonlinearSolver", + "NLS does not support required operations"); + return(ARK_ILL_INPUT); + } + + /* free any existing nonlinear solver */ + if ((step_mem->NLS != NULL) && (step_mem->ownNLS)) + retval = SUNNonlinSolFree(step_mem->NLS); + + /* set SUNNonlinearSolver pointer */ + step_mem->NLS = NLS; + step_mem->ownNLS = SUNFALSE; + + /* set the nonlinear residual/fixed-point function, based on solver type */ + if (SUNNonlinSolGetType(NLS) == SUNNONLINEARSOLVER_ROOTFIND) { + retval = SUNNonlinSolSetSysFn(step_mem->NLS, mriStep_NlsResidual); + } else if (SUNNonlinSolGetType(NLS) == SUNNONLINEARSOLVER_FIXEDPOINT) { + retval = SUNNonlinSolSetSysFn(step_mem->NLS, mriStep_NlsFPFunction); + } else { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepSetNonlinearSolver", + "Invalid nonlinear solver type"); + return(ARK_ILL_INPUT); + } + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepSetNonlinearSolver", + "Setting nonlinear system function failed"); + return(ARK_ILL_INPUT); + } + + /* set convergence test function */ + retval = SUNNonlinSolSetConvTestFn(step_mem->NLS, mriStep_NlsConvTest, + arkode_mem); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepSetNonlinearSolver", + "Setting convergence test function failed"); + return(ARK_ILL_INPUT); + } + + /* set default nonlinear iterations */ + retval = SUNNonlinSolSetMaxIters(step_mem->NLS, step_mem->maxcor); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepSetNonlinearSolver", + "Setting maximum number of nonlinear iterations failed"); + return(ARK_ILL_INPUT); + } + + /* set the nonlinear system RHS function */ + step_mem->nls_fsi = NULL; + + if (step_mem->implicit_rhs) { + if (!(step_mem->fsi)) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "MRIStepSetNonlinearSolver", + "The implicit slow ODE RHS function is NULL"); + return(ARK_ILL_INPUT); + } + step_mem->nls_fsi = step_mem->fsi; + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepSetNlsRhsFn: + + This routine sets an alternative user-supplied slow ODE + right-hand side function to use in the evaluation of nonlinear + system functions. + ---------------------------------------------------------------*/ +int MRIStepSetNlsRhsFn(void *arkode_mem, ARKRhsFn nls_fsi) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepSetNlsRhsFn", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + if (nls_fsi) + step_mem->nls_fsi = nls_fsi; + else + step_mem->nls_fsi = step_mem->fsi; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + MRIStepGetNonlinearSystemData: + + This routine provides access to the relevant data needed to + compute the nonlinear system function. + ---------------------------------------------------------------*/ +int MRIStepGetNonlinearSystemData(void *arkode_mem, realtype *tcur, + N_Vector *zpred, N_Vector *z, + N_Vector *F, realtype *gamma, + N_Vector *sdata, void **user_data) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "MRIStepGetNonlinearSystemData", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + *tcur = ark_mem->tcur; + *zpred = step_mem->zpred; + *z = ark_mem->ycur; + *F = step_mem->Fsi[step_mem->stage_map[step_mem->istage]]; + *gamma = step_mem->gamma; + *sdata = step_mem->sdata; + *user_data = ark_mem->user_data; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + Utility routines called by MRIStep + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + mriStep_NlsInit: + + This routine attaches the linear solver 'setup' and 'solve' + routines to the nonlinear solver object, and then initializes + the nonlinear solver object itself. This should only be + called at the start of a simulation, after a re-init, or after + a re-size. + ---------------------------------------------------------------*/ +int mriStep_NlsInit(ARKodeMem ark_mem) +{ + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::MRIStep", + "mriStep_NlsInit", MSG_MRISTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeMRIStepMem) ark_mem->step_mem; + + /* reset counters */ + step_mem->nls_iters = 0; + + /* set the linear solver setup wrapper function */ + if (step_mem->lsetup) + retval = SUNNonlinSolSetLSetupFn(step_mem->NLS, mriStep_NlsLSetup); + else + retval = SUNNonlinSolSetLSetupFn(step_mem->NLS, NULL); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "mriStep_NlsInit", + "Setting the linear solver setup function failed"); + return(ARK_NLS_INIT_FAIL); + } + + /* set the linear solver solve wrapper function */ + if (step_mem->lsolve) + retval = SUNNonlinSolSetLSolveFn(step_mem->NLS, mriStep_NlsLSolve); + else + retval = SUNNonlinSolSetLSolveFn(step_mem->NLS, NULL); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "mriStep_NlsInit", + "Setting linear solver solve function failed"); + return(ARK_NLS_INIT_FAIL); + } + + /* initialize nonlinear solver */ + retval = SUNNonlinSolInitialize(step_mem->NLS); + if (retval != ARK_SUCCESS) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode::MRIStep", + "mriStep_NlsInit", MSG_NLS_INIT_FAIL); + return(ARK_NLS_INIT_FAIL); + } + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_Nls + + This routine attempts to solve the nonlinear system associated + with a single solve-decoupled implicit stage. It calls the + supplied SUNNonlinearSolver object to perform the solve. + + Upon entry, the predicted solution is held in step_mem->zpred, + which is never changed throughout this routine. If an initial + attempt at solving the nonlinear system fails (e.g. due to a + stale Jacobian), this allows for new attempts at the solution. + + Upon a successful solve, the solution is held in ark_mem->ycur. + ---------------------------------------------------------------*/ +int mriStep_Nls(ARKodeMem ark_mem, int nflag) +{ + ARKodeMRIStepMem step_mem; + booleantype callLSetup; + long int nls_iters_inc; + int retval; + + /* access ARKodeMRIStepMem structure */ + if (ark_mem->step_mem==NULL) { + arkProcessError(ark_mem, ARK_MEM_NULL, "ARKode::MRIStep", + "mriStep_Nls", MSG_MRISTEP_NO_MEM); + return(ARK_MEM_NULL); + } + step_mem = (ARKodeMRIStepMem) ark_mem->step_mem; + + /* If a linear solver 'setup' is supplied, set various flags for + determining whether it should be called */ + if (step_mem->lsetup) { + + /* Set interface 'convfail' flag for use inside lsetup */ + if (step_mem->linear) { + step_mem->convfail = (nflag == FIRST_CALL) ? ARK_NO_FAILURES : ARK_FAIL_OTHER; + } else { + step_mem->convfail = ((nflag == FIRST_CALL) || (nflag == PREV_ERR_FAIL)) ? + ARK_NO_FAILURES : ARK_FAIL_OTHER; + } + + /* Decide whether to recommend call to lsetup within nonlinear solver */ + callLSetup = (ark_mem->firststage) || (step_mem->msbp < 0) || + (SUNRabs(step_mem->gamrat-ONE) > step_mem->dgmax); + if (step_mem->linear) { /* linearly-implicit problem */ + callLSetup = callLSetup || (step_mem->linear_timedep); + } else { /* nonlinearly-implicit problem */ + callLSetup = callLSetup || + (nflag == PREV_CONV_FAIL) || (nflag == PREV_ERR_FAIL) || + (ark_mem->nst >= step_mem->nstlp + abs(step_mem->msbp)); + } + } else { + step_mem->crate = ONE; + callLSetup = SUNFALSE; + } + + /* set a zero guess for correction */ + N_VConst(ZERO, step_mem->zcor); + + /* Reset the stored residual norm (for iterative linear solvers) */ + step_mem->eRNrm = RCONST(0.1) * step_mem->nlscoef; + + /* solve the nonlinear system for the actual correction */ + retval = SUNNonlinSolSolve(step_mem->NLS, step_mem->zpred, step_mem->zcor, + ark_mem->ewt, step_mem->nlscoef, callLSetup, ark_mem); + +#ifdef SUNDIALS_DEBUG_PRINTVEC + STAN_SUNDIALS_PRINTF(" MRIStep nonlinear solution zcor:\n"); + N_VPrint(step_mem->zcor); +#endif + + /* apply the correction to construct ycur */ + N_VLinearSum(ONE, step_mem->zcor, ONE, step_mem->zpred, ark_mem->ycur); + + /* increment counter */ + nls_iters_inc = 0; + (void) SUNNonlinSolGetNumIters(step_mem->NLS, &(nls_iters_inc)); + step_mem->nls_iters += nls_iters_inc; + + /* on successful solve, reset the jcur flag */ + if (retval == ARK_SUCCESS) step_mem->jcur = SUNFALSE; + + /* if convergence failure, return ARKode::CONV_FAIL */ + if (retval == SUN_NLS_CONV_RECVR) return(CONV_FAIL); + + return(retval); +} + + +/*--------------------------------------------------------------- + Interface routines supplied to the SUNNonlinearSolver module + ---------------------------------------------------------------*/ + +/*--------------------------------------------------------------- + mriStep_NlsLSetup: + + This routine wraps the ARKode linear solver interface 'setup' + routine for use by the nonlinear solver object. + ---------------------------------------------------------------*/ +int mriStep_NlsLSetup(booleantype jbad, booleantype* jcur, void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_NlsLSetup", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* update convfail based on jbad flag */ + if (jbad) step_mem->convfail = ARK_FAIL_BAD_J; + + /* Use ARKode's tempv1, tempv2 and tempv3 as + temporary vectors for the linear solver setup routine */ + step_mem->nsetups++; + retval = step_mem->lsetup(ark_mem, step_mem->convfail, ark_mem->tcur, + ark_mem->ycur, + step_mem->Fsi[step_mem->stage_map[step_mem->istage]], + &(step_mem->jcur), ark_mem->tempv1, + ark_mem->tempv2, ark_mem->tempv3); + + /* update Jacobian status */ + *jcur = step_mem->jcur; + + /* update flags and 'gamma' values for last lsetup call */ + ark_mem->firststage = SUNFALSE; + step_mem->gamrat = step_mem->crate = ONE; + step_mem->gammap = step_mem->gamma; + step_mem->nstlp = ark_mem->nst; + + if (retval < 0) return(ARK_LSETUP_FAIL); + if (retval > 0) return(CONV_FAIL); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_NlsLSolve: + + This routine wraps the ARKode linear solver interface 'solve' + routine for use by the nonlinear solver object. + ---------------------------------------------------------------*/ +int mriStep_NlsLSolve(N_Vector b, void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval, nonlin_iter; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_NlsLSolve", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* retrieve nonlinear solver iteration from module */ + retval = SUNNonlinSolGetCurIter(step_mem->NLS, &nonlin_iter); + if (retval != SUN_NLS_SUCCESS) + return(ARK_NLS_OP_ERR); + + /* call linear solver interface, and handle return value */ + retval = step_mem->lsolve(ark_mem, b, ark_mem->tcur, + ark_mem->ycur, + step_mem->Fsi[step_mem->stage_map[step_mem->istage]], + step_mem->eRNrm, nonlin_iter); + + if (retval < 0) return(ARK_LSOLVE_FAIL); + if (retval > 0) return(CONV_FAIL); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_NlsResidual: + + This routine evaluates the nonlinear residual for this + solve-decoupled implicit MRI stage. It assumes that any data + from previous time steps/stages is contained in step_mem, and + merely combines this old data with the current implicit ODE + RHS vector to compute the nonlinear residual r. + + At the ith stage, we compute the residual vector: + r = zc - gamma*Fsi(z) - sdata + where the current stage solution is z = zp + zc, + gamma = h*A(i,i), + zc is stored in the input, zcor, and + sdata is the old solution/stage data stored in step_mem->sdata. + Hence we really just compute: + z = zp + zc (stored in ark_mem->ycur) + Fsi(z) (stored step_mem->Fsi[step_mem->istage]) + r = zc - gamma*Fsi(z) - step_mem->sdata + ---------------------------------------------------------------*/ +int mriStep_NlsResidual(N_Vector zcor, N_Vector r, void* arkode_mem) +{ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + realtype c[3]; + N_Vector X[3]; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_NlsResidual", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* update 'ycur' value as stored predictor + current corrector */ + N_VLinearSum(ONE, step_mem->zpred, ONE, zcor, ark_mem->ycur); + + /* compute slow implicit RHS and save for later */ + retval = step_mem->nls_fsi(ark_mem->tcur, ark_mem->ycur, + step_mem->Fsi[step_mem->stage_map[step_mem->istage]], + ark_mem->user_data); + step_mem->nfsi++; + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + /* compute residual: zcor - gamma*Fsi - sdata */ + c[0] = ONE; + X[0] = zcor; + c[1] = -ONE; + X[1] = step_mem->sdata; + c[2] = -step_mem->gamma; + X[2] = step_mem->Fsi[step_mem->stage_map[step_mem->istage]]; + retval = N_VLinearCombination(3, c, X, r); + if (retval != 0) return(ARK_VECTOROP_ERR); + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_NlsFPFunction: + + This routine evaluates the fixed point iteration function for + this solve-decoupled implicit MRI stage. It assumes that any + data from previous time steps/stages is contained in step_mem, + and merely combines this old data with the current guess and + current slow RHS vector to compute the iteration function g. + + At the ith stage, the new stage solution z=(zc+zp) should solve: + zc = g(zc) := gamma*Fsi(z) + sdata + where + gamma = h*A(i,i), + zp is the predicted stage solution, + zc is stored in the input, zcor, and + sdata is the old solution/stage data stored in step_mem->sdata. + So we really just compute: + z = zp + zc (stored in ark_mem->ycur) + Fsi(z) (store in step_mem->Fsi[step_mem->istage]) + g = gamma*Fsi(z) + step_mem->sdata + ---------------------------------------------------------------*/ +int mriStep_NlsFPFunction(N_Vector zcor, N_Vector g, void* arkode_mem) +{ + /* temporary variables */ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + int retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_NlsFPFunction", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* update 'ycur' value as stored predictor + current corrector */ + N_VLinearSum(ONE, step_mem->zpred, ONE, zcor, ark_mem->ycur); + + /* compute slow implicit RHS and save for later */ + retval = step_mem->nls_fsi(ark_mem->tcur, ark_mem->ycur, + step_mem->Fsi[step_mem->stage_map[step_mem->istage]], + ark_mem->user_data); + step_mem->nfsi++; + if (retval < 0) return(ARK_RHSFUNC_FAIL); + if (retval > 0) return(RHSFUNC_RECVR); + + /* combine parts: g = gamma*Fsi(z) + sdata */ + N_VLinearSum(step_mem->gamma, + step_mem->Fsi[step_mem->stage_map[step_mem->istage]], + ONE, step_mem->sdata, g); + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + mriStep_NlsConvTest: + + This routine provides the nonlinear solver convergence test for + this solve-decoupled implicit MRI stage. We have two modes. + + Standard: + delnorm = ||del||_WRMS + if (m==0) crate = 1 + if (m>0) crate = max(crdown*crate, delnorm/delp) + dcon = min(crate, ONE) * del / nlscoef + if (dcon<=1) return convergence + if ((m >= 2) && (del > rdiv*delp)) return divergence + + Linearly-implicit mode: + if the user specifies that the problem is linearly + implicit, then we just declare 'success' no matter what + is provided. + ---------------------------------------------------------------*/ +int mriStep_NlsConvTest(SUNNonlinearSolver NLS, N_Vector y, N_Vector del, + realtype tol, N_Vector ewt, void* arkode_mem) +{ + /* temporary variables */ + ARKodeMem ark_mem; + ARKodeMRIStepMem step_mem; + realtype delnrm, dcon; + int m, retval; + + /* access ARKodeMRIStepMem structure */ + retval = mriStep_AccessStepMem(arkode_mem, "mriStep_NlsConvTest", + &ark_mem, &step_mem); + if (retval != ARK_SUCCESS) return(retval); + + /* if the problem is linearly implicit, just return success */ + if (step_mem->linear) + return(SUN_NLS_SUCCESS); + + /* compute the norm of the correction */ + delnrm = N_VWrmsNorm(del, ewt); + + /* get the current nonlinear solver iteration count */ + retval = SUNNonlinSolGetCurIter(NLS, &m); + if (retval != ARK_SUCCESS) return(ARK_MEM_NULL); + + /* update the stored estimate of the convergence rate (assumes linear convergence) */ + if (m > 0) + step_mem->crate = SUNMAX(step_mem->crdown*step_mem->crate, delnrm/step_mem->delp); + + /* compute our scaled error norm for testing convergence */ + dcon = SUNMIN(step_mem->crate, ONE) * delnrm / tol; + + /* check for convergence; if so return with success */ + if (dcon <= ONE) return(SUN_NLS_SUCCESS); + + /* check for divergence */ + if ((m >= 1) && (delnrm > step_mem->rdiv*step_mem->delp)) + return(SUN_NLS_CONV_RECVR); + + /* save norm of correction for next iteration */ + step_mem->delp = delnrm; + + /* return with flag that there is more work to do */ + return(SUN_NLS_CONTINUE); +} + + +/*=============================================================== + EOF + ===============================================================*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_root.c b/lib/sundials_6.1.1/src/arkode/arkode_root.c new file mode 100644 index 00000000000..4ebedd89b0b --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_root.c @@ -0,0 +1,783 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 root-finding (in + * time) utility. + *--------------------------------------------------------------*/ + +#include +#include +#include +#include + +#include "arkode_impl.h" +#include +#include + + +/*--------------------------------------------------------------- + arkRootInit: + + arkRootInit initializes a rootfinding problem to be solved + during the integration of the ODE system. It loads the root + function pointer and the number of root functions, and allocates + workspace memory. The return value is ARK_SUCCESS = 0 if no + errors occurred, or a negative value otherwise. + ---------------------------------------------------------------*/ +int arkRootInit(ARKodeMem ark_mem, int nrtfn, ARKRootFn g) +{ + int i, nrt; + + /* Check ark_mem pointer */ + if (ark_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkRootInit", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + nrt = (nrtfn < 0) ? 0 : nrtfn; + + /* If unallocated, allocate rootfinding structure, set defaults, update space */ + if (ark_mem->root_mem == NULL) { + ark_mem->root_mem = (ARKodeRootMem) malloc(sizeof(struct ARKodeRootMemRec)); + if (ark_mem->root_mem == NULL) { + arkProcessError(ark_mem, 0, "ARKode", "arkRootInit", + MSG_ARK_ARKMEM_FAIL); + return(ARK_MEM_FAIL); + } + ark_mem->root_mem->glo = NULL; + ark_mem->root_mem->ghi = NULL; + ark_mem->root_mem->grout = NULL; + ark_mem->root_mem->iroots = NULL; + ark_mem->root_mem->rootdir = NULL; + ark_mem->root_mem->gfun = NULL; + ark_mem->root_mem->nrtfn = 0; + ark_mem->root_mem->irfnd = 0; + ark_mem->root_mem->gactive = NULL; + ark_mem->root_mem->mxgnull = 1; + ark_mem->root_mem->root_data = ark_mem->user_data; + + ark_mem->lrw += ARK_ROOT_LRW; + ark_mem->liw += ARK_ROOT_LIW; + } + + /* If rerunning arkRootInit() with a different number of root + functions (changing number of gfun components), then free + currently held memory resources */ + if ((nrt != ark_mem->root_mem->nrtfn) && (ark_mem->root_mem->nrtfn > 0)) { + free(ark_mem->root_mem->glo); ark_mem->root_mem->glo = NULL; + free(ark_mem->root_mem->ghi); ark_mem->root_mem->ghi = NULL; + free(ark_mem->root_mem->grout); ark_mem->root_mem->grout = NULL; + free(ark_mem->root_mem->iroots); ark_mem->root_mem->iroots = NULL; + free(ark_mem->root_mem->rootdir); ark_mem->root_mem->rootdir = NULL; + free(ark_mem->root_mem->gactive); ark_mem->root_mem->gactive = NULL; + + ark_mem->lrw -= 3 * (ark_mem->root_mem->nrtfn); + ark_mem->liw -= 3 * (ark_mem->root_mem->nrtfn); + } + + /* If arkRootInit() was called with nrtfn == 0, then set + nrtfn to zero and gfun to NULL before returning */ + if (nrt == 0) { + ark_mem->root_mem->nrtfn = nrt; + ark_mem->root_mem->gfun = NULL; + return(ARK_SUCCESS); + } + + /* If rerunning arkRootInit() with the same number of root + functions (not changing number of gfun components), then + check if the root function argument has changed */ + /* If g != NULL then return as currently reserved memory + resources will suffice */ + if (nrt == ark_mem->root_mem->nrtfn) { + if (g != ark_mem->root_mem->gfun) { + if (g == NULL) { + free(ark_mem->root_mem->glo); ark_mem->root_mem->glo = NULL; + free(ark_mem->root_mem->ghi); ark_mem->root_mem->ghi = NULL; + free(ark_mem->root_mem->grout); ark_mem->root_mem->grout = NULL; + free(ark_mem->root_mem->iroots); ark_mem->root_mem->iroots = NULL; + free(ark_mem->root_mem->rootdir); ark_mem->root_mem->rootdir = NULL; + free(ark_mem->root_mem->gactive); ark_mem->root_mem->gactive = NULL; + + ark_mem->lrw -= 3*nrt; + ark_mem->liw -= 3*nrt; + + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkRootInit", MSG_ARK_NULL_G); + return(ARK_ILL_INPUT); + } + else { + ark_mem->root_mem->gfun = g; + return(ARK_SUCCESS); + } + } + else return(ARK_SUCCESS); + } + + /* Set variable values in ARKode memory block */ + ark_mem->root_mem->nrtfn = nrt; + if (g == NULL) { + arkProcessError(ark_mem, ARK_ILL_INPUT, "ARKode", + "arkRootInit", MSG_ARK_NULL_G); + return(ARK_ILL_INPUT); + } + else ark_mem->root_mem->gfun = g; + + /* Allocate necessary memory and return */ + ark_mem->root_mem->glo = NULL; + ark_mem->root_mem->glo = (realtype *) malloc(nrt*sizeof(realtype)); + if (ark_mem->root_mem->glo == NULL) { + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkRootInit", MSG_ARK_MEM_FAIL); + return(ARK_MEM_FAIL); + } + ark_mem->root_mem->ghi = NULL; + ark_mem->root_mem->ghi = (realtype *) malloc(nrt*sizeof(realtype)); + if (ark_mem->root_mem->ghi == NULL) { + free(ark_mem->root_mem->glo); ark_mem->root_mem->glo = NULL; + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkRootInit", MSG_ARK_MEM_FAIL); + return(ARK_MEM_FAIL); + } + ark_mem->root_mem->grout = NULL; + ark_mem->root_mem->grout = (realtype *) malloc(nrt*sizeof(realtype)); + if (ark_mem->root_mem->grout == NULL) { + free(ark_mem->root_mem->glo); ark_mem->root_mem->glo = NULL; + free(ark_mem->root_mem->ghi); ark_mem->root_mem->ghi = NULL; + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkRootInit", MSG_ARK_MEM_FAIL); + return(ARK_MEM_FAIL); + } + ark_mem->root_mem->iroots = NULL; + ark_mem->root_mem->iroots = (int *) malloc(nrt*sizeof(int)); + if (ark_mem->root_mem->iroots == NULL) { + free(ark_mem->root_mem->glo); ark_mem->root_mem->glo = NULL; + free(ark_mem->root_mem->ghi); ark_mem->root_mem->ghi = NULL; + free(ark_mem->root_mem->grout); ark_mem->root_mem->grout = NULL; + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkRootInit", MSG_ARK_MEM_FAIL); + return(ARK_MEM_FAIL); + } + ark_mem->root_mem->rootdir = NULL; + ark_mem->root_mem->rootdir = (int *) malloc(nrt*sizeof(int)); + if (ark_mem->root_mem->rootdir == NULL) { + free(ark_mem->root_mem->glo); ark_mem->root_mem->glo = NULL; + free(ark_mem->root_mem->ghi); ark_mem->root_mem->ghi = NULL; + free(ark_mem->root_mem->grout); ark_mem->root_mem->grout = NULL; + free(ark_mem->root_mem->iroots); ark_mem->root_mem->iroots = NULL; + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKode", + "arkRootInit", MSG_ARK_MEM_FAIL); + return(ARK_MEM_FAIL); + } + ark_mem->root_mem->gactive = NULL; + ark_mem->root_mem->gactive = (booleantype *) malloc(nrt*sizeof(booleantype)); + if (ark_mem->root_mem->gactive == NULL) { + free(ark_mem->root_mem->glo); ark_mem->root_mem->glo = NULL; + free(ark_mem->root_mem->ghi); ark_mem->root_mem->ghi = NULL; + free(ark_mem->root_mem->grout); ark_mem->root_mem->grout = NULL; + free(ark_mem->root_mem->iroots); ark_mem->root_mem->iroots = NULL; + free(ark_mem->root_mem->rootdir); ark_mem->root_mem->rootdir = NULL; + arkProcessError(ark_mem, ARK_MEM_FAIL, "ARKodeS", + "arkRootInit", MSG_ARK_MEM_FAIL); + return(ARK_MEM_FAIL); + } + + /* Set default values for rootdir (both directions) */ + for(i=0; iroot_mem->rootdir[i] = 0; + + /* Set default values for gactive (all active) */ + for(i=0; iroot_mem->gactive[i] = SUNTRUE; + + ark_mem->lrw += 3*nrt; + ark_mem->liw += 3*nrt; + + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkRootFree + + This routine frees all memory associated with ARKode's + rootfinding module. + ---------------------------------------------------------------*/ +int arkRootFree(void* arkode_mem) +{ + ARKodeMem ark_mem; + if (arkode_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkRootFree", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + if (ark_mem->root_mem != NULL) { + if (ark_mem->root_mem->nrtfn > 0) { + free(ark_mem->root_mem->glo); ark_mem->root_mem->glo = NULL; + free(ark_mem->root_mem->ghi); ark_mem->root_mem->ghi = NULL; + free(ark_mem->root_mem->grout); ark_mem->root_mem->grout = NULL; + free(ark_mem->root_mem->iroots); ark_mem->root_mem->iroots = NULL; + free(ark_mem->root_mem->rootdir); ark_mem->root_mem->rootdir = NULL; + free(ark_mem->root_mem->gactive); ark_mem->root_mem->gactive = NULL; + ark_mem->lrw -= 3*ark_mem->root_mem->nrtfn; + ark_mem->liw -= 3*ark_mem->root_mem->nrtfn; + } + free(ark_mem->root_mem); + ark_mem->lrw -= ARK_ROOT_LRW; + ark_mem->liw -= ARK_ROOT_LIW; + } + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkPrintRootMem + + This routine outputs the root-finding memory structure to a + specified file pointer. + ---------------------------------------------------------------*/ +int arkPrintRootMem(void* arkode_mem, FILE *outfile) +{ + int i; + ARKodeMem ark_mem; + if (arkode_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkPrintRootMem", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + if (ark_mem->root_mem != NULL) { + STAN_SUNDIALS_FPRINTF(outfile, "ark_nrtfn = %i\n", ark_mem->root_mem->nrtfn); + STAN_SUNDIALS_FPRINTF(outfile, "ark_nge = %li\n", ark_mem->root_mem->nge); + if (ark_mem->root_mem->iroots != NULL) + for (i=0; iroot_mem->nrtfn; i++) + STAN_SUNDIALS_FPRINTF(outfile, "ark_iroots[%i] = %i\n", i, ark_mem->root_mem->iroots[i]); + if (ark_mem->root_mem->rootdir != NULL) + for (i=0; iroot_mem->nrtfn; i++) + STAN_SUNDIALS_FPRINTF(outfile, "ark_rootdir[%i] = %i\n", i, ark_mem->root_mem->rootdir[i]); + STAN_SUNDIALS_FPRINTF(outfile, "ark_taskc = %i\n", ark_mem->root_mem->taskc); + STAN_SUNDIALS_FPRINTF(outfile, "ark_irfnd = %i\n", ark_mem->root_mem->irfnd); + STAN_SUNDIALS_FPRINTF(outfile, "ark_mxgnull = %i\n", ark_mem->root_mem->mxgnull); + if (ark_mem->root_mem->gactive != NULL) + for (i=0; iroot_mem->nrtfn; i++) + STAN_SUNDIALS_FPRINTF(outfile, "ark_gactive[%i] = %i\n", i, ark_mem->root_mem->gactive[i]); + STAN_SUNDIALS_FPRINTF(outfile, "ark_tlo = %"RSYM"\n", ark_mem->root_mem->tlo); + STAN_SUNDIALS_FPRINTF(outfile, "ark_thi = %"RSYM"\n", ark_mem->root_mem->thi); + STAN_SUNDIALS_FPRINTF(outfile, "ark_trout = %"RSYM"\n", ark_mem->root_mem->trout); + if (ark_mem->root_mem->glo != NULL) + for (i=0; iroot_mem->nrtfn; i++) + STAN_SUNDIALS_FPRINTF(outfile, "ark_glo[%i] = %"RSYM"\n", i, ark_mem->root_mem->glo[i]); + if (ark_mem->root_mem->ghi != NULL) + for (i=0; iroot_mem->nrtfn; i++) + STAN_SUNDIALS_FPRINTF(outfile, "ark_ghi[%i] = %"RSYM"\n", i, ark_mem->root_mem->ghi[i]); + if (ark_mem->root_mem->grout != NULL) + for (i=0; iroot_mem->nrtfn; i++) + STAN_SUNDIALS_FPRINTF(outfile, "ark_grout[%i] = %"RSYM"\n", i, ark_mem->root_mem->grout[i]); + STAN_SUNDIALS_FPRINTF(outfile, "ark_toutc = %"RSYM"\n", ark_mem->root_mem->toutc); + STAN_SUNDIALS_FPRINTF(outfile, "ark_ttol = %"RSYM"\n", ark_mem->root_mem->ttol); + } + return(ARK_SUCCESS); +} + + + +/*--------------------------------------------------------------- + arkRootCheck1 + + This routine completes the initialization of rootfinding memory + information, and checks whether g has a zero both at and very near + the initial point of the IVP. + + This routine returns an int equal to: + ARK_RTFUNC_FAIL < 0 if the g function failed, or + ARK_SUCCESS = 0 otherwise. + ---------------------------------------------------------------*/ +int arkRootCheck1(void* arkode_mem) +{ + int i, retval; + realtype smallh, hratio, tplus; + booleantype zroot; + ARKodeMem ark_mem; + ARKodeRootMem rootmem; + if (arkode_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkRootCheck1", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + rootmem = ark_mem->root_mem; + + for (i = 0; i < rootmem->nrtfn; i++) + rootmem->iroots[i] = 0; + rootmem->tlo = ark_mem->tcur; + rootmem->ttol = (SUNRabs(ark_mem->tcur) + + SUNRabs(ark_mem->h))*ark_mem->uround*HUND; + + /* Evaluate g at initial t and check for zero values. */ + retval = rootmem->gfun(rootmem->tlo, ark_mem->yn, + rootmem->glo, rootmem->root_data); + rootmem->nge = 1; + if (retval != 0) return(ARK_RTFUNC_FAIL); + + zroot = SUNFALSE; + for (i = 0; i < rootmem->nrtfn; i++) { + if (SUNRabs(rootmem->glo[i]) == ZERO) { + zroot = SUNTRUE; + rootmem->gactive[i] = SUNFALSE; + } + } + if (!zroot) return(ARK_SUCCESS); + + /* Some g_i is zero at t0; look at g at t0+(small increment). */ + hratio = SUNMAX(rootmem->ttol/SUNRabs(ark_mem->h), TENTH); + smallh = hratio*ark_mem->h; + tplus = rootmem->tlo + smallh; + N_VLinearSum(ONE, ark_mem->yn, smallh, ark_mem->fn, ark_mem->ycur); + retval = rootmem->gfun(tplus, ark_mem->ycur, rootmem->ghi, + rootmem->root_data); + rootmem->nge++; + if (retval != 0) return(ARK_RTFUNC_FAIL); + + /* We check now only the components of g which were exactly 0.0 at t0 + * to see if we can 'activate' them. */ + for (i = 0; i < rootmem->nrtfn; i++) { + if (!rootmem->gactive[i] && SUNRabs(rootmem->ghi[i]) != ZERO) { + rootmem->gactive[i] = SUNTRUE; + rootmem->glo[i] = rootmem->ghi[i]; + } + } + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkRootCheck2 + + This routine checks for exact zeros of g at the last root found, + if the last return was a root. It then checks for a close pair of + zeros (an error condition), and for a new root at a nearby point. + The array glo = g(tlo) at the left endpoint of the search interval + is adjusted if necessary to assure that all g_i are nonzero + there, before returning to do a root search in the interval. + + On entry, tlo = tretlast is the last value of tret returned by + ARKode. This may be the previous tn, the previous tout value, or + the last root location. + + This routine returns an int equal to: + ARK_RTFUNC_FAIL < 0 if the g function failed, or + CLOSERT = 3 if a close pair of zeros was found, or + RTFOUND = 1 if a new zero of g was found near tlo, or + ARK_SUCCESS = 0 otherwise. + ---------------------------------------------------------------*/ +int arkRootCheck2(void* arkode_mem) +{ + int i, retval; + realtype smallh, tplus; + booleantype zroot; + ARKodeMem ark_mem; + ARKodeRootMem rootmem; + if (arkode_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkRootCheck2", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + rootmem = ark_mem->root_mem; + + /* return if no roots in previous step */ + if (rootmem->irfnd == 0) return(ARK_SUCCESS); + + /* Set ark_ycur = y(tlo) */ + (void) arkGetDky(ark_mem, rootmem->tlo, 0, ark_mem->ycur); + + /* Evaluate root-finding function: glo = g(tlo, y(tlo)) */ + retval = rootmem->gfun(rootmem->tlo, ark_mem->ycur, + rootmem->glo, rootmem->root_data); + rootmem->nge++; + if (retval != 0) return(ARK_RTFUNC_FAIL); + + /* reset root-finding flags (overall, and for specific eqns) */ + zroot = SUNFALSE; + for (i = 0; i < rootmem->nrtfn; i++) + rootmem->iroots[i] = 0; + + /* for all active roots, check if glo_i == 0 to mark roots found */ + for (i = 0; i < rootmem->nrtfn; i++) { + if (!rootmem->gactive[i]) continue; + if (SUNRabs(rootmem->glo[i]) == ZERO) { + zroot = SUNTRUE; + rootmem->iroots[i] = 1; + } + } + if (!zroot) return(ARK_SUCCESS); /* return if no roots */ + + /* One or more g_i has a zero at tlo. Check g at tlo+smallh. */ + /* set time tolerance */ + rootmem->ttol = (SUNRabs(ark_mem->tcur) + + SUNRabs(ark_mem->h))*ark_mem->uround*HUND; + /* set tplus = tlo + smallh */ + smallh = (ark_mem->h > ZERO) ? rootmem->ttol : -rootmem->ttol; + tplus = rootmem->tlo + smallh; + /* update ark_ycur with small explicit Euler step (if tplus is past tn) */ + if ( (tplus - ark_mem->tcur)*ark_mem->h >= ZERO ) { + /* hratio = smallh/ark_mem->h; */ + N_VLinearSum(ONE, ark_mem->ycur, smallh, ark_mem->fn, ark_mem->ycur); + } else { + /* set ark_ycur = y(tplus) via interpolation */ + (void) arkGetDky(ark_mem, tplus, 0, ark_mem->ycur); + } + /* set ghi = g(tplus,y(tplus)) */ + retval = rootmem->gfun(tplus, ark_mem->ycur, rootmem->ghi, + rootmem->root_data); + rootmem->nge++; + if (retval != 0) return(ARK_RTFUNC_FAIL); + + /* Check for close roots (error return), for a new zero at tlo+smallh, + and for a g_i that changed from zero to nonzero. */ + zroot = SUNFALSE; + for (i = 0; i < rootmem->nrtfn; i++) { + if (!rootmem->gactive[i]) continue; + if (SUNRabs(rootmem->ghi[i]) == ZERO) { + if (rootmem->iroots[i] == 1) return(CLOSERT); + zroot = SUNTRUE; + rootmem->iroots[i] = 1; + } else { + if (rootmem->iroots[i] == 1) + rootmem->glo[i] = rootmem->ghi[i]; + } + } + if (zroot) return(RTFOUND); + return(ARK_SUCCESS); +} + + +/*--------------------------------------------------------------- + arkRootCheck3 + + This routine interfaces to arkRootfind to look for a root of g + between tlo and either tn or tout, whichever comes first. + Only roots beyond tlo in the direction of integration are sought. + + This routine returns an int equal to: + ARK_RTFUNC_FAIL < 0 if the g function failed, or + RTFOUND = 1 if a root of g was found, or + ARK_SUCCESS = 0 otherwise. + ---------------------------------------------------------------*/ +int arkRootCheck3(void* arkode_mem) +{ + int i, retval, ier; + ARKodeMem ark_mem; + ARKodeRootMem rootmem; + if (arkode_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkRootCheck3", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + rootmem = ark_mem->root_mem; + + /* Set thi = tn or tout, whichever comes first; set y = y(thi). */ + if (rootmem->taskc == ARK_ONE_STEP) { + rootmem->thi = ark_mem->tcur; + N_VScale(ONE, ark_mem->yn, ark_mem->ycur); + } + if (rootmem->taskc == ARK_NORMAL) { + if ( (rootmem->toutc - ark_mem->tcur)*ark_mem->h >= ZERO) { + rootmem->thi = ark_mem->tcur; + N_VScale(ONE, ark_mem->yn, ark_mem->ycur); + } else { + rootmem->thi = rootmem->toutc; + (void) arkGetDky(ark_mem, rootmem->thi, 0, ark_mem->ycur); + } + } + + /* Set rootmem->ghi = g(thi) and call arkRootfind to search (tlo,thi) for roots. */ + retval = rootmem->gfun(rootmem->thi, ark_mem->ycur, + rootmem->ghi, rootmem->root_data); + rootmem->nge++; + if (retval != 0) return(ARK_RTFUNC_FAIL); + + rootmem->ttol = (SUNRabs(ark_mem->tcur) + + SUNRabs(ark_mem->h))*ark_mem->uround*HUND; + ier = arkRootfind(ark_mem); + if (ier == ARK_RTFUNC_FAIL) return(ARK_RTFUNC_FAIL); + for(i=0; inrtfn; i++) { + if (!rootmem->gactive[i] && rootmem->grout[i] != ZERO) + rootmem->gactive[i] = SUNTRUE; + } + rootmem->tlo = rootmem->trout; + for (i = 0; i < rootmem->nrtfn; i++) + rootmem->glo[i] = rootmem->grout[i]; + + /* If no root found, return ARK_SUCCESS. */ + if (ier == ARK_SUCCESS) return(ARK_SUCCESS); + + /* If a root was found, interpolate to get y(trout) and return. */ + (void) arkGetDky(ark_mem, rootmem->trout, 0, ark_mem->ycur); + return(RTFOUND); +} + + +/*--------------------------------------------------------------- + arkRootfind + + This routine solves for a root of g(t) between tlo and thi, if + one exists. Only roots of odd multiplicity (i.e. with a change + of sign in one of the g_i), or exact zeros, are found. + Here the sign of tlo - thi is arbitrary, but if multiple roots + are found, the one closest to tlo is returned. + + The method used is the Illinois algorithm, a modified secant method. + Reference: Kathie L. Hiebert and Lawrence F. Shampine, Implicitly + Defined Output Points for Solutions of ODEs, Sandia National + Laboratory Report SAND80-0180, February 1980. + + This routine uses the following parameters for communication: + + nrtfn = number of functions g_i, or number of components of + the vector-valued function g(t). Input only. + + gfun = user-defined function for g(t). Its form is + (void) gfun(t, y, gt, user_data) + + rootdir = in array specifying the direction of zero-crossings. + If rootdir[i] > 0, search for roots of g_i only if + g_i is increasing; if rootdir[i] < 0, search for + roots of g_i only if g_i is decreasing; otherwise + always search for roots of g_i. + + gactive = array specifying whether a component of g should + or should not be monitored. gactive[i] is initially + set to SUNTRUE for all i=0,...,nrtfn-1, but it may be + reset to SUNFALSE if at the first step g[i] is 0.0 + both at the I.C. and at a small perturbation of them. + gactive[i] is then set back on SUNTRUE only after the + corresponding g function moves away from 0.0. + + nge = cumulative counter for gfun calls. + + ttol = a convergence tolerance for trout. Input only. + When a root at trout is found, it is located only to + within a tolerance of ttol. Typically, ttol should + be set to a value on the order of + 100 * UROUND * max (SUNRabs(tlo), SUNRabs(thi)) + where UROUND is the unit roundoff of the machine. + + tlo, thi = endpoints of the interval in which roots are sought. + On input, and must be distinct, but tlo - thi may + be of either sign. The direction of integration is + assumed to be from tlo to thi. On return, tlo and thi + are the endpoints of the final relevant interval. + + glo, ghi = arrays of length nrtfn containing the vectors g(tlo) + and g(thi) respectively. Input and output. On input, + none of the glo[i] should be zero. + + trout = root location, if a root was found, or thi if not. + Output only. If a root was found other than an exact + zero of g, trout is the endpoint thi of the final + interval bracketing the root, with size at most ttol. + + grout = array of length nrtfn containing g(trout) on return. + + iroots = int array of length nrtfn with root information. + Output only. If a root was found, iroots indicates + which components g_i have a root at trout. For + i = 0, ..., nrtfn-1, iroots[i] = 1 if g_i has a root + and g_i is increasing, iroots[i] = -1 if g_i has a + root and g_i is decreasing, and iroots[i] = 0 if g_i + has no roots or g_i varies in the direction opposite + to that indicated by rootdir[i]. + + This routine returns an int equal to: + ARK_RTFUNC_FAIL < 0 if the g function failed, or + RTFOUND = 1 if a root of g was found, or + ARK_SUCCESS = 0 otherwise. + ---------------------------------------------------------------*/ +int arkRootfind(void* arkode_mem) +{ + realtype alpha, tmid, gfrac, maxfrac, fracint, fracsub; + int i, retval, imax, side, sideprev; + booleantype zroot, sgnchg; + ARKodeMem ark_mem; + ARKodeRootMem rootmem; + if (arkode_mem == NULL) { + arkProcessError(NULL, ARK_MEM_NULL, "ARKode", + "arkRootfind", MSG_ARK_NO_MEM); + return(ARK_MEM_NULL); + } + ark_mem = (ARKodeMem) arkode_mem; + rootmem = ark_mem->root_mem; + + imax = 0; + + /* First check for change in sign in ghi or for a zero in ghi. */ + maxfrac = ZERO; + zroot = SUNFALSE; + sgnchg = SUNFALSE; + for (i = 0; i < rootmem->nrtfn; i++) { + if (!rootmem->gactive[i]) continue; + if (SUNRabs(rootmem->ghi[i]) == ZERO) { + if (rootmem->rootdir[i]*rootmem->glo[i] <= ZERO) { + zroot = SUNTRUE; + } + } else { + if ( (rootmem->glo[i]*rootmem->ghi[i] < ZERO) && + (rootmem->rootdir[i]*rootmem->glo[i] <= ZERO) ) { + gfrac = SUNRabs(rootmem->ghi[i]/(rootmem->ghi[i] - rootmem->glo[i])); + if (gfrac > maxfrac) { + sgnchg = SUNTRUE; + maxfrac = gfrac; + imax = i; + } + } + } + } + + /* If no sign change was found, reset trout and grout. Then return + ARK_SUCCESS if no zero was found, or set iroots and return RTFOUND. */ + if (!sgnchg) { + rootmem->trout = rootmem->thi; + for (i = 0; i < rootmem->nrtfn; i++) + rootmem->grout[i] = rootmem->ghi[i]; + if (!zroot) return(ARK_SUCCESS); + for (i = 0; i < rootmem->nrtfn; i++) { + rootmem->iroots[i] = 0; + if (!rootmem->gactive[i]) continue; + if (SUNRabs(rootmem->ghi[i]) == ZERO) + rootmem->iroots[i] = rootmem->glo[i] > 0 ? -1:1; + } + return(RTFOUND); + } + + /* Initialize alpha to avoid compiler warning */ + alpha = ONE; + + /* A sign change was found. Loop to locate nearest root. */ + side = 0; sideprev = -1; + for(;;) { /* Looping point */ + + /* If interval size is already less than tolerance ttol, break. */ + if (SUNRabs(rootmem->thi - rootmem->tlo) <= rootmem->ttol) break; + + /* Set weight alpha. + On the first two passes, set alpha = 1. Thereafter, reset alpha + according to the side (low vs high) of the subinterval in which + the sign change was found in the previous two passes. + If the sides were opposite, set alpha = 1. + If the sides were the same, then double alpha (if high side), + or halve alpha (if low side). + The next guess tmid is the secant method value if alpha = 1, but + is closer to tlo if alpha < 1, and closer to thi if alpha > 1. */ + if (sideprev == side) { + alpha = (side == 2) ? alpha*TWO : alpha*HALF; + } else { + alpha = ONE; + } + + /* Set next root approximation tmid and get g(tmid). + If tmid is too close to tlo or thi, adjust it inward, + by a fractional distance that is between 0.1 and 0.5. */ + tmid = rootmem->thi - (rootmem->thi - rootmem->tlo) * + rootmem->ghi[imax]/(rootmem->ghi[imax] - alpha*rootmem->glo[imax]); + if (SUNRabs(tmid - rootmem->tlo) < HALF*rootmem->ttol) { + fracint = SUNRabs(rootmem->thi - rootmem->tlo)/rootmem->ttol; + fracsub = (fracint > FIVE) ? TENTH : HALF/fracint; + tmid = rootmem->tlo + fracsub*(rootmem->thi - rootmem->tlo); + } + if (SUNRabs(rootmem->thi - tmid) < HALF*rootmem->ttol) { + fracint = SUNRabs(rootmem->thi - rootmem->tlo)/rootmem->ttol; + fracsub = (fracint > FIVE) ? TENTH : HALF/fracint; + tmid = rootmem->thi - fracsub*(rootmem->thi - rootmem->tlo); + } + + (void) arkGetDky(ark_mem, tmid, 0, ark_mem->ycur); + retval = rootmem->gfun(tmid, ark_mem->ycur, rootmem->grout, + rootmem->root_data); + rootmem->nge++; + if (retval != 0) return(ARK_RTFUNC_FAIL); + + /* Check to see in which subinterval g changes sign, and reset imax. + Set side = 1 if sign change is on low side, or 2 if on high side. */ + maxfrac = ZERO; + zroot = SUNFALSE; + sgnchg = SUNFALSE; + sideprev = side; + for (i = 0; i < rootmem->nrtfn; i++) { + if (!rootmem->gactive[i]) continue; + if (SUNRabs(rootmem->grout[i]) == ZERO) { + if (rootmem->rootdir[i]*rootmem->glo[i] <= ZERO) { + zroot = SUNTRUE; + } + } else { + if ( (rootmem->glo[i]*rootmem->grout[i] < ZERO) && + (rootmem->rootdir[i]*rootmem->glo[i] <= ZERO) ) { + gfrac = SUNRabs(rootmem->grout[i]/(rootmem->grout[i] - rootmem->glo[i])); + if (gfrac > maxfrac) { + sgnchg = SUNTRUE; + maxfrac = gfrac; + imax = i; + } + } + } + } + if (sgnchg) { + /* Sign change found in (tlo,tmid); replace thi with tmid. */ + rootmem->thi = tmid; + for (i = 0; i < rootmem->nrtfn; i++) + rootmem->ghi[i] = rootmem->grout[i]; + side = 1; + /* Stop at root thi if converged; otherwise loop. */ + if (SUNRabs(rootmem->thi - rootmem->tlo) <= rootmem->ttol) break; + continue; /* Return to looping point. */ + } + + if (zroot) { + /* No sign change in (tlo,tmid), but g = 0 at tmid; return root tmid. */ + rootmem->thi = tmid; + for (i = 0; i < rootmem->nrtfn; i++) + rootmem->ghi[i] = rootmem->grout[i]; + break; + } + + /* No sign change in (tlo,tmid), and no zero at tmid. + Sign change must be in (tmid,thi). Replace tlo with tmid. */ + rootmem->tlo = tmid; + for (i = 0; i < rootmem->nrtfn; i++) + rootmem->glo[i] = rootmem->grout[i]; + side = 2; + /* Stop at root thi if converged; otherwise loop back. */ + if (SUNRabs(rootmem->thi - rootmem->tlo) <= rootmem->ttol) + break; + + } /* End of root-search loop */ + + /* Reset trout and grout, set iroots, and return RTFOUND. */ + rootmem->trout = rootmem->thi; + for (i = 0; i < rootmem->nrtfn; i++) { + rootmem->grout[i] = rootmem->ghi[i]; + rootmem->iroots[i] = 0; + if (!rootmem->gactive[i]) continue; + if ( (SUNRabs(rootmem->ghi[i]) == ZERO) && + (rootmem->rootdir[i]*rootmem->glo[i] <= ZERO) ) + rootmem->iroots[i] = rootmem->glo[i] > 0 ? -1:1; + if ( (rootmem->glo[i]*rootmem->ghi[i] < ZERO) && + (rootmem->rootdir[i]*rootmem->glo[i] <= ZERO) ) + rootmem->iroots[i] = rootmem->glo[i] > 0 ? -1:1; + } + return(RTFOUND); +} + + +/*=============================================================== + EOF + ===============================================================*/ diff --git a/lib/sundials_6.1.1/src/arkode/arkode_root_impl.h b/lib/sundials_6.1.1/src/arkode/arkode_root_impl.h new file mode 100644 index 00000000000..e834fbe5c58 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/arkode_root_impl.h @@ -0,0 +1,91 @@ +/*--------------------------------------------------------------- + * Programmer(s): Daniel R. Reynolds @ SMU + *--------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + *--------------------------------------------------------------- + * Implementation header file for ARKode's root-finding (in time) + * utility. + *--------------------------------------------------------------*/ + +#ifndef _ARKODE_ROOT_IMPL_H +#define _ARKODE_ROOT_IMPL_H + +#include +#include + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/*=============================================================== + ARKode Root-finding constants + ===============================================================*/ + +#define ARK_ROOT_LRW 5 +#define ARK_ROOT_LIW 12 /* int, ptr, etc */ + +/* Numeric constants */ +#define HUND RCONST(100.0) /* real 100.0 */ + + +/*=============================================================== + ARKode Root-finding Data Structure + ===============================================================*/ + +/*--------------------------------------------------------------- + Types : struct ARKodeRootMemRec, ARKodeRootMem + ----------------------------------------------------------------- + The type ARKodeRootMem is type pointer to struct + ARKodeRootMemRec. This structure contains data pertaining to + the use of root-finding capabilities in ARKode. + ---------------------------------------------------------------*/ +typedef struct ARKodeRootMemRec { + + ARKRootFn gfun; /* function g for roots sought */ + int nrtfn; /* number of components of g */ + int *iroots; /* array for root information */ + int *rootdir; /* array specifying direction of zero-crossing */ + realtype tlo; /* nearest endpoint of interval in root search */ + realtype thi; /* farthest endpoint of interval in root search */ + realtype trout; /* t value returned by rootfinding routine */ + realtype *glo; /* saved array of g values at t = tlo */ + realtype *ghi; /* saved array of g values at t = thi */ + realtype *grout; /* array of g values at t = trout */ + realtype toutc; /* copy of tout (if NORMAL mode) */ + realtype ttol; /* tolerance on root location */ + int taskc; /* copy of parameter itask */ + int irfnd; /* flag showing whether last step had a root */ + long int nge; /* counter for g evaluations */ + booleantype *gactive; /* array with active/inactive event functions */ + int mxgnull; /* num. warning messages about possible g==0 */ + void *root_data; /* pointer to user_data */ + +} *ARKodeRootMem; + + +/*=============================================================== + ARKode Root-finding Routines +===============================================================*/ + +int arkRootFree(void* arkode_mem); +int arkPrintRootMem(void* arkode_mem, FILE *outfile); +int arkRootCheck1(void* arkode_mem); +int arkRootCheck2(void* arkode_mem); +int arkRootCheck3(void* arkode_mem); +int arkRootfind(void* arkode_mem); + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/sundials_6.1.1/src/arkode/fmod/farkode_arkstep_mod.c b/lib/sundials_6.1.1/src/arkode/fmod/farkode_arkstep_mod.c new file mode 100644 index 00000000000..fc7c0067f69 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/fmod/farkode_arkstep_mod.c @@ -0,0 +1,2320 @@ +/* ---------------------------------------------------------------------------- + * 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-2022, 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) \ + {STAN_SUNDIALS_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 "arkode/arkode_arkstep.h" + + +#include +#ifdef _MSC_VER +# ifndef strtoull +# define strtoull _strtoui64 +# endif +# ifndef strtoll +# define strtoll _strtoi64 +# endif +#endif + + +typedef struct { + void* data; + size_t size; +} SwigArrayWrapper; + + +SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() { + SwigArrayWrapper result; + result.data = NULL; + result.size = 0; + return result; +} + + +#include + +SWIGEXPORT void * _wrap_FARKStepCreate(ARKRhsFn farg1, ARKRhsFn farg2, double const *farg3, N_Vector farg4, void *farg5) { + void * fresult ; + ARKRhsFn arg1 = (ARKRhsFn) 0 ; + ARKRhsFn arg2 = (ARKRhsFn) 0 ; + realtype arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + SUNContext arg5 = (SUNContext) 0 ; + void *result = 0 ; + + arg1 = (ARKRhsFn)(farg1); + arg2 = (ARKRhsFn)(farg2); + arg3 = (realtype)(*farg3); + arg4 = (N_Vector)(farg4); + arg5 = (SUNContext)(farg5); + result = (void *)ARKStepCreate(arg1,arg2,arg3,arg4,arg5); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepResize(void *farg1, N_Vector farg2, double const *farg3, double const *farg4, ARKVecResizeFn farg5, void *farg6) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype arg3 ; + realtype arg4 ; + ARKVecResizeFn arg5 = (ARKVecResizeFn) 0 ; + void *arg6 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (realtype)(*farg3); + arg4 = (realtype)(*farg4); + arg5 = (ARKVecResizeFn)(farg5); + arg6 = (void *)(farg6); + result = (int)ARKStepResize(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepReInit(void *farg1, ARKRhsFn farg2, ARKRhsFn farg3, double const *farg4, N_Vector farg5) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKRhsFn arg2 = (ARKRhsFn) 0 ; + ARKRhsFn arg3 = (ARKRhsFn) 0 ; + realtype arg4 ; + N_Vector arg5 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKRhsFn)(farg2); + arg3 = (ARKRhsFn)(farg3); + arg4 = (realtype)(*farg4); + arg5 = (N_Vector)(farg5); + result = (int)ARKStepReInit(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepReset(void *farg1, double const *farg2, N_Vector farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + result = (int)ARKStepReset(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSStolerances(void *farg1, double const *farg2, double const *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + realtype arg3 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (realtype)(*farg3); + result = (int)ARKStepSStolerances(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSVtolerances(void *farg1, double const *farg2, N_Vector farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + result = (int)ARKStepSVtolerances(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepWFtolerances(void *farg1, ARKEwtFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKEwtFn arg2 = (ARKEwtFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKEwtFn)(farg2); + result = (int)ARKStepWFtolerances(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepResStolerance(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepResStolerance(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepResVtolerance(void *farg1, N_Vector farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)ARKStepResVtolerance(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepResFtolerance(void *farg1, ARKRwtFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKRwtFn arg2 = (ARKRwtFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKRwtFn)(farg2); + result = (int)ARKStepResFtolerance(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetLinearSolver(void *farg1, SUNLinearSolver farg2, SUNMatrix farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + SUNLinearSolver arg2 = (SUNLinearSolver) 0 ; + SUNMatrix arg3 = (SUNMatrix) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (SUNLinearSolver)(farg2); + arg3 = (SUNMatrix)(farg3); + result = (int)ARKStepSetLinearSolver(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMassLinearSolver(void *farg1, SUNLinearSolver farg2, SUNMatrix farg3, int const *farg4) { + int fresult ; + void *arg1 = (void *) 0 ; + SUNLinearSolver arg2 = (SUNLinearSolver) 0 ; + SUNMatrix arg3 = (SUNMatrix) 0 ; + int arg4 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (SUNLinearSolver)(farg2); + arg3 = (SUNMatrix)(farg3); + arg4 = (int)(*farg4); + result = (int)ARKStepSetMassLinearSolver(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepRootInit(void *farg1, int const *farg2, ARKRootFn farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + ARKRootFn arg3 = (ARKRootFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + arg3 = (ARKRootFn)(farg3); + result = (int)ARKStepRootInit(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetDefaults(void *farg1) { + int fresult ; + void *arg1 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + result = (int)ARKStepSetDefaults(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetOptimalParams(void *farg1) { + int fresult ; + void *arg1 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + result = (int)ARKStepSetOptimalParams(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetOrder(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetOrder(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetInterpolantType(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetInterpolantType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetInterpolantDegree(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetInterpolantDegree(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetDenseOrder(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetDenseOrder(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetNonlinearSolver(void *farg1, SUNNonlinearSolver farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + SUNNonlinearSolver arg2 = (SUNNonlinearSolver) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (SUNNonlinearSolver)(farg2); + result = (int)ARKStepSetNonlinearSolver(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetNlsRhsFn(void *farg1, ARKRhsFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKRhsFn arg2 = (ARKRhsFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKRhsFn)(farg2); + result = (int)ARKStepSetNlsRhsFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetLinear(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetLinear(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetNonlinear(void *farg1) { + int fresult ; + void *arg1 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + result = (int)ARKStepSetNonlinear(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetExplicit(void *farg1) { + int fresult ; + void *arg1 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + result = (int)ARKStepSetExplicit(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetImplicit(void *farg1) { + int fresult ; + void *arg1 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + result = (int)ARKStepSetImplicit(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetImEx(void *farg1) { + int fresult ; + void *arg1 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + result = (int)ARKStepSetImEx(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetTables(void *farg1, int const *farg2, int const *farg3, void *farg4, void *farg5) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int arg3 ; + ARKodeButcherTable arg4 = (ARKodeButcherTable) 0 ; + ARKodeButcherTable arg5 = (ARKodeButcherTable) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + arg4 = (ARKodeButcherTable)(farg4); + arg5 = (ARKodeButcherTable)(farg5); + result = (int)ARKStepSetTables(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetTableNum(void *farg1, int const *farg2, int const *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKODE_DIRKTableID arg2 ; + ARKODE_ERKTableID arg3 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKODE_DIRKTableID)(*farg2); + arg3 = (ARKODE_ERKTableID)(*farg3); + result = (int)ARKStepSetTableNum(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetCFLFraction(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetCFLFraction(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetSafetyFactor(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetSafetyFactor(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetErrorBias(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetErrorBias(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMaxGrowth(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetMaxGrowth(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMinReduction(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetMinReduction(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetFixedStepBounds(void *farg1, double const *farg2, double const *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + realtype arg3 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (realtype)(*farg3); + result = (int)ARKStepSetFixedStepBounds(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetAdaptivityMethod(void *farg1, int const *farg2, int const *farg3, int const *farg4, double *farg5) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int arg3 ; + int arg4 ; + realtype *arg5 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + arg4 = (int)(*farg4); + arg5 = (double *)(farg5); + result = (int)ARKStepSetAdaptivityMethod(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetAdaptivityFn(void *farg1, ARKAdaptFn farg2, void *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKAdaptFn arg2 = (ARKAdaptFn) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKAdaptFn)(farg2); + arg3 = (void *)(farg3); + result = (int)ARKStepSetAdaptivityFn(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMaxFirstGrowth(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetMaxFirstGrowth(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMaxEFailGrowth(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetMaxEFailGrowth(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetSmallNumEFails(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetSmallNumEFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMaxCFailGrowth(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetMaxCFailGrowth(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetNonlinCRDown(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetNonlinCRDown(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetNonlinRDiv(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetNonlinRDiv(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetDeltaGammaMax(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetDeltaGammaMax(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetLSetupFrequency(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetLSetupFrequency(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetPredictorMethod(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetPredictorMethod(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetStabilityFn(void *farg1, ARKExpStabFn farg2, void *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKExpStabFn arg2 = (ARKExpStabFn) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKExpStabFn)(farg2); + arg3 = (void *)(farg3); + result = (int)ARKStepSetStabilityFn(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMaxErrTestFails(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetMaxErrTestFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMaxNonlinIters(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetMaxNonlinIters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMaxConvFails(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetMaxConvFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetNonlinConvCoef(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetNonlinConvCoef(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetConstraints(void *farg1, N_Vector farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)ARKStepSetConstraints(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMaxNumSteps(void *farg1, long const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long)(*farg2); + result = (int)ARKStepSetMaxNumSteps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMaxHnilWarns(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetMaxHnilWarns(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetInitStep(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetInitStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMinStep(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetMinStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMaxStep(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetMaxStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetStopTime(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetStopTime(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetFixedStep(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetFixedStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMaxNumConstrFails(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetMaxNumConstrFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetRootDirection(void *farg1, int *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int *arg2 = (int *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int *)(farg2); + result = (int)ARKStepSetRootDirection(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetNoInactiveRootWarn(void *farg1) { + int fresult ; + void *arg1 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + result = (int)ARKStepSetNoInactiveRootWarn(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetErrHandlerFn(void *farg1, ARKErrHandlerFn farg2, void *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKErrHandlerFn arg2 = (ARKErrHandlerFn) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKErrHandlerFn)(farg2); + arg3 = (void *)(farg3); + result = (int)ARKStepSetErrHandlerFn(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetErrFile(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)ARKStepSetErrFile(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetUserData(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + void *arg2 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (void *)(farg2); + result = (int)ARKStepSetUserData(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetDiagnostics(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)ARKStepSetDiagnostics(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetPostprocessStepFn(void *farg1, ARKPostProcessFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKPostProcessFn arg2 = (ARKPostProcessFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKPostProcessFn)(farg2); + result = (int)ARKStepSetPostprocessStepFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetPostprocessStageFn(void *farg1, ARKPostProcessFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKPostProcessFn arg2 = (ARKPostProcessFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKPostProcessFn)(farg2); + result = (int)ARKStepSetPostprocessStageFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetStagePredictFn(void *farg1, ARKStagePredictFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKStagePredictFn arg2 = (ARKStagePredictFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKStagePredictFn)(farg2); + result = (int)ARKStepSetStagePredictFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetJacFn(void *farg1, ARKLsJacFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKLsJacFn arg2 = (ARKLsJacFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKLsJacFn)(farg2); + result = (int)ARKStepSetJacFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMassFn(void *farg1, ARKLsMassFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKLsMassFn arg2 = (ARKLsMassFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKLsMassFn)(farg2); + result = (int)ARKStepSetMassFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetJacEvalFrequency(void *farg1, long const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long)(*farg2); + result = (int)ARKStepSetJacEvalFrequency(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetLinearSolutionScaling(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ARKStepSetLinearSolutionScaling(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetEpsLin(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetEpsLin(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMassEpsLin(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetMassEpsLin(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetLSNormFactor(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetLSNormFactor(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMassLSNormFactor(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ARKStepSetMassLSNormFactor(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetPreconditioner(void *farg1, ARKLsPrecSetupFn farg2, ARKLsPrecSolveFn farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKLsPrecSetupFn arg2 = (ARKLsPrecSetupFn) 0 ; + ARKLsPrecSolveFn arg3 = (ARKLsPrecSolveFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKLsPrecSetupFn)(farg2); + arg3 = (ARKLsPrecSolveFn)(farg3); + result = (int)ARKStepSetPreconditioner(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMassPreconditioner(void *farg1, ARKLsMassPrecSetupFn farg2, ARKLsMassPrecSolveFn farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKLsMassPrecSetupFn arg2 = (ARKLsMassPrecSetupFn) 0 ; + ARKLsMassPrecSolveFn arg3 = (ARKLsMassPrecSolveFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKLsMassPrecSetupFn)(farg2); + arg3 = (ARKLsMassPrecSolveFn)(farg3); + result = (int)ARKStepSetMassPreconditioner(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetJacTimes(void *farg1, ARKLsJacTimesSetupFn farg2, ARKLsJacTimesVecFn farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKLsJacTimesSetupFn arg2 = (ARKLsJacTimesSetupFn) 0 ; + ARKLsJacTimesVecFn arg3 = (ARKLsJacTimesVecFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKLsJacTimesSetupFn)(farg2); + arg3 = (ARKLsJacTimesVecFn)(farg3); + result = (int)ARKStepSetJacTimes(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetJacTimesRhsFn(void *farg1, ARKRhsFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKRhsFn arg2 = (ARKRhsFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKRhsFn)(farg2); + result = (int)ARKStepSetJacTimesRhsFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetMassTimes(void *farg1, ARKLsMassTimesSetupFn farg2, ARKLsMassTimesVecFn farg3, void *farg4) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKLsMassTimesSetupFn arg2 = (ARKLsMassTimesSetupFn) 0 ; + ARKLsMassTimesVecFn arg3 = (ARKLsMassTimesVecFn) 0 ; + void *arg4 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKLsMassTimesSetupFn)(farg2); + arg3 = (ARKLsMassTimesVecFn)(farg3); + arg4 = (void *)(farg4); + result = (int)ARKStepSetMassTimes(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepSetLinSysFn(void *farg1, ARKLsLinSysFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKLsLinSysFn arg2 = (ARKLsLinSysFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKLsLinSysFn)(farg2); + result = (int)ARKStepSetLinSysFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepEvolve(void *farg1, double const *farg2, N_Vector farg3, double *farg4, int const *farg5) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + realtype *arg4 = (realtype *) 0 ; + int arg5 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (realtype *)(farg4); + arg5 = (int)(*farg5); + result = (int)ARKStepEvolve(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetDky(void *farg1, double const *farg2, int const *farg3, N_Vector farg4) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (int)(*farg3); + arg4 = (N_Vector)(farg4); + result = (int)ARKStepGetDky(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepComputeState(void *farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)ARKStepComputeState(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumExpSteps(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumExpSteps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumAccSteps(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumAccSteps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumStepAttempts(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumStepAttempts(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumRhsEvals(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)ARKStepGetNumRhsEvals(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumLinSolvSetups(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumLinSolvSetups(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumErrTestFails(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumErrTestFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetCurrentButcherTables(void *farg1, void *farg2, void *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKodeButcherTable *arg2 = (ARKodeButcherTable *) 0 ; + ARKodeButcherTable *arg3 = (ARKodeButcherTable *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKodeButcherTable *)(farg2); + arg3 = (ARKodeButcherTable *)(farg3); + result = (int)ARKStepGetCurrentButcherTables(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetEstLocalErrors(void *farg1, N_Vector farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)ARKStepGetEstLocalErrors(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetWorkSpace(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)ARKStepGetWorkSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumSteps(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumSteps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetActualInitStep(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)ARKStepGetActualInitStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetLastStep(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)ARKStepGetLastStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetCurrentStep(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)ARKStepGetCurrentStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetCurrentTime(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)ARKStepGetCurrentTime(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetCurrentState(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector *arg2 = (N_Vector *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector *)(farg2); + result = (int)ARKStepGetCurrentState(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetCurrentGamma(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)ARKStepGetCurrentGamma(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetCurrentMassMatrix(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + SUNMatrix *arg2 = (SUNMatrix *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (SUNMatrix *)(farg2); + result = (int)ARKStepGetCurrentMassMatrix(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetTolScaleFactor(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)ARKStepGetTolScaleFactor(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetErrWeights(void *farg1, N_Vector farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)ARKStepGetErrWeights(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetResWeights(void *farg1, N_Vector farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)ARKStepGetResWeights(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumGEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumGEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetRootInfo(void *farg1, int *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int *arg2 = (int *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int *)(farg2); + result = (int)ARKStepGetRootInfo(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumConstrFails(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumConstrFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SwigArrayWrapper _wrap_FARKStepGetReturnFlagName(long const *farg1) { + SwigArrayWrapper fresult ; + long arg1 ; + char *result = 0 ; + + arg1 = (long)(*farg1); + result = (char *)ARKStepGetReturnFlagName(arg1); + fresult.size = strlen((const char*)(result)); + fresult.data = (char *)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepWriteParameters(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)ARKStepWriteParameters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepWriteButcher(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)ARKStepWriteButcher(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetTimestepperStats(void *farg1, long *farg2, long *farg3, long *farg4, long *farg5, long *farg6, long *farg7, long *farg8) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + long *arg4 = (long *) 0 ; + long *arg5 = (long *) 0 ; + long *arg6 = (long *) 0 ; + long *arg7 = (long *) 0 ; + long *arg8 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + arg4 = (long *)(farg4); + arg5 = (long *)(farg5); + arg6 = (long *)(farg6); + arg7 = (long *)(farg7); + arg8 = (long *)(farg8); + result = (int)ARKStepGetTimestepperStats(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetStepStats(void *farg1, long *farg2, double *farg3, double *farg4, double *farg5, double *farg6) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + realtype *arg3 = (realtype *) 0 ; + realtype *arg4 = (realtype *) 0 ; + realtype *arg5 = (realtype *) 0 ; + realtype *arg6 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (realtype *)(farg3); + arg4 = (realtype *)(farg4); + arg5 = (realtype *)(farg5); + arg6 = (realtype *)(farg6); + result = (int)ARKStepGetStepStats(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNonlinearSystemData(void *farg1, double *farg2, void *farg3, void *farg4, void *farg5, double *farg6, void *farg7, void *farg8) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + N_Vector *arg4 = (N_Vector *) 0 ; + N_Vector *arg5 = (N_Vector *) 0 ; + realtype *arg6 = (realtype *) 0 ; + N_Vector *arg7 = (N_Vector *) 0 ; + void **arg8 = (void **) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (N_Vector *)(farg4); + arg5 = (N_Vector *)(farg5); + arg6 = (realtype *)(farg6); + arg7 = (N_Vector *)(farg7); + arg8 = (void **)(farg8); + result = (int)ARKStepGetNonlinearSystemData(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumNonlinSolvIters(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumNonlinSolvIters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumNonlinSolvConvFails(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumNonlinSolvConvFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNonlinSolvStats(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)ARKStepGetNonlinSolvStats(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetLinWorkSpace(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)ARKStepGetLinWorkSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumJacEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumJacEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumPrecEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumPrecEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumPrecSolves(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumPrecSolves(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumLinIters(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumLinIters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumLinConvFails(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumLinConvFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumJTSetupEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumJTSetupEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumJtimesEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumJtimesEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumLinRhsEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumLinRhsEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetLastLinFlag(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetLastLinFlag(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetMassWorkSpace(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)ARKStepGetMassWorkSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumMassSetups(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumMassSetups(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumMassMultSetups(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumMassMultSetups(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumMassMult(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumMassMult(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumMassSolves(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumMassSolves(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumMassPrecEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumMassPrecEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumMassPrecSolves(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumMassPrecSolves(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumMassIters(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumMassIters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumMassConvFails(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumMassConvFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetNumMTSetups(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetNumMTSetups(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKStepGetLastMassFlag(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKStepGetLastMassFlag(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SwigArrayWrapper _wrap_FARKStepGetLinReturnFlagName(long const *farg1) { + SwigArrayWrapper fresult ; + long arg1 ; + char *result = 0 ; + + arg1 = (long)(*farg1); + result = (char *)ARKStepGetLinReturnFlagName(arg1); + fresult.size = strlen((const char*)(result)); + fresult.data = (char *)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_FARKStepFree(void *farg1) { + void **arg1 = (void **) 0 ; + + arg1 = (void **)(farg1); + ARKStepFree(arg1); +} + + +SWIGEXPORT void _wrap_FARKStepPrintMem(void *farg1, void *farg2) { + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + ARKStepPrintMem(arg1,arg2); +} + + +SWIGEXPORT int _wrap_FARKStepCreateMRIStepInnerStepper(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + MRIStepInnerStepper *arg2 = (MRIStepInnerStepper *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (MRIStepInnerStepper *)(farg2); + result = (int)ARKStepCreateMRIStepInnerStepper(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + + diff --git a/lib/sundials_6.1.1/src/arkode/fmod/farkode_arkstep_mod.f90 b/lib/sundials_6.1.1/src/arkode/fmod/farkode_arkstep_mod.f90 new file mode 100644 index 00000000000..20dc6450fc0 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/fmod/farkode_arkstep_mod.f90 @@ -0,0 +1,3979 @@ +! 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-2022, 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 farkode_arkstep_mod + use, intrinsic :: ISO_C_BINDING + use farkode_mod + use fsundials_nvector_mod + use fsundials_context_mod + use fsundials_types_mod + use fsundials_matrix_mod + use fsundials_nvector_mod + use fsundials_context_mod + use fsundials_types_mod + use fsundials_linearsolver_mod + use fsundials_matrix_mod + use fsundials_nvector_mod + use fsundials_context_mod + use fsundials_types_mod + use fsundials_nonlinearsolver_mod + use fsundials_types_mod + implicit none + private + + ! DECLARATION CONSTRUCTS + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_ERK_2 = ARKODE_HEUN_EULER_2_1_2 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_ERK_3 = ARKODE_BOGACKI_SHAMPINE_4_2_3 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_ERK_4 = ARKODE_ZONNEVELD_5_3_4 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_ERK_5 = ARKODE_CASH_KARP_6_4_5 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_ERK_6 = ARKODE_VERNER_8_5_6 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_ERK_8 = ARKODE_FEHLBERG_13_7_8 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_DIRK_2 = ARKODE_SDIRK_2_1_2 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_DIRK_3 = ARKODE_ARK324L2SA_DIRK_4_2_3 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_DIRK_4 = ARKODE_SDIRK_5_3_4 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_DIRK_5 = ARKODE_ARK548L2SA_DIRK_8_4_5 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_ARK_ETABLE_3 = ARKODE_ARK324L2SA_ERK_4_2_3 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_ARK_ETABLE_4 = ARKODE_ARK436L2SA_ERK_6_3_4 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_ARK_ETABLE_5 = ARKODE_ARK548L2SA_ERK_8_4_5 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_ARK_ITABLE_3 = ARKODE_ARK324L2SA_DIRK_4_2_3 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_ARK_ITABLE_4 = ARKODE_ARK436L2SA_DIRK_6_3_4 + integer(C_INT), parameter, public :: ARKSTEP_DEFAULT_ARK_ITABLE_5 = ARKODE_ARK548L2SA_DIRK_8_4_5 + public :: FARKStepCreate + public :: FARKStepResize + public :: FARKStepReInit + public :: FARKStepReset + public :: FARKStepSStolerances + public :: FARKStepSVtolerances + public :: FARKStepWFtolerances + public :: FARKStepResStolerance + public :: FARKStepResVtolerance + public :: FARKStepResFtolerance + public :: FARKStepSetLinearSolver + public :: FARKStepSetMassLinearSolver + public :: FARKStepRootInit + public :: FARKStepSetDefaults + public :: FARKStepSetOptimalParams + public :: FARKStepSetOrder + public :: FARKStepSetInterpolantType + public :: FARKStepSetInterpolantDegree + public :: FARKStepSetDenseOrder + public :: FARKStepSetNonlinearSolver + public :: FARKStepSetNlsRhsFn + public :: FARKStepSetLinear + public :: FARKStepSetNonlinear + public :: FARKStepSetExplicit + public :: FARKStepSetImplicit + public :: FARKStepSetImEx + public :: FARKStepSetTables + public :: FARKStepSetTableNum + public :: FARKStepSetCFLFraction + public :: FARKStepSetSafetyFactor + public :: FARKStepSetErrorBias + public :: FARKStepSetMaxGrowth + public :: FARKStepSetMinReduction + public :: FARKStepSetFixedStepBounds + public :: FARKStepSetAdaptivityMethod + public :: FARKStepSetAdaptivityFn + public :: FARKStepSetMaxFirstGrowth + public :: FARKStepSetMaxEFailGrowth + public :: FARKStepSetSmallNumEFails + public :: FARKStepSetMaxCFailGrowth + public :: FARKStepSetNonlinCRDown + public :: FARKStepSetNonlinRDiv + public :: FARKStepSetDeltaGammaMax + public :: FARKStepSetLSetupFrequency + public :: FARKStepSetPredictorMethod + public :: FARKStepSetStabilityFn + public :: FARKStepSetMaxErrTestFails + public :: FARKStepSetMaxNonlinIters + public :: FARKStepSetMaxConvFails + public :: FARKStepSetNonlinConvCoef + public :: FARKStepSetConstraints + public :: FARKStepSetMaxNumSteps + public :: FARKStepSetMaxHnilWarns + public :: FARKStepSetInitStep + public :: FARKStepSetMinStep + public :: FARKStepSetMaxStep + public :: FARKStepSetStopTime + public :: FARKStepSetFixedStep + public :: FARKStepSetMaxNumConstrFails + public :: FARKStepSetRootDirection + public :: FARKStepSetNoInactiveRootWarn + public :: FARKStepSetErrHandlerFn + public :: FARKStepSetErrFile + public :: FARKStepSetUserData + public :: FARKStepSetDiagnostics + public :: FARKStepSetPostprocessStepFn + public :: FARKStepSetPostprocessStageFn + public :: FARKStepSetStagePredictFn + public :: FARKStepSetJacFn + public :: FARKStepSetMassFn + public :: FARKStepSetJacEvalFrequency + public :: FARKStepSetLinearSolutionScaling + public :: FARKStepSetEpsLin + public :: FARKStepSetMassEpsLin + public :: FARKStepSetLSNormFactor + public :: FARKStepSetMassLSNormFactor + public :: FARKStepSetPreconditioner + public :: FARKStepSetMassPreconditioner + public :: FARKStepSetJacTimes + public :: FARKStepSetJacTimesRhsFn + public :: FARKStepSetMassTimes + public :: FARKStepSetLinSysFn + public :: FARKStepEvolve + public :: FARKStepGetDky + public :: FARKStepComputeState + public :: FARKStepGetNumExpSteps + public :: FARKStepGetNumAccSteps + public :: FARKStepGetNumStepAttempts + public :: FARKStepGetNumRhsEvals + public :: FARKStepGetNumLinSolvSetups + public :: FARKStepGetNumErrTestFails + public :: FARKStepGetCurrentButcherTables + public :: FARKStepGetEstLocalErrors + public :: FARKStepGetWorkSpace + public :: FARKStepGetNumSteps + public :: FARKStepGetActualInitStep + public :: FARKStepGetLastStep + public :: FARKStepGetCurrentStep + public :: FARKStepGetCurrentTime + public :: FARKStepGetCurrentState + public :: FARKStepGetCurrentGamma + public :: FARKStepGetCurrentMassMatrix + public :: FARKStepGetTolScaleFactor + public :: FARKStepGetErrWeights + public :: FARKStepGetResWeights + public :: FARKStepGetNumGEvals + public :: FARKStepGetRootInfo + public :: FARKStepGetNumConstrFails + type, bind(C) :: SwigArrayWrapper + type(C_PTR), public :: data = C_NULL_PTR + integer(C_SIZE_T), public :: size = 0 + end type + public :: FARKStepGetReturnFlagName + public :: FARKStepWriteParameters + public :: FARKStepWriteButcher + public :: FARKStepGetTimestepperStats + public :: FARKStepGetStepStats + public :: FARKStepGetNonlinearSystemData + public :: FARKStepGetNumNonlinSolvIters + public :: FARKStepGetNumNonlinSolvConvFails + public :: FARKStepGetNonlinSolvStats + public :: FARKStepGetLinWorkSpace + public :: FARKStepGetNumJacEvals + public :: FARKStepGetNumPrecEvals + public :: FARKStepGetNumPrecSolves + public :: FARKStepGetNumLinIters + public :: FARKStepGetNumLinConvFails + public :: FARKStepGetNumJTSetupEvals + public :: FARKStepGetNumJtimesEvals + public :: FARKStepGetNumLinRhsEvals + public :: FARKStepGetLastLinFlag + public :: FARKStepGetMassWorkSpace + public :: FARKStepGetNumMassSetups + public :: FARKStepGetNumMassMultSetups + public :: FARKStepGetNumMassMult + public :: FARKStepGetNumMassSolves + public :: FARKStepGetNumMassPrecEvals + public :: FARKStepGetNumMassPrecSolves + public :: FARKStepGetNumMassIters + public :: FARKStepGetNumMassConvFails + public :: FARKStepGetNumMTSetups + public :: FARKStepGetLastMassFlag + public :: FARKStepGetLinReturnFlagName + public :: FARKStepFree + public :: FARKStepPrintMem + public :: FARKStepCreateMRIStepInnerStepper + +! WRAPPER DECLARATIONS +interface +function swigc_FARKStepCreate(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FARKStepCreate") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR) :: fresult +end function + +function swigc_FARKStepResize(farg1, farg2, farg3, farg4, farg5, farg6) & +bind(C, name="_wrap_FARKStepResize") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_FUNPTR), value :: farg5 +type(C_PTR), value :: farg6 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepReInit(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FARKStepReInit") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_FUNPTR), value :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepReset(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepReset") & +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_INT) :: fresult +end function + +function swigc_FARKStepSStolerances(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepSStolerances") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSVtolerances(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepSVtolerances") & +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_INT) :: fresult +end function + +function swigc_FARKStepWFtolerances(farg1, farg2) & +bind(C, name="_wrap_FARKStepWFtolerances") & +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_FARKStepResStolerance(farg1, farg2) & +bind(C, name="_wrap_FARKStepResStolerance") & +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_FARKStepResVtolerance(farg1, farg2) & +bind(C, name="_wrap_FARKStepResVtolerance") & +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_FARKStepResFtolerance(farg1, farg2) & +bind(C, name="_wrap_FARKStepResFtolerance") & +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_FARKStepSetLinearSolver(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepSetLinearSolver") & +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_FARKStepSetMassLinearSolver(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FARKStepSetMassLinearSolver") & +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), intent(in) :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepRootInit(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepRootInit") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +type(C_FUNPTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetDefaults(farg1) & +bind(C, name="_wrap_FARKStepSetDefaults") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetOptimalParams(farg1) & +bind(C, name="_wrap_FARKStepSetOptimalParams") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetOrder(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetOrder") & +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_FARKStepSetInterpolantType(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetInterpolantType") & +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_FARKStepSetInterpolantDegree(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetInterpolantDegree") & +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_FARKStepSetDenseOrder(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetDenseOrder") & +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_FARKStepSetNonlinearSolver(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetNonlinearSolver") & +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_FARKStepSetNlsRhsFn(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetNlsRhsFn") & +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_FARKStepSetLinear(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetLinear") & +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_FARKStepSetNonlinear(farg1) & +bind(C, name="_wrap_FARKStepSetNonlinear") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetExplicit(farg1) & +bind(C, name="_wrap_FARKStepSetExplicit") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetImplicit(farg1) & +bind(C, name="_wrap_FARKStepSetImplicit") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetImEx(farg1) & +bind(C, name="_wrap_FARKStepSetImEx") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetTables(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FARKStepSetTables") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT), intent(in) :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetTableNum(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepSetTableNum") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT), intent(in) :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetCFLFraction(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetCFLFraction") & +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_FARKStepSetSafetyFactor(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetSafetyFactor") & +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_FARKStepSetErrorBias(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetErrorBias") & +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_FARKStepSetMaxGrowth(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMaxGrowth") & +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_FARKStepSetMinReduction(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMinReduction") & +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_FARKStepSetFixedStepBounds(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepSetFixedStepBounds") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetAdaptivityMethod(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FARKStepSetAdaptivityMethod") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT), intent(in) :: farg3 +integer(C_INT), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetAdaptivityFn(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepSetAdaptivityFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetMaxFirstGrowth(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMaxFirstGrowth") & +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_FARKStepSetMaxEFailGrowth(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMaxEFailGrowth") & +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_FARKStepSetSmallNumEFails(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetSmallNumEFails") & +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_FARKStepSetMaxCFailGrowth(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMaxCFailGrowth") & +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_FARKStepSetNonlinCRDown(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetNonlinCRDown") & +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_FARKStepSetNonlinRDiv(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetNonlinRDiv") & +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_FARKStepSetDeltaGammaMax(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetDeltaGammaMax") & +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_FARKStepSetLSetupFrequency(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetLSetupFrequency") & +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_FARKStepSetPredictorMethod(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetPredictorMethod") & +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_FARKStepSetStabilityFn(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepSetStabilityFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetMaxErrTestFails(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMaxErrTestFails") & +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_FARKStepSetMaxNonlinIters(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMaxNonlinIters") & +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_FARKStepSetMaxConvFails(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMaxConvFails") & +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_FARKStepSetNonlinConvCoef(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetNonlinConvCoef") & +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_FARKStepSetConstraints(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetConstraints") & +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_FARKStepSetMaxNumSteps(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMaxNumSteps") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_LONG), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetMaxHnilWarns(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMaxHnilWarns") & +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_FARKStepSetInitStep(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetInitStep") & +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_FARKStepSetMinStep(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMinStep") & +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_FARKStepSetMaxStep(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMaxStep") & +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_FARKStepSetStopTime(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetStopTime") & +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_FARKStepSetFixedStep(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetFixedStep") & +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_FARKStepSetMaxNumConstrFails(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMaxNumConstrFails") & +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_FARKStepSetRootDirection(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetRootDirection") & +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_FARKStepSetNoInactiveRootWarn(farg1) & +bind(C, name="_wrap_FARKStepSetNoInactiveRootWarn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetErrHandlerFn(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepSetErrHandlerFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetErrFile(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetErrFile") & +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_FARKStepSetUserData(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetUserData") & +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_FARKStepSetDiagnostics(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetDiagnostics") & +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_FARKStepSetPostprocessStepFn(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetPostprocessStepFn") & +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_FARKStepSetPostprocessStageFn(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetPostprocessStageFn") & +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_FARKStepSetStagePredictFn(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetStagePredictFn") & +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_FARKStepSetJacFn(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetJacFn") & +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_FARKStepSetMassFn(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMassFn") & +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_FARKStepSetJacEvalFrequency(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetJacEvalFrequency") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_LONG), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetLinearSolutionScaling(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetLinearSolutionScaling") & +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_FARKStepSetEpsLin(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetEpsLin") & +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_FARKStepSetMassEpsLin(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMassEpsLin") & +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_FARKStepSetLSNormFactor(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetLSNormFactor") & +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_FARKStepSetMassLSNormFactor(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetMassLSNormFactor") & +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_FARKStepSetPreconditioner(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepSetPreconditioner") & +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_FARKStepSetMassPreconditioner(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepSetMassPreconditioner") & +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_FARKStepSetJacTimes(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepSetJacTimes") & +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_FARKStepSetJacTimesRhsFn(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetJacTimesRhsFn") & +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_FARKStepSetMassTimes(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FARKStepSetMassTimes") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_FUNPTR), value :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepSetLinSysFn(farg1, farg2) & +bind(C, name="_wrap_FARKStepSetLinSysFn") & +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_FARKStepEvolve(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FARKStepEvolve") & +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_FARKStepGetDky(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FARKStepGetDky") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +integer(C_INT), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepComputeState(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepComputeState") & +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_FARKStepGetNumExpSteps(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumExpSteps") & +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_FARKStepGetNumAccSteps(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumAccSteps") & +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_FARKStepGetNumStepAttempts(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumStepAttempts") & +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_FARKStepGetNumRhsEvals(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepGetNumRhsEvals") & +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_FARKStepGetNumLinSolvSetups(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumLinSolvSetups") & +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_FARKStepGetNumErrTestFails(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumErrTestFails") & +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_FARKStepGetCurrentButcherTables(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepGetCurrentButcherTables") & +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_FARKStepGetEstLocalErrors(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetEstLocalErrors") & +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_FARKStepGetWorkSpace(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepGetWorkSpace") & +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_FARKStepGetNumSteps(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumSteps") & +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_FARKStepGetActualInitStep(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetActualInitStep") & +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_FARKStepGetLastStep(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetLastStep") & +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_FARKStepGetCurrentStep(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetCurrentStep") & +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_FARKStepGetCurrentTime(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetCurrentTime") & +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_FARKStepGetCurrentState(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetCurrentState") & +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_FARKStepGetCurrentGamma(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetCurrentGamma") & +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_FARKStepGetCurrentMassMatrix(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetCurrentMassMatrix") & +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_FARKStepGetTolScaleFactor(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetTolScaleFactor") & +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_FARKStepGetErrWeights(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetErrWeights") & +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_FARKStepGetResWeights(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetResWeights") & +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_FARKStepGetNumGEvals(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumGEvals") & +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_FARKStepGetRootInfo(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetRootInfo") & +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_FARKStepGetNumConstrFails(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumConstrFails") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + + subroutine SWIG_free(cptr) & + bind(C, name="free") + use, intrinsic :: ISO_C_BINDING + type(C_PTR), value :: cptr +end subroutine +function swigc_FARKStepGetReturnFlagName(farg1) & +bind(C, name="_wrap_FARKStepGetReturnFlagName") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigarraywrapper +integer(C_LONG), intent(in) :: farg1 +type(SwigArrayWrapper) :: fresult +end function + +function swigc_FARKStepWriteParameters(farg1, farg2) & +bind(C, name="_wrap_FARKStepWriteParameters") & +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_FARKStepWriteButcher(farg1, farg2) & +bind(C, name="_wrap_FARKStepWriteButcher") & +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_FARKStepGetTimestepperStats(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) & +bind(C, name="_wrap_FARKStepGetTimestepperStats") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +type(C_PTR), value :: farg7 +type(C_PTR), value :: farg8 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepGetStepStats(farg1, farg2, farg3, farg4, farg5, farg6) & +bind(C, name="_wrap_FARKStepGetStepStats") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepGetNonlinearSystemData(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) & +bind(C, name="_wrap_FARKStepGetNonlinearSystemData") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +type(C_PTR), value :: farg7 +type(C_PTR), value :: farg8 +integer(C_INT) :: fresult +end function + +function swigc_FARKStepGetNumNonlinSolvIters(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumNonlinSolvIters") & +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_FARKStepGetNumNonlinSolvConvFails(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumNonlinSolvConvFails") & +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_FARKStepGetNonlinSolvStats(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepGetNonlinSolvStats") & +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_FARKStepGetLinWorkSpace(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepGetLinWorkSpace") & +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_FARKStepGetNumJacEvals(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumJacEvals") & +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_FARKStepGetNumPrecEvals(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumPrecEvals") & +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_FARKStepGetNumPrecSolves(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumPrecSolves") & +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_FARKStepGetNumLinIters(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumLinIters") & +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_FARKStepGetNumLinConvFails(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumLinConvFails") & +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_FARKStepGetNumJTSetupEvals(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumJTSetupEvals") & +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_FARKStepGetNumJtimesEvals(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumJtimesEvals") & +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_FARKStepGetNumLinRhsEvals(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumLinRhsEvals") & +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_FARKStepGetLastLinFlag(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetLastLinFlag") & +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_FARKStepGetMassWorkSpace(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKStepGetMassWorkSpace") & +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_FARKStepGetNumMassSetups(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumMassSetups") & +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_FARKStepGetNumMassMultSetups(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumMassMultSetups") & +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_FARKStepGetNumMassMult(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumMassMult") & +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_FARKStepGetNumMassSolves(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumMassSolves") & +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_FARKStepGetNumMassPrecEvals(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumMassPrecEvals") & +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_FARKStepGetNumMassPrecSolves(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumMassPrecSolves") & +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_FARKStepGetNumMassIters(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumMassIters") & +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_FARKStepGetNumMassConvFails(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumMassConvFails") & +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_FARKStepGetNumMTSetups(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetNumMTSetups") & +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_FARKStepGetLastMassFlag(farg1, farg2) & +bind(C, name="_wrap_FARKStepGetLastMassFlag") & +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_FARKStepGetLinReturnFlagName(farg1) & +bind(C, name="_wrap_FARKStepGetLinReturnFlagName") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigarraywrapper +integer(C_LONG), intent(in) :: farg1 +type(SwigArrayWrapper) :: fresult +end function + +subroutine swigc_FARKStepFree(farg1) & +bind(C, name="_wrap_FARKStepFree") +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +end subroutine + +subroutine swigc_FARKStepPrintMem(farg1, farg2) & +bind(C, name="_wrap_FARKStepPrintMem") +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_FARKStepCreateMRIStepInnerStepper(farg1, farg2) & +bind(C, name="_wrap_FARKStepCreateMRIStepInnerStepper") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +end interface + + +contains + ! MODULE SUBPROGRAMS +function FARKStepCreate(fe, fi, t0, y0, sunctx) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +type(C_FUNPTR), intent(in), value :: fe +type(C_FUNPTR), intent(in), value :: fi +real(C_DOUBLE), intent(in) :: t0 +type(N_Vector), target, intent(inout) :: y0 +type(C_PTR) :: sunctx +type(C_PTR) :: fresult +type(C_FUNPTR) :: farg1 +type(C_FUNPTR) :: farg2 +real(C_DOUBLE) :: farg3 +type(C_PTR) :: farg4 +type(C_PTR) :: farg5 + +farg1 = fe +farg2 = fi +farg3 = t0 +farg4 = c_loc(y0) +farg5 = sunctx +fresult = swigc_FARKStepCreate(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FARKStepResize(arkode_mem, ynew, hscale, t0, resize, resize_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: ynew +real(C_DOUBLE), intent(in) :: hscale +real(C_DOUBLE), intent(in) :: t0 +type(C_FUNPTR), intent(in), value :: resize +type(C_PTR) :: resize_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +real(C_DOUBLE) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_FUNPTR) :: farg5 +type(C_PTR) :: farg6 + +farg1 = arkode_mem +farg2 = c_loc(ynew) +farg3 = hscale +farg4 = t0 +farg5 = resize +farg6 = resize_data +fresult = swigc_FARKStepResize(farg1, farg2, farg3, farg4, farg5, farg6) +swig_result = fresult +end function + +function FARKStepReInit(arkode_mem, fe, fi, t0, y0) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: fe +type(C_FUNPTR), intent(in), value :: fi +real(C_DOUBLE), intent(in) :: t0 +type(N_Vector), target, intent(inout) :: y0 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_FUNPTR) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = arkode_mem +farg2 = fe +farg3 = fi +farg4 = t0 +farg5 = c_loc(y0) +fresult = swigc_FARKStepReInit(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FARKStepReset(arkode_mem, tr, yr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: tr +type(N_Vector), target, intent(inout) :: yr +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = tr +farg3 = c_loc(yr) +fresult = swigc_FARKStepReset(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepSStolerances(arkode_mem, reltol, abstol) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: reltol +real(C_DOUBLE), intent(in) :: abstol +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +real(C_DOUBLE) :: farg3 + +farg1 = arkode_mem +farg2 = reltol +farg3 = abstol +fresult = swigc_FARKStepSStolerances(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepSVtolerances(arkode_mem, reltol, abstol) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: reltol +type(N_Vector), target, intent(inout) :: abstol +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = reltol +farg3 = c_loc(abstol) +fresult = swigc_FARKStepSVtolerances(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepWFtolerances(arkode_mem, efun) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: efun +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = efun +fresult = swigc_FARKStepWFtolerances(farg1, farg2) +swig_result = fresult +end function + +function FARKStepResStolerance(arkode_mem, rabstol) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: rabstol +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = rabstol +fresult = swigc_FARKStepResStolerance(farg1, farg2) +swig_result = fresult +end function + +function FARKStepResVtolerance(arkode_mem, rabstol) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: rabstol +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(rabstol) +fresult = swigc_FARKStepResVtolerance(farg1, farg2) +swig_result = fresult +end function + +function FARKStepResFtolerance(arkode_mem, rfun) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: rfun +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = rfun +fresult = swigc_FARKStepResFtolerance(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetLinearSolver(arkode_mem, ls, a) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(SUNLinearSolver), target, intent(inout) :: ls +type(SUNMatrix), target, intent(inout) :: a +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(ls) +farg3 = c_loc(a) +fresult = swigc_FARKStepSetLinearSolver(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepSetMassLinearSolver(arkode_mem, ls, m, time_dep) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(SUNLinearSolver), target, intent(inout) :: ls +type(SUNMatrix), target, intent(inout) :: m +integer(C_INT), intent(in) :: time_dep +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 +integer(C_INT) :: farg4 + +farg1 = arkode_mem +farg2 = c_loc(ls) +farg3 = c_loc(m) +farg4 = time_dep +fresult = swigc_FARKStepSetMassLinearSolver(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FARKStepRootInit(arkode_mem, nrtfn, g) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: nrtfn +type(C_FUNPTR), intent(in), value :: g +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 +type(C_FUNPTR) :: farg3 + +farg1 = arkode_mem +farg2 = nrtfn +farg3 = g +fresult = swigc_FARKStepRootInit(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepSetDefaults(arkode_mem) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = arkode_mem +fresult = swigc_FARKStepSetDefaults(farg1) +swig_result = fresult +end function + +function FARKStepSetOptimalParams(arkode_mem) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = arkode_mem +fresult = swigc_FARKStepSetOptimalParams(farg1) +swig_result = fresult +end function + +function FARKStepSetOrder(arkode_mem, maxord) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: maxord +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = maxord +fresult = swigc_FARKStepSetOrder(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetInterpolantType(arkode_mem, itype) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: itype +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = itype +fresult = swigc_FARKStepSetInterpolantType(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetInterpolantDegree(arkode_mem, degree) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: degree +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = degree +fresult = swigc_FARKStepSetInterpolantDegree(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetDenseOrder(arkode_mem, dord) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: dord +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = dord +fresult = swigc_FARKStepSetDenseOrder(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetNonlinearSolver(arkode_mem, nls) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(SUNNonlinearSolver), target, intent(inout) :: nls +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nls) +fresult = swigc_FARKStepSetNonlinearSolver(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetNlsRhsFn(arkode_mem, nls_fi) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: nls_fi +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = nls_fi +fresult = swigc_FARKStepSetNlsRhsFn(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetLinear(arkode_mem, timedepend) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: timedepend +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = timedepend +fresult = swigc_FARKStepSetLinear(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetNonlinear(arkode_mem) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = arkode_mem +fresult = swigc_FARKStepSetNonlinear(farg1) +swig_result = fresult +end function + +function FARKStepSetExplicit(arkode_mem) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = arkode_mem +fresult = swigc_FARKStepSetExplicit(farg1) +swig_result = fresult +end function + +function FARKStepSetImplicit(arkode_mem) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = arkode_mem +fresult = swigc_FARKStepSetImplicit(farg1) +swig_result = fresult +end function + +function FARKStepSetImEx(arkode_mem) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = arkode_mem +fresult = swigc_FARKStepSetImEx(farg1) +swig_result = fresult +end function + +function FARKStepSetTables(arkode_mem, q, p, bi, be) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: q +integer(C_INT), intent(in) :: p +type(C_PTR) :: bi +type(C_PTR) :: be +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 +integer(C_INT) :: farg3 +type(C_PTR) :: farg4 +type(C_PTR) :: farg5 + +farg1 = arkode_mem +farg2 = q +farg3 = p +farg4 = bi +farg5 = be +fresult = swigc_FARKStepSetTables(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FARKStepSetTableNum(arkode_mem, itable, etable) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(ARKODE_DIRKTableID), intent(in) :: itable +integer(ARKODE_ERKTableID), intent(in) :: etable +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 +integer(C_INT) :: farg3 + +farg1 = arkode_mem +farg2 = itable +farg3 = etable +fresult = swigc_FARKStepSetTableNum(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepSetCFLFraction(arkode_mem, cfl_frac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: cfl_frac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = cfl_frac +fresult = swigc_FARKStepSetCFLFraction(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetSafetyFactor(arkode_mem, safety) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: safety +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = safety +fresult = swigc_FARKStepSetSafetyFactor(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetErrorBias(arkode_mem, bias) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: bias +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = bias +fresult = swigc_FARKStepSetErrorBias(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMaxGrowth(arkode_mem, mx_growth) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: mx_growth +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = mx_growth +fresult = swigc_FARKStepSetMaxGrowth(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMinReduction(arkode_mem, eta_min) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: eta_min +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = eta_min +fresult = swigc_FARKStepSetMinReduction(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetFixedStepBounds(arkode_mem, lb, ub) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: lb +real(C_DOUBLE), intent(in) :: ub +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +real(C_DOUBLE) :: farg3 + +farg1 = arkode_mem +farg2 = lb +farg3 = ub +fresult = swigc_FARKStepSetFixedStepBounds(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepSetAdaptivityMethod(arkode_mem, imethod, idefault, pq, adapt_params) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: imethod +integer(C_INT), intent(in) :: idefault +integer(C_INT), intent(in) :: pq +real(C_DOUBLE), dimension(3), target, intent(inout) :: adapt_params +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 +integer(C_INT) :: farg3 +integer(C_INT) :: farg4 +type(C_PTR) :: farg5 + +farg1 = arkode_mem +farg2 = imethod +farg3 = idefault +farg4 = pq +farg5 = c_loc(adapt_params(1)) +fresult = swigc_FARKStepSetAdaptivityMethod(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FARKStepSetAdaptivityFn(arkode_mem, hfun, h_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: hfun +type(C_PTR) :: h_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = hfun +farg3 = h_data +fresult = swigc_FARKStepSetAdaptivityFn(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepSetMaxFirstGrowth(arkode_mem, etamx1) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: etamx1 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = etamx1 +fresult = swigc_FARKStepSetMaxFirstGrowth(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMaxEFailGrowth(arkode_mem, etamxf) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: etamxf +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = etamxf +fresult = swigc_FARKStepSetMaxEFailGrowth(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetSmallNumEFails(arkode_mem, small_nef) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: small_nef +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = small_nef +fresult = swigc_FARKStepSetSmallNumEFails(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMaxCFailGrowth(arkode_mem, etacf) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: etacf +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = etacf +fresult = swigc_FARKStepSetMaxCFailGrowth(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetNonlinCRDown(arkode_mem, crdown) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: crdown +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = crdown +fresult = swigc_FARKStepSetNonlinCRDown(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetNonlinRDiv(arkode_mem, rdiv) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: rdiv +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = rdiv +fresult = swigc_FARKStepSetNonlinRDiv(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetDeltaGammaMax(arkode_mem, dgmax) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: dgmax +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = dgmax +fresult = swigc_FARKStepSetDeltaGammaMax(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetLSetupFrequency(arkode_mem, msbp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: msbp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = msbp +fresult = swigc_FARKStepSetLSetupFrequency(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetPredictorMethod(arkode_mem, method) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: method +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = method +fresult = swigc_FARKStepSetPredictorMethod(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetStabilityFn(arkode_mem, estab, estab_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: estab +type(C_PTR) :: estab_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = estab +farg3 = estab_data +fresult = swigc_FARKStepSetStabilityFn(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepSetMaxErrTestFails(arkode_mem, maxnef) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: maxnef +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = maxnef +fresult = swigc_FARKStepSetMaxErrTestFails(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMaxNonlinIters(arkode_mem, maxcor) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: maxcor +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = maxcor +fresult = swigc_FARKStepSetMaxNonlinIters(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMaxConvFails(arkode_mem, maxncf) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: maxncf +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = maxncf +fresult = swigc_FARKStepSetMaxConvFails(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetNonlinConvCoef(arkode_mem, nlscoef) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: nlscoef +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = nlscoef +fresult = swigc_FARKStepSetNonlinConvCoef(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetConstraints(arkode_mem, constraints) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: constraints +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(constraints) +fresult = swigc_FARKStepSetConstraints(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMaxNumSteps(arkode_mem, mxsteps) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), intent(in) :: mxsteps +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_LONG) :: farg2 + +farg1 = arkode_mem +farg2 = mxsteps +fresult = swigc_FARKStepSetMaxNumSteps(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMaxHnilWarns(arkode_mem, mxhnil) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: mxhnil +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = mxhnil +fresult = swigc_FARKStepSetMaxHnilWarns(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetInitStep(arkode_mem, hin) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: hin +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = hin +fresult = swigc_FARKStepSetInitStep(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMinStep(arkode_mem, hmin) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: hmin +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = hmin +fresult = swigc_FARKStepSetMinStep(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMaxStep(arkode_mem, hmax) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: hmax +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = hmax +fresult = swigc_FARKStepSetMaxStep(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetStopTime(arkode_mem, tstop) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: tstop +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = tstop +fresult = swigc_FARKStepSetStopTime(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetFixedStep(arkode_mem, hfixed) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: hfixed +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = hfixed +fresult = swigc_FARKStepSetFixedStep(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMaxNumConstrFails(arkode_mem, maxfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: maxfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = maxfails +fresult = swigc_FARKStepSetMaxNumConstrFails(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetRootDirection(arkode_mem, rootdir) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), dimension(*), target, intent(inout) :: rootdir +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(rootdir(1)) +fresult = swigc_FARKStepSetRootDirection(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetNoInactiveRootWarn(arkode_mem) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = arkode_mem +fresult = swigc_FARKStepSetNoInactiveRootWarn(farg1) +swig_result = fresult +end function + +function FARKStepSetErrHandlerFn(arkode_mem, ehfun, eh_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: ehfun +type(C_PTR) :: eh_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = ehfun +farg3 = eh_data +fresult = swigc_FARKStepSetErrHandlerFn(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepSetErrFile(arkode_mem, errfp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: errfp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = errfp +fresult = swigc_FARKStepSetErrFile(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetUserData(arkode_mem, user_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: user_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = user_data +fresult = swigc_FARKStepSetUserData(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetDiagnostics(arkode_mem, diagfp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: diagfp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = diagfp +fresult = swigc_FARKStepSetDiagnostics(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetPostprocessStepFn(arkode_mem, processstep) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: processstep +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = processstep +fresult = swigc_FARKStepSetPostprocessStepFn(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetPostprocessStageFn(arkode_mem, processstage) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: processstage +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = processstage +fresult = swigc_FARKStepSetPostprocessStageFn(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetStagePredictFn(arkode_mem, predictstage) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: predictstage +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = predictstage +fresult = swigc_FARKStepSetStagePredictFn(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetJacFn(arkode_mem, jac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: jac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = jac +fresult = swigc_FARKStepSetJacFn(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMassFn(arkode_mem, mass) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: mass +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = mass +fresult = swigc_FARKStepSetMassFn(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetJacEvalFrequency(arkode_mem, msbj) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), intent(in) :: msbj +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_LONG) :: farg2 + +farg1 = arkode_mem +farg2 = msbj +fresult = swigc_FARKStepSetJacEvalFrequency(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetLinearSolutionScaling(arkode_mem, onoff) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: onoff +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = onoff +fresult = swigc_FARKStepSetLinearSolutionScaling(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetEpsLin(arkode_mem, eplifac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: eplifac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = eplifac +fresult = swigc_FARKStepSetEpsLin(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMassEpsLin(arkode_mem, eplifac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: eplifac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = eplifac +fresult = swigc_FARKStepSetMassEpsLin(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetLSNormFactor(arkode_mem, nrmfac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: nrmfac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = nrmfac +fresult = swigc_FARKStepSetLSNormFactor(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMassLSNormFactor(arkode_mem, nrmfac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: nrmfac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = nrmfac +fresult = swigc_FARKStepSetMassLSNormFactor(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetPreconditioner(arkode_mem, psetup, psolve) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: psetup +type(C_FUNPTR), intent(in), value :: psolve +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_FUNPTR) :: farg3 + +farg1 = arkode_mem +farg2 = psetup +farg3 = psolve +fresult = swigc_FARKStepSetPreconditioner(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepSetMassPreconditioner(arkode_mem, psetup, psolve) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: psetup +type(C_FUNPTR), intent(in), value :: psolve +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_FUNPTR) :: farg3 + +farg1 = arkode_mem +farg2 = psetup +farg3 = psolve +fresult = swigc_FARKStepSetMassPreconditioner(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepSetJacTimes(arkode_mem, jtsetup, jtimes) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: jtsetup +type(C_FUNPTR), intent(in), value :: jtimes +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_FUNPTR) :: farg3 + +farg1 = arkode_mem +farg2 = jtsetup +farg3 = jtimes +fresult = swigc_FARKStepSetJacTimes(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepSetJacTimesRhsFn(arkode_mem, jtimesrhsfn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: jtimesrhsfn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = jtimesrhsfn +fresult = swigc_FARKStepSetJacTimesRhsFn(farg1, farg2) +swig_result = fresult +end function + +function FARKStepSetMassTimes(arkode_mem, msetup, mtimes, mtimes_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: msetup +type(C_FUNPTR), intent(in), value :: mtimes +type(C_PTR) :: mtimes_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_FUNPTR) :: farg3 +type(C_PTR) :: farg4 + +farg1 = arkode_mem +farg2 = msetup +farg3 = mtimes +farg4 = mtimes_data +fresult = swigc_FARKStepSetMassTimes(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FARKStepSetLinSysFn(arkode_mem, linsys) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: linsys +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = linsys +fresult = swigc_FARKStepSetLinSysFn(farg1, farg2) +swig_result = fresult +end function + +function FARKStepEvolve(arkode_mem, tout, yout, tret, itask) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: tout +type(N_Vector), target, intent(inout) :: yout +real(C_DOUBLE), dimension(*), target, intent(inout) :: tret +integer(C_INT), intent(in) :: itask +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 = arkode_mem +farg2 = tout +farg3 = c_loc(yout) +farg4 = c_loc(tret(1)) +farg5 = itask +fresult = swigc_FARKStepEvolve(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FARKStepGetDky(arkode_mem, t, k, dky) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: t +integer(C_INT), intent(in) :: k +type(N_Vector), target, intent(inout) :: dky +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +integer(C_INT) :: farg3 +type(C_PTR) :: farg4 + +farg1 = arkode_mem +farg2 = t +farg3 = k +farg4 = c_loc(dky) +fresult = swigc_FARKStepGetDky(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FARKStepComputeState(arkode_mem, zcor, z) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: zcor +type(N_Vector), target, intent(inout) :: z +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(zcor) +farg3 = c_loc(z) +fresult = swigc_FARKStepComputeState(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepGetNumExpSteps(arkode_mem, expsteps) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: expsteps +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(expsteps(1)) +fresult = swigc_FARKStepGetNumExpSteps(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumAccSteps(arkode_mem, accsteps) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: accsteps +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(accsteps(1)) +fresult = swigc_FARKStepGetNumAccSteps(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumStepAttempts(arkode_mem, step_attempts) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: step_attempts +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(step_attempts(1)) +fresult = swigc_FARKStepGetNumStepAttempts(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumRhsEvals(arkode_mem, nfe_evals, nfi_evals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nfe_evals +integer(C_LONG), dimension(*), target, intent(inout) :: nfi_evals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(nfe_evals(1)) +farg3 = c_loc(nfi_evals(1)) +fresult = swigc_FARKStepGetNumRhsEvals(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepGetNumLinSolvSetups(arkode_mem, nlinsetups) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nlinsetups +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nlinsetups(1)) +fresult = swigc_FARKStepGetNumLinSolvSetups(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumErrTestFails(arkode_mem, netfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: netfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(netfails(1)) +fresult = swigc_FARKStepGetNumErrTestFails(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetCurrentButcherTables(arkode_mem, bi, be) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR), target, intent(inout) :: bi +type(C_PTR), target, intent(inout) :: be +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(bi) +farg3 = c_loc(be) +fresult = swigc_FARKStepGetCurrentButcherTables(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepGetEstLocalErrors(arkode_mem, ele) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: ele +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(ele) +fresult = swigc_FARKStepGetEstLocalErrors(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetWorkSpace(arkode_mem, lenrw, leniw) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: lenrw +integer(C_LONG), dimension(*), target, intent(inout) :: leniw +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(lenrw(1)) +farg3 = c_loc(leniw(1)) +fresult = swigc_FARKStepGetWorkSpace(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepGetNumSteps(arkode_mem, nsteps) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nsteps +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nsteps(1)) +fresult = swigc_FARKStepGetNumSteps(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetActualInitStep(arkode_mem, hinused) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: hinused +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(hinused(1)) +fresult = swigc_FARKStepGetActualInitStep(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetLastStep(arkode_mem, hlast) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: hlast +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(hlast(1)) +fresult = swigc_FARKStepGetLastStep(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetCurrentStep(arkode_mem, hcur) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: hcur +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(hcur(1)) +fresult = swigc_FARKStepGetCurrentStep(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetCurrentTime(arkode_mem, tcur) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: tcur +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(tcur(1)) +fresult = swigc_FARKStepGetCurrentTime(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetCurrentState(arkode_mem, state) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: state +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = state +fresult = swigc_FARKStepGetCurrentState(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetCurrentGamma(arkode_mem, gamma) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: gamma +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(gamma(1)) +fresult = swigc_FARKStepGetCurrentGamma(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetCurrentMassMatrix(arkode_mem, m) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR), target, intent(inout) :: m +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(m) +fresult = swigc_FARKStepGetCurrentMassMatrix(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetTolScaleFactor(arkode_mem, tolsfac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: tolsfac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(tolsfac(1)) +fresult = swigc_FARKStepGetTolScaleFactor(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetErrWeights(arkode_mem, eweight) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: eweight +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(eweight) +fresult = swigc_FARKStepGetErrWeights(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetResWeights(arkode_mem, rweight) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: rweight +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(rweight) +fresult = swigc_FARKStepGetResWeights(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumGEvals(arkode_mem, ngevals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: ngevals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(ngevals(1)) +fresult = swigc_FARKStepGetNumGEvals(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetRootInfo(arkode_mem, rootsfound) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), dimension(*), target, intent(inout) :: rootsfound +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(rootsfound(1)) +fresult = swigc_FARKStepGetRootInfo(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumConstrFails(arkode_mem, nconstrfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nconstrfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nconstrfails(1)) +fresult = swigc_FARKStepGetNumConstrFails(farg1, farg2) +swig_result = fresult +end function + + +subroutine SWIG_chararray_to_string(wrap, string) + use, intrinsic :: ISO_C_BINDING + type(SwigArrayWrapper), intent(IN) :: wrap + character(kind=C_CHAR, len=:), allocatable, intent(OUT) :: string + character(kind=C_CHAR), dimension(:), pointer :: chars + integer(kind=C_SIZE_T) :: i + call c_f_pointer(wrap%data, chars, [wrap%size]) + allocate(character(kind=C_CHAR, len=wrap%size) :: string) + do i=1, wrap%size + string(i:i) = chars(i) + end do +end subroutine + +function FARKStepGetReturnFlagName(flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +character(kind=C_CHAR, len=:), allocatable :: swig_result +integer(C_LONG), intent(in) :: flag +type(SwigArrayWrapper) :: fresult +integer(C_LONG) :: farg1 + +farg1 = flag +fresult = swigc_FARKStepGetReturnFlagName(farg1) +call SWIG_chararray_to_string(fresult, swig_result) +if (.false.) call SWIG_free(fresult%data) +end function + +function FARKStepWriteParameters(arkode_mem, fp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: fp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = fp +fresult = swigc_FARKStepWriteParameters(farg1, farg2) +swig_result = fresult +end function + +function FARKStepWriteButcher(arkode_mem, fp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: fp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = fp +fresult = swigc_FARKStepWriteButcher(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetTimestepperStats(arkode_mem, expsteps, accsteps, step_attempts, nfe_evals, nfi_evals, nlinsetups, & + netfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: expsteps +integer(C_LONG), dimension(*), target, intent(inout) :: accsteps +integer(C_LONG), dimension(*), target, intent(inout) :: step_attempts +integer(C_LONG), dimension(*), target, intent(inout) :: nfe_evals +integer(C_LONG), dimension(*), target, intent(inout) :: nfi_evals +integer(C_LONG), dimension(*), target, intent(inout) :: nlinsetups +integer(C_LONG), dimension(*), target, intent(inout) :: netfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 +type(C_PTR) :: farg7 +type(C_PTR) :: farg8 + +farg1 = arkode_mem +farg2 = c_loc(expsteps(1)) +farg3 = c_loc(accsteps(1)) +farg4 = c_loc(step_attempts(1)) +farg5 = c_loc(nfe_evals(1)) +farg6 = c_loc(nfi_evals(1)) +farg7 = c_loc(nlinsetups(1)) +farg8 = c_loc(netfails(1)) +fresult = swigc_FARKStepGetTimestepperStats(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) +swig_result = fresult +end function + +function FARKStepGetStepStats(arkode_mem, nsteps, hinused, hlast, hcur, tcur) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nsteps +real(C_DOUBLE), dimension(*), target, intent(inout) :: hinused +real(C_DOUBLE), dimension(*), target, intent(inout) :: hlast +real(C_DOUBLE), dimension(*), target, intent(inout) :: hcur +real(C_DOUBLE), dimension(*), target, intent(inout) :: tcur +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 + +farg1 = arkode_mem +farg2 = c_loc(nsteps(1)) +farg3 = c_loc(hinused(1)) +farg4 = c_loc(hlast(1)) +farg5 = c_loc(hcur(1)) +farg6 = c_loc(tcur(1)) +fresult = swigc_FARKStepGetStepStats(farg1, farg2, farg3, farg4, farg5, farg6) +swig_result = fresult +end function + +function FARKStepGetNonlinearSystemData(arkode_mem, tcur, zpred, z, fi, gamma, sdata, user_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: tcur +type(C_PTR) :: zpred +type(C_PTR) :: z +type(C_PTR) :: fi +real(C_DOUBLE), dimension(*), target, intent(inout) :: gamma +type(C_PTR) :: sdata +type(C_PTR), target, intent(inout) :: user_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 +type(C_PTR) :: farg7 +type(C_PTR) :: farg8 + +farg1 = arkode_mem +farg2 = c_loc(tcur(1)) +farg3 = zpred +farg4 = z +farg5 = fi +farg6 = c_loc(gamma(1)) +farg7 = sdata +farg8 = c_loc(user_data) +fresult = swigc_FARKStepGetNonlinearSystemData(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) +swig_result = fresult +end function + +function FARKStepGetNumNonlinSolvIters(arkode_mem, nniters) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nniters +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nniters(1)) +fresult = swigc_FARKStepGetNumNonlinSolvIters(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumNonlinSolvConvFails(arkode_mem, nncfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nncfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nncfails(1)) +fresult = swigc_FARKStepGetNumNonlinSolvConvFails(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNonlinSolvStats(arkode_mem, nniters, nncfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nniters +integer(C_LONG), dimension(*), target, intent(inout) :: nncfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(nniters(1)) +farg3 = c_loc(nncfails(1)) +fresult = swigc_FARKStepGetNonlinSolvStats(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepGetLinWorkSpace(arkode_mem, lenrwls, leniwls) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: lenrwls +integer(C_LONG), dimension(*), target, intent(inout) :: leniwls +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(lenrwls(1)) +farg3 = c_loc(leniwls(1)) +fresult = swigc_FARKStepGetLinWorkSpace(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepGetNumJacEvals(arkode_mem, njevals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: njevals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(njevals(1)) +fresult = swigc_FARKStepGetNumJacEvals(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumPrecEvals(arkode_mem, npevals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: npevals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(npevals(1)) +fresult = swigc_FARKStepGetNumPrecEvals(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumPrecSolves(arkode_mem, npsolves) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: npsolves +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(npsolves(1)) +fresult = swigc_FARKStepGetNumPrecSolves(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumLinIters(arkode_mem, nliters) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nliters +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nliters(1)) +fresult = swigc_FARKStepGetNumLinIters(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumLinConvFails(arkode_mem, nlcfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nlcfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nlcfails(1)) +fresult = swigc_FARKStepGetNumLinConvFails(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumJTSetupEvals(arkode_mem, njtsetups) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: njtsetups +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(njtsetups(1)) +fresult = swigc_FARKStepGetNumJTSetupEvals(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumJtimesEvals(arkode_mem, njvevals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: njvevals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(njvevals(1)) +fresult = swigc_FARKStepGetNumJtimesEvals(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumLinRhsEvals(arkode_mem, nfevalsls) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nfevalsls +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nfevalsls(1)) +fresult = swigc_FARKStepGetNumLinRhsEvals(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetLastLinFlag(arkode_mem, flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: flag +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(flag(1)) +fresult = swigc_FARKStepGetLastLinFlag(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetMassWorkSpace(arkode_mem, lenrwmls, leniwmls) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: lenrwmls +integer(C_LONG), dimension(*), target, intent(inout) :: leniwmls +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(lenrwmls(1)) +farg3 = c_loc(leniwmls(1)) +fresult = swigc_FARKStepGetMassWorkSpace(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKStepGetNumMassSetups(arkode_mem, nmsetups) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nmsetups +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nmsetups(1)) +fresult = swigc_FARKStepGetNumMassSetups(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumMassMultSetups(arkode_mem, nmvsetups) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nmvsetups +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nmvsetups(1)) +fresult = swigc_FARKStepGetNumMassMultSetups(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumMassMult(arkode_mem, nmvevals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nmvevals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nmvevals(1)) +fresult = swigc_FARKStepGetNumMassMult(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumMassSolves(arkode_mem, nmsolves) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nmsolves +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nmsolves(1)) +fresult = swigc_FARKStepGetNumMassSolves(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumMassPrecEvals(arkode_mem, nmpevals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nmpevals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nmpevals(1)) +fresult = swigc_FARKStepGetNumMassPrecEvals(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumMassPrecSolves(arkode_mem, nmpsolves) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nmpsolves +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nmpsolves(1)) +fresult = swigc_FARKStepGetNumMassPrecSolves(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumMassIters(arkode_mem, nmiters) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nmiters +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nmiters(1)) +fresult = swigc_FARKStepGetNumMassIters(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumMassConvFails(arkode_mem, nmcfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nmcfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nmcfails(1)) +fresult = swigc_FARKStepGetNumMassConvFails(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetNumMTSetups(arkode_mem, nmtsetups) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nmtsetups +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nmtsetups(1)) +fresult = swigc_FARKStepGetNumMTSetups(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetLastMassFlag(arkode_mem, flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: flag +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(flag(1)) +fresult = swigc_FARKStepGetLastMassFlag(farg1, farg2) +swig_result = fresult +end function + +function FARKStepGetLinReturnFlagName(flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +character(kind=C_CHAR, len=:), allocatable :: swig_result +integer(C_LONG), intent(in) :: flag +type(SwigArrayWrapper) :: fresult +integer(C_LONG) :: farg1 + +farg1 = flag +fresult = swigc_FARKStepGetLinReturnFlagName(farg1) +call SWIG_chararray_to_string(fresult, swig_result) +if (.false.) call SWIG_free(fresult%data) +end function + +subroutine FARKStepFree(arkode_mem) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), target, intent(inout) :: arkode_mem +type(C_PTR) :: farg1 + +farg1 = c_loc(arkode_mem) +call swigc_FARKStepFree(farg1) +end subroutine + +subroutine FARKStepPrintMem(arkode_mem, outfile) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: arkode_mem +type(C_PTR) :: outfile +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = outfile +call swigc_FARKStepPrintMem(farg1, farg2) +end subroutine + +function FARKStepCreateMRIStepInnerStepper(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_FARKStepCreateMRIStepInnerStepper(farg1, farg2) +swig_result = fresult +end function + + +end module diff --git a/lib/sundials_6.1.1/src/arkode/fmod/farkode_erkstep_mod.c b/lib/sundials_6.1.1/src/arkode/fmod/farkode_erkstep_mod.c new file mode 100644 index 00000000000..ff60422c5ed --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/fmod/farkode_erkstep_mod.c @@ -0,0 +1,1295 @@ +/* ---------------------------------------------------------------------------- + * 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-2022, 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) \ + {STAN_SUNDIALS_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 "arkode/arkode_erkstep.h" + + +#include +#ifdef _MSC_VER +# ifndef strtoull +# define strtoull _strtoui64 +# endif +# ifndef strtoll +# define strtoll _strtoi64 +# endif +#endif + + +typedef struct { + void* data; + size_t size; +} SwigArrayWrapper; + + +SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() { + SwigArrayWrapper result; + result.data = NULL; + result.size = 0; + return result; +} + + +#include + +SWIGEXPORT void * _wrap_FERKStepCreate(ARKRhsFn farg1, double const *farg2, N_Vector farg3, void *farg4) { + void * fresult ; + ARKRhsFn arg1 = (ARKRhsFn) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + SUNContext arg4 = (SUNContext) 0 ; + void *result = 0 ; + + arg1 = (ARKRhsFn)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (SUNContext)(farg4); + result = (void *)ERKStepCreate(arg1,arg2,arg3,arg4); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepResize(void *farg1, N_Vector farg2, double const *farg3, double const *farg4, ARKVecResizeFn farg5, void *farg6) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype arg3 ; + realtype arg4 ; + ARKVecResizeFn arg5 = (ARKVecResizeFn) 0 ; + void *arg6 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (realtype)(*farg3); + arg4 = (realtype)(*farg4); + arg5 = (ARKVecResizeFn)(farg5); + arg6 = (void *)(farg6); + result = (int)ERKStepResize(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepReInit(void *farg1, ARKRhsFn farg2, double const *farg3, N_Vector farg4) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKRhsFn arg2 = (ARKRhsFn) 0 ; + realtype arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKRhsFn)(farg2); + arg3 = (realtype)(*farg3); + arg4 = (N_Vector)(farg4); + result = (int)ERKStepReInit(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepReset(void *farg1, double const *farg2, N_Vector farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + result = (int)ERKStepReset(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSStolerances(void *farg1, double const *farg2, double const *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + realtype arg3 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (realtype)(*farg3); + result = (int)ERKStepSStolerances(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSVtolerances(void *farg1, double const *farg2, N_Vector farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + result = (int)ERKStepSVtolerances(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepWFtolerances(void *farg1, ARKEwtFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKEwtFn arg2 = (ARKEwtFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKEwtFn)(farg2); + result = (int)ERKStepWFtolerances(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepRootInit(void *farg1, int const *farg2, ARKRootFn farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + ARKRootFn arg3 = (ARKRootFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + arg3 = (ARKRootFn)(farg3); + result = (int)ERKStepRootInit(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetDefaults(void *farg1) { + int fresult ; + void *arg1 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + result = (int)ERKStepSetDefaults(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetOrder(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ERKStepSetOrder(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetInterpolantType(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ERKStepSetInterpolantType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetInterpolantDegree(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ERKStepSetInterpolantDegree(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetDenseOrder(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ERKStepSetDenseOrder(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetTable(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKodeButcherTable arg2 = (ARKodeButcherTable) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKodeButcherTable)(farg2); + result = (int)ERKStepSetTable(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetTableNum(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKODE_ERKTableID arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKODE_ERKTableID)(*farg2); + result = (int)ERKStepSetTableNum(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetCFLFraction(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ERKStepSetCFLFraction(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetSafetyFactor(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ERKStepSetSafetyFactor(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetErrorBias(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ERKStepSetErrorBias(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetMaxGrowth(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ERKStepSetMaxGrowth(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetMinReduction(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ERKStepSetMinReduction(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetFixedStepBounds(void *farg1, double const *farg2, double const *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + realtype arg3 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (realtype)(*farg3); + result = (int)ERKStepSetFixedStepBounds(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetAdaptivityMethod(void *farg1, int const *farg2, int const *farg3, int const *farg4, double *farg5) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int arg3 ; + int arg4 ; + realtype *arg5 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + arg4 = (int)(*farg4); + arg5 = (double *)(farg5); + result = (int)ERKStepSetAdaptivityMethod(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetAdaptivityFn(void *farg1, ARKAdaptFn farg2, void *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKAdaptFn arg2 = (ARKAdaptFn) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKAdaptFn)(farg2); + arg3 = (void *)(farg3); + result = (int)ERKStepSetAdaptivityFn(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetMaxFirstGrowth(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ERKStepSetMaxFirstGrowth(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetMaxEFailGrowth(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ERKStepSetMaxEFailGrowth(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetSmallNumEFails(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ERKStepSetSmallNumEFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetStabilityFn(void *farg1, ARKExpStabFn farg2, void *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKExpStabFn arg2 = (ARKExpStabFn) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKExpStabFn)(farg2); + arg3 = (void *)(farg3); + result = (int)ERKStepSetStabilityFn(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetMaxErrTestFails(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ERKStepSetMaxErrTestFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetConstraints(void *farg1, N_Vector farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)ERKStepSetConstraints(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetMaxNumSteps(void *farg1, long const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long)(*farg2); + result = (int)ERKStepSetMaxNumSteps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetMaxHnilWarns(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ERKStepSetMaxHnilWarns(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetInitStep(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ERKStepSetInitStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetMinStep(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ERKStepSetMinStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetMaxStep(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ERKStepSetMaxStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetStopTime(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ERKStepSetStopTime(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetFixedStep(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)ERKStepSetFixedStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetMaxNumConstrFails(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)ERKStepSetMaxNumConstrFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetRootDirection(void *farg1, int *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int *arg2 = (int *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int *)(farg2); + result = (int)ERKStepSetRootDirection(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetNoInactiveRootWarn(void *farg1) { + int fresult ; + void *arg1 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + result = (int)ERKStepSetNoInactiveRootWarn(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetErrHandlerFn(void *farg1, ARKErrHandlerFn farg2, void *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKErrHandlerFn arg2 = (ARKErrHandlerFn) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKErrHandlerFn)(farg2); + arg3 = (void *)(farg3); + result = (int)ERKStepSetErrHandlerFn(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetErrFile(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)ERKStepSetErrFile(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetUserData(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + void *arg2 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (void *)(farg2); + result = (int)ERKStepSetUserData(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetDiagnostics(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)ERKStepSetDiagnostics(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetPostprocessStepFn(void *farg1, ARKPostProcessFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKPostProcessFn arg2 = (ARKPostProcessFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKPostProcessFn)(farg2); + result = (int)ERKStepSetPostprocessStepFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepSetPostprocessStageFn(void *farg1, ARKPostProcessFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKPostProcessFn arg2 = (ARKPostProcessFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKPostProcessFn)(farg2); + result = (int)ERKStepSetPostprocessStageFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepEvolve(void *farg1, double const *farg2, N_Vector farg3, double *farg4, int const *farg5) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + realtype *arg4 = (realtype *) 0 ; + int arg5 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (realtype *)(farg4); + arg5 = (int)(*farg5); + result = (int)ERKStepEvolve(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetDky(void *farg1, double const *farg2, int const *farg3, N_Vector farg4) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (int)(*farg3); + arg4 = (N_Vector)(farg4); + result = (int)ERKStepGetDky(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetNumExpSteps(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ERKStepGetNumExpSteps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetNumAccSteps(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ERKStepGetNumAccSteps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetNumStepAttempts(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ERKStepGetNumStepAttempts(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetNumRhsEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ERKStepGetNumRhsEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetNumErrTestFails(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ERKStepGetNumErrTestFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetCurrentButcherTable(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKodeButcherTable *arg2 = (ARKodeButcherTable *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKodeButcherTable *)(farg2); + result = (int)ERKStepGetCurrentButcherTable(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetEstLocalErrors(void *farg1, N_Vector farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)ERKStepGetEstLocalErrors(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetWorkSpace(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)ERKStepGetWorkSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetNumSteps(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ERKStepGetNumSteps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetActualInitStep(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)ERKStepGetActualInitStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetLastStep(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)ERKStepGetLastStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetCurrentStep(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)ERKStepGetCurrentStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetCurrentTime(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)ERKStepGetCurrentTime(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetTolScaleFactor(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)ERKStepGetTolScaleFactor(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetErrWeights(void *farg1, N_Vector farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)ERKStepGetErrWeights(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetNumGEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ERKStepGetNumGEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetRootInfo(void *farg1, int *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int *arg2 = (int *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int *)(farg2); + result = (int)ERKStepGetRootInfo(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetNumConstrFails(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ERKStepGetNumConstrFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SwigArrayWrapper _wrap_FERKStepGetReturnFlagName(long const *farg1) { + SwigArrayWrapper fresult ; + long arg1 ; + char *result = 0 ; + + arg1 = (long)(*farg1); + result = (char *)ERKStepGetReturnFlagName(arg1); + fresult.size = strlen((const char*)(result)); + fresult.data = (char *)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepWriteParameters(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)ERKStepWriteParameters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepWriteButcher(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)ERKStepWriteButcher(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetTimestepperStats(void *farg1, long *farg2, long *farg3, long *farg4, long *farg5, long *farg6) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + long *arg4 = (long *) 0 ; + long *arg5 = (long *) 0 ; + long *arg6 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + arg4 = (long *)(farg4); + arg5 = (long *)(farg5); + arg6 = (long *)(farg6); + result = (int)ERKStepGetTimestepperStats(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FERKStepGetStepStats(void *farg1, long *farg2, double *farg3, double *farg4, double *farg5, double *farg6) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + realtype *arg3 = (realtype *) 0 ; + realtype *arg4 = (realtype *) 0 ; + realtype *arg5 = (realtype *) 0 ; + realtype *arg6 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (realtype *)(farg3); + arg4 = (realtype *)(farg4); + arg5 = (realtype *)(farg5); + arg6 = (realtype *)(farg6); + result = (int)ERKStepGetStepStats(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_FERKStepFree(void *farg1) { + void **arg1 = (void **) 0 ; + + arg1 = (void **)(farg1); + ERKStepFree(arg1); +} + + +SWIGEXPORT void _wrap_FERKStepPrintMem(void *farg1, void *farg2) { + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + ERKStepPrintMem(arg1,arg2); +} + + + diff --git a/lib/sundials_6.1.1/src/arkode/fmod/farkode_erkstep_mod.f90 b/lib/sundials_6.1.1/src/arkode/fmod/farkode_erkstep_mod.f90 new file mode 100644 index 00000000000..fa95c803d54 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/fmod/farkode_erkstep_mod.f90 @@ -0,0 +1,2058 @@ +! 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-2022, 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 farkode_erkstep_mod + use, intrinsic :: ISO_C_BINDING + use farkode_mod + use fsundials_nvector_mod + use fsundials_context_mod + use fsundials_types_mod + use fsundials_matrix_mod + use fsundials_nvector_mod + use fsundials_context_mod + use fsundials_types_mod + use fsundials_linearsolver_mod + use fsundials_matrix_mod + use fsundials_nvector_mod + use fsundials_context_mod + use fsundials_types_mod + use fsundials_nonlinearsolver_mod + use fsundials_types_mod + implicit none + private + + ! DECLARATION CONSTRUCTS + integer(C_INT), parameter, public :: ERKSTEP_DEFAULT_2 = ARKODE_HEUN_EULER_2_1_2 + integer(C_INT), parameter, public :: ERKSTEP_DEFAULT_3 = ARKODE_BOGACKI_SHAMPINE_4_2_3 + integer(C_INT), parameter, public :: ERKSTEP_DEFAULT_4 = ARKODE_ZONNEVELD_5_3_4 + integer(C_INT), parameter, public :: ERKSTEP_DEFAULT_5 = ARKODE_CASH_KARP_6_4_5 + integer(C_INT), parameter, public :: ERKSTEP_DEFAULT_6 = ARKODE_VERNER_8_5_6 + integer(C_INT), parameter, public :: ERKSTEP_DEFAULT_8 = ARKODE_FEHLBERG_13_7_8 + public :: FERKStepCreate + public :: FERKStepResize + public :: FERKStepReInit + public :: FERKStepReset + public :: FERKStepSStolerances + public :: FERKStepSVtolerances + public :: FERKStepWFtolerances + public :: FERKStepRootInit + public :: FERKStepSetDefaults + public :: FERKStepSetOrder + public :: FERKStepSetInterpolantType + public :: FERKStepSetInterpolantDegree + public :: FERKStepSetDenseOrder + public :: FERKStepSetTable + public :: FERKStepSetTableNum + public :: FERKStepSetCFLFraction + public :: FERKStepSetSafetyFactor + public :: FERKStepSetErrorBias + public :: FERKStepSetMaxGrowth + public :: FERKStepSetMinReduction + public :: FERKStepSetFixedStepBounds + public :: FERKStepSetAdaptivityMethod + public :: FERKStepSetAdaptivityFn + public :: FERKStepSetMaxFirstGrowth + public :: FERKStepSetMaxEFailGrowth + public :: FERKStepSetSmallNumEFails + public :: FERKStepSetStabilityFn + public :: FERKStepSetMaxErrTestFails + public :: FERKStepSetConstraints + public :: FERKStepSetMaxNumSteps + public :: FERKStepSetMaxHnilWarns + public :: FERKStepSetInitStep + public :: FERKStepSetMinStep + public :: FERKStepSetMaxStep + public :: FERKStepSetStopTime + public :: FERKStepSetFixedStep + public :: FERKStepSetMaxNumConstrFails + public :: FERKStepSetRootDirection + public :: FERKStepSetNoInactiveRootWarn + public :: FERKStepSetErrHandlerFn + public :: FERKStepSetErrFile + public :: FERKStepSetUserData + public :: FERKStepSetDiagnostics + public :: FERKStepSetPostprocessStepFn + public :: FERKStepSetPostprocessStageFn + public :: FERKStepEvolve + public :: FERKStepGetDky + public :: FERKStepGetNumExpSteps + public :: FERKStepGetNumAccSteps + public :: FERKStepGetNumStepAttempts + public :: FERKStepGetNumRhsEvals + public :: FERKStepGetNumErrTestFails + public :: FERKStepGetCurrentButcherTable + public :: FERKStepGetEstLocalErrors + public :: FERKStepGetWorkSpace + public :: FERKStepGetNumSteps + public :: FERKStepGetActualInitStep + public :: FERKStepGetLastStep + public :: FERKStepGetCurrentStep + public :: FERKStepGetCurrentTime + public :: FERKStepGetTolScaleFactor + public :: FERKStepGetErrWeights + public :: FERKStepGetNumGEvals + public :: FERKStepGetRootInfo + public :: FERKStepGetNumConstrFails + type, bind(C) :: SwigArrayWrapper + type(C_PTR), public :: data = C_NULL_PTR + integer(C_SIZE_T), public :: size = 0 + end type + public :: FERKStepGetReturnFlagName + public :: FERKStepWriteParameters + public :: FERKStepWriteButcher + public :: FERKStepGetTimestepperStats + public :: FERKStepGetStepStats + public :: FERKStepFree + public :: FERKStepPrintMem + +! WRAPPER DECLARATIONS +interface +function swigc_FERKStepCreate(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FERKStepCreate") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR) :: fresult +end function + +function swigc_FERKStepResize(farg1, farg2, farg3, farg4, farg5, farg6) & +bind(C, name="_wrap_FERKStepResize") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_FUNPTR), value :: farg5 +type(C_PTR), value :: farg6 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepReInit(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FERKStepReInit") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepReset(farg1, farg2, farg3) & +bind(C, name="_wrap_FERKStepReset") & +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_INT) :: fresult +end function + +function swigc_FERKStepSStolerances(farg1, farg2, farg3) & +bind(C, name="_wrap_FERKStepSStolerances") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepSVtolerances(farg1, farg2, farg3) & +bind(C, name="_wrap_FERKStepSVtolerances") & +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_INT) :: fresult +end function + +function swigc_FERKStepWFtolerances(farg1, farg2) & +bind(C, name="_wrap_FERKStepWFtolerances") & +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_FERKStepRootInit(farg1, farg2, farg3) & +bind(C, name="_wrap_FERKStepRootInit") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +type(C_FUNPTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepSetDefaults(farg1) & +bind(C, name="_wrap_FERKStepSetDefaults") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepSetOrder(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetOrder") & +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_FERKStepSetInterpolantType(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetInterpolantType") & +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_FERKStepSetInterpolantDegree(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetInterpolantDegree") & +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_FERKStepSetDenseOrder(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetDenseOrder") & +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_FERKStepSetTable(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetTable") & +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_FERKStepSetTableNum(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetTableNum") & +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_FERKStepSetCFLFraction(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetCFLFraction") & +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_FERKStepSetSafetyFactor(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetSafetyFactor") & +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_FERKStepSetErrorBias(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetErrorBias") & +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_FERKStepSetMaxGrowth(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetMaxGrowth") & +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_FERKStepSetMinReduction(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetMinReduction") & +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_FERKStepSetFixedStepBounds(farg1, farg2, farg3) & +bind(C, name="_wrap_FERKStepSetFixedStepBounds") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepSetAdaptivityMethod(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FERKStepSetAdaptivityMethod") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT), intent(in) :: farg3 +integer(C_INT), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepSetAdaptivityFn(farg1, farg2, farg3) & +bind(C, name="_wrap_FERKStepSetAdaptivityFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepSetMaxFirstGrowth(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetMaxFirstGrowth") & +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_FERKStepSetMaxEFailGrowth(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetMaxEFailGrowth") & +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_FERKStepSetSmallNumEFails(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetSmallNumEFails") & +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_FERKStepSetStabilityFn(farg1, farg2, farg3) & +bind(C, name="_wrap_FERKStepSetStabilityFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepSetMaxErrTestFails(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetMaxErrTestFails") & +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_FERKStepSetConstraints(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetConstraints") & +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_FERKStepSetMaxNumSteps(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetMaxNumSteps") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_LONG), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepSetMaxHnilWarns(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetMaxHnilWarns") & +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_FERKStepSetInitStep(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetInitStep") & +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_FERKStepSetMinStep(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetMinStep") & +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_FERKStepSetMaxStep(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetMaxStep") & +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_FERKStepSetStopTime(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetStopTime") & +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_FERKStepSetFixedStep(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetFixedStep") & +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_FERKStepSetMaxNumConstrFails(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetMaxNumConstrFails") & +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_FERKStepSetRootDirection(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetRootDirection") & +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_FERKStepSetNoInactiveRootWarn(farg1) & +bind(C, name="_wrap_FERKStepSetNoInactiveRootWarn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepSetErrHandlerFn(farg1, farg2, farg3) & +bind(C, name="_wrap_FERKStepSetErrHandlerFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepSetErrFile(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetErrFile") & +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_FERKStepSetUserData(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetUserData") & +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_FERKStepSetDiagnostics(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetDiagnostics") & +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_FERKStepSetPostprocessStepFn(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetPostprocessStepFn") & +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_FERKStepSetPostprocessStageFn(farg1, farg2) & +bind(C, name="_wrap_FERKStepSetPostprocessStageFn") & +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_FERKStepEvolve(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FERKStepEvolve") & +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_FERKStepGetDky(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FERKStepGetDky") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +integer(C_INT), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepGetNumExpSteps(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetNumExpSteps") & +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_FERKStepGetNumAccSteps(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetNumAccSteps") & +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_FERKStepGetNumStepAttempts(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetNumStepAttempts") & +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_FERKStepGetNumRhsEvals(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetNumRhsEvals") & +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_FERKStepGetNumErrTestFails(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetNumErrTestFails") & +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_FERKStepGetCurrentButcherTable(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetCurrentButcherTable") & +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_FERKStepGetEstLocalErrors(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetEstLocalErrors") & +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_FERKStepGetWorkSpace(farg1, farg2, farg3) & +bind(C, name="_wrap_FERKStepGetWorkSpace") & +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_FERKStepGetNumSteps(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetNumSteps") & +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_FERKStepGetActualInitStep(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetActualInitStep") & +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_FERKStepGetLastStep(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetLastStep") & +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_FERKStepGetCurrentStep(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetCurrentStep") & +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_FERKStepGetCurrentTime(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetCurrentTime") & +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_FERKStepGetTolScaleFactor(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetTolScaleFactor") & +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_FERKStepGetErrWeights(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetErrWeights") & +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_FERKStepGetNumGEvals(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetNumGEvals") & +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_FERKStepGetRootInfo(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetRootInfo") & +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_FERKStepGetNumConstrFails(farg1, farg2) & +bind(C, name="_wrap_FERKStepGetNumConstrFails") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + + subroutine SWIG_free(cptr) & + bind(C, name="free") + use, intrinsic :: ISO_C_BINDING + type(C_PTR), value :: cptr +end subroutine +function swigc_FERKStepGetReturnFlagName(farg1) & +bind(C, name="_wrap_FERKStepGetReturnFlagName") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigarraywrapper +integer(C_LONG), intent(in) :: farg1 +type(SwigArrayWrapper) :: fresult +end function + +function swigc_FERKStepWriteParameters(farg1, farg2) & +bind(C, name="_wrap_FERKStepWriteParameters") & +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_FERKStepWriteButcher(farg1, farg2) & +bind(C, name="_wrap_FERKStepWriteButcher") & +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_FERKStepGetTimestepperStats(farg1, farg2, farg3, farg4, farg5, farg6) & +bind(C, name="_wrap_FERKStepGetTimestepperStats") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +integer(C_INT) :: fresult +end function + +function swigc_FERKStepGetStepStats(farg1, farg2, farg3, farg4, farg5, farg6) & +bind(C, name="_wrap_FERKStepGetStepStats") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +integer(C_INT) :: fresult +end function + +subroutine swigc_FERKStepFree(farg1) & +bind(C, name="_wrap_FERKStepFree") +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +end subroutine + +subroutine swigc_FERKStepPrintMem(farg1, farg2) & +bind(C, name="_wrap_FERKStepPrintMem") +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +end interface + + +contains + ! MODULE SUBPROGRAMS +function FERKStepCreate(f, t0, y0, sunctx) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +type(C_FUNPTR), intent(in), value :: f +real(C_DOUBLE), intent(in) :: t0 +type(N_Vector), target, intent(inout) :: y0 +type(C_PTR) :: sunctx +type(C_PTR) :: fresult +type(C_FUNPTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 + +farg1 = f +farg2 = t0 +farg3 = c_loc(y0) +farg4 = sunctx +fresult = swigc_FERKStepCreate(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FERKStepResize(arkode_mem, ynew, hscale, t0, resize, resize_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: ynew +real(C_DOUBLE), intent(in) :: hscale +real(C_DOUBLE), intent(in) :: t0 +type(C_FUNPTR), intent(in), value :: resize +type(C_PTR) :: resize_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +real(C_DOUBLE) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_FUNPTR) :: farg5 +type(C_PTR) :: farg6 + +farg1 = arkode_mem +farg2 = c_loc(ynew) +farg3 = hscale +farg4 = t0 +farg5 = resize +farg6 = resize_data +fresult = swigc_FERKStepResize(farg1, farg2, farg3, farg4, farg5, farg6) +swig_result = fresult +end function + +function FERKStepReInit(arkode_mem, f, t0, y0) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: f +real(C_DOUBLE), intent(in) :: t0 +type(N_Vector), target, intent(inout) :: y0 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +real(C_DOUBLE) :: farg3 +type(C_PTR) :: farg4 + +farg1 = arkode_mem +farg2 = f +farg3 = t0 +farg4 = c_loc(y0) +fresult = swigc_FERKStepReInit(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FERKStepReset(arkode_mem, tr, yr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: tr +type(N_Vector), target, intent(inout) :: yr +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = tr +farg3 = c_loc(yr) +fresult = swigc_FERKStepReset(farg1, farg2, farg3) +swig_result = fresult +end function + +function FERKStepSStolerances(arkode_mem, reltol, abstol) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: reltol +real(C_DOUBLE), intent(in) :: abstol +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +real(C_DOUBLE) :: farg3 + +farg1 = arkode_mem +farg2 = reltol +farg3 = abstol +fresult = swigc_FERKStepSStolerances(farg1, farg2, farg3) +swig_result = fresult +end function + +function FERKStepSVtolerances(arkode_mem, reltol, abstol) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: reltol +type(N_Vector), target, intent(inout) :: abstol +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = reltol +farg3 = c_loc(abstol) +fresult = swigc_FERKStepSVtolerances(farg1, farg2, farg3) +swig_result = fresult +end function + +function FERKStepWFtolerances(arkode_mem, efun) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: efun +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = efun +fresult = swigc_FERKStepWFtolerances(farg1, farg2) +swig_result = fresult +end function + +function FERKStepRootInit(arkode_mem, nrtfn, g) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: nrtfn +type(C_FUNPTR), intent(in), value :: g +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 +type(C_FUNPTR) :: farg3 + +farg1 = arkode_mem +farg2 = nrtfn +farg3 = g +fresult = swigc_FERKStepRootInit(farg1, farg2, farg3) +swig_result = fresult +end function + +function FERKStepSetDefaults(arkode_mem) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = arkode_mem +fresult = swigc_FERKStepSetDefaults(farg1) +swig_result = fresult +end function + +function FERKStepSetOrder(arkode_mem, maxord) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: maxord +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = maxord +fresult = swigc_FERKStepSetOrder(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetInterpolantType(arkode_mem, itype) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: itype +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = itype +fresult = swigc_FERKStepSetInterpolantType(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetInterpolantDegree(arkode_mem, degree) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: degree +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = degree +fresult = swigc_FERKStepSetInterpolantDegree(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetDenseOrder(arkode_mem, dord) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: dord +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = dord +fresult = swigc_FERKStepSetDenseOrder(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetTable(arkode_mem, b) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: b +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = b +fresult = swigc_FERKStepSetTable(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetTableNum(arkode_mem, itable) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(ARKODE_ERKTableID), intent(in) :: itable +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = itable +fresult = swigc_FERKStepSetTableNum(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetCFLFraction(arkode_mem, cfl_frac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: cfl_frac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = cfl_frac +fresult = swigc_FERKStepSetCFLFraction(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetSafetyFactor(arkode_mem, safety) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: safety +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = safety +fresult = swigc_FERKStepSetSafetyFactor(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetErrorBias(arkode_mem, bias) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: bias +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = bias +fresult = swigc_FERKStepSetErrorBias(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetMaxGrowth(arkode_mem, mx_growth) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: mx_growth +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = mx_growth +fresult = swigc_FERKStepSetMaxGrowth(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetMinReduction(arkode_mem, eta_min) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: eta_min +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = eta_min +fresult = swigc_FERKStepSetMinReduction(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetFixedStepBounds(arkode_mem, lb, ub) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: lb +real(C_DOUBLE), intent(in) :: ub +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +real(C_DOUBLE) :: farg3 + +farg1 = arkode_mem +farg2 = lb +farg3 = ub +fresult = swigc_FERKStepSetFixedStepBounds(farg1, farg2, farg3) +swig_result = fresult +end function + +function FERKStepSetAdaptivityMethod(arkode_mem, imethod, idefault, pq, adapt_params) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: imethod +integer(C_INT), intent(in) :: idefault +integer(C_INT), intent(in) :: pq +real(C_DOUBLE), dimension(3), target, intent(inout) :: adapt_params +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 +integer(C_INT) :: farg3 +integer(C_INT) :: farg4 +type(C_PTR) :: farg5 + +farg1 = arkode_mem +farg2 = imethod +farg3 = idefault +farg4 = pq +farg5 = c_loc(adapt_params(1)) +fresult = swigc_FERKStepSetAdaptivityMethod(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FERKStepSetAdaptivityFn(arkode_mem, hfun, h_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: hfun +type(C_PTR) :: h_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = hfun +farg3 = h_data +fresult = swigc_FERKStepSetAdaptivityFn(farg1, farg2, farg3) +swig_result = fresult +end function + +function FERKStepSetMaxFirstGrowth(arkode_mem, etamx1) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: etamx1 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = etamx1 +fresult = swigc_FERKStepSetMaxFirstGrowth(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetMaxEFailGrowth(arkode_mem, etamxf) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: etamxf +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = etamxf +fresult = swigc_FERKStepSetMaxEFailGrowth(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetSmallNumEFails(arkode_mem, small_nef) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: small_nef +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = small_nef +fresult = swigc_FERKStepSetSmallNumEFails(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetStabilityFn(arkode_mem, estab, estab_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: estab +type(C_PTR) :: estab_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = estab +farg3 = estab_data +fresult = swigc_FERKStepSetStabilityFn(farg1, farg2, farg3) +swig_result = fresult +end function + +function FERKStepSetMaxErrTestFails(arkode_mem, maxnef) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: maxnef +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = maxnef +fresult = swigc_FERKStepSetMaxErrTestFails(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetConstraints(arkode_mem, constraints) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: constraints +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(constraints) +fresult = swigc_FERKStepSetConstraints(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetMaxNumSteps(arkode_mem, mxsteps) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), intent(in) :: mxsteps +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_LONG) :: farg2 + +farg1 = arkode_mem +farg2 = mxsteps +fresult = swigc_FERKStepSetMaxNumSteps(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetMaxHnilWarns(arkode_mem, mxhnil) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: mxhnil +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = mxhnil +fresult = swigc_FERKStepSetMaxHnilWarns(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetInitStep(arkode_mem, hin) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: hin +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = hin +fresult = swigc_FERKStepSetInitStep(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetMinStep(arkode_mem, hmin) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: hmin +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = hmin +fresult = swigc_FERKStepSetMinStep(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetMaxStep(arkode_mem, hmax) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: hmax +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = hmax +fresult = swigc_FERKStepSetMaxStep(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetStopTime(arkode_mem, tstop) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: tstop +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = tstop +fresult = swigc_FERKStepSetStopTime(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetFixedStep(arkode_mem, hfixed) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: hfixed +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = hfixed +fresult = swigc_FERKStepSetFixedStep(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetMaxNumConstrFails(arkode_mem, maxfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: maxfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = maxfails +fresult = swigc_FERKStepSetMaxNumConstrFails(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetRootDirection(arkode_mem, rootdir) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), dimension(*), target, intent(inout) :: rootdir +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(rootdir(1)) +fresult = swigc_FERKStepSetRootDirection(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetNoInactiveRootWarn(arkode_mem) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = arkode_mem +fresult = swigc_FERKStepSetNoInactiveRootWarn(farg1) +swig_result = fresult +end function + +function FERKStepSetErrHandlerFn(arkode_mem, ehfun, eh_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: ehfun +type(C_PTR) :: eh_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = ehfun +farg3 = eh_data +fresult = swigc_FERKStepSetErrHandlerFn(farg1, farg2, farg3) +swig_result = fresult +end function + +function FERKStepSetErrFile(arkode_mem, errfp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: errfp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = errfp +fresult = swigc_FERKStepSetErrFile(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetUserData(arkode_mem, user_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: user_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = user_data +fresult = swigc_FERKStepSetUserData(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetDiagnostics(arkode_mem, diagfp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: diagfp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = diagfp +fresult = swigc_FERKStepSetDiagnostics(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetPostprocessStepFn(arkode_mem, processstep) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: processstep +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = processstep +fresult = swigc_FERKStepSetPostprocessStepFn(farg1, farg2) +swig_result = fresult +end function + +function FERKStepSetPostprocessStageFn(arkode_mem, processstage) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: processstage +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = processstage +fresult = swigc_FERKStepSetPostprocessStageFn(farg1, farg2) +swig_result = fresult +end function + +function FERKStepEvolve(arkode_mem, tout, yout, tret, itask) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: tout +type(N_Vector), target, intent(inout) :: yout +real(C_DOUBLE), dimension(*), target, intent(inout) :: tret +integer(C_INT), intent(in) :: itask +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 = arkode_mem +farg2 = tout +farg3 = c_loc(yout) +farg4 = c_loc(tret(1)) +farg5 = itask +fresult = swigc_FERKStepEvolve(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FERKStepGetDky(arkode_mem, t, k, dky) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: t +integer(C_INT), intent(in) :: k +type(N_Vector), target, intent(inout) :: dky +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +integer(C_INT) :: farg3 +type(C_PTR) :: farg4 + +farg1 = arkode_mem +farg2 = t +farg3 = k +farg4 = c_loc(dky) +fresult = swigc_FERKStepGetDky(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FERKStepGetNumExpSteps(arkode_mem, expsteps) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: expsteps +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(expsteps(1)) +fresult = swigc_FERKStepGetNumExpSteps(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetNumAccSteps(arkode_mem, accsteps) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: accsteps +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(accsteps(1)) +fresult = swigc_FERKStepGetNumAccSteps(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetNumStepAttempts(arkode_mem, step_attempts) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: step_attempts +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(step_attempts(1)) +fresult = swigc_FERKStepGetNumStepAttempts(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetNumRhsEvals(arkode_mem, nfevals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nfevals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nfevals(1)) +fresult = swigc_FERKStepGetNumRhsEvals(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetNumErrTestFails(arkode_mem, netfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: netfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(netfails(1)) +fresult = swigc_FERKStepGetNumErrTestFails(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetCurrentButcherTable(arkode_mem, b) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR), target, intent(inout) :: b +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(b) +fresult = swigc_FERKStepGetCurrentButcherTable(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetEstLocalErrors(arkode_mem, ele) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: ele +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(ele) +fresult = swigc_FERKStepGetEstLocalErrors(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetWorkSpace(arkode_mem, lenrw, leniw) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: lenrw +integer(C_LONG), dimension(*), target, intent(inout) :: leniw +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(lenrw(1)) +farg3 = c_loc(leniw(1)) +fresult = swigc_FERKStepGetWorkSpace(farg1, farg2, farg3) +swig_result = fresult +end function + +function FERKStepGetNumSteps(arkode_mem, nsteps) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nsteps +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nsteps(1)) +fresult = swigc_FERKStepGetNumSteps(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetActualInitStep(arkode_mem, hinused) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: hinused +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(hinused(1)) +fresult = swigc_FERKStepGetActualInitStep(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetLastStep(arkode_mem, hlast) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: hlast +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(hlast(1)) +fresult = swigc_FERKStepGetLastStep(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetCurrentStep(arkode_mem, hcur) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: hcur +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(hcur(1)) +fresult = swigc_FERKStepGetCurrentStep(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetCurrentTime(arkode_mem, tcur) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: tcur +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(tcur(1)) +fresult = swigc_FERKStepGetCurrentTime(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetTolScaleFactor(arkode_mem, tolsfac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: tolsfac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(tolsfac(1)) +fresult = swigc_FERKStepGetTolScaleFactor(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetErrWeights(arkode_mem, eweight) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: eweight +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(eweight) +fresult = swigc_FERKStepGetErrWeights(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetNumGEvals(arkode_mem, ngevals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: ngevals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(ngevals(1)) +fresult = swigc_FERKStepGetNumGEvals(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetRootInfo(arkode_mem, rootsfound) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), dimension(*), target, intent(inout) :: rootsfound +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(rootsfound(1)) +fresult = swigc_FERKStepGetRootInfo(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetNumConstrFails(arkode_mem, nconstrfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nconstrfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nconstrfails(1)) +fresult = swigc_FERKStepGetNumConstrFails(farg1, farg2) +swig_result = fresult +end function + + +subroutine SWIG_chararray_to_string(wrap, string) + use, intrinsic :: ISO_C_BINDING + type(SwigArrayWrapper), intent(IN) :: wrap + character(kind=C_CHAR, len=:), allocatable, intent(OUT) :: string + character(kind=C_CHAR), dimension(:), pointer :: chars + integer(kind=C_SIZE_T) :: i + call c_f_pointer(wrap%data, chars, [wrap%size]) + allocate(character(kind=C_CHAR, len=wrap%size) :: string) + do i=1, wrap%size + string(i:i) = chars(i) + end do +end subroutine + +function FERKStepGetReturnFlagName(flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +character(kind=C_CHAR, len=:), allocatable :: swig_result +integer(C_LONG), intent(in) :: flag +type(SwigArrayWrapper) :: fresult +integer(C_LONG) :: farg1 + +farg1 = flag +fresult = swigc_FERKStepGetReturnFlagName(farg1) +call SWIG_chararray_to_string(fresult, swig_result) +if (.false.) call SWIG_free(fresult%data) +end function + +function FERKStepWriteParameters(arkode_mem, fp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: fp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = fp +fresult = swigc_FERKStepWriteParameters(farg1, farg2) +swig_result = fresult +end function + +function FERKStepWriteButcher(arkode_mem, fp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: fp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = fp +fresult = swigc_FERKStepWriteButcher(farg1, farg2) +swig_result = fresult +end function + +function FERKStepGetTimestepperStats(arkode_mem, expsteps, accsteps, step_attempts, nfevals, netfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: expsteps +integer(C_LONG), dimension(*), target, intent(inout) :: accsteps +integer(C_LONG), dimension(*), target, intent(inout) :: step_attempts +integer(C_LONG), dimension(*), target, intent(inout) :: nfevals +integer(C_LONG), dimension(*), target, intent(inout) :: netfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 + +farg1 = arkode_mem +farg2 = c_loc(expsteps(1)) +farg3 = c_loc(accsteps(1)) +farg4 = c_loc(step_attempts(1)) +farg5 = c_loc(nfevals(1)) +farg6 = c_loc(netfails(1)) +fresult = swigc_FERKStepGetTimestepperStats(farg1, farg2, farg3, farg4, farg5, farg6) +swig_result = fresult +end function + +function FERKStepGetStepStats(arkode_mem, nsteps, hinused, hlast, hcur, tcur) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nsteps +real(C_DOUBLE), dimension(*), target, intent(inout) :: hinused +real(C_DOUBLE), dimension(*), target, intent(inout) :: hlast +real(C_DOUBLE), dimension(*), target, intent(inout) :: hcur +real(C_DOUBLE), dimension(*), target, intent(inout) :: tcur +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 + +farg1 = arkode_mem +farg2 = c_loc(nsteps(1)) +farg3 = c_loc(hinused(1)) +farg4 = c_loc(hlast(1)) +farg5 = c_loc(hcur(1)) +farg6 = c_loc(tcur(1)) +fresult = swigc_FERKStepGetStepStats(farg1, farg2, farg3, farg4, farg5, farg6) +swig_result = fresult +end function + +subroutine FERKStepFree(arkode_mem) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), target, intent(inout) :: arkode_mem +type(C_PTR) :: farg1 + +farg1 = c_loc(arkode_mem) +call swigc_FERKStepFree(farg1) +end subroutine + +subroutine FERKStepPrintMem(arkode_mem, outfile) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: arkode_mem +type(C_PTR) :: outfile +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = outfile +call swigc_FERKStepPrintMem(farg1, farg2) +end subroutine + + +end module diff --git a/lib/sundials_6.1.1/src/arkode/fmod/farkode_mod.c b/lib/sundials_6.1.1/src/arkode/fmod/farkode_mod.c new file mode 100644 index 00000000000..6c7963ce16e --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/fmod/farkode_mod.c @@ -0,0 +1,768 @@ +/* ---------------------------------------------------------------------------- + * 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-2022, 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) \ + {STAN_SUNDIALS_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 "arkode/arkode.h" +#include "arkode/arkode_bandpre.h" +#include "arkode/arkode_bbdpre.h" +#include "arkode/arkode_butcher.h" +#include "arkode/arkode_butcher_dirk.h" +#include "arkode/arkode_butcher_erk.h" +#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 +# 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 int _wrap_FARKBandPrecInit(void *farg1, int64_t const *farg2, int64_t const *farg3, int64_t const *farg4) { + int fresult ; + void *arg1 = (void *) 0 ; + sunindextype arg2 ; + sunindextype arg3 ; + sunindextype arg4 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (sunindextype)(*farg2); + arg3 = (sunindextype)(*farg3); + arg4 = (sunindextype)(*farg4); + result = (int)ARKBandPrecInit(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKBandPrecGetWorkSpace(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)ARKBandPrecGetWorkSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKBandPrecGetNumRhsEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKBandPrecGetNumRhsEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKBBDPrecInit(void *farg1, int64_t const *farg2, int64_t const *farg3, int64_t const *farg4, int64_t const *farg5, int64_t const *farg6, double const *farg7, ARKLocalFn farg8, ARKCommFn farg9) { + int fresult ; + void *arg1 = (void *) 0 ; + sunindextype arg2 ; + sunindextype arg3 ; + sunindextype arg4 ; + sunindextype arg5 ; + sunindextype arg6 ; + realtype arg7 ; + ARKLocalFn arg8 = (ARKLocalFn) 0 ; + ARKCommFn arg9 = (ARKCommFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (sunindextype)(*farg2); + arg3 = (sunindextype)(*farg3); + arg4 = (sunindextype)(*farg4); + arg5 = (sunindextype)(*farg5); + arg6 = (sunindextype)(*farg6); + arg7 = (realtype)(*farg7); + arg8 = (ARKLocalFn)(farg8); + arg9 = (ARKCommFn)(farg9); + result = (int)ARKBBDPrecInit(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKBBDPrecReInit(void *farg1, int64_t const *farg2, int64_t const *farg3, double const *farg4) { + int fresult ; + void *arg1 = (void *) 0 ; + sunindextype arg2 ; + sunindextype arg3 ; + realtype arg4 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (sunindextype)(*farg2); + arg3 = (sunindextype)(*farg3); + arg4 = (realtype)(*farg4); + result = (int)ARKBBDPrecReInit(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKBBDPrecGetWorkSpace(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)ARKBBDPrecGetWorkSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKBBDPrecGetNumGfnEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)ARKBBDPrecGetNumGfnEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_ARKodeButcherTableMem_q_set(SwigClassWrapper const *farg1, int const *farg2) { + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + int arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::q", return ); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + arg2 = (int)(*farg2); + if (arg1) (arg1)->q = arg2; +} + + +SWIGEXPORT int _wrap_ARKodeButcherTableMem_q_get(SwigClassWrapper const *farg1) { + int fresult ; + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + int result; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::q", return 0); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + result = (int) ((arg1)->q); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_ARKodeButcherTableMem_p_set(SwigClassWrapper const *farg1, int const *farg2) { + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + int arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::p", return ); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + arg2 = (int)(*farg2); + if (arg1) (arg1)->p = arg2; +} + + +SWIGEXPORT int _wrap_ARKodeButcherTableMem_p_get(SwigClassWrapper const *farg1) { + int fresult ; + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + int result; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::p", return 0); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + result = (int) ((arg1)->p); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_ARKodeButcherTableMem_stages_set(SwigClassWrapper const *farg1, int const *farg2) { + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + int arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::stages", return ); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + arg2 = (int)(*farg2); + if (arg1) (arg1)->stages = arg2; +} + + +SWIGEXPORT int _wrap_ARKodeButcherTableMem_stages_get(SwigClassWrapper const *farg1) { + int fresult ; + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + int result; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::stages", return 0); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + result = (int) ((arg1)->stages); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_ARKodeButcherTableMem_A_set(SwigClassWrapper const *farg1, void *farg2) { + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + realtype **arg2 = (realtype **) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::A", return ); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + arg2 = (realtype **)(farg2); + if (arg1) (arg1)->A = arg2; +} + + +SWIGEXPORT void * _wrap_ARKodeButcherTableMem_A_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + realtype **result = 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::A", return 0); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + result = (realtype **) ((arg1)->A); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_ARKodeButcherTableMem_c_set(SwigClassWrapper const *farg1, double *farg2) { + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + realtype *arg2 = (realtype *) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::c", return ); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + arg2 = (realtype *)(farg2); + if (arg1) (arg1)->c = arg2; +} + + +SWIGEXPORT double * _wrap_ARKodeButcherTableMem_c_get(SwigClassWrapper const *farg1) { + double * fresult ; + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + realtype *result = 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::c", return 0); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + result = (realtype *) ((arg1)->c); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_ARKodeButcherTableMem_b_set(SwigClassWrapper const *farg1, double *farg2) { + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + realtype *arg2 = (realtype *) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::b", return ); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + arg2 = (realtype *)(farg2); + if (arg1) (arg1)->b = arg2; +} + + +SWIGEXPORT double * _wrap_ARKodeButcherTableMem_b_get(SwigClassWrapper const *farg1) { + double * fresult ; + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + realtype *result = 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::b", return 0); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + result = (realtype *) ((arg1)->b); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_ARKodeButcherTableMem_d_set(SwigClassWrapper const *farg1, double *farg2) { + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + realtype *arg2 = (realtype *) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::d", return ); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + arg2 = (realtype *)(farg2); + if (arg1) (arg1)->d = arg2; +} + + +SWIGEXPORT double * _wrap_ARKodeButcherTableMem_d_get(SwigClassWrapper const *farg1) { + double * fresult ; + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + realtype *result = 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::d", return 0); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + result = (realtype *) ((arg1)->d); + fresult = result; + return fresult; +} + + +SWIGEXPORT SwigClassWrapper _wrap_new_ARKodeButcherTableMem() { + SwigClassWrapper fresult ; + struct ARKodeButcherTableMem *result = 0 ; + + result = (struct ARKodeButcherTableMem *)calloc(1, sizeof(struct ARKodeButcherTableMem)); + fresult.cptr = result; + fresult.cmemflags = SWIG_MEM_RVALUE | (1 ? SWIG_MEM_OWN : 0); + return fresult; +} + + +SWIGEXPORT void _wrap_delete_ARKodeButcherTableMem(SwigClassWrapper *farg1) { + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + + SWIG_check_mutable(*farg1, "struct ARKodeButcherTableMem *", "ARKodeButcherTableMem", "ARKodeButcherTableMem::~ARKodeButcherTableMem()", return ); + arg1 = (struct ARKodeButcherTableMem *)(farg1->cptr); + free((char *) arg1); +} + + +SWIGEXPORT void _wrap_ARKodeButcherTableMem_op_assign__(SwigClassWrapper *farg1, SwigClassWrapper const *farg2) { + struct ARKodeButcherTableMem *arg1 = (struct ARKodeButcherTableMem *) 0 ; + struct ARKodeButcherTableMem *arg2 = 0 ; + + (void)sizeof(arg1); + (void)sizeof(arg2); + SWIG_assign(farg1, *farg2); + +} + + +SWIGEXPORT void * _wrap_FARKodeButcherTable_Alloc(int const *farg1, int const *farg2) { + void * fresult ; + int arg1 ; + int arg2 ; + ARKodeButcherTable result; + + arg1 = (int)(*farg1); + arg2 = (int)(*farg2); + result = (ARKodeButcherTable)ARKodeButcherTable_Alloc(arg1,arg2); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FARKodeButcherTable_Create(int const *farg1, int const *farg2, int const *farg3, double *farg4, double *farg5, double *farg6, double *farg7) { + void * fresult ; + int arg1 ; + int arg2 ; + int arg3 ; + realtype *arg4 = (realtype *) 0 ; + realtype *arg5 = (realtype *) 0 ; + realtype *arg6 = (realtype *) 0 ; + realtype *arg7 = (realtype *) 0 ; + ARKodeButcherTable result; + + arg1 = (int)(*farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + arg4 = (realtype *)(farg4); + arg5 = (realtype *)(farg5); + arg6 = (realtype *)(farg6); + arg7 = (realtype *)(farg7); + result = (ARKodeButcherTable)ARKodeButcherTable_Create(arg1,arg2,arg3,arg4,arg5,arg6,arg7); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FARKodeButcherTable_Copy(void *farg1) { + void * fresult ; + ARKodeButcherTable arg1 = (ARKodeButcherTable) 0 ; + ARKodeButcherTable result; + + arg1 = (ARKodeButcherTable)(farg1); + result = (ARKodeButcherTable)ARKodeButcherTable_Copy(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FARKodeButcherTable_Space(void *farg1, int64_t *farg2, int64_t *farg3) { + ARKodeButcherTable arg1 = (ARKodeButcherTable) 0 ; + sunindextype *arg2 = (sunindextype *) 0 ; + sunindextype *arg3 = (sunindextype *) 0 ; + + arg1 = (ARKodeButcherTable)(farg1); + arg2 = (sunindextype *)(farg2); + arg3 = (sunindextype *)(farg3); + ARKodeButcherTable_Space(arg1,arg2,arg3); +} + + +SWIGEXPORT void _wrap_FARKodeButcherTable_Free(void *farg1) { + ARKodeButcherTable arg1 = (ARKodeButcherTable) 0 ; + + arg1 = (ARKodeButcherTable)(farg1); + ARKodeButcherTable_Free(arg1); +} + + +SWIGEXPORT void _wrap_FARKodeButcherTable_Write(void *farg1, void *farg2) { + ARKodeButcherTable arg1 = (ARKodeButcherTable) 0 ; + FILE *arg2 = (FILE *) 0 ; + + arg1 = (ARKodeButcherTable)(farg1); + arg2 = (FILE *)(farg2); + ARKodeButcherTable_Write(arg1,arg2); +} + + +SWIGEXPORT int _wrap_FARKodeButcherTable_CheckOrder(void *farg1, int *farg2, int *farg3, void *farg4) { + int fresult ; + ARKodeButcherTable arg1 = (ARKodeButcherTable) 0 ; + int *arg2 = (int *) 0 ; + int *arg3 = (int *) 0 ; + FILE *arg4 = (FILE *) 0 ; + int result; + + arg1 = (ARKodeButcherTable)(farg1); + arg2 = (int *)(farg2); + arg3 = (int *)(farg3); + arg4 = (FILE *)(farg4); + result = (int)ARKodeButcherTable_CheckOrder(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FARKodeButcherTable_CheckARKOrder(void *farg1, void *farg2, int *farg3, int *farg4, void *farg5) { + int fresult ; + ARKodeButcherTable arg1 = (ARKodeButcherTable) 0 ; + ARKodeButcherTable arg2 = (ARKodeButcherTable) 0 ; + int *arg3 = (int *) 0 ; + int *arg4 = (int *) 0 ; + FILE *arg5 = (FILE *) 0 ; + int result; + + arg1 = (ARKodeButcherTable)(farg1); + arg2 = (ARKodeButcherTable)(farg2); + arg3 = (int *)(farg3); + arg4 = (int *)(farg4); + arg5 = (FILE *)(farg5); + result = (int)ARKodeButcherTable_CheckARKOrder(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void * _wrap_FARKodeButcherTable_LoadDIRK(int const *farg1) { + void * fresult ; + ARKODE_DIRKTableID arg1 ; + ARKodeButcherTable result; + + arg1 = (ARKODE_DIRKTableID)(*farg1); + result = (ARKodeButcherTable)ARKodeButcherTable_LoadDIRK(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FARKodeButcherTable_LoadERK(int const *farg1) { + void * fresult ; + ARKODE_ERKTableID arg1 ; + ARKodeButcherTable result; + + arg1 = (ARKODE_ERKTableID)(*farg1); + result = (ARKodeButcherTable)ARKodeButcherTable_LoadERK(arg1); + fresult = result; + return fresult; +} + + + diff --git a/lib/sundials_6.1.1/src/arkode/fmod/farkode_mod.f90 b/lib/sundials_6.1.1/src/arkode/fmod/farkode_mod.f90 new file mode 100644 index 00000000000..62578d7b30e --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/fmod/farkode_mod.f90 @@ -0,0 +1,1102 @@ +! 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-2022, 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 farkode_mod + use, intrinsic :: ISO_C_BINDING + use fsundials_nvector_mod + use fsundials_context_mod + use fsundials_types_mod + use fsundials_matrix_mod + use fsundials_nvector_mod + use fsundials_context_mod + use fsundials_types_mod + use fsundials_linearsolver_mod + use fsundials_matrix_mod + use fsundials_nvector_mod + use fsundials_context_mod + use fsundials_types_mod + use fsundials_nonlinearsolver_mod + use fsundials_types_mod + implicit none + private + + ! DECLARATION CONSTRUCTS + integer(C_INT), parameter, public :: ARK_NORMAL = 1_C_INT + integer(C_INT), parameter, public :: ARK_ONE_STEP = 2_C_INT + integer(C_INT), parameter, public :: ARK_ADAPT_CUSTOM = -1_C_INT + integer(C_INT), parameter, public :: ARK_ADAPT_PID = 0_C_INT + integer(C_INT), parameter, public :: ARK_ADAPT_PI = 1_C_INT + integer(C_INT), parameter, public :: ARK_ADAPT_I = 2_C_INT + integer(C_INT), parameter, public :: ARK_ADAPT_EXP_GUS = 3_C_INT + integer(C_INT), parameter, public :: ARK_ADAPT_IMP_GUS = 4_C_INT + integer(C_INT), parameter, public :: ARK_ADAPT_IMEX_GUS = 5_C_INT + integer(C_INT), parameter, public :: ARK_FULLRHS_START = 0_C_INT + integer(C_INT), parameter, public :: ARK_FULLRHS_END = 1_C_INT + integer(C_INT), parameter, public :: ARK_FULLRHS_OTHER = 2_C_INT + integer(C_INT), parameter, public :: ARK_INTERP_MAX_DEGREE = 5_C_INT + integer(C_INT), parameter, public :: ARK_INTERP_HERMITE = 0_C_INT + integer(C_INT), parameter, public :: ARK_INTERP_LAGRANGE = 1_C_INT + integer(C_INT), parameter, public :: ARK_SUCCESS = 0_C_INT + integer(C_INT), parameter, public :: ARK_TSTOP_RETURN = 1_C_INT + integer(C_INT), parameter, public :: ARK_ROOT_RETURN = 2_C_INT + integer(C_INT), parameter, public :: ARK_WARNING = 99_C_INT + integer(C_INT), parameter, public :: ARK_TOO_MUCH_WORK = -1_C_INT + integer(C_INT), parameter, public :: ARK_TOO_MUCH_ACC = -2_C_INT + integer(C_INT), parameter, public :: ARK_ERR_FAILURE = -3_C_INT + integer(C_INT), parameter, public :: ARK_CONV_FAILURE = -4_C_INT + integer(C_INT), parameter, public :: ARK_LINIT_FAIL = -5_C_INT + integer(C_INT), parameter, public :: ARK_LSETUP_FAIL = -6_C_INT + integer(C_INT), parameter, public :: ARK_LSOLVE_FAIL = -7_C_INT + integer(C_INT), parameter, public :: ARK_RHSFUNC_FAIL = -8_C_INT + integer(C_INT), parameter, public :: ARK_FIRST_RHSFUNC_ERR = -9_C_INT + integer(C_INT), parameter, public :: ARK_REPTD_RHSFUNC_ERR = -10_C_INT + integer(C_INT), parameter, public :: ARK_UNREC_RHSFUNC_ERR = -11_C_INT + integer(C_INT), parameter, public :: ARK_RTFUNC_FAIL = -12_C_INT + integer(C_INT), parameter, public :: ARK_LFREE_FAIL = -13_C_INT + integer(C_INT), parameter, public :: ARK_MASSINIT_FAIL = -14_C_INT + integer(C_INT), parameter, public :: ARK_MASSSETUP_FAIL = -15_C_INT + integer(C_INT), parameter, public :: ARK_MASSSOLVE_FAIL = -16_C_INT + integer(C_INT), parameter, public :: ARK_MASSFREE_FAIL = -17_C_INT + integer(C_INT), parameter, public :: ARK_MASSMULT_FAIL = -18_C_INT + integer(C_INT), parameter, public :: ARK_CONSTR_FAIL = -19_C_INT + integer(C_INT), parameter, public :: ARK_MEM_FAIL = -20_C_INT + integer(C_INT), parameter, public :: ARK_MEM_NULL = -21_C_INT + integer(C_INT), parameter, public :: ARK_ILL_INPUT = -22_C_INT + integer(C_INT), parameter, public :: ARK_NO_MALLOC = -23_C_INT + integer(C_INT), parameter, public :: ARK_BAD_K = -24_C_INT + integer(C_INT), parameter, public :: ARK_BAD_T = -25_C_INT + integer(C_INT), parameter, public :: ARK_BAD_DKY = -26_C_INT + integer(C_INT), parameter, public :: ARK_TOO_CLOSE = -27_C_INT + integer(C_INT), parameter, public :: ARK_VECTOROP_ERR = -28_C_INT + integer(C_INT), parameter, public :: ARK_NLS_INIT_FAIL = -29_C_INT + integer(C_INT), parameter, public :: ARK_NLS_SETUP_FAIL = -30_C_INT + integer(C_INT), parameter, public :: ARK_NLS_SETUP_RECVR = -31_C_INT + integer(C_INT), parameter, public :: ARK_NLS_OP_ERR = -32_C_INT + integer(C_INT), parameter, public :: ARK_INNERSTEP_ATTACH_ERR = -33_C_INT + integer(C_INT), parameter, public :: ARK_INNERSTEP_FAIL = -34_C_INT + integer(C_INT), parameter, public :: ARK_OUTERTOINNER_FAIL = -35_C_INT + integer(C_INT), parameter, public :: ARK_INNERTOOUTER_FAIL = -36_C_INT + integer(C_INT), parameter, public :: ARK_POSTPROCESS_FAIL = -37_C_INT + integer(C_INT), parameter, public :: ARK_POSTPROCESS_STEP_FAIL = -37_C_INT + integer(C_INT), parameter, public :: ARK_POSTPROCESS_STAGE_FAIL = -38_C_INT + integer(C_INT), parameter, public :: ARK_USER_PREDICT_FAIL = -39_C_INT + integer(C_INT), parameter, public :: ARK_INTERP_FAIL = -40_C_INT + integer(C_INT), parameter, public :: ARK_INVALID_TABLE = -41_C_INT + integer(C_INT), parameter, public :: ARK_CONTEXT_ERR = -42_C_INT + integer(C_INT), parameter, public :: ARK_UNRECOGNIZED_ERROR = -99_C_INT + public :: FARKBandPrecInit + public :: FARKBandPrecGetWorkSpace + public :: FARKBandPrecGetNumRhsEvals + public :: FARKBBDPrecInit + 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 + contains + procedure :: set_q => swigf_ARKodeButcherTableMem_q_set + procedure :: get_q => swigf_ARKodeButcherTableMem_q_get + procedure :: set_p => swigf_ARKodeButcherTableMem_p_set + procedure :: get_p => swigf_ARKodeButcherTableMem_p_get + procedure :: set_stages => swigf_ARKodeButcherTableMem_stages_set + procedure :: get_stages => swigf_ARKodeButcherTableMem_stages_get + procedure :: set_A => swigf_ARKodeButcherTableMem_A_set + procedure :: get_A => swigf_ARKodeButcherTableMem_A_get + procedure :: set_c => swigf_ARKodeButcherTableMem_c_set + procedure :: get_c => swigf_ARKodeButcherTableMem_c_get + procedure :: set_b => swigf_ARKodeButcherTableMem_b_set + procedure :: get_b => swigf_ARKodeButcherTableMem_b_get + procedure :: set_d => swigf_ARKodeButcherTableMem_d_set + procedure :: get_d => swigf_ARKodeButcherTableMem_d_get + procedure :: release => swigf_release_ARKodeButcherTableMem + procedure, private :: swigf_ARKodeButcherTableMem_op_assign__ + generic :: assignment(=) => swigf_ARKodeButcherTableMem_op_assign__ + end type ARKodeButcherTableMem + interface ARKodeButcherTableMem + module procedure swigf_create_ARKodeButcherTableMem + end interface + public :: FARKodeButcherTable_Alloc + public :: FARKodeButcherTable_Create + public :: FARKodeButcherTable_Copy + public :: FARKodeButcherTable_Space + public :: FARKodeButcherTable_Free + public :: FARKodeButcherTable_Write + public :: FARKodeButcherTable_CheckOrder + public :: FARKodeButcherTable_CheckARKOrder + integer(C_INT), parameter, public :: SDIRK_2_1_2 = 100_C_INT + integer(C_INT), parameter, public :: BILLINGTON_3_3_2 = 101_C_INT + integer(C_INT), parameter, public :: TRBDF2_3_3_2 = 102_C_INT + integer(C_INT), parameter, public :: KVAERNO_4_2_3 = 103_C_INT + integer(C_INT), parameter, public :: ARK324L2SA_DIRK_4_2_3 = 104_C_INT + integer(C_INT), parameter, public :: CASH_5_2_4 = 105_C_INT + integer(C_INT), parameter, public :: CASH_5_3_4 = 106_C_INT + integer(C_INT), parameter, public :: SDIRK_5_3_4 = 107_C_INT + integer(C_INT), parameter, public :: KVAERNO_5_3_4 = 108_C_INT + integer(C_INT), parameter, public :: ARK436L2SA_DIRK_6_3_4 = 109_C_INT + integer(C_INT), parameter, public :: KVAERNO_7_4_5 = 110_C_INT + integer(C_INT), parameter, public :: ARK548L2SA_DIRK_8_4_5 = 111_C_INT + integer(C_INT), parameter, public :: ARK437L2SA_DIRK_7_3_4 = 112_C_INT + integer(C_INT), parameter, public :: ARK548L2SAb_DIRK_8_4_5 = 113_C_INT + integer(C_INT), parameter, public :: MIN_DIRK_NUM = 100_C_INT + integer(C_INT), parameter, public :: MAX_DIRK_NUM = 113_C_INT + ! typedef enum ARKODE_DIRKTableID + enum, bind(c) + enumerator :: ARKODE_DIRK_NONE = -1 + enumerator :: ARKODE_MIN_DIRK_NUM = 100 + enumerator :: ARKODE_SDIRK_2_1_2 = ARKODE_MIN_DIRK_NUM + enumerator :: ARKODE_BILLINGTON_3_3_2 + enumerator :: ARKODE_TRBDF2_3_3_2 + enumerator :: ARKODE_KVAERNO_4_2_3 + enumerator :: ARKODE_ARK324L2SA_DIRK_4_2_3 + enumerator :: ARKODE_CASH_5_2_4 + enumerator :: ARKODE_CASH_5_3_4 + enumerator :: ARKODE_SDIRK_5_3_4 + enumerator :: ARKODE_KVAERNO_5_3_4 + enumerator :: ARKODE_ARK436L2SA_DIRK_6_3_4 + enumerator :: ARKODE_KVAERNO_7_4_5 + enumerator :: ARKODE_ARK548L2SA_DIRK_8_4_5 + enumerator :: ARKODE_ARK437L2SA_DIRK_7_3_4 + enumerator :: ARKODE_ARK548L2SAb_DIRK_8_4_5 + enumerator :: ARKODE_MAX_DIRK_NUM = ARKODE_ARK548L2SAb_DIRK_8_4_5 + end enum + integer, parameter, public :: ARKODE_DIRKTableID = kind(ARKODE_DIRK_NONE) + public :: ARKODE_DIRK_NONE, ARKODE_MIN_DIRK_NUM, ARKODE_SDIRK_2_1_2, ARKODE_BILLINGTON_3_3_2, ARKODE_TRBDF2_3_3_2, & + ARKODE_KVAERNO_4_2_3, ARKODE_ARK324L2SA_DIRK_4_2_3, ARKODE_CASH_5_2_4, ARKODE_CASH_5_3_4, ARKODE_SDIRK_5_3_4, & + ARKODE_KVAERNO_5_3_4, ARKODE_ARK436L2SA_DIRK_6_3_4, ARKODE_KVAERNO_7_4_5, ARKODE_ARK548L2SA_DIRK_8_4_5, & + ARKODE_ARK437L2SA_DIRK_7_3_4, ARKODE_ARK548L2SAb_DIRK_8_4_5, ARKODE_MAX_DIRK_NUM + public :: FARKodeButcherTable_LoadDIRK + integer(C_INT), parameter, public :: HEUN_EULER_2_1_2 = 0_C_INT + integer(C_INT), parameter, public :: BOGACKI_SHAMPINE_4_2_3 = 1_C_INT + integer(C_INT), parameter, public :: ARK324L2SA_ERK_4_2_3 = 2_C_INT + integer(C_INT), parameter, public :: ZONNEVELD_5_3_4 = 3_C_INT + integer(C_INT), parameter, public :: ARK436L2SA_ERK_6_3_4 = 4_C_INT + integer(C_INT), parameter, public :: SAYFY_ABURUB_6_3_4 = 5_C_INT + integer(C_INT), parameter, public :: CASH_KARP_6_4_5 = 6_C_INT + integer(C_INT), parameter, public :: FEHLBERG_6_4_5 = 7_C_INT + integer(C_INT), parameter, public :: DORMAND_PRINCE_7_4_5 = 8_C_INT + integer(C_INT), parameter, public :: ARK548L2SA_ERK_8_4_5 = 9_C_INT + integer(C_INT), parameter, public :: VERNER_8_5_6 = 10_C_INT + integer(C_INT), parameter, public :: FEHLBERG_13_7_8 = 11_C_INT + integer(C_INT), parameter, public :: KNOTH_WOLKE_3_3 = 12_C_INT + integer(C_INT), parameter, public :: ARK437L2SA_ERK_7_3_4 = 13_C_INT + integer(C_INT), parameter, public :: ARK548L2SAb_ERK_8_4_5 = 14_C_INT + integer(C_INT), parameter, public :: MIN_ERK_NUM = 0_C_INT + integer(C_INT), parameter, public :: MAX_ERK_NUM = 14_C_INT + ! typedef enum ARKODE_ERKTableID + enum, bind(c) + enumerator :: ARKODE_ERK_NONE = -1 + enumerator :: ARKODE_MIN_ERK_NUM = 0 + enumerator :: ARKODE_HEUN_EULER_2_1_2 = ARKODE_MIN_ERK_NUM + enumerator :: ARKODE_BOGACKI_SHAMPINE_4_2_3 + enumerator :: ARKODE_ARK324L2SA_ERK_4_2_3 + enumerator :: ARKODE_ZONNEVELD_5_3_4 + enumerator :: ARKODE_ARK436L2SA_ERK_6_3_4 + enumerator :: ARKODE_SAYFY_ABURUB_6_3_4 + enumerator :: ARKODE_CASH_KARP_6_4_5 + enumerator :: ARKODE_FEHLBERG_6_4_5 + enumerator :: ARKODE_DORMAND_PRINCE_7_4_5 + enumerator :: ARKODE_ARK548L2SA_ERK_8_4_5 + enumerator :: ARKODE_VERNER_8_5_6 + enumerator :: ARKODE_FEHLBERG_13_7_8 + enumerator :: ARKODE_KNOTH_WOLKE_3_3 + enumerator :: ARKODE_ARK437L2SA_ERK_7_3_4 + enumerator :: ARKODE_ARK548L2SAb_ERK_8_4_5 + enumerator :: ARKODE_MAX_ERK_NUM = ARKODE_ARK548L2SAb_ERK_8_4_5 + end enum + integer, parameter, public :: ARKODE_ERKTableID = kind(ARKODE_ERK_NONE) + public :: ARKODE_ERK_NONE, ARKODE_MIN_ERK_NUM, ARKODE_HEUN_EULER_2_1_2, ARKODE_BOGACKI_SHAMPINE_4_2_3, & + ARKODE_ARK324L2SA_ERK_4_2_3, ARKODE_ZONNEVELD_5_3_4, ARKODE_ARK436L2SA_ERK_6_3_4, ARKODE_SAYFY_ABURUB_6_3_4, & + ARKODE_CASH_KARP_6_4_5, ARKODE_FEHLBERG_6_4_5, ARKODE_DORMAND_PRINCE_7_4_5, ARKODE_ARK548L2SA_ERK_8_4_5, & + ARKODE_VERNER_8_5_6, ARKODE_FEHLBERG_13_7_8, ARKODE_KNOTH_WOLKE_3_3, ARKODE_ARK437L2SA_ERK_7_3_4, & + ARKODE_ARK548L2SAb_ERK_8_4_5, ARKODE_MAX_ERK_NUM + public :: FARKodeButcherTable_LoadERK + integer(C_INT), parameter, public :: ARKLS_SUCCESS = 0_C_INT + integer(C_INT), parameter, public :: ARKLS_MEM_NULL = -1_C_INT + integer(C_INT), parameter, public :: ARKLS_LMEM_NULL = -2_C_INT + integer(C_INT), parameter, public :: ARKLS_ILL_INPUT = -3_C_INT + integer(C_INT), parameter, public :: ARKLS_MEM_FAIL = -4_C_INT + integer(C_INT), parameter, public :: ARKLS_PMEM_NULL = -5_C_INT + integer(C_INT), parameter, public :: ARKLS_MASSMEM_NULL = -6_C_INT + integer(C_INT), parameter, public :: ARKLS_JACFUNC_UNRECVR = -7_C_INT + integer(C_INT), parameter, public :: ARKLS_JACFUNC_RECVR = -8_C_INT + integer(C_INT), parameter, public :: ARKLS_MASSFUNC_UNRECVR = -9_C_INT + integer(C_INT), parameter, public :: ARKLS_MASSFUNC_RECVR = -10_C_INT + integer(C_INT), parameter, public :: ARKLS_SUNMAT_FAIL = -11_C_INT + integer(C_INT), parameter, public :: ARKLS_SUNLS_FAIL = -12_C_INT + +! WRAPPER DECLARATIONS +interface +function swigc_FARKBandPrecInit(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FARKBandPrecInit") & +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_INT64_T), intent(in) :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FARKBandPrecGetWorkSpace(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKBandPrecGetWorkSpace") & +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_FARKBandPrecGetNumRhsEvals(farg1, farg2) & +bind(C, name="_wrap_FARKBandPrecGetNumRhsEvals") & +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_FARKBBDPrecInit(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8, farg9) & +bind(C, name="_wrap_FARKBBDPrecInit") & +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_INT64_T), intent(in) :: farg4 +integer(C_INT64_T), intent(in) :: farg5 +integer(C_INT64_T), intent(in) :: farg6 +real(C_DOUBLE), intent(in) :: farg7 +type(C_FUNPTR), value :: farg8 +type(C_FUNPTR), value :: farg9 +integer(C_INT) :: fresult +end function + +function swigc_FARKBBDPrecReInit(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FARKBBDPrecReInit") & +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 +integer(C_INT) :: fresult +end function + +function swigc_FARKBBDPrecGetWorkSpace(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKBBDPrecGetWorkSpace") & +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_FARKBBDPrecGetNumGfnEvals(farg1, farg2) & +bind(C, name="_wrap_FARKBBDPrecGetNumGfnEvals") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + +subroutine swigc_ARKodeButcherTableMem_q_set(farg1, farg2) & +bind(C, name="_wrap_ARKodeButcherTableMem_q_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT), intent(in) :: farg2 +end subroutine + +function swigc_ARKodeButcherTableMem_q_get(farg1) & +bind(C, name="_wrap_ARKodeButcherTableMem_q_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: fresult +end function + +subroutine swigc_ARKodeButcherTableMem_p_set(farg1, farg2) & +bind(C, name="_wrap_ARKodeButcherTableMem_p_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT), intent(in) :: farg2 +end subroutine + +function swigc_ARKodeButcherTableMem_p_get(farg1) & +bind(C, name="_wrap_ARKodeButcherTableMem_p_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: fresult +end function + +subroutine swigc_ARKodeButcherTableMem_stages_set(farg1, farg2) & +bind(C, name="_wrap_ARKodeButcherTableMem_stages_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT), intent(in) :: farg2 +end subroutine + +function swigc_ARKodeButcherTableMem_stages_get(farg1) & +bind(C, name="_wrap_ARKodeButcherTableMem_stages_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: fresult +end function + +subroutine swigc_ARKodeButcherTableMem_A_set(farg1, farg2) & +bind(C, name="_wrap_ARKodeButcherTableMem_A_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_ARKodeButcherTableMem_A_get(farg1) & +bind(C, name="_wrap_ARKodeButcherTableMem_A_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_ARKodeButcherTableMem_c_set(farg1, farg2) & +bind(C, name="_wrap_ARKodeButcherTableMem_c_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_ARKodeButcherTableMem_c_get(farg1) & +bind(C, name="_wrap_ARKodeButcherTableMem_c_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_ARKodeButcherTableMem_b_set(farg1, farg2) & +bind(C, name="_wrap_ARKodeButcherTableMem_b_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_ARKodeButcherTableMem_b_get(farg1) & +bind(C, name="_wrap_ARKodeButcherTableMem_b_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_ARKodeButcherTableMem_d_set(farg1, farg2) & +bind(C, name="_wrap_ARKodeButcherTableMem_d_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_ARKodeButcherTableMem_d_get(farg1) & +bind(C, name="_wrap_ARKodeButcherTableMem_d_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +function swigc_new_ARKodeButcherTableMem() & +bind(C, name="_wrap_new_ARKodeButcherTableMem") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: fresult +end function + +subroutine swigc_delete_ARKodeButcherTableMem(farg1) & +bind(C, name="_wrap_delete_ARKodeButcherTableMem") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper), intent(inout) :: farg1 +end subroutine + +subroutine swigc_ARKodeButcherTableMem_op_assign__(farg1, farg2) & +bind(C, name="_wrap_ARKodeButcherTableMem_op_assign__") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper), intent(inout) :: farg1 +type(SwigClassWrapper) :: farg2 +end subroutine + +function swigc_FARKodeButcherTable_Alloc(farg1, farg2) & +bind(C, name="_wrap_FARKodeButcherTable_Alloc") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +integer(C_INT), intent(in) :: farg1 +integer(C_INT), intent(in) :: farg2 +type(C_PTR) :: fresult +end function + +function swigc_FARKodeButcherTable_Create(farg1, farg2, farg3, farg4, farg5, farg6, farg7) & +bind(C, name="_wrap_FARKodeButcherTable_Create") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +integer(C_INT), intent(in) :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT), intent(in) :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +type(C_PTR), value :: farg7 +type(C_PTR) :: fresult +end function + +function swigc_FARKodeButcherTable_Copy(farg1) & +bind(C, name="_wrap_FARKodeButcherTable_Copy") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_FARKodeButcherTable_Space(farg1, farg2, farg3) & +bind(C, name="_wrap_FARKodeButcherTable_Space") +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +end subroutine + +subroutine swigc_FARKodeButcherTable_Free(farg1) & +bind(C, name="_wrap_FARKodeButcherTable_Free") +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +end subroutine + +subroutine swigc_FARKodeButcherTable_Write(farg1, farg2) & +bind(C, name="_wrap_FARKodeButcherTable_Write") +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_FARKodeButcherTable_CheckOrder(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FARKodeButcherTable_CheckOrder") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FARKodeButcherTable_CheckARKOrder(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FARKodeButcherTable_CheckARKOrder") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FARKodeButcherTable_LoadDIRK(farg1) & +bind(C, name="_wrap_FARKodeButcherTable_LoadDIRK") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +integer(C_INT), intent(in) :: farg1 +type(C_PTR) :: fresult +end function + +function swigc_FARKodeButcherTable_LoadERK(farg1) & +bind(C, name="_wrap_FARKodeButcherTable_LoadERK") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +integer(C_INT), intent(in) :: farg1 +type(C_PTR) :: fresult +end function + +end interface + + +contains + ! MODULE SUBPROGRAMS +function FARKBandPrecInit(arkode_mem, n, mu, ml) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT64_T), intent(in) :: n +integer(C_INT64_T), intent(in) :: mu +integer(C_INT64_T), intent(in) :: ml +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +integer(C_INT64_T) :: farg4 + +farg1 = arkode_mem +farg2 = n +farg3 = mu +farg4 = ml +fresult = swigc_FARKBandPrecInit(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FARKBandPrecGetWorkSpace(arkode_mem, lenrwls, leniwls) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: lenrwls +integer(C_LONG), dimension(*), target, intent(inout) :: leniwls +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(lenrwls(1)) +farg3 = c_loc(leniwls(1)) +fresult = swigc_FARKBandPrecGetWorkSpace(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKBandPrecGetNumRhsEvals(arkode_mem, nfevalsbp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nfevalsbp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nfevalsbp(1)) +fresult = swigc_FARKBandPrecGetNumRhsEvals(farg1, farg2) +swig_result = fresult +end function + +function FARKBBDPrecInit(arkode_mem, nlocal, mudq, mldq, mukeep, mlkeep, dqrely, gloc, cfn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT64_T), intent(in) :: nlocal +integer(C_INT64_T), intent(in) :: mudq +integer(C_INT64_T), intent(in) :: mldq +integer(C_INT64_T), intent(in) :: mukeep +integer(C_INT64_T), intent(in) :: mlkeep +real(C_DOUBLE), intent(in) :: dqrely +type(C_FUNPTR), intent(in), value :: gloc +type(C_FUNPTR), intent(in), value :: cfn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +integer(C_INT64_T) :: farg4 +integer(C_INT64_T) :: farg5 +integer(C_INT64_T) :: farg6 +real(C_DOUBLE) :: farg7 +type(C_FUNPTR) :: farg8 +type(C_FUNPTR) :: farg9 + +farg1 = arkode_mem +farg2 = nlocal +farg3 = mudq +farg4 = mldq +farg5 = mukeep +farg6 = mlkeep +farg7 = dqrely +farg8 = gloc +farg9 = cfn +fresult = swigc_FARKBBDPrecInit(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8, farg9) +swig_result = fresult +end function + +function FARKBBDPrecReInit(arkode_mem, mudq, mldq, dqrely) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT64_T), intent(in) :: mudq +integer(C_INT64_T), intent(in) :: mldq +real(C_DOUBLE), intent(in) :: dqrely +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT64_T) :: farg2 +integer(C_INT64_T) :: farg3 +real(C_DOUBLE) :: farg4 + +farg1 = arkode_mem +farg2 = mudq +farg3 = mldq +farg4 = dqrely +fresult = swigc_FARKBBDPrecReInit(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FARKBBDPrecGetWorkSpace(arkode_mem, lenrwbbdp, leniwbbdp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: lenrwbbdp +integer(C_LONG), dimension(*), target, intent(inout) :: leniwbbdp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(lenrwbbdp(1)) +farg3 = c_loc(leniwbbdp(1)) +fresult = swigc_FARKBBDPrecGetWorkSpace(farg1, farg2, farg3) +swig_result = fresult +end function + +function FARKBBDPrecGetNumGfnEvals(arkode_mem, ngevalsbbdp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: ngevalsbbdp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(ngevalsbbdp(1)) +fresult = swigc_FARKBBDPrecGetNumGfnEvals(farg1, farg2) +swig_result = fresult +end function + +subroutine swigf_ARKodeButcherTableMem_q_set(self, q) +use, intrinsic :: ISO_C_BINDING +class(ARKodeButcherTableMem), intent(in) :: self +integer(C_INT), intent(in) :: q +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: farg2 + +farg1 = self%swigdata +farg2 = q +call swigc_ARKodeButcherTableMem_q_set(farg1, farg2) +end subroutine + +function swigf_ARKodeButcherTableMem_q_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +class(ARKodeButcherTableMem), intent(in) :: self +integer(C_INT) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_ARKodeButcherTableMem_q_get(farg1) +swig_result = fresult +end function + +subroutine swigf_ARKodeButcherTableMem_p_set(self, p) +use, intrinsic :: ISO_C_BINDING +class(ARKodeButcherTableMem), intent(in) :: self +integer(C_INT), intent(in) :: p +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: farg2 + +farg1 = self%swigdata +farg2 = p +call swigc_ARKodeButcherTableMem_p_set(farg1, farg2) +end subroutine + +function swigf_ARKodeButcherTableMem_p_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +class(ARKodeButcherTableMem), intent(in) :: self +integer(C_INT) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_ARKodeButcherTableMem_p_get(farg1) +swig_result = fresult +end function + +subroutine swigf_ARKodeButcherTableMem_stages_set(self, stages) +use, intrinsic :: ISO_C_BINDING +class(ARKodeButcherTableMem), intent(in) :: self +integer(C_INT), intent(in) :: stages +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: farg2 + +farg1 = self%swigdata +farg2 = stages +call swigc_ARKodeButcherTableMem_stages_set(farg1, farg2) +end subroutine + +function swigf_ARKodeButcherTableMem_stages_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +class(ARKodeButcherTableMem), intent(in) :: self +integer(C_INT) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_ARKodeButcherTableMem_stages_get(farg1) +swig_result = fresult +end function + +subroutine swigf_ARKodeButcherTableMem_A_set(self, a) +use, intrinsic :: ISO_C_BINDING +class(ARKodeButcherTableMem), intent(in) :: self +type(C_PTR), target, intent(inout) :: a +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(a) +call swigc_ARKodeButcherTableMem_A_set(farg1, farg2) +end subroutine + +function swigf_ARKodeButcherTableMem_A_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), pointer :: swig_result +class(ARKodeButcherTableMem), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_ARKodeButcherTableMem_A_get(farg1) +call c_f_pointer(fresult, swig_result) +end function + +subroutine swigf_ARKodeButcherTableMem_c_set(self, c) +use, intrinsic :: ISO_C_BINDING +class(ARKodeButcherTableMem), intent(in) :: self +real(C_DOUBLE), dimension(*), target, intent(inout) :: c +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(c(1)) +call swigc_ARKodeButcherTableMem_c_set(farg1, farg2) +end subroutine + +function swigf_ARKodeButcherTableMem_c_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +real(C_DOUBLE), dimension(:), pointer :: swig_result +class(ARKodeButcherTableMem), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_ARKodeButcherTableMem_c_get(farg1) +call c_f_pointer(fresult, swig_result, [1]) +end function + +subroutine swigf_ARKodeButcherTableMem_b_set(self, b) +use, intrinsic :: ISO_C_BINDING +class(ARKodeButcherTableMem), intent(in) :: self +real(C_DOUBLE), dimension(*), target, intent(inout) :: b +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(b(1)) +call swigc_ARKodeButcherTableMem_b_set(farg1, farg2) +end subroutine + +function swigf_ARKodeButcherTableMem_b_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +real(C_DOUBLE), dimension(:), pointer :: swig_result +class(ARKodeButcherTableMem), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_ARKodeButcherTableMem_b_get(farg1) +call c_f_pointer(fresult, swig_result, [1]) +end function + +subroutine swigf_ARKodeButcherTableMem_d_set(self, d) +use, intrinsic :: ISO_C_BINDING +class(ARKodeButcherTableMem), intent(in) :: self +real(C_DOUBLE), dimension(*), target, intent(inout) :: d +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(d(1)) +call swigc_ARKodeButcherTableMem_d_set(farg1, farg2) +end subroutine + +function swigf_ARKodeButcherTableMem_d_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +real(C_DOUBLE), dimension(:), pointer :: swig_result +class(ARKodeButcherTableMem), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_ARKodeButcherTableMem_d_get(farg1) +call c_f_pointer(fresult, swig_result, [1]) +end function + +function swigf_create_ARKodeButcherTableMem() & +result(self) +use, intrinsic :: ISO_C_BINDING +type(ARKodeButcherTableMem) :: self +type(SwigClassWrapper) :: fresult + +fresult = swigc_new_ARKodeButcherTableMem() +self%swigdata = fresult +end function + +subroutine swigf_release_ARKodeButcherTableMem(self) +use, intrinsic :: ISO_C_BINDING +class(ARKodeButcherTableMem), intent(inout) :: self +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +if (btest(farg1%cmemflags, swig_cmem_own_bit)) then +call swigc_delete_ARKodeButcherTableMem(farg1) +endif +farg1%cptr = C_NULL_PTR +farg1%cmemflags = 0 +self%swigdata = farg1 +end subroutine + +subroutine swigf_ARKodeButcherTableMem_op_assign__(self, other) +use, intrinsic :: ISO_C_BINDING +class(ARKodeButcherTableMem), intent(inout) :: self +type(ARKodeButcherTableMem), intent(in) :: other +type(SwigClassWrapper) :: farg1 +type(SwigClassWrapper) :: farg2 + +farg1 = self%swigdata +farg2 = other%swigdata +call swigc_ARKodeButcherTableMem_op_assign__(farg1, farg2) +self%swigdata = farg1 +end subroutine + +function FARKodeButcherTable_Alloc(stages, embedded) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +integer(C_INT), intent(in) :: stages +integer(C_INT), intent(in) :: embedded +type(C_PTR) :: fresult +integer(C_INT) :: farg1 +integer(C_INT) :: farg2 + +farg1 = stages +farg2 = embedded +fresult = swigc_FARKodeButcherTable_Alloc(farg1, farg2) +swig_result = fresult +end function + +function FARKodeButcherTable_Create(s, q, p, c, a, b, d) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +integer(C_INT), intent(in) :: s +integer(C_INT), intent(in) :: q +integer(C_INT), intent(in) :: p +real(C_DOUBLE), dimension(*), target, intent(inout) :: c +real(C_DOUBLE), dimension(*), target, intent(inout) :: a +real(C_DOUBLE), dimension(*), target, intent(inout) :: b +real(C_DOUBLE), dimension(*), target, intent(inout) :: d +type(C_PTR) :: fresult +integer(C_INT) :: farg1 +integer(C_INT) :: farg2 +integer(C_INT) :: farg3 +type(C_PTR) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 +type(C_PTR) :: farg7 + +farg1 = s +farg2 = q +farg3 = p +farg4 = c_loc(c(1)) +farg5 = c_loc(a(1)) +farg6 = c_loc(b(1)) +farg7 = c_loc(d(1)) +fresult = swigc_FARKodeButcherTable_Create(farg1, farg2, farg3, farg4, farg5, farg6, farg7) +swig_result = fresult +end function + +function FARKodeButcherTable_Copy(b) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +type(C_PTR) :: b +type(C_PTR) :: fresult +type(C_PTR) :: farg1 + +farg1 = b +fresult = swigc_FARKodeButcherTable_Copy(farg1) +swig_result = fresult +end function + +subroutine FARKodeButcherTable_Space(b, liw, lrw) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: b +integer(C_INT64_T), dimension(*), target, intent(inout) :: liw +integer(C_INT64_T), dimension(*), target, intent(inout) :: lrw +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = b +farg2 = c_loc(liw(1)) +farg3 = c_loc(lrw(1)) +call swigc_FARKodeButcherTable_Space(farg1, farg2, farg3) +end subroutine + +subroutine FARKodeButcherTable_Free(b) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: b +type(C_PTR) :: farg1 + +farg1 = b +call swigc_FARKodeButcherTable_Free(farg1) +end subroutine + +subroutine FARKodeButcherTable_Write(b, outfile) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: b +type(C_PTR) :: outfile +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = b +farg2 = outfile +call swigc_FARKodeButcherTable_Write(farg1, farg2) +end subroutine + +function FARKodeButcherTable_CheckOrder(b, q, p, outfile) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: b +integer(C_INT), dimension(*), target, intent(inout) :: q +integer(C_INT), dimension(*), target, intent(inout) :: p +type(C_PTR) :: outfile +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 + +farg1 = b +farg2 = c_loc(q(1)) +farg3 = c_loc(p(1)) +farg4 = outfile +fresult = swigc_FARKodeButcherTable_CheckOrder(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FARKodeButcherTable_CheckARKOrder(b1, b2, q, p, outfile) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: b1 +type(C_PTR) :: b2 +integer(C_INT), dimension(*), target, intent(inout) :: q +integer(C_INT), dimension(*), target, intent(inout) :: p +type(C_PTR) :: outfile +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 +type(C_PTR) :: farg5 + +farg1 = b1 +farg2 = b2 +farg3 = c_loc(q(1)) +farg4 = c_loc(p(1)) +farg5 = outfile +fresult = swigc_FARKodeButcherTable_CheckARKOrder(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FARKodeButcherTable_LoadDIRK(imethod) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +integer(ARKODE_DIRKTableID), intent(in) :: imethod +type(C_PTR) :: fresult +integer(C_INT) :: farg1 + +farg1 = imethod +fresult = swigc_FARKodeButcherTable_LoadDIRK(farg1) +swig_result = fresult +end function + +function FARKodeButcherTable_LoadERK(imethod) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +integer(ARKODE_ERKTableID), intent(in) :: imethod +type(C_PTR) :: fresult +integer(C_INT) :: farg1 + +farg1 = imethod +fresult = swigc_FARKodeButcherTable_LoadERK(farg1) +swig_result = fresult +end function + + +end module diff --git a/lib/sundials_6.1.1/src/arkode/fmod/farkode_mristep_mod.c b/lib/sundials_6.1.1/src/arkode/fmod/farkode_mristep_mod.c new file mode 100644 index 00000000000..36bd8d0ba48 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/fmod/farkode_mristep_mod.c @@ -0,0 +1,2006 @@ +/* ---------------------------------------------------------------------------- + * 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-2022, 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) \ + {STAN_SUNDIALS_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 "arkode/arkode_mristep.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; + } + } +} + + +typedef struct { + void* data; + size_t size; +} SwigArrayWrapper; + + +SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() { + SwigArrayWrapper result; + result.data = NULL; + result.size = 0; + return result; +} + +SWIGEXPORT void _wrap_MRIStepCouplingMem_nmat_set(SwigClassWrapper const *farg1, int const *farg2) { + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + int arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::nmat", return ); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + arg2 = (int)(*farg2); + if (arg1) (arg1)->nmat = arg2; +} + + +SWIGEXPORT int _wrap_MRIStepCouplingMem_nmat_get(SwigClassWrapper const *farg1) { + int fresult ; + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + int result; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::nmat", return 0); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + result = (int) ((arg1)->nmat); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_MRIStepCouplingMem_stages_set(SwigClassWrapper const *farg1, int const *farg2) { + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + int arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::stages", return ); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + arg2 = (int)(*farg2); + if (arg1) (arg1)->stages = arg2; +} + + +SWIGEXPORT int _wrap_MRIStepCouplingMem_stages_get(SwigClassWrapper const *farg1) { + int fresult ; + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + int result; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::stages", return 0); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + result = (int) ((arg1)->stages); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_MRIStepCouplingMem_q_set(SwigClassWrapper const *farg1, int const *farg2) { + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + int arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::q", return ); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + arg2 = (int)(*farg2); + if (arg1) (arg1)->q = arg2; +} + + +SWIGEXPORT int _wrap_MRIStepCouplingMem_q_get(SwigClassWrapper const *farg1) { + int fresult ; + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + int result; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::q", return 0); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + result = (int) ((arg1)->q); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_MRIStepCouplingMem_p_set(SwigClassWrapper const *farg1, int const *farg2) { + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + int arg2 ; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::p", return ); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + arg2 = (int)(*farg2); + if (arg1) (arg1)->p = arg2; +} + + +SWIGEXPORT int _wrap_MRIStepCouplingMem_p_get(SwigClassWrapper const *farg1) { + int fresult ; + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + int result; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::p", return 0); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + result = (int) ((arg1)->p); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_MRIStepCouplingMem_c_set(SwigClassWrapper const *farg1, double *farg2) { + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + realtype *arg2 = (realtype *) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::c", return ); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + arg2 = (realtype *)(farg2); + if (arg1) (arg1)->c = arg2; +} + + +SWIGEXPORT double * _wrap_MRIStepCouplingMem_c_get(SwigClassWrapper const *farg1) { + double * fresult ; + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + realtype *result = 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::c", return 0); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + result = (realtype *) ((arg1)->c); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_MRIStepCouplingMem_W_set(SwigClassWrapper const *farg1, void *farg2) { + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + realtype ***arg2 = (realtype ***) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::W", return ); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + arg2 = (realtype ***)(farg2); + if (arg1) (arg1)->W = arg2; +} + + +SWIGEXPORT void * _wrap_MRIStepCouplingMem_W_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + realtype ***result = 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::W", return 0); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + result = (realtype ***) ((arg1)->W); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_MRIStepCouplingMem_G_set(SwigClassWrapper const *farg1, void *farg2) { + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + realtype ***arg2 = (realtype ***) 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::G", return ); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + arg2 = (realtype ***)(farg2); + if (arg1) (arg1)->G = arg2; +} + + +SWIGEXPORT void * _wrap_MRIStepCouplingMem_G_get(SwigClassWrapper const *farg1) { + void * fresult ; + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + realtype ***result = 0 ; + + SWIG_check_mutable_nonnull(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::G", return 0); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + result = (realtype ***) ((arg1)->G); + fresult = result; + return fresult; +} + + +SWIGEXPORT SwigClassWrapper _wrap_new_MRIStepCouplingMem() { + SwigClassWrapper fresult ; + struct MRIStepCouplingMem *result = 0 ; + + result = (struct MRIStepCouplingMem *)calloc(1, sizeof(struct MRIStepCouplingMem)); + fresult.cptr = result; + fresult.cmemflags = SWIG_MEM_RVALUE | (1 ? SWIG_MEM_OWN : 0); + return fresult; +} + + +SWIGEXPORT void _wrap_delete_MRIStepCouplingMem(SwigClassWrapper *farg1) { + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + + SWIG_check_mutable(*farg1, "struct MRIStepCouplingMem *", "MRIStepCouplingMem", "MRIStepCouplingMem::~MRIStepCouplingMem()", return ); + arg1 = (struct MRIStepCouplingMem *)(farg1->cptr); + free((char *) arg1); +} + + +SWIGEXPORT void _wrap_MRIStepCouplingMem_op_assign__(SwigClassWrapper *farg1, SwigClassWrapper const *farg2) { + struct MRIStepCouplingMem *arg1 = (struct MRIStepCouplingMem *) 0 ; + struct MRIStepCouplingMem *arg2 = 0 ; + + (void)sizeof(arg1); + (void)sizeof(arg2); + SWIG_assign(farg1, *farg2); + +} + + +SWIGEXPORT void * _wrap_FMRIStepCoupling_LoadTable(int const *farg1) { + void * fresult ; + ARKODE_MRITableID arg1 ; + MRIStepCoupling result; + + arg1 = (ARKODE_MRITableID)(*farg1); + result = (MRIStepCoupling)MRIStepCoupling_LoadTable(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FMRIStepCoupling_Alloc(int const *farg1, int const *farg2, int const *farg3) { + void * fresult ; + int arg1 ; + int arg2 ; + MRISTEP_METHOD_TYPE arg3 ; + MRIStepCoupling result; + + arg1 = (int)(*farg1); + arg2 = (int)(*farg2); + arg3 = (MRISTEP_METHOD_TYPE)(*farg3); + result = (MRIStepCoupling)MRIStepCoupling_Alloc(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FMRIStepCoupling_Create(int const *farg1, int const *farg2, int const *farg3, int const *farg4, double *farg5, double *farg6, double *farg7) { + void * fresult ; + int arg1 ; + int arg2 ; + int arg3 ; + int arg4 ; + realtype *arg5 = (realtype *) 0 ; + realtype *arg6 = (realtype *) 0 ; + realtype *arg7 = (realtype *) 0 ; + MRIStepCoupling result; + + arg1 = (int)(*farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + arg4 = (int)(*farg4); + arg5 = (realtype *)(farg5); + arg6 = (realtype *)(farg6); + arg7 = (realtype *)(farg7); + result = (MRIStepCoupling)MRIStepCoupling_Create(arg1,arg2,arg3,arg4,arg5,arg6,arg7); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FMRIStepCoupling_MIStoMRI(void *farg1, int const *farg2, int const *farg3) { + void * fresult ; + ARKodeButcherTable arg1 = (ARKodeButcherTable) 0 ; + int arg2 ; + int arg3 ; + MRIStepCoupling result; + + arg1 = (ARKodeButcherTable)(farg1); + arg2 = (int)(*farg2); + arg3 = (int)(*farg3); + result = (MRIStepCoupling)MRIStepCoupling_MIStoMRI(arg1,arg2,arg3); + fresult = result; + return fresult; +} + + +SWIGEXPORT void * _wrap_FMRIStepCoupling_Copy(void *farg1) { + void * fresult ; + MRIStepCoupling arg1 = (MRIStepCoupling) 0 ; + MRIStepCoupling result; + + arg1 = (MRIStepCoupling)(farg1); + result = (MRIStepCoupling)MRIStepCoupling_Copy(arg1); + fresult = result; + return fresult; +} + + +SWIGEXPORT void _wrap_FMRIStepCoupling_Space(void *farg1, int64_t *farg2, int64_t *farg3) { + MRIStepCoupling arg1 = (MRIStepCoupling) 0 ; + sunindextype *arg2 = (sunindextype *) 0 ; + sunindextype *arg3 = (sunindextype *) 0 ; + + arg1 = (MRIStepCoupling)(farg1); + arg2 = (sunindextype *)(farg2); + arg3 = (sunindextype *)(farg3); + MRIStepCoupling_Space(arg1,arg2,arg3); +} + + +SWIGEXPORT void _wrap_FMRIStepCoupling_Free(void *farg1) { + MRIStepCoupling arg1 = (MRIStepCoupling) 0 ; + + arg1 = (MRIStepCoupling)(farg1); + MRIStepCoupling_Free(arg1); +} + + +SWIGEXPORT void _wrap_FMRIStepCoupling_Write(void *farg1, void *farg2) { + MRIStepCoupling arg1 = (MRIStepCoupling) 0 ; + FILE *arg2 = (FILE *) 0 ; + + arg1 = (MRIStepCoupling)(farg1); + arg2 = (FILE *)(farg2); + MRIStepCoupling_Write(arg1,arg2); +} + + +SWIGEXPORT void * _wrap_FMRIStepCreate(ARKRhsFn farg1, ARKRhsFn farg2, double const *farg3, N_Vector farg4, void *farg5, void *farg6) { + void * fresult ; + ARKRhsFn arg1 = (ARKRhsFn) 0 ; + ARKRhsFn arg2 = (ARKRhsFn) 0 ; + realtype arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + MRIStepInnerStepper arg5 = (MRIStepInnerStepper) 0 ; + SUNContext arg6 = (SUNContext) 0 ; + void *result = 0 ; + + arg1 = (ARKRhsFn)(farg1); + arg2 = (ARKRhsFn)(farg2); + arg3 = (realtype)(*farg3); + arg4 = (N_Vector)(farg4); + arg5 = (MRIStepInnerStepper)(farg5); + arg6 = (SUNContext)(farg6); + result = (void *)MRIStepCreate(arg1,arg2,arg3,arg4,arg5,arg6); + fresult = result; + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepResize(void *farg1, N_Vector farg2, double const *farg3, ARKVecResizeFn farg4, void *farg5) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + realtype arg3 ; + ARKVecResizeFn arg4 = (ARKVecResizeFn) 0 ; + void *arg5 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (realtype)(*farg3); + arg4 = (ARKVecResizeFn)(farg4); + arg5 = (void *)(farg5); + result = (int)MRIStepResize(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepReInit(void *farg1, ARKRhsFn farg2, ARKRhsFn farg3, double const *farg4, N_Vector farg5) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKRhsFn arg2 = (ARKRhsFn) 0 ; + ARKRhsFn arg3 = (ARKRhsFn) 0 ; + realtype arg4 ; + N_Vector arg5 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKRhsFn)(farg2); + arg3 = (ARKRhsFn)(farg3); + arg4 = (realtype)(*farg4); + arg5 = (N_Vector)(farg5); + result = (int)MRIStepReInit(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepReset(void *farg1, double const *farg2, N_Vector farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + result = (int)MRIStepReset(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSStolerances(void *farg1, double const *farg2, double const *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + realtype arg3 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (realtype)(*farg3); + result = (int)MRIStepSStolerances(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSVtolerances(void *farg1, double const *farg2, N_Vector farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + result = (int)MRIStepSVtolerances(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepWFtolerances(void *farg1, ARKEwtFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKEwtFn arg2 = (ARKEwtFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKEwtFn)(farg2); + result = (int)MRIStepWFtolerances(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetLinearSolver(void *farg1, SUNLinearSolver farg2, SUNMatrix farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + SUNLinearSolver arg2 = (SUNLinearSolver) 0 ; + SUNMatrix arg3 = (SUNMatrix) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (SUNLinearSolver)(farg2); + arg3 = (SUNMatrix)(farg3); + result = (int)MRIStepSetLinearSolver(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepRootInit(void *farg1, int const *farg2, ARKRootFn farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + ARKRootFn arg3 = (ARKRootFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + arg3 = (ARKRootFn)(farg3); + result = (int)MRIStepRootInit(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetDefaults(void *farg1) { + int fresult ; + void *arg1 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + result = (int)MRIStepSetDefaults(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetInterpolantType(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)MRIStepSetInterpolantType(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetInterpolantDegree(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)MRIStepSetInterpolantDegree(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetDenseOrder(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)MRIStepSetDenseOrder(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetNonlinearSolver(void *farg1, SUNNonlinearSolver farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + SUNNonlinearSolver arg2 = (SUNNonlinearSolver) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (SUNNonlinearSolver)(farg2); + result = (int)MRIStepSetNonlinearSolver(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetNlsRhsFn(void *farg1, ARKRhsFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKRhsFn arg2 = (ARKRhsFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKRhsFn)(farg2); + result = (int)MRIStepSetNlsRhsFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetLinear(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)MRIStepSetLinear(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetNonlinear(void *farg1) { + int fresult ; + void *arg1 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + result = (int)MRIStepSetNonlinear(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetCoupling(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + MRIStepCoupling arg2 = (MRIStepCoupling) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (MRIStepCoupling)(farg2); + result = (int)MRIStepSetCoupling(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetMaxNumSteps(void *farg1, long const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long)(*farg2); + result = (int)MRIStepSetMaxNumSteps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetNonlinCRDown(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)MRIStepSetNonlinCRDown(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetNonlinRDiv(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)MRIStepSetNonlinRDiv(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetDeltaGammaMax(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)MRIStepSetDeltaGammaMax(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetLSetupFrequency(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)MRIStepSetLSetupFrequency(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetPredictorMethod(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)MRIStepSetPredictorMethod(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetMaxNonlinIters(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)MRIStepSetMaxNonlinIters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetNonlinConvCoef(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)MRIStepSetNonlinConvCoef(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetMaxHnilWarns(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)MRIStepSetMaxHnilWarns(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetStopTime(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)MRIStepSetStopTime(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetFixedStep(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)MRIStepSetFixedStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetRootDirection(void *farg1, int *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int *arg2 = (int *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int *)(farg2); + result = (int)MRIStepSetRootDirection(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetNoInactiveRootWarn(void *farg1) { + int fresult ; + void *arg1 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + result = (int)MRIStepSetNoInactiveRootWarn(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetErrHandlerFn(void *farg1, ARKErrHandlerFn farg2, void *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKErrHandlerFn arg2 = (ARKErrHandlerFn) 0 ; + void *arg3 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKErrHandlerFn)(farg2); + arg3 = (void *)(farg3); + result = (int)MRIStepSetErrHandlerFn(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetErrFile(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)MRIStepSetErrFile(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetUserData(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + void *arg2 = (void *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (void *)(farg2); + result = (int)MRIStepSetUserData(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetDiagnostics(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)MRIStepSetDiagnostics(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetPostprocessStepFn(void *farg1, ARKPostProcessFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKPostProcessFn arg2 = (ARKPostProcessFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKPostProcessFn)(farg2); + result = (int)MRIStepSetPostprocessStepFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetPostprocessStageFn(void *farg1, ARKPostProcessFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKPostProcessFn arg2 = (ARKPostProcessFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKPostProcessFn)(farg2); + result = (int)MRIStepSetPostprocessStageFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetPreInnerFn(void *farg1, MRIStepPreInnerFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + MRIStepPreInnerFn arg2 = (MRIStepPreInnerFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (MRIStepPreInnerFn)(farg2); + result = (int)MRIStepSetPreInnerFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetPostInnerFn(void *farg1, MRIStepPostInnerFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + MRIStepPostInnerFn arg2 = (MRIStepPostInnerFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (MRIStepPostInnerFn)(farg2); + result = (int)MRIStepSetPostInnerFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetStagePredictFn(void *farg1, ARKStagePredictFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKStagePredictFn arg2 = (ARKStagePredictFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKStagePredictFn)(farg2); + result = (int)MRIStepSetStagePredictFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetJacFn(void *farg1, ARKLsJacFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKLsJacFn arg2 = (ARKLsJacFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKLsJacFn)(farg2); + result = (int)MRIStepSetJacFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetJacEvalFrequency(void *farg1, long const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long)(*farg2); + result = (int)MRIStepSetJacEvalFrequency(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetLinearSolutionScaling(void *farg1, int const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int)(*farg2); + result = (int)MRIStepSetLinearSolutionScaling(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetEpsLin(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)MRIStepSetEpsLin(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetLSNormFactor(void *farg1, double const *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + result = (int)MRIStepSetLSNormFactor(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetPreconditioner(void *farg1, ARKLsPrecSetupFn farg2, ARKLsPrecSolveFn farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKLsPrecSetupFn arg2 = (ARKLsPrecSetupFn) 0 ; + ARKLsPrecSolveFn arg3 = (ARKLsPrecSolveFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKLsPrecSetupFn)(farg2); + arg3 = (ARKLsPrecSolveFn)(farg3); + result = (int)MRIStepSetPreconditioner(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetJacTimes(void *farg1, ARKLsJacTimesSetupFn farg2, ARKLsJacTimesVecFn farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKLsJacTimesSetupFn arg2 = (ARKLsJacTimesSetupFn) 0 ; + ARKLsJacTimesVecFn arg3 = (ARKLsJacTimesVecFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKLsJacTimesSetupFn)(farg2); + arg3 = (ARKLsJacTimesVecFn)(farg3); + result = (int)MRIStepSetJacTimes(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetJacTimesRhsFn(void *farg1, ARKRhsFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKRhsFn arg2 = (ARKRhsFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKRhsFn)(farg2); + result = (int)MRIStepSetJacTimesRhsFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepSetLinSysFn(void *farg1, ARKLsLinSysFn farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + ARKLsLinSysFn arg2 = (ARKLsLinSysFn) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (ARKLsLinSysFn)(farg2); + result = (int)MRIStepSetLinSysFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepEvolve(void *farg1, double const *farg2, N_Vector farg3, double *farg4, int const *farg5) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + realtype *arg4 = (realtype *) 0 ; + int arg5 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + arg4 = (realtype *)(farg4); + arg5 = (int)(*farg5); + result = (int)MRIStepEvolve(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetDky(void *farg1, double const *farg2, int const *farg3, N_Vector farg4) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype arg2 ; + int arg3 ; + N_Vector arg4 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (int)(*farg3); + arg4 = (N_Vector)(farg4); + result = (int)MRIStepGetDky(arg1,arg2,arg3,arg4); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepComputeState(void *farg1, N_Vector farg2, N_Vector farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + arg3 = (N_Vector)(farg3); + result = (int)MRIStepComputeState(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumRhsEvals(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)MRIStepGetNumRhsEvals(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumLinSolvSetups(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumLinSolvSetups(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetCurrentCoupling(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + MRIStepCoupling *arg2 = (MRIStepCoupling *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (MRIStepCoupling *)(farg2); + result = (int)MRIStepGetCurrentCoupling(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetWorkSpace(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)MRIStepGetWorkSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumSteps(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumSteps(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetLastStep(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)MRIStepGetLastStep(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetCurrentTime(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)MRIStepGetCurrentTime(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetCurrentState(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector *arg2 = (N_Vector *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector *)(farg2); + result = (int)MRIStepGetCurrentState(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetCurrentGamma(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)MRIStepGetCurrentGamma(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetTolScaleFactor(void *farg1, double *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + result = (int)MRIStepGetTolScaleFactor(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetErrWeights(void *farg1, N_Vector farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + N_Vector arg2 = (N_Vector) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (N_Vector)(farg2); + result = (int)MRIStepGetErrWeights(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumGEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumGEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetRootInfo(void *farg1, int *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int *arg2 = (int *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int *)(farg2); + result = (int)MRIStepGetRootInfo(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetLastInnerStepFlag(void *farg1, int *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + int *arg2 = (int *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (int *)(farg2); + result = (int)MRIStepGetLastInnerStepFlag(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SwigArrayWrapper _wrap_FMRIStepGetReturnFlagName(long const *farg1) { + SwigArrayWrapper fresult ; + long arg1 ; + char *result = 0 ; + + arg1 = (long)(*farg1); + result = (char *)MRIStepGetReturnFlagName(arg1); + fresult.size = strlen((const char*)(result)); + fresult.data = (char *)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepWriteParameters(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)MRIStepWriteParameters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepWriteCoupling(void *farg1, void *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + result = (int)MRIStepWriteCoupling(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNonlinearSystemData(void *farg1, double *farg2, void *farg3, void *farg4, void *farg5, double *farg6, void *farg7, void *farg8) { + int fresult ; + void *arg1 = (void *) 0 ; + realtype *arg2 = (realtype *) 0 ; + N_Vector *arg3 = (N_Vector *) 0 ; + N_Vector *arg4 = (N_Vector *) 0 ; + N_Vector *arg5 = (N_Vector *) 0 ; + realtype *arg6 = (realtype *) 0 ; + N_Vector *arg7 = (N_Vector *) 0 ; + void **arg8 = (void **) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (realtype *)(farg2); + arg3 = (N_Vector *)(farg3); + arg4 = (N_Vector *)(farg4); + arg5 = (N_Vector *)(farg5); + arg6 = (realtype *)(farg6); + arg7 = (N_Vector *)(farg7); + arg8 = (void **)(farg8); + result = (int)MRIStepGetNonlinearSystemData(arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumNonlinSolvIters(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumNonlinSolvIters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumNonlinSolvConvFails(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumNonlinSolvConvFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNonlinSolvStats(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)MRIStepGetNonlinSolvStats(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetLinWorkSpace(void *farg1, long *farg2, long *farg3) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + long *arg3 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + arg3 = (long *)(farg3); + result = (int)MRIStepGetLinWorkSpace(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumJacEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumJacEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumPrecEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumPrecEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumPrecSolves(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumPrecSolves(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumLinIters(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumLinIters(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumLinConvFails(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumLinConvFails(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumJTSetupEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumJTSetupEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumJtimesEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumJtimesEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetNumLinRhsEvals(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetNumLinRhsEvals(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepGetLastLinFlag(void *farg1, long *farg2) { + int fresult ; + void *arg1 = (void *) 0 ; + long *arg2 = (long *) 0 ; + int result; + + arg1 = (void *)(farg1); + arg2 = (long *)(farg2); + result = (int)MRIStepGetLastLinFlag(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT SwigArrayWrapper _wrap_FMRIStepGetLinReturnFlagName(long const *farg1) { + SwigArrayWrapper fresult ; + long arg1 ; + char *result = 0 ; + + arg1 = (long)(*farg1); + result = (char *)MRIStepGetLinReturnFlagName(arg1); + fresult.size = strlen((const char*)(result)); + fresult.data = (char *)(result); + return fresult; +} + + +SWIGEXPORT void _wrap_FMRIStepFree(void *farg1) { + void **arg1 = (void **) 0 ; + + arg1 = (void **)(farg1); + MRIStepFree(arg1); +} + + +SWIGEXPORT void _wrap_FMRIStepPrintMem(void *farg1, void *farg2) { + void *arg1 = (void *) 0 ; + FILE *arg2 = (FILE *) 0 ; + + arg1 = (void *)(farg1); + arg2 = (FILE *)(farg2); + MRIStepPrintMem(arg1,arg2); +} + + +SWIGEXPORT int _wrap_FMRIStepInnerStepper_Create(void *farg1, void *farg2) { + int fresult ; + SUNContext arg1 = (SUNContext) 0 ; + MRIStepInnerStepper *arg2 = (MRIStepInnerStepper *) 0 ; + int result; + + arg1 = (SUNContext)(farg1); + arg2 = (MRIStepInnerStepper *)(farg2); + result = (int)MRIStepInnerStepper_Create(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepInnerStepper_Free(void *farg1) { + int fresult ; + MRIStepInnerStepper *arg1 = (MRIStepInnerStepper *) 0 ; + int result; + + arg1 = (MRIStepInnerStepper *)(farg1); + result = (int)MRIStepInnerStepper_Free(arg1); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepInnerStepper_SetContent(void *farg1, void *farg2) { + int fresult ; + MRIStepInnerStepper arg1 = (MRIStepInnerStepper) 0 ; + void *arg2 = (void *) 0 ; + int result; + + arg1 = (MRIStepInnerStepper)(farg1); + arg2 = (void *)(farg2); + result = (int)MRIStepInnerStepper_SetContent(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepInnerStepper_GetContent(void *farg1, void *farg2) { + int fresult ; + MRIStepInnerStepper arg1 = (MRIStepInnerStepper) 0 ; + void **arg2 = (void **) 0 ; + int result; + + arg1 = (MRIStepInnerStepper)(farg1); + arg2 = (void **)(farg2); + result = (int)MRIStepInnerStepper_GetContent(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepInnerStepper_SetEvolveFn(void *farg1, MRIStepInnerEvolveFn farg2) { + int fresult ; + MRIStepInnerStepper arg1 = (MRIStepInnerStepper) 0 ; + MRIStepInnerEvolveFn arg2 = (MRIStepInnerEvolveFn) 0 ; + int result; + + arg1 = (MRIStepInnerStepper)(farg1); + arg2 = (MRIStepInnerEvolveFn)(farg2); + result = (int)MRIStepInnerStepper_SetEvolveFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepInnerStepper_SetFullRhsFn(void *farg1, MRIStepInnerFullRhsFn farg2) { + int fresult ; + MRIStepInnerStepper arg1 = (MRIStepInnerStepper) 0 ; + MRIStepInnerFullRhsFn arg2 = (MRIStepInnerFullRhsFn) 0 ; + int result; + + arg1 = (MRIStepInnerStepper)(farg1); + arg2 = (MRIStepInnerFullRhsFn)(farg2); + result = (int)MRIStepInnerStepper_SetFullRhsFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepInnerStepper_SetResetFn(void *farg1, MRIStepInnerResetFn farg2) { + int fresult ; + MRIStepInnerStepper arg1 = (MRIStepInnerStepper) 0 ; + MRIStepInnerResetFn arg2 = (MRIStepInnerResetFn) 0 ; + int result; + + arg1 = (MRIStepInnerStepper)(farg1); + arg2 = (MRIStepInnerResetFn)(farg2); + result = (int)MRIStepInnerStepper_SetResetFn(arg1,arg2); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepInnerStepper_AddForcing(void *farg1, double const *farg2, N_Vector farg3) { + int fresult ; + MRIStepInnerStepper arg1 = (MRIStepInnerStepper) 0 ; + realtype arg2 ; + N_Vector arg3 = (N_Vector) 0 ; + int result; + + arg1 = (MRIStepInnerStepper)(farg1); + arg2 = (realtype)(*farg2); + arg3 = (N_Vector)(farg3); + result = (int)MRIStepInnerStepper_AddForcing(arg1,arg2,arg3); + fresult = (int)(result); + return fresult; +} + + +SWIGEXPORT int _wrap_FMRIStepInnerStepper_GetForcingData(void *farg1, double *farg2, double *farg3, void *farg4, int *farg5) { + int fresult ; + MRIStepInnerStepper arg1 = (MRIStepInnerStepper) 0 ; + realtype *arg2 = (realtype *) 0 ; + realtype *arg3 = (realtype *) 0 ; + N_Vector **arg4 = (N_Vector **) 0 ; + int *arg5 = (int *) 0 ; + int result; + + arg1 = (MRIStepInnerStepper)(farg1); + arg2 = (realtype *)(farg2); + arg3 = (realtype *)(farg3); + arg4 = (N_Vector **)(farg4); + arg5 = (int *)(farg5); + result = (int)MRIStepInnerStepper_GetForcingData(arg1,arg2,arg3,arg4,arg5); + fresult = (int)(result); + return fresult; +} + + + diff --git a/lib/sundials_6.1.1/src/arkode/fmod/farkode_mristep_mod.f90 b/lib/sundials_6.1.1/src/arkode/fmod/farkode_mristep_mod.f90 new file mode 100644 index 00000000000..9ee5f548cf0 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/fmod/farkode_mristep_mod.f90 @@ -0,0 +1,3303 @@ +! 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-2022, 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 farkode_mristep_mod + use, intrinsic :: ISO_C_BINDING + use farkode_mod + use fsundials_nvector_mod + use fsundials_context_mod + use fsundials_types_mod + use fsundials_matrix_mod + use fsundials_nvector_mod + use fsundials_context_mod + use fsundials_types_mod + use fsundials_linearsolver_mod + use fsundials_matrix_mod + use fsundials_nvector_mod + use fsundials_context_mod + use fsundials_types_mod + use fsundials_nonlinearsolver_mod + use fsundials_types_mod + implicit none + private + + ! DECLARATION CONSTRUCTS + ! typedef enum MRISTEP_METHOD_TYPE + enum, bind(c) + enumerator :: MRISTEP_EXPLICIT + enumerator :: MRISTEP_IMPLICIT + enumerator :: MRISTEP_IMEX + end enum + integer, parameter, public :: MRISTEP_METHOD_TYPE = kind(MRISTEP_EXPLICIT) + public :: MRISTEP_EXPLICIT, MRISTEP_IMPLICIT, MRISTEP_IMEX + integer(C_INT), parameter, public :: MIS_KW3 = 200_C_INT + integer(C_INT), parameter, public :: MRI_GARK_ERK33a = 201_C_INT + integer(C_INT), parameter, public :: MRI_GARK_ERK45a = 202_C_INT + integer(C_INT), parameter, public :: MRI_GARK_IRK21a = 203_C_INT + integer(C_INT), parameter, public :: MRI_GARK_ESDIRK34a = 204_C_INT + integer(C_INT), parameter, public :: MRI_GARK_ESDIRK46a = 205_C_INT + integer(C_INT), parameter, public :: IMEX_MRI_GARK3a = 206_C_INT + integer(C_INT), parameter, public :: IMEX_MRI_GARK3b = 207_C_INT + integer(C_INT), parameter, public :: IMEX_MRI_GARK4 = 208_C_INT + integer(C_INT), parameter, public :: MIN_MRI_NUM = 200_C_INT + integer(C_INT), parameter, public :: MAX_MRI_NUM = 208_C_INT + ! typedef enum ARKODE_MRITableID + enum, bind(c) + enumerator :: ARKODE_MRI_NONE = -1 + enumerator :: ARKODE_MIN_MRI_NUM = 200 + enumerator :: ARKODE_MIS_KW3 = ARKODE_MIN_MRI_NUM + enumerator :: ARKODE_MRI_GARK_ERK33a + enumerator :: ARKODE_MRI_GARK_ERK45a + enumerator :: ARKODE_MRI_GARK_IRK21a + enumerator :: ARKODE_MRI_GARK_ESDIRK34a + enumerator :: ARKODE_MRI_GARK_ESDIRK46a + enumerator :: ARKODE_IMEX_MRI_GARK3a + enumerator :: ARKODE_IMEX_MRI_GARK3b + enumerator :: ARKODE_IMEX_MRI_GARK4 + enumerator :: ARKODE_MAX_MRI_NUM = ARKODE_IMEX_MRI_GARK4 + end enum + integer, parameter, public :: ARKODE_MRITableID = kind(ARKODE_MRI_NONE) + public :: ARKODE_MRI_NONE, ARKODE_MIN_MRI_NUM, ARKODE_MIS_KW3, ARKODE_MRI_GARK_ERK33a, ARKODE_MRI_GARK_ERK45a, & + ARKODE_MRI_GARK_IRK21a, ARKODE_MRI_GARK_ESDIRK34a, ARKODE_MRI_GARK_ESDIRK46a, ARKODE_IMEX_MRI_GARK3a, & + ARKODE_IMEX_MRI_GARK3b, ARKODE_IMEX_MRI_GARK4, ARKODE_MAX_MRI_NUM + integer(C_INT), parameter, public :: MRISTEP_DEFAULT_3 = ARKODE_MIS_KW3 + integer(C_INT), parameter, public :: MRISTEP_DEFAULT_EXPL_3 = ARKODE_MIS_KW3 + integer(C_INT), parameter, public :: MRISTEP_DEFAULT_EXPL_4 = ARKODE_MRI_GARK_ERK45a + integer(C_INT), parameter, public :: MRISTEP_DEFAULT_IMPL_SD_2 = ARKODE_MRI_GARK_IRK21a + integer(C_INT), parameter, public :: MRISTEP_DEFAULT_IMPL_SD_3 = ARKODE_MRI_GARK_ESDIRK34a + integer(C_INT), parameter, public :: MRISTEP_DEFAULT_IMPL_SD_4 = ARKODE_MRI_GARK_ESDIRK46a + integer(C_INT), parameter, public :: MRISTEP_DEFAULT_IMEX_SD_3 = ARKODE_IMEX_MRI_GARK3b + integer(C_INT), parameter, public :: MRISTEP_DEFAULT_IMEX_SD_4 = ARKODE_IMEX_MRI_GARK4 + + 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 MRIStepCouplingMem + type, public :: MRIStepCouplingMem + type(SwigClassWrapper), public :: swigdata + contains + procedure :: set_nmat => swigf_MRIStepCouplingMem_nmat_set + procedure :: get_nmat => swigf_MRIStepCouplingMem_nmat_get + procedure :: set_stages => swigf_MRIStepCouplingMem_stages_set + procedure :: get_stages => swigf_MRIStepCouplingMem_stages_get + procedure :: set_q => swigf_MRIStepCouplingMem_q_set + procedure :: get_q => swigf_MRIStepCouplingMem_q_get + procedure :: set_p => swigf_MRIStepCouplingMem_p_set + procedure :: get_p => swigf_MRIStepCouplingMem_p_get + procedure :: set_c => swigf_MRIStepCouplingMem_c_set + procedure :: get_c => swigf_MRIStepCouplingMem_c_get + procedure :: set_W => swigf_MRIStepCouplingMem_W_set + procedure :: get_W => swigf_MRIStepCouplingMem_W_get + procedure :: set_G => swigf_MRIStepCouplingMem_G_set + procedure :: get_G => swigf_MRIStepCouplingMem_G_get + procedure :: release => swigf_release_MRIStepCouplingMem + procedure, private :: swigf_MRIStepCouplingMem_op_assign__ + generic :: assignment(=) => swigf_MRIStepCouplingMem_op_assign__ + end type MRIStepCouplingMem + interface MRIStepCouplingMem + module procedure swigf_create_MRIStepCouplingMem + end interface + public :: FMRIStepCoupling_LoadTable + public :: FMRIStepCoupling_Alloc + public :: FMRIStepCoupling_Create + public :: FMRIStepCoupling_MIStoMRI + public :: FMRIStepCoupling_Copy + public :: FMRIStepCoupling_Space + public :: FMRIStepCoupling_Free + public :: FMRIStepCoupling_Write + public :: FMRIStepCreate + public :: FMRIStepResize + public :: FMRIStepReInit + public :: FMRIStepReset + public :: FMRIStepSStolerances + public :: FMRIStepSVtolerances + public :: FMRIStepWFtolerances + public :: FMRIStepSetLinearSolver + public :: FMRIStepRootInit + public :: FMRIStepSetDefaults + public :: FMRIStepSetInterpolantType + public :: FMRIStepSetInterpolantDegree + public :: FMRIStepSetDenseOrder + public :: FMRIStepSetNonlinearSolver + public :: FMRIStepSetNlsRhsFn + public :: FMRIStepSetLinear + public :: FMRIStepSetNonlinear + public :: FMRIStepSetCoupling + public :: FMRIStepSetMaxNumSteps + public :: FMRIStepSetNonlinCRDown + public :: FMRIStepSetNonlinRDiv + public :: FMRIStepSetDeltaGammaMax + public :: FMRIStepSetLSetupFrequency + public :: FMRIStepSetPredictorMethod + public :: FMRIStepSetMaxNonlinIters + public :: FMRIStepSetNonlinConvCoef + public :: FMRIStepSetMaxHnilWarns + public :: FMRIStepSetStopTime + public :: FMRIStepSetFixedStep + public :: FMRIStepSetRootDirection + public :: FMRIStepSetNoInactiveRootWarn + public :: FMRIStepSetErrHandlerFn + public :: FMRIStepSetErrFile + public :: FMRIStepSetUserData + public :: FMRIStepSetDiagnostics + public :: FMRIStepSetPostprocessStepFn + public :: FMRIStepSetPostprocessStageFn + public :: FMRIStepSetPreInnerFn + public :: FMRIStepSetPostInnerFn + public :: FMRIStepSetStagePredictFn + public :: FMRIStepSetJacFn + public :: FMRIStepSetJacEvalFrequency + public :: FMRIStepSetLinearSolutionScaling + public :: FMRIStepSetEpsLin + public :: FMRIStepSetLSNormFactor + public :: FMRIStepSetPreconditioner + public :: FMRIStepSetJacTimes + public :: FMRIStepSetJacTimesRhsFn + public :: FMRIStepSetLinSysFn + public :: FMRIStepEvolve + public :: FMRIStepGetDky + public :: FMRIStepComputeState + public :: FMRIStepGetNumRhsEvals + public :: FMRIStepGetNumLinSolvSetups + public :: FMRIStepGetCurrentCoupling + public :: FMRIStepGetWorkSpace + public :: FMRIStepGetNumSteps + public :: FMRIStepGetLastStep + public :: FMRIStepGetCurrentTime + public :: FMRIStepGetCurrentState + public :: FMRIStepGetCurrentGamma + public :: FMRIStepGetTolScaleFactor + public :: FMRIStepGetErrWeights + public :: FMRIStepGetNumGEvals + public :: FMRIStepGetRootInfo + public :: FMRIStepGetLastInnerStepFlag + type, bind(C) :: SwigArrayWrapper + type(C_PTR), public :: data = C_NULL_PTR + integer(C_SIZE_T), public :: size = 0 + end type + public :: FMRIStepGetReturnFlagName + public :: FMRIStepWriteParameters + public :: FMRIStepWriteCoupling + public :: FMRIStepGetNonlinearSystemData + public :: FMRIStepGetNumNonlinSolvIters + public :: FMRIStepGetNumNonlinSolvConvFails + public :: FMRIStepGetNonlinSolvStats + public :: FMRIStepGetLinWorkSpace + public :: FMRIStepGetNumJacEvals + public :: FMRIStepGetNumPrecEvals + public :: FMRIStepGetNumPrecSolves + public :: FMRIStepGetNumLinIters + public :: FMRIStepGetNumLinConvFails + public :: FMRIStepGetNumJTSetupEvals + public :: FMRIStepGetNumJtimesEvals + public :: FMRIStepGetNumLinRhsEvals + public :: FMRIStepGetLastLinFlag + public :: FMRIStepGetLinReturnFlagName + public :: FMRIStepFree + public :: FMRIStepPrintMem + public :: FMRIStepInnerStepper_Create + public :: FMRIStepInnerStepper_Free + public :: FMRIStepInnerStepper_SetContent + public :: FMRIStepInnerStepper_GetContent + public :: FMRIStepInnerStepper_SetEvolveFn + public :: FMRIStepInnerStepper_SetFullRhsFn + public :: FMRIStepInnerStepper_SetResetFn + public :: FMRIStepInnerStepper_AddForcing + public :: FMRIStepInnerStepper_GetForcingData + +! WRAPPER DECLARATIONS +interface +subroutine swigc_MRIStepCouplingMem_nmat_set(farg1, farg2) & +bind(C, name="_wrap_MRIStepCouplingMem_nmat_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT), intent(in) :: farg2 +end subroutine + +function swigc_MRIStepCouplingMem_nmat_get(farg1) & +bind(C, name="_wrap_MRIStepCouplingMem_nmat_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: fresult +end function + +subroutine swigc_MRIStepCouplingMem_stages_set(farg1, farg2) & +bind(C, name="_wrap_MRIStepCouplingMem_stages_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT), intent(in) :: farg2 +end subroutine + +function swigc_MRIStepCouplingMem_stages_get(farg1) & +bind(C, name="_wrap_MRIStepCouplingMem_stages_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: fresult +end function + +subroutine swigc_MRIStepCouplingMem_q_set(farg1, farg2) & +bind(C, name="_wrap_MRIStepCouplingMem_q_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT), intent(in) :: farg2 +end subroutine + +function swigc_MRIStepCouplingMem_q_get(farg1) & +bind(C, name="_wrap_MRIStepCouplingMem_q_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: fresult +end function + +subroutine swigc_MRIStepCouplingMem_p_set(farg1, farg2) & +bind(C, name="_wrap_MRIStepCouplingMem_p_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT), intent(in) :: farg2 +end subroutine + +function swigc_MRIStepCouplingMem_p_get(farg1) & +bind(C, name="_wrap_MRIStepCouplingMem_p_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: fresult +end function + +subroutine swigc_MRIStepCouplingMem_c_set(farg1, farg2) & +bind(C, name="_wrap_MRIStepCouplingMem_c_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_MRIStepCouplingMem_c_get(farg1) & +bind(C, name="_wrap_MRIStepCouplingMem_c_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_MRIStepCouplingMem_W_set(farg1, farg2) & +bind(C, name="_wrap_MRIStepCouplingMem_W_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_MRIStepCouplingMem_W_get(farg1) & +bind(C, name="_wrap_MRIStepCouplingMem_W_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_MRIStepCouplingMem_G_set(farg1, farg2) & +bind(C, name="_wrap_MRIStepCouplingMem_G_set") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_MRIStepCouplingMem_G_get(farg1) & +bind(C, name="_wrap_MRIStepCouplingMem_G_get") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: fresult +end function + +function swigc_new_MRIStepCouplingMem() & +bind(C, name="_wrap_new_MRIStepCouplingMem") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper) :: fresult +end function + +subroutine swigc_delete_MRIStepCouplingMem(farg1) & +bind(C, name="_wrap_delete_MRIStepCouplingMem") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper), intent(inout) :: farg1 +end subroutine + +subroutine swigc_MRIStepCouplingMem_op_assign__(farg1, farg2) & +bind(C, name="_wrap_MRIStepCouplingMem_op_assign__") +use, intrinsic :: ISO_C_BINDING +import :: swigclasswrapper +type(SwigClassWrapper), intent(inout) :: farg1 +type(SwigClassWrapper) :: farg2 +end subroutine + +function swigc_FMRIStepCoupling_LoadTable(farg1) & +bind(C, name="_wrap_FMRIStepCoupling_LoadTable") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +integer(C_INT), intent(in) :: farg1 +type(C_PTR) :: fresult +end function + +function swigc_FMRIStepCoupling_Alloc(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepCoupling_Alloc") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +integer(C_INT), intent(in) :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT), intent(in) :: farg3 +type(C_PTR) :: fresult +end function + +function swigc_FMRIStepCoupling_Create(farg1, farg2, farg3, farg4, farg5, farg6, farg7) & +bind(C, name="_wrap_FMRIStepCoupling_Create") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +integer(C_INT), intent(in) :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT), intent(in) :: farg3 +integer(C_INT), intent(in) :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +type(C_PTR), value :: farg7 +type(C_PTR) :: fresult +end function + +function swigc_FMRIStepCoupling_MIStoMRI(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepCoupling_MIStoMRI") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +integer(C_INT), intent(in) :: farg3 +type(C_PTR) :: fresult +end function + +function swigc_FMRIStepCoupling_Copy(farg1) & +bind(C, name="_wrap_FMRIStepCoupling_Copy") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR) :: fresult +end function + +subroutine swigc_FMRIStepCoupling_Space(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepCoupling_Space") +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +end subroutine + +subroutine swigc_FMRIStepCoupling_Free(farg1) & +bind(C, name="_wrap_FMRIStepCoupling_Free") +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +end subroutine + +subroutine swigc_FMRIStepCoupling_Write(farg1, farg2) & +bind(C, name="_wrap_FMRIStepCoupling_Write") +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_FMRIStepCreate(farg1, farg2, farg3, farg4, farg5, farg6) & +bind(C, name="_wrap_FMRIStepCreate") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_FUNPTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +type(C_PTR) :: fresult +end function + +function swigc_FMRIStepResize(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FMRIStepResize") & +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_FUNPTR), value :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepReInit(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FMRIStepReInit") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_FUNPTR), value :: farg3 +real(C_DOUBLE), intent(in) :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepReset(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepReset") & +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_INT) :: fresult +end function + +function swigc_FMRIStepSStolerances(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepSStolerances") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +real(C_DOUBLE), intent(in) :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepSVtolerances(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepSVtolerances") & +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_INT) :: fresult +end function + +function swigc_FMRIStepWFtolerances(farg1, farg2) & +bind(C, name="_wrap_FMRIStepWFtolerances") & +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_FMRIStepSetLinearSolver(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepSetLinearSolver") & +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_FMRIStepRootInit(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepRootInit") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT), intent(in) :: farg2 +type(C_FUNPTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepSetDefaults(farg1) & +bind(C, name="_wrap_FMRIStepSetDefaults") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepSetInterpolantType(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetInterpolantType") & +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_FMRIStepSetInterpolantDegree(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetInterpolantDegree") & +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_FMRIStepSetDenseOrder(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetDenseOrder") & +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_FMRIStepSetNonlinearSolver(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetNonlinearSolver") & +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_FMRIStepSetNlsRhsFn(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetNlsRhsFn") & +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_FMRIStepSetLinear(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetLinear") & +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_FMRIStepSetNonlinear(farg1) & +bind(C, name="_wrap_FMRIStepSetNonlinear") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepSetCoupling(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetCoupling") & +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_FMRIStepSetMaxNumSteps(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetMaxNumSteps") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_LONG), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepSetNonlinCRDown(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetNonlinCRDown") & +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_FMRIStepSetNonlinRDiv(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetNonlinRDiv") & +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_FMRIStepSetDeltaGammaMax(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetDeltaGammaMax") & +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_FMRIStepSetLSetupFrequency(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetLSetupFrequency") & +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_FMRIStepSetPredictorMethod(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetPredictorMethod") & +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_FMRIStepSetMaxNonlinIters(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetMaxNonlinIters") & +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_FMRIStepSetNonlinConvCoef(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetNonlinConvCoef") & +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_FMRIStepSetMaxHnilWarns(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetMaxHnilWarns") & +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_FMRIStepSetStopTime(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetStopTime") & +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_FMRIStepSetFixedStep(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetFixedStep") & +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_FMRIStepSetRootDirection(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetRootDirection") & +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_FMRIStepSetNoInactiveRootWarn(farg1) & +bind(C, name="_wrap_FMRIStepSetNoInactiveRootWarn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepSetErrHandlerFn(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepSetErrHandlerFn") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_FUNPTR), value :: farg2 +type(C_PTR), value :: farg3 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepSetErrFile(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetErrFile") & +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_FMRIStepSetUserData(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetUserData") & +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_FMRIStepSetDiagnostics(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetDiagnostics") & +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_FMRIStepSetPostprocessStepFn(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetPostprocessStepFn") & +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_FMRIStepSetPostprocessStageFn(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetPostprocessStageFn") & +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_FMRIStepSetPreInnerFn(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetPreInnerFn") & +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_FMRIStepSetPostInnerFn(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetPostInnerFn") & +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_FMRIStepSetStagePredictFn(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetStagePredictFn") & +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_FMRIStepSetJacFn(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetJacFn") & +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_FMRIStepSetJacEvalFrequency(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetJacEvalFrequency") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_LONG), intent(in) :: farg2 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepSetLinearSolutionScaling(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetLinearSolutionScaling") & +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_FMRIStepSetEpsLin(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetEpsLin") & +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_FMRIStepSetLSNormFactor(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetLSNormFactor") & +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_FMRIStepSetPreconditioner(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepSetPreconditioner") & +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_FMRIStepSetJacTimes(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepSetJacTimes") & +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_FMRIStepSetJacTimesRhsFn(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetJacTimesRhsFn") & +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_FMRIStepSetLinSysFn(farg1, farg2) & +bind(C, name="_wrap_FMRIStepSetLinSysFn") & +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_FMRIStepEvolve(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FMRIStepEvolve") & +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_FMRIStepGetDky(farg1, farg2, farg3, farg4) & +bind(C, name="_wrap_FMRIStepGetDky") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +real(C_DOUBLE), intent(in) :: farg2 +integer(C_INT), intent(in) :: farg3 +type(C_PTR), value :: farg4 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepComputeState(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepComputeState") & +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_FMRIStepGetNumRhsEvals(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepGetNumRhsEvals") & +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_FMRIStepGetNumLinSolvSetups(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumLinSolvSetups") & +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_FMRIStepGetCurrentCoupling(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetCurrentCoupling") & +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_FMRIStepGetWorkSpace(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepGetWorkSpace") & +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_FMRIStepGetNumSteps(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumSteps") & +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_FMRIStepGetLastStep(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetLastStep") & +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_FMRIStepGetCurrentTime(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetCurrentTime") & +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_FMRIStepGetCurrentState(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetCurrentState") & +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_FMRIStepGetCurrentGamma(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetCurrentGamma") & +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_FMRIStepGetTolScaleFactor(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetTolScaleFactor") & +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_FMRIStepGetErrWeights(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetErrWeights") & +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_FMRIStepGetNumGEvals(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumGEvals") & +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_FMRIStepGetRootInfo(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetRootInfo") & +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_FMRIStepGetLastInnerStepFlag(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetLastInnerStepFlag") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +integer(C_INT) :: fresult +end function + + subroutine SWIG_free(cptr) & + bind(C, name="free") + use, intrinsic :: ISO_C_BINDING + type(C_PTR), value :: cptr +end subroutine +function swigc_FMRIStepGetReturnFlagName(farg1) & +bind(C, name="_wrap_FMRIStepGetReturnFlagName") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigarraywrapper +integer(C_LONG), intent(in) :: farg1 +type(SwigArrayWrapper) :: fresult +end function + +function swigc_FMRIStepWriteParameters(farg1, farg2) & +bind(C, name="_wrap_FMRIStepWriteParameters") & +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_FMRIStepWriteCoupling(farg1, farg2) & +bind(C, name="_wrap_FMRIStepWriteCoupling") & +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_FMRIStepGetNonlinearSystemData(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) & +bind(C, name="_wrap_FMRIStepGetNonlinearSystemData") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR), value :: farg5 +type(C_PTR), value :: farg6 +type(C_PTR), value :: farg7 +type(C_PTR), value :: farg8 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepGetNumNonlinSolvIters(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumNonlinSolvIters") & +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_FMRIStepGetNumNonlinSolvConvFails(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumNonlinSolvConvFails") & +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_FMRIStepGetNonlinSolvStats(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepGetNonlinSolvStats") & +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_FMRIStepGetLinWorkSpace(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepGetLinWorkSpace") & +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_FMRIStepGetNumJacEvals(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumJacEvals") & +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_FMRIStepGetNumPrecEvals(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumPrecEvals") & +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_FMRIStepGetNumPrecSolves(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumPrecSolves") & +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_FMRIStepGetNumLinIters(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumLinIters") & +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_FMRIStepGetNumLinConvFails(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumLinConvFails") & +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_FMRIStepGetNumJTSetupEvals(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumJTSetupEvals") & +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_FMRIStepGetNumJtimesEvals(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumJtimesEvals") & +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_FMRIStepGetNumLinRhsEvals(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetNumLinRhsEvals") & +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_FMRIStepGetLastLinFlag(farg1, farg2) & +bind(C, name="_wrap_FMRIStepGetLastLinFlag") & +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_FMRIStepGetLinReturnFlagName(farg1) & +bind(C, name="_wrap_FMRIStepGetLinReturnFlagName") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +import :: swigarraywrapper +integer(C_LONG), intent(in) :: farg1 +type(SwigArrayWrapper) :: fresult +end function + +subroutine swigc_FMRIStepFree(farg1) & +bind(C, name="_wrap_FMRIStepFree") +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +end subroutine + +subroutine swigc_FMRIStepPrintMem(farg1, farg2) & +bind(C, name="_wrap_FMRIStepPrintMem") +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +end subroutine + +function swigc_FMRIStepInnerStepper_Create(farg1, farg2) & +bind(C, name="_wrap_FMRIStepInnerStepper_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_FMRIStepInnerStepper_Free(farg1) & +bind(C, name="_wrap_FMRIStepInnerStepper_Free") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +integer(C_INT) :: fresult +end function + +function swigc_FMRIStepInnerStepper_SetContent(farg1, farg2) & +bind(C, name="_wrap_FMRIStepInnerStepper_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_FMRIStepInnerStepper_GetContent(farg1, farg2) & +bind(C, name="_wrap_FMRIStepInnerStepper_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_FMRIStepInnerStepper_SetEvolveFn(farg1, farg2) & +bind(C, name="_wrap_FMRIStepInnerStepper_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_FMRIStepInnerStepper_SetFullRhsFn(farg1, farg2) & +bind(C, name="_wrap_FMRIStepInnerStepper_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_FMRIStepInnerStepper_SetResetFn(farg1, farg2) & +bind(C, name="_wrap_FMRIStepInnerStepper_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_FMRIStepInnerStepper_AddForcing(farg1, farg2, farg3) & +bind(C, name="_wrap_FMRIStepInnerStepper_AddForcing") & +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_INT) :: fresult +end function + +function swigc_FMRIStepInnerStepper_GetForcingData(farg1, farg2, farg3, farg4, farg5) & +bind(C, name="_wrap_FMRIStepInnerStepper_GetForcingData") & +result(fresult) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), value :: farg1 +type(C_PTR), value :: farg2 +type(C_PTR), value :: farg3 +type(C_PTR), value :: farg4 +type(C_PTR), value :: farg5 +integer(C_INT) :: fresult +end function + +end interface + + +contains + ! MODULE SUBPROGRAMS +subroutine swigf_MRIStepCouplingMem_nmat_set(self, nmat) +use, intrinsic :: ISO_C_BINDING +class(MRIStepCouplingMem), intent(in) :: self +integer(C_INT), intent(in) :: nmat +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: farg2 + +farg1 = self%swigdata +farg2 = nmat +call swigc_MRIStepCouplingMem_nmat_set(farg1, farg2) +end subroutine + +function swigf_MRIStepCouplingMem_nmat_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +class(MRIStepCouplingMem), intent(in) :: self +integer(C_INT) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_MRIStepCouplingMem_nmat_get(farg1) +swig_result = fresult +end function + +subroutine swigf_MRIStepCouplingMem_stages_set(self, stages) +use, intrinsic :: ISO_C_BINDING +class(MRIStepCouplingMem), intent(in) :: self +integer(C_INT), intent(in) :: stages +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: farg2 + +farg1 = self%swigdata +farg2 = stages +call swigc_MRIStepCouplingMem_stages_set(farg1, farg2) +end subroutine + +function swigf_MRIStepCouplingMem_stages_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +class(MRIStepCouplingMem), intent(in) :: self +integer(C_INT) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_MRIStepCouplingMem_stages_get(farg1) +swig_result = fresult +end function + +subroutine swigf_MRIStepCouplingMem_q_set(self, q) +use, intrinsic :: ISO_C_BINDING +class(MRIStepCouplingMem), intent(in) :: self +integer(C_INT), intent(in) :: q +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: farg2 + +farg1 = self%swigdata +farg2 = q +call swigc_MRIStepCouplingMem_q_set(farg1, farg2) +end subroutine + +function swigf_MRIStepCouplingMem_q_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +class(MRIStepCouplingMem), intent(in) :: self +integer(C_INT) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_MRIStepCouplingMem_q_get(farg1) +swig_result = fresult +end function + +subroutine swigf_MRIStepCouplingMem_p_set(self, p) +use, intrinsic :: ISO_C_BINDING +class(MRIStepCouplingMem), intent(in) :: self +integer(C_INT), intent(in) :: p +type(SwigClassWrapper) :: farg1 +integer(C_INT) :: farg2 + +farg1 = self%swigdata +farg2 = p +call swigc_MRIStepCouplingMem_p_set(farg1, farg2) +end subroutine + +function swigf_MRIStepCouplingMem_p_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +class(MRIStepCouplingMem), intent(in) :: self +integer(C_INT) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_MRIStepCouplingMem_p_get(farg1) +swig_result = fresult +end function + +subroutine swigf_MRIStepCouplingMem_c_set(self, c) +use, intrinsic :: ISO_C_BINDING +class(MRIStepCouplingMem), intent(in) :: self +real(C_DOUBLE), dimension(*), target, intent(inout) :: c +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(c(1)) +call swigc_MRIStepCouplingMem_c_set(farg1, farg2) +end subroutine + +function swigf_MRIStepCouplingMem_c_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +real(C_DOUBLE), dimension(:), pointer :: swig_result +class(MRIStepCouplingMem), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_MRIStepCouplingMem_c_get(farg1) +call c_f_pointer(fresult, swig_result, [1]) +end function + +subroutine swigf_MRIStepCouplingMem_W_set(self, w) +use, intrinsic :: ISO_C_BINDING +class(MRIStepCouplingMem), intent(in) :: self +type(C_PTR), target, intent(inout) :: w +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(w) +call swigc_MRIStepCouplingMem_W_set(farg1, farg2) +end subroutine + +function swigf_MRIStepCouplingMem_W_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), pointer :: swig_result +class(MRIStepCouplingMem), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_MRIStepCouplingMem_W_get(farg1) +call c_f_pointer(fresult, swig_result) +end function + +subroutine swigf_MRIStepCouplingMem_G_set(self, g) +use, intrinsic :: ISO_C_BINDING +class(MRIStepCouplingMem), intent(in) :: self +type(C_PTR), target, intent(inout) :: g +type(SwigClassWrapper) :: farg1 +type(C_PTR) :: farg2 + +farg1 = self%swigdata +farg2 = c_loc(g) +call swigc_MRIStepCouplingMem_G_set(farg1, farg2) +end subroutine + +function swigf_MRIStepCouplingMem_G_get(self) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), pointer :: swig_result +class(MRIStepCouplingMem), intent(in) :: self +type(C_PTR) :: fresult +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +fresult = swigc_MRIStepCouplingMem_G_get(farg1) +call c_f_pointer(fresult, swig_result) +end function + +function swigf_create_MRIStepCouplingMem() & +result(self) +use, intrinsic :: ISO_C_BINDING +type(MRIStepCouplingMem) :: self +type(SwigClassWrapper) :: fresult + +fresult = swigc_new_MRIStepCouplingMem() +self%swigdata = fresult +end function + +subroutine swigf_release_MRIStepCouplingMem(self) +use, intrinsic :: ISO_C_BINDING +class(MRIStepCouplingMem), intent(inout) :: self +type(SwigClassWrapper) :: farg1 + +farg1 = self%swigdata +if (btest(farg1%cmemflags, swig_cmem_own_bit)) then +call swigc_delete_MRIStepCouplingMem(farg1) +endif +farg1%cptr = C_NULL_PTR +farg1%cmemflags = 0 +self%swigdata = farg1 +end subroutine + +subroutine swigf_MRIStepCouplingMem_op_assign__(self, other) +use, intrinsic :: ISO_C_BINDING +class(MRIStepCouplingMem), intent(inout) :: self +type(MRIStepCouplingMem), intent(in) :: other +type(SwigClassWrapper) :: farg1 +type(SwigClassWrapper) :: farg2 + +farg1 = self%swigdata +farg2 = other%swigdata +call swigc_MRIStepCouplingMem_op_assign__(farg1, farg2) +self%swigdata = farg1 +end subroutine + +function FMRIStepCoupling_LoadTable(imethod) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +integer(ARKODE_MRITableID), intent(in) :: imethod +type(C_PTR) :: fresult +integer(C_INT) :: farg1 + +farg1 = imethod +fresult = swigc_FMRIStepCoupling_LoadTable(farg1) +swig_result = fresult +end function + +function FMRIStepCoupling_Alloc(nmat, stages, type) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +integer(C_INT), intent(in) :: nmat +integer(C_INT), intent(in) :: stages +integer(MRISTEP_METHOD_TYPE), intent(in) :: type +type(C_PTR) :: fresult +integer(C_INT) :: farg1 +integer(C_INT) :: farg2 +integer(C_INT) :: farg3 + +farg1 = nmat +farg2 = stages +farg3 = type +fresult = swigc_FMRIStepCoupling_Alloc(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepCoupling_Create(nmat, stages, q, p, w, g, c) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +integer(C_INT), intent(in) :: nmat +integer(C_INT), intent(in) :: stages +integer(C_INT), intent(in) :: q +integer(C_INT), intent(in) :: p +real(C_DOUBLE), dimension(*), target, intent(inout) :: w +real(C_DOUBLE), dimension(*), target, intent(inout) :: g +real(C_DOUBLE), dimension(*), target, intent(inout) :: c +type(C_PTR) :: fresult +integer(C_INT) :: farg1 +integer(C_INT) :: farg2 +integer(C_INT) :: farg3 +integer(C_INT) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 +type(C_PTR) :: farg7 + +farg1 = nmat +farg2 = stages +farg3 = q +farg4 = p +farg5 = c_loc(w(1)) +farg6 = c_loc(g(1)) +farg7 = c_loc(c(1)) +fresult = swigc_FMRIStepCoupling_Create(farg1, farg2, farg3, farg4, farg5, farg6, farg7) +swig_result = fresult +end function + +function FMRIStepCoupling_MIStoMRI(b, q, p) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +type(C_PTR) :: b +integer(C_INT), intent(in) :: q +integer(C_INT), intent(in) :: p +type(C_PTR) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 +integer(C_INT) :: farg3 + +farg1 = b +farg2 = q +farg3 = p +fresult = swigc_FMRIStepCoupling_MIStoMRI(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepCoupling_Copy(mric) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +type(C_PTR) :: mric +type(C_PTR) :: fresult +type(C_PTR) :: farg1 + +farg1 = mric +fresult = swigc_FMRIStepCoupling_Copy(farg1) +swig_result = fresult +end function + +subroutine FMRIStepCoupling_Space(mric, liw, lrw) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: mric +integer(C_INT64_T), dimension(*), target, intent(inout) :: liw +integer(C_INT64_T), dimension(*), target, intent(inout) :: lrw +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = mric +farg2 = c_loc(liw(1)) +farg3 = c_loc(lrw(1)) +call swigc_FMRIStepCoupling_Space(farg1, farg2, farg3) +end subroutine + +subroutine FMRIStepCoupling_Free(mric) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: mric +type(C_PTR) :: farg1 + +farg1 = mric +call swigc_FMRIStepCoupling_Free(farg1) +end subroutine + +subroutine FMRIStepCoupling_Write(mric, outfile) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: mric +type(C_PTR) :: outfile +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = mric +farg2 = outfile +call swigc_FMRIStepCoupling_Write(farg1, farg2) +end subroutine + +function FMRIStepCreate(fse, fsi, t0, y0, stepper, sunctx) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: swig_result +type(C_FUNPTR), intent(in), value :: fse +type(C_FUNPTR), intent(in), value :: fsi +real(C_DOUBLE), intent(in) :: t0 +type(N_Vector), target, intent(inout) :: y0 +type(C_PTR) :: stepper +type(C_PTR) :: sunctx +type(C_PTR) :: fresult +type(C_FUNPTR) :: farg1 +type(C_FUNPTR) :: farg2 +real(C_DOUBLE) :: farg3 +type(C_PTR) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 + +farg1 = fse +farg2 = fsi +farg3 = t0 +farg4 = c_loc(y0) +farg5 = stepper +farg6 = sunctx +fresult = swigc_FMRIStepCreate(farg1, farg2, farg3, farg4, farg5, farg6) +swig_result = fresult +end function + +function FMRIStepResize(arkode_mem, ynew, t0, resize, resize_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: ynew +real(C_DOUBLE), intent(in) :: t0 +type(C_FUNPTR), intent(in), value :: resize +type(C_PTR) :: resize_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +real(C_DOUBLE) :: farg3 +type(C_FUNPTR) :: farg4 +type(C_PTR) :: farg5 + +farg1 = arkode_mem +farg2 = c_loc(ynew) +farg3 = t0 +farg4 = resize +farg5 = resize_data +fresult = swigc_FMRIStepResize(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FMRIStepReInit(arkode_mem, fse, fsi, t0, y0) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: fse +type(C_FUNPTR), intent(in), value :: fsi +real(C_DOUBLE), intent(in) :: t0 +type(N_Vector), target, intent(inout) :: y0 +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_FUNPTR) :: farg3 +real(C_DOUBLE) :: farg4 +type(C_PTR) :: farg5 + +farg1 = arkode_mem +farg2 = fse +farg3 = fsi +farg4 = t0 +farg5 = c_loc(y0) +fresult = swigc_FMRIStepReInit(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FMRIStepReset(arkode_mem, tr, yr) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: tr +type(N_Vector), target, intent(inout) :: yr +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = tr +farg3 = c_loc(yr) +fresult = swigc_FMRIStepReset(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepSStolerances(arkode_mem, reltol, abstol) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: reltol +real(C_DOUBLE), intent(in) :: abstol +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +real(C_DOUBLE) :: farg3 + +farg1 = arkode_mem +farg2 = reltol +farg3 = abstol +fresult = swigc_FMRIStepSStolerances(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepSVtolerances(arkode_mem, reltol, abstol) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: reltol +type(N_Vector), target, intent(inout) :: abstol +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = reltol +farg3 = c_loc(abstol) +fresult = swigc_FMRIStepSVtolerances(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepWFtolerances(arkode_mem, efun) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: efun +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = efun +fresult = swigc_FMRIStepWFtolerances(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetLinearSolver(arkode_mem, ls, a) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(SUNLinearSolver), target, intent(inout) :: ls +type(SUNMatrix), target, intent(inout) :: a +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(ls) +farg3 = c_loc(a) +fresult = swigc_FMRIStepSetLinearSolver(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepRootInit(arkode_mem, nrtfn, g) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: nrtfn +type(C_FUNPTR), intent(in), value :: g +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 +type(C_FUNPTR) :: farg3 + +farg1 = arkode_mem +farg2 = nrtfn +farg3 = g +fresult = swigc_FMRIStepRootInit(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepSetDefaults(arkode_mem) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = arkode_mem +fresult = swigc_FMRIStepSetDefaults(farg1) +swig_result = fresult +end function + +function FMRIStepSetInterpolantType(arkode_mem, itype) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: itype +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = itype +fresult = swigc_FMRIStepSetInterpolantType(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetInterpolantDegree(arkode_mem, degree) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: degree +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = degree +fresult = swigc_FMRIStepSetInterpolantDegree(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetDenseOrder(arkode_mem, dord) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: dord +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = dord +fresult = swigc_FMRIStepSetDenseOrder(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetNonlinearSolver(arkode_mem, nls) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(SUNNonlinearSolver), target, intent(inout) :: nls +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nls) +fresult = swigc_FMRIStepSetNonlinearSolver(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetNlsRhsFn(arkode_mem, nls_fs) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: nls_fs +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = nls_fs +fresult = swigc_FMRIStepSetNlsRhsFn(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetLinear(arkode_mem, timedepend) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: timedepend +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = timedepend +fresult = swigc_FMRIStepSetLinear(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetNonlinear(arkode_mem) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = arkode_mem +fresult = swigc_FMRIStepSetNonlinear(farg1) +swig_result = fresult +end function + +function FMRIStepSetCoupling(arkode_mem, mric) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: mric +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = mric +fresult = swigc_FMRIStepSetCoupling(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetMaxNumSteps(arkode_mem, mxsteps) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), intent(in) :: mxsteps +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_LONG) :: farg2 + +farg1 = arkode_mem +farg2 = mxsteps +fresult = swigc_FMRIStepSetMaxNumSteps(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetNonlinCRDown(arkode_mem, crdown) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: crdown +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = crdown +fresult = swigc_FMRIStepSetNonlinCRDown(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetNonlinRDiv(arkode_mem, rdiv) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: rdiv +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = rdiv +fresult = swigc_FMRIStepSetNonlinRDiv(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetDeltaGammaMax(arkode_mem, dgmax) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: dgmax +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = dgmax +fresult = swigc_FMRIStepSetDeltaGammaMax(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetLSetupFrequency(arkode_mem, msbp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: msbp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = msbp +fresult = swigc_FMRIStepSetLSetupFrequency(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetPredictorMethod(arkode_mem, method) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: method +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = method +fresult = swigc_FMRIStepSetPredictorMethod(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetMaxNonlinIters(arkode_mem, maxcor) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: maxcor +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = maxcor +fresult = swigc_FMRIStepSetMaxNonlinIters(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetNonlinConvCoef(arkode_mem, nlscoef) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: nlscoef +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = nlscoef +fresult = swigc_FMRIStepSetNonlinConvCoef(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetMaxHnilWarns(arkode_mem, mxhnil) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: mxhnil +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = mxhnil +fresult = swigc_FMRIStepSetMaxHnilWarns(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetStopTime(arkode_mem, tstop) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: tstop +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = tstop +fresult = swigc_FMRIStepSetStopTime(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetFixedStep(arkode_mem, hsfixed) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: hsfixed +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = hsfixed +fresult = swigc_FMRIStepSetFixedStep(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetRootDirection(arkode_mem, rootdir) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), dimension(*), target, intent(inout) :: rootdir +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(rootdir(1)) +fresult = swigc_FMRIStepSetRootDirection(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetNoInactiveRootWarn(arkode_mem) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT) :: fresult +type(C_PTR) :: farg1 + +farg1 = arkode_mem +fresult = swigc_FMRIStepSetNoInactiveRootWarn(farg1) +swig_result = fresult +end function + +function FMRIStepSetErrHandlerFn(arkode_mem, ehfun, eh_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: ehfun +type(C_PTR) :: eh_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = ehfun +farg3 = eh_data +fresult = swigc_FMRIStepSetErrHandlerFn(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepSetErrFile(arkode_mem, errfp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: errfp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = errfp +fresult = swigc_FMRIStepSetErrFile(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetUserData(arkode_mem, user_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: user_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = user_data +fresult = swigc_FMRIStepSetUserData(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetDiagnostics(arkode_mem, diagfp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: diagfp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = diagfp +fresult = swigc_FMRIStepSetDiagnostics(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetPostprocessStepFn(arkode_mem, processstep) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: processstep +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = processstep +fresult = swigc_FMRIStepSetPostprocessStepFn(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetPostprocessStageFn(arkode_mem, processstage) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: processstage +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = processstage +fresult = swigc_FMRIStepSetPostprocessStageFn(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetPreInnerFn(arkode_mem, prefn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: prefn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = prefn +fresult = swigc_FMRIStepSetPreInnerFn(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetPostInnerFn(arkode_mem, postfn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: postfn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = postfn +fresult = swigc_FMRIStepSetPostInnerFn(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetStagePredictFn(arkode_mem, predictstage) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: predictstage +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = predictstage +fresult = swigc_FMRIStepSetStagePredictFn(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetJacFn(arkode_mem, jac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: jac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = jac +fresult = swigc_FMRIStepSetJacFn(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetJacEvalFrequency(arkode_mem, msbj) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), intent(in) :: msbj +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_LONG) :: farg2 + +farg1 = arkode_mem +farg2 = msbj +fresult = swigc_FMRIStepSetJacEvalFrequency(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetLinearSolutionScaling(arkode_mem, onoff) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), intent(in) :: onoff +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +integer(C_INT) :: farg2 + +farg1 = arkode_mem +farg2 = onoff +fresult = swigc_FMRIStepSetLinearSolutionScaling(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetEpsLin(arkode_mem, eplifac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: eplifac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = eplifac +fresult = swigc_FMRIStepSetEpsLin(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetLSNormFactor(arkode_mem, nrmfac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: nrmfac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 + +farg1 = arkode_mem +farg2 = nrmfac +fresult = swigc_FMRIStepSetLSNormFactor(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetPreconditioner(arkode_mem, psetup, psolve) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: psetup +type(C_FUNPTR), intent(in), value :: psolve +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_FUNPTR) :: farg3 + +farg1 = arkode_mem +farg2 = psetup +farg3 = psolve +fresult = swigc_FMRIStepSetPreconditioner(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepSetJacTimes(arkode_mem, jtsetup, jtimes) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: jtsetup +type(C_FUNPTR), intent(in), value :: jtimes +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 +type(C_FUNPTR) :: farg3 + +farg1 = arkode_mem +farg2 = jtsetup +farg3 = jtimes +fresult = swigc_FMRIStepSetJacTimes(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepSetJacTimesRhsFn(arkode_mem, jtimesrhsfn) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: jtimesrhsfn +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = jtimesrhsfn +fresult = swigc_FMRIStepSetJacTimesRhsFn(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepSetLinSysFn(arkode_mem, linsys) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_FUNPTR), intent(in), value :: linsys +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_FUNPTR) :: farg2 + +farg1 = arkode_mem +farg2 = linsys +fresult = swigc_FMRIStepSetLinSysFn(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepEvolve(arkode_mem, tout, yout, tret, itask) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: tout +type(N_Vector), target, intent(inout) :: yout +real(C_DOUBLE), dimension(*), target, intent(inout) :: tret +integer(C_INT), intent(in) :: itask +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 = arkode_mem +farg2 = tout +farg3 = c_loc(yout) +farg4 = c_loc(tret(1)) +farg5 = itask +fresult = swigc_FMRIStepEvolve(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + +function FMRIStepGetDky(arkode_mem, t, k, dky) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), intent(in) :: t +integer(C_INT), intent(in) :: k +type(N_Vector), target, intent(inout) :: dky +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +integer(C_INT) :: farg3 +type(C_PTR) :: farg4 + +farg1 = arkode_mem +farg2 = t +farg3 = k +farg4 = c_loc(dky) +fresult = swigc_FMRIStepGetDky(farg1, farg2, farg3, farg4) +swig_result = fresult +end function + +function FMRIStepComputeState(arkode_mem, zcor, z) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: zcor +type(N_Vector), target, intent(inout) :: z +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(zcor) +farg3 = c_loc(z) +fresult = swigc_FMRIStepComputeState(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepGetNumRhsEvals(arkode_mem, nfse_evals, nfsi_evals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nfse_evals +integer(C_LONG), dimension(*), target, intent(inout) :: nfsi_evals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(nfse_evals(1)) +farg3 = c_loc(nfsi_evals(1)) +fresult = swigc_FMRIStepGetNumRhsEvals(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepGetNumLinSolvSetups(arkode_mem, nlinsetups) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nlinsetups +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nlinsetups(1)) +fresult = swigc_FMRIStepGetNumLinSolvSetups(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetCurrentCoupling(arkode_mem, mric) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR), target, intent(inout) :: mric +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(mric) +fresult = swigc_FMRIStepGetCurrentCoupling(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetWorkSpace(arkode_mem, lenrw, leniw) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: lenrw +integer(C_LONG), dimension(*), target, intent(inout) :: leniw +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(lenrw(1)) +farg3 = c_loc(leniw(1)) +fresult = swigc_FMRIStepGetWorkSpace(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepGetNumSteps(arkode_mem, nssteps) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nssteps +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nssteps(1)) +fresult = swigc_FMRIStepGetNumSteps(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetLastStep(arkode_mem, hlast) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: hlast +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(hlast(1)) +fresult = swigc_FMRIStepGetLastStep(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetCurrentTime(arkode_mem, tcur) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: tcur +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(tcur(1)) +fresult = swigc_FMRIStepGetCurrentTime(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetCurrentState(arkode_mem, state) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: state +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = state +fresult = swigc_FMRIStepGetCurrentState(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetCurrentGamma(arkode_mem, gamma) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: gamma +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(gamma(1)) +fresult = swigc_FMRIStepGetCurrentGamma(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetTolScaleFactor(arkode_mem, tolsfac) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: tolsfac +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(tolsfac(1)) +fresult = swigc_FMRIStepGetTolScaleFactor(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetErrWeights(arkode_mem, eweight) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(N_Vector), target, intent(inout) :: eweight +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(eweight) +fresult = swigc_FMRIStepGetErrWeights(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetNumGEvals(arkode_mem, ngevals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: ngevals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(ngevals(1)) +fresult = swigc_FMRIStepGetNumGEvals(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetRootInfo(arkode_mem, rootsfound) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), dimension(*), target, intent(inout) :: rootsfound +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(rootsfound(1)) +fresult = swigc_FMRIStepGetRootInfo(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetLastInnerStepFlag(arkode_mem, flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_INT), dimension(*), target, intent(inout) :: flag +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(flag(1)) +fresult = swigc_FMRIStepGetLastInnerStepFlag(farg1, farg2) +swig_result = fresult +end function + + +subroutine SWIG_chararray_to_string(wrap, string) + use, intrinsic :: ISO_C_BINDING + type(SwigArrayWrapper), intent(IN) :: wrap + character(kind=C_CHAR, len=:), allocatable, intent(OUT) :: string + character(kind=C_CHAR), dimension(:), pointer :: chars + integer(kind=C_SIZE_T) :: i + call c_f_pointer(wrap%data, chars, [wrap%size]) + allocate(character(kind=C_CHAR, len=wrap%size) :: string) + do i=1, wrap%size + string(i:i) = chars(i) + end do +end subroutine + +function FMRIStepGetReturnFlagName(flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +character(kind=C_CHAR, len=:), allocatable :: swig_result +integer(C_LONG), intent(in) :: flag +type(SwigArrayWrapper) :: fresult +integer(C_LONG) :: farg1 + +farg1 = flag +fresult = swigc_FMRIStepGetReturnFlagName(farg1) +call SWIG_chararray_to_string(fresult, swig_result) +if (.false.) call SWIG_free(fresult%data) +end function + +function FMRIStepWriteParameters(arkode_mem, fp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: fp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = fp +fresult = swigc_FMRIStepWriteParameters(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepWriteCoupling(arkode_mem, fp) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +type(C_PTR) :: fp +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = fp +fresult = swigc_FMRIStepWriteCoupling(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetNonlinearSystemData(arkode_mem, tcur, zpred, z, f, gamma, sdata, user_data) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +real(C_DOUBLE), dimension(*), target, intent(inout) :: tcur +type(C_PTR) :: zpred +type(C_PTR) :: z +type(C_PTR) :: f +real(C_DOUBLE), dimension(*), target, intent(inout) :: gamma +type(C_PTR) :: sdata +type(C_PTR), target, intent(inout) :: user_data +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 +type(C_PTR) :: farg5 +type(C_PTR) :: farg6 +type(C_PTR) :: farg7 +type(C_PTR) :: farg8 + +farg1 = arkode_mem +farg2 = c_loc(tcur(1)) +farg3 = zpred +farg4 = z +farg5 = f +farg6 = c_loc(gamma(1)) +farg7 = sdata +farg8 = c_loc(user_data) +fresult = swigc_FMRIStepGetNonlinearSystemData(farg1, farg2, farg3, farg4, farg5, farg6, farg7, farg8) +swig_result = fresult +end function + +function FMRIStepGetNumNonlinSolvIters(arkode_mem, nniters) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nniters +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nniters(1)) +fresult = swigc_FMRIStepGetNumNonlinSolvIters(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetNumNonlinSolvConvFails(arkode_mem, nncfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nncfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nncfails(1)) +fresult = swigc_FMRIStepGetNumNonlinSolvConvFails(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetNonlinSolvStats(arkode_mem, nniters, nncfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nniters +integer(C_LONG), dimension(*), target, intent(inout) :: nncfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(nniters(1)) +farg3 = c_loc(nncfails(1)) +fresult = swigc_FMRIStepGetNonlinSolvStats(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepGetLinWorkSpace(arkode_mem, lenrwls, leniwls) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: lenrwls +integer(C_LONG), dimension(*), target, intent(inout) :: leniwls +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 + +farg1 = arkode_mem +farg2 = c_loc(lenrwls(1)) +farg3 = c_loc(leniwls(1)) +fresult = swigc_FMRIStepGetLinWorkSpace(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepGetNumJacEvals(arkode_mem, njevals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: njevals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(njevals(1)) +fresult = swigc_FMRIStepGetNumJacEvals(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetNumPrecEvals(arkode_mem, npevals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: npevals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(npevals(1)) +fresult = swigc_FMRIStepGetNumPrecEvals(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetNumPrecSolves(arkode_mem, npsolves) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: npsolves +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(npsolves(1)) +fresult = swigc_FMRIStepGetNumPrecSolves(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetNumLinIters(arkode_mem, nliters) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nliters +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nliters(1)) +fresult = swigc_FMRIStepGetNumLinIters(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetNumLinConvFails(arkode_mem, nlcfails) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nlcfails +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nlcfails(1)) +fresult = swigc_FMRIStepGetNumLinConvFails(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetNumJTSetupEvals(arkode_mem, njtsetups) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: njtsetups +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(njtsetups(1)) +fresult = swigc_FMRIStepGetNumJTSetupEvals(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetNumJtimesEvals(arkode_mem, njvevals) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: njvevals +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(njvevals(1)) +fresult = swigc_FMRIStepGetNumJtimesEvals(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetNumLinRhsEvals(arkode_mem, nfevalsls) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: nfevalsls +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(nfevalsls(1)) +fresult = swigc_FMRIStepGetNumLinRhsEvals(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetLastLinFlag(arkode_mem, flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +integer(C_INT) :: swig_result +type(C_PTR) :: arkode_mem +integer(C_LONG), dimension(*), target, intent(inout) :: flag +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = c_loc(flag(1)) +fresult = swigc_FMRIStepGetLastLinFlag(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepGetLinReturnFlagName(flag) & +result(swig_result) +use, intrinsic :: ISO_C_BINDING +character(kind=C_CHAR, len=:), allocatable :: swig_result +integer(C_LONG), intent(in) :: flag +type(SwigArrayWrapper) :: fresult +integer(C_LONG) :: farg1 + +farg1 = flag +fresult = swigc_FMRIStepGetLinReturnFlagName(farg1) +call SWIG_chararray_to_string(fresult, swig_result) +if (.false.) call SWIG_free(fresult%data) +end function + +subroutine FMRIStepFree(arkode_mem) +use, intrinsic :: ISO_C_BINDING +type(C_PTR), target, intent(inout) :: arkode_mem +type(C_PTR) :: farg1 + +farg1 = c_loc(arkode_mem) +call swigc_FMRIStepFree(farg1) +end subroutine + +subroutine FMRIStepPrintMem(arkode_mem, outfile) +use, intrinsic :: ISO_C_BINDING +type(C_PTR) :: arkode_mem +type(C_PTR) :: outfile +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 + +farg1 = arkode_mem +farg2 = outfile +call swigc_FMRIStepPrintMem(farg1, farg2) +end subroutine + +function FMRIStepInnerStepper_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_FMRIStepInnerStepper_Create(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepInnerStepper_Free(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_FMRIStepInnerStepper_Free(farg1) +swig_result = fresult +end function + +function FMRIStepInnerStepper_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_FMRIStepInnerStepper_SetContent(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepInnerStepper_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_FMRIStepInnerStepper_GetContent(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepInnerStepper_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_FMRIStepInnerStepper_SetEvolveFn(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepInnerStepper_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_FMRIStepInnerStepper_SetFullRhsFn(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepInnerStepper_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_FMRIStepInnerStepper_SetResetFn(farg1, farg2) +swig_result = fresult +end function + +function FMRIStepInnerStepper_AddForcing(stepper, t, f) & +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) :: f +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +real(C_DOUBLE) :: farg2 +type(C_PTR) :: farg3 + +farg1 = stepper +farg2 = t +farg3 = c_loc(f) +fresult = swigc_FMRIStepInnerStepper_AddForcing(farg1, farg2, farg3) +swig_result = fresult +end function + +function FMRIStepInnerStepper_GetForcingData(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), dimension(*), target, intent(inout) :: tshift +real(C_DOUBLE), dimension(*), target, intent(inout) :: tscale +type(C_PTR), target, intent(inout) :: forcing +integer(C_INT), dimension(*), target, intent(inout) :: nforcing +integer(C_INT) :: fresult +type(C_PTR) :: farg1 +type(C_PTR) :: farg2 +type(C_PTR) :: farg3 +type(C_PTR) :: farg4 +type(C_PTR) :: farg5 + +farg1 = stepper +farg2 = c_loc(tshift(1)) +farg3 = c_loc(tscale(1)) +farg4 = c_loc(forcing) +farg5 = c_loc(nforcing(1)) +fresult = swigc_FMRIStepInnerStepper_GetForcingData(farg1, farg2, farg3, farg4, farg5) +swig_result = fresult +end function + + +end module diff --git a/lib/sundials_6.1.1/src/arkode/xbraid/arkode_xbraid.c b/lib/sundials_6.1.1/src/arkode/xbraid/arkode_xbraid.c new file mode 100644 index 00000000000..f3faaab6607 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/xbraid/arkode_xbraid.c @@ -0,0 +1,520 @@ +/* -------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * -------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, Lawrence Livermore National Security + * and Southern Methodist University. + * All rights reserved. + * + * See the top-level LICENSE and NOTICE files for details. + * + * SPDX-License-Identifier: BSD-3-Clause + * SUNDIALS Copyright End + * -------------------------------------------------------------------------- + * This is the implementation file for the ARKODE + XBraid interface. + * -------------------------------------------------------------------------- */ + +#include "arkode/arkode_xbraid.h" +#include "sundials/sundials_math.h" +#include "arkode/arkode.h" + +#include "arkode_xbraid_impl.h" +#include "arkode_arkstep_impl.h" + +#define ONE RCONST(1.0) + + +/* ------------------------------- + * Construct, initialize, and free + * ------------------------------- */ + + +/* Create XBraid app strucutre */ +int ARKBraid_Create(void *arkode_mem, braid_App *app) +{ + int flag; + ARKBraidContent content; + + /* Check input */ + if (arkode_mem == NULL) return SUNBRAID_ILLINPUT; + + /* Create XBraid interface object */ + flag = SUNBraidApp_NewEmpty(app); + if (flag != SUNBRAID_SUCCESS) return flag; + + /* Set operations */ + (*app)->ops->getvectmpl = ARKBraid_GetVecTmpl; + + /* Create ARKODE interface content */ + content = NULL; + content = (ARKBraidContent) malloc(sizeof(*content)); + if (content == NULL) + { + (void) SUNBraidApp_FreeEmpty(app); + return SUNBRAID_ALLOCFAIL; + } + + /* Initialize content */ + + /* Attach ARKODE memory */ + content->ark_mem = (ARKodeMem) arkode_mem; + + /* Interface functions */ + content->step = ARKBraid_Step; + content->init = ARKBraid_Init; + content->snorm = SUNBraidVector_SpatialNorm; + content->access = ARKBraid_Access; + + /* Saved return flags */ + content->last_flag_braid = SUNBRAID_SUCCESS; + content->last_flag_arkode = SUNBRAID_SUCCESS; + + /* Output time and solution (allocaed in access if necessary) */ + content->tout = content->ark_mem->tn; + content->yout = NULL; + + /* Attach content */ + (*app)->content = content; + + return SUNBRAID_SUCCESS; +} + + +/* Initialize XBraid, attach interface functions */ +int ARKBraid_BraidInit(MPI_Comm comm_w, MPI_Comm comm_t, realtype tstart, + realtype tstop, sunindextype ntime, braid_App app, + braid_Core *core) +{ + braid_Int braid_flag; + ARKBraidContent content; + + /* Check inputs */ + if (comm_w == MPI_COMM_NULL || comm_t == MPI_COMM_NULL || ntime < 2 || + app == NULL) + return SUNBRAID_ILLINPUT; + + if (app->content == NULL) return SUNBRAID_MEMFAIL; + + /* Shortcut to content */ + content = (ARKBraidContent) app->content; + + /* Initialize XBraid */ + braid_flag = braid_Init(comm_w, comm_t, tstart, tstop, ntime, app, + content->step, + content->init, + SUNBraidVector_Clone, + SUNBraidVector_Free, + SUNBraidVector_Sum, + content->snorm, + content->access, + SUNBraidVector_BufSize, + SUNBraidVector_BufPack, + SUNBraidVector_BufUnpack, + core); + CHECK_BRAID_RETURN(content->last_flag_braid, braid_flag); + + return SUNBRAID_SUCCESS; +} + + +/* Deallocate XBraid app structure */ +int ARKBraid_Free(braid_App *app) +{ + ARKBraidContent content; /* ARKBraid app content */ + + if (*app == NULL) return SUNBRAID_SUCCESS; + + if ((*app)->content != NULL) + { + content = (ARKBraidContent) (*app)->content; + + if (content->yout != NULL) + { + arkFreeVec(content->ark_mem, &(content->yout)); + content->yout = NULL; + } + free((*app)->content); + (*app)->content = NULL; + } + return SUNBraidApp_FreeEmpty(app); +} + + +/* ---------------------- + * ARKBraid Set Functions + * ---------------------- */ + + +int ARKBraid_SetStepFn(braid_App app, braid_PtFcnStep step) +{ + ARKBraidContent content; + + if (app == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL) return SUNBRAID_MEMFAIL; + + content = (ARKBraidContent) app->content; + + /* Restore default or set function pointer */ + if (step == NULL) + content->step = ARKBraid_Step; + else + content->step = step; + + return SUNBRAID_SUCCESS; +} + + +int ARKBraid_SetInitFn(braid_App app, braid_PtFcnInit init) +{ + ARKBraidContent content; + + if (app == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL) return SUNBRAID_MEMFAIL; + + content = (ARKBraidContent) app->content; + + /* Restore default or set function pointer */ + if (init == NULL) + content->init = ARKBraid_Init; + else + content->init = init; + + return SUNBRAID_SUCCESS; +} + + +int ARKBraid_SetSpatialNormFn(braid_App app, braid_PtFcnSpatialNorm snorm) +{ + ARKBraidContent content; + + if (app == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL) return SUNBRAID_MEMFAIL; + + content = (ARKBraidContent) app->content; + + /* Restore default or set function pointer */ + if (snorm == NULL) + content->snorm = SUNBraidVector_SpatialNorm; + else + content->snorm = snorm; + + return SUNBRAID_SUCCESS; +} + + +int ARKBraid_SetAccessFn(braid_App app, braid_PtFcnAccess access) +{ + ARKBraidContent content; + + if (app == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL) return SUNBRAID_MEMFAIL; + + content = (ARKBraidContent) app->content; + + /* Restore default or set function pointer */ + if (access == NULL) + content->access = ARKBraid_Access; + else + content->access = access; + + return SUNBRAID_SUCCESS; +} + + +/* ---------------------- + * ARKBraid Get Functions + * ---------------------- */ + + +int ARKBraid_GetVecTmpl(braid_App app, N_Vector *tmpl) +{ + ARKBraidContent content; + if (app == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL) return SUNBRAID_MEMFAIL; + content = (ARKBraidContent) app->content; + if (content->ark_mem == NULL) return SUNBRAID_MEMFAIL; + *tmpl = content->ark_mem->yn; + return SUNBRAID_SUCCESS; +} + + +int ARKBraid_GetARKStepMem(braid_App app, void **arkode_mem) +{ + ARKBraidContent content; + if (app == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL) return SUNBRAID_MEMFAIL; + content = (ARKBraidContent) app->content; + if (content->ark_mem == NULL) return SUNBRAID_MEMFAIL; + *arkode_mem = (void*) content->ark_mem; + return SUNBRAID_SUCCESS; +} + + +int ARKBraid_GetUserData(braid_App app, void **user_data) +{ + ARKBraidContent content; + if (app == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL) return SUNBRAID_MEMFAIL; + content = (ARKBraidContent) app->content; + if (content->ark_mem == NULL) return SUNBRAID_MEMFAIL; + *user_data = content->ark_mem->user_data; + return SUNBRAID_SUCCESS; +} + + +int ARKBraid_GetLastBraidFlag(braid_App app, int *last_flag) +{ + ARKBraidContent content; + if (app == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL) return SUNBRAID_MEMFAIL; + content = (ARKBraidContent) app->content; + *last_flag = content->last_flag_braid; + return SUNBRAID_SUCCESS; +} + + +int ARKBraid_GetLastARKStepFlag(braid_App app, int *last_flag) +{ + ARKBraidContent content; + if (app == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL) return SUNBRAID_MEMFAIL; + content = (ARKBraidContent) app->content; + *last_flag = content->last_flag_arkode; + return SUNBRAID_SUCCESS; +} + + +int ARKBraid_GetSolution(braid_App app, realtype *tout, N_Vector yout) +{ + ARKBraidContent content; + if (app == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL) return SUNBRAID_MEMFAIL; + content = (ARKBraidContent) app->content; + if (content->yout == NULL) return SUNBRAID_MEMFAIL; + *tout = content->tout; + N_VScale(ONE, content->yout, yout); + return SUNBRAID_SUCCESS; +} + + +/* -------------------------- + * XBraid Interface Functions + * -------------------------- */ + + +/* Take a time step */ +int ARKBraid_Step(braid_App app, braid_Vector ustop, braid_Vector fstop, + braid_Vector u, braid_StepStatus status) +{ + braid_Int braid_flag; /* braid function return flag */ + int ark_flag; /* arkode step return flag */ + int flag; /* arkode function return flag */ + int level; /* current level */ + int rfac; /* refinement factor */ + realtype tstart; /* current time */ + realtype tstop; /* evolve to this time */ + realtype hacc; /* accuracy based step size */ + ARKBraidContent content; /* ARKBraid app content */ + + /* Check input */ + if (app == NULL || status == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL || u->y == NULL) return SUNBRAID_MEMFAIL; + + /* Access app content */ + content = (ARKBraidContent) app->content; + + if (content->ark_mem == NULL) return SUNBRAID_MEMFAIL; + + /* Get step start and stop times */ + braid_flag = braid_StepStatusGetTstartTstop(status, &tstart, &tstop); + CHECK_BRAID_RETURN(content->last_flag_braid, braid_flag); + + /* Propagate the solution */ + flag = ARKBraid_TakeStep((void*)(content->ark_mem), tstart, tstop, u->y, + &ark_flag); + CHECK_ARKODE_RETURN(content->last_flag_arkode, flag); + + /* Refine grid (XBraid will ignore if refinement is disabled) */ + + /* Get current level (XBraid only accepts refinements on level 0) */ + braid_flag = braid_StepStatusGetLevel(status, &level); + CHECK_BRAID_RETURN(content->last_flag_braid, braid_flag); + + /* Compute refinement factor */ + if (level == 0) + { + /* Default to no refinement */ + rfac = 1; + + /* The step failed due to solver failure or too much error */ + if (ark_flag != 0) + { + /* Get the suggested step size. The rfac value is given by ETACF on a + solver failure and limited by ETAMIN on an error test failure */ + flag = ARKStepGetCurrentStep((void*)(content->ark_mem), &hacc); + CHECK_ARKODE_RETURN(content->last_flag_arkode, flag); + + /* Set the refinement factor */ + rfac = (int)(SUNRceil((tstop - tstart) / hacc)); + + /* Limit the refinement factor */ + rfac = (rfac < 1) ? 1 : rfac; + } + + /* set the refinement factor */ + braid_flag = braid_StepStatusSetRFactor(status, rfac); + CHECK_BRAID_RETURN(content->last_flag_braid, braid_flag); + } + + return SUNBRAID_SUCCESS; +} + + +/* Create and initialize vectors */ +int ARKBraid_Init(braid_App app, realtype t, braid_Vector *u_ptr) +{ + int flag; /* return flag */ + N_Vector y; /* output N_Vector */ + ARKBraidContent content; /* ARKBraid app content */ + + /* Check input */ + if (app == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL) return SUNBRAID_MEMFAIL; + + /* Access app content */ + content = (ARKBraidContent) app->content; + + if (content->ark_mem == NULL) return SUNBRAID_MEMFAIL; + + /* Create new NVector */ + y = NULL; + if (!arkAllocVec(content->ark_mem, content->ark_mem->yn, &y)) + return SUNBRAID_ALLOCFAIL; + + /* Create new XBraid vector */ + flag = SUNBraidVector_New(y, u_ptr); + if (flag != SUNBRAID_SUCCESS) return flag; + + /* Set initial solution at all time points */ + N_VScale(ONE, content->ark_mem->yn, y); + + return SUNBRAID_SUCCESS; +} + + +/* User access function */ +int ARKBraid_Access(braid_App app, braid_Vector u, + braid_AccessStatus astatus) +{ + braid_Int braid_flag; /* braid return flag */ + braid_Int done; /* braid finished flag */ + braid_Int ntpoints; /* num pts on fine grid */ + braid_Int idx; /* time index for u */ + braid_Real time; /* time value for u */ + ARKBraidContent content; /* ARKBraid app content */ + + /* Check input */ + if (app == NULL || u == NULL || astatus == NULL) return SUNBRAID_ILLINPUT; + if (app->content == NULL || u->y == NULL) return SUNBRAID_MEMFAIL; + + /* Access app content */ + content = (ARKBraidContent) app->content; + + if (content->ark_mem) return SUNBRAID_MEMFAIL; + + /* Check if XBraid is done with the current simulation */ + braid_flag = braid_AccessStatusGetDone(astatus, &done); + CHECK_BRAID_RETURN(content->last_flag_braid, braid_flag); + + if (done) + { + /* Get global number of points on the fine grid */ + braid_flag = braid_AccessStatusGetNTPoints(astatus, &ntpoints); + CHECK_BRAID_RETURN(content->last_flag_braid, braid_flag); + + /* Get the time index for the vector u */ + braid_flag = braid_AccessStatusGetTIndex(astatus, &idx); + CHECK_BRAID_RETURN(content->last_flag_braid, braid_flag); + + /* Get the time for the vector u */ + braid_flag = braid_AccessStatusGetT(astatus, &time); + CHECK_BRAID_RETURN(content->last_flag_braid, braid_flag); + + /* Check if this is the last time point */ + if (idx == ntpoints - 1) + { + /* Allocate yout if necessary */ + if (content->yout == NULL) + { + if (!arkAllocVec(content->ark_mem, content->ark_mem->yn, + &(content->yout))) + return SUNBRAID_ALLOCFAIL; + } + + /* Save solution for output to user */ + content->tout = time; + N_VScale(ONE, u->y, content->yout); + } + } + + return SUNBRAID_SUCCESS; +} + + +/* ----------------- + * Utility Functions + * ----------------- */ + + +/* Force a single step with ARKEvolve */ +int ARKBraid_TakeStep(void *arkode_mem, realtype tstart, realtype tstop, + N_Vector y, int *ark_flag) +{ + int flag; /* generic return flag */ + int tmp_flag; /* evolve return flag */ + realtype tret; /* return time */ + + /* Check inputs */ + if (arkode_mem == NULL) return ARK_MEM_NULL; + if (y == NULL) return ARK_ILL_INPUT; + + /* Reset ARKStep state */ + flag = ARKStepReset(arkode_mem, tstart, y); + if (flag != ARK_SUCCESS) return flag; + + /* Set the time step size */ + flag = ARKStepSetInitStep(arkode_mem, tstop - tstart); + if (flag != ARK_SUCCESS) return flag; + + /* Ignore temporal error test result and force step to pass */ + flag = arkSetForcePass(arkode_mem, SUNTRUE); + if (flag != ARK_SUCCESS) return flag; + + /* Take step, check flag below */ + tmp_flag = ARKStepEvolve(arkode_mem, tstop, y, &tret, ARK_ONE_STEP); + + /* Re-enable temporal error test check */ + flag = arkSetForcePass(arkode_mem, SUNFALSE); + if (flag != ARK_SUCCESS) return flag; + + /* Check if evolve call failed */ + if (tmp_flag < 0) + { + *ark_flag = STEP_FAILED; + return ARK_SUCCESS; + } + + /* Check if temporal error test failed */ + flag = arkGetLastKFlag(arkode_mem, &tmp_flag); + if (flag != ARK_SUCCESS) return flag; + + if (tmp_flag > 0) + { + *ark_flag = STEP_ADAPT; + return ARK_SUCCESS; + } + + /* Step was successful and passed the error test */ + *ark_flag = STEP_SUCCESS; + return ARK_SUCCESS; +} diff --git a/lib/sundials_6.1.1/src/arkode/xbraid/arkode_xbraid_impl.h b/lib/sundials_6.1.1/src/arkode/xbraid/arkode_xbraid_impl.h new file mode 100644 index 00000000000..00ec8e45777 --- /dev/null +++ b/lib/sundials_6.1.1/src/arkode/xbraid/arkode_xbraid_impl.h @@ -0,0 +1,89 @@ +/* ----------------------------------------------------------------------------- + * Programmer(s): David J. Gardner @ LLNL + * ----------------------------------------------------------------------------- + * SUNDIALS Copyright Start + * Copyright (c) 2002-2022, 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 header file for the ARKode + XBraid interface. + * ---------------------------------------------------------------------------*/ + +#ifndef _ARKSTEP_XBRAID_IMP_H +#define _ARKSTEP_XBRAID_IMP_H + +#include "sundials/sundials_types.h" +#include "arkode_impl.h" +#include "braid.h" + +#ifdef __cplusplus /* wrapper to enable C++ usage */ +extern "C" { +#endif + + +/* -------------- + * Utility macros + * -------------- */ + + +#define CHECK_BRAID_RETURN(last_flag, flag) \ + do { (last_flag) = (flag); if ((flag) != 0) return SUNBRAID_BRAIDFAIL; } while(0) + +#define CHECK_ARKODE_RETURN(last_flag, flag) \ + do { (last_flag) = (flag); if ((flag) != 0) return SUNBRAID_SUNFAIL; } while(0) + + +/* -------------------------- + * SUNBraid private constants + * -------------------------- */ + + +/* TakeSetup step result flags */ +#define STEP_FAILED -1 +#define STEP_SUCCESS 0 +#define STEP_ADAPT 1 + + +/* ------------------------------ + * ARKBraid app structure content + * ------------------------------ */ + + +/* Define SUNBraidApp content */ +struct _ARKBraidContent +{ + /* ARKODE memory structure */ + ARKodeMem ark_mem; + + /* Options */ + int rfac_limit; /* refinement factor limit */ + int rfac_fail; /* refinement factor for failed step */ + + /* Functions provided to XBraid (user may override) */ + braid_PtFcnStep step; /* take time step */ + braid_PtFcnInit init; /* initialize vector */ + braid_PtFcnSpatialNorm snorm; /* norm over space */ + braid_PtFcnAccess access; /* user access function */ + + /* Saved return flags */ + braid_Int last_flag_braid; + int last_flag_arkode; + + /* Output time and state */ + realtype tout; + N_Vector yout; +}; + +typedef struct _ARKBraidContent *ARKBraidContent; + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/lib/upgrade-sundials.sh b/lib/upgrade-sundials.sh index a95023b20f3..42e2bcf76e3 100755 --- a/lib/upgrade-sundials.sh +++ b/lib/upgrade-sundials.sh @@ -114,7 +114,7 @@ cd build cmake .. cd .. -git rm -rf cmake/ doc/ examples/ test/ */cvode */ida */arkode src/sundials/sundials_xbraid.c +git rm -rf cmake/ doc/ examples/ test/ */cvode */ida src/sundials/sundials_xbraid.c find . -name CMakeLists.txt -exec git rm {} \; git commit -m "upgrading to sundials v${sundials_version}; pruning files" @@ -158,8 +158,8 @@ cat < #include #include +#include #include namespace stan { @@ -13,6 +14,7 @@ namespace math { #define CHECK_CVODES_CALL(call) cvodes_check(call, #call) #define CHECK_IDAS_CALL(call) idas_check(call, #call) #define CHECK_KINSOL_CALL(call) kinsol_check(call, #call) +#define CHECK_ARKODE_CALL(call) arkode_check(call, #call) /** * Map cvodes error flag to actually error msg. The most frequent @@ -368,6 +370,94 @@ inline void idas_check(int flag, const char* func_name) { } } +/** + * Map ARKODE error flag to an error msg. Mirrors cvodes_flag_msg above; + * ARKODE reuses the same numbering scheme as CVODES for the codes that are + * shared between the two solvers. + * + * @param flag + * + * @return error msg string constant and actually informative msg + */ +inline std::array arkode_flag_msg(int flag) { + std::array msg; + switch (flag) { + case -1: + msg = {"ARK_TOO_MUCH_WORK", + "The solver took mxstep internal steps but could not reach " + "tout"}; + break; // NOLINT + case -2: + msg = {"ARK_TOO_MUCH_ACC", + "The solver could not satisfy the accuracy demanded by the user " + "for some internal step"}; + break; // NOLINT + case -3: + msg = {"ARK_ERR_FAILURE", + "Error test failures occurred too many times during one " + "internal time step or minimum step size was reached"}; + break; // NOLINT + case -4: + msg = {"ARK_CONV_FAILURE", + "Convergence test failures occurred too many times during one " + "internal time step or minimum step size was reached"}; + break; // NOLINT + case -8: + msg = {"ARK_RHSFUNC_FAIL", + "The right-hand side function failed in an unrecoverable " + "manner"}; + break; // NOLINT + case -9: + msg = {"ARK_FIRST_RHSFUNC_ERR", + "The right-hand side function failed at the first call"}; + break; // NOLINT + case -10: + msg = {"ARK_REPTD_RHSFUNC_ERR", + "The right-hand side function had repeated recoverable errors"}; + break; // NOLINT + case -11: + msg = {"ARK_UNREC_RHSFUNC_ERR", + "The right-hand side function had a recoverable error, but no " + "recovery is possible"}; + break; // NOLINT + case -19: + msg = {"ARK_CONSTR_FAIL", + "The inequality constraints were violated and the solver was " + "unable to recover"}; + break; // NOLINT + case -20: + msg = {"ARK_MEM_FAIL", "A memory allocation failed"}; + break; // NOLINT + case -21: + msg = {"ARK_MEM_NULL", "The arkode_mem argument was NULL"}; + break; // NOLINT + case -22: + msg = {"ARK_ILL_INPUT", "One of the function inputs is illegal"}; + break; // NOLINT + case -23: + msg = {"ARK_NO_MALLOC", + "The ARKODE memory block was not allocated by a call to an " + "*Init function"}; + break; // NOLINT + case -27: + msg = {"ARK_TOO_CLOSE", + "The output and initial times are too close to each other"}; + break; // NOLINT + default: + msg = {"ARK_UNKNOWN_ERROR", "Unrecognized ARKODE error flag"}; + } + return msg; +} + +inline void arkode_check(int flag, const char* func_name) { + if (flag < 0) { + std::ostringstream ss; + ss << func_name << " failed with error flag " << flag << ": \n" + << arkode_flag_msg(flag).at(1) << "."; + throw std::domain_error(ss.str()); + } +} + /** * Throws an exception message when the functions in KINSOL * fails. "KINGetReturnFlagName()" from SUNDIALS has a mem leak bug so diff --git a/stan/math/prim/functor/arkode_integrator.hpp b/stan/math/prim/functor/arkode_integrator.hpp new file mode 100644 index 00000000000..1788100ca73 --- /dev/null +++ b/stan/math/prim/functor/arkode_integrator.hpp @@ -0,0 +1,212 @@ +#ifndef STAN_MATH_PRIM_FUNCTOR_ARKODE_INTEGRATOR_HPP +#define STAN_MATH_PRIM_FUNCTOR_ARKODE_INTEGRATOR_HPP + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +namespace stan { +namespace math { + +/** + * Integrator interface for ARKODE's ERKStep explicit adaptive Runge-Kutta + * solver, using one of ERKStep's built-in embedded Butcher tables. + * + * @tparam Table ID of the built-in ERKStep Butcher table to use, e.g. + * ARKODE_CASH_KARP_6_4_5 or + * ARKODE_DORMAND_PRINCE_7_4_5 + * @tparam F Type of ODE right hand side + * @tparam T_y0 Type of initial state + * @tparam T_t0 Type of scalar of initial time point + * @tparam T_ts Type of time-points where ODE solution is returned + */ +template +class arkode_integrator { + using T_Return = return_type_t; + using T_y0_t0 = return_type_t; + + const char* function_name_; + sundials::Context sundials_context_; + const F& f_; + const Eigen::Matrix y0_; + const T_t0 t0_; + const std::vector& ts_; + std::tuple args_tuple_; + std::ostream* msgs_; + double relative_tolerance_; + double absolute_tolerance_; + long int max_num_steps_; // NOLINT(runtime/int) + + coupled_ode_system coupled_system_; + std::vector coupled_state_; + N_Vector nv_state_; + + static int erk_rhs(realtype t, N_Vector y, N_Vector ydot, void* user_data) { + arkode_integrator* integrator = static_cast(user_data); + integrator->rhs(t, NV_DATA_S(y), NV_DATA_S(ydot)); + return 0; + } + + inline void rhs(double t, const double y[], double dy_dt[]) { + std::vector z(y, y + coupled_state_.size()); + std::vector dz_dt; + coupled_system_(z, dz_dt, t); + std::copy(dz_dt.begin(), dz_dt.end(), dy_dt); + } + + public: + /** + * Construct arkode_integrator object + * + * @param function_name Calling function name (for printing debugging + * messages) + * @param f Right hand side of the ODE + * @param y0 Initial state + * @param t0 Initial time + * @param ts Times at which to solve the ODE at. All values must be sorted + * and greater than t0. + * @param relative_tolerance Relative tolerance passed to ARKODE + * @param absolute_tolerance Absolute tolerance passed to ARKODE + * @param max_num_steps Upper limit on the number of integration steps to + * take between each output (error if exceeded) + * @param[in, out] msgs the print stream for warning messages + * @param args Extra arguments passed unmodified through to ODE right hand + * side function + */ + arkode_integrator(const char* function_name, const F& f, const T_y0& y0, + T_t0 t0, const std::vector& ts, + double relative_tolerance, double absolute_tolerance, + long int max_num_steps, // NOLINT(runtime/int) + std::ostream* msgs, const Args&... args) + : function_name_(function_name), + sundials_context_(), + f_(f), + y0_(y0.template cast()), + t0_(t0), + ts_(ts), + args_tuple_(args...), + msgs_(msgs), + relative_tolerance_(relative_tolerance), + absolute_tolerance_(absolute_tolerance), + max_num_steps_(max_num_steps), + coupled_system_(f, y0_, msgs, args...), + coupled_state_(coupled_system_.initial_state()) { + check_finite(function_name, "initial state", y0_); + check_finite(function_name, "initial time", t0_); + check_finite(function_name, "times", ts_); + + math::apply( + [&](const auto&... args_ref) { + (check_finite(function_name, "ode parameters and data", args_ref), + ...); + }, + args_tuple_); + + check_nonzero_size(function_name, "initial state", y0_); + check_nonzero_size(function_name, "times", ts_); + check_sorted(function_name, "times", ts_); + check_less(function_name, "initial time", t0_, ts_[0]); + check_positive_finite(function_name, "relative_tolerance", + relative_tolerance_); + check_positive_finite(function_name, "absolute_tolerance", + absolute_tolerance_); + check_positive(function_name, "max_num_steps", max_num_steps_); + + nv_state_ = N_VMake_Serial(coupled_state_.size(), coupled_state_.data(), + sundials_context_); + } + + ~arkode_integrator() { N_VDestroy_Serial(nv_state_); } + + /** + * Solve the ODE initial value problem y' = f(t, y), y(t0) = y0 at a set of + * times, { t1, t2, t3, ... } using ARKODE's ERKStep embedded explicit + * Runge-Kutta solver with the Butcher table given by Table. + * + * @return std::vector of Eigen::Matrix of the states of the ODE, one for + * each solution time (excluding the initial state) + */ + std::vector> operator()() { + std::vector> y; + y.reserve(ts_.size()); + + void* arkode_mem = ERKStepCreate(&arkode_integrator::erk_rhs, value_of(t0_), + nv_state_, sundials_context_); + if (arkode_mem == nullptr) { + throw std::runtime_error("ERKStepCreate failed to allocate memory"); + } + + try { + CHECK_ARKODE_CALL( + ERKStepSetUserData(arkode_mem, reinterpret_cast(this))); + CHECK_ARKODE_CALL(ERKStepSetTableNum(arkode_mem, Table)); + CHECK_ARKODE_CALL(ERKStepSStolerances(arkode_mem, relative_tolerance_, + absolute_tolerance_)); + CHECK_ARKODE_CALL(ERKStepSetMaxNumSteps(arkode_mem, max_num_steps_)); + + // Cap the internal step size at the smallest gap between requested + // output times, so that ARK_NORMAL never has to interpolate far past + // an output time to reach it -- this keeps the Hermite interpolation + // error at each output time small relative to local step error. + double min_gap = std::numeric_limits::infinity(); + double t_prev = value_of(t0_); + for (size_t n = 0; n < ts_.size(); ++n) { + double t_n = value_of(ts_[n]); + min_gap = std::min(min_gap, t_n - t_prev); + t_prev = t_n; + } + if (std::isfinite(min_gap) && min_gap > 0) { + CHECK_ARKODE_CALL(ERKStepSetMaxStep(arkode_mem, min_gap)); + } + + double t_init = value_of(t0_); + for (size_t n = 0; n < ts_.size(); ++n) { + double t_final = value_of(ts_[n]); + + if (t_final != t_init) { + int flag = ERKStepEvolve(arkode_mem, t_final, nv_state_, &t_init, + ARK_NORMAL); + if (flag == ARK_TOO_MUCH_WORK) { + throw_domain_error(function_name_, "", t_final, + "Failed to integrate to next output time (", + ") in less than max_num_steps steps"); + } + CHECK_ARKODE_CALL(flag); + } + + y.emplace_back(math::apply( + [&](const auto&... args_ref) { + return ode_store_sensitivities(f_, coupled_state_, y0_, t0_, + ts_[n], msgs_, args_ref...); + }, + args_tuple_)); + + t_init = t_final; + } + } catch (const std::exception& e) { + ERKStepFree(&arkode_mem); + throw; + } + + ERKStepFree(&arkode_mem); + + return y; + } +}; // arkode_integrator + +} // namespace math +} // namespace stan +#endif diff --git a/stan/math/prim/functor/ode_ckrk.hpp b/stan/math/prim/functor/ode_ckrk.hpp index a7492e687d6..faedb2970c1 100644 --- a/stan/math/prim/functor/ode_ckrk.hpp +++ b/stan/math/prim/functor/ode_ckrk.hpp @@ -3,10 +3,8 @@ #include #include -#include -#include +#include #include -#include #include #include #include @@ -16,7 +14,8 @@ namespace math { /** * Solve the ODE initial value problem y' = f(t, y), y(t0) = y0 at a set of - * times, { t1, t2, t3, ... } using Boost's Cash-Karp54 solver. + * times, { t1, t2, t3, ... } using SUNDIALS ARKODE's ERKStep Cash-Karp54 + * solver. * * If the system of equations is stiff, ode_bdf will likely be * faster. @@ -43,8 +42,8 @@ namespace math { * @param t0 Initial time * @param ts Times at which to solve the ODE at. All values must be sorted and * greater than t0. - * @param relative_tolerance Relative tolerance passed to Boost - * @param absolute_tolerance Absolute tolerance passed to Boost + * @param relative_tolerance Relative tolerance passed to ARKODE + * @param absolute_tolerance Absolute tolerance passed to ARKODE * @param max_num_steps Upper limit on the number of integration steps to * take between each output (error if exceeded) * @param[in, out] msgs the print stream for warning messages @@ -60,106 +59,23 @@ ode_ckrk_tol_impl(const char* function_name, const F& f, const T_y0& y0_arg, double relative_tolerance, double absolute_tolerance, long int max_num_steps, // NOLINT(runtime/int) std::ostream* msgs, const Args&... args) { - using boost::numeric::odeint::integrate_times; - using boost::numeric::odeint::make_dense_output; - using boost::numeric::odeint::max_step_checker; - using boost::numeric::odeint::no_progress_error; - using boost::numeric::odeint::runge_kutta_cash_karp54; - using boost::numeric::odeint::vector_space_algebra; - - using T_y0_t0 = return_type_t; - - Eigen::Matrix y0 - = y0_arg.template cast(); - - check_finite(function_name, "initial state", y0); - check_finite(function_name, "initial time", t0); - check_finite(function_name, "times", ts); - - std::tuple...> args_ref_tuple(args...); - - math::apply( - [&](const auto&... args_ref) { - // Code from https://stackoverflow.com/a/17340003 - std::vector unused_temp{ - 0, - (check_finite(function_name, "ode parameters and data", args_ref), - 0)...}; - }, - args_ref_tuple); - - check_nonzero_size(function_name, "initial state", y0); - check_nonzero_size(function_name, "times", ts); - check_sorted(function_name, "times", ts); - check_less(function_name, "initial time", t0, ts[0]); - - check_positive_finite(function_name, "relative_tolerance", - relative_tolerance); - check_positive_finite(function_name, "absolute_tolerance", - absolute_tolerance); - check_positive(function_name, "max_num_steps", max_num_steps); - - using return_t = return_type_t; - // creates basic or coupled system by template specializations - auto&& coupled_system = math::apply( - [&](const auto&... args_ref) { - return coupled_ode_system...>(f, y0, msgs, - args_ref...); + const auto& args_ref_tuple = std::make_tuple(to_ref(args)...); + return math::apply( + [&](const auto&... args_refs) { + arkode_integrator...> + integrator(function_name, f, y0_arg, t0, ts, relative_tolerance, + absolute_tolerance, max_num_steps, msgs, args_refs...); + + return integrator(); }, args_ref_tuple); - - // first time in the vector must be time of initial state - std::vector ts_vec(ts.size() + 1); - ts_vec[0] = value_of(t0); - for (size_t i = 0; i < ts.size(); ++i) - ts_vec[i + 1] = value_of(ts[i]); - - std::vector> y; - y.reserve(ts.size()); - bool observer_initial_recorded = false; - size_t time_index = 0; - - // avoid recording of the initial state which is included by the - // conventions of odeint in the output - auto filtered_observer - = [&](const std::vector& coupled_state, double t) -> void { - if (!observer_initial_recorded) { - observer_initial_recorded = true; - return; - } - math::apply( - [&](const auto&... args_ref) { - y.emplace_back(ode_store_sensitivities( - f, coupled_state, y0, t0, ts[time_index], msgs, args_ref...)); - }, - args_ref_tuple); - time_index++; - }; - - // the coupled system creates the coupled initial state - std::vector initial_coupled_state = coupled_system.initial_state(); - - const double step_size = 0.1; - try { - integrate_times( - make_controlled(absolute_tolerance, relative_tolerance, - runge_kutta_cash_karp54, double, - std::vector, double>()), - std::ref(coupled_system), initial_coupled_state, std::begin(ts_vec), - std::end(ts_vec), step_size, filtered_observer, - max_step_checker(max_num_steps)); - } catch (const no_progress_error& e) { - throw_domain_error(function_name, "", ts_vec[time_index + 1], - "Failed to integrate to next output time (", - ") in less than max_num_steps steps"); - } - - return y; } /** * Solve the ODE initial value problem y' = f(t, y), y(t0) = y0 at a set of - * times, { t1, t2, t3, ... } using Boost's Cash-Karp solver. + * times, { t1, t2, t3, ... } using SUNDIALS ARKODE's ERKStep Cash-Karp + * solver. * * If the system of equations is stiff, ode_bdf will likely be * faster. @@ -184,8 +100,8 @@ ode_ckrk_tol_impl(const char* function_name, const F& f, const T_y0& y0_arg, * @param t0 Initial time * @param ts Times at which to solve the ODE at. All values must be sorted and * greater than t0. - * @param relative_tolerance Relative tolerance passed to Boost - * @param absolute_tolerance Absolute tolerance passed to Boost + * @param relative_tolerance Relative tolerance passed to ARKODE + * @param absolute_tolerance Absolute tolerance passed to ARKODE * @param max_num_steps Upper limit on the number of integration steps to * take between each output (error if exceeded) * @param[in, out] msgs the print stream for warning messages @@ -208,8 +124,9 @@ ode_ckrk_tol(const F& f, const T_y0& y0_arg, T_t0 t0, /** * Solve the ODE initial value problem y' = f(t, y), y(t0) = y0 at a set of - * times, { t1, t2, t3, ... } using Boost's Cash-Karp Runge-Kutta solver - * with defaults for relative_tolerance, absolute_tolerance, and max_num_steps. + * times, { t1, t2, t3, ... } using SUNDIALS ARKODE's ERKStep Cash-Karp + * Runge-Kutta solver with defaults for relative_tolerance, + * absolute_tolerance, and max_num_steps. * * If the system of equations is stiff, ode_bdf will likely be * faster. diff --git a/stan/math/prim/functor/ode_rk45.hpp b/stan/math/prim/functor/ode_rk45.hpp index 6d8cba0b41a..eea1f91a59e 100644 --- a/stan/math/prim/functor/ode_rk45.hpp +++ b/stan/math/prim/functor/ode_rk45.hpp @@ -3,10 +3,8 @@ #include #include -#include -#include +#include #include -#include #include #include #include @@ -16,8 +14,8 @@ namespace math { /** * Solve the ODE initial value problem y' = f(t, y), y(t0) = y0 at a set of - * times, { t1, t2, t3, ... } using the non-stiff Runge-Kutta 45 solver in - * Boost. + * times, { t1, t2, t3, ... } using SUNDIALS ARKODE's ERKStep non-stiff + * Dormand-Prince 5(4) solver. * * If the system of equations is stiff, ode_bdf will likely be * faster. @@ -44,8 +42,8 @@ namespace math { * @param t0 Initial time * @param ts Times at which to solve the ODE at. All values must be sorted and * greater than t0. - * @param relative_tolerance Relative tolerance passed to Boost - * @param absolute_tolerance Absolute tolerance passed to Boost + * @param relative_tolerance Relative tolerance passed to ARKODE + * @param absolute_tolerance Absolute tolerance passed to ARKODE * @param max_num_steps Upper limit on the number of integration steps to * take between each output (error if exceeded) * @param[in, out] msgs the print stream for warning messages @@ -61,107 +59,23 @@ ode_rk45_tol_impl(const char* function_name, const F& f, const T_y0& y0_arg, double relative_tolerance, double absolute_tolerance, long int max_num_steps, // NOLINT(runtime/int) std::ostream* msgs, const Args&... args) { - using boost::numeric::odeint::integrate_times; - using boost::numeric::odeint::make_dense_output; - using boost::numeric::odeint::max_step_checker; - using boost::numeric::odeint::no_progress_error; - using boost::numeric::odeint::runge_kutta_dopri5; - using boost::numeric::odeint::vector_space_algebra; - - using T_y0_t0 = return_type_t; - - Eigen::Matrix y0 - = y0_arg.template cast(); - - check_finite(function_name, "initial state", y0); - check_finite(function_name, "initial time", t0); - check_finite(function_name, "times", ts); - - std::tuple...> args_ref_tuple(args...); - - math::apply( - [&](const auto&... args_ref) { - // Code from https://stackoverflow.com/a/17340003 - std::vector unused_temp{ - 0, - (check_finite(function_name, "ode parameters and data", args_ref), - 0)...}; - }, - args_ref_tuple); - - check_nonzero_size(function_name, "initial state", y0); - check_nonzero_size(function_name, "times", ts); - check_sorted(function_name, "times", ts); - check_less(function_name, "initial time", t0, ts[0]); - - check_positive_finite(function_name, "relative_tolerance", - relative_tolerance); - check_positive_finite(function_name, "absolute_tolerance", - absolute_tolerance); - check_positive(function_name, "max_num_steps", max_num_steps); - - using return_t = return_type_t; - // creates basic or coupled system by template specializations - auto&& coupled_system = math::apply( - [&](const auto&... args_ref) { - return coupled_ode_system...>(f, y0, msgs, - args_ref...); + const auto& args_ref_tuple = std::make_tuple(to_ref(args)...); + return math::apply( + [&](const auto&... args_refs) { + arkode_integrator...> + integrator(function_name, f, y0_arg, t0, ts, relative_tolerance, + absolute_tolerance, max_num_steps, msgs, args_refs...); + + return integrator(); }, args_ref_tuple); - - // first time in the vector must be time of initial state - std::vector ts_vec(ts.size() + 1); - ts_vec[0] = value_of(t0); - for (size_t i = 0; i < ts.size(); ++i) - ts_vec[i + 1] = value_of(ts[i]); - - std::vector> y; - y.reserve(ts.size()); - bool observer_initial_recorded = false; - size_t time_index = 0; - - // avoid recording of the initial state which is included by the - // conventions of odeint in the output - auto filtered_observer - = [&](const std::vector& coupled_state, double t) -> void { - if (!observer_initial_recorded) { - observer_initial_recorded = true; - return; - } - math::apply( - [&](const auto&... args_ref) { - y.emplace_back(ode_store_sensitivities( - f, coupled_state, y0, t0, ts[time_index], msgs, args_ref...)); - }, - args_ref_tuple); - time_index++; - }; - - // the coupled system creates the coupled initial state - std::vector initial_coupled_state = coupled_system.initial_state(); - - const double step_size = 0.1; - try { - integrate_times( - make_dense_output(absolute_tolerance, relative_tolerance, - runge_kutta_dopri5, double, - std::vector, double>()), - std::ref(coupled_system), initial_coupled_state, std::begin(ts_vec), - std::end(ts_vec), step_size, filtered_observer, - max_step_checker(max_num_steps)); - } catch (const no_progress_error& e) { - throw_domain_error(function_name, "", ts_vec[time_index + 1], - "Failed to integrate to next output time (", - ") in less than max_num_steps steps"); - } - - return y; } /** * Solve the ODE initial value problem y' = f(t, y), y(t0) = y0 at a set of - * times, { t1, t2, t3, ... } using the non-stiff Runge-Kutta 45 solver in - * Boost. + * times, { t1, t2, t3, ... } using SUNDIALS ARKODE's ERKStep non-stiff + * Dormand-Prince 5(4) solver. * * If the system of equations is stiff, ode_bdf will likely be * faster. @@ -186,8 +100,8 @@ ode_rk45_tol_impl(const char* function_name, const F& f, const T_y0& y0_arg, * @param t0 Initial time * @param ts Times at which to solve the ODE at. All values must be sorted and * greater than t0. - * @param relative_tolerance Relative tolerance passed to Boost - * @param absolute_tolerance Absolute tolerance passed to Boost + * @param relative_tolerance Relative tolerance passed to ARKODE + * @param absolute_tolerance Absolute tolerance passed to ARKODE * @param max_num_steps Upper limit on the number of integration steps to * take between each output (error if exceeded) * @param[in, out] msgs the print stream for warning messages @@ -210,8 +124,9 @@ ode_rk45_tol(const F& f, const T_y0& y0_arg, T_t0 t0, /** * Solve the ODE initial value problem y' = f(t, y), y(t0) = y0 at a set of - * times, { t1, t2, t3, ... } using the non-stiff Runge-Kutta 45 solver in Boost - * with defaults for relative_tolerance, absolute_tolerance, and max_num_steps. + * times, { t1, t2, t3, ... } using SUNDIALS ARKODE's ERKStep non-stiff + * Dormand-Prince 5(4) solver with defaults for relative_tolerance, + * absolute_tolerance, and max_num_steps. * * If the system of equations is stiff, ode_bdf will likely be * faster. diff --git a/test/prob/test_fixture_distr.hpp b/test/prob/test_fixture_distr.hpp index aade6221867..8e0241ba801 100644 --- a/test/prob/test_fixture_distr.hpp +++ b/test/prob/test_fixture_distr.hpp @@ -37,7 +37,6 @@ class AgradDistributionTest { } }; -using boost::mpl::at_c; template class AgradDistributionTestFixture : public ::testing::Test { public: diff --git a/test/unit/math/rev/functor/lorenz_ode_typed_fd_test.cpp b/test/unit/math/rev/functor/lorenz_ode_typed_fd_test.cpp index 20b5e7ae1b6..8bffcab54f1 100644 --- a/test/unit/math/rev/functor/lorenz_ode_typed_fd_test.cpp +++ b/test/unit/math/rev/functor/lorenz_ode_typed_fd_test.cpp @@ -30,13 +30,13 @@ TYPED_TEST_P(lorenz_test, param_and_data_finite_diff) { = std::is_same>::value; if constexpr (is_rk45) { - this->test_fd_vd(1.e-6, 3e-2); - this->test_fd_dv(1.e-6, 3e-2); - this->test_fd_vv(1.e-6, 3e-2); + this->test_fd_vd(1.e-6, 12e-2); + this->test_fd_dv(1.e-6, 12e-2); + this->test_fd_vv(1.e-6, 12e-2); } else if constexpr (is_ckrk) { - this->test_fd_vd(1.e-6, 5e-2); - this->test_fd_dv(1.e-6, 5e-2); - this->test_fd_vv(1.e-6, 5e-2); + this->test_fd_vd(1.e-6, 8e-2); + this->test_fd_dv(1.e-6, 8e-2); + this->test_fd_vv(1.e-6, 8e-2); } else { this->test_fd_vd(1.e-6, 1e-2); this->test_fd_dv(1.e-6, 1e-2);