PetscErrorCode PostStep(TS ts)
{
PetscErrorCode ierr;
Vec X;
AppCtx *user;
PetscReal t;
PetscScalar asum;
PetscFunctionBegin;
ierr = TSGetApplicationContext(ts,&user);CHKERRQ(ierr);
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
/*
if (t >= .2) {
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
ierr = VecView(X,PETSC_VIEWER_BINARY_WORLD);CHKERRQ(ierr);
exit(0);
results in initial conditions after fault in binaryoutput
}*/
if ((t > user->tf) && (t < user->tcl)) user->Pmax = 0.0; /* A short-circuit that drives the electrical power output (Pmax*sin(delta)) to zero */
else user->Pmax = user->Pmax_s;
ierr = VecSum(X,&asum);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"sum(p) at t = %f = %f\n",(double)t,(double)(asum));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode TSAdjointEventHandler(TS ts)
{
PetscErrorCode ierr;
TSEvent event;
PetscReal t;
Vec U;
PetscInt ctr;
PetscBool forwardsolve=PETSC_FALSE; /* Flag indicating that TS is doing an adjoint solve */
PetscFunctionBegin;
PetscValidHeaderSpecific(ts,TS_CLASSID,1);
if (!ts->event) PetscFunctionReturn(0);
event = ts->event;
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&U);CHKERRQ(ierr);
ctr = event->recorder.ctr-1;
if (ctr >= 0 && PetscAbsReal(t - event->recorder.time[ctr]) < PETSC_SMALL) {
/* Call the user postevent function */
if (event->postevent) {
ierr = (*event->postevent)(ts,event->recorder.nevents[ctr],event->recorder.eventidx[ctr],t,U,forwardsolve,event->ctx);CHKERRQ(ierr);
event->recorder.ctr--;
}
}
PetscBarrier((PetscObject)ts);
PetscFunctionReturn(0);
}
PetscErrorCode PostStep(TS ts)
{
PetscErrorCode ierr;
PetscReal t;
PetscFunctionBeginUser;
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF," PostStep, t: %g\n",(double)t);
PetscFunctionReturn(0);
}
virtual TimeStepperStatus step(Real *ftime) {
PetscErrorCode ierr;
TSConvergedReason reason;
ierr = TSStep(_ts);
CHKERRABORT(libMesh::COMM_WORLD,ierr);
ierr = TSGetConvergedReason(_ts,&reason);
CHKERRABORT(libMesh::COMM_WORLD,ierr);
ierr = TSGetTime(_ts,ftime);
CHKERRABORT(libMesh::COMM_WORLD,ierr);
return (TimeStepperStatus)reason;
}
static PetscErrorCode _preStep(TS ts) {
PetscTimeStepper *ths;
PetscErrorCode ierr;
PetscReal time,stepsize;
int step;
ierr = TSGetApplicationContext(ts,&ths);CHKERRQ(ierr);
ierr = TSGetTime(ts,&time);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&stepsize);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&step);CHKERRQ(ierr);
ths->preStep(time,step+1,stepsize);
return 0;
}
PetscErrorCode EvalMisfit(TS ts)
{
PetscErrorCode ierr;
Userctx *user;
Vec X;
PetscReal t;
Vec Xgen,Xnet;
PetscScalar *xnet, *proj_vec;
PetscInt obs_len,i,idx;
PetscReal step_num;
PetscScalar *mat;
PetscFunctionBegin;
ierr = TSGetApplicationContext(ts,&user);CHKERRQ(ierr);
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
//!t = t - user->tdisturb;
t = t - user->trestore;
step_num = round(t / user->data_dt);
if(fabs(step_num - t/user->data_dt)<= 1e-6*user->dt) {
ierr = VecGetArray(user->proj,&proj_vec);CHKERRQ(ierr);
ierr = VecGetSize(user->proj, &obs_len);CHKERRQ(ierr);
idx = 2*obs_len*(PetscInt) step_num;
ierr = DMCompositeGetLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = DMCompositeScatter(user->dmpgrid,X,Xgen,Xnet);CHKERRQ(ierr);
ierr = VecGetArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = MatDenseGetArray(user->obs,&mat);CHKERRQ(ierr);
for(i=0;i<obs_len; i++) {
user->misfit += 0.5*pow(xnet[2*((int)proj_vec[i])] - mat[idx+2*i], 2) / pow(user->data_stddev[i], 2); // obs[2*i, num_obs]
user->misfit += 0.5*pow(xnet[2*((int)proj_vec[i])+1] - mat[idx+2*i+1],2)
/ pow(user->data_stddev[i+1], 2);// obs[2*i+1, num_obs]
}
//printf("evm %g %g idx=%d\n", xnet[0], mat[idx], idx);
ierr = MatDenseRestoreArray(user->obs,&mat);CHKERRQ(ierr);
ierr = VecRestoreArray(Xnet,&xnet);CHKERRQ(ierr);
ierr = DMCompositeRestoreLocalVectors(user->dmpgrid,&Xgen,&Xnet);CHKERRQ(ierr);
ierr = VecRestoreArray(user->proj,&proj_vec);CHKERRQ(ierr);
}
user->stepnum++;
PetscFunctionReturn(0);
}
PetscErrorCode PostStepFunction(TS ts)
{
PetscErrorCode ierr;
Vec U;
PetscReal t;
const PetscScalar *u;
PetscFunctionBegin;
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&U);CHKERRQ(ierr);
ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"delta(%3.2f) = %8.7f\n",(double)t,(double)u[0]);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PostStep(TS ts)
{
PetscErrorCode ierr;
Vec X;
AppCtx *user;
PetscScalar sum;
PetscReal t;
PetscFunctionBegin;
ierr = TSGetApplicationContext(ts,&user);CHKERRQ(ierr);
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
ierr = VecSum(X,&sum);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"sum(p)*dw*dtheta at t = %3.2f = %3.6f\n",t,sum*user->dx*user->dy);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PostStep(TS ts)
{
PetscErrorCode ierr;
Vec X;
PetscReal t;
PetscFunctionBegin;
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
if (t >= .2) {
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
ierr = VecView(X,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
exit(0);
/* results in initial conditions after fault of -u 0.496792,1.00932 */
}
PetscFunctionReturn(0);
}
PetscErrorCode SaveObservation(TS ts)
{
PetscErrorCode ierr;
Userctx *user;
Vec X;
PetscReal t;
PetscFunctionBegin;
ierr = TSGetApplicationContext(ts,&user);CHKERRQ(ierr);
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
ierr = SetObservation(user,t,X);CHKERRQ(ierr);
ierr = SetSolution(user,t,X);CHKERRQ(ierr);
user->stepnum++;
PetscFunctionReturn(0);
}
PetscErrorCode SaveSolution(TS ts)
{
PetscErrorCode ierr;
Userctx *user;
Vec X;
PetscScalar *x,*mat;
PetscInt idx;
PetscReal t;
PetscFunctionBegin;
ierr = TSGetApplicationContext(ts,&user);CHKERRQ(ierr);
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
idx = user->stepnum*(user->neqs_pgrid+1);
ierr = MatDenseGetArray(user->Sol,&mat);CHKERRQ(ierr);
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
mat[idx] = t;
ierr = PetscMemcpy(mat+idx+1,x,user->neqs_pgrid*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = MatDenseRestoreArray(user->Sol,&mat);CHKERRQ(ierr);
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
user->stepnum++;
PetscFunctionReturn(0);
}
PetscErrorCode PostStep(TS ts)
{
PetscErrorCode ierr;
Vec X,gc;
AppCtx *user;
PetscScalar sum = 0,asum;
PetscReal t,**p;
DMDACoor2d **coors;
DM cda;
PetscInt i,j,xs,ys,xm,ym;
PetscFunctionBegin;
ierr = TSGetApplicationContext(ts,&user);CHKERRQ(ierr);
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(user->da,&cda);CHKERRQ(ierr);
ierr = DMDAGetCorners(cda,&xs,&ys,0,&xm,&ym,0);CHKERRQ(ierr);
ierr = DMGetCoordinates(user->da,&gc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,gc,&coors);CHKERRQ(ierr);
ierr = DMDAVecGetArray(user->da,X,&p);CHKERRQ(ierr);
for (i=xs; i < xs+xm; i++) {
for (j=ys; j < ys+ym; j++) {
// printf("i %d j %d y %g %g\n",i,j,coors[j][i].y,p[j][i]);
if (coors[j][i].y < 5) sum += p[j][i];
}
}
ierr = DMDAVecRestoreArray(cda,gc,&coors);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(user->da,X,&p);CHKERRQ(ierr);
ierr = MPI_Allreduce(&sum,&asum,1,MPIU_SCALAR,MPIU_SUM,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"sum(p)*dw*dtheta at t = %f = %f\n",(double)t,(double)(asum));CHKERRQ(ierr);
if (sum < 1.0e-2) {
ierr = TSSetConvergedReason(ts,TS_CONVERGED_USER);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Exiting TS as the integral of PDF is almost zero\n");CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc, char **argv)
{
TS ts;
Vec x; /*solution vector*/
Mat A; /*Jacobian*/
PetscInt steps,maxsteps,mx;
PetscErrorCode ierr;
PetscReal ftime;
AppCtx user; /* user-defined work context */
PetscInitialize(&argc,&argv,NULL,help);
/* Initialize user application context */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Allen-Cahn equation","");
user.param = 9e-4;
user.xleft = -1.;
user.xright = 2.;
user.mx = 400;
ierr = PetscOptionsReal("-eps","parameter","",user.param,&user.param,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
* ierr = PetscOptionsGetBool(NULL,"-monitor",&monitor,NULL);CHKERRQ(ierr);
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors, solve same ODE on every process
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,user.mx,user.mx);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatGetVecs(A,&x,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create time stepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSEIMEX);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,FormIFunction,&user);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,FormIJacobian,&user);CHKERRQ(ierr);
ftime = 142;
maxsteps = 100000;
ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(ts,x,&user);CHKERRQ(ierr);
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
ierr = VecGetSize(x,&mx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,x);CHKERRQ(ierr);
ierr = TSGetTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"eps %g, steps %D, ftime %g\n",(double)user.param,steps,(double)ftime);CHKERRQ(ierr);
/* ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
int main(int argc, char **argv)
{
AppCtx ctx;
DM dm;
TS ts;
Vec u, r;
PetscReal t = 0.0;
PetscReal L2error = 0.0;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc, &argv, NULL, help);
CHKERRQ(ierr);
ierr = ProcessOptions(PETSC_COMM_WORLD, &ctx);
CHKERRQ(ierr);
ierr = CreateMesh(PETSC_COMM_WORLD, &dm, &ctx);
CHKERRQ(ierr);
ierr = DMSetApplicationContext(dm, &ctx);
CHKERRQ(ierr);
ierr = PetscMalloc1(1, &ctx.exactFuncs);
CHKERRQ(ierr);
ierr = SetupDiscretization(dm, &ctx);
CHKERRQ(ierr);
ierr = DMCreateGlobalVector(dm, &u);
CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) u, "temperature");
CHKERRQ(ierr);
ierr = VecDuplicate(u, &r);
CHKERRQ(ierr);
ierr = TSCreate(PETSC_COMM_WORLD, &ts);
CHKERRQ(ierr);
ierr = TSSetDM(ts, dm);
CHKERRQ(ierr);
ierr = DMTSSetBoundaryLocal(dm, DMPlexTSComputeBoundary, &ctx);
CHKERRQ(ierr);
ierr = DMTSSetIFunctionLocal(dm, DMPlexTSComputeIFunctionFEM, &ctx);
CHKERRQ(ierr);
ierr = DMTSSetIJacobianLocal(dm, DMPlexTSComputeIJacobianFEM, &ctx);
CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts, TS_EXACTFINALTIME_STEPOVER);
CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);
CHKERRQ(ierr);
ierr = DMProjectFunction(dm, t, ctx.exactFuncs, NULL, INSERT_ALL_VALUES, u);
CHKERRQ(ierr);
ierr = TSSolve(ts, u);
CHKERRQ(ierr);
ierr = TSGetTime(ts, &t);
CHKERRQ(ierr);
ierr = DMComputeL2Diff(dm, t, ctx.exactFuncs, NULL, u, &L2error);
CHKERRQ(ierr);
if (L2error < 1.0e-11) {
ierr = PetscPrintf(PETSC_COMM_WORLD, "L_2 Error: < 1.0e-11\n");
CHKERRQ(ierr);
}
else {
ierr = PetscPrintf(PETSC_COMM_WORLD, "L_2 Error: %g\n", L2error);
CHKERRQ(ierr);
}
ierr = VecViewFromOptions(u, NULL, "-sol_vec_view");
CHKERRQ(ierr);
ierr = VecDestroy(&u);
CHKERRQ(ierr);
ierr = VecDestroy(&r);
CHKERRQ(ierr);
ierr = TSDestroy(&ts);
CHKERRQ(ierr);
ierr = DMDestroy(&dm);
CHKERRQ(ierr);
ierr = PetscFree(ctx.exactFuncs);
CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
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;
}
PetscErrorCode TSEventHandler(TS ts)
{
PetscErrorCode ierr;
TSEvent event;
PetscReal t;
Vec U;
PetscInt i;
PetscReal dt,dt_min;
PetscInt rollback=0,in[2],out[2];
PetscInt fvalue_sign,fvalueprev_sign;
PetscFunctionBegin;
PetscValidHeaderSpecific(ts,TS_CLASSID,1);
if (!ts->event) PetscFunctionReturn(0);
event = ts->event;
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&U);CHKERRQ(ierr);
if (event->status == TSEVENT_NONE) {
if (ts->steps == 1) /* After first successful step */
event->timestep_orig = ts->ptime - ts->ptime_prev;
event->timestep_prev = dt;
}
if (event->status == TSEVENT_RESET_NEXTSTEP) {
/* Restore time step */
dt = PetscMin(event->timestep_orig,event->timestep_prev);
ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
event->status = TSEVENT_NONE;
}
if (event->status == TSEVENT_NONE) {
event->ptime_end = t;
}
ierr = VecLockPush(U);CHKERRQ(ierr);
ierr = (*event->eventhandler)(ts,t,U,event->fvalue,event->ctx);CHKERRQ(ierr);
ierr = VecLockPop(U);CHKERRQ(ierr);
for (i=0; i < event->nevents; i++) {
if (PetscAbsScalar(event->fvalue[i]) < event->vtol[i]) {
event->status = TSEVENT_ZERO;
event->fvalue_right[i] = event->fvalue[i];
continue;
}
fvalue_sign = PetscSign(PetscRealPart(event->fvalue[i]));
fvalueprev_sign = PetscSign(PetscRealPart(event->fvalue_prev[i]));
if (fvalueprev_sign != 0 && (fvalue_sign != fvalueprev_sign) && (PetscAbsScalar(event->fvalue_prev[i]) > event->vtol[i])) {
switch (event->direction[i]) {
case -1:
if (fvalue_sign < 0) {
rollback = 1;
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Event %D interval detected [%g - %g]\n",event->iterctr,i,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->fvalue_right[i] = event->fvalue[i];
event->side[i] = 1;
if (!event->iterctr) event->zerocrossing[i] = PETSC_TRUE;
event->status = TSEVENT_LOCATED_INTERVAL;
}
break;
case 1:
if (fvalue_sign > 0) {
rollback = 1;
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Event %D interval detected [%g - %g]\n",event->iterctr,i,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->fvalue_right[i] = event->fvalue[i];
event->side[i] = 1;
if (!event->iterctr) event->zerocrossing[i] = PETSC_TRUE;
event->status = TSEVENT_LOCATED_INTERVAL;
}
break;
case 0:
rollback = 1;
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Event %D interval detected [%g - %g]\n",event->iterctr,i,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->fvalue_right[i] = event->fvalue[i];
event->side[i] = 1;
if (!event->iterctr) event->zerocrossing[i] = PETSC_TRUE;
event->status = TSEVENT_LOCATED_INTERVAL;
break;
}
}
}
in[0] = event->status; in[1] = rollback;
ierr = MPIU_Allreduce(in,out,2,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
event->status = (TSEventStatus)out[0]; rollback = out[1];
if (rollback) event->status = TSEVENT_LOCATED_INTERVAL;
event->nevents_zero = 0;
if (event->status == TSEVENT_ZERO) {
for (i=0; i < event->nevents; i++) {
if (PetscAbsScalar(event->fvalue[i]) < event->vtol[i]) {
event->events_zero[event->nevents_zero++] = i;
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: Event %D zero crossing at time %g located in %D iterations\n",i,(double)t,event->iterctr);CHKERRQ(ierr);
}
event->zerocrossing[i] = PETSC_FALSE;
}
event->side[i] = 0;
}
ierr = TSPostEvent(ts,t,U);CHKERRQ(ierr);
dt = event->ptime_end - t;
if (PetscAbsReal(dt) < PETSC_SMALL) { /* we hit the event, continue with the candidate time step */
dt = event->timestep_prev;
event->status = TSEVENT_NONE;
}
ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
event->iterctr = 0;
PetscFunctionReturn(0);
}
if (event->status == TSEVENT_LOCATED_INTERVAL) {
ierr = TSRollBack(ts);CHKERRQ(ierr);
ierr = TSSetConvergedReason(ts,TS_CONVERGED_ITERATING);CHKERRQ(ierr);
event->status = TSEVENT_PROCESSING;
event->ptime_right = t;
} else {
for (i=0; i < event->nevents; i++) {
if (event->status == TSEVENT_PROCESSING && event->zerocrossing[i]) {
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
event->side[i] = -1;
}
event->fvalue_prev[i] = event->fvalue[i];
}
if (event->monitor && event->status == TSEVENT_PROCESSING) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Stepping forward as no event detected in interval [%g - %g]\n",event->iterctr,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->ptime_prev = t;
}
if (event->status == TSEVENT_PROCESSING) event->iterctr++;
ierr = MPIU_Allreduce(&dt,&dt_min,1,MPIU_REAL,MPIU_MIN,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,dt_min);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* ODE integrator */
Vec U; /* solution will be stored here */
Vec Utrue;
PetscErrorCode ierr;
PetscMPIInt size;
AppCtx ctx;
PetscScalar *u;
IS iss;
IS isf;
PetscInt *indicess;
PetscInt *indicesf;
PetscInt n=2;
PetscReal error,tt;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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");
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create index for slow part and fast part
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscMalloc1(1,&indicess);CHKERRQ(ierr);
indicess[0]=0;
ierr = PetscMalloc1(1,&indicesf);CHKERRQ(ierr);
indicesf[0]=1;
ierr = ISCreateGeneral(PETSC_COMM_SELF,1,indicess,PETSC_COPY_VALUES,&iss);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,1,indicesf,PETSC_COPY_VALUES,&isf);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necesary vector
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecCreate(PETSC_COMM_WORLD,&U);CHKERRQ(ierr);
ierr = VecSetSizes(U,n,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = VecSetFromOptions(U);CHKERRQ(ierr);
ierr = VecDuplicate(U,&Utrue);
ierr = VecCopy(U,Utrue);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial condition
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecGetArray(U,&u);CHKERRQ(ierr);
u[0] = PetscSqrtScalar(2.0);
u[1] = PetscSqrtScalar(3.0);
ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSMPRK);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,(TSRHSFunction)RHSFunction,&ctx);CHKERRQ(ierr);
ierr = TSRHSSplitSetIS(ts,"slow",iss);CHKERRQ(ierr);
ierr = TSRHSSplitSetIS(ts,"fast",isf);CHKERRQ(ierr);
ierr = TSRHSSplitSetRHSFunction(ts,"slow",NULL,(TSRHSFunctionslow)RHSFunctionslow,&ctx);CHKERRQ(ierr);
ierr = TSRHSSplitSetRHSFunction(ts,"fast",NULL,(TSRHSFunctionfast)RHSFunctionfast,&ctx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetSolution(ts,U);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set solver options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"ODE options","");CHKERRQ(ierr);
{
ctx.Tf = 0.3;
ctx.dt = 0.01;
ierr = PetscOptionsScalar("-Tf","","",ctx.Tf,&ctx.Tf,NULL);CHKERRQ(ierr);
ierr = PetscOptionsScalar("-dt","","",ctx.dt,&ctx.dt,NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = TSSetMaxTime(ts,ctx.Tf);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,ctx.dt);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,U);CHKERRQ(ierr);
ierr = VecView(U,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check the error of the Petsc solution
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSGetTime(ts,&tt);CHKERRQ(ierr);
ierr = sol_true(tt,Utrue);CHKERRQ(ierr);
ierr = VecAXPY(Utrue,-1.0,U);CHKERRQ(ierr);
ierr = VecNorm(Utrue,NORM_2,&error);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Print norm2 error
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscPrintf(PETSC_COMM_WORLD,"l2 error norm: %g\n", error);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 = VecDestroy(&Utrue);CHKERRQ(ierr);
ierr = ISDestroy(&iss);CHKERRQ(ierr);
ierr = ISDestroy(&isf);CHKERRQ(ierr);
ierr = PetscFree(indicess);CHKERRQ(ierr);
ierr = PetscFree(indicesf);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
/*
FormFunction - Evaluates the function and corresponding gradient.
Input Parameters:
tao - the Tao context
X - the input vector
ptr - optional user-defined context, as set by TaoSetObjectiveAndGradientRoutine()
Output Parameters:
f - the newly evaluated function
G - the newly evaluated gradient
*/
PetscErrorCode FormFunctionGradient(Tao tao,Vec P,PetscReal *f,Vec G,void *ctx0)
{
TS ts;
PetscErrorCode ierr;
Userctx *ctx = (Userctx*)ctx0;
Vec X, F_alg;
SNES snes_alg;
PetscScalar *x_ptr;
Vec lambda[1];
//Vec q;
Vec mu[1];
PetscInt steps,steps3;
PetscReal t,t2;
Vec Xdot;
/* FD check */
PetscReal f1,f2,expo;
Vec Pvec_eps;
PetscReal* P_eps;
PetscInt i;
PetscBool fd;
Vec Xdist_final;
printf("aaa\n");
ierr = VecGetArray(P,&x_ptr);CHKERRQ(ierr);
H[0] = x_ptr[0];
H[1] = x_ptr[1];
H[2] = x_ptr[2];
//printf("FormFunctionGradient: x=[%.14f, %.14f, %.14f]\n", x_ptr[0], x_ptr[1], x_ptr[2]);
//printf("FormFunctionGradient - PD0[0]=%g\n", PD0[0]);
ierr = VecRestoreArray(P,&x_ptr);CHKERRQ(ierr);
if(ctx->t0 > ctx->tdisturb) {
printf("t0 cannot be greater than tdisturb\n");
PetscFunctionReturn(-1);
}
if( (ctx->tdisturb >= ctx->trestore-1.0e-8) || (ctx->tdisturb >= ctx->tfinal-1.0e-8) ) {
printf("tdisturb should be less than trestore and tfinal\n");
PetscFunctionReturn(-1);
}
ctx->misfit=0.0;
ctx->stepnum = 0;
ierr = VecZeroEntries(ctx->vec_q);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(ctx->dmpgrid,&X);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,ctx);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,ctx->J,ctx->J,(TSIJacobian)IJacobian,ctx);CHKERRQ(ierr);
ierr = TSSetApplicationContext(ts,ctx);CHKERRQ(ierr);
/* Set initial conditions */
ierr = VecCopy(ctx->X0_disturb, X);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve from on [tdisturb, trestore] (disturbance part of the transient)
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* Induce a load perturbation at t=tdisturb */
//!for(i=0; i<3; i++) PD0[i] = PD0_disturb[i];
/* Induce a load perturbation at t=trestore*/
for(i=0; i<3; i++) PD0[i] = PD0_ref[i];
//!printf("In FormFunctionGradien: Induce a load perturbance to PD0[0]=%g\n", PD0[0]);
/* Solve for algebraic variables with Xgen given by X0_disturb */
ierr = VecDuplicate(X,&F_alg);CHKERRQ(ierr);
ierr = SNESCreate(PETSC_COMM_WORLD,&snes_alg);CHKERRQ(ierr);
ierr = SNESSetFunction(snes_alg,F_alg,AlgFunction,ctx);CHKERRQ(ierr);
ierr = MatZeroEntries(ctx->J);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes_alg,ctx->J,ctx->J,AlgJacobian,ctx);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(snes_alg,"alg_");CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes_alg);CHKERRQ(ierr);
/* Solve the algebraic equations */
ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
/* Just to set up the Jacobian structure */
ierr = VecDuplicate(X,&Xdot);CHKERRQ(ierr);
//! ierr = IJacobian(ts,ctx->tdisturb,X,Xdot,0.0,ctx->J,ctx->J,ctx);CHKERRQ(ierr);
ierr = IJacobian(ts,ctx->trestore,X,Xdot,0.0,ctx->J,ctx->J,ctx);CHKERRQ(ierr);
ierr = VecDestroy(&Xdot);CHKERRQ(ierr);
/* Save trajectory of solution so that TSAdjointSolve() may be used */
ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);
/* Hook up the function evaluation */
ierr = TSSetPostStep(ts,EvalMisfit);CHKERRQ(ierr);
//!ierr = TSSetDuration(ts,10000,fmin(ctx->trestore,ctx->tfinal));CHKERRQ(ierr);
ierr = TSSetDuration(ts,10000,ctx->tfinal);CHKERRQ(ierr);
//!ierr = TSSetInitialTimeStep(ts,ctx->tdisturb,ctx->dt);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,ctx->trestore,ctx->dt);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* Solve the forward problem */
//printf("Forward solve...\n");
ierr = TSSolve(ts,X);CHKERRQ(ierr);
ierr = VecDuplicate(X, &Xdist_final);CHKERRQ(ierr);
ierr = VecCopy(X, Xdist_final);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve from on [trestore, tfinal] (post-disturbance transient)
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* if(ctx->tfinal>=ctx->trestore+1.0e-8) { */
/* //restore load at trestore */
/* for(i=0; i<3; i++) PD0[i] = PD0_ref[i]; */
/* printf("In FormFunctionGradien: Restore load to PD0[0]=%g\n", PD0[0]); */
/* /\* Solve the algebraic equations *\/ */
/* ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr); */
/* ierr = TSSetDuration(ts,100000,ctx->tfinal);CHKERRQ(ierr); */
/* ierr = TSSetInitialTimeStep(ts,ctx->trestore,ctx->dt);CHKERRQ(ierr); */
/* /\* Solve (from trestore to tfinal) *\/ */
/* ierr = TSSolve(ts,X);CHKERRQ(ierr); */
/* } else { */
/* printf("Ignoring trestore since tfinal is less than it.\n"); */
/* } */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Adjoint model starts here
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSGetTimeStepNumber(ts,&steps3);CHKERRQ(ierr);
ierr = TSSetPostStep(ts,NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(ctx->J,&lambda[0],NULL);CHKERRQ(ierr);
/* Set initial conditions for the adjoint integration */
ierr = VecZeroEntries(lambda[0]);CHKERRQ(ierr);
ierr = MatCreateVecs(ctx->Jacp,&mu[0],NULL);CHKERRQ(ierr);
ierr = VecZeroEntries(mu[0]);CHKERRQ(ierr);
/* Sets the initial value of the gradients of the cost w.r.t. x_0 and p */
/* Notes: the entries in these vectors must be correctly initialized */
/* with the values lambda_i = df/dy|finaltime mu_i = df/dp|finaltime */
ierr = TSSetCostGradients(ts,1,lambda,mu);CHKERRQ(ierr);
/* Sets the function that computes the Jacobian of f w.r.t. p where x_t = f(x,y,p,t) */
ierr = TSAdjointSetRHSJacobian(ts,ctx->Jacp,RHSJacobianP,ctx);CHKERRQ(ierr);
/* Sets the routine for evaluating the integral term in the cost */
/*ierr = TSSetCostIntegrand(ts,1,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec,void*))CostIntegrand,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDYFunction,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDPFunction,ctx);
*/
ierr = TSSetCostIntegrand(ts,1,
NULL,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDYFunction,
(PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDPFunction,ctx);
CHKERRQ(ierr);
t = ctx->tfinal;
steps = (PetscInt)round(ctx->data_dt/ctx->dt);
while(fabs(t-ctx->trestore)>1e-8)
{
ierr = TSGetTime(ts, &t2);CHKERRQ(ierr);
/* Induce the perturbation in load accordingly corresponding to this time */
if(t2-ctx->trestore>=-1e-8)
for(i=0; i<3; i++) PD0[i] = PD0_ref[i];
/* else if(t2-ctx->tdisturb>=0) */
/* for(i=0; i<3; i++) PD0[i] = PD0_disturb[i]; */
else {printf("Panic: should not get here\n"); PetscFunctionReturn(-1);}
/* Initial conditions for the adjoint */
/* lambda += dr/dy */
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
ierr = AddDRDY(t2,X,&lambda[0],ctx);CHKERRQ(ierr);
//printf("Manual adjoint backward integration steps=%d t=%g t2=%g \n", steps, t, t2);
/* Sets # steps the adjoint solver should take backward in time*/
ierr = TSAdjointSetSteps(ts,steps);CHKERRQ(ierr);
/* Solves the discrete adjoint problem for an ODE/DAE */
ierr = TSAdjointSolve(ts);CHKERRQ(ierr);
t -= steps * ctx->dt;
}
//printf("mu-FunctionGradient after Adjoint (t=%g)\n",t);
//ierr = VecView(mu[0],PETSC_VIEWER_STDOUT_SELF);
//ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_SELF);
/* return gradient */
ierr = VecCopy(mu[0],G);CHKERRQ(ierr);
ierr = AddRegGradient(ctx,P,G);
//ierr = VecView(G,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
/* return fcn eval */
*f = ctx->misfit;
EvalReg(ctx, P);
*f += ctx->prior;
//printf("objective=%.12f\n", *f);
/* Finalize: destroy */
ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
ierr = VecDestroy(&mu[0]);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&F_alg);CHKERRQ(ierr);
ierr = SNESDestroy(&snes_alg);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
//printf("Adjoint ends\n");
fd=0;
if(fd) {
/* FD check */
ierr = FormFunction(tao,P,&f1,ctx); CHKERRQ(ierr);
printf("cost=%.12f \n",f1);
ierr = VecDuplicate(P, &Pvec_eps); CHKERRQ(ierr);
for(i=0; i<3; i++) {
for(expo=1e-2; expo>1e-8; expo/=3) {
ierr = VecCopy(P, Pvec_eps); CHKERRQ(ierr);
ierr = VecGetArray(Pvec_eps, &P_eps); CHKERRQ(ierr);
P_eps[i] += expo;
ierr = VecRestoreArray(Pvec_eps, &P_eps); CHKERRQ(ierr);
//ierr = VecView(Pvec_eps,PETSC_VIEWER_STDOUT_SELF);
ierr = FormFunction(tao,Pvec_eps,&f2,ctx); CHKERRQ(ierr);
printf("fd[%d]=%12.6e f1=%.7e f2=%.7e expo=%g\n", i+1, (f2-f1)/expo, f1, f2, expo);
}
}
ierr = VecDestroy(&Pvec_eps); CHKERRQ(ierr);
/* ~end of FD */
}
//PetscFunctionReturn(-1);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* nonlinear solver */
Vec u; /* solution, residual vectors */
Mat J; /* Jacobian matrix */
PetscInt maxsteps = 1000; /* iterations for convergence */
PetscInt nsteps;
PetscReal vmin,vmax,norm;
PetscErrorCode ierr;
DM da;
PetscReal ftime,dt;
AppCtx user; /* user-defined work context */
JacobianType jacType;
PetscInitialize(&argc,&argv,(char*)0,help);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,-11,1,1,NULL,&da);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&u);
CHKERRQ(ierr);
/* Initialize user application context */
user.c = -30.0;
user.boundary = 0; /* 0: Dirichlet BC; 1: Neumann BC */
user.viewJacobian = PETSC_FALSE;
ierr = PetscOptionsGetInt(NULL,"-boundary",&user.boundary,NULL);
CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-viewJacobian",&user.viewJacobian);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);
CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);
CHKERRQ(ierr);
ierr = TSSetType(ts,TSTHETA);
CHKERRQ(ierr);
ierr = TSThetaSetTheta(ts,1.0);
CHKERRQ(ierr); /* Make the Theta method behave like backward Euler */
ierr = TSSetIFunction(ts,NULL,FormIFunction,&user);
CHKERRQ(ierr);
ierr = DMSetMatType(da,MATAIJ);
CHKERRQ(ierr);
ierr = DMCreateMatrix(da,&J);
CHKERRQ(ierr);
jacType = JACOBIAN_ANALYTIC; /* use user-provide Jacobian */
ierr = TSSetDM(ts,da);
CHKERRQ(ierr); /* Use TSGetDM() to access. Setting here allows easy use of geometric multigrid. */
ftime = 1.0;
ierr = TSSetDuration(ts,maxsteps,ftime);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(ts,u,&user);
CHKERRQ(ierr);
ierr = TSSetSolution(ts,u);
CHKERRQ(ierr);
dt = .01;
ierr = TSSetInitialTimeStep(ts,0.0,dt);
CHKERRQ(ierr);
/* Use slow fd Jacobian or fast fd Jacobian with colorings.
Note: this requirs snes which is not created until TSSetUp()/TSSetFromOptions() is called */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Options for Jacobian evaluation",NULL);
CHKERRQ(ierr);
ierr = PetscOptionsEnum("-jac_type","Type of Jacobian","",JacobianTypes,(PetscEnum)jacType,(PetscEnum*)&jacType,0);
CHKERRQ(ierr);
ierr = PetscOptionsEnd();
CHKERRQ(ierr);
if (jacType == JACOBIAN_ANALYTIC) {
ierr = TSSetIJacobian(ts,J,J,FormIJacobian,&user);
CHKERRQ(ierr);
} else if (jacType == JACOBIAN_FD_COLORING) {
SNES snes;
ierr = TSGetSNES(ts,&snes);
CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,0);
CHKERRQ(ierr);
} else if (jacType == JACOBIAN_FD_FULL) {
SNES snes;
ierr = TSGetSNES(ts,&snes);
CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefault,&user);
CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Integrate ODE system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,u);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute diagnostics of the solution
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecNorm(u,NORM_1,&norm);
CHKERRQ(ierr);
ierr = VecMax(u,NULL,&vmax);
CHKERRQ(ierr);
ierr = VecMin(u,NULL,&vmin);
CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&nsteps);
CHKERRQ(ierr);
ierr = TSGetTime(ts,&ftime);
CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"timestep %D: time %G, solution norm %G, max %G, min %G\n",nsteps,ftime,norm,vmax,vmin);
CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&J);
CHKERRQ(ierr);
ierr = VecDestroy(&u);
CHKERRQ(ierr);
ierr = TSDestroy(&ts);
CHKERRQ(ierr);
ierr = DMDestroy(&da);
CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
double time() const {
double t;
TSGetTime(ts, &t);
return t;
}
int main(int argc, char **argv)
{
TS ts;
Vec x; /*solution vector*/
Mat A; /*Jacobian*/
PetscInt steps,maxsteps,mx,eimex_rowcol[2],two;
PetscErrorCode ierr;
PetscScalar *x_ptr;
PetscReal ftime,dt,norm;
Vec ref;
struct _User user; /* user-defined work context */
PetscViewer viewer;
ierr = PetscInitialize(&argc,&argv,NULL,help);CHKERRQ(ierr);
/* Initialize user application context */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"van der Pol options","");
user.mu = 1e0;
ierr = PetscOptionsReal("-eps","Stiffness controller","",user.mu,&user.mu,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
ierr = PetscOptionsGetBool(NULL,NULL,"-monitor",&monitor,NULL);CHKERRQ(ierr);
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors, solve same ODE on every process
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,2,2);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&x,NULL);CHKERRQ(ierr);
ierr = MatCreateVecs(A,&ref,NULL);CHKERRQ(ierr);
ierr = VecGetArray(ref,&x_ptr);CHKERRQ(ierr);
/*
* [0,1], mu=10^-3
*/
/*
x_ptr[0] = -1.8881254106283;
x_ptr[1] = 0.7359074233370;*/
/*
* [0,0.5],mu=10^-3
*/
/*
x_ptr[0] = 1.596980778659137;
x_ptr[1] = -1.029103015879544;
*/
/*
* [0,0.5],mu=1
*/
x_ptr[0] = 1.619084329683235;
x_ptr[1] = -0.803530465176385;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSEIMEX);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,IFunction,&user);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,IJacobian,&user);CHKERRQ(ierr);
ftime = 1.1;
dt = 0.00001;
maxsteps = 100000;
ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = VecGetArray(x,&x_ptr);CHKERRQ(ierr);
x_ptr[0] = 2.;
x_ptr[1] = -2./3. + 10./81.*(user.mu) - 292./2187.* (user.mu) * (user.mu)
-1814./19683.*(user.mu)*(user.mu)*(user.mu);
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
ierr = VecGetSize(x,&mx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,x);CHKERRQ(ierr);
ierr = TSGetTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
ierr = VecAXPY(x,-1.0,ref);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
eimex_rowcol[0] = 0; eimex_rowcol[1] = 0; two = 2;
ierr = PetscOptionsGetIntArray(NULL,NULL,"-ts_eimex_row_col",eimex_rowcol,&two,NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"order %11s %18s %37s\n","dt","norm","final solution components 0 and 1");CHKERRQ(ierr);
ierr = VecGetArray(x,&x_ptr);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"(%D,%D) %10.8f %18.15f %18.15f %18.15f\n",eimex_rowcol[0],eimex_rowcol[1],(double)dt,(double)norm,(double)PetscRealPart(x_ptr[0]),(double)PetscRealPart(x_ptr[1]));CHKERRQ(ierr);
ierr = VecRestoreArray(x,&x_ptr);CHKERRQ(ierr);
/* Write line in convergence log */
ierr = PetscViewerCreate(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr);
ierr = PetscViewerFileSetMode(viewer,FILE_MODE_APPEND);CHKERRQ(ierr);
ierr = PetscViewerFileSetName(viewer,"eimex_nonstiff_vdp.txt");CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"%D %D %10.8f %18.15f\n",eimex_rowcol[0],eimex_rowcol[1],(double)dt,(double)norm);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&ref);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
void PETSC_STDCALL tsgettime_(TS ts,PetscReal* t, int *__ierr ){
*__ierr = TSGetTime(
(TS)PetscToPointer((ts) ),t);
}
