/* 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;
}
void FSUNSPARSEMAT_INIT(int *code, long int *M, long int *N,
long int *NNZ, int *sparsetype, int *ier)
{
*ier = 0;
switch(*code) {
case FCMIX_CVODE:
if (F2C_CVODE_matrix) SUNMatDestroy(F2C_CVODE_matrix);
F2C_CVODE_matrix = NULL;
F2C_CVODE_matrix = SUNSparseMatrix(*M, *N, *NNZ, *sparsetype);
if (F2C_CVODE_matrix == NULL) *ier = -1;
break;
case FCMIX_IDA:
if (F2C_IDA_matrix) SUNMatDestroy(F2C_IDA_matrix);
F2C_IDA_matrix = NULL;
F2C_IDA_matrix = SUNSparseMatrix(*M, *N, *NNZ, *sparsetype);
if (F2C_IDA_matrix == NULL) *ier = -1;
break;
case FCMIX_KINSOL:
if (F2C_KINSOL_matrix) SUNMatDestroy(F2C_KINSOL_matrix);
F2C_KINSOL_matrix = NULL;
F2C_KINSOL_matrix = SUNSparseMatrix(*M, *N, *NNZ, *sparsetype);
if (F2C_KINSOL_matrix == NULL) *ier = -1;
break;
case FCMIX_ARKODE:
if (F2C_ARKODE_matrix) SUNMatDestroy(F2C_ARKODE_matrix);
F2C_ARKODE_matrix = NULL;
F2C_ARKODE_matrix = SUNSparseMatrix(*M, *N, *NNZ, *sparsetype);
if (F2C_ARKODE_matrix == NULL) *ier = -1;
break;
default:
*ier = -1;
}
}
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;
}
/*-----------------------------------------------------------------
cvDlsFree
-----------------------------------------------------------------
This routine frees memory associates with the CVDls solver
interface.
-----------------------------------------------------------------*/
int cvDlsFree(CVodeMem cv_mem)
{
CVDlsMem cvdls_mem;
/* Return immediately if cv_mem or cv_mem->cv_lmem are NULL */
if (cv_mem == NULL) return (CVDLS_SUCCESS);
if (cv_mem->cv_lmem == NULL) return(CVDLS_SUCCESS);
cvdls_mem = (CVDlsMem) cv_mem->cv_lmem;
/* Free x vector */
if (cvdls_mem->x) {
N_VDestroy(cvdls_mem->x);
cvdls_mem->x = NULL;
}
/* Free savedJ memory */
if (cvdls_mem->savedJ) {
SUNMatDestroy(cvdls_mem->savedJ);
cvdls_mem->savedJ = NULL;
}
/* Nullify other SUNMatrix pointer */
cvdls_mem->A = NULL;
/* free CVDls interface structure */
free(cv_mem->cv_lmem);
return(CVDLS_SUCCESS);
}
/*-------------------------------------------------------------*/
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 FSUNDENSEMASSMAT_INIT(long int *M, long int *N, int *ier)
{
*ier = 0;
if (F2C_ARKODE_mass_matrix) SUNMatDestroy(F2C_ARKODE_mass_matrix);
F2C_ARKODE_mass_matrix = NULL;
F2C_ARKODE_mass_matrix = SUNDenseMatrix(*M, *N);
if (F2C_ARKODE_mass_matrix == NULL) *ier = -1;
}
void FSUNSPARSEMASSMAT_INIT(long int *M, long int *N, long int *NNZ,
int *sparsetype, int *ier)
{
*ier = 0;
if (F2C_ARKODE_mass_matrix) SUNMatDestroy(F2C_ARKODE_mass_matrix);
F2C_ARKODE_mass_matrix = NULL;
F2C_ARKODE_mass_matrix = SUNSparseMatrix(*M, *N, *NNZ, *sparsetype);
if (F2C_ARKODE_mass_matrix == 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_;
}
/*-----------------------------------------------------------------
cvLsFree
This routine frees memory associates with the CVLs system
solver interface.
-----------------------------------------------------------------*/
int cvLsFree(CVodeMem cv_mem)
{
CVLsMem cvls_mem;
/* Return immediately if CVodeMem or CVLsMem are NULL */
if (cv_mem == NULL) return (CVLS_SUCCESS);
if (cv_mem->cv_lmem == NULL) return(CVLS_SUCCESS);
cvls_mem = (CVLsMem) cv_mem->cv_lmem;
/* Free N_Vector memory */
if (cvls_mem->ytemp) {
N_VDestroy(cvls_mem->ytemp);
cvls_mem->ytemp = NULL;
}
if (cvls_mem->x) {
N_VDestroy(cvls_mem->x);
cvls_mem->x = NULL;
}
/* Free savedJ memory */
if (cvls_mem->savedJ) {
SUNMatDestroy(cvls_mem->savedJ);
cvls_mem->savedJ = NULL;
}
/* Nullify other N_Vector pointers */
cvls_mem->ycur = NULL;
cvls_mem->fcur = NULL;
/* Nullify other SUNMatrix pointer */
cvls_mem->A = NULL;
/* Free preconditioner memory (if applicable) */
if (cvls_mem->pfree) cvls_mem->pfree(cv_mem);
/* free CVLs interface structure */
free(cv_mem->cv_lmem);
return(CVLS_SUCCESS);
}
/* ----------------------------------------------------------------------
* 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()
{
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);
}
/* ----------------------------------------------------------------------
* Main SUNMatrix Testing Routine
* --------------------------------------------------------------------*/
int main(int argc, char *argv[])
{
int fails = 0; /* counter for test failures */
sunindextype matrows, matcols; /* vector length */
N_Vector x, y; /* test vectors */
realtype *xdata, *ydata; /* pointers to vector data */
SUNMatrix A, I; /* test matrices */
realtype *Adata, *Idata; /* pointers to matrix data */
int print_timing, square;
sunindextype i, j, m, n;
/* check input and set vector length */
if (argc < 4){
printf("ERROR: THREE (3) Input required: matrix rows, matrix cols, print timing \n");
return(-1);
}
matrows = atol(argv[1]);
if (matrows <= 0) {
printf("ERROR: number of rows must be a positive integer \n");
return(-1);
}
matcols = atol(argv[2]);
if (matcols <= 0) {
printf("ERROR: number of cols must be a positive integer \n");
return(-1);
}
print_timing = atoi(argv[3]);
SetTiming(print_timing);
square = (matrows == matcols) ? 1 : 0;
printf("\nDense matrix test: size %ld by %ld\n\n",
(long int) matrows, (long int) matcols);
/* Initialize vectors and matrices to NULL */
x = NULL;
y = NULL;
A = NULL;
I = NULL;
/* Create vectors and matrices */
x = N_VNew_Serial(matcols);
y = N_VNew_Serial(matrows);
A = SUNDenseMatrix(matrows, matcols);
I = NULL;
if (square)
I = SUNDenseMatrix(matrows, matcols);
/* Fill matrices and vectors */
Adata = SUNDenseMatrix_Data(A);
for(j=0; j < matcols; j++) {
for(i=0; i < matrows; i++) {
Adata[j*matrows + i] = (j+1)*(i+j);
}
}
if (square) {
Idata = SUNDenseMatrix_Data(I);
for(i=0, j=0; i < matrows; i++, j++) {
Idata[j*matrows + i] = ONE;
}
}
xdata = N_VGetArrayPointer(x);
for(i=0; i < matcols; i++) {
xdata[i] = ONE / (i+1);
}
ydata = N_VGetArrayPointer(y);
for(i=0; i < matrows; i++) {
m = i;
n = m + matcols - 1;
ydata[i] = HALF*(n+1-m)*(n+m);
}
/* SUNMatrix Tests */
fails += Test_SUNMatGetID(A, SUNMATRIX_DENSE, 0);
fails += Test_SUNMatClone(A, 0);
fails += Test_SUNMatCopy(A, 0);
fails += Test_SUNMatZero(A, 0);
if (square) {
fails += Test_SUNMatScaleAdd(A, I, 0);
fails += Test_SUNMatScaleAddI(A, I, 0);
}
fails += Test_SUNMatMatvec(A, x, y, 0);
fails += Test_SUNMatSpace(A, 0);
/* Print result */
if (fails) {
printf("FAIL: SUNMatrix module failed %i tests \n \n", fails);
printf("\nA =\n");
SUNDenseMatrix_Print(A,stdout);
if (square) {
printf("\nI =\n");
SUNDenseMatrix_Print(I,stdout);
}
printf("\nx =\n");
N_VPrint_Serial(x);
printf("\ny =\n");
N_VPrint_Serial(y);
} else {
printf("SUCCESS: SUNMatrix module passed all tests \n \n");
}
/* Free vectors and matrices */
N_VDestroy_Serial(x);
N_VDestroy_Serial(y);
SUNMatDestroy(A);
if (square)
SUNMatDestroy(I);
return(fails);
}
/*---------------------------------------------------------------
CVodeSetLinearSolver specifies the linear solver
---------------------------------------------------------------*/
int CVodeSetLinearSolver(void *cvode_mem, SUNLinearSolver LS,
SUNMatrix A)
{
CVodeMem cv_mem;
CVLsMem cvls_mem;
int retval, LSType;
/* Return immediately if either cvode_mem or LS inputs are NULL */
if (cvode_mem == NULL) {
cvProcessError(NULL, CVLS_MEM_NULL, "CVLS",
"CVodeSetLinearSolver", MSG_LS_CVMEM_NULL);
return(CVLS_MEM_NULL);
}
if (LS == NULL) {
cvProcessError(NULL, CVLS_ILL_INPUT, "CVLS",
"CVodeSetLinearSolver",
"LS must be non-NULL");
return(CVLS_ILL_INPUT);
}
cv_mem = (CVodeMem) cvode_mem;
/* Test if solver is compatible with LS interface */
if ( (LS->ops->gettype == NULL) ||
(LS->ops->initialize == NULL) ||
(LS->ops->setup == NULL) ||
(LS->ops->solve == NULL) ) {
cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVLS",
"CVodeSetLinearSolver",
"LS object is missing a required operation");
return(CVLS_ILL_INPUT);
}
/* Test if vector is compatible with LS interface */
if ( (cv_mem->cv_tempv->ops->nvconst == NULL) ||
(cv_mem->cv_tempv->ops->nvdotprod == NULL) ) {
cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVLS",
"CVodeSetLinearSolver", MSG_LS_BAD_NVECTOR);
return(CVLS_ILL_INPUT);
}
/* Retrieve the LS type */
LSType = SUNLinSolGetType(LS);
/* Check for compatible LS type, matrix and "atimes" support */
if ((LSType == SUNLINEARSOLVER_ITERATIVE) && (LS->ops->setatimes == NULL)) {
cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVLS", "CVodeSetLinearSolver",
"Incompatible inputs: iterative LS must support ATimes routine");
return(CVLS_ILL_INPUT);
}
if ((LSType == SUNLINEARSOLVER_DIRECT) && (A == NULL)) {
cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVLS", "CVodeSetLinearSolver",
"Incompatible inputs: direct LS requires non-NULL matrix");
return(CVLS_ILL_INPUT);
}
if ((LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) && (A == NULL)) {
cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVLS", "CVodeSetLinearSolver",
"Incompatible inputs: matrix-iterative LS requires non-NULL matrix");
return(CVLS_ILL_INPUT);
}
/* free any existing system solver attached to CVode */
if (cv_mem->cv_lfree) cv_mem->cv_lfree(cv_mem);
/* Set four main system linear solver function fields in cv_mem */
cv_mem->cv_linit = cvLsInitialize;
cv_mem->cv_lsetup = cvLsSetup;
cv_mem->cv_lsolve = cvLsSolve;
cv_mem->cv_lfree = cvLsFree;
/* Allocate memory for CVLsMemRec */
cvls_mem = NULL;
cvls_mem = (CVLsMem) malloc(sizeof(struct CVLsMemRec));
if (cvls_mem == NULL) {
cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVLS",
"CVodeSetLinearSolver", MSG_LS_MEM_FAIL);
return(CVLS_MEM_FAIL);
}
memset(cvls_mem, 0, sizeof(struct CVLsMemRec));
/* set SUNLinearSolver pointer */
cvls_mem->LS = LS;
/* Set defaults for Jacobian-related fields */
if (A != NULL) {
cvls_mem->jacDQ = SUNTRUE;
cvls_mem->jac = cvLsDQJac;
cvls_mem->J_data = cv_mem;
} else {
cvls_mem->jacDQ = SUNFALSE;
cvls_mem->jac = NULL;
cvls_mem->J_data = NULL;
}
cvls_mem->jtimesDQ = SUNTRUE;
cvls_mem->jtsetup = NULL;
cvls_mem->jtimes = cvLsDQJtimes;
cvls_mem->jt_data = cv_mem;
/* Set defaults for preconditioner-related fields */
cvls_mem->pset = NULL;
cvls_mem->psolve = NULL;
cvls_mem->pfree = NULL;
cvls_mem->P_data = cv_mem->cv_user_data;
/* Initialize counters */
cvLsInitializeCounters(cvls_mem);
/* Set default values for the rest of the LS parameters */
cvls_mem->msbj = CVLS_MSBJ;
cvls_mem->jbad = SUNTRUE;
cvls_mem->eplifac = CVLS_EPLIN;
cvls_mem->last_flag = CVLS_SUCCESS;
/* If LS supports ATimes, attach CVLs routine */
if (LS->ops->setatimes) {
retval = SUNLinSolSetATimes(LS, cv_mem, cvLsATimes);
if (retval != SUNLS_SUCCESS) {
cvProcessError(cv_mem, CVLS_SUNLS_FAIL, "CVLS",
"CVodeSetLinearSolver",
"Error in calling SUNLinSolSetATimes");
free(cvls_mem); cvls_mem = NULL;
return(CVLS_SUNLS_FAIL);
}
}
/* If LS supports preconditioning, initialize pset/psol to NULL */
if (LS->ops->setpreconditioner) {
retval = SUNLinSolSetPreconditioner(LS, cv_mem, NULL, NULL);
if (retval != SUNLS_SUCCESS) {
cvProcessError(cv_mem, CVLS_SUNLS_FAIL, "CVLS",
"CVodeSetLinearSolver",
"Error in calling SUNLinSolSetPreconditioner");
free(cvls_mem); cvls_mem = NULL;
return(CVLS_SUNLS_FAIL);
}
}
/* When using a non-NULL SUNMatrix object, store pointer to A and create saved_J */
if (A != NULL) {
cvls_mem->A = A;
cvls_mem->savedJ = SUNMatClone(A);
if (cvls_mem->savedJ == NULL) {
cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVLS",
"CVodeSetLinearSolver", MSG_LS_MEM_FAIL);
free(cvls_mem); cvls_mem = NULL;
return(CVLS_MEM_FAIL);
}
}
/* Allocate memory for ytemp and x */
cvls_mem->ytemp = N_VClone(cv_mem->cv_tempv);
if (cvls_mem->ytemp == NULL) {
cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVLS",
"CVodeSetLinearSolver", MSG_LS_MEM_FAIL);
SUNMatDestroy(cvls_mem->savedJ);
free(cvls_mem); cvls_mem = NULL;
return(CVLS_MEM_FAIL);
}
cvls_mem->x = N_VClone(cv_mem->cv_tempv);
if (cvls_mem->x == NULL) {
cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVLS",
"CVodeSetLinearSolver", MSG_LS_MEM_FAIL);
SUNMatDestroy(cvls_mem->savedJ);
N_VDestroy(cvls_mem->ytemp);
free(cvls_mem); cvls_mem = NULL;
return(CVLS_MEM_FAIL);
}
/* For iterative LS, compute sqrtN from a dot product */
if ( (LSType == SUNLINEARSOLVER_ITERATIVE) ||
(LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) ) {
N_VConst(ONE, cvls_mem->ytemp);
cvls_mem->sqrtN = SUNRsqrt( N_VDotProd(cvls_mem->ytemp,
cvls_mem->ytemp) );
}
/* Attach linear solver memory to integrator memory */
cv_mem->cv_lmem = cvls_mem;
return(CVLS_SUCCESS);
}
/*---------------------------------------------------------------
CVDlsSetLinearSolver specifies the direct linear solver.
---------------------------------------------------------------*/
int CVDlsSetLinearSolver(void *cvode_mem, SUNLinearSolver LS,
SUNMatrix A)
{
CVodeMem cv_mem;
CVDlsMem cvdls_mem;
/* Return immediately if any input is NULL */
if (cvode_mem == NULL) {
cvProcessError(NULL, CVDLS_MEM_NULL, "CVDLS",
"CVDlsSetLinearSolver", MSGD_CVMEM_NULL);
return(CVDLS_MEM_NULL);
}
if ( (LS == NULL) || (A == NULL) ) {
cvProcessError(NULL, CVDLS_ILL_INPUT, "CVDLS",
"CVDlsSetLinearSolver",
"Both LS and A must be non-NULL");
return(CVDLS_ILL_INPUT);
}
cv_mem = (CVodeMem) cvode_mem;
/* Test if solver and vector are compatible with DLS */
if (SUNLinSolGetType(LS) != SUNLINEARSOLVER_DIRECT) {
cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVDLS",
"CVDlsSetLinearSolver",
"Non-direct LS supplied to CVDls interface");
return(CVDLS_ILL_INPUT);
}
if (cv_mem->cv_tempv->ops->nvgetarraypointer == NULL ||
cv_mem->cv_tempv->ops->nvsetarraypointer == NULL) {
cvProcessError(cv_mem, CVDLS_ILL_INPUT, "CVDLS",
"CVDlsSetLinearSolver", MSGD_BAD_NVECTOR);
return(CVDLS_ILL_INPUT);
}
/* free any existing system solver attached to CVode */
if (cv_mem->cv_lfree) cv_mem->cv_lfree(cv_mem);
/* Set four main system linear solver function fields in cv_mem */
cv_mem->cv_linit = cvDlsInitialize;
cv_mem->cv_lsetup = cvDlsSetup;
cv_mem->cv_lsolve = cvDlsSolve;
cv_mem->cv_lfree = cvDlsFree;
/* Get memory for CVDlsMemRec */
cvdls_mem = NULL;
cvdls_mem = (CVDlsMem) malloc(sizeof(struct CVDlsMemRec));
if (cvdls_mem == NULL) {
cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVDLS",
"CVDlsSetLinearSolver", MSGD_MEM_FAIL);
return(CVDLS_MEM_FAIL);
}
/* set SUNLinearSolver pointer */
cvdls_mem->LS = LS;
/* Initialize Jacobian-related data */
cvdls_mem->jacDQ = SUNTRUE;
cvdls_mem->jac = cvDlsDQJac;
cvdls_mem->J_data = cv_mem;
cvdls_mem->last_flag = CVDLS_SUCCESS;
/* Initialize counters */
cvDlsInitializeCounters(cvdls_mem);
/* Store pointer to A and create saved_J */
cvdls_mem->A = A;
cvdls_mem->savedJ = SUNMatClone(A);
if (cvdls_mem->savedJ == NULL) {
cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVDLS",
"CVDlsSetLinearSolver", MSGD_MEM_FAIL);
free(cvdls_mem); cvdls_mem = NULL;
return(CVDLS_MEM_FAIL);
}
/* Allocate memory for x */
cvdls_mem->x = N_VClone(cv_mem->cv_tempv);
if (cvdls_mem->x == NULL) {
cvProcessError(cv_mem, CVDLS_MEM_FAIL, "CVDLS",
"CVDlsSetLinearSolver", MSGD_MEM_FAIL);
SUNMatDestroy(cvdls_mem->savedJ);
free(cvdls_mem); cvdls_mem = NULL;
return(CVDLS_MEM_FAIL);
}
/* Attach linear solver memory to integrator memory */
cv_mem->cv_lmem = cvdls_mem;
return(CVDLS_SUCCESS);
}
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);
}
/*---------------------------------------------------------------
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()
{
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);
}
/* ----------------------------------------------------------------------
* Main SUNMatrix Testing Routine
* --------------------------------------------------------------------*/
int main(int argc, char *argv[])
{
int fails=0; /* counter for test failures */
sunindextype matrows, matcols; /* matrix dims */
int mattype; /* matrix storage type */
N_Vector x, y, z; /* test vectors */
realtype* vecdata; /* pointers to vector data */
SUNMatrix A, B, C, D, I; /* test matrices */
realtype* matdata; /* pointer to matrix data */
sunindextype i, j, k, kstart, kend, N, uband, lband;
sunindextype *colptrs, *rowindices;
sunindextype *rowptrs, *colindices;
int print_timing, square;
/* check input and set vector length */
if (argc < 5){
printf("ERROR: FOUR (4) Input required: matrix rows, matrix cols, matrix type (0/1), print timing \n");
return(-1);
}
matrows = atol(argv[1]);
if (matrows < 1) {
printf("ERROR: number of rows must be a positive integer\n");
return(-1);
}
matcols = atol(argv[2]);
if (matcols < 1) {
printf("ERROR: number of cols must be a positive integer\n");
return(-1);
}
k = atol(argv[3]);
if ((k != 0) && (k != 1)) {
printf("ERROR: matrix type must be 0 or 1\n");
return(-1);
}
mattype = (k == 0) ? CSC_MAT : CSR_MAT;
print_timing = atoi(argv[4]);
SetTiming(print_timing);
square = (matrows == matcols) ? 1 : 0;
printf("\nSparse matrix test: size %ld by %ld, type = %i\n\n",
(long int) matrows, (long int) matcols, mattype);
/* Initialize vectors and matrices to NULL */
x = NULL;
y = NULL;
z = NULL;
A = NULL;
B = NULL;
C = NULL;
D = NULL;
I = NULL;
/* check creating sparse matrix from dense matrix */
B = SUNDenseMatrix(5,6);
matdata = SUNDenseMatrix_Data(B);
matdata[2] = RCONST(1.0); /* [ 0 2 0 0 7 0 ] */
matdata[5] = RCONST(2.0); /* [ 0 0 4 0 8 0 ] */
matdata[9] = RCONST(3.0); /* [ 1 0 0 0 0 0 ] */
matdata[11] = RCONST(4.0); /* [ 0 0 5 6 0 0 ] */
matdata[13] = RCONST(5.0); /* [ 0 3 0 0 0 9 ] */
matdata[18] = RCONST(6.0);
matdata[20] = RCONST(7.0);
matdata[21] = RCONST(8.0);
matdata[29] = RCONST(9.0);
if (mattype == CSR_MAT) {
/* Check CSR */
C = SUNSparseMatrix(5, 6, 9, CSR_MAT);
rowptrs = SUNSparseMatrix_IndexPointers(C);
colindices = SUNSparseMatrix_IndexValues(C);
matdata = SUNSparseMatrix_Data(C);
rowptrs[0] = 0;
matdata[0] = RCONST(2.0); colindices[0] = 1;
matdata[1] = RCONST(7.0); colindices[1] = 4;
rowptrs[1] = 2;
matdata[2] = RCONST(4.0); colindices[2] = 2;
matdata[3] = RCONST(8.0); colindices[3] = 4;
rowptrs[2] = 4;
matdata[4] = RCONST(1.0); colindices[4] = 0;
rowptrs[3] = 5;
matdata[5] = RCONST(5.0); colindices[5] = 2;
matdata[6] = RCONST(6.0); colindices[6] = 3;
rowptrs[4] = 7;
matdata[7] = RCONST(3.0); colindices[7] = 1;
matdata[8] = RCONST(9.0); colindices[8] = 5;
rowptrs[5] = 9;
A = SUNSparseFromDenseMatrix(B, ZERO, CSR_MAT);
fails += check_matrix(A, C, 1e-15);
if (fails) {
printf("FAIL: SUNMatrix SparseFromDense CSR conversion failed\n");
return(1);
}
SUNMatDestroy(A);
SUNMatDestroy(C);
} else {
/* Check CSC */
D = SUNSparseMatrix(5, 6, 9, CSC_MAT);
colptrs = SUNSparseMatrix_IndexPointers(D);
rowindices = SUNSparseMatrix_IndexValues(D);
matdata = SUNSparseMatrix_Data(D);
colptrs[0] = 0;
matdata[0] = RCONST(1.0); rowindices[0] = 2;
colptrs[1] = 1;
matdata[1] = RCONST(2.0); rowindices[1] = 0;
matdata[2] = RCONST(3.0); rowindices[2] = 4;
colptrs[2] = 3;
matdata[3] = RCONST(4.0); rowindices[3] = 1;
matdata[4] = RCONST(5.0); rowindices[4] = 3;
colptrs[3] = 5;
matdata[5] = RCONST(6.0); rowindices[5] = 3;
colptrs[4] = 6;
matdata[6] = RCONST(7.0); rowindices[6] = 0;
matdata[7] = RCONST(8.0); rowindices[7] = 1;
colptrs[5] = 8;
matdata[8] = RCONST(9.0); rowindices[8] = 4;
colptrs[6] = 9;
A = SUNSparseFromDenseMatrix(B, 1e-15, CSC_MAT);
fails += check_matrix(A, D, 1e-15);
if (fails) {
printf("FAIL: SUNMatrix SparseFromDense CSC conversion failed\n");
return(1);
}
SUNMatDestroy(A);
SUNMatDestroy(D);
}
SUNMatDestroy(B);
/* check creating sparse matrix from banded matrix */
N = 7;
uband = 1;
lband = 2; /* B(i,j) = j + (j-i) */
B = SUNBandMatrix(N, uband, lband); /* B = [ 0 2 0 0 0 0 0 ] */
for (j=0; j<N; j++) { /* [ -1 1 3 0 0 0 0 ] */
matdata = SUNBandMatrix_Column(B, j); /* [ -2 0 2 4 0 0 0 ] */
kstart = (j<uband) ? -j : -uband; /* [ 0 -1 1 3 5 0 0 ] */
kend = (j>N-1-lband) ? N-1-j: lband; /* [ 0 0 0 2 4 6 0 ] */
for (k=kstart; k<=kend; k++) /* [ 0 0 0 1 3 5 7 ] */
matdata[k] = j - k; /* [ 0 0 0 0 2 4 6 ] */
}
if (mattype == CSR_MAT) {
/* CSR */
C = SUNSparseMatrix(7, 7, 21, CSR_MAT);
rowptrs = SUNSparseMatrix_IndexPointers(C);
colindices = SUNSparseMatrix_IndexValues(C);
matdata = SUNSparseMatrix_Data(C);
rowptrs[ 0] = 0;
matdata[ 0] = RCONST(2.0); colindices[ 0] = 1;
rowptrs[ 1] = 1;
matdata[ 1] = RCONST(-1.0); colindices[ 1] = 0;
matdata[ 2] = RCONST(1.0); colindices[ 2] = 1;
matdata[ 3] = RCONST(3.0); colindices[ 3] = 2;
rowptrs[ 2] = 4;
matdata[ 4] = RCONST(-2.0); colindices[ 4] = 0;
matdata[ 5] = RCONST(2.0); colindices[ 5] = 2;
matdata[ 6] = RCONST(4.0); colindices[ 6] = 3;
rowptrs[ 3] = 7;
matdata[ 7] = RCONST(-1.0); colindices[ 7] = 1;
matdata[ 8] = RCONST(1.0); colindices[ 8] = 2;
matdata[ 9] = RCONST(3.0); colindices[ 9] = 3;
matdata[10] = RCONST(5.0); colindices[10] = 4;
rowptrs[ 4] = 11;
matdata[11] = RCONST(2.0); colindices[11] = 3;
matdata[12] = RCONST(4.0); colindices[12] = 4;
matdata[13] = RCONST(6.0); colindices[13] = 5;
rowptrs[ 5] = 14;
matdata[14] = RCONST(1.0); colindices[14] = 3;
matdata[15] = RCONST(3.0); colindices[15] = 4;
matdata[16] = RCONST(5.0); colindices[16] = 5;
matdata[17] = RCONST(7.0); colindices[17] = 6;
rowptrs[ 6] = 18;
matdata[18] = RCONST(2.0); colindices[18] = 4;
matdata[19] = RCONST(4.0); colindices[19] = 5;
matdata[20] = RCONST(6.0); colindices[20] = 6;
rowptrs[ 7] = 21;
A = SUNSparseFromBandMatrix(B, ZERO, CSR_MAT);
fails += check_matrix(A, C, 1e-15);
if (fails) {
printf("FAIL: SUNMatrix SparseFromBand CSR conversion failed\n");
return(1);
}
SUNMatDestroy(A);
SUNMatDestroy(C);
} else {
/* Check CSC */
D = SUNSparseMatrix(7, 7, 21, CSC_MAT);
colptrs = SUNSparseMatrix_IndexPointers(D);
rowindices = SUNSparseMatrix_IndexValues(D);
matdata = SUNSparseMatrix_Data(D);
colptrs[ 0] = 0;
matdata[ 0] = RCONST(-1.0); rowindices[ 0] = 1;
matdata[ 1] = RCONST(-2.0); rowindices[ 1] = 2;
colptrs[ 1] = 2;
matdata[ 2] = RCONST(2.0); rowindices[ 2] = 0;
matdata[ 3] = RCONST(1.0); rowindices[ 3] = 1;
matdata[ 4] = RCONST(-1.0); rowindices[ 4] = 3;
colptrs[ 2] = 5;
matdata[ 5] = RCONST(3.0); rowindices[ 5] = 1;
matdata[ 6] = RCONST(2.0); rowindices[ 6] = 2;
matdata[ 7] = RCONST(1.0); rowindices[ 7] = 3;
colptrs[ 3] = 8;
matdata[ 8] = RCONST(4.0); rowindices[ 8] = 2;
matdata[ 9] = RCONST(3.0); rowindices[ 9] = 3;
matdata[10] = RCONST(2.0); rowindices[10] = 4;
matdata[11] = RCONST(1.0); rowindices[11] = 5;
colptrs[ 4] = 12;
matdata[12] = RCONST(5.0); rowindices[12] = 3;
matdata[13] = RCONST(4.0); rowindices[13] = 4;
matdata[14] = RCONST(3.0); rowindices[14] = 5;
matdata[15] = RCONST(2.0); rowindices[15] = 6;
colptrs[ 5] = 16;
matdata[16] = RCONST(6.0); rowindices[16] = 4;
matdata[17] = RCONST(5.0); rowindices[17] = 5;
matdata[18] = RCONST(4.0); rowindices[18] = 6;
colptrs[ 6] = 19;
matdata[19] = RCONST(7.0); rowindices[19] = 5;
matdata[20] = RCONST(6.0); rowindices[20] = 6;
colptrs[ 7] = 21;
A = SUNSparseFromBandMatrix(B, 1e-15, CSC_MAT);
fails += check_matrix(A, D, 1e-15);
if (fails) {
printf("FAIL: SUNMatrix SparseFromBand CSC conversion failed\n");
return(1);
}
SUNMatDestroy(A);
SUNMatDestroy(D);
}
SUNMatDestroy(B);
/* Create/fill I matrix */
I = NULL;
if (square) {
I = SUNSparseMatrix(matrows, matcols, matcols, mattype);
matdata = SUNSparseMatrix_Data(I);
colindices = SUNSparseMatrix_IndexValues(I);
rowptrs = SUNSparseMatrix_IndexPointers(I);
for(i=0; i<matrows; i++) {
matdata[i] = ONE;
colindices[i] = i;
rowptrs[i] = i;
}
rowptrs[matrows] = matrows;
}
/* Create/fill random dense matrices, create sparse from them */
C = SUNDenseMatrix(matrows, matcols);
D = SUNDenseMatrix(matrows, matcols);
for (k=0; k<3*matrows; k++) {
i = rand() % matrows;
j = rand() % matcols;
matdata = SUNDenseMatrix_Column(D,j);
matdata[i] = (realtype) rand() / (realtype) RAND_MAX;
}
for (k=0; k<matrows; k++) {
i = rand() % matrows;
j = rand() % matcols;
matdata = SUNDenseMatrix_Column(C,j);
matdata[i] = (realtype) rand() / (realtype) RAND_MAX;
}
A = SUNSparseFromDenseMatrix(C, ZERO, mattype);
B = SUNSparseFromDenseMatrix(D, ZERO, mattype);
/* Create vectors and fill */
x = N_VNew_Serial(matcols);
y = N_VNew_Serial(matrows);
z = N_VNew_Serial(matrows);
vecdata = N_VGetArrayPointer(x);
for(i=0; i<matcols; i++)
vecdata[i] = (realtype) rand() / (realtype) RAND_MAX;
if (SUNMatMatvec(C, x, y) != 0) {
printf("FAIL: SUNMatrix module Dense matvec failure \n \n");
SUNMatDestroy(A); SUNMatDestroy(B);
SUNMatDestroy(C); SUNMatDestroy(D);
N_VDestroy(x); N_VDestroy(y); N_VDestroy(z);
if (square)
SUNMatDestroy(I);
return(1);
}
if (SUNMatMatvec(D, x, z) != 0) {
printf("FAIL: SUNMatrix module Dense matvec failure \n \n");
SUNMatDestroy(A); SUNMatDestroy(B);
SUNMatDestroy(C); SUNMatDestroy(D);
N_VDestroy(x); N_VDestroy(y); N_VDestroy(z);
if (square)
SUNMatDestroy(I);
return(1);
}
/* SUNMatrix Tests */
fails += Test_SUNMatGetID(A, SUNMATRIX_SPARSE, 0);
fails += Test_SUNMatClone(A, 0);
fails += Test_SUNMatCopy(A, 0);
fails += Test_SUNMatZero(A, 0);
fails += Test_SUNMatScaleAdd(A, I, 0);
fails += Test_SUNMatScaleAdd2(A, B, x, y, z);
if (square) {
fails += Test_SUNMatScaleAddI(A, I, 0);
fails += Test_SUNMatScaleAddI2(A, x, y);
}
fails += Test_SUNMatMatvec(A, x, y, 0);
fails += Test_SUNMatSpace(A, 0);
/* Print result */
if (fails) {
printf("FAIL: SUNMatrix module failed %i tests \n \n", fails);
printf("\nA =\n");
SUNSparseMatrix_Print(A,stdout);
printf("\nB =\n");
SUNSparseMatrix_Print(B,stdout);
if (square) {
printf("\nI =\n");
SUNSparseMatrix_Print(I,stdout);
}
printf("\nx =\n");
N_VPrint_Serial(x);
printf("\ny =\n");
N_VPrint_Serial(y);
printf("\nz =\n");
N_VPrint_Serial(z);
} else {
printf("SUCCESS: SUNMatrix module passed all tests \n \n");
}
/* Free vectors and matrices */
N_VDestroy(x);
N_VDestroy(y);
N_VDestroy(z);
SUNMatDestroy(A);
SUNMatDestroy(B);
SUNMatDestroy(C);
SUNMatDestroy(D);
if (square)
SUNMatDestroy(I);
return(fails);
}
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);
}
/* ----------------------------------------------------------------------
* Extra ScaleAdd tests for sparse matrices:
* A and B should have different sparsity patterns, and neither should
* contain sufficient storage to for their sum
* y should already equal A*x
* z should already equal B*x
* --------------------------------------------------------------------*/
int Test_SUNMatScaleAdd2(SUNMatrix A, SUNMatrix B, N_Vector x,
N_Vector y, N_Vector z)
{
int failure;
SUNMatrix C, D, E;
N_Vector u, v;
realtype tol=100*UNIT_ROUNDOFF;
/* create clones for test */
C = SUNMatClone(A);
u = N_VClone(y);
v = N_VClone(y);
/* test 1: add A to B (output must be enlarged) */
failure = SUNMatCopy(A, C); /* C = A */
if (failure) {
printf(">>> FAILED test -- SUNMatCopy returned %d \n",
failure);
SUNMatDestroy(C); N_VDestroy(u); N_VDestroy(v); return(1);
}
failure = SUNMatScaleAdd(ONE, C, B); /* C = A+B */
if (failure) {
printf(">>> FAILED test -- SUNMatScaleAdd returned %d \n",
failure);
SUNMatDestroy(C); N_VDestroy(u); N_VDestroy(v); return(1);
}
failure = SUNMatMatvec(C, x, u); /* u = Cx = Ax+Bx */
if (failure) {
printf(">>> FAILED test -- SUNMatMatvec returned %d \n",
failure);
SUNMatDestroy(C); N_VDestroy(u); N_VDestroy(v); return(1);
}
N_VLinearSum(ONE,y,ONE,z,v); /* v = y+z */
failure = check_vector(u, v, tol); /* u ?= v */
if (failure) {
printf(">>> FAILED test -- SUNMatScaleAdd2 check 1 \n");
printf("\nA =\n");
SUNSparseMatrix_Print(A,stdout);
printf("\nB =\n");
SUNSparseMatrix_Print(B,stdout);
printf("\nC =\n");
SUNSparseMatrix_Print(C,stdout);
printf("\nx =\n");
N_VPrint_Serial(x);
printf("\ny =\n");
N_VPrint_Serial(y);
printf("\nz =\n");
N_VPrint_Serial(z);
printf("\nu =\n");
N_VPrint_Serial(u);
printf("\nv =\n");
N_VPrint_Serial(v);
SUNMatDestroy(C); N_VDestroy(u); N_VDestroy(v); return(1);
}
else {
printf(" PASSED test -- SUNMatScaleAdd2 check 1 \n");
}
/* test 2: add A to a matrix with sufficient but misplaced storage */
D = SUNMatClone(A);
failure = SUNSparseMatrix_Reallocate(D, SM_NNZ_S(A)+SM_NNZ_S(B));
failure = SUNMatCopy(A, D); /* D = A */
if (failure) {
printf(">>> FAILED test -- SUNMatCopy returned %d \n",
failure);
SUNMatDestroy(C); SUNMatDestroy(D);
N_VDestroy(u); N_VDestroy(v); return(1);
}
failure = SUNMatScaleAdd(ONE, D, B); /* D = A+B */
if (failure) {
printf(">>> FAILED test -- SUNMatScaleAdd returned %d \n",
failure);
SUNMatDestroy(C); SUNMatDestroy(D);
N_VDestroy(u); N_VDestroy(v); return(1);
}
failure = SUNMatMatvec(D, x, u); /* u = Cx = Ax+Bx */
if (failure) {
printf(">>> FAILED test -- SUNMatMatvec returned %d \n",
failure);
SUNMatDestroy(C); SUNMatDestroy(D);
N_VDestroy(u); N_VDestroy(v); return(1);
}
N_VLinearSum(ONE,y,ONE,z,v); /* v = y+z */
failure = check_vector(u, v, tol); /* u ?= v */
if (failure) {
printf(">>> FAILED test -- SUNMatScaleAdd2 check 2 \n");
printf("\nA =\n");
SUNSparseMatrix_Print(A,stdout);
printf("\nB =\n");
SUNSparseMatrix_Print(B,stdout);
printf("\nD =\n");
SUNSparseMatrix_Print(D,stdout);
printf("\nx =\n");
N_VPrint_Serial(x);
printf("\ny =\n");
N_VPrint_Serial(y);
printf("\nz =\n");
N_VPrint_Serial(z);
printf("\nu =\n");
N_VPrint_Serial(u);
printf("\nv =\n");
N_VPrint_Serial(v);
SUNMatDestroy(C); SUNMatDestroy(D);
N_VDestroy(u); N_VDestroy(v); return(1);
}
else {
printf(" PASSED test -- SUNMatScaleAdd2 check 2 \n");
}
/* test 3: add A to a matrix with the appropriate structure already in place */
E = SUNMatClone(C);
failure = SUNMatCopy(C, E); /* E = A + B */
if (failure) {
printf(">>> FAILED test -- SUNMatCopy returned %d \n",
failure);
SUNMatDestroy(C); SUNMatDestroy(D); SUNMatDestroy(E);
N_VDestroy(u); N_VDestroy(v); return(1);
}
failure = SUNMatScaleAdd(NEG_ONE, E, B); /* E = -A */
if (failure) {
printf(">>> FAILED test -- SUNMatScaleAdd returned %d \n",
failure);
SUNMatDestroy(C); SUNMatDestroy(D); SUNMatDestroy(E);
N_VDestroy(u); N_VDestroy(v); return(1);
}
failure = SUNMatMatvec(E, x, u); /* u = Ex = -Ax */
if (failure) {
printf(">>> FAILED test -- SUNMatMatvec returned %d \n",
failure);
SUNMatDestroy(C); SUNMatDestroy(D); SUNMatDestroy(E);
N_VDestroy(u); N_VDestroy(v); return(1);
}
N_VLinearSum(NEG_ONE,y,ZERO,z,v); /* v = -y */
failure = check_vector(u, v, tol); /* v ?= u */
if (failure) {
printf(">>> FAILED test -- SUNMatScaleAdd2 check 3 \n");
printf("\nA =\n");
SUNSparseMatrix_Print(A,stdout);
printf("\nB =\n");
SUNSparseMatrix_Print(B,stdout);
printf("\nC =\n");
SUNSparseMatrix_Print(C,stdout);
printf("\nE =\n");
SUNSparseMatrix_Print(E,stdout);
printf("\nx =\n");
N_VPrint_Serial(x);
printf("\ny =\n");
N_VPrint_Serial(y);
printf("\nu =\n");
N_VPrint_Serial(u);
printf("\nv =\n");
N_VPrint_Serial(v);
SUNMatDestroy(C); SUNMatDestroy(D); SUNMatDestroy(E);
N_VDestroy(u); N_VDestroy(v); return(1);
}
else {
printf(" PASSED test -- SUNMatScaleAdd2 check 3 \n");
}
SUNMatDestroy(C);
SUNMatDestroy(D);
SUNMatDestroy(E);
N_VDestroy(u);
N_VDestroy(v);
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(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);
}
/* ----------------------------------------------------------------------
* Extra ScaleAddI tests for sparse matrices:
* A should not contain values on the diagonal, nor should it contain
* sufficient storage to add those in
* y should already equal A*x
* --------------------------------------------------------------------*/
int Test_SUNMatScaleAddI2(SUNMatrix A, N_Vector x, N_Vector y)
{
int failure;
SUNMatrix B, C, D;
N_Vector w, z;
realtype tol=100*UNIT_ROUNDOFF;
/* create clones for test */
B = SUNMatClone(A);
z = N_VClone(x);
w = N_VClone(x);
/* test 1: add I to a matrix with insufficient storage */
failure = SUNMatCopy(A, B);
if (failure) {
printf(">>> FAILED test -- SUNMatCopy returned %d \n",
failure);
SUNMatDestroy(B); N_VDestroy(z); N_VDestroy(w); return(1);
}
failure = SUNMatScaleAddI(NEG_ONE, B); /* B = I-A */
if (failure) {
printf(">>> FAILED test -- SUNMatScaleAddI returned %d \n",
failure);
SUNMatDestroy(B); N_VDestroy(z); N_VDestroy(w); return(1);
}
failure = SUNMatMatvec(B, x, z);
if (failure) {
printf(">>> FAILED test -- SUNMatMatvec returned %d \n",
failure);
SUNMatDestroy(B); N_VDestroy(z); N_VDestroy(w); return(1);
}
N_VLinearSum(ONE,x,NEG_ONE,y,w);
failure = check_vector(z, w, tol);
if (failure) {
printf(">>> FAILED test -- SUNMatScaleAddI2 check 1 \n");
printf("\nA =\n");
SUNSparseMatrix_Print(A,stdout);
printf("\nB =\n");
SUNSparseMatrix_Print(B,stdout);
printf("\nz =\n");
N_VPrint_Serial(z);
printf("\nw =\n");
N_VPrint_Serial(w);
SUNMatDestroy(B); N_VDestroy(z); N_VDestroy(w); return(1);
}
else {
printf(" PASSED test -- SUNMatScaleAddI2 check 1 \n");
}
/* test 2: add I to a matrix with sufficient but misplaced
storage */
C = SUNMatClone(A);
failure = SUNSparseMatrix_Reallocate(C, SM_NNZ_S(A)+SM_ROWS_S(A));
failure = SUNMatCopy(A, C);
if (failure) {
printf(">>> FAILED test -- SUNMatCopy returned %d \n",
failure);
SUNMatDestroy(B); SUNMatDestroy(C);
N_VDestroy(z); N_VDestroy(w); return(1);
}
failure = SUNMatScaleAddI(NEG_ONE, C); /* C = I-A */
if (failure) {
printf(">>> FAILED test -- SUNMatScaleAddI returned %d \n",
failure);
SUNMatDestroy(B); SUNMatDestroy(C);
N_VDestroy(z); N_VDestroy(w); return(1);
}
failure = SUNMatMatvec(C, x, z);
if (failure) {
printf(">>> FAILED test -- SUNMatMatvec returned %d \n",
failure);
SUNMatDestroy(B); SUNMatDestroy(C);
N_VDestroy(z); N_VDestroy(w); return(1);
}
N_VLinearSum(ONE,x,NEG_ONE,y,w);
failure = check_vector(z, w, tol);
if (failure) {
printf(">>> FAILED test -- SUNMatScaleAddI2 check 2 \n");
printf("\nA =\n");
SUNSparseMatrix_Print(A,stdout);
printf("\nC =\n");
SUNSparseMatrix_Print(C,stdout);
printf("\nz =\n");
N_VPrint_Serial(z);
printf("\nw =\n");
N_VPrint_Serial(w);
SUNMatDestroy(B); SUNMatDestroy(C);
N_VDestroy(z); N_VDestroy(w); return(1);
}
else {
printf(" PASSED test -- SUNMatScaleAddI2 check 2 \n");
}
/* test 3: add I to a matrix with appropriate structure already in place */
D = SUNMatClone(C);
failure = SUNMatCopy(C, D);
if (failure) {
printf(">>> FAILED test -- SUNMatCopy returned %d \n",
failure);
SUNMatDestroy(B); SUNMatDestroy(C); SUNMatDestroy(D);
N_VDestroy(z); N_VDestroy(w); return(1);
}
failure = SUNMatScaleAddI(NEG_ONE, D); /* D = A */
if (failure) {
printf(">>> FAILED test -- SUNMatScaleAddI returned %d \n",
failure);
SUNMatDestroy(B); SUNMatDestroy(C); SUNMatDestroy(D);
N_VDestroy(z); N_VDestroy(w); return(1);
}
failure = SUNMatMatvec(D, x, z);
if (failure) {
printf(">>> FAILED test -- SUNMatMatvec returned %d \n",
failure);
SUNMatDestroy(B); SUNMatDestroy(C); SUNMatDestroy(D);
N_VDestroy(z); N_VDestroy(w); return(1);
}
failure = check_vector(z, y, tol);
if (failure) {
printf(">>> FAILED test -- SUNMatScaleAddI2 check 3 \n");
printf("\nA =\n");
SUNSparseMatrix_Print(A,stdout);
printf("\nD =\n");
SUNSparseMatrix_Print(D,stdout);
printf("\nz =\n");
N_VPrint_Serial(z);
printf("\ny =\n");
N_VPrint_Serial(y);
SUNMatDestroy(B); SUNMatDestroy(C); SUNMatDestroy(D);
N_VDestroy(z); N_VDestroy(w); return(1);
}
else {
printf(" PASSED test -- SUNMatScaleAddI2 check 3 \n");
}
SUNMatDestroy(B);
SUNMatDestroy(C);
SUNMatDestroy(D);
N_VDestroy(z);
N_VDestroy(w);
return(0);
}
