/* Monitor timesteps and use interpolation to output at integer multiples of 0.1 */
static PetscErrorCode Monitor(TS ts,PetscInt step,PetscReal t,Vec X,void *ctx)
{
PetscErrorCode ierr;
const PetscScalar *x;
PetscReal tfinal, dt;
User user = (User)ctx;
Vec interpolatedX;
PetscFunctionBeginUser;
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
ierr = TSGetDuration(ts,NULL,&tfinal);CHKERRQ(ierr);
while (user->next_output <= t && user->next_output <= tfinal) {
ierr = VecDuplicate(X,&interpolatedX);CHKERRQ(ierr);
ierr = TSInterpolate(ts,user->next_output,interpolatedX);CHKERRQ(ierr);
ierr = VecGetArrayRead(interpolatedX,&x);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"[%.1f] %D TS %.6f (dt = %.6f) X % 12.6e % 12.6e\n",
user->next_output,step,t,dt,(double)PetscRealPart(x[0]),
(double)PetscRealPart(x[1]));CHKERRQ(ierr);
ierr = VecRestoreArrayRead(interpolatedX,&x);CHKERRQ(ierr);
ierr = VecDestroy(&interpolatedX);CHKERRQ(ierr);
user->next_output += 0.1;
}
PetscFunctionReturn(0);
}
PetscErrorCode TSAlphaAdaptDefault(TS ts,PetscReal t,Vec X,Vec Xdot, PetscReal *nextdt,PetscBool *ok,void *ctx)
{
TS_Alpha *th;
SNESConvergedReason snesreason;
PetscReal dt,normX,normE,Emax,scale;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(ts,TS_CLASSID,1);
#if PETSC_USE_DEBUG
{
PetscBool match;
ierr = PetscObjectTypeCompare((PetscObject)ts,TSALPHA,&match);CHKERRQ(ierr);
if (!match) SETERRQ(((PetscObject)ts)->comm,1,"Only for TSALPHA");
}
#endif
th = (TS_Alpha*)ts->data;
ierr = SNESGetConvergedReason(ts->snes,&snesreason);CHKERRQ(ierr);
if (snesreason < 0) {
*ok = PETSC_FALSE;
*nextdt *= th->scale_min;
goto finally;
}
/* first-order aproximation to the local error */
/* E = (X0 + dt*Xdot) - X */
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
if (!th->E) {ierr = VecDuplicate(th->X0,&th->E);CHKERRQ(ierr);}
ierr = VecWAXPY(th->E,dt,Xdot,th->X0);CHKERRQ(ierr);
ierr = VecAXPY(th->E,-1,X);CHKERRQ(ierr);
ierr = VecNorm(th->E,NORM_2,&normE);CHKERRQ(ierr);
/* compute maximum allowable error */
ierr = VecNorm(X,NORM_2,&normX);CHKERRQ(ierr);
if (normX == 0) {ierr = VecNorm(th->X0,NORM_2,&normX);CHKERRQ(ierr);}
Emax = th->rtol * normX + th->atol;
/* compute next time step */
if (normE > 0) {
scale = th->rho * PetscRealPart(PetscSqrtScalar((PetscScalar)(Emax/normE)));
scale = PetscMax(scale,th->scale_min);
scale = PetscMin(scale,th->scale_max);
if (!(*ok))
scale = PetscMin(1.0,scale);
*nextdt *= scale;
}
/* accept or reject step */
if (normE <= Emax)
*ok = PETSC_TRUE;
else
*ok = PETSC_FALSE;
finally:
*nextdt = PetscMax(*nextdt,th->dt_min);
*nextdt = PetscMin(*nextdt,th->dt_max);
PetscFunctionReturn(0);
}
static PetscErrorCode _preStage(TS ts, PetscReal stage_time) {
PetscTimeStepper *ths;
PetscErrorCode ierr;
PetscReal stepsize;
int step;
ierr = TSGetApplicationContext(ts,&ths);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&stepsize);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&step);CHKERRQ(ierr);
ths->preStage(stage_time,step+1,stepsize);
return 0;
}
/*
Use Lax-Wendroff method to evaluate F(u,t) = du/dt + a * du/dx
*/
PetscErrorCode IFunction_LaxWendroff(TS ts,PetscReal t,Vec U,Vec Udot,Vec F,void* ctx)
{
PetscErrorCode ierr;
AppCtx *appctx=(AppCtx*)ctx;
PetscInt mstart,mend,M,i,um;
DM da;
Vec Uold,localUold;
PetscScalar *uarray,*f,*uoldarray,h,RFlux,LFlux,lambda;
PetscReal dt,a;
PetscFunctionBegin;
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&Uold);CHKERRQ(ierr);
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&M,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&mstart,0,0,&um,0,0);CHKERRQ(ierr);
h = 1.0/M;
mend = mstart + um;
/* printf(" mstart %d, um %d\n",mstart,um); */
ierr = DMGetLocalVector(da,&localUold);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da,Uold,INSERT_VALUES,localUold);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,Uold,INSERT_VALUES,localUold);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArrayRead(da,U,&uarray);CHKERRQ(ierr);
ierr = DMDAVecGetArrayRead(da,localUold,&uoldarray);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/* advection -- finite volume (appctx->a < 0 -- can be relaxed?) */
lambda = dt/h;
a = appctx->a;
for (i=mstart; i<mend; i++) {
RFlux = 0.5 * a * (uoldarray[i+1] + uoldarray[i]) - a*a*0.5*lambda * (uoldarray[i+1] - uoldarray[i]);
LFlux = 0.5 * a * (uoldarray[i-1] + uoldarray[i]) - a*a*0.5*lambda * (uoldarray[i] - uoldarray[i-1]);
f[i] = uarray[i] - uoldarray[i] + lambda * (RFlux - LFlux);
}
/* Restore vectors */
ierr = DMDAVecRestoreArrayRead(da,U,&uarray);CHKERRQ(ierr);
ierr = DMDAVecRestoreArrayRead(da,localUold,&uoldarray);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localUold);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* Monitor timesteps and use interpolation to output at integer multiples of 0.1 */
static PetscErrorCode Monitor(TS ts,PetscInt step,PetscReal t,Vec X,void *ctx)
{
PetscErrorCode ierr;
const PetscScalar *x;
PetscReal tfinal, dt, tprev;
User user = (User)ctx;
PetscFunctionBeginUser;
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
ierr = TSGetDuration(ts,NULL,&tfinal);CHKERRQ(ierr);
ierr = TSGetPrevTime(ts,&tprev);CHKERRQ(ierr);
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"[%.1f] %D TS %.6f (dt = %.6f) X % 12.6e % 12.6e\n",(double)user->next_output,step,(double)t,(double)dt,(double)PetscRealPart(x[0]),(double)PetscRealPart(x[1]));CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"t %.6f (tprev = %.6f) \n",(double)t,(double)tprev);CHKERRQ(ierr);
ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode MonitorError(TS ts,PetscInt step,PetscReal t,Vec x,void *ctx)
{
PetscErrorCode ierr;
MonitorCtx *mon = (MonitorCtx*)ctx;
PetscReal h,nrm_x,nrm_exact,nrm_diff;
PetscFunctionBeginUser;
if (!mon->problem->solution) PetscFunctionReturn(0);
ierr = (*mon->problem->solution)(t,mon->x,mon->problem->data);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&nrm_x);CHKERRQ(ierr);
ierr = VecNorm(mon->x,NORM_2,&nrm_exact);CHKERRQ(ierr);
ierr = VecAYPX(mon->x,-1,x);CHKERRQ(ierr);
ierr = VecNorm(mon->x,NORM_2,&nrm_diff);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&h);CHKERRQ(ierr);
ierr = PetscPrintf(mon->comm,"step %4D t=%12.8e h=% 8.2e |x|=%9.2e |x_e|=%9.2e |x-x_e|=%9.2e\n",step,t,h,nrm_x,nrm_exact,nrm_diff);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Use Lax-Friedrichs method to evaluate F(u,t) = du/dt + a * du/dx
See https://en.wikipedia.org/wiki/Lax%E2%80%93Friedrichs_method
*/
PetscErrorCode IFunction_LaxFriedrichs(TS ts,PetscReal t,Vec U,Vec Udot,Vec F,void* ctx)
{
PetscErrorCode ierr;
AppCtx *appctx=(AppCtx*)ctx;
PetscInt mstart,mend,M,i,um;
DM da;
Vec Uold,localUold;
PetscScalar *uarray,*f,*uoldarray,h,uave,c;
PetscReal dt;
PetscFunctionBegin;
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&Uold);CHKERRQ(ierr);
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&M,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&mstart,0,0,&um,0,0);CHKERRQ(ierr);
h = 1.0/M;
mend = mstart + um;
/* printf(" mstart %d, um %d\n",mstart,um); */
ierr = DMGetLocalVector(da,&localUold);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da,Uold,INSERT_VALUES,localUold);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,Uold,INSERT_VALUES,localUold);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArrayRead(da,U,&uarray);CHKERRQ(ierr);
ierr = DMDAVecGetArrayRead(da,localUold,&uoldarray);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/* advection */
c = appctx->a*dt/h; /* Courant-Friedrichs-Lewy number (CFL number) */
for (i=mstart; i<mend; i++) {
uave = 0.5*(uoldarray[i-1] + uoldarray[i+1]);
f[i] = uarray[i] - uave + c*0.5*(uoldarray[i+1] - uoldarray[i-1]);
}
/* Restore vectors */
ierr = DMDAVecRestoreArrayRead(da,U,&uarray);CHKERRQ(ierr);
ierr = DMDAVecRestoreArrayRead(da,localUold,&uoldarray);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localUold);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
TSAdaptCheckStage - checks whether to accept a stage, (e.g. reject and change time step size if nonlinear solve fails)
Collective on TSAdapt
Input Arguments:
+ adapt - adaptive controller context
. ts - time stepper
. t - Current simulation time
- Y - Current solution vector
Output Arguments:
. accept - PETSC_TRUE to accept the stage, PETSC_FALSE to reject
Level: developer
.seealso:
@*/
PetscErrorCode TSAdaptCheckStage(TSAdapt adapt,TS ts,PetscReal t,Vec Y,PetscBool *accept)
{
PetscErrorCode ierr;
SNESConvergedReason snesreason = SNES_CONVERGED_ITERATING;
PetscFunctionBegin;
PetscValidHeaderSpecific(adapt,TSADAPT_CLASSID,1);
PetscValidHeaderSpecific(ts,TS_CLASSID,2);
PetscValidIntPointer(accept,3);
if (ts->snes) {ierr = SNESGetConvergedReason(ts->snes,&snesreason);CHKERRQ(ierr);}
if (snesreason < 0) {
*accept = PETSC_FALSE;
if (++ts->num_snes_failures >= ts->max_snes_failures && ts->max_snes_failures > 0) {
ts->reason = TS_DIVERGED_NONLINEAR_SOLVE;
ierr = PetscInfo2(ts,"Step=%D, nonlinear solve failures %D greater than current TS allowed, stopping solve\n",ts->steps,ts->num_snes_failures);CHKERRQ(ierr);
if (adapt->monitor) {
ierr = PetscViewerASCIIAddTab(adapt->monitor,((PetscObject)adapt)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(adapt->monitor," TSAdapt %s step %3D stage rejected t=%-11g+%10.3e, nonlinear solve failures %D greater than current TS allowed\n",((PetscObject)adapt)->type_name,ts->steps,(double)ts->ptime,(double)ts->time_step,ts->num_snes_failures);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(adapt->monitor,((PetscObject)adapt)->tablevel);CHKERRQ(ierr);
}
}
} else {
*accept = PETSC_TRUE;
ierr = TSFunctionDomainError(ts,t,Y,accept);CHKERRQ(ierr);
if(*accept && adapt->checkstage) {
ierr = (*adapt->checkstage)(adapt,ts,t,Y,accept);CHKERRQ(ierr);
}
}
if(!(*accept) && !ts->reason) {
PetscReal dt,new_dt;
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
new_dt = dt * adapt->scale_solve_failed;
ierr = TSSetTimeStep(ts,new_dt);CHKERRQ(ierr);
adapt->timestepjustdecreased += adapt->timestepjustdecreased_delay;
if (adapt->monitor) {
ierr = PetscViewerASCIIAddTab(adapt->monitor,((PetscObject)adapt)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(adapt->monitor," TSAdapt %s step %3D stage rejected (%s) t=%-11g+%10.3e retrying with dt=%-10.3e\n",((PetscObject)adapt)->type_name,ts->steps,SNESConvergedReasons[snesreason],(double)ts->ptime,(double)dt,(double)new_dt);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(adapt->monitor,((PetscObject)adapt)->tablevel);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);
}
PetscErrorCode DomainErrorFunction(TS ts, PetscReal t, Vec Y, PetscBool *accept)
{
AppCtx *user;
PetscReal dt;
PetscErrorCode ierr;
const PetscScalar *x;
PetscInt nb_cells, i;
ierr = TSGetApplicationContext(ts, &user);CHKERRQ(ierr);
nb_cells = user->nb_cells;
ierr = VecGetArrayRead(Y, &x);CHKERRQ(ierr);
for(i = 0 ; i < 2*nb_cells ; ++i) {
if(PetscRealPart(x[i]) < 0) {
ierr = TSGetTimeStep(ts, &dt);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD, " ** Domain Error at time %g\n", (double)t);CHKERRQ(ierr);
*accept = PETSC_FALSE;
break;
}
}
ierr = VecRestoreArrayRead(Y, &x);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode MonitorUpdateQ(TS ts,PetscInt stepnum,PetscReal time,Vec X,void *ctx0)
{
PetscErrorCode ierr;
Vec C,*Y;
PetscInt Nr;
PetscReal h,theta;
Userctx *ctx=(Userctx*)ctx0;
PetscFunctionBegin;
theta = 0.5;
ierr = TSGetStages(ts,&Nr,&Y);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&h);CHKERRQ(ierr);
ierr = VecDuplicate(ctx->vec_q,&C);CHKERRQ(ierr);
/* compute integrals */
if (stepnum>0) {
ierr = CostIntegrand(ts,time,X,C,ctx);CHKERRQ(ierr);
ierr = VecAXPY(ctx->vec_q,h*theta,C);CHKERRQ(ierr);
ierr = CostIntegrand(ts,time+h*theta,Y[0],C,ctx);CHKERRQ(ierr);
ierr = VecAXPY(ctx->vec_q,h*(1-theta),C);CHKERRQ(ierr);
}
ierr = VecDestroy(&C);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Monitor - User-provided routine to monitor the solution computed at
each timestep. This example plots the solution and computes the
error in two different norms.
This example also demonstrates changing the timestep via TSSetTimeStep().
Input Parameters:
ts - the timestep context
step - the count of the current step (with 0 meaning the
initial condition)
crtime - the current time
u - the solution at this timestep
ctx - the user-provided context for this monitoring routine.
In this case we use the application context which contains
information about the problem size, workspace and the exact
solution.
*/
PetscErrorCode Monitor(TS ts,PetscInt step,PetscReal crtime,Vec u,void *ctx)
{
AppCtx *appctx = (AppCtx*) ctx; /* user-defined application context */
PetscErrorCode ierr;
PetscReal norm_2, norm_max, dt, dttol;
PetscBool flg;
/*
View a graph of the current iterate
*/
ierr = VecView(u,appctx->viewer2);CHKERRQ(ierr);
/*
Compute the exact solution
*/
ierr = ExactSolution(crtime,appctx->solution,appctx);CHKERRQ(ierr);
/*
Print debugging information if desired
*/
if (appctx->debug) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Computed solution vector\n");CHKERRQ(ierr);
ierr = VecView(u,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"Exact solution vector\n");CHKERRQ(ierr);
ierr = VecView(appctx->solution,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
/*
Compute the 2-norm and max-norm of the error
*/
ierr = VecAXPY(appctx->solution,-1.0,u);CHKERRQ(ierr);
ierr = VecNorm(appctx->solution,NORM_2,&norm_2);CHKERRQ(ierr);
norm_2 = PetscSqrtReal(appctx->h)*norm_2;
ierr = VecNorm(appctx->solution,NORM_MAX,&norm_max);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
if (norm_2 > 1.e-2) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Timestep %D: step size = %G, time = %G, 2-norm error = %G, max norm error = %G\n",step,dt,crtime,norm_2,norm_max);CHKERRQ(ierr);
}
appctx->norm_2 += norm_2;
appctx->norm_max += norm_max;
dttol = .0001;
ierr = PetscOptionsGetReal(NULL,"-dttol",&dttol,&flg);CHKERRQ(ierr);
if (dt < dttol) {
dt *= .999;
ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
}
/*
View a graph of the error
*/
ierr = VecView(appctx->solution,appctx->viewer1);CHKERRQ(ierr);
/*
Print debugging information if desired
*/
if (appctx->debug) {
ierr = PetscPrintf(PETSC_COMM_SELF,"Error vector\n");CHKERRQ(ierr);
ierr = VecView(appctx->solution,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
}
return 0;
}
PetscErrorCode TSEventHandler(TS ts)
{
PetscErrorCode ierr;
TSEvent event;
PetscReal t;
Vec U;
PetscInt i;
PetscReal dt,dt_min;
PetscInt rollback=0,in[2],out[2];
PetscInt fvalue_sign,fvalueprev_sign;
PetscFunctionBegin;
PetscValidHeaderSpecific(ts,TS_CLASSID,1);
if (!ts->event) PetscFunctionReturn(0);
event = ts->event;
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&U);CHKERRQ(ierr);
if (event->status == TSEVENT_NONE) {
if (ts->steps == 1) /* After first successful step */
event->timestep_orig = ts->ptime - ts->ptime_prev;
event->timestep_prev = dt;
}
if (event->status == TSEVENT_RESET_NEXTSTEP) {
/* Restore time step */
dt = PetscMin(event->timestep_orig,event->timestep_prev);
ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
event->status = TSEVENT_NONE;
}
if (event->status == TSEVENT_NONE) {
event->ptime_end = t;
}
ierr = VecLockPush(U);CHKERRQ(ierr);
ierr = (*event->eventhandler)(ts,t,U,event->fvalue,event->ctx);CHKERRQ(ierr);
ierr = VecLockPop(U);CHKERRQ(ierr);
for (i=0; i < event->nevents; i++) {
if (PetscAbsScalar(event->fvalue[i]) < event->vtol[i]) {
event->status = TSEVENT_ZERO;
event->fvalue_right[i] = event->fvalue[i];
continue;
}
fvalue_sign = PetscSign(PetscRealPart(event->fvalue[i]));
fvalueprev_sign = PetscSign(PetscRealPart(event->fvalue_prev[i]));
if (fvalueprev_sign != 0 && (fvalue_sign != fvalueprev_sign) && (PetscAbsScalar(event->fvalue_prev[i]) > event->vtol[i])) {
switch (event->direction[i]) {
case -1:
if (fvalue_sign < 0) {
rollback = 1;
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Event %D interval detected [%g - %g]\n",event->iterctr,i,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->fvalue_right[i] = event->fvalue[i];
event->side[i] = 1;
if (!event->iterctr) event->zerocrossing[i] = PETSC_TRUE;
event->status = TSEVENT_LOCATED_INTERVAL;
}
break;
case 1:
if (fvalue_sign > 0) {
rollback = 1;
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Event %D interval detected [%g - %g]\n",event->iterctr,i,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->fvalue_right[i] = event->fvalue[i];
event->side[i] = 1;
if (!event->iterctr) event->zerocrossing[i] = PETSC_TRUE;
event->status = TSEVENT_LOCATED_INTERVAL;
}
break;
case 0:
rollback = 1;
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Event %D interval detected [%g - %g]\n",event->iterctr,i,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->fvalue_right[i] = event->fvalue[i];
event->side[i] = 1;
if (!event->iterctr) event->zerocrossing[i] = PETSC_TRUE;
event->status = TSEVENT_LOCATED_INTERVAL;
break;
}
}
}
in[0] = event->status; in[1] = rollback;
ierr = MPIU_Allreduce(in,out,2,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
event->status = (TSEventStatus)out[0]; rollback = out[1];
if (rollback) event->status = TSEVENT_LOCATED_INTERVAL;
event->nevents_zero = 0;
if (event->status == TSEVENT_ZERO) {
for (i=0; i < event->nevents; i++) {
if (PetscAbsScalar(event->fvalue[i]) < event->vtol[i]) {
event->events_zero[event->nevents_zero++] = i;
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: Event %D zero crossing at time %g located in %D iterations\n",i,(double)t,event->iterctr);CHKERRQ(ierr);
}
event->zerocrossing[i] = PETSC_FALSE;
}
event->side[i] = 0;
}
ierr = TSPostEvent(ts,t,U);CHKERRQ(ierr);
dt = event->ptime_end - t;
if (PetscAbsReal(dt) < PETSC_SMALL) { /* we hit the event, continue with the candidate time step */
dt = event->timestep_prev;
event->status = TSEVENT_NONE;
}
ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
event->iterctr = 0;
PetscFunctionReturn(0);
}
if (event->status == TSEVENT_LOCATED_INTERVAL) {
ierr = TSRollBack(ts);CHKERRQ(ierr);
ierr = TSSetConvergedReason(ts,TS_CONVERGED_ITERATING);CHKERRQ(ierr);
event->status = TSEVENT_PROCESSING;
event->ptime_right = t;
} else {
for (i=0; i < event->nevents; i++) {
if (event->status == TSEVENT_PROCESSING && event->zerocrossing[i]) {
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
event->side[i] = -1;
}
event->fvalue_prev[i] = event->fvalue[i];
}
if (event->monitor && event->status == TSEVENT_PROCESSING) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Stepping forward as no event detected in interval [%g - %g]\n",event->iterctr,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->ptime_prev = t;
}
if (event->status == TSEVENT_PROCESSING) event->iterctr++;
ierr = MPIU_Allreduce(&dt,&dt_min,1,MPIU_REAL,MPIU_MIN,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,dt_min);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void PETSC_STDCALL tsgettimestep_(TS ts,PetscReal* dt, int *__ierr ){
*__ierr = TSGetTimeStep(
(TS)PetscToPointer((ts) ),dt);
}
int main(int argc, char **argv)
{
TS ts;
Vec x; /*solution vector*/
Mat A; /*Jacobian*/
PetscInt steps,maxsteps,mx,eimex_rowcol[2],two;
PetscErrorCode ierr;
PetscScalar *x_ptr;
PetscReal ftime,dt,norm;
Vec ref;
struct _User user; /* user-defined work context */
PetscViewer viewer;
ierr = PetscInitialize(&argc,&argv,NULL,help);CHKERRQ(ierr);
/* Initialize user application context */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"van der Pol options","");
user.mu = 1e0;
ierr = PetscOptionsReal("-eps","Stiffness controller","",user.mu,&user.mu,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
ierr = PetscOptionsGetBool(NULL,NULL,"-monitor",&monitor,NULL);CHKERRQ(ierr);
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors, solve same ODE on every process
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,2,2);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&x,NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&ref,NULL);CHKERRQ(ierr);
ierr = VecGetArray(ref,&x_ptr);CHKERRQ(ierr);
/*
* [0,1], mu=10^-3
*/
/*
x_ptr[0] = -1.8881254106283;
x_ptr[1] = 0.7359074233370;*/
/*
* [0,0.5],mu=10^-3
*/
/*
x_ptr[0] = 1.596980778659137;
x_ptr[1] = -1.029103015879544;
*/
/*
* [0,0.5],mu=1
*/
x_ptr[0] = 1.619084329683235;
x_ptr[1] = -0.803530465176385;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSEIMEX);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,IFunction,&user);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,IJacobian,&user);CHKERRQ(ierr);
ftime = 1.1;
dt = 0.00001;
maxsteps = 100000;
ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecGetArray(x,&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 2.;
x_ptr[1] = -2./3. + 10./81.*(user.mu) - 292./2187.* (user.mu) * (user.mu)
-1814./19683.*(user.mu)*(user.mu)*(user.mu);
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
ierr = VecGetSize(x,&mx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,x);CHKERRQ(ierr);
ierr = TSGetTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
ierr = VecAXPY(x,-1.0,ref);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
eimex_rowcol[0] = 0; eimex_rowcol[1] = 0; two = 2;
ierr = PetscOptionsGetIntArray(NULL,NULL,"-ts_eimex_row_col",eimex_rowcol,&two,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"order %11s %18s %37s\n","dt","norm","final solution components 0 and 1");CHKERRQ(ierr);
ierr = VecGetArray(x,&x_ptr);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"(%D,%D) %10.8f %18.15f %18.15f %18.15f\n",eimex_rowcol[0],eimex_rowcol[1],(double)dt,(double)norm,(double)PetscRealPart(x_ptr[0]),(double)PetscRealPart(x_ptr[1]));CHKERRQ(ierr);
ierr = VecRestoreArray(x,&x_ptr);CHKERRQ(ierr);
/* Write line in convergence log */
ierr = PetscViewerCreate(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr);
ierr = PetscViewerFileSetMode(viewer,FILE_MODE_APPEND);CHKERRQ(ierr);
ierr = PetscViewerFileSetName(viewer,"eimex_nonstiff_vdp.txt");CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"%D %D %10.8f %18.15f\n",eimex_rowcol[0],eimex_rowcol[1],(double)dt,(double)norm);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&ref);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
static PetscErrorCode TSAlpha_Restart(TS ts,PetscBool *initok)
{
TS_Alpha *th = (TS_Alpha*)ts->data;
PetscReal time_step;
PetscReal alpha_m,alpha_f,gamma,beta;
Vec X0 = ts->vec_sol, X1, X2 = th->X1;
Vec V0 = ts->vec_dot, V1, V2 = th->V1;
PetscBool stageok;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecDuplicate(X0,&X1);CHKERRQ(ierr);
ierr = VecDuplicate(V0,&V1);CHKERRQ(ierr);
/* Setup backward Euler with halved time step */
ierr = TSAlpha2GetParams(ts,&alpha_m,&alpha_f,&gamma,&beta);CHKERRQ(ierr);
ierr = TSAlpha2SetParams(ts,1,1,1,0.5);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&time_step);CHKERRQ(ierr);
ts->time_step = time_step/2;
ierr = TSAlpha_StageTime(ts);CHKERRQ(ierr);
th->stage_time = ts->ptime;
ierr = VecZeroEntries(th->A0);CHKERRQ(ierr);
/* First BE step, (t0,X0,V0) -> (t1,X1,V1) */
th->stage_time += ts->time_step;
ierr = VecCopy(X0,th->X0);CHKERRQ(ierr);
ierr = VecCopy(V0,th->V0);CHKERRQ(ierr);
ierr = TSPreStage(ts,th->stage_time);CHKERRQ(ierr);
ierr = VecCopy(th->X0,X1);CHKERRQ(ierr);
ierr = TS_SNESSolve(ts,NULL,X1);CHKERRQ(ierr);
ierr = VecCopy(th->V1,V1);CHKERRQ(ierr);
ierr = TSPostStage(ts,th->stage_time,0,&X1);CHKERRQ(ierr);
ierr = TSAdaptCheckStage(ts->adapt,ts,th->stage_time,X1,&stageok);CHKERRQ(ierr);
if (!stageok) goto finally;
/* Second BE step, (t1,X1,V1) -> (t2,X2,V2) */
th->stage_time += ts->time_step;
ierr = VecCopy(X1,th->X0);CHKERRQ(ierr);
ierr = VecCopy(V1,th->V0);CHKERRQ(ierr);
ierr = TSPreStage(ts,th->stage_time);CHKERRQ(ierr);
ierr = VecCopy(th->X0,X2);CHKERRQ(ierr);
ierr = TS_SNESSolve(ts,NULL,X2);CHKERRQ(ierr);
ierr = VecCopy(th->V1,V2);CHKERRQ(ierr);
ierr = TSPostStage(ts,th->stage_time,0,&X2);CHKERRQ(ierr);
ierr = TSAdaptCheckStage(ts->adapt,ts,th->stage_time,X1,&stageok);CHKERRQ(ierr);
if (!stageok) goto finally;
/* Compute A0 ~ dV/dt at t0 with backward differences */
ierr = VecZeroEntries(th->A0);CHKERRQ(ierr);
ierr = VecAXPY(th->A0,-3/ts->time_step,V0);CHKERRQ(ierr);
ierr = VecAXPY(th->A0,+4/ts->time_step,V1);CHKERRQ(ierr);
ierr = VecAXPY(th->A0,-1/ts->time_step,V2);CHKERRQ(ierr);
/* Rough, lower-order estimate LTE of the initial step */
if (th->adapt) {
ierr = VecZeroEntries(th->vec_lte_work[0]);CHKERRQ(ierr);
ierr = VecAXPY(th->vec_lte_work[0],+2,X2);CHKERRQ(ierr);
ierr = VecAXPY(th->vec_lte_work[0],-4,X1);CHKERRQ(ierr);
ierr = VecAXPY(th->vec_lte_work[0],+2,X0);CHKERRQ(ierr);
}
if (th->adapt) {
ierr = VecZeroEntries(th->vec_lte_work[1]);CHKERRQ(ierr);
ierr = VecAXPY(th->vec_lte_work[1],+2,V2);CHKERRQ(ierr);
ierr = VecAXPY(th->vec_lte_work[1],-4,V1);CHKERRQ(ierr);
ierr = VecAXPY(th->vec_lte_work[1],+2,V0);CHKERRQ(ierr);
}
finally:
/* Revert TSAlpha to the initial state (t0,X0,V0) */
if (initok) *initok = stageok;
ierr = TSSetTimeStep(ts,time_step);CHKERRQ(ierr);
ierr = TSAlpha2SetParams(ts,alpha_m,alpha_f,gamma,beta);CHKERRQ(ierr);
ierr = VecCopy(ts->vec_sol,th->X0);CHKERRQ(ierr);
ierr = VecCopy(ts->vec_dot,th->V0);CHKERRQ(ierr);
ierr = VecDestroy(&X1);CHKERRQ(ierr);
ierr = VecDestroy(&V1);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
double dt() const {
double dt;
TSGetTimeStep(ts, &dt);
return dt;
}
