xref: /petsc/src/ts/tutorials/ex45.c (revision fffbe07892e3829f28d4ec4d935109d0474c54e5)
1 static char help[] = "Heat Equation in 2d and 3d with finite elements.\n\
2 We solve the heat equation in a rectangular\n\
3 domain, using a parallel unstructured mesh (DMPLEX) to discretize it.\n\
4 Contributed by: Julian Andrej <juan@tf.uni-kiel.de>\n\n\n";
5 
6 #include <petscdmplex.h>
7 #include <petscds.h>
8 #include <petscts.h>
9 
10 /*
11   Heat equation:
12 
13     du/dt - \Delta u + f = 0
14 */
15 
16 typedef enum {SOL_QUADRATIC_LINEAR, SOL_QUADRATIC_TRIG, SOL_TRIG_LINEAR, SOL_TRIG_TRIG, NUM_SOLUTION_TYPES} SolutionType;
17 const char *solutionTypes[NUM_SOLUTION_TYPES+1] = {"quadratic_linear", "quadratic_trig", "trig_linear", "trig_trig", "unknown"};
18 
19 typedef struct {
20   SolutionType solType; /* Type of exact solution */
21   /* Solver setup */
22   PetscBool expTS;      /* Flag for explicit timestepping */
23   PetscBool lumped;     /* Lump the mass matrix */
24 } AppCtx;
25 
26 /*
27 Exact 2D solution:
28   u    = 2t + x^2 + y^2
29   u_t  = 2
30   \Delta u = 2 + 2 = 4
31   f    = 2
32   F(u) = 2 - (2 + 2) + 2 = 0
33 
34 Exact 3D solution:
35   u = 3t + x^2 + y^2 + z^2
36   F(u) = 3 - (2 + 2 + 2) + 3 = 0
37 */
38 static PetscErrorCode mms_quad_lin(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
39 {
40   PetscInt d;
41 
42   *u = dim*time;
43   for (d = 0; d < dim; ++d) *u += x[d]*x[d];
44   return 0;
45 }
46 
47 static PetscErrorCode mms_quad_lin_t(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
48 {
49   *u = dim;
50   return 0;
51 }
52 
53 static void f0_quad_lin_exp(PetscInt dim, PetscInt Nf, PetscInt NfAux,
54                             const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
55                             const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
56                             PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f0[])
57 {
58   f0[0] = -(PetscScalar) dim;
59 }
60 static void f0_quad_lin(PetscInt dim, PetscInt Nf, PetscInt NfAux,
61                         const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
62                         const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
63                         PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f0[])
64 {
65   PetscScalar exp[1] = {0.};
66   f0_quad_lin_exp(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, a_t, a_x, t, x, numConstants, constants, exp);
67   f0[0] = u_t[0] - exp[0];
68 }
69 
70 /*
71 Exact 2D solution:
72   u = 2*cos(t) + x^2 + y^2
73   F(u) = -2*sint(t) - (2 + 2) + 2*sin(t) + 4 = 0
74 
75 Exact 3D solution:
76   u = 3*cos(t) + x^2 + y^2 + z^2
77   F(u) = -3*sin(t) - (2 + 2 + 2) + 3*sin(t) + 6 = 0
78 */
79 static PetscErrorCode mms_quad_trig(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
80 {
81   PetscInt d;
82 
83   *u = dim*PetscCosReal(time);
84   for (d = 0; d < dim; ++d) *u += x[d]*x[d];
85   return 0;
86 }
87 
88 static PetscErrorCode mms_quad_trig_t(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
89 {
90   *u = -dim*PetscSinReal(time);
91   return 0;
92 }
93 
94 static void f0_quad_trig_exp(PetscInt dim, PetscInt Nf, PetscInt NfAux,
95                              const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
96                              const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
97                              PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f0[])
98 {
99   f0[0] = -dim*(PetscSinReal(t) + 2.0);
100 }
101 static void f0_quad_trig(PetscInt dim, PetscInt Nf, PetscInt NfAux,
102                          const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
103                          const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
104                          PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f0[])
105 {
106   PetscScalar exp[1] = {0.};
107   f0_quad_trig_exp(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, a_t, a_x, t, x, numConstants, constants, exp);
108   f0[0] = u_t[0] - exp[0];
109 }
110 
111 /*
112 Exact 2D solution:
113   u = 2\pi^2 t + cos(\pi x) + cos(\pi y)
114   F(u) = 2\pi^2 - \pi^2 (cos(\pi x) + cos(\pi y)) + \pi^2 (cos(\pi x) + cos(\pi y)) - 2\pi^2 = 0
115 
116 Exact 3D solution:
117   u = 3\pi^2 t + cos(\pi x) + cos(\pi y) + cos(\pi z)
118   F(u) = 3\pi^2 - \pi^2 (cos(\pi x) + cos(\pi y) + cos(\pi z)) + \pi^2 (cos(\pi x) + cos(\pi y) + cos(\pi z)) - 3\pi^2 = 0
119 */
120 static PetscErrorCode mms_trig_lin(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
121 {
122   PetscInt d;
123 
124   *u = dim*PetscSqr(PETSC_PI)*time;
125   for (d = 0; d < dim; ++d) *u += PetscCosReal(PETSC_PI*x[d]);
126   return 0;
127 }
128 
129 static PetscErrorCode mms_trig_lin_t(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
130 {
131   *u = dim*PetscSqr(PETSC_PI);
132   return 0;
133 }
134 
135 static void f0_trig_lin(PetscInt dim, PetscInt Nf, PetscInt NfAux,
136                         const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
137                         const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
138                         PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f0[])
139 {
140   PetscInt d;
141   f0[0] = u_t[0];
142   for (d = 0; d < dim; ++d) f0[0] += PetscSqr(PETSC_PI)*(PetscCosReal(PETSC_PI*x[d]) - 1.0);
143 }
144 
145 /*
146 Exact 2D solution:
147   u    = pi^2 cos(t) + cos(\pi x) + cos(\pi y)
148   u_t  = -pi^2 sin(t)
149   \Delta u = -\pi^2 (cos(\pi x) + cos(\pi y))
150   f    = pi^2 sin(t) - \pi^2 (cos(\pi x) + cos(\pi y))
151   F(u) = -\pi^2 sin(t) + \pi^2 (cos(\pi x) + cos(\pi y)) - \pi^2 (cos(\pi x) + cos(\pi y)) + \pi^2 sin(t) = 0
152 
153 Exact 3D solution:
154   u    = pi^2 cos(t) + cos(\pi x) + cos(\pi y) + cos(\pi z)
155   u_t  = -pi^2 sin(t)
156   \Delta u = -\pi^2 (cos(\pi x) + cos(\pi y) + cos(\pi z))
157   f    = pi^2 sin(t) - \pi^2 (cos(\pi x) + cos(\pi y) + cos(\pi z))
158   F(u) = -\pi^2 sin(t) + \pi^2 (cos(\pi x) + cos(\pi y) + cos(\pi z)) - \pi^2 (cos(\pi x) + cos(\pi y) + cos(\pi z)) + \pi^2 sin(t) = 0
159 */
160 static PetscErrorCode mms_trig_trig(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
161 {
162   PetscInt d;
163 
164   *u = PetscSqr(PETSC_PI)*PetscCosReal(time);
165   for (d = 0; d < dim; ++d) *u += PetscCosReal(PETSC_PI*x[d]);
166   return 0;
167 }
168 
169 static PetscErrorCode mms_trig_trig_t(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
170 {
171   *u = -PetscSqr(PETSC_PI)*PetscSinReal(time);
172   return 0;
173 }
174 
175 static void f0_trig_trig_exp(PetscInt dim, PetscInt Nf, PetscInt NfAux,
176                              const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
177                              const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
178                              PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f0[])
179 {
180   PetscInt d;
181   f0[0] -= PetscSqr(PETSC_PI)*PetscSinReal(t);
182   for (d = 0; d < dim; ++d) f0[0] += PetscSqr(PETSC_PI)*PetscCosReal(PETSC_PI*x[d]);
183 }
184 static void f0_trig_trig(PetscInt dim, PetscInt Nf, PetscInt NfAux,
185                          const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
186                          const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
187                          PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f0[])
188 {
189   PetscScalar exp[1] = {0.};
190   f0_trig_trig_exp(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, a_t, a_x, t, x, numConstants, constants, exp);
191   f0[0] = u_t[0] - exp[0];
192 }
193 
194 static void f1_temp_exp(PetscInt dim, PetscInt Nf, PetscInt NfAux,
195                         const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
196                         const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
197                         PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f1[])
198 {
199   PetscInt d;
200   for (d = 0; d < dim; ++d) f1[d] = -u_x[d];
201 }
202 static void f1_temp(PetscInt dim, PetscInt Nf, PetscInt NfAux,
203                     const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
204                     const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
205                     PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f1[])
206 {
207   PetscInt d;
208   for (d = 0; d < dim; ++d) f1[d] = u_x[d];
209 }
210 
211 static void g3_temp(PetscInt dim, PetscInt Nf, PetscInt NfAux,
212                     const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
213                     const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
214                     PetscReal t, PetscReal u_tShift, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar g3[])
215 {
216   PetscInt d;
217   for (d = 0; d < dim; ++d) g3[d*dim+d] = 1.0;
218 }
219 
220 static void g0_temp(PetscInt dim, PetscInt Nf, PetscInt NfAux,
221                     const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
222                     const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
223                     PetscReal t, PetscReal u_tShift, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar g0[])
224 {
225   g0[0] = u_tShift*1.0;
226 }
227 
228 static PetscErrorCode ProcessOptions(MPI_Comm comm, AppCtx *options)
229 {
230   PetscInt       sol;
231   PetscErrorCode ierr;
232 
233   PetscFunctionBeginUser;
234   options->solType  = SOL_QUADRATIC_LINEAR;
235   options->expTS    = PETSC_FALSE;
236   options->lumped   = PETSC_TRUE;
237 
238   ierr = PetscOptionsBegin(comm, "", "Heat Equation Options", "DMPLEX");CHKERRQ(ierr);
239   ierr = PetscOptionsEList("-sol_type", "Type of exact solution", "ex45.c", solutionTypes, NUM_SOLUTION_TYPES, solutionTypes[options->solType], &sol, NULL);CHKERRQ(ierr);
240   options->solType = (SolutionType) sol;
241   ierr = PetscOptionsBool("-explicit", "Use explicit timestepping", "ex45.c", options->expTS, &options->expTS, NULL);CHKERRQ(ierr);
242   ierr = PetscOptionsBool("-lumped", "Lump the mass matrix", "ex45.c", options->lumped, &options->lumped, NULL);CHKERRQ(ierr);
243   ierr = PetscOptionsEnd();CHKERRQ(ierr);
244   PetscFunctionReturn(0);
245 }
246 
247 static PetscErrorCode CreateMesh(MPI_Comm comm, DM *dm, AppCtx *ctx)
248 {
249   PetscErrorCode ierr;
250 
251   PetscFunctionBeginUser;
252   ierr = DMCreate(comm, dm);CHKERRQ(ierr);
253   ierr = DMSetType(*dm, DMPLEX);CHKERRQ(ierr);
254   ierr = DMSetFromOptions(*dm);CHKERRQ(ierr);
255   ierr = DMViewFromOptions(*dm, NULL, "-dm_view");CHKERRQ(ierr);
256   PetscFunctionReturn(0);
257 }
258 
259 static PetscErrorCode SetupProblem(DM dm, AppCtx *ctx)
260 {
261   PetscDS        ds;
262   DMLabel        label;
263   const PetscInt id = 1;
264   PetscErrorCode ierr;
265 
266   PetscFunctionBeginUser;
267   ierr = DMGetLabel(dm, "marker", &label);CHKERRQ(ierr);
268   ierr = DMGetDS(dm, &ds);CHKERRQ(ierr);
269   ierr = PetscDSSetJacobian(ds, 0, 0, g0_temp, NULL, NULL, g3_temp);CHKERRQ(ierr);
270   switch (ctx->solType) {
271     case SOL_QUADRATIC_LINEAR:
272       ierr = PetscDSSetResidual(ds, 0, f0_quad_lin,  f1_temp);CHKERRQ(ierr);
273       ierr = PetscDSSetRHSResidual(ds, 0, f0_quad_lin_exp, f1_temp_exp);CHKERRQ(ierr);
274       ierr = PetscDSSetExactSolution(ds, 0, mms_quad_lin, ctx);CHKERRQ(ierr);
275       ierr = PetscDSSetExactSolutionTimeDerivative(ds, 0, mms_quad_lin_t, ctx);CHKERRQ(ierr);
276       ierr = DMAddBoundary(dm, DM_BC_ESSENTIAL, "wall", label, 1, &id, 0, 0, NULL, (void (*)(void)) mms_quad_lin, (void (*)(void)) mms_quad_lin_t, ctx, NULL);CHKERRQ(ierr);
277       break;
278     case SOL_QUADRATIC_TRIG:
279       ierr = PetscDSSetResidual(ds, 0, f0_quad_trig, f1_temp);CHKERRQ(ierr);
280       ierr = PetscDSSetRHSResidual(ds, 0, f0_quad_trig_exp, f1_temp_exp);CHKERRQ(ierr);
281       ierr = PetscDSSetExactSolution(ds, 0, mms_quad_trig, ctx);CHKERRQ(ierr);
282       ierr = PetscDSSetExactSolutionTimeDerivative(ds, 0, mms_quad_trig_t, ctx);CHKERRQ(ierr);
283       ierr = DMAddBoundary(dm, DM_BC_ESSENTIAL, "wall", label, 1, &id, 0, 0, NULL, (void (*)(void)) mms_quad_trig, (void (*)(void)) mms_quad_trig_t, ctx, NULL);CHKERRQ(ierr);
284       break;
285     case SOL_TRIG_LINEAR:
286       ierr = PetscDSSetResidual(ds, 0, f0_trig_lin,  f1_temp);CHKERRQ(ierr);
287       ierr = PetscDSSetExactSolution(ds, 0, mms_trig_lin, ctx);CHKERRQ(ierr);
288       ierr = PetscDSSetExactSolutionTimeDerivative(ds, 0, mms_trig_lin_t, ctx);CHKERRQ(ierr);
289       ierr = DMAddBoundary(dm, DM_BC_ESSENTIAL, "wall", label, 1, &id, 0, 0, NULL, (void (*)(void)) mms_trig_lin, (void (*)(void)) mms_trig_lin_t, ctx, NULL);CHKERRQ(ierr);
290       break;
291     case SOL_TRIG_TRIG:
292       ierr = PetscDSSetResidual(ds, 0, f0_trig_trig, f1_temp);CHKERRQ(ierr);
293       ierr = PetscDSSetRHSResidual(ds, 0, f0_trig_trig_exp, f1_temp_exp);CHKERRQ(ierr);
294       ierr = PetscDSSetExactSolution(ds, 0, mms_trig_trig, ctx);CHKERRQ(ierr);
295       ierr = PetscDSSetExactSolutionTimeDerivative(ds, 0, mms_trig_trig_t, ctx);CHKERRQ(ierr);
296       break;
297     default: SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Invalid solution type: %s (%D)", solutionTypes[PetscMin(ctx->solType, NUM_SOLUTION_TYPES)], ctx->solType);
298   }
299   PetscFunctionReturn(0);
300 }
301 
302 static PetscErrorCode SetupDiscretization(DM dm, AppCtx* ctx)
303 {
304   DM             cdm = dm;
305   PetscFE        fe;
306   DMPolytopeType ct;
307   PetscBool      simplex;
308   PetscInt       dim, cStart;
309   PetscErrorCode ierr;
310 
311   PetscFunctionBeginUser;
312   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
313   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, NULL);CHKERRQ(ierr);
314   ierr = DMPlexGetCellType(dm, cStart, &ct);CHKERRQ(ierr);
315   simplex = DMPolytopeTypeGetNumVertices(ct) == DMPolytopeTypeGetDim(ct)+1 ? PETSC_TRUE : PETSC_FALSE;
316   /* Create finite element */
317   ierr = PetscFECreateDefault(PETSC_COMM_SELF, dim, 1, simplex, "temp_", -1, &fe);CHKERRQ(ierr);
318   ierr = PetscObjectSetName((PetscObject) fe, "temperature");CHKERRQ(ierr);
319   /* Set discretization and boundary conditions for each mesh */
320   ierr = DMSetField(dm, 0, NULL, (PetscObject) fe);CHKERRQ(ierr);
321   ierr = DMCreateDS(dm);CHKERRQ(ierr);
322   if (ctx->expTS) {
323     PetscDS ds;
324 
325     ierr = DMGetDS(dm, &ds);CHKERRQ(ierr);
326     ierr = PetscDSSetImplicit(ds, 0, PETSC_FALSE);CHKERRQ(ierr);
327   }
328   ierr = SetupProblem(dm, ctx);CHKERRQ(ierr);
329   while (cdm) {
330     ierr = DMCopyDisc(dm, cdm);CHKERRQ(ierr);
331     ierr = DMGetCoarseDM(cdm, &cdm);CHKERRQ(ierr);
332   }
333   ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
334   PetscFunctionReturn(0);
335 }
336 
337 static PetscErrorCode SetInitialConditions(TS ts, Vec u)
338 {
339   DM             dm;
340   PetscReal      t;
341   PetscErrorCode ierr;
342 
343   PetscFunctionBegin;
344   ierr = TSGetDM(ts, &dm);CHKERRQ(ierr);
345   ierr = TSGetTime(ts, &t);CHKERRQ(ierr);
346   ierr = DMComputeExactSolution(dm, t, u, NULL);CHKERRQ(ierr);
347   PetscFunctionReturn(0);
348 }
349 
350 int main(int argc, char **argv)
351 {
352   DM             dm;
353   TS             ts;
354   Vec            u;
355   AppCtx         ctx;
356   PetscErrorCode ierr;
357 
358   ierr = PetscInitialize(&argc, &argv, NULL, help);if (ierr) return ierr;
359   ierr = ProcessOptions(PETSC_COMM_WORLD, &ctx);CHKERRQ(ierr);
360   ierr = CreateMesh(PETSC_COMM_WORLD, &dm, &ctx);CHKERRQ(ierr);
361   ierr = DMSetApplicationContext(dm, &ctx);CHKERRQ(ierr);
362   ierr = SetupDiscretization(dm, &ctx);CHKERRQ(ierr);
363 
364   ierr = TSCreate(PETSC_COMM_WORLD, &ts);CHKERRQ(ierr);
365   ierr = TSSetDM(ts, dm);CHKERRQ(ierr);
366   ierr = DMTSSetBoundaryLocal(dm, DMPlexTSComputeBoundary, &ctx);CHKERRQ(ierr);
367   if (ctx.expTS) {
368     ierr = DMTSSetRHSFunctionLocal(dm, DMPlexTSComputeRHSFunctionFEM, &ctx);CHKERRQ(ierr);
369     if (ctx.lumped) {ierr = DMTSCreateRHSMassMatrixLumped(dm);CHKERRQ(ierr);}
370     else            {ierr = DMTSCreateRHSMassMatrix(dm);CHKERRQ(ierr);}
371   } else {
372     ierr = DMTSSetIFunctionLocal(dm, DMPlexTSComputeIFunctionFEM, &ctx);CHKERRQ(ierr);
373     ierr = DMTSSetIJacobianLocal(dm, DMPlexTSComputeIJacobianFEM, &ctx);CHKERRQ(ierr);
374   }
375   ierr = TSSetExactFinalTime(ts, TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr);
376   ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
377   ierr = TSSetComputeInitialCondition(ts, SetInitialConditions);CHKERRQ(ierr);
378 
379   ierr = DMCreateGlobalVector(dm, &u);CHKERRQ(ierr);
380   ierr = DMTSCheckFromOptions(ts, u);CHKERRQ(ierr);
381   ierr = SetInitialConditions(ts, u);CHKERRQ(ierr);
382   ierr = PetscObjectSetName((PetscObject) u, "temperature");CHKERRQ(ierr);
383   ierr = TSSolve(ts, u);CHKERRQ(ierr);
384   ierr = DMTSCheckFromOptions(ts, u);CHKERRQ(ierr);
385   if (ctx.expTS) {ierr = DMTSDestroyRHSMassMatrix(dm);CHKERRQ(ierr);}
386 
387   ierr = VecDestroy(&u);CHKERRQ(ierr);
388   ierr = TSDestroy(&ts);CHKERRQ(ierr);
389   ierr = DMDestroy(&dm);CHKERRQ(ierr);
390   ierr = PetscFinalize();
391   return ierr;
392 }
393 
394 /*TEST
395 
396   test:
397     suffix: 2d_p1
398     requires: triangle
399     args: -sol_type quadratic_linear -dm_refine 1 -temp_petscspace_degree 1 -dmts_check .0001 \
400           -ts_type beuler -ts_max_steps 5 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
401   test:
402     suffix: 2d_p1_exp
403     requires: triangle
404     args: -sol_type quadratic_linear -dm_refine 1 -temp_petscspace_degree 1 -explicit \
405           -ts_type euler -ts_max_steps 4 -ts_dt 1e-3 -ts_monitor_error
406   test:
407     # -dm_refine 2 -convest_num_refine 3 get L_2 convergence rate: [1.9]
408     suffix: 2d_p1_sconv
409     requires: triangle
410     args: -sol_type quadratic_linear -temp_petscspace_degree 1 -ts_convergence_estimate -ts_convergence_temporal 0 -convest_num_refine 1 \
411           -ts_type beuler -ts_max_steps 1 -ts_dt 0.00001 -snes_error_if_not_converged -pc_type lu
412   test:
413     # -dm_refine 2 -convest_num_refine 3 get L_2 convergence rate: [2.1]
414     suffix: 2d_p1_sconv_2
415     requires: triangle
416     args: -sol_type trig_trig -temp_petscspace_degree 1 -ts_convergence_estimate -ts_convergence_temporal 0 -convest_num_refine 1 \
417           -ts_type beuler -ts_max_steps 1 -ts_dt 1e-6 -snes_error_if_not_converged -pc_type lu
418   test:
419     # -dm_refine 4 -convest_num_refine 3 get L_2 convergence rate: [1.2]
420     suffix: 2d_p1_tconv
421     requires: triangle
422     args: -sol_type quadratic_trig -temp_petscspace_degree 1 -ts_convergence_estimate -convest_num_refine 1 \
423           -ts_type beuler -ts_max_steps 4 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
424   test:
425     # -dm_refine 6 -convest_num_refine 3 get L_2 convergence rate: [1.0]
426     suffix: 2d_p1_tconv_2
427     requires: triangle
428     args: -sol_type trig_trig -temp_petscspace_degree 1 -ts_convergence_estimate -convest_num_refine 1 \
429           -ts_type beuler -ts_max_steps 4 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
430   test:
431     # The L_2 convergence rate cannot be seen since stability of the explicit integrator requires that is be more accurate than the grid
432     suffix: 2d_p1_exp_tconv_2
433     requires: triangle
434     args: -sol_type trig_trig -temp_petscspace_degree 1 -explicit -ts_convergence_estimate -convest_num_refine 1 \
435           -ts_type euler -ts_max_steps 4 -ts_dt 1e-4 -lumped 0 -mass_pc_type lu
436   test:
437     # The L_2 convergence rate cannot be seen since stability of the explicit integrator requires that is be more accurate than the grid
438     suffix: 2d_p1_exp_tconv_2_lump
439     requires: triangle
440     args: -sol_type trig_trig -temp_petscspace_degree 1 -explicit -ts_convergence_estimate -convest_num_refine 1 \
441           -ts_type euler -ts_max_steps 4 -ts_dt 1e-4
442   test:
443     suffix: 2d_p2
444     requires: triangle
445     args: -sol_type quadratic_linear -dm_refine 0 -temp_petscspace_degree 2 -dmts_check .0001 \
446           -ts_type beuler -ts_max_steps 5 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
447   test:
448     # -dm_refine 2 -convest_num_refine 3 get L_2 convergence rate: [2.9]
449     suffix: 2d_p2_sconv
450     requires: triangle
451     args: -sol_type trig_linear -temp_petscspace_degree 2 -ts_convergence_estimate -ts_convergence_temporal 0 -convest_num_refine 1 \
452           -ts_type beuler -ts_max_steps 1 -ts_dt 0.00000001 -snes_error_if_not_converged -pc_type lu
453   test:
454     # -dm_refine 2 -convest_num_refine 3 get L_2 convergence rate: [3.1]
455     suffix: 2d_p2_sconv_2
456     requires: triangle
457     args: -sol_type trig_trig -temp_petscspace_degree 2 -ts_convergence_estimate -ts_convergence_temporal 0 -convest_num_refine 1 \
458           -ts_type beuler -ts_max_steps 1 -ts_dt 0.00000001 -snes_error_if_not_converged -pc_type lu
459   test:
460     # -dm_refine 3 -convest_num_refine 3 get L_2 convergence rate: [1.0]
461     suffix: 2d_p2_tconv
462     requires: triangle
463     args: -sol_type quadratic_trig -temp_petscspace_degree 2 -ts_convergence_estimate -convest_num_refine 1 \
464           -ts_type beuler -ts_max_steps 4 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
465   test:
466     # -dm_refine 3 -convest_num_refine 3 get L_2 convergence rate: [1.0]
467     suffix: 2d_p2_tconv_2
468     requires: triangle
469     args: -sol_type trig_trig -temp_petscspace_degree 2 -ts_convergence_estimate -convest_num_refine 1 \
470           -ts_type beuler -ts_max_steps 4 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
471   test:
472     suffix: 2d_q1
473     args: -sol_type quadratic_linear -dm_plex_simplex 0 -dm_refine 1 -temp_petscspace_degree 1 -dmts_check .0001 \
474           -ts_type beuler -ts_max_steps 5 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
475   test:
476     # -dm_refine 2 -convest_num_refine 3 get L_2 convergence rate: [1.9]
477     suffix: 2d_q1_sconv
478     args: -sol_type quadratic_linear -dm_plex_simplex 0 -temp_petscspace_degree 1 -ts_convergence_estimate -ts_convergence_temporal 0 -convest_num_refine 1 \
479           -ts_type beuler -ts_max_steps 1 -ts_dt 0.00001 -snes_error_if_not_converged -pc_type lu
480   test:
481     # -dm_refine 4 -convest_num_refine 3 get L_2 convergence rate: [1.2]
482     suffix: 2d_q1_tconv
483     args: -sol_type quadratic_trig -dm_plex_simplex 0 -temp_petscspace_degree 1 -ts_convergence_estimate -convest_num_refine 1 \
484           -ts_type beuler -ts_max_steps 4 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
485   test:
486     suffix: 2d_q2
487     args: -sol_type quadratic_linear -dm_plex_simplex 0 -dm_refine 0 -temp_petscspace_degree 2 -dmts_check .0001 \
488           -ts_type beuler -ts_max_steps 5 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
489   test:
490     # -dm_refine 2 -convest_num_refine 3 get L_2 convergence rate: [2.9]
491     suffix: 2d_q2_sconv
492     args: -sol_type trig_linear -dm_plex_simplex 0 -temp_petscspace_degree 2 -ts_convergence_estimate -ts_convergence_temporal 0 -convest_num_refine 1 \
493           -ts_type beuler -ts_max_steps 1 -ts_dt 0.00000001 -snes_error_if_not_converged -pc_type lu
494   test:
495     # -dm_refine 3 -convest_num_refine 3 get L_2 convergence rate: [1.0]
496     suffix: 2d_q2_tconv
497     args: -sol_type quadratic_trig -dm_plex_simplex 0 -temp_petscspace_degree 2 -ts_convergence_estimate -convest_num_refine 1 \
498           -ts_type beuler -ts_max_steps 4 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
499 
500   test:
501     suffix: 3d_p1
502     requires: ctetgen
503     args: -sol_type quadratic_linear -dm_refine 1 -temp_petscspace_degree 1 -dmts_check .0001 \
504           -ts_type beuler -ts_max_steps 5 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
505   test:
506     # -dm_refine 2 -convest_num_refine 3 get L_2 convergence rate: [1.9]
507     suffix: 3d_p1_sconv
508     requires: ctetgen
509     args: -sol_type quadratic_linear -temp_petscspace_degree 1 -ts_convergence_estimate -ts_convergence_temporal 0 -convest_num_refine 1 \
510           -ts_type beuler -ts_max_steps 1 -ts_dt 0.00001 -snes_error_if_not_converged -pc_type lu
511   test:
512     # -dm_refine 4 -convest_num_refine 3 get L_2 convergence rate: [1.2]
513     suffix: 3d_p1_tconv
514     requires: ctetgen
515     args: -sol_type quadratic_trig -temp_petscspace_degree 1 -ts_convergence_estimate -convest_num_refine 1 \
516           -ts_type beuler -ts_max_steps 4 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
517   test:
518     suffix: 3d_p2
519     requires: ctetgen
520     args: -sol_type quadratic_linear -dm_refine 0 -temp_petscspace_degree 2 -dmts_check .0001 \
521           -ts_type beuler -ts_max_steps 5 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
522   test:
523     # -dm_refine 2 -convest_num_refine 3 get L_2 convergence rate: [2.9]
524     suffix: 3d_p2_sconv
525     requires: ctetgen
526     args: -sol_type trig_linear -temp_petscspace_degree 2 -ts_convergence_estimate -ts_convergence_temporal 0 -convest_num_refine 1 \
527           -ts_type beuler -ts_max_steps 1 -ts_dt 0.00000001 -snes_error_if_not_converged -pc_type lu
528   test:
529     # -dm_refine 3 -convest_num_refine 3 get L_2 convergence rate: [1.0]
530     suffix: 3d_p2_tconv
531     requires: ctetgen
532     args: -sol_type quadratic_trig -temp_petscspace_degree 2 -ts_convergence_estimate -convest_num_refine 1 \
533           -ts_type beuler -ts_max_steps 4 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
534   test:
535     suffix: 3d_q1
536     args: -sol_type quadratic_linear -dm_plex_simplex 0 -dm_refine 1 -temp_petscspace_degree 1 -dmts_check .0001 \
537           -ts_type beuler -ts_max_steps 5 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
538   test:
539     # -dm_refine 2 -convest_num_refine 3 get L_2 convergence rate: [1.9]
540     suffix: 3d_q1_sconv
541     args: -sol_type quadratic_linear -dm_plex_simplex 0 -temp_petscspace_degree 1 -ts_convergence_estimate -ts_convergence_temporal 0 -convest_num_refine 1 \
542           -ts_type beuler -ts_max_steps 1 -ts_dt 0.00001 -snes_error_if_not_converged -pc_type lu
543   test:
544     # -dm_refine 4 -convest_num_refine 3 get L_2 convergence rate: [1.2]
545     suffix: 3d_q1_tconv
546     args: -sol_type quadratic_trig -dm_plex_simplex 0 -temp_petscspace_degree 1 -ts_convergence_estimate -convest_num_refine 1 \
547           -ts_type beuler -ts_max_steps 4 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
548   test:
549     suffix: 3d_q2
550     args: -sol_type quadratic_linear -dm_plex_simplex 0 -dm_refine 0 -temp_petscspace_degree 2 -dmts_check .0001 \
551           -ts_type beuler -ts_max_steps 5 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
552   test:
553     # -dm_refine 2 -convest_num_refine 3 get L_2 convergence rate: [2.9]
554     suffix: 3d_q2_sconv
555     args: -sol_type trig_linear -dm_plex_simplex 0 -temp_petscspace_degree 2 -ts_convergence_estimate -ts_convergence_temporal 0 -convest_num_refine 1 \
556           -ts_type beuler -ts_max_steps 1 -ts_dt 0.00000001 -snes_error_if_not_converged -pc_type lu
557   test:
558     # -dm_refine 3 -convest_num_refine 3 get L_2 convergence rate: [1.0]
559     suffix: 3d_q2_tconv
560     args: -sol_type quadratic_trig -dm_plex_simplex 0 -temp_petscspace_degree 2 -ts_convergence_estimate -convest_num_refine 1 \
561           -ts_type beuler -ts_max_steps 4 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
562 
563   test:
564     # For a nice picture, -bd_dm_refine 2 -dm_refine 1 -dm_view hdf5:${PETSC_DIR}/sol.h5 -ts_monitor_solution hdf5:${PETSC_DIR}/sol.h5::append
565     suffix: egads_sphere
566     requires: egads ctetgen
567     args: -sol_type quadratic_linear \
568           -dm_plex_boundary_filename ${wPETSC_DIR}/share/petsc/datafiles/meshes/unit_sphere.egadslite -dm_plex_boundary_label marker -bd_dm_plex_scale 40 \
569           -temp_petscspace_degree 2 -dmts_check .0001 \
570           -ts_type beuler -ts_max_steps 5 -ts_dt 0.1 -snes_error_if_not_converged -pc_type lu
571 
572 TEST*/
573