static PetscErrorCode TSSetUp_Alpha(TS ts)
{
TS_Alpha *th = (TS_Alpha*)ts->data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecDuplicate(ts->vec_sol,&th->X0);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->Xa);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->X1);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->V0);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->Va);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->V1);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->A0);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->Aa);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->A1);CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&ts->adapt);CHKERRQ(ierr);
ierr = TSAdaptCandidatesClear(ts->adapt);CHKERRQ(ierr);
if (!th->adapt) {
ierr = TSAdaptSetType(ts->adapt,TSADAPTNONE);CHKERRQ(ierr);
} else {
ierr = VecDuplicate(ts->vec_sol,&th->vec_sol_prev);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->vec_dot_prev);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->vec_lte_work[0]);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->vec_lte_work[1]);CHKERRQ(ierr);
if (ts->exact_final_time == TS_EXACTFINALTIME_UNSPECIFIED)
ts->exact_final_time = TS_EXACTFINALTIME_MATCHSTEP;
}
ierr = TSGetSNES(ts,&ts->snes);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSSetUp_Theta(TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscErrorCode ierr;
SNES snes;
TSAdapt adapt;
DM dm;
PetscFunctionBegin;
ierr = VecDuplicate(ts->vec_sol,&th->X);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->Xdot);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->X0);CHKERRQ(ierr);
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
if (dm) {
ierr = DMCoarsenHookAdd(dm,DMCoarsenHook_TSTheta,DMRestrictHook_TSTheta,ts);CHKERRQ(ierr);
ierr = DMSubDomainHookAdd(dm,DMSubDomainHook_TSTheta,DMSubDomainRestrictHook_TSTheta,ts);CHKERRQ(ierr);
}
if (th->Theta == 0.5 && th->endpoint) th->order = 2;
else th->order = 1;
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
if (!th->adapt) {
ierr = TSAdaptSetType(adapt,TSADAPTNONE);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode TSStage_EIMEX(TS ts,PetscInt istage)
{
TS_EIMEX *ext = (TS_EIMEX*)ts->data;
PetscReal h;
Vec Y=ext->Y, Z=ext->Z;
SNES snes;
TSAdapt adapt;
PetscInt i,its,lits;
PetscBool accept;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
h = ts->time_step/ext->N[istage];/* step size for the istage-th stage */
ext->shift = 1./h;
ierr = SNESSetLagJacobian(snes,-2);CHKERRQ(ierr); /* Recompute the Jacobian on this solve, but not again */
ierr = VecCopy(ext->VecSolPrev,Y);CHKERRQ(ierr); /* Take the previous solution as intial step */
for(i=0; i<ext->N[istage]; i++){
ext->ctime = ts->ptime + h*i;
ierr = VecCopy(Y,Z);CHKERRQ(ierr);/* Save the solution of the previous substep */
ierr = SNESSolve(snes,NULL,Y);CHKERRQ(ierr);
ierr = SNESGetIterationNumber(snes,&its);CHKERRQ(ierr);
ierr = SNESGetLinearSolveIterations(snes,&lits);CHKERRQ(ierr);
ts->snes_its += its; ts->ksp_its += lits;
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptCheckStage(adapt,ts,ext->ctime,Y,&accept);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
virtual void setStepLimits(Real dtmin,Real dtmax) {
PetscErrorCode ierr;
TSAdapt adapt;
ierr = TSGetAdapt(this->_ts,&adapt);
CHKERRABORT(libMesh::COMM_WORLD,ierr);
ierr = TSAdaptSetStepLimits(adapt,dtmin,dtmax);
CHKERRABORT(libMesh::COMM_WORLD,ierr);
}
static PetscErrorCode TSSetUp_SSP(TS ts)
{
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = TSGetAdapt(ts,&ts->adapt);CHKERRQ(ierr);
ierr = TSAdaptCandidatesClear(ts->adapt);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSLoad_RK(TS ts,PetscViewer viewer)
{
PetscErrorCode ierr;
TSAdapt adapt;
PetscFunctionBegin;
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptLoad(adapt,viewer);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSSetUp_Theta(TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!th->VecCostIntegral0 && ts->vec_costintegral && ts->costintegralfwd) { /* back up cost integral */
ierr = VecDuplicate(ts->vec_costintegral,&th->VecCostIntegral0);CHKERRQ(ierr);
}
if (!th->X) {
ierr = VecDuplicate(ts->vec_sol,&th->X);CHKERRQ(ierr);
}
if (!th->Xdot) {
ierr = VecDuplicate(ts->vec_sol,&th->Xdot);CHKERRQ(ierr);
}
if (!th->X0) {
ierr = VecDuplicate(ts->vec_sol,&th->X0);CHKERRQ(ierr);
}
if (th->endpoint) {
ierr = VecDuplicate(ts->vec_sol,&th->affine);CHKERRQ(ierr);
}
th->order = (th->Theta == 0.5) ? 2 : 1;
ierr = TSGetDM(ts,&ts->dm);CHKERRQ(ierr);
ierr = DMCoarsenHookAdd(ts->dm,DMCoarsenHook_TSTheta,DMRestrictHook_TSTheta,ts);CHKERRQ(ierr);
ierr = DMSubDomainHookAdd(ts->dm,DMSubDomainHook_TSTheta,DMSubDomainRestrictHook_TSTheta,ts);CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&ts->adapt);CHKERRQ(ierr);
ierr = TSAdaptCandidatesClear(ts->adapt);CHKERRQ(ierr);
if (!th->adapt) {
ierr = TSAdaptSetType(ts->adapt,TSADAPTNONE);CHKERRQ(ierr);
} else {
ierr = VecDuplicate(ts->vec_sol,&th->vec_sol_prev);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&th->vec_lte_work);CHKERRQ(ierr);
if (ts->exact_final_time == TS_EXACTFINALTIME_UNSPECIFIED)
ts->exact_final_time = TS_EXACTFINALTIME_MATCHSTEP;
}
ierr = TSGetSNES(ts,&ts->snes);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSView_RK(TS ts,PetscViewer viewer)
{
TS_RK *rk = (TS_RK*)ts->data;
RKTableau tab = rk->tableau;
PetscBool iascii;
PetscErrorCode ierr;
TSAdapt adapt;
PetscFunctionBegin;
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
if (iascii) {
TSRKType rktype;
char buf[512];
ierr = TSRKGetType(ts,&rktype);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer," RK %s\n",rktype);CHKERRQ(ierr);
ierr = PetscFormatRealArray(buf,sizeof(buf),"% 8.6f",tab->s,tab->c);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer," Abscissa c = %s\n",buf);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"FSAL: %s\n",tab->FSAL ? "yes" : "no");CHKERRQ(ierr);
}
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptView(adapt,viewer);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec U; /* solution will be stored here */
Mat A; /* Jacobian matrix */
PetscErrorCode ierr;
PetscMPIInt rank;
PetscInt n = 2;
PetscScalar *u;
PetscInt direction=-1;
PetscBool terminate=PETSC_FALSE;
TSAdapt adapt;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&U,NULL);CHKERRQ(ierr);
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = 1.0*rank;
u[1] = 20.0;
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSROSW);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,NULL);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,(TSIJacobian)IJacobian,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSolution(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetDuration(ts,1000,30.0);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,0.1);CHKERRQ(ierr);
ierr = TSSetEventHandler(ts,1,&direction,&terminate,EventFunction,PostEventFunction,NULL);CHKERRQ(ierr);
/* The adapative time step controller could take very large timesteps resulting in
the same event occuring multiple times in the same interval. A maximum step size
limit is enforced here to avoid this issue.
*/
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptSetStepLimits(adapt,0.0,0.5);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Run timestepping solver
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
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);
}
int main(int argc,char **argv)
{
TS ts; /* time integrator */
TSAdapt adapt;
Vec X; /* solution vector */
Mat J; /* Jacobian matrix */
PetscInt steps,maxsteps,ncells,xs,xm,i;
PetscErrorCode ierr;
PetscReal ftime,dt;
char chemfile[PETSC_MAX_PATH_LEN] = "chem.inp",thermofile[PETSC_MAX_PATH_LEN] = "therm.dat";
struct _User user;
TSConvergedReason reason;
PetscBool showsolutions = PETSC_FALSE;
char **snames,*names;
Vec lambda; /* used with TSAdjoint for sensitivities */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Chemistry solver options","");CHKERRQ(ierr);
ierr = PetscOptionsString("-chem","CHEMKIN input file","",chemfile,chemfile,sizeof(chemfile),NULL);CHKERRQ(ierr);
ierr = PetscOptionsString("-thermo","NASA thermo input file","",thermofile,thermofile,sizeof(thermofile),NULL);CHKERRQ(ierr);
user.pressure = 1.01325e5; /* Pascal */
ierr = PetscOptionsReal("-pressure","Pressure of reaction [Pa]","",user.pressure,&user.pressure,NULL);CHKERRQ(ierr);
user.Tini = 1550;
ierr = PetscOptionsReal("-Tini","Initial temperature [K]","",user.Tini,&user.Tini,NULL);CHKERRQ(ierr);
user.diffus = 100;
ierr = PetscOptionsReal("-diffus","Diffusion constant","",user.diffus,&user.diffus,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-draw_solution","Plot the solution for each cell","",showsolutions,&showsolutions,NULL);CHKERRQ(ierr);
user.diffusion = PETSC_TRUE;
ierr = PetscOptionsBool("-diffusion","Have diffusion","",user.diffusion,&user.diffusion,NULL);CHKERRQ(ierr);
user.reactions = PETSC_TRUE;
ierr = PetscOptionsBool("-reactions","Have reactions","",user.reactions,&user.reactions,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = TC_initChem(chemfile, thermofile, 0, 1.0);TCCHKERRQ(ierr);
user.Nspec = TC_getNspec();
user.Nreac = TC_getNreac();
ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_PERIODIC,-1,user.Nspec+1,1,NULL,&user.dm);CHKERRQ(ierr);
ierr = DMDAGetInfo(user.dm,NULL,&ncells,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
user.dx = 1.0/ncells; /* Set the coordinates of the cell centers; note final ghost cell is at x coordinate 1.0 */
ierr = DMDASetUniformCoordinates(user.dm,0.0,1.0,0.0,1.0,0.0,1.0);CHKERRQ(ierr);
/* set the names of each field in the DMDA based on the species name */
ierr = PetscMalloc1((user.Nspec+1)*LENGTHOFSPECNAME,&names);CHKERRQ(ierr);
ierr = PetscStrcpy(names,"Temp");CHKERRQ(ierr);
TC_getSnames(user.Nspec,names+LENGTHOFSPECNAME);CHKERRQ(ierr);
ierr = PetscMalloc1((user.Nspec+2),&snames);CHKERRQ(ierr);
for (i=0; i<user.Nspec+1; i++) snames[i] = names+i*LENGTHOFSPECNAME;
snames[user.Nspec+1] = NULL;
ierr = DMDASetFieldNames(user.dm,(const char * const *)snames);CHKERRQ(ierr);
ierr = PetscFree(snames);CHKERRQ(ierr);
ierr = PetscFree(names);CHKERRQ(ierr);
ierr = DMCreateMatrix(user.dm,&J);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(user.dm,&X);CHKERRQ(ierr);
ierr = PetscMalloc3(user.Nspec+1,&user.tchemwork,PetscSqr(user.Nspec+1),&user.Jdense,user.Nspec+1,&user.rows);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetDM(ts,user.dm);CHKERRQ(ierr);
ierr = TSSetType(ts,TSARKIMEX);CHKERRQ(ierr);
ierr = TSARKIMEXSetFullyImplicit(ts,PETSC_TRUE);CHKERRQ(ierr);
ierr = TSARKIMEXSetType(ts,TSARKIMEX4);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,FormRHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,J,J,FormRHSJacobian,&user);CHKERRQ(ierr);
ftime = 1.0;
maxsteps = 10000;
ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(ts,X,&user);CHKERRQ(ierr);
ierr = TSSetSolution(ts,X);CHKERRQ(ierr);
dt = 1e-10; /* Initial time step */
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptSetStepLimits(adapt,1e-12,1e-4);CHKERRQ(ierr); /* Also available with -ts_adapt_dt_min/-ts_adapt_dt_max */
ierr = TSSetMaxSNESFailures(ts,-1);CHKERRQ(ierr); /* Retry step an unlimited number of times */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Pass information to graphical monitoring routine
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
if (showsolutions) {
ierr = DMDAGetCorners(user.dm,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr);
for (i=xs;i<xs+xm;i++) {
ierr = MonitorCell(ts,&user,i);CHKERRQ(ierr);
}
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set final conditions for sensitivities
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(user.dm,&lambda);CHKERRQ(ierr);
ierr = TSSetCostGradients(ts,1,&lambda,NULL);CHKERRQ(ierr);
ierr = VecSetValue(lambda,0,1.0,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(lambda);CHKERRQ(ierr);
ierr = VecAssemblyEnd(lambda);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve ODE
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,X);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
ierr = TSGetConvergedReason(ts,&reason);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"%s at time %g after %D steps\n",TSConvergedReasons[reason],(double)ftime,steps);CHKERRQ(ierr);
{
Vec max;
const char * const *names;
PetscInt i;
const PetscReal *bmax;
ierr = TSMonitorEnvelopeGetBounds(ts,&max,NULL);CHKERRQ(ierr);
if (max) {
ierr = TSMonitorLGGetVariableNames(ts,&names);CHKERRQ(ierr);
if (names) {
ierr = VecGetArrayRead(max,&bmax);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"Species - maximum mass fraction\n");CHKERRQ(ierr);
for (i=1; i<user.Nspec; i++) {
if (bmax[i] > .01) {ierr = PetscPrintf(PETSC_COMM_SELF,"%s %g\n",names[i],bmax[i]);CHKERRQ(ierr);}
}
ierr = VecRestoreArrayRead(max,&bmax);CHKERRQ(ierr);
}
}
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
TC_reset();
ierr = DMDestroy(&user.dm);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&lambda);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFree3(user.tchemwork,user.Jdense,user.rows);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec U,V; /* solution will be stored here */
Vec F; /* residual vector */
Mat J; /* Jacobian matrix */
PetscMPIInt rank;
PetscScalar *u,*v;
AppCtx app;
PetscInt direction[2];
PetscBool terminate[2];
TSAdapt adapt;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc,&argv,NULL,help);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
app.Cd = 0.0;
app.Cr = 0.9;
app.bounces = 0;
app.maxbounces = 10;
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"ex44 options","");CHKERRQ(ierr);
ierr = PetscOptionsReal("-Cd","Drag coefficient","",app.Cd,&app.Cd,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-Cr","Restitution coefficient","",app.Cr,&app.Cr,NULL);CHKERRQ(ierr);
ierr = PetscOptionsInt("-maxbounces","Maximum number of bounces","",app.maxbounces,&app.maxbounces,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
/*ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);*/
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSALPHA2);CHKERRQ(ierr);
ierr = TSSetDuration(ts,PETSC_MAX_INT,PETSC_MAX_REAL);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,0.1);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptSetStepLimits(adapt,0.0,0.5);CHKERRQ(ierr);
direction[0] = -1; terminate[0] = PETSC_FALSE;
direction[1] = -1; terminate[1] = PETSC_TRUE;
ierr = TSSetEventHandler(ts,2,direction,terminate,Event,PostEvent,&app);CHKERRQ(ierr);
ierr = MatCreateAIJ(PETSC_COMM_WORLD,1,1,PETSC_DECIDE,PETSC_DECIDE,1,NULL,0,NULL,&J);CHKERRQ(ierr);
ierr = MatSetFromOptions(J);CHKERRQ(ierr);
ierr = MatSetUp(J);CHKERRQ(ierr);
ierr = MatCreateVecs(J,NULL,&F);CHKERRQ(ierr);
ierr = TSSetI2Function(ts,F,I2Function,&app);CHKERRQ(ierr);
ierr = TSSetI2Jacobian(ts,J,J,I2Jacobian,&app);CHKERRQ(ierr);
ierr = VecDestroy(&F);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = TSGetI2Jacobian(ts,&J,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(J,&U,NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(J,&V,NULL);CHKERRQ(ierr);
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
ierr = VecGetArray(V,&v);CHKERRQ(ierr);
u[0] = 5.0*rank; v[0] = 20.0;
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
ierr = VecRestoreArray(V,&v);CHKERRQ(ierr);
ierr = TS2SetSolution(ts,U,V);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSolve(ts,NULL);CHKERRQ(ierr);
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = VecDestroy(&V);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
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 tsgetadapt_(TS ts,TSAdapt *adapt, int *__ierr ){
*__ierr = TSGetAdapt(
(TS)PetscToPointer((ts) ),adapt);
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec U; /* solution will be stored here */
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt n = 2;
PetscScalar *u;
AppCtx app;
PetscInt direction[2];
PetscBool terminate[2];
PetscBool rhs_form=PETSC_FALSE,hist=PETSC_TRUE;
TSAdapt adapt;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs");
app.nbounces = 0;
app.maxbounces = 10;
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"ex40 options","");CHKERRQ(ierr);
ierr = PetscOptionsInt("-maxbounces","","",app.maxbounces,&app.maxbounces,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-test_adapthistory","","",hist,&hist,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSROSW);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set ODE routines
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
/* Users are advised against the following branching and code duplication.
For problems without a mass matrix like the one at hand, the RHSFunction
(and companion RHSJacobian) interface is enough to support both explicit
and implicit timesteppers. This tutorial example also deals with the
IFunction/IJacobian interface for demonstration and testing purposes. */
ierr = PetscOptionsGetBool(NULL,NULL,"-rhs-form",&rhs_form,NULL);CHKERRQ(ierr);
if (rhs_form) {
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,NULL);CHKERRQ(ierr);
ierr = TSSetRHSJacobian(ts,NULL,NULL,RHSJacobian,NULL);CHKERRQ(ierr);
} else {
Mat A; /* Jacobian matrix */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,IFunction,NULL);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,IJacobian,NULL);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecCreate(PETSC_COMM_WORLD,&U);CHKERRQ(ierr);
ierr = VecSetSizes(U,n,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = VecSetUp(U);CHKERRQ(ierr);
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = 0.0;
u[1] = 20.0;
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
ierr = TSSetSolution(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
ierr = TSSetMaxTime(ts,30.0);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,0.1);CHKERRQ(ierr);
/* The adapative time step controller could take very large timesteps resulting in
the same event occuring multiple times in the same interval. A maximum step size
limit is enforced here to avoid this issue. */
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptSetStepLimits(adapt,0.0,0.5);CHKERRQ(ierr);
/* Set directions and terminate flags for the two events */
direction[0] = -1; direction[1] = -1;
terminate[0] = PETSC_FALSE; terminate[1] = PETSC_TRUE;
ierr = TSSetEventHandler(ts,2,direction,terminate,EventFunction,PostEventFunction,(void*)&app);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Run timestepping solver
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,U);CHKERRQ(ierr);
if (hist) { /* replay following history */
TSTrajectory tj;
PetscReal tf,t0,dt;
app.nbounces = 0;
ierr = TSGetTime(ts,&tf);CHKERRQ(ierr);
ierr = TSSetMaxTime(ts,tf);CHKERRQ(ierr);
ierr = TSSetStepNumber(ts,0);CHKERRQ(ierr);
ierr = TSRestartStep(ts);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptSetType(adapt,TSADAPTHISTORY);CHKERRQ(ierr);
ierr = TSGetTrajectory(ts,&tj);CHKERRQ(ierr);
ierr = TSAdaptHistorySetTrajectory(adapt,tj,PETSC_FALSE);CHKERRQ(ierr);
ierr = TSAdaptHistoryGetStep(adapt,0,&t0,&dt);CHKERRQ(ierr);
/* this example fails with single (or smaller) precision */
#if defined(PETSC_USE_REAL_SINGLE) || defined(PETSC_USE_REAL__FP16)
ierr = TSAdaptSetType(adapt,TSADAPTBASIC);CHKERRQ(ierr);
ierr = TSAdaptSetStepLimits(adapt,0.0,0.5);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
#endif
ierr = TSSetTime(ts,t0);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
ierr = TSResetTrajectory(ts);CHKERRQ(ierr);
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = 0.0;
u[1] = 20.0;
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
ierr = TSSolve(ts,U);CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecDestroy(&U);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
