static PetscErrorCode TSStep_Euler(TS ts,PetscInt *steps,PetscReal *ptime)
{
TS_Euler *euler = (TS_Euler*)ts->data;
Vec sol = ts->vec_sol,update = euler->update;
PetscErrorCode ierr;
PetscInt i,max_steps = ts->max_steps;
PetscFunctionBegin;
*steps = -ts->steps;
ierr = TSMonitor(ts,ts->steps,ts->ptime,sol);CHKERRQ(ierr);
for (i=0; i<max_steps; i++) {
PetscReal dt = ts->time_step;
ierr = TSPreStep(ts);CHKERRQ(ierr);
ts->ptime += dt;
ierr = TSComputeRHSFunction(ts,ts->ptime,sol,update);CHKERRQ(ierr);
ierr = VecAXPY(sol,dt,update);CHKERRQ(ierr);
ts->steps++;
ierr = TSPostStep(ts);CHKERRQ(ierr);
ierr = TSMonitor(ts,ts->steps,ts->ptime,sol);CHKERRQ(ierr);
if (ts->ptime > ts->max_time) break;
}
*steps += ts->steps;
*ptime = ts->ptime;
PetscFunctionReturn(0);
}
PetscErrorCode TSStep_Sundials_Nonlinear(TS ts,int *steps,double *time)
{
TS_Sundials *cvode = (TS_Sundials*)ts->data;
Vec sol = ts->vec_sol;
PetscErrorCode ierr;
PetscInt i,max_steps = ts->max_steps,flag;
long int its;
realtype t,tout;
PetscScalar *y_data;
void *mem;
PetscFunctionBegin;
mem = cvode->mem;
tout = ts->max_time;
ierr = VecGetArray(ts->vec_sol,&y_data);CHKERRQ(ierr);
N_VSetArrayPointer((realtype *)y_data,cvode->y);
ierr = VecRestoreArray(ts->vec_sol,PETSC_NULL);CHKERRQ(ierr);
for (i = 0; i < max_steps; i++) {
if (ts->ptime >= ts->max_time) break;
ierr = TSPreStep(ts);CHKERRQ(ierr);
if (cvode->monitorstep){
flag = CVode(mem,tout,cvode->y,&t,CV_ONE_STEP);
} else {
flag = CVode(mem,tout,cvode->y,&t,CV_NORMAL);
}
if (flag)SETERRQ1(PETSC_ERR_LIB,"CVode() fails, flag %d",flag);
if (t > ts->max_time && cvode->exact_final_time) {
/* interpolate to final requested time */
ierr = CVodeGetDky(mem,tout,0,cvode->y);CHKERRQ(ierr);
t = tout;
}
ts->time_step = t - ts->ptime;
ts->ptime = t;
/* copy the solution from cvode->y to cvode->update and sol */
ierr = VecPlaceArray(cvode->w1,y_data); CHKERRQ(ierr);
ierr = VecCopy(cvode->w1,cvode->update);CHKERRQ(ierr);
ierr = VecResetArray(cvode->w1); CHKERRQ(ierr);
ierr = VecCopy(cvode->update,sol);CHKERRQ(ierr);
ierr = CVodeGetNumNonlinSolvIters(mem,&its);CHKERRQ(ierr);
ts->nonlinear_its = its;
ierr = CVSpilsGetNumLinIters(mem, &its);
ts->linear_its = its;
ts->steps++;
ierr = TSPostStep(ts);CHKERRQ(ierr);
ierr = TSMonitor(ts,ts->steps,t,sol);CHKERRQ(ierr);
}
*steps += ts->steps;
*time = t;
PetscFunctionReturn(0);
}
PetscErrorCode TSSetUp_Sundials_Nonlinear(TS ts)
{
TS_Sundials *cvode = (TS_Sundials*)ts->data;
PetscErrorCode ierr;
PetscInt glosize,locsize,i,flag;
PetscScalar *y_data,*parray;
void *mem;
const PCType pctype;
PetscTruth pcnone;
Vec sol = ts->vec_sol;
PetscFunctionBegin;
ierr = PCSetFromOptions(cvode->pc);CHKERRQ(ierr);
/* get the vector size */
ierr = VecGetSize(ts->vec_sol,&glosize);CHKERRQ(ierr);
ierr = VecGetLocalSize(ts->vec_sol,&locsize);CHKERRQ(ierr);
/* allocate the memory for N_Vec y */
cvode->y = N_VNew_Parallel(cvode->comm_sundials,locsize,glosize);
if (!cvode->y) SETERRQ(1,"cvode->y is not allocated");
/* initialize N_Vec y: copy ts->vec_sol to cvode->y */
ierr = VecGetArray(ts->vec_sol,&parray);CHKERRQ(ierr);
y_data = (PetscScalar *) N_VGetArrayPointer(cvode->y);
for (i = 0; i < locsize; i++) y_data[i] = parray[i];
/*ierr = PetscMemcpy(y_data,parray,locsize*sizeof(PETSC_SCALAR)); CHKERRQ(ierr);*/
ierr = VecRestoreArray(ts->vec_sol,PETSC_NULL);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&cvode->update);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&cvode->func);CHKERRQ(ierr);
ierr = PetscLogObjectParent(ts,cvode->update);CHKERRQ(ierr);
ierr = PetscLogObjectParent(ts,cvode->func);CHKERRQ(ierr);
/*
Create work vectors for the TSPSolve_Sundials() routine. Note these are
allocated with zero space arrays because the actual array space is provided
by Sundials and set using VecPlaceArray().
*/
ierr = VecCreateMPIWithArray(((PetscObject)ts)->comm,locsize,PETSC_DECIDE,0,&cvode->w1);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(((PetscObject)ts)->comm,locsize,PETSC_DECIDE,0,&cvode->w2);CHKERRQ(ierr);
ierr = PetscLogObjectParent(ts,cvode->w1);CHKERRQ(ierr);
ierr = PetscLogObjectParent(ts,cvode->w2);CHKERRQ(ierr);
/* Call CVodeCreate to create the solver memory and the use of a Newton iteration */
mem = CVodeCreate(cvode->cvode_type, CV_NEWTON);
if (!mem) SETERRQ(PETSC_ERR_MEM,"CVodeCreate() fails");
cvode->mem = mem;
/* Set the pointer to user-defined data */
flag = CVodeSetUserData(mem, ts);
if (flag) SETERRQ(PETSC_ERR_LIB,"CVodeSetUserData() fails");
/* Call CVodeInit to initialize the integrator memory and specify the
* user's right hand side function in u'=f(t,u), the inital time T0, and
* the initial dependent variable vector cvode->y */
flag = CVodeInit(mem,TSFunction_Sundials,ts->ptime,cvode->y);
if (flag){
SETERRQ1(PETSC_ERR_LIB,"CVodeInit() fails, flag %d",flag);
}
flag = CVodeSStolerances(mem,cvode->reltol,cvode->abstol);
if (flag){
SETERRQ1(PETSC_ERR_LIB,"CVodeSStolerances() fails, flag %d",flag);
}
/* initialize the number of steps */
ierr = TSMonitor(ts,ts->steps,ts->ptime,sol);CHKERRQ(ierr);
/* call CVSpgmr to use GMRES as the linear solver. */
/* setup the ode integrator with the given preconditioner */
ierr = PCGetType(cvode->pc,&pctype);CHKERRQ(ierr);
ierr = PetscTypeCompare((PetscObject)cvode->pc,PCNONE,&pcnone);CHKERRQ(ierr);
if (pcnone){
flag = CVSpgmr(mem,PREC_NONE,0);
if (flag) SETERRQ1(PETSC_ERR_LIB,"CVSpgmr() fails, flag %d",flag);
} else {
flag = CVSpgmr(mem,PREC_LEFT,0);
if (flag) SETERRQ1(PETSC_ERR_LIB,"CVSpgmr() fails, flag %d",flag);
/* Set preconditioner and solve routines Precond and PSolve,
and the pointer to the user-defined block data */
flag = CVSpilsSetPreconditioner(mem,TSPrecond_Sundials,TSPSolve_Sundials);
if (flag) SETERRQ1(PETSC_ERR_LIB,"CVSpilsSetPreconditioner() fails, flag %d", flag);
}
flag = CVSpilsSetGSType(mem, MODIFIED_GS);
if (flag) SETERRQ1(PETSC_ERR_LIB,"CVSpgmrSetGSType() fails, flag %d",flag);
PetscFunctionReturn(0);
}
static PetscErrorCode TSSolve_RK(TS ts)
{
TS_RK *rk = (TS_RK*)ts->data;
PetscReal norm=0.0,dt_fac=0.0,fac = 0.0/*,ttmp=0.0*/;
PetscInt i;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecCopy(ts->vec_sol,rk->y1);CHKERRQ(ierr);
/* while loop to get from start to stop */
for (i = 0; i < ts->max_steps; i++) {
ierr = TSPreStep(ts);CHKERRQ(ierr); /* Note that this is called once per STEP, not once per STAGE. */
/* calling rkqs */
/*
-- input
ts - pointer to ts
ts->ptime - current time
ts->time_step - try this timestep
y1 - solution for this step
--output
y1 - suggested solution
y2 - check solution (runge - kutta second permutation)
*/
ierr = TSRKqs(ts,ts->ptime,ts->time_step);CHKERRQ(ierr);
/* counting steps */
ts->steps++;
/* checking for maxerror */
/* comparing difference to maxerror */
ierr = VecNorm(rk->y2,NORM_2,&norm);CHKERRQ(ierr);
/* modifying maxerror to satisfy this timestep */
rk->maxerror = rk->ferror * ts->time_step;
/* ierr = PetscPrintf(PETSC_COMM_WORLD,"norm err: %f maxerror: %f dt: %f",norm,rk->maxerror,ts->time_step);CHKERRQ(ierr); */
/* handling ok and not ok */
if (norm < rk->maxerror){
/* if ok: */
ierr=VecCopy(rk->y1,ts->vec_sol);CHKERRQ(ierr); /* saves the suggested solution to current solution */
ts->ptime += ts->time_step; /* storing the new current time */
rk->nok++;
fac=5.0;
/* trying to save the vector */
ierr = TSPostStep(ts);CHKERRQ(ierr);
ierr = TSMonitor(ts,ts->steps,ts->ptime,ts->vec_sol);CHKERRQ(ierr);
if (ts->ptime >= ts->max_time) break;
} else{
/* if not OK */
rk->nnok++;
fac=1.0;
ierr=VecCopy(ts->vec_sol,rk->y1);CHKERRQ(ierr); /* restores old solution */
}
/*Computing next stepsize. See page 167 in Solving ODE 1
*
* h_new = h * min( facmax , max( facmin , fac * (tol/err)^(1/(p+1)) ) )
* facmax set above
* facmin
*/
dt_fac = exp(log((rk->maxerror) / norm) / ((rk->p) + 1) ) * 0.9 ;
if (dt_fac > fac){
/*ierr = PetscPrintf(PETSC_COMM_WORLD,"changing fac %f\n",fac);*/
dt_fac = fac;
}
/* computing new ts->time_step */
ts->time_step = ts->time_step * dt_fac;
if (ts->ptime+ts->time_step > ts->max_time){
ts->time_step = ts->max_time - ts->ptime;
}
if (ts->time_step < 1e-14){
ierr = PetscPrintf(PETSC_COMM_WORLD,"Very small steps: %f\n",ts->time_step);CHKERRQ(ierr);
ts->time_step = 1e-14;
}
/* trying to purify h */
/* (did not give any visible result) */
/* ttmp = ts->ptime + ts->time_step;
ts->time_step = ttmp - ts->ptime; */
}
ierr=VecCopy(rk->y1,ts->vec_sol);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void PETSC_STDCALL tsmonitor_(TS ts,PetscInt *step,PetscReal *ptime,Vec x, int *__ierr ){
*__ierr = TSMonitor(
(TS)PetscToPointer((ts) ),*step,*ptime,
(Vec)PetscToPointer((x) ));
}
