/*MC
TSSSPRKS104 - Optimal fourth order SSP Runge-Kutta, low-storage (2N), c_eff=0.6
SSPRK(10,4), Pseudocode 3 of Ketcheson 2008
Level: beginner
.seealso: TSSSP, TSSSPSetType()
M*/
static PetscErrorCode TSSSPStep_RK_10_4(TS ts,PetscReal t0,PetscReal dt,Vec sol)
{
const PetscReal c[10] = {0, 1./6, 2./6, 3./6, 4./6, 2./6, 3./6, 4./6, 5./6, 1};
Vec *work,F;
PetscInt i;
PetscReal stage_time;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = TSSSPGetWorkVectors(ts,3,&work);CHKERRQ(ierr);
F = work[2];
ierr = VecCopy(sol,work[0]);CHKERRQ(ierr);
for (i=0; i<5; i++) {
stage_time = t0+c[i]*dt;
ierr = TSPreStage(ts,stage_time);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,stage_time,work[0],F);CHKERRQ(ierr);
ierr = VecAXPY(work[0],dt/6,F);CHKERRQ(ierr);
}
ierr = VecAXPBYPCZ(work[1],1./25,9./25,0,sol,work[0]);CHKERRQ(ierr);
ierr = VecAXPBY(work[0],15,-5,work[1]);CHKERRQ(ierr);
for (; i<9; i++) {
stage_time = t0+c[i]*dt;
ierr = TSPreStage(ts,stage_time);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,stage_time,work[0],F);CHKERRQ(ierr);
ierr = VecAXPY(work[0],dt/6,F);CHKERRQ(ierr);
}
stage_time = t0+dt;
ierr = TSPreStage(ts,stage_time);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,stage_time,work[0],F);CHKERRQ(ierr);
ierr = VecAXPBYPCZ(work[1],3./5,dt/10,1,work[0],F);CHKERRQ(ierr);
ierr = VecCopy(work[1],sol);CHKERRQ(ierr);
ierr = TSSSPRestoreWorkVectors(ts,3,&work);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*MC
TSSSPRKS3 - Optimal third order SSP Runge-Kutta, low-storage, c_eff=(PetscSqrtReal(s)-1)/PetscSqrtReal(s), where PetscSqrtReal(s) is an integer
Pseudocode 2 of Ketcheson 2008
Level: beginner
.seealso: TSSSP, TSSSPSetType(), TSSSPSetNumStages()
M*/
static PetscErrorCode TSSSPStep_RK_3(TS ts,PetscReal t0,PetscReal dt,Vec sol)
{
TS_SSP *ssp = (TS_SSP*)ts->data;
Vec *work,F;
PetscInt i,s,n,r;
PetscReal c,stage_time;
PetscErrorCode ierr;
PetscFunctionBegin;
s = ssp->nstages;
n = (PetscInt)(PetscSqrtReal((PetscReal)s)+0.001);
r = s-n;
if (n*n != s) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for optimal third order schemes with %d stages, must be a square number at least 4",s);
ierr = TSSSPGetWorkVectors(ts,3,&work);CHKERRQ(ierr);
F = work[2];
ierr = VecCopy(sol,work[0]);CHKERRQ(ierr);
for (i=0; i<(n-1)*(n-2)/2; i++) {
c = (i<n*(n+1)/2) ? 1.*i/(s-n) : (1.*i-n)/(s-n);
stage_time = t0+c*dt;
ierr = TSPreStage(ts,stage_time);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,stage_time,work[0],F);CHKERRQ(ierr);
ierr = VecAXPY(work[0],dt/r,F);CHKERRQ(ierr);
}
ierr = VecCopy(work[0],work[1]);CHKERRQ(ierr);
for (; i<n*(n+1)/2-1; i++) {
c = (i<n*(n+1)/2) ? 1.*i/(s-n) : (1.*i-n)/(s-n);
stage_time = t0+c*dt;
ierr = TSPreStage(ts,stage_time);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,stage_time,work[0],F);CHKERRQ(ierr);
ierr = VecAXPY(work[0],dt/r,F);CHKERRQ(ierr);
}
{
c = (i<n*(n+1)/2) ? 1.*i/(s-n) : (1.*i-n)/(s-n);
stage_time = t0+c*dt;
ierr = TSPreStage(ts,stage_time);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,stage_time,work[0],F);CHKERRQ(ierr);
ierr = VecAXPBYPCZ(work[0],1.*n/(2*n-1.),(n-1.)*dt/(r*(2*n-1)),(n-1.)/(2*n-1.),work[1],F);CHKERRQ(ierr);
i++;
}
for (; i<s; i++) {
c = (i<n*(n+1)/2) ? 1.*i/(s-n) : (1.*i-n)/(s-n);
stage_time = t0+c*dt;
ierr = TSPreStage(ts,stage_time);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,stage_time,work[0],F);CHKERRQ(ierr);
ierr = VecAXPY(work[0],dt/r,F);CHKERRQ(ierr);
}
ierr = VecCopy(work[0],sol);CHKERRQ(ierr);
ierr = TSSSPRestoreWorkVectors(ts,3,&work);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSStep_Euler(TS ts)
{
TS_Euler *euler = (TS_Euler*)ts->data;
Vec sol = ts->vec_sol,update = euler->update;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = TSPreStep(ts);CHKERRQ(ierr);
ierr = TSPreStage(ts,ts->ptime);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,ts->ptime,sol,update);CHKERRQ(ierr);
ierr = VecAXPY(sol,ts->time_step,update);CHKERRQ(ierr);
ts->ptime += ts->time_step;
ts->steps++;
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 TSStep_Pseudo(TS ts)
{
TS_Pseudo *pseudo = (TS_Pseudo*)ts->data;
PetscInt its,lits,reject;
PetscBool stepok;
PetscReal next_time_step;
SNESConvergedReason snesreason = SNES_CONVERGED_ITERATING;
PetscErrorCode ierr;
PetscFunctionBegin;
if (ts->steps == 0) pseudo->dt_initial = ts->time_step;
ierr = VecCopy(ts->vec_sol,pseudo->update);CHKERRQ(ierr);
next_time_step = ts->time_step;
ierr = TSPseudoComputeTimeStep(ts,&next_time_step);CHKERRQ(ierr);
for (reject=0; reject<ts->max_reject; reject++,ts->reject++) {
ts->time_step = next_time_step;
ierr = TSPreStep(ts);CHKERRQ(ierr);
ierr = TSPreStage(ts,ts->ptime+ts->time_step);CHKERRQ(ierr);
ierr = SNESSolve(ts->snes,NULL,pseudo->update);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(ts->snes,&snesreason);CHKERRQ(ierr);
ierr = SNESGetLinearSolveIterations(ts->snes,&lits);CHKERRQ(ierr);
ierr = SNESGetIterationNumber(ts->snes,&its);CHKERRQ(ierr);
ierr = TSPostStage(ts,ts->ptime+ts->time_step,0,&(pseudo->update));CHKERRQ(ierr);
ts->snes_its += its; ts->ksp_its += lits;
ierr = PetscInfo3(ts,"step=%D, nonlinear solve iterations=%D, linear solve iterations=%D\n",ts->steps,its,lits);CHKERRQ(ierr);
pseudo->fnorm = -1; /* The current norm is no longer valid, monitor must recompute it. */
ierr = TSPseudoVerifyTimeStep(ts,pseudo->update,&next_time_step,&stepok);CHKERRQ(ierr);
if (stepok) break;
}
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 (reject >= ts->max_reject) {
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);
PetscFunctionReturn(0);
}
ierr = VecCopy(pseudo->update,ts->vec_sol);CHKERRQ(ierr);
ts->ptime += ts->time_step;
ts->time_step = next_time_step;
ts->steps++;
PetscFunctionReturn(0);
}
/*MC
TSSSPRKS2 - Optimal second order SSP Runge-Kutta method, low-storage, c_eff=(s-1)/s
Pseudocode 2 of Ketcheson 2008
Level: beginner
.seealso: TSSSP, TSSSPSetType(), TSSSPSetNumStages()
M*/
static PetscErrorCode TSSSPStep_RK_2(TS ts,PetscReal t0,PetscReal dt,Vec sol)
{
TS_SSP *ssp = (TS_SSP*)ts->data;
Vec *work,F;
PetscInt i,s;
PetscErrorCode ierr;
PetscFunctionBegin;
s = ssp->nstages;
ierr = TSSSPGetWorkVectors(ts,2,&work);CHKERRQ(ierr);
F = work[1];
ierr = VecCopy(sol,work[0]);CHKERRQ(ierr);
for (i=0; i<s-1; i++) {
PetscReal stage_time = t0+dt*(i/(s-1.));
ierr = TSPreStage(ts,stage_time);CHKERRQ(ierr);
ierr = TSComputeRHSFunction(ts,stage_time,work[0],F);CHKERRQ(ierr);
ierr = VecAXPY(work[0],dt/(s-1.),F);CHKERRQ(ierr);
}
ierr = TSComputeRHSFunction(ts,t0+dt,work[0],F);CHKERRQ(ierr);
ierr = VecAXPBYPCZ(sol,(s-1.)/s,dt/s,1./s,work[0],F);CHKERRQ(ierr);
ierr = TSSSPRestoreWorkVectors(ts,2,&work);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSStep_RK(TS ts)
{
TS_RK *rk = (TS_RK*)ts->data;
RKTableau tab = rk->tableau;
const PetscInt s = tab->s;
const PetscReal *A = tab->A,*c = tab->c;
PetscScalar *w = rk->work;
Vec *Y = rk->Y,*YdotRHS = rk->YdotRHS;
TSAdapt adapt;
PetscInt i,j;
PetscInt rejections = 0;
PetscBool stageok,accept = PETSC_TRUE;
PetscReal next_time_step = ts->time_step;
PetscErrorCode ierr;
PetscFunctionBegin;
rk->status = TS_STEP_INCOMPLETE;
while (!ts->reason && rk->status != TS_STEP_COMPLETE) {
PetscReal t = ts->ptime;
PetscReal h = ts->time_step;
for (i=0; i<s; i++) {
rk->stage_time = t + h*c[i];
ierr = TSPreStage(ts,rk->stage_time); CHKERRQ(ierr);
ierr = VecCopy(ts->vec_sol,Y[i]);CHKERRQ(ierr);
for (j=0; j<i; j++) w[j] = h*A[i*s+j];
ierr = VecMAXPY(Y[i],i,w,YdotRHS);CHKERRQ(ierr);
ierr = TSPostStage(ts,rk->stage_time,i,Y); CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptCheckStage(adapt,ts,rk->stage_time,Y[i],&stageok);CHKERRQ(ierr);
if (!stageok) goto reject_step;
ierr = TSComputeRHSFunction(ts,t+h*c[i],Y[i],YdotRHS[i]);CHKERRQ(ierr);
}
rk->status = TS_STEP_INCOMPLETE;
ierr = TSEvaluateStep(ts,tab->order,ts->vec_sol,NULL);CHKERRQ(ierr);
rk->status = TS_STEP_PENDING;
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptCandidatesClear(adapt);CHKERRQ(ierr);
ierr = TSAdaptCandidateAdd(adapt,tab->name,tab->order,1,tab->ccfl,1.*tab->s,PETSC_TRUE);CHKERRQ(ierr);
ierr = TSAdaptChoose(adapt,ts,ts->time_step,NULL,&next_time_step,&accept);CHKERRQ(ierr);
rk->status = accept ? TS_STEP_COMPLETE : TS_STEP_INCOMPLETE;
if (!accept) { /* Roll back the current step */
ierr = TSRollBack_RK(ts);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*/
rk->ptime = ts->ptime;
rk->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_Alpha(TS ts)
{
TS_Alpha *th = (TS_Alpha*)ts->data;
PetscInt its,lits,reject;
PetscReal next_time_step;
SNESConvergedReason snesreason = SNES_CONVERGED_ITERATING;
PetscErrorCode ierr;
PetscFunctionBegin;
if (ts->steps == 0) {
ierr = VecSet(th->V0,0.0);CHKERRQ(ierr);
} else {
ierr = VecCopy(th->V1,th->V0);CHKERRQ(ierr);
}
ierr = VecCopy(ts->vec_sol,th->X0);CHKERRQ(ierr);
next_time_step = ts->time_step;
for (reject=0; reject<ts->max_reject; reject++,ts->reject++) {
ts->time_step = next_time_step;
th->stage_time = ts->ptime + th->Alpha_f*ts->time_step;
th->shift = th->Alpha_m/(th->Alpha_f*th->Gamma*ts->time_step);
ierr = TSPreStep(ts);CHKERRQ(ierr);
ierr = TSPreStage(ts,th->stage_time);CHKERRQ(ierr);
/* predictor */
ierr = VecCopy(th->X0,th->X1);CHKERRQ(ierr);
/* solve R(X,V) = 0 */
ierr = SNESSolve(ts->snes,PETSC_NULL,th->X1);CHKERRQ(ierr);
/* V1 = (1-1/Gamma)*V0 + 1/(Gamma*dT)*(X1-X0) */
ierr = VecWAXPY(th->V1,-1,th->X0,th->X1);CHKERRQ(ierr);
ierr = VecAXPBY(th->V1,1-1/th->Gamma,1/(th->Gamma*ts->time_step),th->V0);CHKERRQ(ierr);
/* nonlinear solve convergence */
ierr = SNESGetConvergedReason(ts->snes,&snesreason);CHKERRQ(ierr);
if (snesreason < 0 && !th->adapt) break;
ierr = SNESGetIterationNumber(ts->snes,&its);CHKERRQ(ierr);
ierr = SNESGetLinearSolveIterations(ts->snes,&lits);CHKERRQ(ierr);
ts->snes_its += its; ts->ksp_its += lits;
ierr = PetscInfo3(ts,"step=%D, nonlinear solve iterations=%D, linear solve iterations=%D\n",ts->steps,its,lits);CHKERRQ(ierr);
/* time step adaptativity */
if (!th->adapt) break;
else {
PetscReal t1 = ts->ptime + ts->time_step;
PetscBool stepok = (reject==0) ? PETSC_TRUE : PETSC_FALSE;
ierr = th->adapt(ts,t1,th->X1,th->V1,&next_time_step,&stepok,th->adaptctx);CHKERRQ(ierr);
ierr = PetscInfo5(ts,"Step %D (t=%G,dt=%G) %s, next dt=%G\n",ts->steps,ts->ptime,ts->time_step,stepok?"accepted":"rejected",next_time_step);CHKERRQ(ierr);
if (stepok) break;
}
}
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 (reject >= ts->max_reject) {
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);
PetscFunctionReturn(0);
}
ierr = VecCopy(th->X1,ts->vec_sol);CHKERRQ(ierr);
ts->ptime += ts->time_step;
ts->time_step = next_time_step;
ts->steps++;
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_Alpha(TS ts)
{
TS_Alpha *th = (TS_Alpha*)ts->data;
PetscInt rejections = 0;
PetscBool stageok,accept = PETSC_TRUE;
PetscReal next_time_step = ts->time_step;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscCitationsRegister(citation,&cited);CHKERRQ(ierr);
if (!ts->steprollback) {
if (th->adapt) { ierr = VecCopy(th->X0,th->vec_sol_prev);CHKERRQ(ierr); }
if (th->adapt) { ierr = VecCopy(th->V0,th->vec_dot_prev);CHKERRQ(ierr); }
ierr = VecCopy(ts->vec_sol,th->X0);CHKERRQ(ierr);
ierr = VecCopy(ts->vec_dot,th->V0);CHKERRQ(ierr);
ierr = VecCopy(th->A1,th->A0);CHKERRQ(ierr);
}
th->status = TS_STEP_INCOMPLETE;
while (!ts->reason && th->status != TS_STEP_COMPLETE) {
if (ts->steprestart) {
ierr = TSAlpha_Restart(ts,&stageok);CHKERRQ(ierr);
if (!stageok) goto reject_step;
}
ierr = TSAlpha_StageTime(ts);CHKERRQ(ierr);
ierr = VecCopy(th->X0,th->X1);CHKERRQ(ierr);
ierr = TSPreStage(ts,th->stage_time);CHKERRQ(ierr);
ierr = TS_SNESSolve(ts,NULL,th->X1);CHKERRQ(ierr);
ierr = TSPostStage(ts,th->stage_time,0,&th->Xa);CHKERRQ(ierr);
ierr = TSAdaptCheckStage(ts->adapt,ts,th->stage_time,th->Xa,&stageok);CHKERRQ(ierr);
if (!stageok) goto reject_step;
th->status = TS_STEP_PENDING;
ierr = VecCopy(th->X1,ts->vec_sol);CHKERRQ(ierr);
ierr = VecCopy(th->V1,ts->vec_dot);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);
ierr = VecCopy(th->V0,ts->vec_dot);CHKERRQ(ierr);
ts->time_step = next_time_step;
goto reject_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 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);
}
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);
}
static PetscErrorCode TSStep_RK(TS ts)
{
TS_RK *rk = (TS_RK*)ts->data;
RKTableau tab = rk->tableau;
const PetscInt s = tab->s;
const PetscReal *A = tab->A,*b = tab->b,*c = tab->c;
PetscScalar *w = rk->work;
Vec *Y = rk->Y,*YdotRHS = rk->YdotRHS;
TSAdapt adapt;
PetscInt i,j,reject,next_scheme;
PetscReal next_time_step;
PetscReal t;
PetscBool accept;
PetscErrorCode ierr;
PetscFunctionBegin;
next_time_step = ts->time_step;
t = ts->ptime;
accept = PETSC_TRUE;
rk->status = TS_STEP_INCOMPLETE;
for (reject=0; reject<ts->max_reject && !ts->reason; reject++,ts->reject++) {
PetscReal h = ts->time_step;
ierr = TSPreStep(ts);CHKERRQ(ierr);
for (i=0; i<s; i++) {
rk->stage_time = t + h*c[i];
ierr = TSPreStage(ts,rk->stage_time); CHKERRQ(ierr);
ierr = VecCopy(ts->vec_sol,Y[i]);CHKERRQ(ierr);
for (j=0; j<i; j++) w[j] = h*A[i*s+j];
ierr = VecMAXPY(Y[i],i,w,YdotRHS);CHKERRQ(ierr);
ierr = TSPostStage(ts,rk->stage_time,i,Y); CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptCheckStage(adapt,ts,&accept);CHKERRQ(ierr);
if (!accept) goto reject_step;
ierr = TSComputeRHSFunction(ts,t+h*c[i],Y[i],YdotRHS[i]);CHKERRQ(ierr);
}
ierr = TSEvaluateStep(ts,tab->order,ts->vec_sol,NULL);CHKERRQ(ierr);
rk->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,tab->name,tab->order,1,tab->ccfl,1.*tab->s,PETSC_TRUE);CHKERRQ(ierr);
ierr = TSAdaptChoose(adapt,ts,ts->time_step,&next_scheme,&next_time_step,&accept);CHKERRQ(ierr);
if (accept) {
if (ts->costintegralfwd) {
/* Evolve ts->vec_costintegral to compute integrals */
for (i=0; i<s; i++) {
ierr = TSAdjointComputeCostIntegrand(ts,t+h*c[i],Y[i],ts->vec_costintegrand);CHKERRQ(ierr);
ierr = VecAXPY(ts->vec_costintegral,h*b[i],ts->vec_costintegrand);CHKERRQ(ierr);
}
}
/* ignore next_scheme for now */
ts->ptime += ts->time_step;
ts->time_step = next_time_step;
ts->steps++;
rk->status = TS_STEP_COMPLETE;
ierr = PetscObjectComposedDataSetReal((PetscObject)ts->vec_sol,explicit_stage_time_id,ts->ptime);CHKERRQ(ierr);
break;
} else { /* Roll back the current step */
for (j=0; j<s; j++) w[j] = -h*b[j];
ierr = VecMAXPY(ts->vec_sol,s,w,rk->YdotRHS);CHKERRQ(ierr);
ts->time_step = next_time_step;
rk->status = TS_STEP_INCOMPLETE;
}
reject_step: continue;
}
if (rk->status != TS_STEP_COMPLETE && !ts->reason) ts->reason = TS_DIVERGED_STEP_REJECTED;
PetscFunctionReturn(0);
}
void PETSC_STDCALL tsprestage_(TS ts,PetscReal *stagetime, int *__ierr ){
*__ierr = TSPreStage(
(TS)PetscToPointer((ts) ),*stagetime);
}
