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; PetscInt order = PETSC_DECIDE; PetscReal enorm = -1; PetscReal safety = basic->safety; PetscReal hfac_lte,h_lte; PetscErrorCode ierr; PetscFunctionBegin; *next_sc = 0; /* Reuse the same order scheme */ if (ts->ops->evaluatewlte) { ierr = TSEvaluateWLTE(ts,adapt->wnormtype,&order,&enorm);CHKERRQ(ierr); if (enorm >= 0 && order < 1) SETERRQ1(PetscObjectComm((PetscObject)adapt),PETSC_ERR_ARG_OUTOFRANGE,"Computed error order %D must be positive",order); } else if (ts->ops->evaluatestep) { if (adapt->candidates.n < 1) SETERRQ(PetscObjectComm((PetscObject)adapt),PETSC_ERR_ARG_WRONGSTATE,"No candidate has been registered"); if (!adapt->candidates.inuse_set) SETERRQ1(PetscObjectComm((PetscObject)adapt),PETSC_ERR_ARG_WRONGSTATE,"The current in-use scheme is not among the %D candidates",adapt->candidates.n); if (!basic->Y) {ierr = VecDuplicate(ts->vec_sol,&basic->Y);CHKERRQ(ierr);} order = adapt->candidates.order[0]; ierr = TSEvaluateStep(ts,order-1,basic->Y,NULL);CHKERRQ(ierr); ierr = TSErrorWeightedNorm(ts,ts->vec_sol,basic->Y,adapt->wnormtype,&enorm);CHKERRQ(ierr); } if (enorm < 0) { *accept = PETSC_TRUE; *next_h = h; /* Reuse the old step */ *wlte = -1; /* Weighted local truncation error was not evaluated */ PetscFunctionReturn(0); } /* Determine whether the step is accepted of rejected */ 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. */ if (enorm > 0) hfac_lte = safety * PetscPowReal(enorm,((PetscReal)-1)/order); else hfac_lte = safety * PETSC_INFINITY; h_lte = h * PetscClipInterval(hfac_lte,basic->clip[0],basic->clip[1]); *next_h = PetscClipInterval(h_lte,adapt->dt_min,adapt->dt_max); *wlte = enorm; 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); }
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,*c = tab->c; PetscScalar *w = rk->work; Vec *Y = rk->Y,*YdotRHS = rk->YdotRHS; TSAdapt adapt; PetscInt i,j; PetscInt rejections = 0; PetscBool stageok,accept = PETSC_TRUE; PetscReal next_time_step = ts->time_step; PetscErrorCode ierr; PetscFunctionBegin; rk->status = TS_STEP_INCOMPLETE; while (!ts->reason && rk->status != TS_STEP_COMPLETE) { PetscReal t = ts->ptime; PetscReal h = ts->time_step; 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,rk->stage_time,Y[i],&stageok);CHKERRQ(ierr); if (!stageok) goto reject_step; ierr = TSComputeRHSFunction(ts,t+h*c[i],Y[i],YdotRHS[i]);CHKERRQ(ierr); } rk->status = TS_STEP_INCOMPLETE; ierr = TSEvaluateStep(ts,tab->order,ts->vec_sol,NULL);CHKERRQ(ierr); rk->status = TS_STEP_PENDING; 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,NULL,&next_time_step,&accept);CHKERRQ(ierr); rk->status = accept ? TS_STEP_COMPLETE : TS_STEP_INCOMPLETE; if (!accept) { /* Roll back the current step */ ierr = TSRollBack_RK(ts);CHKERRQ(ierr); ts->time_step = next_time_step; goto reject_step; } if (ts->costintegralfwd) { /* Save the info for the later use in cost integral evaluation*/ rk->ptime = ts->ptime; rk->time_step = ts->time_step; } ts->ptime += ts->time_step; ts->time_step = next_time_step; break; reject_step: ts->reject++; accept = PETSC_FALSE; if (!ts->reason && ++rejections > ts->max_reject && ts->max_reject >= 0) { ts->reason = TS_DIVERGED_STEP_REJECTED; ierr = PetscInfo2(ts,"Step=%D, step rejections %D greater than current TS allowed, stopping solve\n",ts->steps,rejections);CHKERRQ(ierr); } } PetscFunctionReturn(0); }
static PetscErrorCode TSStep_Theta(TS ts) { TS_Theta *th = (TS_Theta*)ts->data; PetscInt its,lits,reject,next_scheme; PetscReal next_time_step; TSAdapt adapt; PetscBool stageok,accept = PETSC_TRUE; PetscErrorCode ierr; PetscFunctionBegin; th->status = TS_STEP_INCOMPLETE; ierr = VecCopy(ts->vec_sol,th->X0);CHKERRQ(ierr); for (reject=0; !ts->reason && th->status != TS_STEP_COMPLETE; ts->reject++) { PetscReal shift = 1./(th->Theta*ts->time_step); th->stage_time = ts->ptime + (th->endpoint ? 1. : th->Theta)*ts->time_step; ierr = TSPreStep(ts);CHKERRQ(ierr); ierr = TSPreStage(ts,th->stage_time);CHKERRQ(ierr); if (th->endpoint) { /* This formulation assumes linear time-independent mass matrix */ ierr = VecZeroEntries(th->Xdot);CHKERRQ(ierr); if (!th->affine) {ierr = VecDuplicate(ts->vec_sol,&th->affine);CHKERRQ(ierr);} ierr = TSComputeIFunction(ts,ts->ptime,ts->vec_sol,th->Xdot,th->affine,PETSC_FALSE);CHKERRQ(ierr); ierr = VecScale(th->affine,(th->Theta-1.)/th->Theta);CHKERRQ(ierr); } if (th->extrapolate) { ierr = VecWAXPY(th->X,1./shift,th->Xdot,ts->vec_sol);CHKERRQ(ierr); } else { ierr = VecCopy(ts->vec_sol,th->X);CHKERRQ(ierr); } ierr = SNESSolve(ts->snes,th->affine,th->X);CHKERRQ(ierr); ierr = SNESGetIterationNumber(ts->snes,&its);CHKERRQ(ierr); ierr = SNESGetLinearSolveIterations(ts->snes,&lits);CHKERRQ(ierr); ts->snes_its += its; ts->ksp_its += lits; ierr = TSPostStage(ts,th->stage_time,0,&(th->X));CHKERRQ(ierr); ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr); ierr = TSAdaptCheckStage(adapt,ts,&stageok);CHKERRQ(ierr); if (!stageok) {accept = PETSC_FALSE; goto reject_step;} ierr = TSEvaluateStep(ts,th->order,ts->vec_sol,NULL);CHKERRQ(ierr); th->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,NULL,th->order,1,th->ccfl,1.0,PETSC_TRUE);CHKERRQ(ierr); ierr = TSAdaptChoose(adapt,ts,ts->time_step,&next_scheme,&next_time_step,&accept);CHKERRQ(ierr); if (!accept) { /* Roll back the current step */ ts->ptime += next_time_step; /* This will be undone in rollback */ th->status = TS_STEP_INCOMPLETE; ierr = TSRollBack(ts);CHKERRQ(ierr); goto reject_step; } /* ignore next_scheme for now */ ts->ptime += ts->time_step; ts->time_step = next_time_step; ts->steps++; th->status = TS_STEP_COMPLETE; break; reject_step: if (!ts->reason && ++reject > ts->max_reject && ts->max_reject >= 0) { ts->reason = TS_DIVERGED_STEP_REJECTED; ierr = PetscInfo2(ts,"Step=%D, step rejections %D greater than current TS allowed, stopping solve\n",ts->steps,reject);CHKERRQ(ierr); } continue; } 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); }
void PETSC_STDCALL tsevaluatestep_(TS ts,PetscInt *order,Vec X,PetscBool *done, int *__ierr ){ *__ierr = TSEvaluateStep( (TS)PetscToPointer((ts) ),*order, (Vec)PetscToPointer((X) ),done); }
static PetscErrorCode TSStep_EIMEX(TS ts) { TS_EIMEX *ext = (TS_EIMEX*)ts->data; const PetscInt ns = ext->nstages; Vec *T=ext->T, Y=ext->Y; SNES snes; PetscInt i,j; PetscBool accept = PETSC_FALSE; PetscErrorCode ierr; PetscReal alpha,local_error; PetscFunctionBegin; ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); ierr = SNESSetType(snes,"ksponly"); CHKERRQ(ierr); ext->status = TS_STEP_INCOMPLETE; ierr = VecCopy(ts->vec_sol,ext->VecSolPrev);CHKERRQ(ierr); /* Apply n_j steps of the base method to obtain solutions of T(j,1),1<=j<=s */ for(j=0; j<ns; j++){ ierr = TSStage_EIMEX(ts,j);CHKERRQ(ierr); ierr = VecCopy(Y,T[j]); CHKERRQ(ierr); } for(i=1;i<ns;i++){ for(j=i;j<ns;j++){ alpha = -(PetscReal)ext->N[j]/ext->N[j-i]; ierr = VecAXPBYPCZ(T[Map(j,i,ns)],alpha,1.0,0,T[Map(j,i-1,ns)],T[Map(j-1,i-1,ns)]);/* T[j][i]=alpha*T[j][i-1]+T[j-1][i-1] */CHKERRQ(ierr); alpha = 1.0/(1.0 + alpha); ierr = VecScale(T[Map(j,i,ns)],alpha);CHKERRQ(ierr); } } ierr = TSEvaluateStep(ts,ns,ts->vec_sol,NULL);CHKERRQ(ierr);/*update ts solution */ if(ext->ord_adapt && ext->nstages < ext->max_rows){ accept = PETSC_FALSE; while(!accept && ext->nstages < ext->max_rows){ ierr = TSErrorWeightedNorm(ts,ts->vec_sol,T[Map(ext->nstages-1,ext->nstages-2,ext->nstages)],ts->adapt->wnormtype,&local_error);CHKERRQ(ierr); accept = (local_error < 1.0)? PETSC_TRUE : PETSC_FALSE; if(!accept){/* add one more stage*/ ierr = TSStage_EIMEX(ts,ext->nstages);CHKERRQ(ierr); ext->nstages++; ext->row_ind++; ext->col_ind++; /*T table need to be recycled*/ ierr = VecDuplicateVecs(ts->vec_sol,(1+ext->nstages)*ext->nstages/2,&ext->T);CHKERRQ(ierr); for(i=0; i<ext->nstages-1; i++){ for(j=0; j<=i; j++){ ierr = VecCopy(T[Map(i,j,ext->nstages-1)],ext->T[Map(i,j,ext->nstages)]);CHKERRQ(ierr); } } ierr = VecDestroyVecs(ext->nstages*(ext->nstages-1)/2,&T);CHKERRQ(ierr); T = ext->T; /*reset the pointer*/ /*recycling finished, store the new solution*/ ierr = VecCopy(Y,T[ext->nstages-1]); CHKERRQ(ierr); /*extrapolation for the newly added stage*/ for(i=1;i<ext->nstages;i++){ alpha = -(PetscReal)ext->N[ext->nstages-1]/ext->N[ext->nstages-1-i]; ierr = VecAXPBYPCZ(T[Map(ext->nstages-1,i,ext->nstages)],alpha,1.0,0,T[Map(ext->nstages-1,i-1,ext->nstages)],T[Map(ext->nstages-1-1,i-1,ext->nstages)]);/*T[ext->nstages-1][i]=alpha*T[ext->nstages-1][i-1]+T[ext->nstages-1-1][i-1]*/CHKERRQ(ierr); alpha = 1.0/(1.0 + alpha); ierr = VecScale(T[Map(ext->nstages-1,i,ext->nstages)],alpha);CHKERRQ(ierr); } /*update ts solution */ ierr = TSEvaluateStep(ts,ext->nstages,ts->vec_sol,NULL);CHKERRQ(ierr); }/*end if !accept*/ }/*end while*/ if(ext->nstages == ext->max_rows){ ierr = PetscInfo(ts,"Max number of rows has been used\n");CHKERRQ(ierr); } }/*end if ext->ord_adapt*/ ts->ptime += ts->time_step; ext->status = TS_STEP_COMPLETE; if (ext->status != TS_STEP_COMPLETE && !ts->reason) ts->reason = TS_DIVERGED_STEP_REJECTED; PetscFunctionReturn(0); }