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);
}
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 tspoststep_(TS ts, int *__ierr ){
*__ierr = TSPostStep(
(TS)PetscToPointer((ts) ));
}
