/* 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;
}
SUNLinearSolver SUNPCG(N_Vector y, int pretype, int maxl)
{ return(SUNLinSol_PCG(y, pretype, maxl)); }
/* ----------------------------------------------------------------------
* SUNOCG 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 s (no preconditioning)
* 4. tridiagonal system w/ scale vector s (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 scaling, we use
* the matrix
* A = (S-inverse) Ahat (S-inverse),
* solution vector
* x = S xhat;
* and construct b = A*x. Hence the linear system has both rows
* and columns scaled by (S-inverse), where S is the diagonal
* matrix with entries from the vector s, the 'scaling' vector
* supplied to PCG having strictly positive entries.
*
* When this is combined with preconditioning, we construct
* P \approx (A-inverse) by taking a unit-less preconditioner
* Phat \approx (Ahat-inverse), and constructing the operator
* P via
* P = S Phat S \approx S (Ahat-inverse) S = A-inverse
* We apply this via the steps:
* z = Pr = S Phat S r
* Since both S and Phat are diagonal matrices, this is
* equivalent to
* z(i) = s(i)^2 Phat(i) r(i)
* --------------------------------------------------------------------*/
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 maxl, print_timing;
sunindextype i;
realtype *vecdata;
double tol;
/* check inputs: local problem size, timing flag */
if (argc < 5) {
printf("ERROR: FOUR (4) Inputs required:\n");
printf(" Problem size should be >0\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;
}
maxl = atoi(argv[2]);
if (maxl <= 0) {
printf("ERROR: Maximum Krylov subspace dimension must be a positive integer\n");
return 1;
}
tol = atof(argv[3]);
if (tol <= ZERO) {
printf("ERROR: Solver tolerance must be a positive real number\n");
return 1;
}
print_timing = atoi(argv[4]);
SetTiming(print_timing);
printf("\nPCG linear solver test:\n");
printf(" Problem size = %ld\n", (long int) ProbData.N);
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.s = N_VNew_Serial(ProbData.N);
if (check_flag(ProbData.s, "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 PCG linear solver */
LS = SUNLinSol_PCG(x, PREC_RIGHT, 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.s, NULL, 0);
fails += Test_SUNLinSolInitialize(LS, 0);
fails += Test_SUNLinSolSpace(LS, 0);
if (fails) {
printf("FAIL: SUNLinSol_PCG module failed %i initialization tests\n\n", fails);
return 1;
} else {
printf("SUCCESS: SUNLinSol_PCG module passed all initialization tests\n\n");
}
/*** Test 1: simple Poisson-like solve (no preconditioning) ***/
/* set scaling vector */
N_VConst(ONE, ProbData.s);
/* Fill x vector with scaled version */
N_VProd(xhat, ProbData.s, x);
/* Fill b vector with result of matrix-vector product */
fails = ATimes(&ProbData, x, b);
if (check_flag(&fails, "ATimes", 1)) return 1;
/* Run test with this setup */
fails += SUNLinSol_PCGSetPrecType(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_PCG module, problem 1, failed %i tests\n\n", fails);
passfail += 1;
} else {
printf("SUCCESS: SUNLinSol_PCG module, problem 1, passed all tests\n\n");
}
/*** Test 2: simple Poisson-like solve (Jacobi preconditioning) ***/
/* set scaling vector */
N_VConst(ONE, ProbData.s);
/* Fill x vector with scaled version */
N_VProd(xhat, ProbData.s, 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_PCGSetPrecType(LS, PREC_RIGHT);
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_PCG module, problem 2, failed %i tests\n\n", fails);
passfail += 1;
} else {
printf("SUCCESS: SUNLinSol_PCG module, problem 2, passed all tests\n\n");
}
/*** Test 3: Poisson-like solve w/ scaling (no preconditioning) ***/
/* set scaling vector */
vecdata = N_VGetArrayPointer(ProbData.s);
for (i=0; i<ProbData.N; i++)
vecdata[i] = ONE + THOUSAND*urand();
/* Fill x vector with scaled version */
N_VProd(xhat, ProbData.s, 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_PCGSetPrecType(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_PCG module, problem 3, failed %i tests\n\n", fails);
passfail += 1;
} else {
printf("SUCCESS: SUNLinSol_PCG module, problem 3, passed all tests\n\n");
}
/*** Test 4: Poisson-like solve w/ scaling (Jacobi preconditioning) ***/
/* set scaling vectors */
vecdata = N_VGetArrayPointer(ProbData.s);
for (i=0; i<ProbData.N; i++)
vecdata[i] = ONE + THOUSAND*urand();
/* Fill x vector with scaled version */
N_VProd(xhat, ProbData.s, 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_PCGSetPrecType(LS, PREC_RIGHT);
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_PCG module, problem 4, failed %i tests\n\n", fails);
passfail += 1;
} else {
printf("SUCCESS: SUNLinSol_PCG module, problem 4, 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.s);
return(passfail);
}
