/*@ 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); }