/*
Helper rutine to handle user postenvents and recording
*/
static PetscErrorCode TSPostEvent(TS ts,PetscReal t,Vec U)
{
PetscErrorCode ierr;
TSEvent event = ts->event;
PetscBool terminate = PETSC_FALSE;
PetscBool restart = PETSC_FALSE;
PetscInt i,ctr,stepnum;
PetscBool inflag[2],outflag[2];
PetscBool forwardsolve = PETSC_TRUE; /* Flag indicating that TS is doing a forward solve */
PetscFunctionBegin;
if (event->postevent) {
PetscObjectState state_prev,state_post;
ierr = PetscObjectStateGet((PetscObject)U,&state_prev);CHKERRQ(ierr);
ierr = (*event->postevent)(ts,event->nevents_zero,event->events_zero,t,U,forwardsolve,event->ctx);CHKERRQ(ierr);
ierr = PetscObjectStateGet((PetscObject)U,&state_post);CHKERRQ(ierr);
if (state_prev != state_post) restart = PETSC_TRUE;
}
/* Handle termination events and step restart */
for (i=0; i<event->nevents_zero; i++) if (event->terminate[event->events_zero[i]]) terminate = PETSC_TRUE;
inflag[0] = restart; inflag[1] = terminate;
ierr = MPIU_Allreduce(inflag,outflag,2,MPIU_BOOL,MPI_LOR,((PetscObject)ts)->comm);CHKERRQ(ierr);
restart = outflag[0]; terminate = outflag[1];
if (restart) {ierr = TSRestartStep(ts);CHKERRQ(ierr);}
if (terminate) {ierr = TSSetConvergedReason(ts,TS_CONVERGED_EVENT);CHKERRQ(ierr);}
event->status = terminate ? TSEVENT_NONE : TSEVENT_RESET_NEXTSTEP;
/* Reset event residual functions as states might get changed by the postevent callback */
if (event->postevent) {
ierr = VecLockPush(U);CHKERRQ(ierr);
ierr = (*event->eventhandler)(ts,t,U,event->fvalue,event->ctx);CHKERRQ(ierr);
ierr = VecLockPop(U);CHKERRQ(ierr);
}
/* Cache current time and event residual functions */
event->ptime_prev = t;
for (i=0; i<event->nevents; i++)
event->fvalue_prev[i] = event->fvalue[i];
/* Record the event in the event recorder */
ierr = TSGetStepNumber(ts,&stepnum);CHKERRQ(ierr);
ctr = event->recorder.ctr;
if (ctr == event->recsize) {
ierr = TSEventRecorderResize(event);CHKERRQ(ierr);
}
event->recorder.time[ctr] = t;
event->recorder.stepnum[ctr] = stepnum;
event->recorder.nevents[ctr] = event->nevents_zero;
for (i=0; i<event->nevents_zero; i++) event->recorder.eventidx[ctr][i] = event->events_zero[i];
event->recorder.ctr++;
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);
}
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);
}