static PetscErrorCode TSAdaptChoose_Basic(TSAdapt adapt,TS ts,PetscReal h,PetscInt *next_sc,PetscReal *next_h,PetscBool *accept,PetscReal *wlte)
{
TSAdapt_Basic *basic = (TSAdapt_Basic*)adapt->data;
PetscInt order = PETSC_DECIDE;
PetscReal enorm = -1;
PetscReal safety = basic->safety;
PetscReal hfac_lte,h_lte;
PetscErrorCode ierr;
PetscFunctionBegin;
*next_sc = 0; /* Reuse the same order scheme */
if (ts->ops->evaluatewlte) {
ierr = TSEvaluateWLTE(ts,adapt->wnormtype,&order,&enorm);CHKERRQ(ierr);
if (enorm >= 0 && order < 1) SETERRQ1(PetscObjectComm((PetscObject)adapt),PETSC_ERR_ARG_OUTOFRANGE,"Computed error order %D must be positive",order);
} else if (ts->ops->evaluatestep) {
if (adapt->candidates.n < 1) SETERRQ(PetscObjectComm((PetscObject)adapt),PETSC_ERR_ARG_WRONGSTATE,"No candidate has been registered");
if (!adapt->candidates.inuse_set) SETERRQ1(PetscObjectComm((PetscObject)adapt),PETSC_ERR_ARG_WRONGSTATE,"The current in-use scheme is not among the %D candidates",adapt->candidates.n);
if (!basic->Y) {ierr = VecDuplicate(ts->vec_sol,&basic->Y);CHKERRQ(ierr);}
order = adapt->candidates.order[0];
ierr = TSEvaluateStep(ts,order-1,basic->Y,NULL);CHKERRQ(ierr);
ierr = TSErrorWeightedNorm(ts,ts->vec_sol,basic->Y,adapt->wnormtype,&enorm);CHKERRQ(ierr);
}
if (enorm < 0) {
*accept = PETSC_TRUE;
*next_h = h; /* Reuse the old step */
*wlte = -1; /* Weighted local truncation error was not evaluated */
PetscFunctionReturn(0);
}
/* Determine whether the step is accepted of rejected */
if (enorm > 1) {
if (!*accept) safety *= basic->reject_safety; /* The last attempt also failed, shorten more aggressively */
if (h < (1 + PETSC_SQRT_MACHINE_EPSILON)*adapt->dt_min) {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting because step size %g is at minimum\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
} else if (basic->always_accept) {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting step of size %g because always_accept is set\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
} else {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, rejecting step of size %g\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_FALSE;
}
} else {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting step of size %g\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
}
/* The optimal new step based purely on local truncation error for this step. */
if (enorm > 0)
hfac_lte = safety * PetscPowReal(enorm,((PetscReal)-1)/order);
else
hfac_lte = safety * PETSC_INFINITY;
h_lte = h * PetscClipInterval(hfac_lte,basic->clip[0],basic->clip[1]);
*next_h = PetscClipInterval(h_lte,adapt->dt_min,adapt->dt_max);
*wlte = enorm;
PetscFunctionReturn(0);
}
static PetscErrorCode TSAdaptChoose_Basic(TSAdapt adapt,TS ts,PetscReal h,PetscInt *next_sc,PetscReal *next_h,PetscBool *accept,PetscReal *wlte)
{
TSAdapt_Basic *basic = (TSAdapt_Basic*)adapt->data;
PetscErrorCode ierr;
Vec X,Y;
PetscReal enorm,hfac_lte,h_lte,safety;
PetscInt order,stepno;
PetscFunctionBegin;
ierr = TSGetTimeStepNumber(ts,&stepno);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
if (!basic->Y) {ierr = VecDuplicate(X,&basic->Y);CHKERRQ(ierr);}
Y = basic->Y;
order = adapt->candidates.order[0];
ierr = TSEvaluateStep(ts,order-1,Y,NULL);CHKERRQ(ierr);
safety = basic->safety;
ierr = TSErrorNormWRMS(ts,Y,&enorm);CHKERRQ(ierr);
if (enorm > 1.) {
if (!*accept) safety *= basic->reject_safety; /* The last attempt also failed, shorten more aggressively */
if (h < (1 + PETSC_SQRT_MACHINE_EPSILON)*adapt->dt_min) {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting because step size %g is at minimum\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
} else if (basic->always_accept) {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting step of size %g because always_accept is set\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
} else {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, rejecting step of size %g\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_FALSE;
}
} else {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting step of size %g\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
}
/* The optimal new step based purely on local truncation error for this step. */
hfac_lte = safety * PetscRealPart(PetscPowScalar((PetscScalar)enorm,(PetscReal)(-1./order)));
h_lte = h * PetscClipInterval(hfac_lte,basic->clip[0],basic->clip[1]);
*next_sc = 0;
*next_h = PetscClipInterval(h_lte,adapt->dt_min,adapt->dt_max);
*wlte = enorm;
PetscFunctionReturn(0);
}
static PetscErrorCode TSAdaptChoose_CFL(TSAdapt adapt,TS ts,PetscReal h,PetscInt *next_sc,PetscReal *next_h,PetscBool *accept,PetscReal *wlte)
{
TSAdapt_CFL *cfl = (TSAdapt_CFL*)adapt->data;
PetscErrorCode ierr;
PetscReal hcfl,cfltime;
PetscInt stepno,ncandidates;
const PetscInt *order;
const PetscReal *ccfl;
PetscFunctionBegin;
ierr = TSGetTimeStepNumber(ts,&stepno);CHKERRQ(ierr);
ierr = TSGetCFLTime(ts,&cfltime);CHKERRQ(ierr);
ierr = TSAdaptCandidatesGet(adapt,&ncandidates,&order,NULL,&ccfl,NULL);CHKERRQ(ierr);
hcfl = cfl->safety * cfltime * ccfl[0];
if (hcfl < adapt->dt_min) {
ierr = PetscInfo4(adapt,"Cannot satisfy CFL constraint %g (with %g safety) at minimum time step %g with method coefficient %g, proceding anyway\n",(double)cfltime,(double)cfl->safety,(double)adapt->dt_min,(double)ccfl[0]);CHKERRQ(ierr);
}
if (h > cfltime * ccfl[0]) {
if (cfl->always_accept) {
ierr = PetscInfo3(adapt,"Step length %g with scheme of CFL coefficient %g did not satisfy user-provided CFL constraint %g, proceeding anyway\n",(double)h,(double)ccfl[0],(double)cfltime);CHKERRQ(ierr);
} else {
ierr = PetscInfo3(adapt,"Step length %g with scheme of CFL coefficient %g did not satisfy user-provided CFL constraint %g, step REJECTED\n",(double)h,(double)ccfl[0],(double)cfltime);CHKERRQ(ierr);
*next_sc = 0;
*next_h = PetscClipInterval(hcfl,adapt->dt_min,adapt->dt_max);
*accept = PETSC_FALSE;
}
}
*next_sc = 0;
*next_h = PetscClipInterval(hcfl,adapt->dt_min,adapt->dt_max);
*accept = PETSC_TRUE;
*wlte = -1; /* Weighted local truncation error was not evaluated */
PetscFunctionReturn(0);
}
/*
Compare the direction of the current and previous step, modify the current step accordingly
*/
PetscErrorCode PreCheckFunction(SNESLineSearch linesearch,Vec X,Vec Y,PetscBool *changed, void *ctx)
{
PetscErrorCode ierr;
PreCheck precheck;
Vec Ylast;
PetscScalar dot;
PetscInt iter;
PetscReal ynorm,ylastnorm,theta,angle_radians;
SNES snes;
PetscFunctionBegin;
ierr = SNESLineSearchGetSNES(linesearch, &snes);CHKERRQ(ierr);
precheck = (PreCheck)ctx;
if (!precheck->Ylast) {ierr = VecDuplicate(Y,&precheck->Ylast);CHKERRQ(ierr);}
Ylast = precheck->Ylast;
ierr = SNESGetIterationNumber(snes,&iter);CHKERRQ(ierr);
if (iter < 1) {
ierr = VecCopy(Y,Ylast);CHKERRQ(ierr);
*changed = PETSC_FALSE;
PetscFunctionReturn(0);
}
ierr = VecDot(Y,Ylast,&dot);CHKERRQ(ierr);
ierr = VecNorm(Y,NORM_2,&ynorm);CHKERRQ(ierr);
ierr = VecNorm(Ylast,NORM_2,&ylastnorm);CHKERRQ(ierr);
/* Compute the angle between the vectors Y and Ylast, clip to keep inside the domain of acos() */
theta = acos((double)PetscClipInterval(PetscAbsScalar(dot) / (ynorm * ylastnorm),-1.0,1.0));
angle_radians = precheck->angle * PETSC_PI / 180.;
if (PetscAbsReal(theta) < angle_radians || PetscAbsReal(theta - PETSC_PI) < angle_radians) {
/* Modify the step Y */
PetscReal alpha,ydiffnorm;
ierr = VecAXPY(Ylast,-1.0,Y);CHKERRQ(ierr);
ierr = VecNorm(Ylast,NORM_2,&ydiffnorm);CHKERRQ(ierr);
alpha = ylastnorm / ydiffnorm;
ierr = VecCopy(Y,Ylast);CHKERRQ(ierr);
ierr = VecScale(Y,alpha);CHKERRQ(ierr);
if (precheck->monitor) {
ierr = PetscViewerASCIIPrintf(precheck->monitor,"Angle %E degrees less than threshold %G, corrected step by alpha=%G\n",theta*180./PETSC_PI,precheck->angle,alpha);CHKERRQ(ierr);
}
} else {
ierr = VecCopy(Y,Ylast);CHKERRQ(ierr);
*changed = PETSC_FALSE;
if (precheck->monitor) {
ierr = PetscViewerASCIIPrintf(precheck->monitor,"Angle %E degrees exceeds threshold %G, no correction applied\n",theta*180./PETSC_PI,precheck->angle);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
