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 TSTrajectoryGet_Basic(TSTrajectory tj,TS ts,PetscInt stepnum,PetscReal *t)
{
Vec Sol,*Y;
PetscInt Nr,i;
PetscViewer viewer;
PetscReal timepre;
char filename[PETSC_MAX_PATH_LEN];
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = TSGetTotalSteps(ts,&stepnum);CHKERRQ(ierr);
ierr = PetscSNPrintf(filename,sizeof filename,"SA-data/SA-%06d.bin",stepnum);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,filename,FILE_MODE_READ,&viewer);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&Sol);CHKERRQ(ierr);
ierr = VecLoad(Sol,viewer);CHKERRQ(ierr);
ierr = PetscViewerBinaryRead(viewer,t,1,NULL,PETSC_REAL);CHKERRQ(ierr);
if (stepnum != 0) {
ierr = TSGetStages(ts,&Nr,&Y);CHKERRQ(ierr);
for (i=0;i<Nr ;i++) {
ierr = VecLoad(Y[i],viewer);CHKERRQ(ierr);
}
ierr = PetscViewerBinaryRead(viewer,&timepre,1,NULL,PETSC_REAL);CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,-(*t)+timepre);CHKERRQ(ierr);
}
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Sets up a monitor that will display He as a function of space and cluster size for each time step
*/
PetscErrorCode MyMonitorSetUp(TS ts)
{
DM da;
PetscErrorCode ierr;
PetscInt xi,xs,xm,*idx,M,xj,cnt = 0,dof = 3*N + N*N;
const PetscInt *lx;
Vec C;
MyMonitorCtx *ctx;
PetscBool flg;
IS is;
char ycoor[32];
PetscReal valuebounds[4] = {0, 1.2, 0, 1.2};
PetscFunctionBeginUser;
ierr = PetscOptionsHasName(PETSC_NULL,"-mymonitor",&flg);CHKERRQ(ierr);
if (!flg) PetscFunctionReturn(0);
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = PetscNew(MyMonitorCtx,&ctx);CHKERRQ(ierr);
ierr = PetscViewerDrawOpen(((PetscObject)da)->comm,PETSC_NULL,"",PETSC_DECIDE,PETSC_DECIDE,600,400,&ctx->viewer);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&xs,PETSC_NULL,PETSC_NULL,&xm,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&M,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
ierr = DMDAGetOwnershipRanges(da,&lx,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
ierr = DMDACreate2d(((PetscObject)da)->comm,DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE,DMDA_STENCIL_STAR,M,N,PETSC_DETERMINE,1,2,1,lx,PETSC_NULL,&ctx->da);CHKERRQ(ierr);
ierr = DMDASetFieldName(ctx->da,0,"He");CHKERRQ(ierr);
ierr = DMDASetFieldName(ctx->da,1,"V");CHKERRQ(ierr);
ierr = DMDASetCoordinateName(ctx->da,0,"X coordinate direction");CHKERRQ(ierr);
ierr = PetscSNPrintf(ycoor,32,"%D ... Cluster size ... 1",N);CHKERRQ(ierr);
ierr = DMDASetCoordinateName(ctx->da,1,ycoor);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(ctx->da,&ctx->He);CHKERRQ(ierr);
ierr = PetscMalloc(2*N*xm*sizeof(PetscInt),&idx);CHKERRQ(ierr);
cnt = 0;
for (xj=0; xj<N; xj++) {
for (xi=xs; xi<xs+xm; xi++) {
idx[cnt++] = dof*xi + xj;
idx[cnt++] = dof*xi + xj + N;
}
}
ierr = ISCreateGeneral(((PetscObject)ts)->comm,2*N*xm,idx,PETSC_OWN_POINTER,&is);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&C);CHKERRQ(ierr);
ierr = VecScatterCreate(C,is,ctx->He,PETSC_NULL,&ctx->scatter);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
/* sets the bounds on the contour plot values so the colors mean the same thing for different timesteps */
ierr = PetscViewerDrawSetBounds(ctx->viewer,2,valuebounds);CHKERRQ(ierr);
ierr = TSMonitorSet(ts,MyMonitorMonitor,ctx,MyMonitorDestroy);CHKERRQ(ierr);
PetscFunctionReturn(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 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 TSMonitorDMDARay(TS ts,PetscInt steps,PetscReal time,Vec u,void *mctx)
{
TSMonitorDMDARayCtx *rayctx = (TSMonitorDMDARayCtx*)mctx;
Vec solution;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = TSGetSolution(ts,&solution);CHKERRQ(ierr);
ierr = VecScatterBegin(rayctx->scatter,solution,rayctx->ray,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(rayctx->scatter,solution,rayctx->ray,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
if (rayctx->viewer) {
ierr = VecView(rayctx->ray,rayctx->viewer);CHKERRQ(ierr);
}
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;
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);
}
/*
Use Lax-Wendroff method to evaluate F(u,t) = du/dt + a * du/dx
*/
PetscErrorCode IFunction_LaxWendroff(TS ts,PetscReal t,Vec U,Vec Udot,Vec F,void* ctx)
{
PetscErrorCode ierr;
AppCtx *appctx=(AppCtx*)ctx;
PetscInt mstart,mend,M,i,um;
DM da;
Vec Uold,localUold;
PetscScalar *uarray,*f,*uoldarray,h,RFlux,LFlux,lambda;
PetscReal dt,a;
PetscFunctionBegin;
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&Uold);CHKERRQ(ierr);
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&M,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&mstart,0,0,&um,0,0);CHKERRQ(ierr);
h = 1.0/M;
mend = mstart + um;
/* printf(" mstart %d, um %d\n",mstart,um); */
ierr = DMGetLocalVector(da,&localUold);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da,Uold,INSERT_VALUES,localUold);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,Uold,INSERT_VALUES,localUold);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArrayRead(da,U,&uarray);CHKERRQ(ierr);
ierr = DMDAVecGetArrayRead(da,localUold,&uoldarray);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/* advection -- finite volume (appctx->a < 0 -- can be relaxed?) */
lambda = dt/h;
a = appctx->a;
for (i=mstart; i<mend; i++) {
RFlux = 0.5 * a * (uoldarray[i+1] + uoldarray[i]) - a*a*0.5*lambda * (uoldarray[i+1] - uoldarray[i]);
LFlux = 0.5 * a * (uoldarray[i-1] + uoldarray[i]) - a*a*0.5*lambda * (uoldarray[i] - uoldarray[i-1]);
f[i] = uarray[i] - uoldarray[i] + lambda * (RFlux - LFlux);
}
/* Restore vectors */
ierr = DMDAVecRestoreArrayRead(da,U,&uarray);CHKERRQ(ierr);
ierr = DMDAVecRestoreArrayRead(da,localUold,&uoldarray);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localUold);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Use Lax-Friedrichs method to evaluate F(u,t) = du/dt + a * du/dx
See https://en.wikipedia.org/wiki/Lax%E2%80%93Friedrichs_method
*/
PetscErrorCode IFunction_LaxFriedrichs(TS ts,PetscReal t,Vec U,Vec Udot,Vec F,void* ctx)
{
PetscErrorCode ierr;
AppCtx *appctx=(AppCtx*)ctx;
PetscInt mstart,mend,M,i,um;
DM da;
Vec Uold,localUold;
PetscScalar *uarray,*f,*uoldarray,h,uave,c;
PetscReal dt;
PetscFunctionBegin;
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&Uold);CHKERRQ(ierr);
ierr = TSGetDM(ts,&da);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&M,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&mstart,0,0,&um,0,0);CHKERRQ(ierr);
h = 1.0/M;
mend = mstart + um;
/* printf(" mstart %d, um %d\n",mstart,um); */
ierr = DMGetLocalVector(da,&localUold);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(da,Uold,INSERT_VALUES,localUold);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,Uold,INSERT_VALUES,localUold);CHKERRQ(ierr);
/* Get pointers to vector data */
ierr = DMDAVecGetArrayRead(da,U,&uarray);CHKERRQ(ierr);
ierr = DMDAVecGetArrayRead(da,localUold,&uoldarray);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
/* advection */
c = appctx->a*dt/h; /* Courant-Friedrichs-Lewy number (CFL number) */
for (i=mstart; i<mend; i++) {
uave = 0.5*(uoldarray[i-1] + uoldarray[i+1]);
f[i] = uarray[i] - uave + c*0.5*(uoldarray[i+1] - uoldarray[i-1]);
}
/* Restore vectors */
ierr = DMDAVecRestoreArrayRead(da,U,&uarray);CHKERRQ(ierr);
ierr = DMDAVecRestoreArrayRead(da,localUold,&uoldarray);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localUold);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSAdaptChoose_Basic(TSAdapt adapt,TS ts,PetscReal h,PetscInt *next_sc,PetscReal *next_h,PetscBool *accept,PetscReal *wlte)
{
TSAdapt_Basic *basic = (TSAdapt_Basic*)adapt->data;
PetscErrorCode ierr;
Vec X,Y;
PetscReal enorm,hfac_lte,h_lte,safety;
PetscInt order,stepno;
PetscFunctionBegin;
ierr = TSGetTimeStepNumber(ts,&stepno);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
if (!basic->Y) {ierr = VecDuplicate(X,&basic->Y);CHKERRQ(ierr);}
Y = basic->Y;
order = adapt->candidates.order[0];
ierr = TSEvaluateStep(ts,order-1,Y,NULL);CHKERRQ(ierr);
safety = basic->safety;
ierr = TSErrorNormWRMS(ts,Y,&enorm);CHKERRQ(ierr);
if (enorm > 1.) {
if (!*accept) safety *= basic->reject_safety; /* The last attempt also failed, shorten more aggressively */
if (h < (1 + PETSC_SQRT_MACHINE_EPSILON)*adapt->dt_min) {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting because step size %g is at minimum\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
} else if (basic->always_accept) {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting step of size %g because always_accept is set\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
} else {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, rejecting step of size %g\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_FALSE;
}
} else {
ierr = PetscInfo2(adapt,"Estimated scaled local truncation error %g, accepting step of size %g\n",(double)enorm,(double)h);CHKERRQ(ierr);
*accept = PETSC_TRUE;
}
/* The optimal new step based purely on local truncation error for this step. */
hfac_lte = safety * PetscRealPart(PetscPowScalar((PetscScalar)enorm,(PetscReal)(-1./order)));
h_lte = h * PetscClipInterval(hfac_lte,basic->clip[0],basic->clip[1]);
*next_sc = 0;
*next_h = PetscClipInterval(h_lte,adapt->dt_min,adapt->dt_max);
*wlte = enorm;
PetscFunctionReturn(0);
}
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);
}
double TimeIntegration_PETSc::solveTimeStep(Vlasov *vlasov, Fields *fields, TestParticles *particles, Timing &timing)
{
if(timeIntegrationScheme == "Implicit_RK4") {
PETScMatrixVector pMV(vlasov, fields);
TSSetTimeStep(ts, dt);
TSStep(ts);
// Get Solution
Vec Vec_F1;
cmplxd *x_F1;
TSGetSolution(ts, &Vec_F1);
VecGetArray(Vec_F1, &x_F1);
// copy whole phase space function (waste but starting point) (important due to bounday conditions
// we can built wrapper around this and directly pass it
for(int x = NxLlD, n = 0; x <= NxLuD; x++) { for(int y_k = NkyLlD; y_k <= NkyLuD; y_k++) { for(int z = NzLlD; z <= NzLuD; z++) {
for(int v = NvLlD ; v <= NvLuD; v++) { for(int m = NmLlD ; m <= NmLuD ; m++ ) { for(int s = NsLlD; s <= NsLuD; s++) {
vlasov->fs(x,y_k,z,v,m,s) = x_F1[n];
vlasov->f(x,y_k,z,v,m,s) = x_F1[n++];
}}} }}}
fields->solve(vlasov->f0, vlasov->f);
VecRestoreArray (Vec_F1, &x_F1);
timing.time += dt;
timing.step++;
writeTimeStep(timing, maxTiming, dt);
}
else TimeIntegration::solveTimeStep(vlasov, fields, particles, timing);
return dt;
}
/*
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);
}
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);
}
void PETSC_STDCALL tsgetsolution_(TS ts,Vec *v, int *__ierr ){
*__ierr = TSGetSolution(
(TS)PetscToPointer((ts) ),v);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
PetscInt time_steps=100,iout,NOUT=1;
PetscMPIInt size;
Vec global;
PetscReal dt,ftime,ftime_original;
TS ts;
PetscViewer viewfile;
Mat J = 0;
Vec x;
Data data;
PetscInt mn;
PetscBool flg;
MatColoring mc;
ISColoring iscoloring;
MatFDColoring matfdcoloring = 0;
PetscBool fd_jacobian_coloring = PETSC_FALSE;
SNES snes;
KSP ksp;
PC pc;
PetscViewer viewer;
char pcinfo[120],tsinfo[120];
TSType tstype;
PetscBool sundials;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
/* set data */
data.m = 9;
data.n = 9;
data.a = 1.0;
data.epsilon = 0.1;
data.dx = 1.0/(data.m+1.0);
data.dy = 1.0/(data.n+1.0);
mn = (data.m)*(data.n);
ierr = PetscOptionsGetInt(NULL,"-time",&time_steps,NULL);CHKERRQ(ierr);
/* set initial conditions */
ierr = VecCreate(PETSC_COMM_WORLD,&global);CHKERRQ(ierr);
ierr = VecSetSizes(global,PETSC_DECIDE,mn);CHKERRQ(ierr);
ierr = VecSetFromOptions(global);CHKERRQ(ierr);
ierr = Initial(global,&data);CHKERRQ(ierr);
ierr = VecDuplicate(global,&x);CHKERRQ(ierr);
/* create timestep context */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSMonitorSet(ts,Monitor,&data,NULL);CHKERRQ(ierr);
#if defined(PETSC_HAVE_SUNDIALS)
ierr = TSSetType(ts,TSSUNDIALS);CHKERRQ(ierr);
#else
ierr = TSSetType(ts,TSEULER);CHKERRQ(ierr);
#endif
dt = 0.1;
ftime_original = data.tfinal = 1.0;
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetDuration(ts,time_steps,ftime_original);CHKERRQ(ierr);
ierr = TSSetSolution(ts,global);CHKERRQ(ierr);
/* set user provided RHSFunction and RHSJacobian */
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&data);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr);
ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,mn,mn);CHKERRQ(ierr);
ierr = MatSetFromOptions(J);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(J,5,NULL);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(J,5,NULL,5,NULL);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-ts_fd",&flg);CHKERRQ(ierr);
if (!flg) {
ierr = TSSetRHSJacobian(ts,J,J,RHSJacobian,&data);CHKERRQ(ierr);
} else {
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-fd_color",&fd_jacobian_coloring);CHKERRQ(ierr);
if (fd_jacobian_coloring) { /* Use finite differences with coloring */
/* Get data structure of J */
PetscBool pc_diagonal;
ierr = PetscOptionsHasName(NULL,"-pc_diagonal",&pc_diagonal);CHKERRQ(ierr);
if (pc_diagonal) { /* the preconditioner of J is a diagonal matrix */
PetscInt rstart,rend,i;
PetscScalar zero=0.0;
ierr = MatGetOwnershipRange(J,&rstart,&rend);CHKERRQ(ierr);
for (i=rstart; i<rend; i++) {
ierr = MatSetValues(J,1,&i,1,&i,&zero,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
} else {
/* Fill the structure using the expensive SNESComputeJacobianDefault. Temporarily set up the TS so we can call this function */
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
ierr = TSSetUp(ts);CHKERRQ(ierr);
ierr = SNESComputeJacobianDefault(snes,x,J,J,ts);CHKERRQ(ierr);
}
/* create coloring context */
ierr = MatColoringCreate(J,&mc);CHKERRQ(ierr);
ierr = MatColoringSetType(mc,MATCOLORINGSL);CHKERRQ(ierr);
ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr);
ierr = MatColoringApply(mc,&iscoloring);CHKERRQ(ierr);
ierr = MatColoringDestroy(&mc);CHKERRQ(ierr);
ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode (*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(J,iscoloring,matfdcoloring);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,matfdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
} else { /* Use finite differences (slow) */
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefault,NULL);CHKERRQ(ierr);
}
}
/* Pick up a Petsc preconditioner */
/* one can always set method or preconditioner during the run time */
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSetUp(ts);CHKERRQ(ierr);
/* Test TSSetPostStep() */
ierr = PetscOptionsHasName(NULL,"-test_PostStep",&flg);CHKERRQ(ierr);
if (flg) {
ierr = TSSetPostStep(ts,PostStep);CHKERRQ(ierr);
}
ierr = PetscOptionsGetInt(NULL,"-NOUT",&NOUT,NULL);CHKERRQ(ierr);
for (iout=1; iout<=NOUT; iout++) {
ierr = TSSetDuration(ts,time_steps,iout*ftime_original/NOUT);CHKERRQ(ierr);
ierr = TSSolve(ts,global);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts,ftime,dt);CHKERRQ(ierr);
}
/* Interpolate solution at tfinal */
ierr = TSGetSolution(ts,&global);CHKERRQ(ierr);
ierr = TSInterpolate(ts,ftime_original,global);CHKERRQ(ierr);
ierr = PetscOptionsHasName(NULL,"-matlab_view",&flg);CHKERRQ(ierr);
if (flg) { /* print solution into a MATLAB file */
ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,"out.m",&viewfile);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(viewfile,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
ierr = VecView(global,viewfile);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewfile);CHKERRQ(ierr);
}
/* display solver info for Sundials */
ierr = TSGetType(ts,&tstype);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)ts,TSSUNDIALS,&sundials);CHKERRQ(ierr);
if (sundials) {
ierr = PetscViewerStringOpen(PETSC_COMM_WORLD,tsinfo,120,&viewer);CHKERRQ(ierr);
ierr = TSView(ts,viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = PetscViewerStringOpen(PETSC_COMM_WORLD,pcinfo,120,&viewer);CHKERRQ(ierr);
ierr = PCView(pc,viewer);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"%d Procs,%s TSType, %s Preconditioner\n",size,tsinfo,pcinfo);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
/* free the memories */
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = VecDestroy(&global);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = MatDestroy(&J);CHKERRQ(ierr);
if (fd_jacobian_coloring) {ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);}
ierr = PetscFinalize();
return 0;
}
Vector solution() const {
Vec U;
TSGetSolution(ts, &U);
return Vector(U, Vector::owner::other);
}
