Actual source code: beuler.c

  1: #define PETSCTS_DLL

  3: /*
  4:        Code for Timestepping with implicit backwards Euler.
  5: */
 6:  #include src/ts/tsimpl.h

  8: typedef struct {
  9:   Vec  update;      /* work vector where new solution is formed */
 10:   Vec  func;        /* work vector where F(t[i],u[i]) is stored */
 11:   Vec  rhs;         /* work vector for RHS; vec_sol/dt */
 12: } TS_BEuler;

 14: /*------------------------------------------------------------------------------*/

 16: /*
 17:     Version for linear PDE where RHS does not depend on time. Has built a
 18:   single matrix that is to be used for all timesteps.
 19: */
 22: static PetscErrorCode TSStep_BEuler_Linear_Constant_Matrix(TS ts,PetscInt *steps,PetscReal *ptime)
 23: {
 24:   TS_BEuler      *beuler = (TS_BEuler*)ts->data;
 25:   Vec            sol = ts->vec_sol,update = beuler->update;
 26:   Vec            rhs = beuler->rhs;
 28:   PetscInt       i,max_steps = ts->max_steps,its;
 29:   PetscScalar    mdt = 1.0/ts->time_step;
 30:   KSP            ksp;

 33:   TSGetKSP(ts,&ksp);
 34:   *steps = -ts->steps;
 35:   TSMonitor(ts,ts->steps,ts->ptime,sol);

 37:   /* set initial guess to be previous solution */
 38:   VecCopy(sol,update);

 40:   for (i=0; i<max_steps; i++) {
 41:     /* set rhs = 1/dt*Alhs*sol */
 42:     if (ts->Alhs){
 43:       MatMult(ts->Alhs,sol,rhs);
 44:     } else {
 45:       VecCopy(sol,rhs);
 46:     }
 47:     VecScale(rhs,mdt);

 49:     ts->ptime += ts->time_step;
 50:     if (ts->ptime > ts->max_time) break;

 52:     /* solve (1/dt*Alhs - A)*update = rhs */
 53:     KSPSolve(ts->ksp,rhs,update);
 54:     KSPGetIterationNumber(ksp,&its);
 55:     ts->linear_its += its;
 56:     VecCopy(update,sol);
 57:     ts->steps++;
 58:     TSMonitor(ts,ts->steps,ts->ptime,sol);
 59:   }

 61:   *steps += ts->steps;
 62:   *ptime  = ts->ptime;
 63:   return(0);
 64: }

 66: /*
 67:       Version where matrix depends on time 
 68: */
 71: static PetscErrorCode TSStep_BEuler_Linear_Variable_Matrix(TS ts,PetscInt *steps,PetscReal *ptime)
 72: {
 73:   TS_BEuler      *beuler = (TS_BEuler*)ts->data;
 74:   Vec            sol = ts->vec_sol,update = beuler->update,rhs = beuler->rhs;
 76:   PetscInt       i,max_steps = ts->max_steps,its;
 77:   PetscReal      mdt = 1.0/ts->time_step,t_mid;
 78:   MatStructure   str;
 79:   KSP            ksp;

 82:   TSGetKSP(ts,&ksp);
 83:   *steps = -ts->steps;
 84:   TSMonitor(ts,ts->steps,ts->ptime,sol);

 86:   /* set initial guess to be previous solution */
 87:   VecCopy(sol,update);

 89:   for (i=0; i<max_steps; i++) {
 90:     /* set rhs = 1/dt*Alhs(t_mid)*sol */
 91:     if (ts->Alhs){
 92:       t_mid = ts->ptime+ts->time_step/2.0;
 93:       (*ts->ops->lhsmatrix)(ts,t_mid,&ts->Alhs,&ts->Blhs,&str,ts->jacPlhs);
 94:       MatMult(ts->Alhs,sol,rhs);
 95:     } else {
 96:       VecCopy(sol,rhs);
 97:     }
 98:     VecScale(rhs,mdt);

100:     ts->ptime += ts->time_step;
101:     if (ts->ptime > ts->max_time) break;
102:     /*
103:         evaluate rhs matrix function at current ptime. 
104:     */
105:     (*ts->ops->rhsmatrix)(ts,ts->ptime,&ts->A,&ts->B,&str,ts->jacP);
106:     TSScaleShiftMatrices(ts,ts->A,ts->B,str);
107:     KSPSetOperators(ts->ksp,ts->A,ts->B,str);

109:     /* solve (1/dt*Alhs(t_mid) - A(t_n+1))*update = rhs */
110:     KSPSolve(ts->ksp,rhs,update);
111:     KSPGetIterationNumber(ksp,&its);
112:     ts->linear_its += its;
113:     VecCopy(update,sol);
114:     ts->steps++;
115:     TSMonitor(ts,ts->steps,ts->ptime,sol);
116:   }

118:   *steps += ts->steps;
119:   *ptime  = ts->ptime;
120:   return(0);
121: }
122: /*
123:     Version for nonlinear PDE.
124: */
127: static PetscErrorCode TSStep_BEuler_Nonlinear(TS ts,PetscInt *steps,PetscReal *ptime)
128: {
129:   Vec            sol = ts->vec_sol;
131:   PetscInt       i,max_steps = ts->max_steps,its,lits;
132:   TS_BEuler      *beuler = (TS_BEuler*)ts->data;
133: 
135:   *steps = -ts->steps;
136:   TSMonitor(ts,ts->steps,ts->ptime,sol);

138:   for (i=0; i<max_steps; i++) {
139:     ts->ptime += ts->time_step;
140:     if (ts->ptime > ts->max_time) break;
141:     VecCopy(sol,beuler->update);
142:     SNESSolve(ts->snes,PETSC_NULL,beuler->update);
143:     SNESGetNumberLinearIterations(ts->snes,&lits);
144:     SNESGetIterationNumber(ts->snes,&its);
145:     ts->nonlinear_its += its; ts->linear_its += lits;
146:     VecCopy(beuler->update,sol);
147:     ts->steps++;
148:     TSMonitor(ts,ts->steps,ts->ptime,sol);
149:   }

151:   *steps += ts->steps;
152:   *ptime  = ts->ptime;
153:   return(0);
154: }

