PetscErrorCode IJacobian(TS ts,PetscReal t,Vec X,Vec Xdot,PetscReal a,Mat A,Mat B,Userctx *user)
{
PetscErrorCode ierr;
SNES snes;
PetscScalar atmp = (PetscScalar) a;
PetscInt i,row;
PetscFunctionBegin;
user->t = t;
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = ResidualJacobian(snes,X,A,B,user);CHKERRQ(ierr);
for (i=0;i < ngen;i++) {
row = 9*i;
ierr = MatSetValues(A,1,&row,1,&row,&atmp,ADD_VALUES);CHKERRQ(ierr);
row = 9*i+1;
ierr = MatSetValues(A,1,&row,1,&row,&atmp,ADD_VALUES);CHKERRQ(ierr);
row = 9*i+2;
ierr = MatSetValues(A,1,&row,1,&row,&atmp,ADD_VALUES);CHKERRQ(ierr);
row = 9*i+3;
ierr = MatSetValues(A,1,&row,1,&row,&atmp,ADD_VALUES);CHKERRQ(ierr);
row = 9*i+6;
ierr = MatSetValues(A,1,&row,1,&row,&atmp,ADD_VALUES);CHKERRQ(ierr);
row = 9*i+7;
ierr = MatSetValues(A,1,&row,1,&row,&atmp,ADD_VALUES);CHKERRQ(ierr);
row = 9*i+8;
ierr = MatSetValues(A,1,&row,1,&row,&atmp,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSSetUp_Theta(TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscErrorCode ierr;
SNES snes;
TSAdapt adapt;
DM dm;
PetscFunctionBegin;
ierr = VecDuplicate(ts->vec_sol,&th->X);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->Xdot);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->X0);CHKERRQ(ierr);
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
if (dm) {
ierr = DMCoarsenHookAdd(dm,DMCoarsenHook_TSTheta,DMRestrictHook_TSTheta,ts);CHKERRQ(ierr);
ierr = DMSubDomainHookAdd(dm,DMSubDomainHook_TSTheta,DMSubDomainRestrictHook_TSTheta,ts);CHKERRQ(ierr);
}
if (th->Theta == 0.5 && th->endpoint) th->order = 2;
else th->order = 1;
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
if (!th->adapt) {
ierr = TSAdaptSetType(adapt,TSADAPTNONE);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode TSSetUp_Alpha(TS ts)
{
TS_Alpha *th = (TS_Alpha*)ts->data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecDuplicate(ts->vec_sol,&th->X0);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->Xa);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->X1);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->V0);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->Va);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->V1);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->A0);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->Aa);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->A1);CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&ts->adapt);CHKERRQ(ierr);
ierr = TSAdaptCandidatesClear(ts->adapt);CHKERRQ(ierr);
if (!th->adapt) {
ierr = TSAdaptSetType(ts->adapt,TSADAPTNONE);CHKERRQ(ierr);
} else {
ierr = VecDuplicate(ts->vec_sol,&th->vec_sol_prev);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->vec_dot_prev);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->vec_lte_work[0]);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->vec_lte_work[1]);CHKERRQ(ierr);
if (ts->exact_final_time == TS_EXACTFINALTIME_UNSPECIFIED)
ts->exact_final_time = TS_EXACTFINALTIME_MATCHSTEP;
}
ierr = TSGetSNES(ts,&ts->snes);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSStage_EIMEX(TS ts,PetscInt istage)
{
TS_EIMEX *ext = (TS_EIMEX*)ts->data;
PetscReal h;
Vec Y=ext->Y, Z=ext->Z;
SNES snes;
TSAdapt adapt;
PetscInt i,its,lits;
PetscBool accept;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
h = ts->time_step/ext->N[istage];/* step size for the istage-th stage */
ext->shift = 1./h;
ierr = SNESSetLagJacobian(snes,-2);CHKERRQ(ierr); /* Recompute the Jacobian on this solve, but not again */
ierr = VecCopy(ext->VecSolPrev,Y);CHKERRQ(ierr); /* Take the previous solution as intial step */
for(i=0; i<ext->N[istage]; i++){
ext->ctime = ts->ptime + h*i;
ierr = VecCopy(Y,Z);CHKERRQ(ierr);/* Save the solution of the previous substep */
ierr = SNESSolve(snes,NULL,Y);CHKERRQ(ierr);
ierr = SNESGetIterationNumber(snes,&its);CHKERRQ(ierr);
ierr = SNESGetLinearSolveIterations(snes,&lits);CHKERRQ(ierr);
ts->snes_its += its; ts->ksp_its += lits;
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptCheckStage(adapt,ts,ext->ctime,Y,&accept);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode IFunction(TS ts,PetscReal t, Vec X, Vec Xdot, Vec F, Userctx *user)
{
PetscErrorCode ierr;
SNES snes;
PetscScalar *f;
const PetscScalar *xdot;
PetscInt i;
PetscFunctionBegin;
user->t = t;
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = ResidualFunction(snes,X,F,user);CHKERRQ(ierr);
ierr = VecGetArray(F,&f);
ierr = VecGetArrayRead(Xdot,&xdot);CHKERRQ(ierr);
for (i=0;i < ngen;i++) {
f[9*i] += xdot[9*i];
f[9*i+1] += xdot[9*i+1];
f[9*i+2] += xdot[9*i+2];
f[9*i+3] += xdot[9*i+3];
f[9*i+6] += xdot[9*i+6];
f[9*i+7] += xdot[9*i+7];
f[9*i+8] += xdot[9*i+8];
}
ierr = VecRestoreArray(F,&f);
ierr = VecRestoreArrayRead(Xdot,&xdot);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode RunTest(int nx, int ny, int nz, int loops, double *wt)
{
Vec x,f;
TS ts;
AppCtx _app,*app=&_app;
double t1,t2;
PetscErrorCode ierr;
PetscFunctionBegin;
app->nx = nx; app->h[0] = 1./(nx-1);
app->ny = ny; app->h[1] = 1./(ny-1);
app->nz = nz; app->h[2] = 1./(nz-1);
ierr = VecCreate(PETSC_COMM_SELF,&x);CHKERRQ(ierr);
ierr = VecSetSizes(x,nx*ny*nz,nx*ny*nz);CHKERRQ(ierr);
ierr = VecSetUp(x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&f);CHKERRQ(ierr);
ierr = TSCreate(PETSC_COMM_SELF,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSTHETA);CHKERRQ(ierr);
ierr = TSThetaSetTheta(ts,1.0);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,0.01);CHKERRQ(ierr);
ierr = TSSetTime(ts,0.0);CHKERRQ(ierr);
ierr = TSSetDuration(ts,10,1.0);CHKERRQ(ierr);
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,f,FormFunction,app);CHKERRQ(ierr);
ierr = PetscOptionsSetValue("-snes_mf","1");CHKERRQ(ierr);
{
SNES snes;
KSP ksp;
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr);
ierr = KSPSetType(ksp,KSPCG);CHKERRQ(ierr);
}
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSetUp(ts);CHKERRQ(ierr);
*wt = 1e300;
while (loops-- > 0) {
ierr = FormInitial(0.0,x,app);CHKERRQ(ierr);
ierr = PetscGetTime(&t1);CHKERRQ(ierr);
ierr = TSSolve(ts,x,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscGetTime(&t2);CHKERRQ(ierr);
*wt = PetscMin(*wt,t2-t1);
}
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&f);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode TSSundialsGetPC_Sundials(TS ts,PC *pc)
{
SNES snes;
KSP ksp;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,pc);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* MyTSMonitor: stdout report at every time step */
PetscErrorCode MyTSMonitor(TS ts,PetscInt step,PetscReal ptime,Vec X,void *ptr)
{
PetscErrorCode ierr;
PetscReal twonorms[2],rnorm2,Wnorm1,Wnorminf,Pnorm1,Pnorminf;
PetscReal secperday=3600.0*24.0,CD;
MPI_Comm comm;
PorousCtx *user = (PorousCtx*)ptr;
SNES snes;
PetscFunctionBegin;
ierr = getWPnorms(user,X,&Wnorm1,&Wnorminf,&Pnorm1,&Pnorminf);CHKERRQ(ierr);
CD = (user->Kconst * user->sigma) / (user->rhow * user->g);
ierr = VecStrideNormAll(X,NORM_2,twonorms);CHKERRQ(ierr);
ierr = PetscObjectGetComm((PetscObject)ts,&comm);CHKERRQ(ierr);
/* summary */
if (!user->run_silent) {
/*
ierr = PetscPrintf(comm,
"step %3d at %7G days: |W|_1=%.9e m3, max W=%.3f m,\n"
" max D=%.3f m2s-1, max P=%.3f bar\n",
step,ptime/secperday,Wnorm1,Wnorminf,
CD*Pnorminf,Pnorminf/1.0e5);CHKERRQ(ierr);
*/
if (user->fcncount <= 2) {
ierr = PetscPrintf(comm,
" step time(days) |W|_1(m3) max W(m) max D(m2 s-1) max P(bar)\n");CHKERRQ(ierr);
}
ierr = PetscPrintf(comm,
" %3d %7G %11.6e %11.6f %11.6f %11.6f\n",
step,ptime/secperday,Wnorm1,Wnorminf,CD*Pnorminf,
Pnorminf/1.0e5);CHKERRQ(ierr);
}
/* warning if solution not small */
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetFunctionNorm(snes,&rnorm2);CHKERRQ(ierr);
if (rnorm2 > 1.0e-10 * (twonorms[0]+twonorms[1])) {
user->not_converged_warning = PETSC_TRUE;
if (!user->run_silent) {
ierr = PetscPrintf(comm,
"***WARNING1***: residual norm not small (> 1e-10 * (|W|_2+|P|_2)) at step %d\n",
step);CHKERRQ(ierr); }
}
/* update max of rnorm (relative) so far */
if (twonorms[0] > 0.0) user->maxrnorm = PetscMax(user->maxrnorm,rnorm2);
PetscFunctionReturn(0);
}
EXTERN_C_END
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "TSSundialsGetPC_Sundials"
PetscErrorCode TSSundialsGetPC_Sundials(TS ts,PC *pc)
{
SNES snes;
KSP ksp;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,pc); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSSetUp_Theta(TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscErrorCode ierr;
SNES snes;
DM dm;
PetscFunctionBegin;
ierr = VecDuplicate(ts->vec_sol,&th->X);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->Xdot);CHKERRQ(ierr);
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
if (dm) {
ierr = DMCoarsenHookAdd(dm,DMCoarsenHook_TSTheta,DMRestrictHook_TSTheta,ts);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts;
SNES snes;
SNESLineSearch linesearch;
Vec x;
AppCtx ctx;
PetscErrorCode ierr;
DM da;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = SetFromOptions(&ctx);CHKERRQ(ierr);
ierr = TSCreate(PETSC_COMM_WORLD, &ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetIFunction(ts, NULL, FormIFunction, &ctx);CHKERRQ(ierr);
ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,-4,-4,PETSC_DECIDE,PETSC_DECIDE,N_SPECIES,1,NULL,NULL,&da);CHKERRQ(ierr);
ierr = DMDASetUniformCoordinates(da, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0);CHKERRQ(ierr);
ierr = DMDASetFieldName(da,0,"species A");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,1,"species B");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,2,"species C");CHKERRQ(ierr);
ierr = DMSetApplicationContext(da,&ctx);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(da,&x);CHKERRQ(ierr);
ierr = FormInitialGuess(da, &ctx, x);CHKERRQ(ierr);
ierr = TSSetDM(ts, da);CHKERRQ(ierr);
ierr = TSSetDuration(ts,10000,1000.0);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,1.0);CHKERRQ(ierr);
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetLineSearch(snes,&linesearch);CHKERRQ(ierr);
ierr = SNESLineSearchSetPostCheck(linesearch, ReactingFlowPostCheck, (void*)&ctx);CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
ierr = TSSolve(ts,x);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
static PetscErrorCode TSSetUp_Theta(TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!th->VecCostIntegral0 && ts->vec_costintegral && ts->costintegralfwd) { /* back up cost integral */
ierr = VecDuplicate(ts->vec_costintegral,&th->VecCostIntegral0);CHKERRQ(ierr);
}
if (!th->X) {
ierr = VecDuplicate(ts->vec_sol,&th->X);CHKERRQ(ierr);
}
if (!th->Xdot) {
ierr = VecDuplicate(ts->vec_sol,&th->Xdot);CHKERRQ(ierr);
}
if (!th->X0) {
ierr = VecDuplicate(ts->vec_sol,&th->X0);CHKERRQ(ierr);
}
if (th->endpoint) {
ierr = VecDuplicate(ts->vec_sol,&th->affine);CHKERRQ(ierr);
}
th->order = (th->Theta == 0.5) ? 2 : 1;
ierr = TSGetDM(ts,&ts->dm);CHKERRQ(ierr);
ierr = DMCoarsenHookAdd(ts->dm,DMCoarsenHook_TSTheta,DMRestrictHook_TSTheta,ts);CHKERRQ(ierr);
ierr = DMSubDomainHookAdd(ts->dm,DMSubDomainHook_TSTheta,DMSubDomainRestrictHook_TSTheta,ts);CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&ts->adapt);CHKERRQ(ierr);
ierr = TSAdaptCandidatesClear(ts->adapt);CHKERRQ(ierr);
if (!th->adapt) {
ierr = TSAdaptSetType(ts->adapt,TSADAPTNONE);CHKERRQ(ierr);
} else {
ierr = VecDuplicate(ts->vec_sol,&th->vec_sol_prev);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->vec_lte_work);CHKERRQ(ierr);
if (ts->exact_final_time == TS_EXACTFINALTIME_UNSPECIFIED)
ts->exact_final_time = TS_EXACTFINALTIME_MATCHSTEP;
}
ierr = TSGetSNES(ts,&ts->snes);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DMTSCheckFromOptions(TS ts, Vec u, PetscErrorCode (**exactFuncs)(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nf, PetscScalar *u, void *ctx), void **ctxs)
{
DM dm;
SNES snes;
Vec sol;
PetscBool check;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscOptionsHasName(((PetscObject)ts)->options,((PetscObject)ts)->prefix, "-dmts_check", &check);CHKERRQ(ierr);
if (!check) PetscFunctionReturn(0);
ierr = VecDuplicate(u, &sol);CHKERRQ(ierr);
ierr = TSSetSolution(ts, sol);CHKERRQ(ierr);
ierr = TSGetDM(ts, &dm);CHKERRQ(ierr);
ierr = TSSetUp(ts);CHKERRQ(ierr);
ierr = TSGetSNES(ts, &snes);CHKERRQ(ierr);
ierr = SNESSetSolution(snes, sol);CHKERRQ(ierr);
ierr = DMSNESCheckFromOptions_Internal(snes, dm, u, sol, exactFuncs, ctxs);CHKERRQ(ierr);
ierr = VecDestroy(&sol);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode MonitorObjective(TS ts,PetscInt step,PetscReal t,Vec X,void *ictx)
{
Ctx *ctx = (Ctx*)ictx;
PetscErrorCode ierr;
const PetscScalar *x;
PetscScalar f;
PetscReal dt,gnorm;
PetscInt i,snesit,linit;
SNES snes;
Vec Xdot,F;
PetscFunctionBeginUser;
/* Compute objective functional */
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
f = 0;
for (i=0; i<ctx->n-1; i++) {
f += PetscSqr(1. - x[i]) + 100. * PetscSqr(x[i+1] - PetscSqr(x[i]));
}
ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
/* Compute norm of gradient */
ierr = VecDuplicate(X,&Xdot);CHKERRQ(ierr);
ierr = VecDuplicate(X,&F);CHKERRQ(ierr);
ierr = VecZeroEntries(Xdot);CHKERRQ(ierr);
ierr = FormIFunction(ts,t,X,Xdot,F,ictx);CHKERRQ(ierr);
ierr = VecNorm(F,NORM_2,&gnorm);CHKERRQ(ierr);
ierr = VecDestroy(&Xdot);CHKERRQ(ierr);
ierr = VecDestroy(&F);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetIterationNumber(snes,&snesit);CHKERRQ(ierr);
ierr = SNESGetLinearSolveIterations(snes,&linit);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,
(ctx->monitor_short
? "%3D t=%10.1e dt=%10.1e f=%10.1e df=%10.1e it=(%2D,%3D)\n"
: "%3D t=%10.4e dt=%10.4e f=%10.4e df=%10.4e it=(%2D,%3D)\n"),
step,(double)t,(double)dt,(double)PetscRealPart(f),(double)gnorm,snesit,linit);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode TSCreate_Pseudo(TS ts)
{
TS_Pseudo *pseudo;
PetscErrorCode ierr;
SNES snes;
SNESType stype;
PetscFunctionBegin;
ts->ops->reset = TSReset_Pseudo;
ts->ops->destroy = TSDestroy_Pseudo;
ts->ops->view = TSView_Pseudo;
ts->ops->setup = TSSetUp_Pseudo;
ts->ops->step = TSStep_Pseudo;
ts->ops->setfromoptions = TSSetFromOptions_Pseudo;
ts->ops->snesfunction = SNESTSFormFunction_Pseudo;
ts->ops->snesjacobian = SNESTSFormJacobian_Pseudo;
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetType(snes,&stype);CHKERRQ(ierr);
if (!stype) {ierr = SNESSetType(snes,SNESKSPONLY);CHKERRQ(ierr);}
ierr = PetscNewLog(ts,&pseudo);CHKERRQ(ierr);
ts->data = (void*)pseudo;
pseudo->dt_increment = 1.1;
pseudo->increment_dt_from_initial_dt = PETSC_FALSE;
pseudo->dt = TSPseudoTimeStepDefault;
pseudo->fnorm = -1;
ierr = PetscObjectComposeFunction((PetscObject)ts,"TSPseudoSetVerifyTimeStep_C",TSPseudoSetVerifyTimeStep_Pseudo);CHKERRQ(ierr);
ierr = PetscObjectComposeFunction((PetscObject)ts,"TSPseudoSetTimeStepIncrement_C",TSPseudoSetTimeStepIncrement_Pseudo);CHKERRQ(ierr);
ierr = PetscObjectComposeFunction((PetscObject)ts,"TSPseudoSetMaxTimeStep_C",TSPseudoSetMaxTimeStep_Pseudo);CHKERRQ(ierr);
ierr = PetscObjectComposeFunction((PetscObject)ts,"TSPseudoIncrementDtFromInitialDt_C",TSPseudoIncrementDtFromInitialDt_Pseudo);CHKERRQ(ierr);
ierr = PetscObjectComposeFunction((PetscObject)ts,"TSPseudoSetTimeStep_C",TSPseudoSetTimeStep_Pseudo);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* nonlinear solver */
Vec u,r; /* solution, residual vectors */
Mat J,Jmf = PETSC_NULL; /* Jacobian matrices */
PetscInt maxsteps = 1000; /* iterations for convergence */
PetscErrorCode ierr;
DM da;
PetscReal dt;
AppCtx user; /* user-defined work context */
SNES snes;
PetscInt Jtype; /* Jacobian type
0: user provide Jacobian;
1: slow finite difference;
2: fd with coloring; */
PetscInitialize(&argc,&argv,(char *)0,help);
/* Initialize user application context */
user.da = PETSC_NULL;
user.nstencilpts = 5;
user.c = -30.0;
user.boundary = 0; /* 0: Drichlet BC; 1: Neumann BC */
user.viewJacobian = PETSC_FALSE;
ierr = PetscOptionsGetInt(PETSC_NULL,"-nstencilpts",&user.nstencilpts,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-boundary",&user.boundary,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL,"-viewJacobian",&user.viewJacobian);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
if (user.nstencilpts == 5){
ierr = DMDACreate2d(PETSC_COMM_WORLD, DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE,DMDA_STENCIL_STAR,-11,-11,PETSC_DECIDE,PETSC_DECIDE,1,1,PETSC_NULL,PETSC_NULL,&da);CHKERRQ(ierr);
} else if (user.nstencilpts == 9){
ierr = DMDACreate2d(PETSC_COMM_WORLD, DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE,DMDA_STENCIL_BOX,-11,-11,PETSC_DECIDE,PETSC_DECIDE,1,1,PETSC_NULL,PETSC_NULL,&da);CHKERRQ(ierr);
} else {
SETERRQ1(PETSC_COMM_WORLD,PETSC_ERR_SUP,"nstencilpts %d is not supported",user.nstencilpts);
}
user.da = da;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&r);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,r,FormIFunction,&user);CHKERRQ(ierr);
ierr = TSSetDuration(ts,maxsteps,1.0);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(u,&user);CHKERRQ(ierr);
ierr = TSSetSolution(ts,u);CHKERRQ(ierr);
dt = .01;
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set Jacobian evaluation routine
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateMatrix(da,MATAIJ,&J);CHKERRQ(ierr);
Jtype = 0;
ierr = PetscOptionsGetInt(PETSC_NULL, "-Jtype",&Jtype,PETSC_NULL);CHKERRQ(ierr);
if (Jtype == 0){ /* use user provided Jacobian evaluation routine */
if (user.nstencilpts != 5) SETERRQ1(PETSC_COMM_WORLD,PETSC_ERR_SUP,"user Jacobian routine FormIJacobian() does not support nstencilpts=%D",user.nstencilpts);
ierr = TSSetIJacobian(ts,J,J,FormIJacobian,&user);CHKERRQ(ierr);
} else { /* use finite difference Jacobian J as preconditioner and '-snes_mf_operator' for Mat*vec */
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = MatCreateSNESMF(snes,&Jmf);CHKERRQ(ierr);
if (Jtype == 1){ /* slow finite difference J; */
ierr = SNESSetJacobian(snes,Jmf,J,SNESDefaultComputeJacobian,PETSC_NULL);CHKERRQ(ierr);
} else if (Jtype == 2){ /* Use coloring to compute finite difference J efficiently */
ierr = SNESSetJacobian(snes,Jmf,J,SNESDefaultComputeJacobianColor,0);CHKERRQ(ierr);
} else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Jtype is not supported");
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sets various TS parameters from user options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,u);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = MatDestroy(&Jmf);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* nonlinear solver */
Vec u; /* solution, residual vectors */
Mat J; /* Jacobian matrix */
PetscInt steps,maxsteps = 1000; /* iterations for convergence */
PetscErrorCode ierr;
DM da;
MatFDColoring matfdcoloring = PETSC_NULL;
PetscReal ftime,dt;
MonitorCtx usermonitor; /* user-defined monitor context */
AppCtx user; /* user-defined work context */
JacobianType jacType;
PetscInitialize(&argc,&argv,(char *)0,help);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,-11,1,1,PETSC_NULL,&da);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&u);CHKERRQ(ierr);
/* Initialize user application context */
user.c = -30.0;
user.boundary = 0; /* 0: Dirichlet BC; 1: Neumann BC */
user.viewJacobian = PETSC_FALSE;
ierr = PetscOptionsGetInt(PETSC_NULL,"-boundary",&user.boundary,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL,"-viewJacobian",&user.viewJacobian);CHKERRQ(ierr);
usermonitor.drawcontours = PETSC_FALSE;
ierr = PetscOptionsHasName(PETSC_NULL,"-drawcontours",&usermonitor.drawcontours);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSTHETA);CHKERRQ(ierr);
ierr = TSThetaSetTheta(ts,1.0);CHKERRQ(ierr); /* Make the Theta method behave like backward Euler */
ierr = TSSetIFunction(ts,PETSC_NULL,FormIFunction,&user);CHKERRQ(ierr);
ierr = DMCreateMatrix(da,MATAIJ,&J);CHKERRQ(ierr);
jacType = JACOBIAN_ANALYTIC; /* use user-provide Jacobian */
ierr = TSSetIJacobian(ts,J,J,FormIJacobian,&user);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr); /* Use TSGetDM() to access. Setting here allows easy use of geometric multigrid. */
ftime = 1.0;
ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr);
ierr = TSMonitorSet(ts,MyTSMonitor,&usermonitor,PETSC_NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(ts,u,&user);CHKERRQ(ierr);
ierr = TSSetSolution(ts,u);CHKERRQ(ierr);
dt = .01;
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* Use slow fd Jacobian or fast fd Jacobian with colorings.
Note: this requirs snes which is not created until TSSetUp()/TSSetFromOptions() is called */
ierr = PetscOptionsBegin(((PetscObject)da)->comm,PETSC_NULL,"Options for Jacobian evaluation",PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnum("-jac_type","Type of Jacobian","",JacobianTypes,(PetscEnum)jacType,(PetscEnum*)&jacType,0);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
if (jacType == JACOBIAN_FD_COLORING) {
SNES snes;
ISColoring iscoloring;
ierr = DMCreateColoring(da,IS_COLORING_GLOBAL,MATAIJ,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode(*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr);
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESDefaultComputeJacobianColor,matfdcoloring);CHKERRQ(ierr);
} else if (jacType == JACOBIAN_FD_FULL){
SNES snes;
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESDefaultComputeJacobian,&user);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,u,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&J);CHKERRQ(ierr);
if (matfdcoloring) {ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);}
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* nonlinear solver */
Vec u; /* solution, residual vectors */
Mat J; /* Jacobian matrix */
PetscInt maxsteps = 1000; /* iterations for convergence */
PetscInt nsteps;
PetscReal vmin,vmax,norm;
PetscErrorCode ierr;
DM da;
PetscReal ftime,dt;
AppCtx user; /* user-defined work context */
JacobianType jacType;
PetscInitialize(&argc,&argv,(char*)0,help);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,-11,1,1,NULL,&da);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&u);
CHKERRQ(ierr);
/* Initialize user application context */
user.c = -30.0;
user.boundary = 0; /* 0: Dirichlet BC; 1: Neumann BC */
user.viewJacobian = PETSC_FALSE;
ierr = PetscOptionsGetInt(NULL,"-boundary",&user.boundary,NULL);
CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-viewJacobian",&user.viewJacobian);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);
CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);
CHKERRQ(ierr);
ierr = TSSetType(ts,TSTHETA);
CHKERRQ(ierr);
ierr = TSThetaSetTheta(ts,1.0);
CHKERRQ(ierr); /* Make the Theta method behave like backward Euler */
ierr = TSSetIFunction(ts,NULL,FormIFunction,&user);
CHKERRQ(ierr);
ierr = DMSetMatType(da,MATAIJ);
CHKERRQ(ierr);
ierr = DMCreateMatrix(da,&J);
CHKERRQ(ierr);
jacType = JACOBIAN_ANALYTIC; /* use user-provide Jacobian */
ierr = TSSetDM(ts,da);
CHKERRQ(ierr); /* Use TSGetDM() to access. Setting here allows easy use of geometric multigrid. */
ftime = 1.0;
ierr = TSSetDuration(ts,maxsteps,ftime);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(ts,u,&user);
CHKERRQ(ierr);
ierr = TSSetSolution(ts,u);
CHKERRQ(ierr);
dt = .01;
ierr = TSSetInitialTimeStep(ts,0.0,dt);
CHKERRQ(ierr);
/* Use slow fd Jacobian or fast fd Jacobian with colorings.
Note: this requirs snes which is not created until TSSetUp()/TSSetFromOptions() is called */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Options for Jacobian evaluation",NULL);
CHKERRQ(ierr);
ierr = PetscOptionsEnum("-jac_type","Type of Jacobian","",JacobianTypes,(PetscEnum)jacType,(PetscEnum*)&jacType,0);
CHKERRQ(ierr);
ierr = PetscOptionsEnd();
CHKERRQ(ierr);
if (jacType == JACOBIAN_ANALYTIC) {
ierr = TSSetIJacobian(ts,J,J,FormIJacobian,&user);
CHKERRQ(ierr);
} else if (jacType == JACOBIAN_FD_COLORING) {
SNES snes;
ierr = TSGetSNES(ts,&snes);
CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,0);
CHKERRQ(ierr);
} else if (jacType == JACOBIAN_FD_FULL) {
SNES snes;
ierr = TSGetSNES(ts,&snes);
CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefault,&user);
CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Integrate ODE system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,u);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute diagnostics of the solution
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecNorm(u,NORM_1,&norm);
CHKERRQ(ierr);
ierr = VecMax(u,NULL,&vmax);
CHKERRQ(ierr);
ierr = VecMin(u,NULL,&vmin);
CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&nsteps);
CHKERRQ(ierr);
ierr = TSGetTime(ts,&ftime);
CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"timestep %D: time %G, solution norm %G, max %G, min %G\n",nsteps,ftime,norm,vmax,vmin);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&J);
CHKERRQ(ierr);
ierr = VecDestroy(&u);
CHKERRQ(ierr);
ierr = TSDestroy(&ts);
CHKERRQ(ierr);
ierr = DMDestroy(&da);
CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
int time; /* amount of loops */
struct in put;
PetscScalar rh; /* relative humidity */
PetscScalar x; /* memory varialbe for relative humidity calculation */
PetscScalar deep_grnd_temp; /* temperature of ground under top soil surface layer */
PetscScalar emma; /* absorption-emission constant for air */
PetscScalar pressure1 = 101300; /* surface pressure */
PetscScalar mixratio; /* mixing ratio */
PetscScalar airtemp; /* temperature of air near boundary layer inversion */
PetscScalar dewtemp; /* dew point temperature */
PetscScalar sfctemp; /* temperature at surface */
PetscScalar pwat; /* total column precipitable water */
PetscScalar cloudTemp; /* temperature at base of cloud */
AppCtx user; /* user-defined work context */
MonitorCtx usermonitor; /* user-defined monitor context */
PetscMPIInt rank,size;
TS ts;
SNES snes;
DM da;
Vec T,rhs; /* solution vector */
Mat J; /* Jacobian matrix */
PetscReal ftime,dt;
PetscInt steps,dof = 5;
PetscBool use_coloring = PETSC_TRUE;
MatFDColoring matfdcoloring = 0;
PetscBool monitor_off = PETSC_FALSE;
PetscInitialize(&argc,&argv,(char*)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
/* Inputs */
readinput(&put);
sfctemp = put.Ts;
dewtemp = put.Td;
cloudTemp = put.Tc;
airtemp = put.Ta;
pwat = put.pwt;
if (!rank) PetscPrintf(PETSC_COMM_SELF,"Initial Temperature = %g\n",sfctemp); /* input surface temperature */
deep_grnd_temp = sfctemp - 10; /* set underlying ground layer temperature */
emma = emission(pwat); /* accounts for radiative effects of water vapor */
/* Converts from Fahrenheit to Celsuis */
sfctemp = fahr_to_cel(sfctemp);
airtemp = fahr_to_cel(airtemp);
dewtemp = fahr_to_cel(dewtemp);
cloudTemp = fahr_to_cel(cloudTemp);
deep_grnd_temp = fahr_to_cel(deep_grnd_temp);
/* Converts from Celsius to Kelvin */
sfctemp += 273;
airtemp += 273;
dewtemp += 273;
cloudTemp += 273;
deep_grnd_temp += 273;
/* Calculates initial relative humidity */
x = calcmixingr(dewtemp,pressure1);
mixratio = calcmixingr(sfctemp,pressure1);
rh = (x/mixratio)*100;
if (!rank) printf("Initial RH = %.1f percent\n\n",rh); /* prints initial relative humidity */
time = 3600*put.time; /* sets amount of timesteps to run model */
/* Configure PETSc TS solver */
/*------------------------------------------*/
/* Create grid */
ierr = DMDACreate2d(PETSC_COMM_WORLD,DMDA_BOUNDARY_PERIODIC,DMDA_BOUNDARY_PERIODIC,DMDA_STENCIL_STAR,-20,-20,
PETSC_DECIDE,PETSC_DECIDE,dof,1,NULL,NULL,&da);CHKERRQ(ierr);
ierr = DMDASetUniformCoordinates(da, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0);CHKERRQ(ierr);
/* Define output window for each variable of interest */
ierr = DMDASetFieldName(da,0,"Ts");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,1,"Ta");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,2,"u");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,3,"v");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,4,"p");CHKERRQ(ierr);
/* set values for appctx */
user.da = da;
user.Ts = sfctemp;
user.fract = put.fr; /* fraction of sky covered by clouds */
user.dewtemp = dewtemp; /* dew point temperature (mositure in air) */
user.csoil = 2000000; /* heat constant for layer */
user.dzlay = 0.08; /* thickness of top soil layer */
user.emma = emma; /* emission parameter */
user.wind = put.wnd; /* wind spped */
user.pressure1 = pressure1; /* sea level pressure */
user.airtemp = airtemp; /* temperature of air near boundar layer inversion */
user.Tc = cloudTemp; /* temperature at base of lowest cloud layer */
user.init = put.init; /* user chosen initiation scenario */
user.lat = 70*0.0174532; /* converts latitude degrees to latitude in radians */
user.deep_grnd_temp = deep_grnd_temp; /* temp in lowest ground layer */
/* set values for MonitorCtx */
usermonitor.drawcontours = PETSC_FALSE;
ierr = PetscOptionsHasName(NULL,"-drawcontours",&usermonitor.drawcontours);CHKERRQ(ierr);
if (usermonitor.drawcontours) {
PetscReal bounds[] = {1000.0,-1000., -1000.,-1000., 1000.,-1000., 1000.,-1000., 1000,-1000, 100700,100800};
ierr = PetscViewerDrawOpen(PETSC_COMM_WORLD,0,0,0,0,300,300,&usermonitor.drawviewer);CHKERRQ(ierr);
ierr = PetscViewerDrawSetBounds(usermonitor.drawviewer,dof,bounds);CHKERRQ(ierr);
}
usermonitor.interval = 1;
ierr = PetscOptionsGetInt(NULL,"-monitor_interval",&usermonitor.interval,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DA;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&T);CHKERRQ(ierr);
ierr = VecDuplicate(T,&rhs);CHKERRQ(ierr); /* r: vector to put the computed right hand side */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,rhs,RhsFunc,&user);CHKERRQ(ierr);
/* Set Jacobian evaluation routine - use coloring to compute finite difference Jacobian efficiently */
ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr);
ierr = DMCreateMatrix(da,&J);CHKERRQ(ierr);
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
if (use_coloring) {
ISColoring iscoloring;
ierr = DMCreateColoring(da,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(J,iscoloring,matfdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode (*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,matfdcoloring);CHKERRQ(ierr);
} else {
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefault,NULL);CHKERRQ(ierr);
}
/* Define what to print for ts_monitor option */
ierr = PetscOptionsHasName(NULL,"-monitor_off",&monitor_off);CHKERRQ(ierr);
if (!monitor_off) {
ierr = TSMonitorSet(ts,Monitor,&usermonitor,NULL);CHKERRQ(ierr);
}
ierr = FormInitialSolution(da,T,&user);CHKERRQ(ierr);
dt = TIMESTEP; /* initial time step */
ftime = TIMESTEP*time;
if (!rank) printf("time %d, ftime %g hour, TIMESTEP %g\n",time,ftime/3600,dt);
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetDuration(ts,time,ftime);CHKERRQ(ierr);
ierr = TSSetSolution(ts,T);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,T);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
if (!rank) PetscPrintf(PETSC_COMM_WORLD,"Solution T after %g hours %d steps\n",ftime/3600,steps);
if (matfdcoloring) {ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);}
if (usermonitor.drawcontours) {
ierr = PetscViewerDestroy(&usermonitor.drawviewer);CHKERRQ(ierr);
}
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = VecDestroy(&T);CHKERRQ(ierr);
ierr = VecDestroy(&rhs);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
PetscFinalize();
return 0;
}
int main(int argc,char **argv)
{
TS ts; /* nonlinear solver */
Vec x,r; /* solution, residual vectors */
Mat J; /* Jacobian matrix */
PetscInt steps,Mx,maxsteps = 10000000;
PetscErrorCode ierr;
DM da;
MatFDColoring matfdcoloring;
ISColoring iscoloring;
PetscReal dt;
PetscReal vbounds[] = {-100000,100000,-1.1,1.1};
PetscBool wait;
Vec ul,uh;
SNES snes;
UserCtx ctx;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ctx.kappa = 1.0;
ierr = PetscOptionsGetReal(NULL,"-kappa",&ctx.kappa,NULL);CHKERRQ(ierr);
ctx.cahnhillard = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,NULL,"-cahn-hillard",&ctx.cahnhillard,NULL);CHKERRQ(ierr);
ierr = PetscViewerDrawSetBounds(PETSC_VIEWER_DRAW_(PETSC_COMM_WORLD),2,vbounds);CHKERRQ(ierr);
ierr = PetscViewerDrawResize(PETSC_VIEWER_DRAW_(PETSC_COMM_WORLD),600,600);CHKERRQ(ierr);
ctx.energy = 1;
/* ierr = PetscOptionsGetInt(NULL,NULL,"-energy",&ctx.energy,NULL);CHKERRQ(ierr); */
ierr = PetscOptionsGetInt(NULL,NULL,"-energy",&ctx.energy,NULL);CHKERRQ(ierr);
ctx.tol = 1.0e-8;
ierr = PetscOptionsGetReal(NULL,"-tol",&ctx.tol,NULL);CHKERRQ(ierr);
ctx.theta = .001;
ctx.theta_c = 1.0;
ierr = PetscOptionsGetReal(NULL,"-theta",&ctx.theta,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-theta_c",&ctx.theta_c,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate1d(PETSC_COMM_WORLD, DM_BOUNDARY_PERIODIC, -10,2,2,NULL,&da);CHKERRQ(ierr);
ierr = DMSetFromOptions(da);CHKERRQ(ierr);
ierr = DMSetUp(da);CHKERRQ(ierr);
ierr = DMDASetFieldName(da,0,"Biharmonic heat equation: w = -kappa*u_xx");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,1,"Biharmonic heat equation: u");CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&Mx,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
dt = 1.0/(10.*ctx.kappa*Mx*Mx*Mx*Mx);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA; then duplicate for remaining
vectors that are the same types
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&r);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,FormFunction,&ctx);CHKERRQ(ierr);
ierr = TSSetDuration(ts,maxsteps,.02);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create matrix data structure; set Jacobian evaluation routine
< Set Jacobian matrix data structure and default Jacobian evaluation
routine. User can override with:
-snes_mf : matrix-free Newton-Krylov method with no preconditioning
(unless user explicitly sets preconditioner)
-snes_mf_operator : form preconditioning matrix as set by the user,
but use matrix-free approx for Jacobian-vector
products within Newton-Krylov method
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = DMCreateColoring(da,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr);
ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr);
ierr = DMCreateMatrix(da,&J);CHKERRQ(ierr);
ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode (*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(J,iscoloring,matfdcoloring);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,matfdcoloring);CHKERRQ(ierr);
{
ierr = VecDuplicate(x,&ul);CHKERRQ(ierr);
ierr = VecDuplicate(x,&uh);CHKERRQ(ierr);
ierr = VecStrideSet(ul,0,PETSC_NINFINITY);CHKERRQ(ierr);
ierr = VecStrideSet(ul,1,-1.0);CHKERRQ(ierr);
ierr = VecStrideSet(uh,0,PETSC_INFINITY);CHKERRQ(ierr);
ierr = VecStrideSet(uh,1,1.0);CHKERRQ(ierr);
ierr = TSVISetVariableBounds(ts,ul,uh);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Customize nonlinear solver
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(da,x,ctx.kappa);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,x);CHKERRQ(ierr);
wait = PETSC_FALSE;
ierr = PetscOptionsGetBool(NULL,NULL,"-wait",&wait,NULL);CHKERRQ(ierr);
if (wait) {
ierr = PetscSleep(-1);CHKERRQ(ierr);
}
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
{
ierr = VecDestroy(&ul);CHKERRQ(ierr);
ierr = VecDestroy(&uh);CHKERRQ(ierr);
}
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
static PetscErrorCode TSStep_EIMEX(TS ts)
{
TS_EIMEX *ext = (TS_EIMEX*)ts->data;
const PetscInt ns = ext->nstages;
Vec *T=ext->T, Y=ext->Y;
SNES snes;
PetscInt i,j;
PetscBool accept = PETSC_FALSE;
PetscErrorCode ierr;
PetscReal alpha,local_error;
PetscFunctionBegin;
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESSetType(snes,"ksponly"); CHKERRQ(ierr);
ext->status = TS_STEP_INCOMPLETE;
ierr = VecCopy(ts->vec_sol,ext->VecSolPrev);CHKERRQ(ierr);
/* Apply n_j steps of the base method to obtain solutions of T(j,1),1<=j<=s */
for(j=0; j<ns; j++){
ierr = TSStage_EIMEX(ts,j);CHKERRQ(ierr);
ierr = VecCopy(Y,T[j]); CHKERRQ(ierr);
}
for(i=1;i<ns;i++){
for(j=i;j<ns;j++){
alpha = -(PetscReal)ext->N[j]/ext->N[j-i];
ierr = VecAXPBYPCZ(T[Map(j,i,ns)],alpha,1.0,0,T[Map(j,i-1,ns)],T[Map(j-1,i-1,ns)]);/* T[j][i]=alpha*T[j][i-1]+T[j-1][i-1] */CHKERRQ(ierr);
alpha = 1.0/(1.0 + alpha);
ierr = VecScale(T[Map(j,i,ns)],alpha);CHKERRQ(ierr);
}
}
ierr = TSEvaluateStep(ts,ns,ts->vec_sol,NULL);CHKERRQ(ierr);/*update ts solution */
if(ext->ord_adapt && ext->nstages < ext->max_rows){
accept = PETSC_FALSE;
while(!accept && ext->nstages < ext->max_rows){
ierr = TSErrorWeightedNorm(ts,ts->vec_sol,T[Map(ext->nstages-1,ext->nstages-2,ext->nstages)],ts->adapt->wnormtype,&local_error);CHKERRQ(ierr);
accept = (local_error < 1.0)? PETSC_TRUE : PETSC_FALSE;
if(!accept){/* add one more stage*/
ierr = TSStage_EIMEX(ts,ext->nstages);CHKERRQ(ierr);
ext->nstages++; ext->row_ind++; ext->col_ind++;
/*T table need to be recycled*/
ierr = VecDuplicateVecs(ts->vec_sol,(1+ext->nstages)*ext->nstages/2,&ext->T);CHKERRQ(ierr);
for(i=0; i<ext->nstages-1; i++){
for(j=0; j<=i; j++){
ierr = VecCopy(T[Map(i,j,ext->nstages-1)],ext->T[Map(i,j,ext->nstages)]);CHKERRQ(ierr);
}
}
ierr = VecDestroyVecs(ext->nstages*(ext->nstages-1)/2,&T);CHKERRQ(ierr);
T = ext->T; /*reset the pointer*/
/*recycling finished, store the new solution*/
ierr = VecCopy(Y,T[ext->nstages-1]); CHKERRQ(ierr);
/*extrapolation for the newly added stage*/
for(i=1;i<ext->nstages;i++){
alpha = -(PetscReal)ext->N[ext->nstages-1]/ext->N[ext->nstages-1-i];
ierr = VecAXPBYPCZ(T[Map(ext->nstages-1,i,ext->nstages)],alpha,1.0,0,T[Map(ext->nstages-1,i-1,ext->nstages)],T[Map(ext->nstages-1-1,i-1,ext->nstages)]);/*T[ext->nstages-1][i]=alpha*T[ext->nstages-1][i-1]+T[ext->nstages-1-1][i-1]*/CHKERRQ(ierr);
alpha = 1.0/(1.0 + alpha);
ierr = VecScale(T[Map(ext->nstages-1,i,ext->nstages)],alpha);CHKERRQ(ierr);
}
/*update ts solution */
ierr = TSEvaluateStep(ts,ext->nstages,ts->vec_sol,NULL);CHKERRQ(ierr);
}/*end if !accept*/
}/*end while*/
if(ext->nstages == ext->max_rows){
ierr = PetscInfo(ts,"Max number of rows has been used\n");CHKERRQ(ierr);
}
}/*end if ext->ord_adapt*/
ts->ptime += ts->time_step;
ext->status = TS_STEP_COMPLETE;
if (ext->status != TS_STEP_COMPLETE && !ts->reason) ts->reason = TS_DIVERGED_STEP_REJECTED;
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* time integrator */
SNES snes; /* nonlinear solver */
SNESLineSearch linesearch; /* line search */
Vec X; /* solution, residual vectors */
Mat J; /* Jacobian matrix */
PetscInt steps,maxsteps,mx;
PetscErrorCode ierr;
DM da;
PetscReal ftime,dt;
struct _User user; /* user-defined work context */
TSConvergedReason reason;
PetscInitialize(&argc,&argv,(char*)0,help);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,-11,2,2,NULL,&da);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&X);CHKERRQ(ierr);
/* Initialize user application context */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Advection-reaction options","");
{
user.a[0] = 1; ierr = PetscOptionsReal("-a0","Advection rate 0","",user.a[0],&user.a[0],NULL);CHKERRQ(ierr);
user.a[1] = 0; ierr = PetscOptionsReal("-a1","Advection rate 1","",user.a[1],&user.a[1],NULL);CHKERRQ(ierr);
user.k[0] = 1e6; ierr = PetscOptionsReal("-k0","Reaction rate 0","",user.k[0],&user.k[0],NULL);CHKERRQ(ierr);
user.k[1] = 2*user.k[0]; ierr = PetscOptionsReal("-k1","Reaction rate 1","",user.k[1],&user.k[1],NULL);CHKERRQ(ierr);
user.s[0] = 0; ierr = PetscOptionsReal("-s0","Source 0","",user.s[0],&user.s[0],NULL);CHKERRQ(ierr);
user.s[1] = 1; ierr = PetscOptionsReal("-s1","Source 1","",user.s[1],&user.s[1],NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
ierr = TSSetType(ts,TSARKIMEX);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,FormRHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,FormIFunction,&user);CHKERRQ(ierr);
ierr = DMCreateMatrix(da,MATAIJ,&J);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,J,J,FormIJacobian,&user);CHKERRQ(ierr);
/* A line search in the nonlinear solve can fail due to ill-conditioning unless an absolute tolerance is set. Since
* this problem is linear, we deactivate the line search. For a linear problem, it is usually recommended to also use
* SNESSetType(snes,SNESKSPONLY). */
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetLineSearch(snes,&linesearch);CHKERRQ(ierr);
ierr = SNESLineSearchSetType(linesearch,SNESLINESEARCHBASIC);CHKERRQ(ierr);
ftime = 1.0;
maxsteps = 10000;
ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(ts,X,&user);CHKERRQ(ierr);
ierr = TSSetSolution(ts,X);CHKERRQ(ierr);
ierr = VecGetSize(X,&mx);CHKERRQ(ierr);
dt = .1 * PetscMax(user.a[0],user.a[1]) / mx; /* Advective CFL, I don't know why it needs so much safety factor. */
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,X);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
ierr = TSGetConvergedReason(ts,&reason);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"%s at time %G after %D steps\n",TSConvergedReasons[reason],ftime,steps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec U; /* solution will be stored here */
Mat A; /* Jacobian matrix */
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt n = 2;
AppCtx user;
PetscScalar *u;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs");
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatGetVecs(A,&U,PETSC_NULL);CHKERRQ(ierr);
/* Create wind speed data using Weibull distribution */
ierr = WindSpeeds(&user);CHKERRQ(ierr);
/* Set parameters for wind turbine and induction generator */
ierr = SetWindTurbineParams(&user);CHKERRQ(ierr);
ierr = SetInductionGeneratorParams(&user);CHKERRQ(ierr);
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = vwa;
u[1] = s;
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
/* Create matrix to save solutions at each time step */
user.stepnum = 0;
ierr = MatCreateSeqDense(PETSC_COMM_SELF,3,2010,PETSC_NULL,&user.Sol);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,PETSC_NULL,(TSIFunction) IFunction,&user);CHKERRQ(ierr);
SNES snes;
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,A,A,SNESDefaultComputeJacobian,PETSC_NULL);CHKERRQ(ierr);
/* ierr = TSSetIJacobian(ts,A,A,(TSIJacobian)IJacobian,&user);CHKERRQ(ierr); */
ierr = TSSetApplicationContext(ts,&user);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSolution(ts,U);CHKERRQ(ierr);
/* Save initial solution */
PetscScalar *x,*mat;
PetscInt idx=3*user.stepnum;
ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr);
ierr = VecGetArray(U,&x);CHKERRQ(ierr);
mat[idx] = 0.0;
ierr = PetscMemcpy(mat+idx+1,x,2*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr);
ierr = VecRestoreArray(U,&x);CHKERRQ(ierr);
user.stepnum++;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetDuration(ts,2000,20.0);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSetPostStep(ts,SaveSolution);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,U);CHKERRQ(ierr);
Mat B;
PetscScalar *amat;
ierr = MatCreateSeqDense(PETSC_COMM_SELF,3,user.stepnum,PETSC_NULL,&B);CHKERRQ(ierr);
ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr);
ierr = MatDenseGetArray(B,&amat);CHKERRQ(ierr);
ierr = PetscMemcpy(amat,mat,user.stepnum*3*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = MatDenseRestoreArray(B,&amat);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr);
PetscViewer viewer;
ierr = PetscViewerBinaryOpen(PETSC_COMM_SELF,"out.bin",FILE_MODE_WRITE,&viewer);CHKERRQ(ierr);
ierr = MatView(B,viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = MatDestroy(&user.Sol);CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecDestroy(&user.wind_data);CHKERRQ(ierr);
ierr = VecDestroy(&user.t_wind);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInt time_steps=100,iout,NOUT=1;
PetscMPIInt size;
Vec global;
PetscReal dt,ftime,ftime_original;
TS ts;
PetscViewer viewfile;
Mat J = 0;
Vec x;
Data data;
PetscInt mn;
PetscBool flg;
MatColoring mc;
ISColoring iscoloring;
MatFDColoring matfdcoloring = 0;
PetscBool fd_jacobian_coloring = PETSC_FALSE;
SNES snes;
KSP ksp;
PC pc;
PetscViewer viewer;
char pcinfo[120],tsinfo[120];
TSType tstype;
PetscBool sundials;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
/* set data */
data.m = 9;
data.n = 9;
data.a = 1.0;
data.epsilon = 0.1;
data.dx = 1.0/(data.m+1.0);
data.dy = 1.0/(data.n+1.0);
mn = (data.m)*(data.n);
ierr = PetscOptionsGetInt(NULL,"-time",&time_steps,NULL);CHKERRQ(ierr);
/* set initial conditions */
ierr = VecCreate(PETSC_COMM_WORLD,&global);CHKERRQ(ierr);
ierr = VecSetSizes(global,PETSC_DECIDE,mn);CHKERRQ(ierr);
ierr = VecSetFromOptions(global);CHKERRQ(ierr);
ierr = Initial(global,&data);CHKERRQ(ierr);
ierr = VecDuplicate(global,&x);CHKERRQ(ierr);
/* create timestep context */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSMonitorSet(ts,Monitor,&data,NULL);CHKERRQ(ierr);
#if defined(PETSC_HAVE_SUNDIALS)
ierr = TSSetType(ts,TSSUNDIALS);CHKERRQ(ierr);
#else
ierr = TSSetType(ts,TSEULER);CHKERRQ(ierr);
#endif
dt = 0.1;
ftime_original = data.tfinal = 1.0;
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetDuration(ts,time_steps,ftime_original);CHKERRQ(ierr);
ierr = TSSetSolution(ts,global);CHKERRQ(ierr);
/* set user provided RHSFunction and RHSJacobian */
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&data);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr);
ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,mn,mn);CHKERRQ(ierr);
ierr = MatSetFromOptions(J);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(J,5,NULL);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(J,5,NULL,5,NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-ts_fd",&flg);CHKERRQ(ierr);
if (!flg) {
ierr = TSSetRHSJacobian(ts,J,J,RHSJacobian,&data);CHKERRQ(ierr);
} else {
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-fd_color",&fd_jacobian_coloring);CHKERRQ(ierr);
if (fd_jacobian_coloring) { /* Use finite differences with coloring */
/* Get data structure of J */
PetscBool pc_diagonal;
ierr = PetscOptionsHasName(NULL,"-pc_diagonal",&pc_diagonal);CHKERRQ(ierr);
if (pc_diagonal) { /* the preconditioner of J is a diagonal matrix */
PetscInt rstart,rend,i;
PetscScalar zero=0.0;
ierr = MatGetOwnershipRange(J,&rstart,&rend);CHKERRQ(ierr);
for (i=rstart; i<rend; i++) {
ierr = MatSetValues(J,1,&i,1,&i,&zero,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
} else {
/* Fill the structure using the expensive SNESComputeJacobianDefault. Temporarily set up the TS so we can call this function */
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
ierr = TSSetUp(ts);CHKERRQ(ierr);
ierr = SNESComputeJacobianDefault(snes,x,J,J,ts);CHKERRQ(ierr);
}
/* create coloring context */
ierr = MatColoringCreate(J,&mc);CHKERRQ(ierr);
ierr = MatColoringSetType(mc,MATCOLORINGSL);CHKERRQ(ierr);
ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr);
ierr = MatColoringApply(mc,&iscoloring);CHKERRQ(ierr);
ierr = MatColoringDestroy(&mc);CHKERRQ(ierr);
ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode (*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(J,iscoloring,matfdcoloring);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,matfdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
} else { /* Use finite differences (slow) */
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefault,NULL);CHKERRQ(ierr);
}
}
/* Pick up a Petsc preconditioner */
/* one can always set method or preconditioner during the run time */
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSetUp(ts);CHKERRQ(ierr);
/* Test TSSetPostStep() */
ierr = PetscOptionsHasName(NULL,"-test_PostStep",&flg);CHKERRQ(ierr);
if (flg) {
ierr = TSSetPostStep(ts,PostStep);CHKERRQ(ierr);
}
ierr = PetscOptionsGetInt(NULL,"-NOUT",&NOUT,NULL);CHKERRQ(ierr);
for (iout=1; iout<=NOUT; iout++) {
ierr = TSSetDuration(ts,time_steps,iout*ftime_original/NOUT);CHKERRQ(ierr);
ierr = TSSolve(ts,global);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,ftime,dt);CHKERRQ(ierr);
}
/* Interpolate solution at tfinal */
ierr = TSGetSolution(ts,&global);CHKERRQ(ierr);
ierr = TSInterpolate(ts,ftime_original,global);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-matlab_view",&flg);CHKERRQ(ierr);
if (flg) { /* print solution into a MATLAB file */
ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,"out.m",&viewfile);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(viewfile,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
ierr = VecView(global,viewfile);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewfile);CHKERRQ(ierr);
}
/* display solver info for Sundials */
ierr = TSGetType(ts,&tstype);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)ts,TSSUNDIALS,&sundials);CHKERRQ(ierr);
if (sundials) {
ierr = PetscViewerStringOpen(PETSC_COMM_WORLD,tsinfo,120,&viewer);CHKERRQ(ierr);
ierr = TSView(ts,viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = PetscViewerStringOpen(PETSC_COMM_WORLD,pcinfo,120,&viewer);CHKERRQ(ierr);
ierr = PCView(pc,viewer);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"%d Procs,%s TSType, %s Preconditioner\n",size,tsinfo,pcinfo);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
/* free the memories */
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = VecDestroy(&global);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
if (fd_jacobian_coloring) {ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);}
ierr = PetscFinalize();
return 0;
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
DM da; /* structured grid topology object */
TS ts; /* time-stepping object (contains snes) */
SNES snes; /* Newton solver object */
Vec X,residual; /* solution, residual */
Mat J; /* Jacobian matrix */
PetscInt Mx,My,fsteps,steps;
ISColoring iscoloring;
PetscReal tstart,tend,ftime,secperday=3600.0*24.0,Y0;
PetscBool fdflg = PETSC_FALSE, mfileflg = PETSC_FALSE, optflg = PETSC_FALSE;
char mfile[PETSC_MAX_PATH_LEN] = "out.m";
MatFDColoring matfdcoloring;
PorousCtx user; /* user-defined work context */
PetscInitialize(&argc,&argv,(char *)0,help);
ierr = DMDACreate2d(PETSC_COMM_WORLD,
DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE, // correct for zero Dirichlet
DMDA_STENCIL_STAR, // nonlinear diffusion but diffusivity
// depends on soln W not grad W
-21,-21, // default to 20x20 grid but override with
// -da_grid_x, -da_grid_y (or -da_refine)
PETSC_DECIDE,PETSC_DECIDE, // num of procs in each dim
2, // dof = 2: node = (W,Y)
// or node = (P,dPsqr)
// or node = (ddxE,ddyN)
1, // s = 1 (stencil extends out one cell)
PETSC_NULL,PETSC_NULL, // no specify proc decomposition
&da);CHKERRQ(ierr);
ierr = DMSetApplicationContext(da,&user);CHKERRQ(ierr);
/* get Vecs and Mats for this grid */
ierr = DMCreateGlobalVector(da,&X);CHKERRQ(ierr);
ierr = VecDuplicate(X,&residual);CHKERRQ(ierr);
ierr = VecDuplicate(X,&user.geom);CHKERRQ(ierr);
ierr = DMGetMatrix(da,MATAIJ,&J);CHKERRQ(ierr);
/* set up contexts */
tstart = 10.0 * secperday; /* 10 days in seconds */
tend = 30.0 * secperday;
steps = 20;
Y0 = 1.0; /* initial value of Y, for computing initial
value of P; note Ymin = 0.1 is different */
user.da = da;
ierr = DefaultContext(&user);CHKERRQ(ierr);
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,
"","options to (W,P)-space better hydrology model alt","");CHKERRQ(ierr);
{
ierr = PetscOptionsReal("-alt_sigma","nonlinear power","",
user.sigma,&user.sigma,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_Ymin",
"min capacity thickness (esp. in pressure computation)","",
user.Ymin,&user.Ymin,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_Wmin",
"min water amount (esp. in pressure computation)","",
user.Wmin,&user.Wmin,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_Y0",
"constant initial capacity thickness","",
Y0,&Y0,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_Cmelt",
"additional coefficient for amount of melt","",
user.Cmelt,&user.Cmelt,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_Creep",
"creep closure coefficient","",
user.Creep,&user.Creep,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_L","half-width of square region in meters","",
user.L,&user.L,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alt_tstart_days","start time in days","",
tstart/secperday,&tstart,&optflg);CHKERRQ(ierr);
if (optflg) { tstart *= secperday; }
ierr = PetscOptionsReal("-alt_tend_days","end time in days","",
tend/secperday,&tend,&optflg);CHKERRQ(ierr);
if (optflg) { tend *= secperday; }
ierr = PetscOptionsInt("-alt_steps","number of timesteps to take","",
steps,&steps,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-alt_converge_check",
"run silent and check for convergence",
"",user.run_silent,&user.run_silent,PETSC_NULL);
CHKERRQ(ierr);
ierr = PetscOptionsString("-mfile",
"name of Matlab file to write results","",
mfile,mfile,PETSC_MAX_PATH_LEN,&mfileflg);
CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* fix remaining parameters */
ierr = DerivedConstants(&user);CHKERRQ(ierr);
ierr = VecStrideSet(user.geom,0,user.H0);CHKERRQ(ierr); /* H(x,y) = H0 */
ierr = VecStrideSet(user.geom,1,0.0);CHKERRQ(ierr); /* b(x,y) = 0 */
ierr = DMDASetUniformCoordinates(da, // square domain
-user.L, user.L, -user.L, user.L, 0.0, 1.0);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
user.dx = 2.0 * user.L / (Mx-1);
user.dy = 2.0 * user.L / (My-1);
/* setup TS = timestepping object */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,residual,RHSFunction,&user);CHKERRQ(ierr);
/* use coloring to compute rhs Jacobian efficiently */
ierr = PetscOptionsGetBool(PETSC_NULL,"-fd",&fdflg,PETSC_NULL);CHKERRQ(ierr);
if (fdflg){
ierr = DMGetColoring(da,IS_COLORING_GLOBAL,MATAIJ,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(matfdcoloring,
(PetscErrorCode (*)(void))RHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,J,J,TSDefaultComputeJacobianColor,
matfdcoloring);CHKERRQ(ierr);
} else { /* default case */
ierr = TSSetRHSJacobian(ts,J,J,RHSJacobian,&user);CHKERRQ(ierr);
}
/* set initial state: W = barenblatt, P = pi (W/Y0)^sigma */
ierr = InitialState(da,&user,tstart,Y0,X);CHKERRQ(ierr);
/* set up times for time-stepping */
ierr = TSSetInitialTimeStep(ts,tstart,
(tend - tstart) / (PetscReal)steps);CHKERRQ(ierr);
ierr = TSSetDuration(ts,steps,tend);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,PETSC_TRUE);CHKERRQ(ierr);
ierr = TSMonitorSet(ts,MyTSMonitor,&user,PETSC_NULL);CHKERRQ(ierr);
/* Set SNESVI type and supply upper and lower bounds. */
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESVISetComputeVariableBounds(snes,FormPositivityBounds);
CHKERRQ(ierr);
/* ask user to finalize settings */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* report on setup */
if (!user.run_silent) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
"setup done: square side length = %.3f km\n"
" grid Mx,My = %d,%d\n"
" spacing dx,dy = %.3f,%.3f m\n"
" times tstart:dt:tend = %.3f:%.3f:%.3f days\n",
2.0 * user.L / 1000.0, Mx, My, user.dx, user.dy,
tstart / secperday, (tend-tstart)/(steps*secperday), tend / secperday);
CHKERRQ(ierr);
}
if (mfileflg) {
if (!user.run_silent) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
"writing initial W,P and geometry H,b to Matlab file %s ...\n",
mfile);CHKERRQ(ierr);
}
ierr = print2vecmatlab(da,X,"W_init","P_init",mfile,PETSC_FALSE);CHKERRQ(ierr);
ierr = print2vecmatlab(da,user.geom,"H","b",mfile,PETSC_TRUE);CHKERRQ(ierr);
}
/* run time-stepping with implicit steps */
ierr = TSSolve(ts,X,&ftime);CHKERRQ(ierr);
/* make a report on run and final state */
ierr = TSGetTimeStepNumber(ts,&fsteps);CHKERRQ(ierr);
if ((!user.run_silent) && (ftime != tend)) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
"***WARNING3***: reported final time wrong: ftime(=%.12e) != tend(=%.12e) (days)\n",
ftime / secperday, tend / secperday);CHKERRQ(ierr); }
if ((!user.run_silent) && (fsteps != steps)) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
"***WARNING4***: reported number of steps wrong: fsteps(=%D) != steps(=%D)\n",
fsteps, steps);CHKERRQ(ierr); }
if (mfileflg) {
if (!user.run_silent) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
"writing final fields to %s ...\n",mfile);CHKERRQ(ierr);
}
ierr = print2vecmatlab(da,X,"W_final","P_final",mfile,PETSC_TRUE);CHKERRQ(ierr);
ierr = printfigurematlab(da,2,"W_init","W_final",mfile,PETSC_TRUE);CHKERRQ(ierr);
ierr = printfigurematlab(da,3,"P_init","P_final",mfile,PETSC_TRUE);CHKERRQ(ierr);
}
if (user.run_silent) {
ierr = PetscPrintf(PETSC_COMM_WORLD, "%6d %6d %9.3f %.12e\n",
Mx, My, (tend-tstart)/secperday, user.maxrnorm);CHKERRQ(ierr);
}
/* Free work space. */
ierr = MatDestroy(&J);CHKERRQ(ierr);
if (fdflg) { ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr); }
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&user.geom);CHKERRQ(ierr);
ierr = VecDestroy(&residual);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
PetscFunctionReturn((PetscInt)(user.not_converged_warning));
}
PetscErrorCode TSMonitorSPEig(TS ts,PetscInt step,PetscReal ptime,Vec v,void *monctx)
{
TSMonitorSPEigCtx ctx = (TSMonitorSPEigCtx) monctx;
PetscErrorCode ierr;
KSP ksp = ctx->ksp;
PetscInt n,N,nits,neig,i,its = 200;
PetscReal *r,*c,time_step_save;
PetscDrawSP drawsp = ctx->drawsp;
Mat A,B;
Vec xdot;
SNES snes;
PetscFunctionBegin;
if (!step) PetscFunctionReturn(0);
if (((ctx->howoften > 0) && (!(step % ctx->howoften))) || ((ctx->howoften == -1) && ts->reason)) {
ierr = VecDuplicate(v,&xdot);CHKERRQ(ierr);
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetJacobian(snes,&A,&B,NULL,NULL);CHKERRQ(ierr);
ierr = MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&B);CHKERRQ(ierr);
/*
This doesn't work because methods keep and use internal information about the shift so it
seems we would need code for each method to trick the correct Jacobian in being computed.
*/
time_step_save = ts->time_step;
ts->time_step = PETSC_MAX_REAL;
ierr = SNESComputeJacobian(snes,v,A,B);CHKERRQ(ierr);
ts->time_step = time_step_save;
ierr = KSPSetOperators(ksp,B,B);CHKERRQ(ierr);
ierr = VecGetSize(v,&n);CHKERRQ(ierr);
if (n < 200) its = n;
ierr = KSPSetTolerances(ksp,1.e-10,PETSC_DEFAULT,PETSC_DEFAULT,its);CHKERRQ(ierr);
ierr = VecSetRandom(xdot,ctx->rand);CHKERRQ(ierr);
ierr = KSPSolve(ksp,xdot,xdot);CHKERRQ(ierr);
ierr = VecDestroy(&xdot);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&nits);CHKERRQ(ierr);
N = nits+2;
if (nits) {
PetscDraw draw;
PetscReal pause;
PetscDrawAxis axis;
PetscReal xmin,xmax,ymin,ymax;
ierr = PetscDrawSPReset(drawsp);CHKERRQ(ierr);
ierr = PetscDrawSPSetLimits(drawsp,ctx->xmin,ctx->xmax,ctx->ymin,ctx->ymax);CHKERRQ(ierr);
ierr = PetscMalloc2(PetscMax(n,N),&r,PetscMax(n,N),&c);CHKERRQ(ierr);
if (ctx->computeexplicitly) {
ierr = KSPComputeEigenvaluesExplicitly(ksp,n,r,c);CHKERRQ(ierr);
neig = n;
} else {
ierr = KSPComputeEigenvalues(ksp,N,r,c,&neig);CHKERRQ(ierr);
}
/* We used the positive operator to be able to reuse KSPs that require positive definiteness, now flip the spectrum as is conventional for ODEs */
for (i=0; i<neig; i++) r[i] = -r[i];
for (i=0; i<neig; i++) {
if (ts->ops->linearstability) {
PetscReal fr,fi;
ierr = TSComputeLinearStability(ts,r[i],c[i],&fr,&fi);CHKERRQ(ierr);
if ((fr*fr + fi*fi) > 1.0) {
ierr = PetscPrintf(ctx->comm,"Linearized Eigenvalue %g + %g i linear stability function %g norm indicates unstable scheme \n",(double)r[i],(double)c[i],(double)(fr*fr + fi*fi));CHKERRQ(ierr);
}
}
ierr = PetscDrawSPAddPoint(drawsp,r+i,c+i);CHKERRQ(ierr);
}
ierr = PetscFree2(r,c);CHKERRQ(ierr);
ierr = PetscDrawSPGetDraw(drawsp,&draw);CHKERRQ(ierr);
ierr = PetscDrawGetPause(draw,&pause);CHKERRQ(ierr);
ierr = PetscDrawSetPause(draw,0.0);CHKERRQ(ierr);
ierr = PetscDrawSPDraw(drawsp,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscDrawSetPause(draw,pause);CHKERRQ(ierr);
if (ts->ops->linearstability) {
ierr = PetscDrawSPGetAxis(drawsp,&axis);CHKERRQ(ierr);
ierr = PetscDrawAxisGetLimits(axis,&xmin,&xmax,&ymin,&ymax);CHKERRQ(ierr);
ierr = PetscDrawIndicatorFunction(draw,xmin,xmax,ymin,ymax,PETSC_DRAW_CYAN,(PetscErrorCode (*)(void*,PetscReal,PetscReal,PetscBool*))TSLinearStabilityIndicator,ts);CHKERRQ(ierr);
ierr = PetscDrawSPDraw(drawsp,PETSC_FALSE);CHKERRQ(ierr);
}
}
ierr = MatDestroy(&B);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* nonlinear solver */
Vec x,r; /* solution, residual vectors */
PetscInt steps,maxsteps = 100; /* iterations for convergence */
PetscErrorCode ierr;
DM da;
PetscReal ftime;
SNES ts_snes;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
PetscInitialize(&argc,&argv,(char*)0,help);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,-8,-8,PETSC_DECIDE,PETSC_DECIDE,
2,1,NULL,NULL,&da);CHKERRQ(ierr);
ierr = DMDASetFieldName(da,0,"u");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,1,"v");CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA; then duplicate for remaining
vectors that are the same types
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&x);CHKERRQ(ierr);
ierr = VecDuplicate(x,&r);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,FormFunction,da);CHKERRQ(ierr);
ierr = TSSetDuration(ts,maxsteps,1.0);CHKERRQ(ierr);
ierr = TSMonitorSet(ts,MyTSMonitor,0,0);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Customize nonlinear solver
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
ierr = TSGetSNES(ts,&ts_snes);
ierr = SNESMonitorSet(ts_snes,MySNESMonitor,NULL,NULL);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(da,x);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,.0001);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,x);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&r);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
void PETSC_STDCALL tsgetsnes_(TS ts,SNES *snes, int *__ierr ){
*__ierr = TSGetSNES(
(TS)PetscToPointer((ts) ),snes);
}