xref: /petsc/src/ts/tutorials/ex15.c (revision 030f984af8d8bb4c203755d35bded3c05b3d83ce)
1 
2 static char help[] = "Time-dependent PDE in 2d. Modified from ex13.c for illustrating how to solve DAEs. \n";
3 /*
4    u_t = uxx + uyy
5    0 < x < 1, 0 < y < 1;
6    At t=0: u(x,y) = exp(c*r*r*r), if r=PetscSqrtReal((x-.5)*(x-.5) + (y-.5)*(y-.5)) < .125
7            u(x,y) = 0.0           if r >= .125
8 
9    Boundary conditions:
10    Drichlet BC:
11    At x=0, x=1, y=0, y=1: u = 0.0
12 
13    Neumann BC:
14    At x=0, x=1: du(x,y,t)/dx = 0
15    At y=0, y=1: du(x,y,t)/dy = 0
16 
17    mpiexec -n 2 ./ex15 -da_grid_x 40 -da_grid_y 40 -ts_max_steps 2 -snes_monitor -ksp_monitor
18          ./ex15 -da_grid_x 40 -da_grid_y 40  -draw_pause .1 -boundary 1 -ts_monitor_draw_solution
19          ./ex15 -da_grid_x 40 -da_grid_y 40  -draw_pause .1 -boundary 1 -Jtype 2 -nstencilpts 9
20 
21 */
22 
23 #include <petscdm.h>
24 #include <petscdmda.h>
25 #include <petscts.h>
26 
27 /*
28    User-defined data structures and routines
29 */
30 
31 /* AppCtx: used by FormIFunction() and FormIJacobian() */
32 typedef struct {
33   DM        da;
34   PetscInt  nstencilpts;         /* number of stencil points: 5 or 9 */
35   PetscReal c;
36   PetscInt  boundary;            /* Type of boundary condition */
37   PetscBool viewJacobian;
38 } AppCtx;
39 
40 extern PetscErrorCode FormIFunction(TS,PetscReal,Vec,Vec,Vec,void*);
41 extern PetscErrorCode FormIJacobian(TS,PetscReal,Vec,Vec,PetscReal,Mat,Mat,void*);
42 extern PetscErrorCode FormInitialSolution(Vec,void*);
43 
44 int main(int argc,char **argv)
45 {
46   TS             ts;                   /* nonlinear solver */
47   Vec            u,r;                  /* solution, residual vectors */
48   Mat            J,Jmf = NULL;   /* Jacobian matrices */
49   PetscErrorCode ierr;
50   DM             da;
51   PetscReal      dt;
52   AppCtx         user;              /* user-defined work context */
53   SNES           snes;
54   PetscInt       Jtype; /* Jacobian type
55                             0: user provide Jacobian;
56                             1: slow finite difference;
57                             2: fd with coloring; */
58 
59   ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
60   /* Initialize user application context */
61   user.da           = NULL;
62   user.nstencilpts  = 5;
63   user.c            = -30.0;
64   user.boundary     = 0;  /* 0: Drichlet BC; 1: Neumann BC */
65   user.viewJacobian = PETSC_FALSE;
66 
67   ierr = PetscOptionsGetInt(NULL,NULL,"-nstencilpts",&user.nstencilpts,NULL);CHKERRQ(ierr);
68   ierr = PetscOptionsGetInt(NULL,NULL,"-boundary",&user.boundary,NULL);CHKERRQ(ierr);
69   ierr = PetscOptionsHasName(NULL,NULL,"-viewJacobian",&user.viewJacobian);CHKERRQ(ierr);
70 
71   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
72      Create distributed array (DMDA) to manage parallel grid and vectors
73   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
74   if (user.nstencilpts == 5) {
75     ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,11,11,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&da);CHKERRQ(ierr);
76   } else if (user.nstencilpts == 9) {
77     ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_BOX,11,11,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&da);CHKERRQ(ierr);
78   } else SETERRQ1(PETSC_COMM_WORLD,PETSC_ERR_SUP,"nstencilpts %d is not supported",user.nstencilpts);
79   ierr = DMSetFromOptions(da);CHKERRQ(ierr);
80   ierr = DMSetUp(da);CHKERRQ(ierr);
81   user.da = da;
82 
83   /*  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
84      Extract global vectors from DMDA;
85    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
86   ierr = DMCreateGlobalVector(da,&u);CHKERRQ(ierr);
87   ierr = VecDuplicate(u,&r);CHKERRQ(ierr);
88 
89   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
90      Create timestepping solver context
91      - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
92   ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
93   ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
94   ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
95   ierr = TSSetDM(ts,da);CHKERRQ(ierr);
96   ierr = TSSetIFunction(ts,r,FormIFunction,&user);CHKERRQ(ierr);
97   ierr = TSSetMaxTime(ts,1.0);CHKERRQ(ierr);
98   ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
99 
100   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
101      Set initial conditions
102    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
103   ierr = FormInitialSolution(u,&user);CHKERRQ(ierr);
104   ierr = TSSetSolution(ts,u);CHKERRQ(ierr);
105   dt   = .01;
106   ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
107 
108   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
109    Set Jacobian evaluation routine
110   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
111   ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr);
112   ierr  = DMCreateMatrix(da,&J);CHKERRQ(ierr);
113   Jtype = 0;
114   ierr  = PetscOptionsGetInt(NULL,NULL, "-Jtype",&Jtype,NULL);CHKERRQ(ierr);
115   if (Jtype == 0) { /* use user provided Jacobian evaluation routine */
116     if (user.nstencilpts != 5) SETERRQ1(PETSC_COMM_WORLD,PETSC_ERR_SUP,"user Jacobian routine FormIJacobian() does not support nstencilpts=%D",user.nstencilpts);
117     ierr = TSSetIJacobian(ts,J,J,FormIJacobian,&user);CHKERRQ(ierr);
118   } else { /* use finite difference Jacobian J as preconditioner and '-snes_mf_operator' for Mat*vec */
119     ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
120     ierr = MatCreateSNESMF(snes,&Jmf);CHKERRQ(ierr);
121     if (Jtype == 1) { /* slow finite difference J; */
122       ierr = SNESSetJacobian(snes,Jmf,J,SNESComputeJacobianDefault,NULL);CHKERRQ(ierr);
123     } else if (Jtype == 2) { /* Use coloring to compute  finite difference J efficiently */
124       ierr = SNESSetJacobian(snes,Jmf,J,SNESComputeJacobianDefaultColor,0);CHKERRQ(ierr);
125     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Jtype is not supported");
126   }
127 
128   /*  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
129    Sets various TS parameters from user options
130    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
131   ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
132 
133   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
134      Solve nonlinear system
135      - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
136   ierr = TSSolve(ts,u);CHKERRQ(ierr);
137 
138   /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
139      Free work space.
140    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
141   ierr = MatDestroy(&J);CHKERRQ(ierr);
142   ierr = MatDestroy(&Jmf);CHKERRQ(ierr);
143   ierr = VecDestroy(&u);CHKERRQ(ierr);
144   ierr = VecDestroy(&r);CHKERRQ(ierr);
145   ierr = TSDestroy(&ts);CHKERRQ(ierr);
146   ierr = DMDestroy(&da);CHKERRQ(ierr);
147 
148   ierr = PetscFinalize();
149   return ierr;
150 }
151 
152 /* --------------------------------------------------------------------- */
153 /*
154   FormIFunction = Udot - RHSFunction
155 */
156 PetscErrorCode FormIFunction(TS ts,PetscReal t,Vec U,Vec Udot,Vec F,void *ctx)
157 {
158   PetscErrorCode ierr;
159   AppCtx         *user=(AppCtx*)ctx;
160   DM             da   = (DM)user->da;
161   PetscInt       i,j,Mx,My,xs,ys,xm,ym;
162   PetscReal      hx,hy,sx,sy;
163   PetscScalar    u,uxx,uyy,**uarray,**f,**udot;
164   Vec            localU;
165 
166   PetscFunctionBeginUser;
167   ierr = DMGetLocalVector(da,&localU);CHKERRQ(ierr);
168   ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
169 
170   hx = 1.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);
171   hy = 1.0/(PetscReal)(My-1); sy = 1.0/(hy*hy);
172   if (user->nstencilpts == 9 && hx != hy) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"hx must equal hy when nstencilpts = 9 for this example");
173 
174   /*
175      Scatter ghost points to local vector,using the 2-step process
176         DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
177      By placing code between these two statements, computations can be
178      done while messages are in transition.
179   */
180   ierr = DMGlobalToLocalBegin(da,U,INSERT_VALUES,localU);CHKERRQ(ierr);
181   ierr = DMGlobalToLocalEnd(da,U,INSERT_VALUES,localU);CHKERRQ(ierr);
182 
183   /* Get pointers to vector data */
184   ierr = DMDAVecGetArrayRead(da,localU,&uarray);CHKERRQ(ierr);
185   ierr = DMDAVecGetArray(da,F,&f);CHKERRQ(ierr);
186   ierr = DMDAVecGetArray(da,Udot,&udot);CHKERRQ(ierr);
187 
188   /* Get local grid boundaries */
189   ierr = DMDAGetCorners(da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
190 
191   /* Compute function over the locally owned part of the grid */
192   for (j=ys; j<ys+ym; j++) {
193     for (i=xs; i<xs+xm; i++) {
194       /* Boundary conditions */
195       if (i == 0 || j == 0 || i == Mx-1 || j == My-1) {
196         if (user->boundary == 0) { /* Drichlet BC */
197           f[j][i] = uarray[j][i]; /* F = U */
198         } else {                  /* Neumann BC */
199           if (i == 0 && j == 0) {              /* SW corner */
200             f[j][i] = uarray[j][i] - uarray[j+1][i+1];
201           } else if (i == Mx-1 && j == 0) {    /* SE corner */
202             f[j][i] = uarray[j][i] - uarray[j+1][i-1];
203           } else if (i == 0 && j == My-1) {    /* NW corner */
204             f[j][i] = uarray[j][i] - uarray[j-1][i+1];
205           } else if (i == Mx-1 && j == My-1) { /* NE corner */
206             f[j][i] = uarray[j][i] - uarray[j-1][i-1];
207           } else if (i == 0) {                  /* Left */
208             f[j][i] = uarray[j][i] - uarray[j][i+1];
209           } else if (i == Mx-1) {               /* Right */
210             f[j][i] = uarray[j][i] - uarray[j][i-1];
211           } else if (j == 0) {                 /* Bottom */
212             f[j][i] = uarray[j][i] - uarray[j+1][i];
213           } else if (j == My-1) {               /* Top */
214             f[j][i] = uarray[j][i] - uarray[j-1][i];
215           }
216         }
217       } else { /* Interior */
218         u = uarray[j][i];
219         /* 5-point stencil */
220         uxx = (-2.0*u + uarray[j][i-1] + uarray[j][i+1]);
221         uyy = (-2.0*u + uarray[j-1][i] + uarray[j+1][i]);
222         if (user->nstencilpts == 9) {
223           /* 9-point stencil: assume hx=hy */
224           uxx = 2.0*uxx/3.0 + (0.5*(uarray[j-1][i-1]+uarray[j-1][i+1]+uarray[j+1][i-1]+uarray[j+1][i+1]) - 2.0*u)/6.0;
225           uyy = 2.0*uyy/3.0 + (0.5*(uarray[j-1][i-1]+uarray[j-1][i+1]+uarray[j+1][i-1]+uarray[j+1][i+1]) - 2.0*u)/6.0;
226         }
227         f[j][i] = udot[j][i] - (uxx*sx + uyy*sy);
228       }
229     }
230   }
231 
232   /* Restore vectors */
233   ierr = DMDAVecRestoreArrayRead(da,localU,&uarray);CHKERRQ(ierr);
234   ierr = DMDAVecRestoreArray(da,F,&f);CHKERRQ(ierr);
235   ierr = DMDAVecRestoreArray(da,Udot,&udot);CHKERRQ(ierr);
236   ierr = DMRestoreLocalVector(da,&localU);CHKERRQ(ierr);
237   ierr = PetscLogFlops(11.0*ym*xm);CHKERRQ(ierr);
238   PetscFunctionReturn(0);
239 }
240 
241 /* --------------------------------------------------------------------- */
242 /*
243   FormIJacobian() - Compute IJacobian = dF/dU + a dF/dUdot
244   This routine is not used with option '-use_coloring'
245 */
246 PetscErrorCode FormIJacobian(TS ts,PetscReal t,Vec U,Vec Udot,PetscReal a,Mat J,Mat Jpre,void *ctx)
247 {
248   PetscErrorCode ierr;
249   PetscInt       i,j,Mx,My,xs,ys,xm,ym,nc;
250   AppCtx         *user = (AppCtx*)ctx;
251   DM             da    = (DM)user->da;
252   MatStencil     col[5],row;
253   PetscScalar    vals[5],hx,hy,sx,sy;
254 
255   PetscFunctionBeginUser;
256   ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
257   ierr = DMDAGetCorners(da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
258 
259   hx = 1.0/(PetscReal)(Mx-1); sx = 1.0/(hx*hx);
260   hy = 1.0/(PetscReal)(My-1); sy = 1.0/(hy*hy);
261 
262   for (j=ys; j<ys+ym; j++) {
263     for (i=xs; i<xs+xm; i++) {
264       nc    = 0;
265       row.j = j; row.i = i;
266       if (user->boundary == 0 && (i == 0 || i == Mx-1 || j == 0 || j == My-1)) {
267         col[nc].j = j; col[nc].i = i; vals[nc++] = 1.0;
268 
269       } else if (user->boundary > 0 && i == 0) {  /* Left Neumann */
270         col[nc].j = j; col[nc].i = i;   vals[nc++] = 1.0;
271         col[nc].j = j; col[nc].i = i+1; vals[nc++] = -1.0;
272       } else if (user->boundary > 0 && i == Mx-1) { /* Right Neumann */
273         col[nc].j = j; col[nc].i = i;   vals[nc++] = 1.0;
274         col[nc].j = j; col[nc].i = i-1; vals[nc++] = -1.0;
275       } else if (user->boundary > 0 && j == 0) {  /* Bottom Neumann */
276         col[nc].j = j;   col[nc].i = i; vals[nc++] = 1.0;
277         col[nc].j = j+1; col[nc].i = i; vals[nc++] = -1.0;
278       } else if (user->boundary > 0 && j == My-1) { /* Top Neumann */
279         col[nc].j = j;   col[nc].i = i;  vals[nc++] = 1.0;
280         col[nc].j = j-1; col[nc].i = i;  vals[nc++] = -1.0;
281       } else {   /* Interior */
282         col[nc].j = j-1; col[nc].i = i;   vals[nc++] = -sy;
283         col[nc].j = j;   col[nc].i = i-1; vals[nc++] = -sx;
284         col[nc].j = j;   col[nc].i = i;   vals[nc++] = 2.0*(sx + sy) + a;
285         col[nc].j = j;   col[nc].i = i+1; vals[nc++] = -sx;
286         col[nc].j = j+1; col[nc].i = i;   vals[nc++] = -sy;
287       }
288       ierr = MatSetValuesStencil(Jpre,1,&row,nc,col,vals,INSERT_VALUES);CHKERRQ(ierr);
289     }
290   }
291   ierr = MatAssemblyBegin(Jpre,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
292   ierr = MatAssemblyEnd(Jpre,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
293   if (J != Jpre) {
294     ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
295     ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
296   }
297 
298   if (user->viewJacobian) {
299     ierr = PetscPrintf(PetscObjectComm((PetscObject)Jpre),"Jpre:\n");CHKERRQ(ierr);
300     ierr = MatView(Jpre,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
301   }
302   PetscFunctionReturn(0);
303 }
304 
305 /* ------------------------------------------------------------------- */
306 PetscErrorCode FormInitialSolution(Vec U,void *ptr)
307 {
308   AppCtx         *user=(AppCtx*)ptr;
309   DM             da   =user->da;
310   PetscReal      c    =user->c;
311   PetscErrorCode ierr;
312   PetscInt       i,j,xs,ys,xm,ym,Mx,My;
313   PetscScalar    **u;
314   PetscReal      hx,hy,x,y,r;
315 
316   PetscFunctionBeginUser;
317   ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
318 
319   hx = 1.0/(PetscReal)(Mx-1);
320   hy = 1.0/(PetscReal)(My-1);
321 
322   /* Get pointers to vector data */
323   ierr = DMDAVecGetArray(da,U,&u);CHKERRQ(ierr);
324 
325   /* Get local grid boundaries */
326   ierr = DMDAGetCorners(da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
327 
328   /* Compute function over the locally owned part of the grid */
329   for (j=ys; j<ys+ym; j++) {
330     y = j*hy;
331     for (i=xs; i<xs+xm; i++) {
332       x = i*hx;
333       r = PetscSqrtReal((x-.5)*(x-.5) + (y-.5)*(y-.5));
334       if (r < .125) u[j][i] = PetscExpReal(c*r*r*r);
335       else u[j][i] = 0.0;
336     }
337   }
338 
339   /* Restore vectors */
340   ierr = DMDAVecRestoreArray(da,U,&u);CHKERRQ(ierr);
341   PetscFunctionReturn(0);
342 }
343 
344 /*TEST
345 
346     test:
347       args: -da_grid_x 20 -da_grid_y 20 -boundary 0 -ts_max_steps 10 -ts_monitor
348 
349     test:
350       suffix: 2
351       args: -da_grid_x 20 -da_grid_y 20 -boundary 0 -ts_max_steps 10 -Jtype 2 -ts_monitor
352 
353     test:
354       suffix: 3
355       requires: !single
356       args: -da_grid_x 20 -da_grid_y 20 -boundary 1 -ts_max_steps 10 -ts_monitor
357 
358     test:
359       suffix: 4
360       requires: !single
361       nsize: 2
362       args: -da_grid_x 20 -da_grid_y 20 -boundary 1 -ts_max_steps 10 -ts_monitor
363 
364     test:
365       suffix: 5
366       nsize: 1
367       args: -da_grid_x 20 -da_grid_y 20 -boundary 0 -ts_max_steps 10 -Jtype 1 -ts_monitor
368 
369 TEST*/
370