156: /*------------------------------------------------------------*/
159: static PetscErrorCode TSDestroy_BEuler(TS ts)
160: {
161:   TS_BEuler      *beuler = (TS_BEuler*)ts->data;

165:   if (beuler->update) {VecDestroy(beuler->update);}
166:   if (beuler->func) {VecDestroy(beuler->func);}
167:   if (beuler->rhs) {VecDestroy(beuler->rhs);}
168:   PetscFree(beuler);
169:   return(0);
170: }



174: /* 
175:     This defines the nonlinear equation that is to be solved with SNES

177:               U^{n+1} - dt*F(U^{n+1}) - U^{n}
178: */
181: PetscErrorCode TSBEulerFunction(SNES snes,Vec x,Vec y,void *ctx)
182: {
183:   TS             ts = (TS) ctx;
184:   PetscScalar    mdt = 1.0/ts->time_step,*unp1,*un,*Funp1;
186:   PetscInt       i,n;

189:   /* apply user-provided function */
190:   TSComputeRHSFunction(ts,ts->ptime,x,y);
191:   /* (u^{n+1} - U^{n})/dt - F(u^{n+1}) */
192:   VecGetArray(ts->vec_sol,&un);
193:   VecGetArray(x,&unp1);
194:   VecGetArray(y,&Funp1);
195:   VecGetLocalSize(x,&n);

197:   for (i=0; i<n; i++) {
198:     Funp1[i] = mdt*(unp1[i] - un[i]) - Funp1[i];
199:   }
200:   VecRestoreArray(ts->vec_sol,&un);
201:   VecRestoreArray(x,&unp1);
202:   VecRestoreArray(y,&Funp1);
203:   return(0);
204: }

206: /*
207:    This constructs the Jacobian needed for SNES 

209:              J = I/dt - J_{F}   where J_{F} is the given Jacobian of F.
210: */
213: PetscErrorCode TSBEulerJacobian(SNES snes,Vec x,Mat *AA,Mat *BB,MatStructure *str,void *ctx)
214: {
215:   TS             ts = (TS) ctx;

219:   /* construct user's Jacobian */
220:   TSComputeRHSJacobian(ts,ts->ptime,x,AA,BB,str);

222:   /* shift and scale Jacobian */
223:   /* this test is a undesirable hack, we assume that if it is MATMFFD then it is
224:      obtained from -snes_mf_operator and there is computed directly from the 
225:      FormFunction() SNES is given and therefor does not need to be shifted/scaled
226:      BUT maybe it could be MATMFFD and does require shift in some other case? */
227:   TSScaleShiftMatrices(ts,*AA,*BB,*str);
228:   return(0);
229: }

