static PetscErrorCode TSInterpolate_EIMEX(TS ts,PetscReal itime,Vec X)
{
TS_EIMEX *ext = (TS_EIMEX*)ts->data;
PetscReal t,a,b;
Vec Y0=ext->VecSolPrev,Y1=ext->Y,Ydot=ext->Ydot,YdotI=ext->YdotI;
const PetscReal h = ts->ptime - ts->ptime_prev;
PetscErrorCode ierr;
PetscFunctionBegin;
t = (itime -ts->ptime + h)/h;
/* YdotI = -f(x)-g(x) */
ierr = VecZeroEntries(Ydot);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,ts->ptime-h,Y0,Ydot,YdotI,PETSC_FALSE);CHKERRQ(ierr);
a = 2.0*t*t*t - 3.0*t*t + 1.0;
b = -(t*t*t - 2.0*t*t + t)*h;
ierr = VecAXPBYPCZ(X,a,b,0.0,Y0,YdotI);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,ts->ptime,Y1,Ydot,YdotI,PETSC_FALSE);CHKERRQ(ierr);
a = -2.0*t*t*t+3.0*t*t;
b = -(t*t*t - t*t)*h;
ierr = VecAXPBYPCZ(X,a,b,1.0,Y1,YdotI);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int TSFunction_Sundials(realtype t,N_Vector y,N_Vector ydot,void *ctx)
{
TS ts = (TS) ctx;
DM dm;
DMTS tsdm;
TSIFunction ifunction;
MPI_Comm comm;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
Vec yy = cvode->w1,yyd = cvode->w2,yydot = cvode->ydot;
PetscScalar *y_data,*ydot_data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)ts,&comm);CHKERRQ(ierr);
/* Make the PETSc work vectors yy and yyd point to the arrays in the SUNDIALS vectors y and ydot respectively*/
y_data = (PetscScalar*) N_VGetArrayPointer(y);
ydot_data = (PetscScalar*) N_VGetArrayPointer(ydot);
ierr = VecPlaceArray(yy,y_data);CHKERRABORT(comm,ierr);
ierr = VecPlaceArray(yyd,ydot_data);CHKERRABORT(comm,ierr);
/* Now compute the right hand side function, via IFunction unless only the more efficient RHSFunction is set */
ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
ierr = DMGetDMTS(dm,&tsdm);CHKERRQ(ierr);
ierr = DMTSGetIFunction(dm,&ifunction,NULL);CHKERRQ(ierr);
if (!ifunction) {
ierr = TSComputeRHSFunction(ts,t,yy,yyd);CHKERRQ(ierr);
} else { /* If rhsfunction is also set, this computes both parts and shifts them to the right */
ierr = VecZeroEntries(yydot);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,t,yy,yydot,yyd,PETSC_FALSE);CHKERRABORT(comm,ierr);
ierr = VecScale(yyd,-1.);CHKERRQ(ierr);
}
ierr = VecResetArray(yy);CHKERRABORT(comm,ierr);
ierr = VecResetArray(yyd);CHKERRABORT(comm,ierr);
PetscFunctionReturn(0);
}
void PETSC_STDCALL tscomputeifunction_(TS ts,PetscReal *t,Vec X,Vec Xdot,Vec Y,PetscBool *imex, int *__ierr ){
*__ierr = TSComputeIFunction(
(TS)PetscToPointer((ts) ),*t,
(Vec)PetscToPointer((X) ),
(Vec)PetscToPointer((Xdot) ),
(Vec)PetscToPointer((Y) ),*imex);
}
int TSFunction_Sundials(realtype t,N_Vector y,N_Vector ydot,void *ctx)
{
TS ts = (TS) ctx;
MPI_Comm comm = ((PetscObject)ts)->comm;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
Vec yy = cvode->w1,yyd = cvode->w2,yydot = cvode->ydot;
PetscScalar *y_data,*ydot_data;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Make the PETSc work vectors yy and yyd point to the arrays in the SUNDIALS vectors y and ydot respectively*/
y_data = (PetscScalar *) N_VGetArrayPointer(y);
ydot_data = (PetscScalar *) N_VGetArrayPointer(ydot);
ierr = VecPlaceArray(yy,y_data);CHKERRABORT(comm,ierr);
ierr = VecPlaceArray(yyd,ydot_data); CHKERRABORT(comm,ierr);
/* now compute the right hand side function */
if (!ts->userops->ifunction) {
ierr = TSComputeRHSFunction(ts,t,yy,yyd);CHKERRQ(ierr);
} else { /* If rhsfunction is also set, this computes both parts and shifts them to the right */
ierr = VecZeroEntries(yydot);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,t,yy,yydot,yyd,PETSC_FALSE); CHKERRABORT(comm,ierr);
ierr = VecScale(yyd,-1.);CHKERRQ(ierr);
}
ierr = VecResetArray(yy); CHKERRABORT(comm,ierr);
ierr = VecResetArray(yyd); CHKERRABORT(comm,ierr);
PetscFunctionReturn(0);
}
/*
The transient residual is
F(U^{n+1},(U^{n+1}-U^n)/dt) = 0
or for ODE,
(U^{n+1} - U^{n})/dt - F(U^{n+1}) = 0
This is the function that must be evaluated for transient simulation and for
finite difference Jacobians. On the first Newton step, this algorithm uses
a guess of U^{n+1} = U^n in which case the transient term vanishes and the
residual is actually the steady state residual. Pseudotransient
continuation as described in the literature is a linearly implicit
algorithm, it only takes this one Newton step with the steady state
residual, and then advances to the next time step.
*/
static PetscErrorCode SNESTSFormFunction_Pseudo(SNES snes,Vec X,Vec Y,TS ts)
{
Vec Xdot;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = TSPseudoGetXdot(ts,X,&Xdot);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,ts->ptime+ts->time_step,X,Xdot,Y,PETSC_FALSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSStep_Theta(TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscInt its,lits;
PetscReal next_time_step;
SNESConvergedReason snesreason;
PetscErrorCode ierr;
PetscFunctionBegin;
next_time_step = ts->time_step;
th->stage_time = ts->ptime + (th->endpoint ? 1. : th->Theta)*ts->time_step;
th->shift = 1./(th->Theta*ts->time_step);
ierr = TSPreStep(ts);CHKERRQ(ierr);
ierr = TSPreStage(ts,th->stage_time);CHKERRQ(ierr);
if (th->endpoint) { /* This formulation assumes linear time-independent mass matrix */
ierr = VecZeroEntries(th->Xdot);CHKERRQ(ierr);
if (!th->affine) {ierr = VecDuplicate(ts->vec_sol,&th->affine);CHKERRQ(ierr);}
ierr = TSComputeIFunction(ts,ts->ptime,ts->vec_sol,th->Xdot,th->affine,PETSC_FALSE);CHKERRQ(ierr);
ierr = VecScale(th->affine,(th->Theta-1.)/th->Theta);CHKERRQ(ierr);
}
if (th->extrapolate) {
ierr = VecWAXPY(th->X,1./th->shift,th->Xdot,ts->vec_sol);CHKERRQ(ierr);
} else {
ierr = VecCopy(ts->vec_sol,th->X);CHKERRQ(ierr);
}
ierr = SNESSolve(ts->snes,th->affine,th->X);CHKERRQ(ierr);
ierr = SNESGetIterationNumber(ts->snes,&its);CHKERRQ(ierr);
ierr = SNESGetLinearSolveIterations(ts->snes,&lits);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(ts->snes,&snesreason);CHKERRQ(ierr);
ts->snes_its += its; ts->ksp_its += lits;
if (snesreason < 0 && ts->max_snes_failures > 0 && ++ts->num_snes_failures >= ts->max_snes_failures) {
ts->reason = TS_DIVERGED_NONLINEAR_SOLVE;
ierr = PetscInfo2(ts,"Step=%D, nonlinear solve solve failures %D greater than current TS allowed, stopping solve\n",ts->steps,ts->num_snes_failures);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (th->endpoint) {
ierr = VecCopy(th->X,ts->vec_sol);CHKERRQ(ierr);
} else {
ierr = VecAXPBYPCZ(th->Xdot,-th->shift,th->shift,0,ts->vec_sol,th->X);CHKERRQ(ierr);
ierr = VecAXPY(ts->vec_sol,ts->time_step,th->Xdot);CHKERRQ(ierr);
}
ts->ptime += ts->time_step;
ts->time_step = next_time_step;
ts->steps++;
PetscFunctionReturn(0);
}
static PetscErrorCode SNESTSFormFunction_Theta(SNES snes,Vec x,Vec y,TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscErrorCode ierr;
Vec X0,Xdot;
DM dm,dmsave;
PetscFunctionBegin;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
/* When using the endpoint variant, this is actually 1/Theta * Xdot */
ierr = TSThetaGetX0AndXdot(ts,dm,&X0,&Xdot);CHKERRQ(ierr);
ierr = VecAXPBYPCZ(Xdot,-th->shift,th->shift,0,X0,x);CHKERRQ(ierr);
/* DM monkey-business allows user code to call TSGetDM() inside of functions evaluated on levels of FAS */
dmsave = ts->dm;
ts->dm = dm;
ierr = TSComputeIFunction(ts,th->stage_time,x,Xdot,y,PETSC_FALSE);CHKERRQ(ierr);
ts->dm = dmsave;
PetscFunctionReturn(0);
}
PetscErrorCode TSPseudoMonitorDefault(TS ts,PetscInt step,PetscReal ptime,Vec v,void *dummy)
{
TS_Pseudo *pseudo = (TS_Pseudo*)ts->data;
PetscErrorCode ierr;
PetscViewer viewer = (PetscViewer) dummy;
PetscFunctionBegin;
if (!viewer) {
ierr = PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)ts),&viewer);CHKERRQ(ierr);
}
if (pseudo->fnorm < 0) { /* The last computed norm is stale, recompute */
ierr = VecZeroEntries(pseudo->xdot);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,ts->ptime,ts->vec_sol,pseudo->xdot,pseudo->func,PETSC_FALSE);CHKERRQ(ierr);
ierr = VecNorm(pseudo->func,NORM_2,&pseudo->fnorm);CHKERRQ(ierr);
}
ierr = PetscViewerASCIIAddTab(viewer,((PetscObject)ts)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"TS %D dt %g time %g fnorm %g\n",step,(double)ts->time_step,(double)ptime,(double)pseudo->fnorm);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(viewer,((PetscObject)ts)->tablevel);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESTSFormFunction_Alpha(SNES snes,Vec x,Vec y,TS ts)
{
TS_Alpha *th = (TS_Alpha*)ts->data;
Vec X0 = th->X0, V0 = th->V0;
Vec X1 = x, V1 = th->V1, R = y;
PetscErrorCode ierr;
PetscFunctionBegin;
/* V1 = (1-1/Gamma)*V0 + 1/(Gamma*dT)*(X1-X0) */
ierr = VecWAXPY(V1,-1,X0,X1);CHKERRQ(ierr);
ierr = VecAXPBY(V1,1-1/th->Gamma,1/(th->Gamma*ts->time_step),V0);CHKERRQ(ierr);
/* Xa = X0 + Alpha_f*(X1-X0) */
ierr = VecWAXPY(th->Xa,-1,X0,X1);CHKERRQ(ierr);
ierr = VecAYPX(th->Xa,th->Alpha_f,X0);CHKERRQ(ierr);
/* Va = V0 + Alpha_m*(V1-V0) */
ierr = VecWAXPY(th->Va,-1,V0,V1);CHKERRQ(ierr);
ierr = VecAYPX(th->Va,th->Alpha_m,V0);CHKERRQ(ierr);
/* F = Function(ta,Xa,Va) */
ierr = TSComputeIFunction(ts,th->stage_time,th->Xa,th->Va,R,PETSC_FALSE);CHKERRQ(ierr);
ierr = VecScale(R,1/th->Alpha_f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
TSPseudoTimeStepDefault - Default code to compute pseudo-timestepping.
Use with TSPseudoSetTimeStep().
Collective on TS
Input Parameters:
. ts - the timestep context
. dtctx - unused timestep context
Output Parameter:
. newdt - the timestep to use for the next step
Level: advanced
.keywords: timestep, pseudo, default
.seealso: TSPseudoSetTimeStep(), TSPseudoComputeTimeStep()
@*/
PetscErrorCode TSPseudoTimeStepDefault(TS ts,PetscReal *newdt,void *dtctx)
{
TS_Pseudo *pseudo = (TS_Pseudo*)ts->data;
PetscReal inc = pseudo->dt_increment,fnorm_previous = pseudo->fnorm_previous;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecZeroEntries(pseudo->xdot);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,ts->ptime,ts->vec_sol,pseudo->xdot,pseudo->func,PETSC_FALSE);CHKERRQ(ierr);
ierr = VecNorm(pseudo->func,NORM_2,&pseudo->fnorm);CHKERRQ(ierr);
if (pseudo->fnorm_initial == 0.0) {
/* first time through so compute initial function norm */
pseudo->fnorm_initial = pseudo->fnorm;
fnorm_previous = pseudo->fnorm;
}
if (pseudo->fnorm == 0.0) *newdt = 1.e12*inc*ts->time_step;
else if (pseudo->increment_dt_from_initial_dt) *newdt = inc*pseudo->dt_initial*pseudo->fnorm_initial/pseudo->fnorm;
else *newdt = inc*ts->time_step*fnorm_previous/pseudo->fnorm;
if (pseudo->dt_max > 0) *newdt = PetscMin(*newdt,pseudo->dt_max);
pseudo->fnorm_previous = pseudo->fnorm;
PetscFunctionReturn(0);
}
static PetscErrorCode SNESTSFormFunction_EIMEX(SNES snes,Vec X,Vec G,TS ts)
{
TS_EIMEX *ext = (TS_EIMEX*)ts->data;
PetscErrorCode ierr;
Vec Ydot,Z;
DM dm,dmsave;
PetscFunctionBegin;
ierr = VecZeroEntries(G);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = TSEIMEXGetVecs(ts,dm,&Z,&Ydot,NULL,NULL);CHKERRQ(ierr);
ierr = VecZeroEntries(Ydot);CHKERRQ(ierr);
dmsave = ts->dm;
ts->dm = dm;
ierr = TSComputeIFunction(ts,ext->ctime,X,Ydot,G,PETSC_FALSE);CHKERRQ(ierr);
/* PETSC_FALSE indicates non-imex, adding explicit RHS to the implicit I function. */
ierr = VecCopy(G,Ydot);CHKERRQ(ierr);
ts->dm = dmsave;
ierr = TSEIMEXRestoreVecs(ts,dm,&Z,&Ydot,NULL,NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSStep_Theta(TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscInt rejections = 0;
PetscBool stageok,accept = PETSC_TRUE;
PetscReal next_time_step = ts->time_step;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!ts->steprollback) {
if (th->adapt) { ierr = VecCopy(th->X0,th->vec_sol_prev);CHKERRQ(ierr); }
ierr = VecCopy(ts->vec_sol,th->X0);CHKERRQ(ierr);
}
th->status = TS_STEP_INCOMPLETE;
while (!ts->reason && th->status != TS_STEP_COMPLETE) {
PetscReal shift = 1/(th->Theta*ts->time_step);
th->stage_time = ts->ptime + (th->endpoint ? (PetscReal)1 : th->Theta)*ts->time_step;
ierr = VecCopy(th->X0,th->X);CHKERRQ(ierr);
if (th->extrapolate && !ts->steprestart) {
ierr = VecAXPY(th->X,1/shift,th->Xdot);CHKERRQ(ierr);
}
if (th->endpoint) { /* This formulation assumes linear time-independent mass matrix */
if (!th->affine) {ierr = VecDuplicate(ts->vec_sol,&th->affine);CHKERRQ(ierr);}
ierr = VecZeroEntries(th->Xdot);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,ts->ptime,th->X0,th->Xdot,th->affine,PETSC_FALSE);CHKERRQ(ierr);
ierr = VecScale(th->affine,(th->Theta-1)/th->Theta);CHKERRQ(ierr);
} else if (th->affine) { /* Just in case th->endpoint is changed between calls to TSStep_Theta() */
ierr = VecZeroEntries(th->affine);CHKERRQ(ierr);
}
ierr = TSPreStage(ts,th->stage_time);CHKERRQ(ierr);
ierr = TS_SNESSolve(ts,th->affine,th->X);CHKERRQ(ierr);
ierr = TSPostStage(ts,th->stage_time,0,&th->X);CHKERRQ(ierr);
ierr = TSAdaptCheckStage(ts->adapt,ts,th->stage_time,th->X,&stageok);CHKERRQ(ierr);
if (!stageok) goto reject_step;
th->status = TS_STEP_PENDING;
if (th->endpoint) {
ierr = VecCopy(th->X,ts->vec_sol);CHKERRQ(ierr);
} else {
ierr = VecAXPBYPCZ(th->Xdot,-shift,shift,0,th->X0,th->X);CHKERRQ(ierr);
ierr = VecAXPY(ts->vec_sol,ts->time_step,th->Xdot);CHKERRQ(ierr);
}
ierr = TSAdaptChoose(ts->adapt,ts,ts->time_step,NULL,&next_time_step,&accept);CHKERRQ(ierr);
th->status = accept ? TS_STEP_COMPLETE : TS_STEP_INCOMPLETE;
if (!accept) {
ierr = VecCopy(th->X0,ts->vec_sol);CHKERRQ(ierr);
ts->time_step = next_time_step;
goto reject_step;
}
if (ts->costintegralfwd) { /* Save the info for the later use in cost integral evaluation */
th->ptime = ts->ptime;
th->time_step = ts->time_step;
}
ts->ptime += ts->time_step;
ts->time_step = next_time_step;
break;
reject_step:
ts->reject++; accept = PETSC_FALSE;
if (!ts->reason && ++rejections > ts->max_reject && ts->max_reject >= 0) {
ts->reason = TS_DIVERGED_STEP_REJECTED;
ierr = PetscInfo2(ts,"Step=%D, step rejections %D greater than current TS allowed, stopping solve\n",ts->steps,rejections);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode TSStep_Theta(TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscInt its,lits,reject,next_scheme;
PetscReal next_time_step;
TSAdapt adapt;
PetscBool stageok,accept = PETSC_TRUE;
PetscErrorCode ierr;
PetscFunctionBegin;
th->status = TS_STEP_INCOMPLETE;
ierr = VecCopy(ts->vec_sol,th->X0);CHKERRQ(ierr);
for (reject=0; !ts->reason && th->status != TS_STEP_COMPLETE; ts->reject++) {
PetscReal shift = 1./(th->Theta*ts->time_step);
th->stage_time = ts->ptime + (th->endpoint ? 1. : th->Theta)*ts->time_step;
ierr = TSPreStep(ts);CHKERRQ(ierr);
ierr = TSPreStage(ts,th->stage_time);CHKERRQ(ierr);
if (th->endpoint) { /* This formulation assumes linear time-independent mass matrix */
ierr = VecZeroEntries(th->Xdot);CHKERRQ(ierr);
if (!th->affine) {ierr = VecDuplicate(ts->vec_sol,&th->affine);CHKERRQ(ierr);}
ierr = TSComputeIFunction(ts,ts->ptime,ts->vec_sol,th->Xdot,th->affine,PETSC_FALSE);CHKERRQ(ierr);
ierr = VecScale(th->affine,(th->Theta-1.)/th->Theta);CHKERRQ(ierr);
}
if (th->extrapolate) {
ierr = VecWAXPY(th->X,1./shift,th->Xdot,ts->vec_sol);CHKERRQ(ierr);
} else {
ierr = VecCopy(ts->vec_sol,th->X);CHKERRQ(ierr);
}
ierr = SNESSolve(ts->snes,th->affine,th->X);CHKERRQ(ierr);
ierr = SNESGetIterationNumber(ts->snes,&its);CHKERRQ(ierr);
ierr = SNESGetLinearSolveIterations(ts->snes,&lits);CHKERRQ(ierr);
ts->snes_its += its; ts->ksp_its += lits;
ierr = TSPostStage(ts,th->stage_time,0,&(th->X));CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptCheckStage(adapt,ts,&stageok);CHKERRQ(ierr);
if (!stageok) {accept = PETSC_FALSE; goto reject_step;}
ierr = TSEvaluateStep(ts,th->order,ts->vec_sol,NULL);CHKERRQ(ierr);
th->status = TS_STEP_PENDING;
/* Register only the current method as a candidate because we're not supporting multiple candidates yet. */
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptCandidatesClear(adapt);CHKERRQ(ierr);
ierr = TSAdaptCandidateAdd(adapt,NULL,th->order,1,th->ccfl,1.0,PETSC_TRUE);CHKERRQ(ierr);
ierr = TSAdaptChoose(adapt,ts,ts->time_step,&next_scheme,&next_time_step,&accept);CHKERRQ(ierr);
if (!accept) { /* Roll back the current step */
ts->ptime += next_time_step; /* This will be undone in rollback */
th->status = TS_STEP_INCOMPLETE;
ierr = TSRollBack(ts);CHKERRQ(ierr);
goto reject_step;
}
/* ignore next_scheme for now */
ts->ptime += ts->time_step;
ts->time_step = next_time_step;
ts->steps++;
th->status = TS_STEP_COMPLETE;
break;
reject_step:
if (!ts->reason && ++reject > ts->max_reject && ts->max_reject >= 0) {
ts->reason = TS_DIVERGED_STEP_REJECTED;
ierr = PetscInfo2(ts,"Step=%D, step rejections %D greater than current TS allowed, stopping solve\n",ts->steps,reject);CHKERRQ(ierr);
}
continue;
}
PetscFunctionReturn(0);
}
