static PetscErrorCode TSStep_Euler(TS ts,PetscInt *steps,PetscReal *ptime)
{
TS_Euler *euler = (TS_Euler*)ts->data;
Vec sol = ts->vec_sol,update = euler->update;
PetscErrorCode ierr;
PetscInt i,max_steps = ts->max_steps;
PetscFunctionBegin;
*steps = -ts->steps;
ierr = TSMonitor(ts,ts->steps,ts->ptime,sol);CHKERRQ(ierr);
for (i=0; i<max_steps; i++) {
PetscReal dt = ts->time_step;
ierr = TSPreStep(ts);CHKERRQ(ierr);
ts->ptime += dt;
ierr = TSComputeRHSFunction(ts,ts->ptime,sol,update);CHKERRQ(ierr);
ierr = VecAXPY(sol,dt,update);CHKERRQ(ierr);
ts->steps++;
ierr = TSPostStep(ts);CHKERRQ(ierr);
ierr = TSMonitor(ts,ts->steps,ts->ptime,sol);CHKERRQ(ierr);
if (ts->ptime > ts->max_time) break;
}
*steps += ts->steps;
*ptime = ts->ptime;
PetscFunctionReturn(0);
}
static PetscErrorCode TSAdjointStep_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,*VecDeltaLam = rk->VecDeltaLam,*VecDeltaMu = rk->VecDeltaMu,*VecSensiTemp = rk->VecSensiTemp;
PetscInt i,j,nadj;
PetscReal t;
PetscErrorCode ierr;
PetscReal h = ts->time_step;
Mat J,Jp;
PetscFunctionBegin;
t = ts->ptime;
rk->status = TS_STEP_INCOMPLETE;
h = ts->time_step;
ierr = TSPreStep(ts);CHKERRQ(ierr);
for (i=s-1; i>=0; i--) {
rk->stage_time = t + h*(1.0-c[i]);
for (nadj=0; nadj<ts->numcost; nadj++) {
ierr = VecCopy(ts->vecs_sensi[nadj],VecSensiTemp[nadj]);CHKERRQ(ierr);
ierr = VecScale(VecSensiTemp[nadj],-h*b[i]);
for (j=i+1; j<s; j++) {
ierr = VecAXPY(VecSensiTemp[nadj],-h*A[j*s+i],VecDeltaLam[nadj*s+j]);
}
}
/* Stage values of lambda */
ierr = TSGetRHSJacobian(ts,&J,&Jp,NULL,NULL);CHKERRQ(ierr);
ierr = TSComputeRHSJacobian(ts,rk->stage_time,Y[i],J,Jp);CHKERRQ(ierr);
for (nadj=0; nadj<ts->numcost; nadj++) {
ierr = MatMultTranspose(J,VecSensiTemp[nadj],VecDeltaLam[nadj*s+i]);CHKERRQ(ierr);
}
/* Stage values of mu */
if(ts->vecs_sensip) {
ierr = TSAdjointComputeRHSJacobian(ts,rk->stage_time,Y[i],ts->Jacp);CHKERRQ(ierr);
for (nadj=0; nadj<ts->numcost; nadj++) {
ierr = MatMultTranspose(ts->Jacp,VecSensiTemp[nadj],VecDeltaMu[nadj*s+i]);CHKERRQ(ierr);
}
}
}
for (j=0; j<s; j++) w[j] = 1.0;
for (nadj=0; nadj<ts->numcost; nadj++) {
ierr = VecMAXPY(ts->vecs_sensi[nadj],s,w,&VecDeltaLam[nadj*s]);CHKERRQ(ierr);
if(ts->vecs_sensip) {
ierr = VecMAXPY(ts->vecs_sensip[nadj],s,w,&VecDeltaMu[nadj*s]);CHKERRQ(ierr);
}
}
ts->ptime += ts->time_step;
ts->steps++;
rk->status = TS_STEP_COMPLETE;
PetscFunctionReturn(0);
}
static PetscErrorCode TSStep_SSP(TS ts)
{
TS_SSP *ssp = (TS_SSP*)ts->data;
Vec sol = ts->vec_sol;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = TSPreStep(ts);CHKERRQ(ierr);
ierr = (*ssp->onestep)(ts,ts->ptime,ts->time_step,sol);CHKERRQ(ierr);
ts->ptime += ts->time_step;
ts->steps++;
PetscFunctionReturn(0);
}
PetscErrorCode TSStep_Sundials_Nonlinear(TS ts,int *steps,double *time)
{
TS_Sundials *cvode = (TS_Sundials*)ts->data;
Vec sol = ts->vec_sol;
PetscErrorCode ierr;
PetscInt i,max_steps = ts->max_steps,flag;
long int its;
realtype t,tout;
PetscScalar *y_data;
void *mem;
PetscFunctionBegin;
mem = cvode->mem;
tout = ts->max_time;
ierr = VecGetArray(ts->vec_sol,&y_data);CHKERRQ(ierr);
N_VSetArrayPointer((realtype *)y_data,cvode->y);
ierr = VecRestoreArray(ts->vec_sol,PETSC_NULL);CHKERRQ(ierr);
for (i = 0; i < max_steps; i++) {
if (ts->ptime >= ts->max_time) break;
ierr = TSPreStep(ts);CHKERRQ(ierr);
if (cvode->monitorstep){
flag = CVode(mem,tout,cvode->y,&t,CV_ONE_STEP);
} else {
flag = CVode(mem,tout,cvode->y,&t,CV_NORMAL);
}
if (flag)SETERRQ1(PETSC_ERR_LIB,"CVode() fails, flag %d",flag);
if (t > ts->max_time && cvode->exact_final_time) {
/* interpolate to final requested time */
ierr = CVodeGetDky(mem,tout,0,cvode->y);CHKERRQ(ierr);
t = tout;
}
ts->time_step = t - ts->ptime;
ts->ptime = t;
/* copy the solution from cvode->y to cvode->update and sol */
ierr = VecPlaceArray(cvode->w1,y_data); CHKERRQ(ierr);
ierr = VecCopy(cvode->w1,cvode->update);CHKERRQ(ierr);
ierr = VecResetArray(cvode->w1); CHKERRQ(ierr);
ierr = VecCopy(cvode->update,sol);CHKERRQ(ierr);
ierr = CVodeGetNumNonlinSolvIters(mem,&its);CHKERRQ(ierr);
ts->nonlinear_its = its;
ierr = CVSpilsGetNumLinIters(mem, &its);
ts->linear_its = its;
ts->steps++;
ierr = TSPostStep(ts);CHKERRQ(ierr);
ierr = TSMonitor(ts,ts->steps,t,sol);CHKERRQ(ierr);
}
*steps += ts->steps;
*time = t;
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);
}
PetscErrorCode TSStep_Sundials(TS ts)
{
TS_Sundials *cvode = (TS_Sundials*)ts->data;
PetscErrorCode ierr;
PetscInt flag;
long int its,nsteps;
realtype t,tout;
PetscScalar *y_data;
void *mem;
PetscFunctionBegin;
mem = cvode->mem;
tout = ts->max_time;
ierr = VecGetArray(ts->vec_sol,&y_data);CHKERRQ(ierr);
N_VSetArrayPointer((realtype*)y_data,cvode->y);
ierr = VecRestoreArray(ts->vec_sol,NULL);CHKERRQ(ierr);
ierr = TSPreStep(ts);CHKERRQ(ierr);
/* We would like to call TSPreStep() when starting each step (including rejections) and TSPreStage() before each
* stage solve, but CVode does not appear to support this. */
if (cvode->monitorstep) flag = CVode(mem,tout,cvode->y,&t,CV_ONE_STEP);
else flag = CVode(mem,tout,cvode->y,&t,CV_NORMAL);
if (flag) { /* display error message */
switch (flag) {
case CV_ILL_INPUT:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_ILL_INPUT");
break;
case CV_TOO_CLOSE:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_TOO_CLOSE");
break;
case CV_TOO_MUCH_WORK: {
PetscReal tcur;
ierr = CVodeGetNumSteps(mem,&nsteps);CHKERRQ(ierr);
ierr = CVodeGetCurrentTime(mem,&tcur);CHKERRQ(ierr);
SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_TOO_MUCH_WORK. At t=%G, nsteps %D exceeds mxstep %D. Increase '-ts_max_steps <>' or modify TSSetDuration()",tcur,nsteps,ts->max_steps);
} break;
case CV_TOO_MUCH_ACC:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_TOO_MUCH_ACC");
break;
case CV_ERR_FAILURE:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_ERR_FAILURE");
break;
case CV_CONV_FAILURE:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_CONV_FAILURE");
break;
case CV_LINIT_FAIL:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_LINIT_FAIL");
break;
case CV_LSETUP_FAIL:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_LSETUP_FAIL");
break;
case CV_LSOLVE_FAIL:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_LSOLVE_FAIL");
break;
case CV_RHSFUNC_FAIL:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_RHSFUNC_FAIL");
break;
case CV_FIRST_RHSFUNC_ERR:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_FIRST_RHSFUNC_ERR");
break;
case CV_REPTD_RHSFUNC_ERR:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_REPTD_RHSFUNC_ERR");
break;
case CV_UNREC_RHSFUNC_ERR:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_UNREC_RHSFUNC_ERR");
break;
case CV_RTFUNC_FAIL:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_RTFUNC_FAIL");
break;
default:
SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, flag %d",flag);
}
}
/* copy the solution from cvode->y to cvode->update and sol */
ierr = VecPlaceArray(cvode->w1,y_data);CHKERRQ(ierr);
ierr = VecCopy(cvode->w1,cvode->update);CHKERRQ(ierr);
ierr = VecResetArray(cvode->w1);CHKERRQ(ierr);
ierr = VecCopy(cvode->update,ts->vec_sol);CHKERRQ(ierr);
ierr = CVodeGetNumNonlinSolvIters(mem,&its);CHKERRQ(ierr);
ierr = CVSpilsGetNumLinIters(mem, &its);
ts->snes_its = its; ts->ksp_its = its;
ts->time_step = t - ts->ptime;
ts->ptime = t;
ts->steps++;
ierr = CVodeGetNumSteps(mem,&nsteps);CHKERRQ(ierr);
if (!cvode->monitorstep) ts->steps = nsteps;
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 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 TSSolve_RK(TS ts)
{
TS_RK *rk = (TS_RK*)ts->data;
PetscReal norm=0.0,dt_fac=0.0,fac = 0.0/*,ttmp=0.0*/;
PetscInt i;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecCopy(ts->vec_sol,rk->y1);CHKERRQ(ierr);
/* while loop to get from start to stop */
for (i = 0; i < ts->max_steps; i++) {
ierr = TSPreStep(ts);CHKERRQ(ierr); /* Note that this is called once per STEP, not once per STAGE. */
/* calling rkqs */
/*
-- input
ts - pointer to ts
ts->ptime - current time
ts->time_step - try this timestep
y1 - solution for this step
--output
y1 - suggested solution
y2 - check solution (runge - kutta second permutation)
*/
ierr = TSRKqs(ts,ts->ptime,ts->time_step);CHKERRQ(ierr);
/* counting steps */
ts->steps++;
/* checking for maxerror */
/* comparing difference to maxerror */
ierr = VecNorm(rk->y2,NORM_2,&norm);CHKERRQ(ierr);
/* modifying maxerror to satisfy this timestep */
rk->maxerror = rk->ferror * ts->time_step;
/* ierr = PetscPrintf(PETSC_COMM_WORLD,"norm err: %f maxerror: %f dt: %f",norm,rk->maxerror,ts->time_step);CHKERRQ(ierr); */
/* handling ok and not ok */
if (norm < rk->maxerror){
/* if ok: */
ierr=VecCopy(rk->y1,ts->vec_sol);CHKERRQ(ierr); /* saves the suggested solution to current solution */
ts->ptime += ts->time_step; /* storing the new current time */
rk->nok++;
fac=5.0;
/* trying to save the vector */
ierr = TSPostStep(ts);CHKERRQ(ierr);
ierr = TSMonitor(ts,ts->steps,ts->ptime,ts->vec_sol);CHKERRQ(ierr);
if (ts->ptime >= ts->max_time) break;
} else{
/* if not OK */
rk->nnok++;
fac=1.0;
ierr=VecCopy(ts->vec_sol,rk->y1);CHKERRQ(ierr); /* restores old solution */
}
/*Computing next stepsize. See page 167 in Solving ODE 1
*
* h_new = h * min( facmax , max( facmin , fac * (tol/err)^(1/(p+1)) ) )
* facmax set above
* facmin
*/
dt_fac = exp(log((rk->maxerror) / norm) / ((rk->p) + 1) ) * 0.9 ;
if (dt_fac > fac){
/*ierr = PetscPrintf(PETSC_COMM_WORLD,"changing fac %f\n",fac);*/
dt_fac = fac;
}
/* computing new ts->time_step */
ts->time_step = ts->time_step * dt_fac;
if (ts->ptime+ts->time_step > ts->max_time){
ts->time_step = ts->max_time - ts->ptime;
}
if (ts->time_step < 1e-14){
ierr = PetscPrintf(PETSC_COMM_WORLD,"Very small steps: %f\n",ts->time_step);CHKERRQ(ierr);
ts->time_step = 1e-14;
}
/* trying to purify h */
/* (did not give any visible result) */
/* ttmp = ts->ptime + ts->time_step;
ts->time_step = ttmp - ts->ptime; */
}
ierr=VecCopy(rk->y1,ts->vec_sol);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,*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 tsprestep_(TS ts, int *__ierr ){
*__ierr = TSPreStep(
(TS)PetscToPointer((ts) ));
}
