/*@
VecNormEnd - Ends a split phase norm computation.
Input Parameters:
+ x - the first vector (can be PETSC_NULL)
. ntype - norm type, one of NORM_1, NORM_2, NORM_MAX, NORM_1_AND_2
- result - where the result will go
Level: advanced
Notes:
Each call to VecNormBegin() should be paired with a call to VecNormEnd().
.seealso: VecNormBegin(), VecNorm(), VecDot(), VecMDot(), VecDotBegin(), VecDotEnd(), PetscCommSplitReductionBegin()
@*/
PetscErrorCode VecNormEnd(Vec x,NormType ntype,PetscReal *result)
{
PetscErrorCode ierr;
PetscSplitReduction *sr;
MPI_Comm comm;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)x,&comm);CHKERRQ(ierr);
ierr = PetscSplitReductionGet(comm,&sr);CHKERRQ(ierr);
ierr = PetscSplitReductionEnd(sr);CHKERRQ(ierr);
if (sr->numopsend >= sr->numopsbegin) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Called VecxxxEnd() more times then VecxxxBegin()");
if (x && (void*)x != sr->invecs[sr->numopsend]) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Called VecxxxEnd() in a different order or with a different vector than VecxxxBegin()");
if (sr->reducetype[sr->numopsend] != REDUCE_MAX && ntype == NORM_MAX) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Called VecNormEnd(,NORM_MAX,) on a reduction started with VecDotBegin() or NORM_1 or NORM_2");
result[0] = PetscRealPart(sr->gvalues[sr->numopsend++]);
if (ntype == NORM_2) {
result[0] = PetscSqrtReal(result[0]);
} else if (ntype == NORM_1_AND_2) {
result[1] = PetscRealPart(sr->gvalues[sr->numopsend++]);
result[1] = PetscSqrtReal(result[1]);
}
if (ntype!=NORM_1_AND_2) {
ierr = PetscObjectComposedDataSetReal((PetscObject)x,NormIds[ntype],result[0]);CHKERRQ(ierr);
}
if (sr->numopsend == sr->numopsbegin) {
sr->state = STATE_BEGIN;
sr->numopsend = 0;
sr->numopsbegin = 0;
}
PetscFunctionReturn(0);
}
static PetscErrorCode TSStep_RK(TS ts)
{
TS_RK *rk = (TS_RK*)ts->data;
RKTableau tab = rk->tableau;
const PetscInt s = tab->s;
const PetscReal *A = tab->A,*b = tab->b,*c = tab->c;
PetscScalar *w = rk->work;
Vec *Y = rk->Y,*YdotRHS = rk->YdotRHS;
TSAdapt adapt;
PetscInt i,j,reject,next_scheme;
PetscReal next_time_step;
PetscReal t;
PetscBool accept;
PetscErrorCode ierr;
PetscFunctionBegin;
next_time_step = ts->time_step;
t = ts->ptime;
accept = PETSC_TRUE;
rk->status = TS_STEP_INCOMPLETE;
for (reject=0; reject<ts->max_reject && !ts->reason; reject++,ts->reject++) {
PetscReal h = ts->time_step;
ierr = TSPreStep(ts);CHKERRQ(ierr);
for (i=0; i<s; i++) {
rk->stage_time = t + h*c[i];
ierr = TSPreStage(ts,rk->stage_time); CHKERRQ(ierr);
ierr = VecCopy(ts->vec_sol,Y[i]);CHKERRQ(ierr);
for (j=0; j<i; j++) w[j] = h*A[i*s+j];
ierr = VecMAXPY(Y[i],i,w,YdotRHS);CHKERRQ(ierr);
ierr = TSPostStage(ts,rk->stage_time,i,Y); CHKERRQ(ierr);
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptCheckStage(adapt,ts,&accept);CHKERRQ(ierr);
if (!accept) goto reject_step;
ierr = TSComputeRHSFunction(ts,t+h*c[i],Y[i],YdotRHS[i]);CHKERRQ(ierr);
}
ierr = TSEvaluateStep(ts,tab->order,ts->vec_sol,NULL);CHKERRQ(ierr);
rk->status = TS_STEP_PENDING;
/* Register only the current method as a candidate because we're not supporting multiple candidates yet. */
ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr);
ierr = TSAdaptCandidatesClear(adapt);CHKERRQ(ierr);
ierr = TSAdaptCandidateAdd(adapt,tab->name,tab->order,1,tab->ccfl,1.*tab->s,PETSC_TRUE);CHKERRQ(ierr);
ierr = TSAdaptChoose(adapt,ts,ts->time_step,&next_scheme,&next_time_step,&accept);CHKERRQ(ierr);
if (accept) {
if (ts->costintegralfwd) {
/* Evolve ts->vec_costintegral to compute integrals */
for (i=0; i<s; i++) {
ierr = TSAdjointComputeCostIntegrand(ts,t+h*c[i],Y[i],ts->vec_costintegrand);CHKERRQ(ierr);
ierr = VecAXPY(ts->vec_costintegral,h*b[i],ts->vec_costintegrand);CHKERRQ(ierr);
}
}
/* ignore next_scheme for now */
ts->ptime += ts->time_step;
ts->time_step = next_time_step;
ts->steps++;
rk->status = TS_STEP_COMPLETE;
ierr = PetscObjectComposedDataSetReal((PetscObject)ts->vec_sol,explicit_stage_time_id,ts->ptime);CHKERRQ(ierr);
break;
} else { /* Roll back the current step */
for (j=0; j<s; j++) w[j] = -h*b[j];
ierr = VecMAXPY(ts->vec_sol,s,w,rk->YdotRHS);CHKERRQ(ierr);
ts->time_step = next_time_step;
rk->status = TS_STEP_INCOMPLETE;
}
reject_step: continue;
}
if (rk->status != TS_STEP_COMPLETE && !ts->reason) ts->reason = TS_DIVERGED_STEP_REJECTED;
PetscFunctionReturn(0);
}