void FSUNLAPACKBAND_INIT(int *code, int *ier)
{
*ier = 0;
switch(*code) {
case FCMIX_CVODE:
if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol);
F2C_CVODE_linsol = NULL;
F2C_CVODE_linsol = SUNLinSol_LapackBand(F2C_CVODE_vec, F2C_CVODE_matrix);
if (F2C_CVODE_linsol == NULL) *ier = -1;
break;
case FCMIX_IDA:
if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol);
F2C_IDA_linsol = NULL;
F2C_IDA_linsol = SUNLinSol_LapackBand(F2C_IDA_vec, F2C_IDA_matrix);
if (F2C_IDA_linsol == NULL) *ier = -1;
break;
case FCMIX_KINSOL:
if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol);
F2C_KINSOL_linsol = NULL;
F2C_KINSOL_linsol = SUNLinSol_LapackBand(F2C_KINSOL_vec, F2C_KINSOL_matrix);
if (F2C_KINSOL_linsol == NULL) *ier = -1;
break;
case FCMIX_ARKODE:
if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol);
F2C_ARKODE_linsol = NULL;
F2C_ARKODE_linsol = SUNLinSol_LapackBand(F2C_ARKODE_vec, F2C_ARKODE_matrix);
if (F2C_ARKODE_linsol == NULL) *ier = -1;
break;
default:
*ier = -1;
}
}
/* Fortran interface to C routine ARKStepFree; see farkode.h for
further details */
void FARK_FREE() {
ARKodeMem ark_mem;
ark_mem = (ARKodeMem) ARK_arkodemem;
/* free user_data structure */
if (ark_mem->user_data)
free(ark_mem->user_data);
ark_mem->user_data = NULL;
/* free main integrator memory structure (internally
frees time step module, rootfinding, interpolation structures) */
ARKStepFree(&ARK_arkodemem);
/* free interface vector / matrices / linear solvers */
N_VSetArrayPointer(NULL, F2C_ARKODE_vec);
N_VDestroy(F2C_ARKODE_vec);
if (F2C_ARKODE_matrix)
SUNMatDestroy(F2C_ARKODE_matrix);
if (F2C_ARKODE_mass_matrix)
SUNMatDestroy(F2C_ARKODE_mass_matrix);
if (F2C_ARKODE_linsol)
SUNLinSolFree(F2C_ARKODE_linsol);
if (F2C_ARKODE_mass_sol)
SUNLinSolFree(F2C_ARKODE_mass_sol);
return;
}
/*-------------------------------------------------------------*/
static int IDABBDPrecFree(IDAMem IDA_mem)
{
IDALsMem idals_mem;
IBBDPrecData pdata;
if (IDA_mem->ida_lmem == NULL) return(0);
idals_mem = (IDALsMem) IDA_mem->ida_lmem;
if (idals_mem->pdata == NULL) return(0);
pdata = (IBBDPrecData) idals_mem->pdata;
SUNLinSolFree(pdata->LS);
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->zlocal);
N_VDestroy(pdata->tempv1);
N_VDestroy(pdata->tempv2);
N_VDestroy(pdata->tempv3);
N_VDestroy(pdata->tempv4);
SUNMatDestroy(pdata->PP);
free(pdata);
pdata = NULL;
return(0);
}
void FCV_FREE ()
{
CVodeMem cv_mem;
cv_mem = (CVodeMem) CV_cvodemem;
if (cv_mem->cv_lfree)
cv_mem->cv_lfree(cv_mem);
cv_mem->cv_lmem = NULL;
free(cv_mem->cv_user_data); cv_mem->cv_user_data = NULL;
CVodeFree(&CV_cvodemem);
N_VSetArrayPointer(NULL, F2C_CVODE_vec);
N_VDestroy(F2C_CVODE_vec);
if (F2C_CVODE_matrix)
SUNMatDestroy(F2C_CVODE_matrix);
if (F2C_CVODE_linsol)
SUNLinSolFree(F2C_CVODE_linsol);
/* already freed by CVodeFree */
if (F2C_CVODE_nonlinsol)
F2C_CVODE_nonlinsol = NULL;
return;
}
void FSUNMASSDENSELINSOL_INIT(int *ier)
{
*ier = 0;
if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol);
F2C_ARKODE_mass_sol = NULL;
F2C_ARKODE_mass_sol = SUNLinSol_Dense(F2C_ARKODE_vec,
F2C_ARKODE_mass_matrix);
if (F2C_ARKODE_mass_sol == NULL) *ier = -1;
}
void FSUNMASSLAPACKBAND_INIT(int *ier)
{
*ier = 0;
if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol);
F2C_ARKODE_mass_sol = NULL;
F2C_ARKODE_mass_sol = SUNLinSol_LapackBand(F2C_ARKODE_vec,
F2C_ARKODE_mass_matrix);
if (F2C_ARKODE_mass_sol == NULL) *ier = -1;
}
OpenSMOKE_CVODE_Sundials<T>::~OpenSMOKE_CVODE_Sundials(void)
{
/* Free vectors */
N_VDestroy_Serial(y0Sundials_);
N_VDestroy_Serial(ySundials_);
/* Free integrator memory */
CVodeFree(&cvode_mem_);
SUNLinSolFree(LS);
SUNMatDestroy(A);
delete[] this->y0_;
delete[] this->y_;
}
int main(void)
{
realtype abstol, reltol, t, tout;
N_Vector u;
UserData data;
SUNLinearSolver LS;
void *cvode_mem;
int linsolver, iout, retval;
u = NULL;
data = NULL;
LS = NULL;
cvode_mem = NULL;
/* Allocate memory, and set problem data, initial values, tolerances */
u = N_VNew_Serial(NEQ);
if(check_retval((void *)u, "N_VNew_Serial", 0)) return(1);
data = AllocUserData();
if(check_retval((void *)data, "AllocUserData", 2)) return(1);
InitUserData(data);
SetInitialProfiles(u, data->dx, data->dy);
abstol=ATOL;
reltol=RTOL;
/* Call CVodeCreate to create the solver memory and specify the
* Backward Differentiation Formula */
cvode_mem = CVodeCreate(CV_BDF);
if(check_retval((void *)cvode_mem, "CVodeCreate", 0)) return(1);
/* Set the pointer to user-defined data */
retval = CVodeSetUserData(cvode_mem, data);
if(check_retval(&retval, "CVodeSetUserData", 1)) return(1);
/* Call CVodeInit to initialize the integrator memory and specify the
* user's right hand side function in u'=f(t,u), the inital time T0, and
* the initial dependent variable vector u. */
retval = CVodeInit(cvode_mem, f, T0, u);
if(check_retval(&retval, "CVodeInit", 1)) return(1);
/* Call CVodeSStolerances to specify the scalar relative tolerance
* and scalar absolute tolerances */
retval = CVodeSStolerances(cvode_mem, reltol, abstol);
if (check_retval(&retval, "CVodeSStolerances", 1)) return(1);
/* START: Loop through SPGMR, SPBCG and SPTFQMR linear solver modules */
for (linsolver = 0; linsolver < 3; ++linsolver) {
if (linsolver != 0) {
/* Re-initialize user data */
InitUserData(data);
SetInitialProfiles(u, data->dx, data->dy);
/* Re-initialize CVode for the solution of the same problem, but
using a different linear solver module */
retval = CVodeReInit(cvode_mem, T0, u);
if (check_retval(&retval, "CVodeReInit", 1)) return(1);
}
/* Free previous linear solver and attach a new linear solver module */
SUNLinSolFree(LS);
switch(linsolver) {
/* (a) SPGMR */
case(USE_SPGMR):
/* Print header */
printf(" -------");
printf(" \n| SPGMR |\n");
printf(" -------\n");
/* Call SUNLinSol_SPGMR to specify the linear solver SPGMR with
left preconditioning and the default maximum Krylov dimension */
LS = SUNLinSol_SPGMR(u, PREC_LEFT, 0);
if(check_retval((void *)LS, "SUNLinSol_SPGMR", 0)) return(1);
retval = CVodeSetLinearSolver(cvode_mem, LS, NULL);
if(check_retval(&retval, "CVodeSetLinearSolver", 1)) return 1;
break;
/* (b) SPBCG */
case(USE_SPBCG):
/* Print header */
printf(" -------");
printf(" \n| SPBCGS |\n");
printf(" -------\n");
/* Call SUNLinSol_SPBCGS to specify the linear solver SPBCGS with
left preconditioning and the default maximum Krylov dimension */
LS = SUNLinSol_SPBCGS(u, PREC_LEFT, 0);
if(check_retval((void *)LS, "SUNLinSol_SPBCGS", 0)) return(1);
retval = CVodeSetLinearSolver(cvode_mem, LS, NULL);
if(check_retval(&retval, "CVodeSetLinearSolver", 1)) return 1;
break;
/* (c) SPTFQMR */
case(USE_SPTFQMR):
/* Print header */
printf(" ---------");
printf(" \n| SPTFQMR |\n");
printf(" ---------\n");
/* Call SUNLinSol_SPTFQMR to specify the linear solver SPTFQMR with
left preconditioning and the default maximum Krylov dimension */
LS = SUNLinSol_SPTFQMR(u, PREC_LEFT, 0);
if(check_retval((void *)LS, "SUNLinSol_SPTFQMR", 0)) return(1);
retval = CVodeSetLinearSolver(cvode_mem, LS, NULL);
if(check_retval(&retval, "CVodeSetLinearSolver", 1)) return 1;
break;
}
/* Set preconditioner setup and solve routines Precond and PSolve,
and the pointer to the user-defined block data */
retval = CVodeSetPreconditioner(cvode_mem, Precond, PSolve);
if(check_retval(&retval, "CVodeSetPreconditioner", 1)) return(1);
/* In loop over output points, call CVode, print results, test for error */
printf(" \n2-species diurnal advection-diffusion problem\n\n");
for (iout=1, tout = TWOHR; iout <= NOUT; iout++, tout += TWOHR) {
retval = CVode(cvode_mem, tout, u, &t, CV_NORMAL);
PrintOutput(cvode_mem, u, t);
if(check_retval(&retval, "CVode", 1)) break;
}
PrintFinalStats(cvode_mem, linsolver);
} /* END: Loop through SPGMR, SPBCG and SPTFQMR linear solver modules */
/* Free memory */
N_VDestroy(u);
FreeUserData(data);
CVodeFree(&cvode_mem);
SUNLinSolFree(LS);
return(0);
}
int main(int argc, char *argv[])
{
UserData data;
void *cvode_mem;
SUNMatrix A, AB;
SUNLinearSolver LS, LSB;
realtype dx, dy, reltol, abstol, t;
N_Vector u;
int indexB;
realtype reltolB, abstolB;
N_Vector uB;
int retval, ncheck;
data = NULL;
cvode_mem = NULL;
u = uB = NULL;
LS = LSB = NULL;
A = AB = NULL;
/* Allocate and initialize user data memory */
data = (UserData) malloc(sizeof *data);
if(check_retval((void *)data, "malloc", 2)) return(1);
dx = data->dx = XMAX/(MX+1);
dy = data->dy = YMAX/(MY+1);
data->hdcoef = ONE/(dx*dx);
data->hacoef = RCONST(1.5)/(TWO*dx);
data->vdcoef = ONE/(dy*dy);
/* Set the tolerances for the forward integration */
reltol = ZERO;
abstol = ATOL;
/* Allocate u vector */
u = N_VNew_Serial(NEQ);
if(check_retval((void *)u, "N_VNew", 0)) return(1);
/* Initialize u vector */
SetIC(u, data);
/* Create and allocate CVODES memory for forward run */
printf("\nCreate and allocate CVODES memory for forward runs\n");
cvode_mem = CVodeCreate(CV_BDF);
if(check_retval((void *)cvode_mem, "CVodeCreate", 0)) return(1);
retval = CVodeSetUserData(cvode_mem, data);
if(check_retval(&retval, "CVodeSetUserData", 1)) return(1);
retval = CVodeInit(cvode_mem, f, T0, u);
if(check_retval(&retval, "CVodeInit", 1)) return(1);
retval = CVodeSStolerances(cvode_mem, reltol, abstol);
if(check_retval(&retval, "CVodeSStolerances", 1)) return(1);
/* Create banded SUNMatrix for the forward problem */
A = SUNBandMatrix(NEQ, MY, MY);
if(check_retval((void *)A, "SUNBandMatrix", 0)) return(1);
/* Create banded SUNLinearSolver for the forward problem */
LS = SUNLinSol_Band(u, A);
if(check_retval((void *)LS, "SUNLinSol_Band", 0)) return(1);
/* Attach the matrix and linear solver */
retval = CVodeSetLinearSolver(cvode_mem, LS, A);
if(check_retval(&retval, "CVodeSetLinearSolver", 1)) return(1);
/* Set the user-supplied Jacobian routine for the forward problem */
retval = CVodeSetJacFn(cvode_mem, Jac);
if(check_retval(&retval, "CVodeSetJacFn", 1)) return(1);
/* Allocate global memory */
printf("\nAllocate global memory\n");
retval = CVodeAdjInit(cvode_mem, NSTEP, CV_HERMITE);
if(check_retval(&retval, "CVodeAdjInit", 1)) return(1);
/* Perform forward run */
printf("\nForward integration\n");
retval = CVodeF(cvode_mem, TOUT, u, &t, CV_NORMAL, &ncheck);
if(check_retval(&retval, "CVodeF", 1)) return(1);
printf("\nncheck = %d\n", ncheck);
/* Set the tolerances for the backward integration */
reltolB = RTOLB;
abstolB = ATOL;
/* Allocate uB */
uB = N_VNew_Serial(NEQ);
if(check_retval((void *)uB, "N_VNew", 0)) return(1);
/* Initialize uB = 0 */
N_VConst(ZERO, uB);
/* Create and allocate CVODES memory for backward run */
printf("\nCreate and allocate CVODES memory for backward run\n");
retval = CVodeCreateB(cvode_mem, CV_BDF, &indexB);
if(check_retval(&retval, "CVodeCreateB", 1)) return(1);
retval = CVodeSetUserDataB(cvode_mem, indexB, data);
if(check_retval(&retval, "CVodeSetUserDataB", 1)) return(1);
retval = CVodeInitB(cvode_mem, indexB, fB, TOUT, uB);
if(check_retval(&retval, "CVodeInitB", 1)) return(1);
retval = CVodeSStolerancesB(cvode_mem, indexB, reltolB, abstolB);
if(check_retval(&retval, "CVodeSStolerancesB", 1)) return(1);
/* Create banded SUNMatrix for the backward problem */
AB = SUNBandMatrix(NEQ, MY, MY);
if(check_retval((void *)AB, "SUNBandMatrix", 0)) return(1);
/* Create banded SUNLinearSolver for the backward problem */
LSB = SUNLinSol_Band(uB, AB);
if(check_retval((void *)LSB, "SUNLinSol_Band", 0)) return(1);
/* Attach the matrix and linear solver */
retval = CVodeSetLinearSolverB(cvode_mem, indexB, LSB, AB);
if(check_retval(&retval, "CVodeSetLinearSolverB", 1)) return(1);
/* Set the user-supplied Jacobian routine for the backward problem */
retval = CVodeSetJacFnB(cvode_mem, indexB, JacB);
if(check_retval(&retval, "CVodeSetJacFnB", 1)) return(1);
/* Perform backward integration */
printf("\nBackward integration\n");
retval = CVodeB(cvode_mem, T0, CV_NORMAL);
if(check_retval(&retval, "CVodeB", 1)) return(1);
retval = CVodeGetB(cvode_mem, indexB, &t, uB);
if(check_retval(&retval, "CVodeGetB", 1)) return(1);
PrintOutput(uB, data);
N_VDestroy(u); /* Free the u vector */
N_VDestroy(uB); /* Free the uB vector */
CVodeFree(&cvode_mem); /* Free the CVODE problem memory */
SUNLinSolFree(LS); /* Free the forward linear solver memory */
SUNMatDestroy(A); /* Free the forward matrix memory */
SUNLinSolFree(LSB); /* Free the backward linear solver memory */
SUNMatDestroy(AB); /* Free the backward matrix memory */
free(data); /* Free the user data */
return(0);
}
int main()
{
realtype fnormtol, scsteptol;
N_Vector y, scale, constraints;
int mset, flag, i;
void *kmem;
SUNMatrix J;
SUNLinearSolver LS;
y = scale = constraints = NULL;
kmem = NULL;
J = NULL;
LS = NULL;
printf("\nRobot Kinematics Example\n");
printf("8 variables; -1 <= x_i <= 1\n");
printf("KINSOL problem size: 8 + 2*8 = 24 \n\n");
/* Create vectors for solution, scales, and constraints */
y = N_VNew_Serial(NEQ);
if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1);
scale = N_VNew_Serial(NEQ);
if (check_flag((void *)scale, "N_VNew_Serial", 0)) return(1);
constraints = N_VNew_Serial(NEQ);
if (check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1);
/* Initialize and allocate memory for KINSOL */
kmem = KINCreate();
if (check_flag((void *)kmem, "KINCreate", 0)) return(1);
flag = KINInit(kmem, func, y); /* y passed as a template */
if (check_flag(&flag, "KINInit", 1)) return(1);
/* Set optional inputs */
N_VConst_Serial(ZERO,constraints);
for (i = NVAR+1; i <= NEQ; i++) Ith(constraints, i) = ONE;
flag = KINSetConstraints(kmem, constraints);
if (check_flag(&flag, "KINSetConstraints", 1)) return(1);
fnormtol = FTOL;
flag = KINSetFuncNormTol(kmem, fnormtol);
if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1);
scsteptol = STOL;
flag = KINSetScaledStepTol(kmem, scsteptol);
if (check_flag(&flag, "KINSetScaledStepTol", 1)) return(1);
/* Create dense SUNMatrix */
J = SUNDenseMatrix(NEQ, NEQ);
if(check_flag((void *)J, "SUNDenseMatrix", 0)) return(1);
/* Create dense SUNLinearSolver object */
LS = SUNLinSol_Dense(y, J);
if(check_flag((void *)LS, "SUNLinSol_Dense", 0)) return(1);
/* Attach the matrix and linear solver to KINSOL */
flag = KINSetLinearSolver(kmem, LS, J);
if(check_flag(&flag, "KINSetLinearSolver", 1)) return(1);
/* Set the Jacobian function */
flag = KINSetJacFn(kmem, jac);
if (check_flag(&flag, "KINSetJacFn", 1)) return(1);
/* Indicate exact Newton */
mset = 1;
flag = KINSetMaxSetupCalls(kmem, mset);
if (check_flag(&flag, "KINSetMaxSetupCalls", 1)) return(1);
/* Initial guess */
N_VConst_Serial(ONE, y);
for(i = 1; i <= NVAR; i++) Ith(y,i) = SUNRsqrt(TWO)/TWO;
printf("Initial guess:\n");
PrintOutput(y);
/* Call KINSol to solve problem */
N_VConst_Serial(ONE,scale);
flag = KINSol(kmem, /* KINSol memory block */
y, /* initial guess on input; solution vector */
KIN_LINESEARCH, /* global strategy choice */
scale, /* scaling vector, for the variable cc */
scale); /* scaling vector for function values fval */
if (check_flag(&flag, "KINSol", 1)) return(1);
printf("\nComputed solution:\n");
PrintOutput(y);
/* Print final statistics and free memory */
PrintFinalStats(kmem);
N_VDestroy_Serial(y);
N_VDestroy_Serial(scale);
N_VDestroy_Serial(constraints);
KINFree(&kmem);
SUNLinSolFree(LS);
SUNMatDestroy(J);
return(0);
}
int main(void)
{
void *mem;
N_Vector yy, yp, avtol;
realtype rtol, *yval, *ypval, *atval;
realtype t0, tout1, tout, tret;
int iout, retval, retvalr;
int rootsfound[2];
SUNMatrix A;
SUNLinearSolver LS;
sunindextype nnz;
mem = NULL;
yy = yp = avtol = NULL;
yval = ypval = atval = NULL;
A = NULL;
LS = NULL;
/* Allocate N-vectors. */
yy = N_VNew_Serial(NEQ);
if(check_retval((void *)yy, "N_VNew_Serial", 0)) return(1);
yp = N_VNew_Serial(NEQ);
if(check_retval((void *)yp, "N_VNew_Serial", 0)) return(1);
avtol = N_VNew_Serial(NEQ);
if(check_retval((void *)avtol, "N_VNew_Serial", 0)) return(1);
/* Create and initialize y, y', and absolute tolerance vectors. */
yval = N_VGetArrayPointer(yy);
yval[0] = ONE;
yval[1] = ZERO;
yval[2] = ZERO;
ypval = N_VGetArrayPointer(yp);
ypval[0] = RCONST(-0.04);
ypval[1] = RCONST(0.04);
ypval[2] = ZERO;
rtol = RCONST(1.0e-4);
atval = N_VGetArrayPointer(avtol);
atval[0] = RCONST(1.0e-8);
atval[1] = RCONST(1.0e-6);
atval[2] = RCONST(1.0e-6);
/* Integration limits */
t0 = ZERO;
tout1 = RCONST(0.4);
PrintHeader(rtol, avtol, yy);
/* Call IDACreate and IDAInit to initialize IDA memory */
mem = IDACreate();
if(check_retval((void *)mem, "IDACreate", 0)) return(1);
retval = IDAInit(mem, resrob, t0, yy, yp);
if(check_retval(&retval, "IDAInit", 1)) return(1);
/* Call IDASVtolerances to set tolerances */
retval = IDASVtolerances(mem, rtol, avtol);
if(check_retval(&retval, "IDASVtolerances", 1)) return(1);
/* Free avtol */
N_VDestroy(avtol);
/* Call IDARootInit to specify the root function grob with 2 components */
retval = IDARootInit(mem, 2, grob);
if (check_retval(&retval, "IDARootInit", 1)) return(1);
/* Create sparse SUNMatrix for use in linear solves */
nnz = NEQ * NEQ;
A = SUNSparseMatrix(NEQ, NEQ, nnz, CSC_MAT);
if(check_retval((void *)A, "SUNSparseMatrix", 0)) return(1);
/* Create SuperLUMT SUNLinearSolver object (one thread) */
LS = SUNLinSol_SuperLUMT(yy, A, 1);
if(check_retval((void *)LS, "SUNLinSol_SuperLUMT", 0)) return(1);
/* Attach the matrix and linear solver */
retval = IDASetLinearSolver(mem, LS, A);
if(check_retval(&retval, "IDASetLinearSolver", 1)) return(1);
/* Set the user-supplied Jacobian routine */
retval = IDASetJacFn(mem, jacrob);
if(check_retval(&retval, "IDASetJacFn", 1)) return(1);
/* In loop, call IDASolve, print results, and test for error.
Break out of loop when NOUT preset output times have been reached. */
iout = 0; tout = tout1;
while(1) {
retval = IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL);
PrintOutput(mem,tret,yy);
if(check_retval(&retval, "IDASolve", 1)) return(1);
if (retval == IDA_ROOT_RETURN) {
retvalr = IDAGetRootInfo(mem, rootsfound);
check_retval(&retvalr, "IDAGetRootInfo", 1);
PrintRootInfo(rootsfound[0],rootsfound[1]);
}
if (retval == IDA_SUCCESS) {
iout++;
tout *= RCONST(10.0);
}
if (iout == NOUT) break;
}
PrintFinalStats(mem);
/* Free memory */
IDAFree(&mem);
SUNLinSolFree(LS);
SUNMatDestroy(A);
N_VDestroy(yy);
N_VDestroy(yp);
return(0);
}
int main(int argc, char *argv[])
{
SUNMatrix A;
SUNLinearSolver LS;
void *cvode_mem;
UserData data;
realtype t, tout;
N_Vector y, constraints;
int iout, retval;
realtype pbar[NS];
int is;
N_Vector *yS;
booleantype sensi, err_con;
int sensi_meth;
cvode_mem = NULL;
data = NULL;
y = NULL;
yS = NULL;
A = NULL;
LS = NULL;
constraints = NULL;
/* Process arguments */
ProcessArgs(argc, argv, &sensi, &sensi_meth, &err_con);
/* User data structure */
data = (UserData) malloc(sizeof *data);
if (check_retval((void *)data, "malloc", 2)) return(1);
data->p[0] = RCONST(0.04);
data->p[1] = RCONST(1.0e4);
data->p[2] = RCONST(3.0e7);
/* Initial conditions */
y = N_VNew_Serial(NEQ);
if (check_retval((void *)y, "N_VNew_Serial", 0)) return(1);
Ith(y,1) = Y1;
Ith(y,2) = Y2;
Ith(y,3) = Y3;
/* Set constraints to all 1's for nonnegative solution values. */
constraints = N_VNew_Serial(NEQ);
if(check_retval((void *)constraints, "N_VNew_Serial", 0)) return(1);
N_VConst(ONE, constraints);
/* Create CVODES object */
cvode_mem = CVodeCreate(CV_BDF);
if (check_retval((void *)cvode_mem, "CVodeCreate", 0)) return(1);
/* Allocate space for CVODES */
retval = CVodeInit(cvode_mem, f, T0, y);
if (check_retval(&retval, "CVodeInit", 1)) return(1);
/* Use private function to compute error weights */
retval = CVodeWFtolerances(cvode_mem, ewt);
if (check_retval(&retval, "CVodeSetEwtFn", 1)) return(1);
/* Attach user data */
retval = CVodeSetUserData(cvode_mem, data);
if (check_retval(&retval, "CVodeSetUserData", 1)) return(1);
/* Call CVodeSetConstraints to initialize constraints */
retval = CVodeSetConstraints(cvode_mem, constraints);
if(check_retval(&retval, "CVodeSetConstraints", 1)) return(1);
N_VDestroy(constraints);
/* Create dense SUNMatrix */
A = SUNDenseMatrix(NEQ, NEQ);
if (check_retval((void *)A, "SUNDenseMatrix", 0)) return(1);
/* Create dense SUNLinearSolver */
LS = SUNLinSol_Dense(y, A);
if (check_retval((void *)LS, "SUNLinSol_Dense", 0)) return(1);
/* Attach the matrix and linear solver */
retval = CVDlsSetLinearSolver(cvode_mem, LS, A);
if (check_retval(&retval, "CVDlsSetLinearSolver", 1)) return(1);
/* Set the user-supplied Jacobian routine Jac */
retval = CVDlsSetJacFn(cvode_mem, Jac);
if (check_retval(&retval, "CVDlsSetJacFn", 1)) return(1);
printf("\n3-species chemical kinetics problem\n");
/* Sensitivity-related settings */
if (sensi) {
/* Set parameter scaling factor */
pbar[0] = data->p[0];
pbar[1] = data->p[1];
pbar[2] = data->p[2];
/* Set sensitivity initial conditions */
yS = N_VCloneVectorArray(NS, y);
if (check_retval((void *)yS, "N_VCloneVectorArray", 0)) return(1);
for (is=0;is<NS;is++) N_VConst(ZERO, yS[is]);
/* Call CVodeSensInit1 to activate forward sensitivity computations
and allocate internal memory for COVEDS related to sensitivity
calculations. Computes the right-hand sides of the sensitivity
ODE, one at a time */
retval = CVodeSensInit1(cvode_mem, NS, sensi_meth, fS, yS);
if(check_retval(&retval, "CVodeSensInit", 1)) return(1);
/* Call CVodeSensEEtolerances to estimate tolerances for sensitivity
variables based on the rolerances supplied for states variables and
the scaling factor pbar */
retval = CVodeSensEEtolerances(cvode_mem);
if(check_retval(&retval, "CVodeSensEEtolerances", 1)) return(1);
/* Set sensitivity analysis optional inputs */
/* Call CVodeSetSensErrCon to specify the error control strategy for
sensitivity variables */
retval = CVodeSetSensErrCon(cvode_mem, err_con);
if (check_retval(&retval, "CVodeSetSensErrCon", 1)) return(1);
/* Call CVodeSetSensParams to specify problem parameter information for
sensitivity calculations */
retval = CVodeSetSensParams(cvode_mem, NULL, pbar, NULL);
if (check_retval(&retval, "CVodeSetSensParams", 1)) return(1);
printf("Sensitivity: YES ");
if(sensi_meth == CV_SIMULTANEOUS)
printf("( SIMULTANEOUS +");
else
if(sensi_meth == CV_STAGGERED) printf("( STAGGERED +");
else printf("( STAGGERED1 +");
if(err_con) printf(" FULL ERROR CONTROL )");
else printf(" PARTIAL ERROR CONTROL )");
} else {
printf("Sensitivity: NO ");
}
/* In loop over output points, call CVode, print results, test for error */
printf("\n\n");
printf("===========================================");
printf("============================\n");
printf(" T Q H NST y1");
printf(" y2 y3 \n");
printf("===========================================");
printf("============================\n");
for (iout=1, tout=T1; iout <= NOUT; iout++, tout *= TMULT) {
retval = CVode(cvode_mem, tout, y, &t, CV_NORMAL);
if (check_retval(&retval, "CVode", 1)) break;
PrintOutput(cvode_mem, t, y);
/* Call CVodeGetSens to get the sensitivity solution vector after a
successful return from CVode */
if (sensi) {
retval = CVodeGetSens(cvode_mem, &t, yS);
if (check_retval(&retval, "CVodeGetSens", 1)) break;
PrintOutputS(yS);
}
printf("-----------------------------------------");
printf("------------------------------\n");
}
/* Print final statistics */
PrintFinalStats(cvode_mem, sensi);
/* Free memory */
N_VDestroy(y); /* Free y vector */
if (sensi) {
N_VDestroyVectorArray(yS, NS); /* Free yS vector */
}
free(data); /* Free user data */
CVodeFree(&cvode_mem); /* Free CVODES memory */
SUNLinSolFree(LS); /* Free the linear solver memory */
SUNMatDestroy(A); /* Free the matrix memory */
return(0);
}
/* Main Program */
int main() {
/* general problem parameters */
realtype T0 = RCONST(0.0); /* initial time */
realtype Tf = RCONST(1.0); /* final time */
int Nt = 10; /* total number of output times */
realtype rtol = 1.e-6; /* relative tolerance */
realtype atol = 1.e-10; /* absolute tolerance */
UserData udata = NULL;
realtype *data;
sunindextype N = 201; /* spatial mesh size */
realtype k = 0.5; /* heat conductivity */
sunindextype i;
/* general problem variables */
int flag; /* reusable error-checking flag */
N_Vector y = NULL; /* empty vector for storing solution */
SUNLinearSolver LS = NULL; /* empty linear solver object */
void *arkode_mem = NULL; /* empty ARKode memory structure */
FILE *FID, *UFID;
realtype t, dTout, tout;
int iout;
long int nst, nst_a, nfe, nfi, nsetups, nli, nJv, nlcf, nni, ncfn, netf;
/* allocate and fill udata structure */
udata = (UserData) malloc(sizeof(*udata));
udata->N = N;
udata->k = k;
udata->dx = RCONST(1.0)/(1.0*N-1.0); /* mesh spacing */
/* Initial problem output */
printf("\n1D Heat PDE test problem:\n");
printf(" N = %li\n", (long int) udata->N);
printf(" diffusion coefficient: k = %"GSYM"\n", udata->k);
/* Initialize data structures */
y = N_VNew_Serial(N); /* Create serial vector for solution */
if (check_flag((void *) y, "N_VNew_Serial", 0)) return 1;
N_VConst(0.0, y); /* Set initial conditions */
/* Call ARKStepCreate to initialize the ARK timestepper module and
specify the right-hand side function in y'=f(t,y), the inital time
T0, and the initial dependent variable vector y. Note: since this
problem is fully implicit, we set f_E to NULL and f_I to f. */
arkode_mem = ARKStepCreate(NULL, f, T0, y);
if (check_flag((void *) arkode_mem, "ARKStepCreate", 0)) return 1;
/* Set routines */
flag = ARKStepSetUserData(arkode_mem, (void *) udata); /* Pass udata to user functions */
if (check_flag(&flag, "ARKStepSetUserData", 1)) return 1;
flag = ARKStepSetMaxNumSteps(arkode_mem, 10000); /* Increase max num steps */
if (check_flag(&flag, "ARKStepSetMaxNumSteps", 1)) return 1;
flag = ARKStepSetPredictorMethod(arkode_mem, 1); /* Specify maximum-order predictor */
if (check_flag(&flag, "ARKStepSetPredictorMethod", 1)) return 1;
flag = ARKStepSStolerances(arkode_mem, rtol, atol); /* Specify tolerances */
if (check_flag(&flag, "ARKStepSStolerances", 1)) return 1;
/* Initialize PCG solver -- no preconditioning, with up to N iterations */
LS = SUNLinSol_PCG(y, 0, N);
if (check_flag((void *)LS, "SUNLinSol_PCG", 0)) return 1;
/* Linear solver interface -- set user-supplied J*v routine (no 'jtsetup' required) */
flag = ARKStepSetLinearSolver(arkode_mem, LS, NULL); /* Attach linear solver to ARKStep */
if (check_flag(&flag, "ARKStepSetLinearSolver", 1)) return 1;
flag = ARKStepSetJacTimes(arkode_mem, NULL, Jac); /* Set the Jacobian routine */
if (check_flag(&flag, "ARKStepSetJacTimes", 1)) return 1;
/* Specify linearly implicit RHS, with non-time-dependent Jacobian */
flag = ARKStepSetLinear(arkode_mem, 0);
if (check_flag(&flag, "ARKStepSetLinear", 1)) return 1;
/* output mesh to disk */
FID=fopen("heat_mesh.txt","w");
for (i=0; i<N; i++) fprintf(FID," %.16"ESYM"\n", udata->dx*i);
fclose(FID);
/* Open output stream for results, access data array */
UFID=fopen("heat1D.txt","w");
data = N_VGetArrayPointer(y);
/* output initial condition to disk */
for (i=0; i<N; i++) fprintf(UFID," %.16"ESYM"", data[i]);
fprintf(UFID,"\n");
/* Main time-stepping loop: calls ARKStepEvolve to perform the integration, then
prints results. Stops when the final time has been reached */
t = T0;
dTout = (Tf-T0)/Nt;
tout = T0+dTout;
printf(" t ||u||_rms\n");
printf(" -------------------------\n");
printf(" %10.6"FSYM" %10.6"FSYM"\n", t, SUNRsqrt(N_VDotProd(y,y)/N));
for (iout=0; iout<Nt; iout++) {
flag = ARKStepEvolve(arkode_mem, tout, y, &t, ARK_NORMAL); /* call integrator */
if (check_flag(&flag, "ARKStepEvolve", 1)) break;
printf(" %10.6"FSYM" %10.6"FSYM"\n", t, SUNRsqrt(N_VDotProd(y,y)/N)); /* print solution stats */
if (flag >= 0) { /* successful solve: update output time */
tout += dTout;
tout = (tout > Tf) ? Tf : tout;
} else { /* unsuccessful solve: break */
fprintf(stderr,"Solver failure, stopping integration\n");
break;
}
/* output results to disk */
for (i=0; i<N; i++) fprintf(UFID," %.16"ESYM"", data[i]);
fprintf(UFID,"\n");
}
printf(" -------------------------\n");
fclose(UFID);
/* Print some final statistics */
flag = ARKStepGetNumSteps(arkode_mem, &nst);
check_flag(&flag, "ARKStepGetNumSteps", 1);
flag = ARKStepGetNumStepAttempts(arkode_mem, &nst_a);
check_flag(&flag, "ARKStepGetNumStepAttempts", 1);
flag = ARKStepGetNumRhsEvals(arkode_mem, &nfe, &nfi);
check_flag(&flag, "ARKStepGetNumRhsEvals", 1);
flag = ARKStepGetNumLinSolvSetups(arkode_mem, &nsetups);
check_flag(&flag, "ARKStepGetNumLinSolvSetups", 1);
flag = ARKStepGetNumErrTestFails(arkode_mem, &netf);
check_flag(&flag, "ARKStepGetNumErrTestFails", 1);
flag = ARKStepGetNumNonlinSolvIters(arkode_mem, &nni);
check_flag(&flag, "ARKStepGetNumNonlinSolvIters", 1);
flag = ARKStepGetNumNonlinSolvConvFails(arkode_mem, &ncfn);
check_flag(&flag, "ARKStepGetNumNonlinSolvConvFails", 1);
flag = ARKStepGetNumLinIters(arkode_mem, &nli);
check_flag(&flag, "ARKStepGetNumLinIters", 1);
flag = ARKStepGetNumJtimesEvals(arkode_mem, &nJv);
check_flag(&flag, "ARKStepGetNumJtimesEvals", 1);
flag = ARKStepGetNumLinConvFails(arkode_mem, &nlcf);
check_flag(&flag, "ARKStepGetNumLinConvFails", 1);
printf("\nFinal Solver Statistics:\n");
printf(" Internal solver steps = %li (attempted = %li)\n", nst, nst_a);
printf(" Total RHS evals: Fe = %li, Fi = %li\n", nfe, nfi);
printf(" Total linear solver setups = %li\n", nsetups);
printf(" Total linear iterations = %li\n", nli);
printf(" Total number of Jacobian-vector products = %li\n", nJv);
printf(" Total number of linear solver convergence failures = %li\n", nlcf);
printf(" Total number of Newton iterations = %li\n", nni);
printf(" Total number of nonlinear solver convergence failures = %li\n", ncfn);
printf(" Total number of error test failures = %li\n", netf);
/* Clean up and return with successful completion */
N_VDestroy(y); /* Free vectors */
free(udata); /* Free user data */
ARKStepFree(&arkode_mem); /* Free integrator memory */
SUNLinSolFree(LS); /* Free linear solver */
return 0;
}
int main()
{
void *cvode_mem;
SUNMatrix A;
SUNLinearSolver LS;
N_Vector y;
int flag, ret;
realtype reltol, abstol, t0, t1, t2, t;
long int nst1, nst2, nst;
reltol = RCONST(1.0e-3);
abstol = RCONST(1.0e-4);
t0 = RCONST(0.0);
t1 = RCONST(1.0);
t2 = RCONST(2.0);
/* Allocate the vector of initial conditions */
y = N_VNew_Serial(NEQ);
/* Set initial condition */
NV_Ith_S(y,0) = RCONST(1.0);
/*
* ------------------------------------------------------------
* Shared initialization and setup
* ------------------------------------------------------------
*/
/* Call CVodeCreate to create CVODE memory block and specify the
* Backward Differentiaion Formula */
cvode_mem = CVodeCreate(CV_BDF);
if (check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1);
/* Call CVodeInit to initialize integrator memory and specify the
* user's right hand side function y'=f(t,y), the initial time T0
* and the initial condiition vector y. */
ret = CVodeInit(cvode_mem, f, t0, y);
if (check_flag((void *)&ret, "CVodeInit", 1)) return(1);
/* Call CVodeSStolerances to specify integration tolereances,
* specifically the scalar relative and absolute tolerance. */
ret = CVodeSStolerances(cvode_mem, reltol, abstol);
if (check_flag((void *)&ret, "CVodeSStolerances", 1)) return(1);
/* Provide RHS flag as user data which can be access in user provided routines */
ret = CVodeSetUserData(cvode_mem, &flag);
if (check_flag((void *)&ret, "CVodeSetUserData", 1)) return(1);
/* Create dense SUNMatrix for use in linear solver */
A = SUNDenseMatrix(NEQ, NEQ);
if (check_flag((void *)A, "SUNDenseMatrix", 0)) return(1);
/* Create dense linear solver for use by CVode */
LS = SUNLinSol_Dense(y, A);
if (check_flag((void *)LS, "SUNLinSol_Dense", 0)) return(1);
/* Attach the linear solver and matrix to CVode by calling CVodeSetLinearSolver */
ret = CVodeSetLinearSolver(cvode_mem, LS, A);
if (check_flag((void *)&ret, "CVodeSetLinearSolver", 1)) return(1);
/*
* ---------------------------------------------------------------
* Discontinuity in the solution
*
* 1) Integrate to the discontinuity
* 2) Integrate from the discontinuity
* ---------------------------------------------------------------
*/
/* ---- Integrate to the discontinuity */
printf("\nDiscontinuity in solution\n\n");
/* set TSTOP (max time solution proceeds to) - this is not required */
ret = CVodeSetStopTime(cvode_mem, t1);
if (check_flag((void *)&ret, "CVodeSetStopTime", 1)) return(1);
flag = RHS1; /* use -y for RHS */
t = t0; /* set the integrator start time */
printf("%12.8e %12.8e\n",t,NV_Ith_S(y,0));
while (t<t1) {
/* advance solver just one internal step */
ret = CVode(cvode_mem, t1, y, &t, CV_ONE_STEP);
if (check_flag((void *)&ret, "CVode", 1)) return(1);
printf("%12.8e %12.8e\n",t,NV_Ith_S(y,0));
}
/* Get the number of steps the solver took to get to the discont. */
ret = CVodeGetNumSteps(cvode_mem, &nst1);
if (check_flag((void *)&ret, "CvodeGetNumSteps", 1)) return(1);
/* ---- Integrate from the discontinuity */
/* Include discontinuity */
NV_Ith_S(y,0) = RCONST(1.0);
/* Reinitialize the solver */
ret = CVodeReInit(cvode_mem, t1, y);
if (check_flag((void *)&ret, "CVodeReInit", 1)) return(1);
/* set TSTOP (max time solution proceeds to) - this is not required */
ret = CVodeSetStopTime(cvode_mem, t2);
if (check_flag((void *)&ret, "CVodeSetStopTime", 1)) return(1);
flag = RHS1; /* use -y for RHS */
t = t1; /* set the integrator start time */
printf("%12.8e %12.8e\n",t,NV_Ith_S(y,0));
while (t<t2) {
/* advance solver just one internal step */
ret = CVode(cvode_mem, t2, y, &t, CV_ONE_STEP);
if (check_flag((void *)&ret, "CVode", 1)) return(1);
printf("%12.8e %12.8e\n",t,NV_Ith_S(y,0));
}
/* Get the number of steps the solver took after the discont. */
ret = CVodeGetNumSteps(cvode_mem, &nst2);
if (check_flag((void *)&ret, "CvodeGetNumSteps", 1)) return(1);
/* Print statistics */
nst = nst1 + nst2;
printf("\nNumber of steps: %ld + %ld = %ld\n",nst1, nst2, nst);
/*
* ---------------------------------------------------------------
* Discontinuity in RHS: Case 1 - explicit treatment
* Note that it is not required to set TSTOP, but without it
* we would have to find y(t1) to reinitialize the solver.
* ---------------------------------------------------------------
*/
printf("\nDiscontinuity in RHS: Case 1 - explicit treatment\n\n");
/* Set initial condition */
NV_Ith_S(y,0) = RCONST(1.0);
/* Reinitialize the solver. CVodeReInit does not reallocate memory
* so it can only be used when the new problem size is the same as
* the problem size when CVodeCreate was called. */
ret = CVodeReInit(cvode_mem, t0, y);
if (check_flag((void *)&ret, "CVodeReInit", 1)) return(1);
/* ---- Integrate to the discontinuity */
/* Set TSTOP (max time solution proceeds to) to location of discont. */
ret = CVodeSetStopTime(cvode_mem, t1);
if (check_flag((void *)&ret, "CVodeSetStopTime", 1)) return(1);
flag = RHS1; /* use -y for RHS */
t = t0; /* set the integrator start time */
printf("%12.8e %12.8e\n",t,NV_Ith_S(y,0));
while (t<t1) {
/* advance solver just one internal step */
ret = CVode(cvode_mem, t1, y, &t, CV_ONE_STEP);
if (check_flag((void *)&ret, "CVode", 1)) return(1);
printf("%12.8e %12.8e\n",t,NV_Ith_S(y,0));
}
/* Get the number of steps the solver took to get to the discont. */
ret = CVodeGetNumSteps(cvode_mem, &nst1);
if (check_flag((void *)&ret, "CvodeGetNumSteps", 1)) return(1);
/* If TSTOP was not set, we'd need to find y(t1): */
/* CVodeGetDky(cvode_mem, t1, 0, y); */
/* ---- Integrate from the discontinuity */
/* Reinitialize solver */
ret = CVodeReInit(cvode_mem, t1, y);
/* set TSTOP (max time solution proceeds to) - this is not required */
ret = CVodeSetStopTime(cvode_mem, t2);
if (check_flag((void *)&ret, "CVodeSetStopTime", 1)) return(1);
flag = RHS2; /* use -5y for RHS */
t = t1; /* set the integrator start time */
printf("%12.8e %12.8e\n",t,NV_Ith_S(y,0));
while (t<t2) {
/* advance solver just one internal step */
ret = CVode(cvode_mem, t2, y, &t, CV_ONE_STEP);
if (check_flag((void *)&ret, "CVode", 1)) return(1);
printf("%12.8e %12.8e\n",t,NV_Ith_S(y,0));
}
/* Get the number of steps the solver took after the discont. */
ret = CVodeGetNumSteps(cvode_mem, &nst2);
if (check_flag((void *)&ret, "CvodeGetNumSteps", 1)) return(1);
/* Print statistics */
nst = nst1 + nst2;
printf("\nNumber of steps: %ld + %ld = %ld\n",nst1, nst2, nst);
/*
* ---------------------------------------------------------------
* Discontinuity in RHS: Case 2 - let CVODE deal with it
* Note that here we MUST set TSTOP to ensure that the
* change in the RHS happens at the appropriate time
* ---------------------------------------------------------------
*/
printf("\nDiscontinuity in RHS: Case 2 - let CVODE deal with it\n\n");
/* Set initial condition */
NV_Ith_S(y,0) = RCONST(1.0);
/* Reinitialize the solver. CVodeReInit does not reallocate memory
* so it can only be used when the new problem size is the same as
* the problem size when CVodeCreate was called. */
ret = CVodeReInit(cvode_mem, t0, y);
if (check_flag((void *)&ret, "CVodeReInit", 1)) return(1);
/* ---- Integrate to the discontinuity */
/* Set TSTOP (max time solution proceeds to) to location of discont. */
ret = CVodeSetStopTime(cvode_mem, t1);
if (check_flag((void *)&ret, "CVodeSetStopTime", 1)) return(1);
flag = RHS1; /* use -y for RHS */
t = t0; /* set the integrator start time */
printf("%12.8e %12.8e\n",t,NV_Ith_S(y,0));
while (t<t1) {
/* advance solver just one internal step */
ret = CVode(cvode_mem, t1, y, &t, CV_ONE_STEP);
if (check_flag((void *)&ret, "CVode", 1)) return(1);
printf("%12.8e %12.8e\n",t,NV_Ith_S(y,0));
}
/* Get the number of steps the solver took to get to the discont. */
ret = CVodeGetNumSteps(cvode_mem, &nst1);
if (check_flag((void *)&ret, "CvodeGetNumSteps", 1)) return(1);
/* ---- Integrate from the discontinuity */
/* set TSTOP (max time solution proceeds to) - this is not required */
ret = CVodeSetStopTime(cvode_mem, t2);
if (check_flag((void *)&ret, "CVodeSetStopTime", 1)) return(1);
flag = RHS2; /* use -5y for RHS */
t = t1; /* set the integrator start time */
printf("%12.8e %12.8e\n",t,NV_Ith_S(y,0));
while (t<t2) {
/* advance solver just one internal step */
ret = CVode(cvode_mem, t2, y, &t, CV_ONE_STEP);
if (check_flag((void *)&ret, "CVode", 1)) return(1);
printf("%12.8e %12.8e\n",t,NV_Ith_S(y,0));
}
/* Get the number of steps the solver took after the discont. */
ret = CVodeGetNumSteps(cvode_mem, &nst);
if (check_flag((void *)&ret, "CvodeGetNumSteps", 1)) return(1);
/* Print statistics */
nst2 = nst - nst1;
printf("\nNumber of steps: %ld + %ld = %ld\n",nst1, nst2, nst);
/* Free memory */
N_VDestroy(y);
SUNMatDestroy(A);
SUNLinSolFree(LS);
CVodeFree(&cvode_mem);
return(0);
}
/*---------------------------------------------------------------
User-Callable Functions: initialization, reinit and free
---------------------------------------------------------------*/
int IDABBDPrecInit(void *ida_mem, sunindextype Nlocal,
sunindextype mudq, sunindextype mldq,
sunindextype mukeep, sunindextype mlkeep,
realtype dq_rel_yy,
IDABBDLocalFn Gres, IDABBDCommFn Gcomm)
{
IDAMem IDA_mem;
IDALsMem idals_mem;
IBBDPrecData pdata;
sunindextype muk, mlk, storage_mu, lrw1, liw1;
long int lrw, liw;
int flag;
if (ida_mem == NULL) {
IDAProcessError(NULL, IDALS_MEM_NULL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_NULL);
return(IDALS_MEM_NULL);
}
IDA_mem = (IDAMem) ida_mem;
/* Test if the LS linear solver interface has been created */
if (IDA_mem->ida_lmem == NULL) {
IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_LMEM_NULL);
return(IDALS_LMEM_NULL);
}
idals_mem = (IDALsMem) IDA_mem->ida_lmem;
/* Test compatibility of NVECTOR package with the BBD preconditioner */
if(IDA_mem->ida_tempv1->ops->nvgetarraypointer == NULL) {
IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_BAD_NVECTOR);
return(IDALS_ILL_INPUT);
}
/* Allocate data memory. */
pdata = NULL;
pdata = (IBBDPrecData) malloc(sizeof *pdata);
if (pdata == NULL) {
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
/* Set pointers to glocal and gcomm; load half-bandwidths. */
pdata->ida_mem = IDA_mem;
pdata->glocal = Gres;
pdata->gcomm = Gcomm;
pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0, mudq));
pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0, mldq));
muk = SUNMIN(Nlocal-1, SUNMAX(0, mukeep));
mlk = SUNMIN(Nlocal-1, SUNMAX(0, mlkeep));
pdata->mukeep = muk;
pdata->mlkeep = mlk;
/* Set extended upper half-bandwidth for PP (required for pivoting). */
storage_mu = SUNMIN(Nlocal-1, muk+mlk);
/* Allocate memory for preconditioner matrix. */
pdata->PP = NULL;
pdata->PP = SUNBandMatrixStorage(Nlocal, muk, mlk, storage_mu);
if (pdata->PP == NULL) {
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
/* Allocate memory for temporary N_Vectors */
pdata->zlocal = NULL;
pdata->zlocal = N_VNewEmpty_Serial(Nlocal);
if (pdata->zlocal == NULL) {
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
pdata->rlocal = NULL;
pdata->rlocal = N_VNewEmpty_Serial(Nlocal);
if (pdata->rlocal == NULL) {
N_VDestroy(pdata->zlocal);
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
pdata->tempv1 = NULL;
pdata->tempv1 = N_VClone(IDA_mem->ida_tempv1);
if (pdata->tempv1 == NULL){
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->zlocal);
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
pdata->tempv2 = NULL;
pdata->tempv2 = N_VClone(IDA_mem->ida_tempv1);
if (pdata->tempv2 == NULL){
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->zlocal);
N_VDestroy(pdata->tempv1);
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
pdata->tempv3 = NULL;
pdata->tempv3 = N_VClone(IDA_mem->ida_tempv1);
if (pdata->tempv3 == NULL){
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->zlocal);
N_VDestroy(pdata->tempv1);
N_VDestroy(pdata->tempv2);
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
pdata->tempv4 = NULL;
pdata->tempv4 = N_VClone(IDA_mem->ida_tempv1);
if (pdata->tempv4 == NULL){
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->zlocal);
N_VDestroy(pdata->tempv1);
N_VDestroy(pdata->tempv2);
N_VDestroy(pdata->tempv3);
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
/* Allocate memory for banded linear solver */
pdata->LS = NULL;
pdata->LS = SUNLinSol_Band(pdata->rlocal, pdata->PP);
if (pdata->LS == NULL) {
N_VDestroy(pdata->zlocal);
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->tempv1);
N_VDestroy(pdata->tempv2);
N_VDestroy(pdata->tempv3);
N_VDestroy(pdata->tempv4);
SUNMatDestroy(pdata->PP);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_MEM_FAIL);
return(IDALS_MEM_FAIL);
}
/* initialize band linear solver object */
flag = SUNLinSolInitialize(pdata->LS);
if (flag != SUNLS_SUCCESS) {
N_VDestroy(pdata->zlocal);
N_VDestroy(pdata->rlocal);
N_VDestroy(pdata->tempv1);
N_VDestroy(pdata->tempv2);
N_VDestroy(pdata->tempv3);
N_VDestroy(pdata->tempv4);
SUNMatDestroy(pdata->PP);
SUNLinSolFree(pdata->LS);
free(pdata); pdata = NULL;
IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDASBBDPRE",
"IDABBDPrecInit", MSGBBD_SUNLS_FAIL);
return(IDALS_SUNLS_FAIL);
}
/* Set rel_yy based on input value dq_rel_yy (0 implies default). */
pdata->rel_yy = (dq_rel_yy > ZERO) ?
dq_rel_yy : SUNRsqrt(IDA_mem->ida_uround);
/* Store Nlocal to be used in IDABBDPrecSetup */
pdata->n_local = Nlocal;
/* Set work space sizes and initialize nge. */
pdata->rpwsize = 0;
pdata->ipwsize = 0;
if (IDA_mem->ida_tempv1->ops->nvspace) {
N_VSpace(IDA_mem->ida_tempv1, &lrw1, &liw1);
pdata->rpwsize += 4*lrw1;
pdata->ipwsize += 4*liw1;
}
if (pdata->rlocal->ops->nvspace) {
N_VSpace(pdata->rlocal, &lrw1, &liw1);
pdata->rpwsize += 2*lrw1;
pdata->ipwsize += 2*liw1;
}
if (pdata->PP->ops->space) {
flag = SUNMatSpace(pdata->PP, &lrw, &liw);
pdata->rpwsize += lrw;
pdata->ipwsize += liw;
}
if (pdata->LS->ops->space) {
flag = SUNLinSolSpace(pdata->LS, &lrw, &liw);
pdata->rpwsize += lrw;
pdata->ipwsize += liw;
}
pdata->nge = 0;
/* make sure pdata is free from any previous allocations */
if (idals_mem->pfree)
idals_mem->pfree(IDA_mem);
/* Point to the new pdata field in the LS memory */
idals_mem->pdata = pdata;
/* Attach the pfree function */
idals_mem->pfree = IDABBDPrecFree;
/* Attach preconditioner solve and setup functions */
flag = IDASetPreconditioner(ida_mem, IDABBDPrecSetup,
IDABBDPrecSolve);
return(flag);
}
int main(int argc, char *argv[])
{
realtype abstol=ATOL, reltol=RTOL, t;
N_Vector c;
WebData wdata;
void *cvode_mem;
SUNLinearSolver LS, LSB;
int retval, ncheck;
int indexB;
realtype reltolB=RTOL, abstolB=ATOL;
N_Vector cB;
c = NULL;
cB = NULL;
wdata = NULL;
cvode_mem = NULL;
LS = LSB = NULL;
/* Allocate and initialize user data */
wdata = AllocUserData();
if(check_retval((void *)wdata, "AllocUserData", 2)) return(1);
InitUserData(wdata);
/* Set-up forward problem */
/* Initializations */
c = N_VNew_Serial(NEQ+1);
if(check_retval((void *)c, "N_VNew_Serial", 0)) return(1);
CInit(c, wdata);
/* Call CVodeCreate/CVodeInit for forward run */
printf("\nCreate and allocate CVODES memory for forward run\n");
cvode_mem = CVodeCreate(CV_BDF);
if(check_retval((void *)cvode_mem, "CVodeCreate", 0)) return(1);
wdata->cvode_mem = cvode_mem; /* Used in Precond */
retval = CVodeSetUserData(cvode_mem, wdata);
if(check_retval(&retval, "CVodeSetUserData", 1)) return(1);
retval = CVodeInit(cvode_mem, f, T0, c);
if(check_retval(&retval, "CVodeInit", 1)) return(1);
retval = CVodeSStolerances(cvode_mem, reltol, abstol);
if(check_retval(&retval, "CVodeSStolerances", 1)) return(1);
/* Create SUNLinSol_SPGMR linear solver for forward run */
LS = SUNLinSol_SPGMR(c, PREC_LEFT, 0);
if(check_retval((void *)LS, "SUNLinSol_SPGMR", 0)) return(1);
/* Attach the linear sovler */
retval = CVodeSetLinearSolver(cvode_mem, LS, NULL);
if (check_retval(&retval, "CVodeSetLinearSolver", 1)) return 1;
/* Set the preconditioner solve and setup functions */
retval = CVodeSetPreconditioner(cvode_mem, Precond, PSolve);
if(check_retval(&retval, "CVodeSetPreconditioner", 1)) return(1);
/* Set-up adjoint calculations */
printf("\nAllocate global memory\n");
retval = CVodeAdjInit(cvode_mem, NSTEPS, CV_HERMITE);
if(check_retval(&retval, "CVadjInit", 1)) return(1);
/* Perform forward run */
printf("\nForward integration\n");
retval = CVodeF(cvode_mem, TOUT, c, &t, CV_NORMAL, &ncheck);
if(check_retval(&retval, "CVodeF", 1)) return(1);
printf("\nncheck = %d\n", ncheck);
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("\n G = int_t int_x int_y c%d(t,x,y) dx dy dt = %Lf \n\n",
ISPEC, N_VGetArrayPointer(c)[NEQ]);
#else
printf("\n G = int_t int_x int_y c%d(t,x,y) dx dy dt = %f \n\n",
ISPEC, N_VGetArrayPointer(c)[NEQ]);
#endif
/* Set-up backward problem */
/* Allocate cB */
cB = N_VNew_Serial(NEQ);
if(check_retval((void *)cB, "N_VNew_Serial", 0)) return(1);
/* Initialize cB = 0 */
N_VConst(ZERO, cB);
/* Create and allocate CVODES memory for backward run */
printf("\nCreate and allocate CVODES memory for backward run\n");
retval = CVodeCreateB(cvode_mem, CV_BDF, &indexB);
if(check_retval(&retval, "CVodeCreateB", 1)) return(1);
retval = CVodeSetUserDataB(cvode_mem, indexB, wdata);
if(check_retval(&retval, "CVodeSetUserDataB", 1)) return(1);
retval = CVodeSetMaxNumStepsB(cvode_mem, indexB, 1000);
if(check_retval(&retval, "CVodeSetMaxNumStepsB", 1)) return(1);
retval = CVodeInitB(cvode_mem, indexB, fB, TOUT, cB);
if(check_retval(&retval, "CVodeInitB", 1)) return(1);
retval = CVodeSStolerancesB(cvode_mem, indexB, reltolB, abstolB);
if(check_retval(&retval, "CVodeSStolerancesB", 1)) return(1);
wdata->indexB = indexB;
/* Create SUNLinSol_SPGMR linear solver for backward run */
LSB = SUNLinSol_SPGMR(cB, PREC_LEFT, 0);
if(check_retval((void *)LSB, "SUNLinSol_SPGMR", 0)) return(1);
/* Attach the linear sovler */
retval = CVodeSetLinearSolverB(cvode_mem, indexB, LSB, NULL);
if (check_retval(&retval, "CVodeSetLinearSolverB", 1)) return 1;
/* Set the preconditioner solve and setup functions */
retval = CVodeSetPreconditionerB(cvode_mem, indexB, PrecondB, PSolveB);
if(check_retval(&retval, "CVodeSetPreconditionerB", 1)) return(1);
/* Perform backward integration */
printf("\nBackward integration\n");
retval = CVodeB(cvode_mem, T0, CV_NORMAL);
if(check_retval(&retval, "CVodeB", 1)) return(1);
retval = CVodeGetB(cvode_mem, indexB, &t, cB);
if(check_retval(&retval, "CVodeGetB", 1)) return(1);
PrintOutput(cB, NS, MXNS, wdata);
/* Free all memory */
CVodeFree(&cvode_mem);
N_VDestroy(c);
N_VDestroy(cB);
SUNLinSolFree(LS);
SUNLinSolFree(LSB);
FreeUserData(wdata);
return(0);
}
/* ----------------------------------------------------------------------
* SUNLinSol_SPGMR Linear Solver Testing Routine
*
* We run multiple tests to exercise this solver:
* 1. simple tridiagonal system (no preconditioning)
* 2. simple tridiagonal system (Jacobi preconditioning)
* 3. tridiagonal system w/ scale vector s1 (no preconditioning)
* 4. tridiagonal system w/ scale vector s1 (Jacobi preconditioning)
* 5. tridiagonal system w/ scale vector s2 (no preconditioning)
* 6. tridiagonal system w/ scale vector s2 (Jacobi preconditioning)
*
* Note: We construct a tridiagonal matrix Ahat, a random solution xhat,
* and a corresponding rhs vector bhat = Ahat*xhat, such that each
* of these is unit-less. To test row/column scaling, we use the
* matrix A = S1-inverse Ahat S2, rhs vector b = S1-inverse bhat,
* and solution vector x = (S2-inverse) xhat; hence the linear
* system has rows scaled by S1-inverse and columns scaled by S2,
* where S1 and S2 are the diagonal matrices with entries from the
* vectors s1 and s2, the 'scaling' vectors supplied to SPGMR
* having strictly positive entries. When this is combined with
* preconditioning, assume that Phat is the desired preconditioner
* for Ahat, then our preconditioning matrix P \approx A should be
* left prec: P-inverse \approx S1-inverse Ahat-inverse S1
* right prec: P-inverse \approx S2-inverse Ahat-inverse S2.
* Here we use a diagonal preconditioner D, so the S*-inverse
* and S* in the product cancel one another.
* --------------------------------------------------------------------*/
int main(int argc, char *argv[])
{
int fails=0; /* counter for test failures */
int passfail=0; /* overall pass/fail flag */
SUNLinearSolver LS; /* linear solver object */
N_Vector xhat, x, b; /* test vectors */
UserData ProbData; /* problem data structure */
int gstype, pretype, maxl, print_timing;
sunindextype i;
realtype *vecdata;
double tol;
/* check inputs: local problem size, timing flag */
if (argc < 7) {
printf("ERROR: SIX (6) Inputs required:\n");
printf(" Problem size should be >0\n");
printf(" Gram-Schmidt orthogonalization type should be 1 or 2\n");
printf(" Preconditioning type should be 1 or 2\n");
printf(" Maximum Krylov subspace dimension should be >0\n");
printf(" Solver tolerance should be >0\n");
printf(" timing output flag should be 0 or 1 \n");
return 1;
}
ProbData.N = atol(argv[1]);
problem_size = ProbData.N;
if (ProbData.N <= 0) {
printf("ERROR: Problem size must be a positive integer\n");
return 1;
}
gstype = atoi(argv[2]);
if ((gstype < 1) || (gstype > 2)) {
printf("ERROR: Gram-Schmidt orthogonalization type must be either 1 or 2\n");
return 1;
}
pretype = atoi(argv[3]);
if ((pretype < 1) || (pretype > 2)) {
printf("ERROR: Preconditioning type must be either 1 or 2\n");
return 1;
}
maxl = atoi(argv[4]);
if (maxl <= 0) {
printf("ERROR: Maximum Krylov subspace dimension must be a positive integer\n");
return 1;
}
tol = atof(argv[5]);
if (tol <= ZERO) {
printf("ERROR: Solver tolerance must be a positive real number\n");
return 1;
}
print_timing = atoi(argv[6]);
SetTiming(print_timing);
printf("\nSPGMR linear solver test:\n");
printf(" Problem size = %ld\n", (long int) ProbData.N);
printf(" Gram-Schmidt orthogonalization type = %i\n", gstype);
printf(" Preconditioning type = %i\n", pretype);
printf(" Maximum Krylov subspace dimension = %i\n", maxl);
printf(" Solver Tolerance = %"GSYM"\n", tol);
printf(" timing output flag = %i\n\n", print_timing);
/* Create vectors */
x = N_VNew_Serial(ProbData.N);
if (check_flag(x, "N_VNew_Serial", 0)) return 1;
xhat = N_VNew_Serial(ProbData.N);
if (check_flag(xhat, "N_VNew_Serial", 0)) return 1;
b = N_VNew_Serial(ProbData.N);
if (check_flag(b, "N_VNew_Serial", 0)) return 1;
ProbData.d = N_VNew_Serial(ProbData.N);
if (check_flag(ProbData.d, "N_VNew_Serial", 0)) return 1;
ProbData.s1 = N_VNew_Serial(ProbData.N);
if (check_flag(ProbData.s1, "N_VNew_Serial", 0)) return 1;
ProbData.s2 = N_VNew_Serial(ProbData.N);
if (check_flag(ProbData.s2, "N_VNew_Serial", 0)) return 1;
/* Fill xhat vector with uniform random data in [1,2] */
vecdata = N_VGetArrayPointer(xhat);
for (i=0; i<ProbData.N; i++)
vecdata[i] = ONE + urand();
/* Fill Jacobi vector with matrix diagonal */
N_VConst(FIVE, ProbData.d);
/* Create SPGMR linear solver */
LS = SUNLinSol_SPGMR(x, pretype, maxl);
fails += Test_SUNLinSolGetType(LS, SUNLINEARSOLVER_ITERATIVE, 0);
fails += Test_SUNLinSolSetATimes(LS, &ProbData, ATimes, 0);
fails += Test_SUNLinSolSetPreconditioner(LS, &ProbData, PSetup, PSolve, 0);
fails += Test_SUNLinSolSetScalingVectors(LS, ProbData.s1, ProbData.s2, 0);
fails += Test_SUNLinSolInitialize(LS, 0);
fails += Test_SUNLinSolSpace(LS, 0);
fails += SUNLinSol_SPGMRSetGSType(LS, gstype);
if (fails) {
printf("FAIL: SUNLinSol_SPGMR module failed %i initialization tests\n\n", fails);
return 1;
} else {
printf("SUCCESS: SUNLinSol_SPGMR module passed all initialization tests\n\n");
}
/*** Test 1: simple Poisson-like solve (no preconditioning) ***/
/* set scaling vectors */
N_VConst(ONE, ProbData.s1);
N_VConst(ONE, ProbData.s2);
/* Fill x vector with scaled version */
N_VDiv(xhat,ProbData.s2,x);
/* Fill b vector with result of matrix-vector product */
fails = ATimes(&ProbData, x, b);
if (check_flag(&fails, "ATimes", 1)) return 1;
/* Run tests with this setup */
fails += SUNLinSol_SPGMRSetPrecType(LS, PREC_NONE);
fails += Test_SUNLinSolSetup(LS, NULL, 0);
fails += Test_SUNLinSolSolve(LS, NULL, x, b, tol, 0);
fails += Test_SUNLinSolLastFlag(LS, 0);
fails += Test_SUNLinSolNumIters(LS, 0);
fails += Test_SUNLinSolResNorm(LS, 0);
fails += Test_SUNLinSolResid(LS, 0);
/* Print result */
if (fails) {
printf("FAIL: SUNLinSol_SPGMR module, problem 1, failed %i tests\n\n", fails);
passfail += 1;
} else {
printf("SUCCESS: SUNLinSol_SPGMR module, problem 1, passed all tests\n\n");
}
/*** Test 2: simple Poisson-like solve (Jacobi preconditioning) ***/
/* set scaling vectors */
N_VConst(ONE, ProbData.s1);
N_VConst(ONE, ProbData.s2);
/* Fill x vector with scaled version */
N_VDiv(xhat,ProbData.s2,x);
/* Fill b vector with result of matrix-vector product */
fails = ATimes(&ProbData, x, b);
if (check_flag(&fails, "ATimes", 1)) return 1;
/* Run tests with this setup */
fails += SUNLinSol_SPGMRSetPrecType(LS, pretype);
fails += Test_SUNLinSolSetup(LS, NULL, 0);
fails += Test_SUNLinSolSolve(LS, NULL, x, b, tol, 0);
fails += Test_SUNLinSolLastFlag(LS, 0);
fails += Test_SUNLinSolNumIters(LS, 0);
fails += Test_SUNLinSolResNorm(LS, 0);
fails += Test_SUNLinSolResid(LS, 0);
/* Print result */
if (fails) {
printf("FAIL: SUNLinSol_SPGMR module, problem 2, failed %i tests\n\n", fails);
passfail += 1;
} else {
printf("SUCCESS: SUNLinSol_SPGMR module, problem 2, passed all tests\n\n");
}
/*** Test 3: Poisson-like solve w/ scaled rows (no preconditioning) ***/
/* set scaling vectors */
vecdata = N_VGetArrayPointer(ProbData.s1);
for (i=0; i<ProbData.N; i++)
vecdata[i] = ONE + THOUSAND*urand();
N_VConst(ONE, ProbData.s2);
/* Fill x vector with scaled version */
N_VDiv(xhat,ProbData.s2,x);
/* Fill b vector with result of matrix-vector product */
fails = ATimes(&ProbData, x, b);
if (check_flag(&fails, "ATimes", 1)) return 1;
/* Run tests with this setup */
fails += SUNLinSol_SPGMRSetPrecType(LS, PREC_NONE);
fails += Test_SUNLinSolSetup(LS, NULL, 0);
fails += Test_SUNLinSolSolve(LS, NULL, x, b, tol, 0);
fails += Test_SUNLinSolLastFlag(LS, 0);
fails += Test_SUNLinSolNumIters(LS, 0);
fails += Test_SUNLinSolResNorm(LS, 0);
fails += Test_SUNLinSolResid(LS, 0);
/* Print result */
if (fails) {
printf("FAIL: SUNLinSol_SPGMR module, problem 3, failed %i tests\n\n", fails);
passfail += 1;
} else {
printf("SUCCESS: SUNLinSol_SPGMR module, problem 3, passed all tests\n\n");
}
/*** Test 4: Poisson-like solve w/ scaled rows (Jacobi preconditioning) ***/
/* set scaling vectors */
vecdata = N_VGetArrayPointer(ProbData.s1);
for (i=0; i<ProbData.N; i++)
vecdata[i] = ONE + THOUSAND*urand();
N_VConst(ONE, ProbData.s2);
/* Fill x vector with scaled version */
N_VDiv(xhat,ProbData.s2,x);
/* Fill b vector with result of matrix-vector product */
fails = ATimes(&ProbData, x, b);
if (check_flag(&fails, "ATimes", 1)) return 1;
/* Run tests with this setup */
fails += SUNLinSol_SPGMRSetPrecType(LS, pretype);
fails += Test_SUNLinSolSetup(LS, NULL, 0);
fails += Test_SUNLinSolSolve(LS, NULL, x, b, tol, 0);
fails += Test_SUNLinSolLastFlag(LS, 0);
fails += Test_SUNLinSolNumIters(LS, 0);
fails += Test_SUNLinSolResNorm(LS, 0);
fails += Test_SUNLinSolResid(LS, 0);
/* Print result */
if (fails) {
printf("FAIL: SUNLinSol_SPGMR module, problem 4, failed %i tests\n\n", fails);
passfail += 1;
} else {
printf("SUCCESS: SUNLinSol_SPGMR module, problem 4, passed all tests\n\n");
}
/*** Test 5: Poisson-like solve w/ scaled columns (no preconditioning) ***/
/* set scaling vectors */
N_VConst(ONE, ProbData.s1);
vecdata = N_VGetArrayPointer(ProbData.s2);
for (i=0; i<ProbData.N; i++)
vecdata[i] = ONE + THOUSAND*urand();
/* Fill x vector with scaled version */
N_VDiv(xhat,ProbData.s2,x);
/* Fill b vector with result of matrix-vector product */
fails = ATimes(&ProbData, x, b);
if (check_flag(&fails, "ATimes", 1)) return 1;
/* Run tests with this setup */
fails += SUNLinSol_SPGMRSetPrecType(LS, PREC_NONE);
fails += Test_SUNLinSolSetup(LS, NULL, 0);
fails += Test_SUNLinSolSolve(LS, NULL, x, b, tol, 0);
fails += Test_SUNLinSolLastFlag(LS, 0);
fails += Test_SUNLinSolNumIters(LS, 0);
fails += Test_SUNLinSolResNorm(LS, 0);
fails += Test_SUNLinSolResid(LS, 0);
/* Print result */
if (fails) {
printf("FAIL: SUNLinSol_SPGMR module, problem 5, failed %i tests\n\n", fails);
passfail += 1;
} else {
printf("SUCCESS: SUNLinSol_SPGMR module, problem 5, passed all tests\n\n");
}
/*** Test 6: Poisson-like solve w/ scaled columns (Jacobi preconditioning) ***/
/* set scaling vector, Jacobi solver vector */
N_VConst(ONE, ProbData.s1);
vecdata = N_VGetArrayPointer(ProbData.s2);
for (i=0; i<ProbData.N; i++)
vecdata[i] = ONE + THOUSAND*urand();
/* Fill x vector with scaled version */
N_VDiv(xhat,ProbData.s2,x);
/* Fill b vector with result of matrix-vector product */
fails = ATimes(&ProbData, x, b);
if (check_flag(&fails, "ATimes", 1)) return 1;
/* Run tests with this setup */
fails += SUNLinSol_SPGMRSetPrecType(LS, pretype);
fails += Test_SUNLinSolSetup(LS, NULL, 0);
fails += Test_SUNLinSolSolve(LS, NULL, x, b, tol, 0);
fails += Test_SUNLinSolLastFlag(LS, 0);
fails += Test_SUNLinSolNumIters(LS, 0);
fails += Test_SUNLinSolResNorm(LS, 0);
fails += Test_SUNLinSolResid(LS, 0);
/* Print result */
if (fails) {
printf("FAIL: SUNLinSol_SPGMR module, problem 6, failed %i tests\n\n", fails);
passfail += 1;
} else {
printf("SUCCESS: SUNLinSol_SPGMR module, problem 6, passed all tests\n\n");
}
/* Free solver and vectors */
SUNLinSolFree(LS);
N_VDestroy(x);
N_VDestroy(xhat);
N_VDestroy(b);
N_VDestroy(ProbData.d);
N_VDestroy(ProbData.s1);
N_VDestroy(ProbData.s2);
return(passfail);
}
int main(int argc, char *argv[])
{
void *ida_mem;
SUNMatrix A;
SUNLinearSolver LS;
UserData webdata;
N_Vector cc, cp, id;
int iout, retval;
sunindextype mu, ml;
realtype rtol, atol, t0, tout, tret;
int num_threads;
ida_mem = NULL;
A = NULL;
LS = NULL;
webdata = NULL;
cc = cp = id = NULL;
/* Set the number of threads to use */
num_threads = 1; /* default value */
#ifdef _OPENMP
num_threads = omp_get_max_threads(); /* overwrite with OMP_NUM_THREADS enviroment variable */
#endif
if (argc > 1) /* overwrite with command line value, if supplied */
num_threads = strtol(argv[1], NULL, 0);
/* Allocate and initialize user data block webdata. */
webdata = (UserData) malloc(sizeof *webdata);
webdata->rates = N_VNew_OpenMP(NEQ, num_threads);
webdata->acoef = newDenseMat(NUM_SPECIES, NUM_SPECIES);
webdata->nthreads = num_threads;
InitUserData(webdata);
/* Allocate N-vectors and initialize cc, cp, and id. */
cc = N_VNew_OpenMP(NEQ, num_threads);
if(check_retval((void *)cc, "N_VNew_OpenMP", 0)) return(1);
cp = N_VNew_OpenMP(NEQ, num_threads);
if(check_retval((void *)cp, "N_VNew_OpenMP", 0)) return(1);
id = N_VNew_OpenMP(NEQ, num_threads);
if(check_retval((void *)id, "N_VNew_OpenMP", 0)) return(1);
SetInitialProfiles(cc, cp, id, webdata);
/* Set remaining inputs to IDAMalloc. */
t0 = ZERO;
rtol = RTOL;
atol = ATOL;
/* Call IDACreate and IDAMalloc to initialize IDA. */
ida_mem = IDACreate();
if(check_retval((void *)ida_mem, "IDACreate", 0)) return(1);
retval = IDASetUserData(ida_mem, webdata);
if(check_retval(&retval, "IDASetUserData", 1)) return(1);
retval = IDASetId(ida_mem, id);
if(check_retval(&retval, "IDASetId", 1)) return(1);
retval = IDAInit(ida_mem, resweb, t0, cc, cp);
if(check_retval(&retval, "IDAInit", 1)) return(1);
retval = IDASStolerances(ida_mem, rtol, atol);
if(check_retval(&retval, "IDASStolerances", 1)) return(1);
/* Setup band matrix and linear solver, and attach to IDA. */
mu = ml = NSMX;
A = SUNBandMatrix(NEQ, mu, ml);
if(check_retval((void *)A, "SUNBandMatrix", 0)) return(1);
LS = SUNLinSol_Band(cc, A);
if(check_retval((void *)LS, "SUNLinSol_Band", 0)) return(1);
retval = IDASetLinearSolver(ida_mem, LS, A);
if(check_retval(&retval, "IDASetLinearSolver", 1)) return(1);
/* Call IDACalcIC (with default options) to correct the initial values. */
tout = RCONST(0.001);
retval = IDACalcIC(ida_mem, IDA_YA_YDP_INIT, tout);
if(check_retval(&retval, "IDACalcIC", 1)) return(1);
/* Print heading, basic parameters, and initial values. */
PrintHeader(mu, ml, rtol, atol);
PrintOutput(ida_mem, cc, ZERO);
/* Loop over iout, call IDASolve (normal mode), print selected output. */
for (iout = 1; iout <= NOUT; iout++) {
retval = IDASolve(ida_mem, tout, &tret, cc, cp, IDA_NORMAL);
if(check_retval(&retval, "IDASolve", 1)) return(retval);
PrintOutput(ida_mem, cc, tret);
if (iout < 3) tout *= TMULT; else tout += TADD;
}
/* Print final statistics and free memory. */
PrintFinalStats(ida_mem);
printf("num_threads = %i\n\n", num_threads);
/* Free memory */
IDAFree(&ida_mem);
SUNLinSolFree(LS);
SUNMatDestroy(A);
N_VDestroy_OpenMP(cc);
N_VDestroy_OpenMP(cp);
N_VDestroy_OpenMP(id);
destroyMat(webdata->acoef);
N_VDestroy_OpenMP(webdata->rates);
free(webdata);
return(0);
}
/* ----------------------------------------------------------------------
* SUNLinSol_Dense Testing Routine
* --------------------------------------------------------------------*/
int main(int argc, char *argv[])
{
int fails = 0; /* counter for test failures */
sunindextype cols, rows; /* matrix columns, rows */
SUNLinearSolver LS; /* solver object */
SUNMatrix A, B, I; /* test matrices */
N_Vector x, y, b; /* test vectors */
int print_timing;
sunindextype j, k;
realtype *colj, *xdata, *colIj;
/* check input and set matrix dimensions */
if (argc < 3){
printf("ERROR: TWO (2) Inputs required: matrix cols, print timing \n");
return(-1);
}
cols = atol(argv[1]);
if (cols <= 0) {
printf("ERROR: number of matrix columns must be a positive integer \n");
return(-1);
}
rows = cols;
print_timing = atoi(argv[2]);
SetTiming(print_timing);
printf("\nDense linear solver test: size %ld\n\n",
(long int) cols);
/* Create matrices and vectors */
A = SUNDenseMatrix(rows, cols);
B = SUNDenseMatrix(rows, cols);
I = SUNDenseMatrix(rows, cols);
x = N_VNew_Serial(cols);
y = N_VNew_Serial(cols);
b = N_VNew_Serial(cols);
/* Fill A matrix with uniform random data in [0,1/cols] */
for (j=0; j<cols; j++) {
colj = SUNDenseMatrix_Column(A, j);
for (k=0; k<rows; k++)
colj[k] = (realtype) rand() / (realtype) RAND_MAX / cols;
}
/* Create anti-identity matrix */
j=cols-1;
for (k=0; k<rows; k++) {
colj = SUNDenseMatrix_Column(I,j);
colj[k] = 1;
j = j-1;
}
/* Add anti-identity to ensure the solver needs to do row-swapping */
for (k=0; k<rows; k++){
for(j=0; j<cols; j++){
colj = SUNDenseMatrix_Column(A,j);
colIj = SUNDenseMatrix_Column(I,j);
colj[k] = colj[k] + colIj[k];
}
}
/* Fill x vector with uniform random data in [0,1] */
xdata = N_VGetArrayPointer(x);
for (j=0; j<cols; j++) {
xdata[j] = (realtype) rand() / (realtype) RAND_MAX;
}
/* copy A and x into B and y to print in case of solver failure */
SUNMatCopy(A, B);
N_VScale(ONE, x, y);
/* create right-hand side vector for linear solve */
fails = SUNMatMatvec(A, x, b);
if (fails) {
printf("FAIL: SUNLinSol SUNMatMatvec failure\n");
/* Free matrices and vectors */
SUNMatDestroy(A);
SUNMatDestroy(B);
SUNMatDestroy(I);
N_VDestroy(x);
N_VDestroy(y);
N_VDestroy(b);
return(1);
}
/* Create dense linear solver */
LS = SUNLinSol_Dense(x, A);
/* Run Tests */
fails += Test_SUNLinSolInitialize(LS, 0);
fails += Test_SUNLinSolSetup(LS, A, 0);
fails += Test_SUNLinSolSolve(LS, A, x, b, 10*UNIT_ROUNDOFF, 0);
fails += Test_SUNLinSolGetType(LS, SUNLINEARSOLVER_DIRECT, 0);
fails += Test_SUNLinSolLastFlag(LS, 0);
fails += Test_SUNLinSolSpace(LS, 0);
/* Print result */
if (fails) {
printf("FAIL: SUNLinSol module failed %i tests \n \n", fails);
printf("\nA (original) =\n");
SUNDenseMatrix_Print(B,stdout);
printf("\nA (factored) =\n");
SUNDenseMatrix_Print(A,stdout);
printf("\nx (original) =\n");
N_VPrint_Serial(y);
printf("\nx (computed) =\n");
N_VPrint_Serial(x);
} else {
printf("SUCCESS: SUNLinSol module passed all tests \n \n");
}
/* Free solver, matrix and vectors */
SUNLinSolFree(LS);
SUNMatDestroy(A);
SUNMatDestroy(B);
SUNMatDestroy(I);
N_VDestroy(x);
N_VDestroy(y);
N_VDestroy(b);
return(fails);
}
int main(int argc, char *argv[])
{
UserData data;
SUNMatrix A, AB;
SUNLinearSolver LS, LSB;
void *cvode_mem;
realtype reltolQ, abstolQ;
N_Vector y, q, constraints;
int steps;
int indexB;
realtype reltolB, abstolB, abstolQB;
N_Vector yB, qB, constraintsB;
realtype time;
int retval, ncheck;
long int nst, nstB;
CVadjCheckPointRec *ckpnt;
data = NULL;
A = AB = NULL;
LS = LSB = NULL;
cvode_mem = NULL;
ckpnt = NULL;
y = yB = qB = NULL;
constraints = NULL;
constraintsB = NULL;
/* Print problem description */
printf("\nAdjoint Sensitivity Example for Chemical Kinetics\n");
printf("-------------------------------------------------\n\n");
printf("ODE: dy1/dt = -p1*y1 + p2*y2*y3\n");
printf(" dy2/dt = p1*y1 - p2*y2*y3 - p3*(y2)^2\n");
printf(" dy3/dt = p3*(y2)^2\n\n");
printf("Find dG/dp for\n");
printf(" G = int_t0^tB0 g(t,p,y) dt\n");
printf(" g(t,p,y) = y3\n\n\n");
/* User data structure */
data = (UserData) malloc(sizeof *data);
if (check_retval((void *)data, "malloc", 2)) return(1);
data->p[0] = RCONST(0.04);
data->p[1] = RCONST(1.0e4);
data->p[2] = RCONST(3.0e7);
/* Initialize y */
y = N_VNew_Serial(NEQ);
if (check_retval((void *)y, "N_VNew_Serial", 0)) return(1);
Ith(y,1) = RCONST(1.0);
Ith(y,2) = ZERO;
Ith(y,3) = ZERO;
/* Set constraints to all 1's for nonnegative solution values. */
constraints = N_VNew_Serial(NEQ);
if(check_retval((void *)constraints, "N_VNew_Serial", 0)) return(1);
N_VConst(ONE, constraints);
/* Initialize q */
q = N_VNew_Serial(1);
if (check_retval((void *)q, "N_VNew_Serial", 0)) return(1);
Ith(q,1) = ZERO;
/* Set the scalar realtive and absolute tolerances reltolQ and abstolQ */
reltolQ = RTOL;
abstolQ = ATOLq;
/* Create and allocate CVODES memory for forward run */
printf("Create and allocate CVODES memory for forward runs\n");
/* Call CVodeCreate to create the solver memory and specify the
Backward Differentiation Formula */
cvode_mem = CVodeCreate(CV_BDF);
if (check_retval((void *)cvode_mem, "CVodeCreate", 0)) return(1);
/* Call CVodeInit to initialize the integrator memory and specify the
user's right hand side function in y'=f(t,y), the initial time T0, and
the initial dependent variable vector y. */
retval = CVodeInit(cvode_mem, f, T0, y);
if (check_retval(&retval, "CVodeInit", 1)) return(1);
/* Call CVodeWFtolerances to specify a user-supplied function ewt that sets
the multiplicative error weights w_i for use in the weighted RMS norm */
retval = CVodeWFtolerances(cvode_mem, ewt);
if (check_retval(&retval, "CVodeWFtolerances", 1)) return(1);
/* Attach user data */
retval = CVodeSetUserData(cvode_mem, data);
if (check_retval(&retval, "CVodeSetUserData", 1)) return(1);
/* Call CVodeSetConstraints to initialize constraints */
retval = CVodeSetConstraints(cvode_mem, constraints);
if (check_retval(&retval, "CVODESetConstraints", 1)) return(1);
N_VDestroy(constraints);
/* Create dense SUNMatrix for use in linear solves */
A = SUNDenseMatrix(NEQ, NEQ);
if (check_retval((void *)A, "SUNDenseMatrix", 0)) return(1);
/* Create dense SUNLinearSolver object */
LS = SUNLinSol_Dense(y, A);
if (check_retval((void *)LS, "SUNLinSol_Dense", 0)) return(1);
/* Attach the matrix and linear solver */
retval = CVDlsSetLinearSolver(cvode_mem, LS, A);
if (check_retval(&retval, "CVDlsSetLinearSolver", 1)) return(1);
/* Set the user-supplied Jacobian routine Jac */
retval = CVDlsSetJacFn(cvode_mem, Jac);
if (check_retval(&retval, "CVDlsSetJacFn", 1)) return(1);
/* Call CVodeQuadInit to allocate initernal memory and initialize
quadrature integration*/
retval = CVodeQuadInit(cvode_mem, fQ, q);
if (check_retval(&retval, "CVodeQuadInit", 1)) return(1);
/* Call CVodeSetQuadErrCon to specify whether or not the quadrature variables
are to be used in the step size control mechanism within CVODES. Call
CVodeQuadSStolerances or CVodeQuadSVtolerances to specify the integration
tolerances for the quadrature variables. */
retval = CVodeSetQuadErrCon(cvode_mem, SUNTRUE);
if (check_retval(&retval, "CVodeSetQuadErrCon", 1)) return(1);
/* Call CVodeQuadSStolerances to specify scalar relative and absolute
tolerances. */
retval = CVodeQuadSStolerances(cvode_mem, reltolQ, abstolQ);
if (check_retval(&retval, "CVodeQuadSStolerances", 1)) return(1);
/* Allocate global memory */
/* Call CVodeAdjInit to update CVODES memory block by allocting the internal
memory needed for backward integration.*/
steps = STEPS; /* no. of integration steps between two consecutive ckeckpoints*/
retval = CVodeAdjInit(cvode_mem, steps, CV_HERMITE);
/*
retval = CVodeAdjInit(cvode_mem, steps, CV_POLYNOMIAL);
*/
if (check_retval(&retval, "CVodeAdjInit", 1)) return(1);
/* Perform forward run */
printf("Forward integration ... ");
/* Call CVodeF to integrate the forward problem over an interval in time and
saves checkpointing data */
retval = CVodeF(cvode_mem, TOUT, y, &time, CV_NORMAL, &ncheck);
if (check_retval(&retval, "CVodeF", 1)) return(1);
retval = CVodeGetNumSteps(cvode_mem, &nst);
if (check_retval(&retval, "CVodeGetNumSteps", 1)) return(1);
printf("done ( nst = %ld )\n",nst);
printf("\nncheck = %d\n\n", ncheck);
retval = CVodeGetQuad(cvode_mem, &time, q);
if (check_retval(&retval, "CVodeGetQuad", 1)) return(1);
printf("--------------------------------------------------------\n");
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("G: %12.4Le \n",Ith(q,1));
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("G: %12.4e \n",Ith(q,1));
#else
printf("G: %12.4e \n",Ith(q,1));
#endif
printf("--------------------------------------------------------\n\n");
/* Test check point linked list
(uncomment next block to print check point information) */
/*
{
int i;
printf("\nList of Check Points (ncheck = %d)\n\n", ncheck);
ckpnt = (CVadjCheckPointRec *) malloc ( (ncheck+1)*sizeof(CVadjCheckPointRec));
CVodeGetAdjCheckPointsInfo(cvode_mem, ckpnt);
for (i=0;i<=ncheck;i++) {
printf("Address: %p\n",ckpnt[i].my_addr);
printf("Next: %p\n",ckpnt[i].next_addr);
printf("Time interval: %le %le\n",ckpnt[i].t0, ckpnt[i].t1);
printf("Step number: %ld\n",ckpnt[i].nstep);
printf("Order: %d\n",ckpnt[i].order);
printf("Step size: %le\n",ckpnt[i].step);
printf("\n");
}
}
*/
/* Initialize yB */
yB = N_VNew_Serial(NEQ);
if (check_retval((void *)yB, "N_VNew_Serial", 0)) return(1);
Ith(yB,1) = ZERO;
Ith(yB,2) = ZERO;
Ith(yB,3) = ZERO;
/* Initialize qB */
qB = N_VNew_Serial(NP);
if (check_retval((void *)qB, "N_VNew", 0)) return(1);
Ith(qB,1) = ZERO;
Ith(qB,2) = ZERO;
Ith(qB,3) = ZERO;
/* Set the scalar relative tolerance reltolB */
reltolB = RTOL;
/* Set the scalar absolute tolerance abstolB */
abstolB = ATOLl;
/* Set the scalar absolute tolerance abstolQB */
abstolQB = ATOLq;
/* Set constraints to all 1's for nonnegative solution values. */
constraintsB = N_VNew_Serial(NEQ);
if(check_retval((void *)constraintsB, "N_VNew_Serial", 0)) return(1);
N_VConst(ONE, constraintsB);
/* Create and allocate CVODES memory for backward run */
printf("Create and allocate CVODES memory for backward run\n");
/* Call CVodeCreateB to specify the solution method for the backward
problem. */
retval = CVodeCreateB(cvode_mem, CV_BDF, &indexB);
if (check_retval(&retval, "CVodeCreateB", 1)) return(1);
/* Call CVodeInitB to allocate internal memory and initialize the
backward problem. */
retval = CVodeInitB(cvode_mem, indexB, fB, TB1, yB);
if (check_retval(&retval, "CVodeInitB", 1)) return(1);
/* Set the scalar relative and absolute tolerances. */
retval = CVodeSStolerancesB(cvode_mem, indexB, reltolB, abstolB);
if (check_retval(&retval, "CVodeSStolerancesB", 1)) return(1);
/* Attach the user data for backward problem. */
retval = CVodeSetUserDataB(cvode_mem, indexB, data);
if (check_retval(&retval, "CVodeSetUserDataB", 1)) return(1);
/* Call CVodeSetConstraintsB to initialize constraints */
retval = CVodeSetConstraintsB(cvode_mem, indexB, constraintsB);
if(check_retval(&retval, "CVodeSetConstraintsB", 1)) return(1);
N_VDestroy(constraintsB);
/* Create dense SUNMatrix for use in linear solves */
AB = SUNDenseMatrix(NEQ, NEQ);
if (check_retval((void *)AB, "SUNDenseMatrix", 0)) return(1);
/* Create dense SUNLinearSolver object */
LSB = SUNLinSol_Dense(yB, AB);
if (check_retval((void *)LSB, "SUNLinSol_Dense", 0)) return(1);
/* Attach the matrix and linear solver */
retval = CVDlsSetLinearSolverB(cvode_mem, indexB, LSB, AB);
if (check_retval(&retval, "CVDlsSetLinearSolverB", 1)) return(1);
/* Set the user-supplied Jacobian routine JacB */
retval = CVDlsSetJacFnB(cvode_mem, indexB, JacB);
if (check_retval(&retval, "CVDlsSetJacFnB", 1)) return(1);
/* Call CVodeQuadInitB to allocate internal memory and initialize backward
quadrature integration. */
retval = CVodeQuadInitB(cvode_mem, indexB, fQB, qB);
if (check_retval(&retval, "CVodeQuadInitB", 1)) return(1);
/* Call CVodeSetQuadErrCon to specify whether or not the quadrature variables
are to be used in the step size control mechanism within CVODES. Call
CVodeQuadSStolerances or CVodeQuadSVtolerances to specify the integration
tolerances for the quadrature variables. */
retval = CVodeSetQuadErrConB(cvode_mem, indexB, SUNTRUE);
if (check_retval(&retval, "CVodeSetQuadErrConB", 1)) return(1);
/* Call CVodeQuadSStolerancesB to specify the scalar relative and absolute tolerances
for the backward problem. */
retval = CVodeQuadSStolerancesB(cvode_mem, indexB, reltolB, abstolQB);
if (check_retval(&retval, "CVodeQuadSStolerancesB", 1)) return(1);
/* Backward Integration */
PrintHead(TB1);
/* First get results at t = TBout1 */
/* Call CVodeB to integrate the backward ODE problem. */
retval = CVodeB(cvode_mem, TBout1, CV_NORMAL);
if (check_retval(&retval, "CVodeB", 1)) return(1);
/* Call CVodeGetB to get yB of the backward ODE problem. */
retval = CVodeGetB(cvode_mem, indexB, &time, yB);
if (check_retval(&retval, "CVodeGetB", 1)) return(1);
/* Call CVodeGetAdjY to get the interpolated value of the forward solution
y during a backward integration. */
retval = CVodeGetAdjY(cvode_mem, TBout1, y);
if (check_retval(&retval, "CVodeGetAdjY", 1)) return(1);
PrintOutput1(time, TBout1, y, yB);
/* Then at t = T0 */
retval = CVodeB(cvode_mem, T0, CV_NORMAL);
if (check_retval(&retval, "CVodeB", 1)) return(1);
CVodeGetNumSteps(CVodeGetAdjCVodeBmem(cvode_mem, indexB), &nstB);
printf("Done ( nst = %ld )\n", nstB);
retval = CVodeGetB(cvode_mem, indexB, &time, yB);
if (check_retval(&retval, "CVodeGetB", 1)) return(1);
/* Call CVodeGetQuadB to get the quadrature solution vector after a
successful return from CVodeB. */
retval = CVodeGetQuadB(cvode_mem, indexB, &time, qB);
if (check_retval(&retval, "CVodeGetQuadB", 1)) return(1);
retval = CVodeGetAdjY(cvode_mem, T0, y);
if (check_retval(&retval, "CVodeGetAdjY", 1)) return(1);
PrintOutput(time, y, yB, qB);
/* Reinitialize backward phase (new tB0) */
Ith(yB,1) = ZERO;
Ith(yB,2) = ZERO;
Ith(yB,3) = ZERO;
Ith(qB,1) = ZERO;
Ith(qB,2) = ZERO;
Ith(qB,3) = ZERO;
printf("Re-initialize CVODES memory for backward run\n");
retval = CVodeReInitB(cvode_mem, indexB, TB2, yB);
if (check_retval(&retval, "CVodeReInitB", 1)) return(1);
retval = CVodeQuadReInitB(cvode_mem, indexB, qB);
if (check_retval(&retval, "CVodeQuadReInitB", 1)) return(1);
PrintHead(TB2);
/* First get results at t = TBout1 */
retval = CVodeB(cvode_mem, TBout1, CV_NORMAL);
if (check_retval(&retval, "CVodeB", 1)) return(1);
retval = CVodeGetB(cvode_mem, indexB, &time, yB);
if (check_retval(&retval, "CVodeGetB", 1)) return(1);
retval = CVodeGetAdjY(cvode_mem, TBout1, y);
if (check_retval(&retval, "CVodeGetAdjY", 1)) return(1);
PrintOutput1(time, TBout1, y, yB);
/* Then at t = T0 */
retval = CVodeB(cvode_mem, T0, CV_NORMAL);
if (check_retval(&retval, "CVodeB", 1)) return(1);
CVodeGetNumSteps(CVodeGetAdjCVodeBmem(cvode_mem, indexB), &nstB);
printf("Done ( nst = %ld )\n", nstB);
retval = CVodeGetB(cvode_mem, indexB, &time, yB);
if (check_retval(&retval, "CVodeGetB", 1)) return(1);
retval = CVodeGetQuadB(cvode_mem, indexB, &time, qB);
if (check_retval(&retval, "CVodeGetQuadB", 1)) return(1);
retval = CVodeGetAdjY(cvode_mem, T0, y);
if (check_retval(&retval, "CVodeGetAdjY", 1)) return(1);
PrintOutput(time, y, yB, qB);
/* Free memory */
printf("Free memory\n\n");
CVodeFree(&cvode_mem);
N_VDestroy(y);
N_VDestroy(q);
N_VDestroy(yB);
N_VDestroy(qB);
SUNLinSolFree(LS);
SUNMatDestroy(A);
SUNLinSolFree(LSB);
SUNMatDestroy(AB);
if (ckpnt != NULL) free(ckpnt);
free(data);
return(0);
}
static void finalize_lsolver(value vls)
{
SUNLinearSolver ls = LSOLVER_VAL(vls);
if (ls) SUNLinSolFree(ls);
}