231: /* ------------------------------------------------------------*/
234: static PetscErrorCode TSSetUp_BEuler_Linear_Constant_Matrix(TS ts)
235: {
236:   TS_BEuler      *beuler = (TS_BEuler*)ts->data;

240:   KSPSetFromOptions(ts->ksp);
241:   VecDuplicate(ts->vec_sol,&beuler->update);
242:   VecDuplicate(ts->vec_sol,&beuler->rhs);
243: 
244:   /* build linear system to be solved */
245:   /* ts->A = 1/dt*Alhs - A, ts->B = 1/dt*Blhs - B */
246:   TSScaleShiftMatrices(ts,ts->A,ts->B,SAME_NONZERO_PATTERN);
247:   KSPSetOperators(ts->ksp,ts->A,ts->B,SAME_NONZERO_PATTERN);
248:   return(0);
249: }

253: static PetscErrorCode TSSetUp_BEuler_Linear_Variable_Matrix(TS ts)
254: {
255:   TS_BEuler      *beuler = (TS_BEuler*)ts->data;

259:   KSPSetFromOptions(ts->ksp);
260:   VecDuplicate(ts->vec_sol,&beuler->update);
261:   VecDuplicate(ts->vec_sol,&beuler->rhs);
262:   return(0);
263: }

267: static PetscErrorCode TSSetUp_BEuler_Nonlinear(TS ts)
268: {
269:   TS_BEuler      *beuler = (TS_BEuler*)ts->data;

273:   VecDuplicate(ts->vec_sol,&beuler->update);
274:   VecDuplicate(ts->vec_sol,&beuler->func);
275:   SNESSetFunction(ts->snes,beuler->func,TSBEulerFunction,ts);
276:   SNESSetJacobian(ts->snes,ts->A,ts->B,TSBEulerJacobian,ts);
277:   return(0);
278: }
279: /*------------------------------------------------------------*/

283: static PetscErrorCode TSSetFromOptions_BEuler_Linear(TS ts)
284: {
286:   return(0);
287: }

291: static PetscErrorCode TSSetFromOptions_BEuler_Nonlinear(TS ts)
292: {
294:   return(0);
295: }

299: static PetscErrorCode TSView_BEuler(TS ts,PetscViewer viewer)
300: {
302:   return(0);
303: }

305: /* ------------------------------------------------------------ */
306: /*MC
307:       TS_BEULER - ODE solver using the implicit backward Euler method

309:   Level: beginner

311: .seealso:  TSCreate(), TS, TSSetType(), TS_EULER

313: M*/
317: PetscErrorCode  TSCreate_BEuler(TS ts)
318: {
319:   TS_BEuler      *beuler;

323:   ts->ops->destroy = TSDestroy_BEuler;
324:   ts->ops->view    = TSView_BEuler;

326:   if (ts->problem_type == TS_LINEAR) {
327:     if (!ts->A) {
328:       SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Must set rhs matrix for linear problem");
329:     }
330:     if (!ts->ops->rhsmatrix) {
331:       ts->ops->setup  = TSSetUp_BEuler_Linear_Constant_Matrix;
332:       ts->ops->step   = TSStep_BEuler_Linear_Constant_Matrix;
333:     } else {
334:       ts->ops->setup  = TSSetUp_BEuler_Linear_Variable_Matrix;
335:       ts->ops->step   = TSStep_BEuler_Linear_Variable_Matrix;
336:     }
337:     ts->ops->setfromoptions  = TSSetFromOptions_BEuler_Linear;
338:     KSPCreate(ts->comm,&ts->ksp);
339:     KSPSetInitialGuessNonzero(ts->ksp,PETSC_TRUE);
340:   } else if (ts->problem_type == TS_NONLINEAR) {
341:     ts->ops->setup           = TSSetUp_BEuler_Nonlinear;
342:     ts->ops->step            = TSStep_BEuler_Nonlinear;
343:     ts->ops->setfromoptions  = TSSetFromOptions_BEuler_Nonlinear;
344:     SNESCreate(ts->comm,&ts->snes);
345:   } else SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"No such problem");

347:   PetscNew(TS_BEuler,&beuler);
348:   PetscLogObjectMemory(ts,sizeof(TS_BEuler));
349:   ts->data = (void*)beuler;

351:   return(0);
352: }