xref: /petsc/src/snes/utils/dmplexsnes.c (revision aa0b44dba1dce152c77c35552895bdbefce90cc2)
1 #include <petsc/private/dmpleximpl.h>   /*I "petscdmplex.h" I*/
2 #include <petsc/private/snesimpl.h>     /*I "petscsnes.h"   I*/
3 #include <petscds.h>
4 #include <petsc/private/petscimpl.h>
5 #include <petsc/private/petscfeimpl.h>
6 
7 /************************** Interpolation *******************************/
8 
9 #undef __FUNCT__
10 #define __FUNCT__ "DMInterpolationCreate"
11 PetscErrorCode DMInterpolationCreate(MPI_Comm comm, DMInterpolationInfo *ctx)
12 {
13   PetscErrorCode ierr;
14 
15   PetscFunctionBegin;
16   PetscValidPointer(ctx, 2);
17   ierr = PetscMalloc(sizeof(struct _DMInterpolationInfo), ctx);CHKERRQ(ierr);
18 
19   (*ctx)->comm   = comm;
20   (*ctx)->dim    = -1;
21   (*ctx)->nInput = 0;
22   (*ctx)->points = NULL;
23   (*ctx)->cells  = NULL;
24   (*ctx)->n      = -1;
25   (*ctx)->coords = NULL;
26   PetscFunctionReturn(0);
27 }
28 
29 #undef __FUNCT__
30 #define __FUNCT__ "DMInterpolationSetDim"
31 PetscErrorCode DMInterpolationSetDim(DMInterpolationInfo ctx, PetscInt dim)
32 {
33   PetscFunctionBegin;
34   if ((dim < 1) || (dim > 3)) SETERRQ1(ctx->comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid dimension for points: %d", dim);
35   ctx->dim = dim;
36   PetscFunctionReturn(0);
37 }
38 
39 #undef __FUNCT__
40 #define __FUNCT__ "DMInterpolationGetDim"
41 PetscErrorCode DMInterpolationGetDim(DMInterpolationInfo ctx, PetscInt *dim)
42 {
43   PetscFunctionBegin;
44   PetscValidIntPointer(dim, 2);
45   *dim = ctx->dim;
46   PetscFunctionReturn(0);
47 }
48 
49 #undef __FUNCT__
50 #define __FUNCT__ "DMInterpolationSetDof"
51 PetscErrorCode DMInterpolationSetDof(DMInterpolationInfo ctx, PetscInt dof)
52 {
53   PetscFunctionBegin;
54   if (dof < 1) SETERRQ1(ctx->comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of components: %d", dof);
55   ctx->dof = dof;
56   PetscFunctionReturn(0);
57 }
58 
59 #undef __FUNCT__
60 #define __FUNCT__ "DMInterpolationGetDof"
61 PetscErrorCode DMInterpolationGetDof(DMInterpolationInfo ctx, PetscInt *dof)
62 {
63   PetscFunctionBegin;
64   PetscValidIntPointer(dof, 2);
65   *dof = ctx->dof;
66   PetscFunctionReturn(0);
67 }
68 
69 #undef __FUNCT__
70 #define __FUNCT__ "DMInterpolationAddPoints"
71 PetscErrorCode DMInterpolationAddPoints(DMInterpolationInfo ctx, PetscInt n, PetscReal points[])
72 {
73   PetscErrorCode ierr;
74 
75   PetscFunctionBegin;
76   if (ctx->dim < 0) SETERRQ(ctx->comm, PETSC_ERR_ARG_WRONGSTATE, "The spatial dimension has not been set");
77   if (ctx->points)  SETERRQ(ctx->comm, PETSC_ERR_ARG_WRONGSTATE, "Cannot add points multiple times yet");
78   ctx->nInput = n;
79 
80   ierr = PetscMalloc1(n*ctx->dim, &ctx->points);CHKERRQ(ierr);
81   ierr = PetscMemcpy(ctx->points, points, n*ctx->dim * sizeof(PetscReal));CHKERRQ(ierr);
82   PetscFunctionReturn(0);
83 }
84 
85 #undef __FUNCT__
86 #define __FUNCT__ "DMInterpolationSetUp"
87 PetscErrorCode DMInterpolationSetUp(DMInterpolationInfo ctx, DM dm, PetscBool redundantPoints)
88 {
89   MPI_Comm       comm = ctx->comm;
90   PetscScalar   *a;
91   PetscInt       p, q, i;
92   PetscMPIInt    rank, size;
93   PetscErrorCode ierr;
94   Vec            pointVec;
95   IS             cellIS;
96   PetscLayout    layout;
97   PetscReal      *globalPoints;
98   PetscScalar    *globalPointsScalar;
99   const PetscInt *ranges;
100   PetscMPIInt    *counts, *displs;
101   const PetscInt *foundCells;
102   PetscMPIInt    *foundProcs, *globalProcs;
103   PetscInt       n, N;
104 
105   PetscFunctionBegin;
106   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
107   ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
108   ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
109   if (ctx->dim < 0) SETERRQ(comm, PETSC_ERR_ARG_WRONGSTATE, "The spatial dimension has not been set");
110   /* Locate points */
111   n = ctx->nInput;
112   if (!redundantPoints) {
113     ierr = PetscLayoutCreate(comm, &layout);CHKERRQ(ierr);
114     ierr = PetscLayoutSetBlockSize(layout, 1);CHKERRQ(ierr);
115     ierr = PetscLayoutSetLocalSize(layout, n);CHKERRQ(ierr);
116     ierr = PetscLayoutSetUp(layout);CHKERRQ(ierr);
117     ierr = PetscLayoutGetSize(layout, &N);CHKERRQ(ierr);
118     /* Communicate all points to all processes */
119     ierr = PetscMalloc3(N*ctx->dim,&globalPoints,size,&counts,size,&displs);CHKERRQ(ierr);
120     ierr = PetscLayoutGetRanges(layout, &ranges);CHKERRQ(ierr);
121     for (p = 0; p < size; ++p) {
122       counts[p] = (ranges[p+1] - ranges[p])*ctx->dim;
123       displs[p] = ranges[p]*ctx->dim;
124     }
125     ierr = MPI_Allgatherv(ctx->points, n*ctx->dim, MPIU_REAL, globalPoints, counts, displs, MPIU_REAL, comm);CHKERRQ(ierr);
126   } else {
127     N = n;
128     globalPoints = ctx->points;
129     counts = displs = NULL;
130     layout = NULL;
131   }
132 #if 0
133   ierr = PetscMalloc3(N,&foundCells,N,&foundProcs,N,&globalProcs);CHKERRQ(ierr);
134   /* foundCells[p] = m->locatePoint(&globalPoints[p*ctx->dim]); */
135 #else
136 #if defined(PETSC_USE_COMPLEX)
137   ierr = PetscMalloc1(N,&globalPointsScalar);CHKERRQ(ierr);
138   for (i=0; i<N; i++) globalPointsScalar[i] = globalPoints[i];
139 #else
140   globalPointsScalar = globalPoints;
141 #endif
142   ierr = VecCreateSeqWithArray(PETSC_COMM_SELF, ctx->dim, N*ctx->dim, globalPointsScalar, &pointVec);CHKERRQ(ierr);
143   ierr = PetscMalloc2(N,&foundProcs,N,&globalProcs);CHKERRQ(ierr);
144   ierr = DMLocatePoints(dm, pointVec, &cellIS);CHKERRQ(ierr);
145   ierr = ISGetIndices(cellIS, &foundCells);CHKERRQ(ierr);
146 #endif
147   for (p = 0; p < N; ++p) {
148     if (foundCells[p] >= 0) foundProcs[p] = rank;
149     else foundProcs[p] = size;
150   }
151   /* Let the lowest rank process own each point */
152   ierr   = MPIU_Allreduce(foundProcs, globalProcs, N, MPI_INT, MPI_MIN, comm);CHKERRQ(ierr);
153   ctx->n = 0;
154   for (p = 0; p < N; ++p) {
155     if (globalProcs[p] == size) SETERRQ4(comm, PETSC_ERR_PLIB, "Point %d: %g %g %g not located in mesh", p, globalPoints[p*ctx->dim+0], ctx->dim > 1 ? globalPoints[p*ctx->dim+1] : 0.0, ctx->dim > 2 ? globalPoints[p*ctx->dim+2] : 0.0);
156     else if (globalProcs[p] == rank) ctx->n++;
157   }
158   /* Create coordinates vector and array of owned cells */
159   ierr = PetscMalloc1(ctx->n, &ctx->cells);CHKERRQ(ierr);
160   ierr = VecCreate(comm, &ctx->coords);CHKERRQ(ierr);
161   ierr = VecSetSizes(ctx->coords, ctx->n*ctx->dim, PETSC_DECIDE);CHKERRQ(ierr);
162   ierr = VecSetBlockSize(ctx->coords, ctx->dim);CHKERRQ(ierr);
163   ierr = VecSetType(ctx->coords,VECSTANDARD);CHKERRQ(ierr);
164   ierr = VecGetArray(ctx->coords, &a);CHKERRQ(ierr);
165   for (p = 0, q = 0, i = 0; p < N; ++p) {
166     if (globalProcs[p] == rank) {
167       PetscInt d;
168 
169       for (d = 0; d < ctx->dim; ++d, ++i) a[i] = globalPoints[p*ctx->dim+d];
170       ctx->cells[q++] = foundCells[p];
171     }
172   }
173   ierr = VecRestoreArray(ctx->coords, &a);CHKERRQ(ierr);
174 #if 0
175   ierr = PetscFree3(foundCells,foundProcs,globalProcs);CHKERRQ(ierr);
176 #else
177   ierr = PetscFree2(foundProcs,globalProcs);CHKERRQ(ierr);
178   ierr = ISRestoreIndices(cellIS, &foundCells);CHKERRQ(ierr);
179   ierr = ISDestroy(&cellIS);CHKERRQ(ierr);
180   ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
181 #endif
182   if ((void*)globalPointsScalar != (void*)globalPoints) {ierr = PetscFree(globalPointsScalar);CHKERRQ(ierr);}
183   if (!redundantPoints) {ierr = PetscFree3(globalPoints,counts,displs);CHKERRQ(ierr);}
184   ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr);
185   PetscFunctionReturn(0);
186 }
187 
188 #undef __FUNCT__
189 #define __FUNCT__ "DMInterpolationGetCoordinates"
190 PetscErrorCode DMInterpolationGetCoordinates(DMInterpolationInfo ctx, Vec *coordinates)
191 {
192   PetscFunctionBegin;
193   PetscValidPointer(coordinates, 2);
194   if (!ctx->coords) SETERRQ(ctx->comm, PETSC_ERR_ARG_WRONGSTATE, "The interpolation context has not been setup.");
195   *coordinates = ctx->coords;
196   PetscFunctionReturn(0);
197 }
198 
199 #undef __FUNCT__
200 #define __FUNCT__ "DMInterpolationGetVector"
201 PetscErrorCode DMInterpolationGetVector(DMInterpolationInfo ctx, Vec *v)
202 {
203   PetscErrorCode ierr;
204 
205   PetscFunctionBegin;
206   PetscValidPointer(v, 2);
207   if (!ctx->coords) SETERRQ(ctx->comm, PETSC_ERR_ARG_WRONGSTATE, "The interpolation context has not been setup.");
208   ierr = VecCreate(ctx->comm, v);CHKERRQ(ierr);
209   ierr = VecSetSizes(*v, ctx->n*ctx->dof, PETSC_DECIDE);CHKERRQ(ierr);
210   ierr = VecSetBlockSize(*v, ctx->dof);CHKERRQ(ierr);
211   ierr = VecSetType(*v,VECSTANDARD);CHKERRQ(ierr);
212   PetscFunctionReturn(0);
213 }
214 
215 #undef __FUNCT__
216 #define __FUNCT__ "DMInterpolationRestoreVector"
217 PetscErrorCode DMInterpolationRestoreVector(DMInterpolationInfo ctx, Vec *v)
218 {
219   PetscErrorCode ierr;
220 
221   PetscFunctionBegin;
222   PetscValidPointer(v, 2);
223   if (!ctx->coords) SETERRQ(ctx->comm, PETSC_ERR_ARG_WRONGSTATE, "The interpolation context has not been setup.");
224   ierr = VecDestroy(v);CHKERRQ(ierr);
225   PetscFunctionReturn(0);
226 }
227 
228 #undef __FUNCT__
229 #define __FUNCT__ "DMInterpolate_Triangle_Private"
230 PETSC_STATIC_INLINE PetscErrorCode DMInterpolate_Triangle_Private(DMInterpolationInfo ctx, DM dm, Vec xLocal, Vec v)
231 {
232   PetscReal      *v0, *J, *invJ, detJ;
233   const PetscScalar *coords;
234   PetscScalar    *a;
235   PetscInt       p;
236   PetscErrorCode ierr;
237 
238   PetscFunctionBegin;
239   ierr = PetscMalloc3(ctx->dim,&v0,ctx->dim*ctx->dim,&J,ctx->dim*ctx->dim,&invJ);CHKERRQ(ierr);
240   ierr = VecGetArrayRead(ctx->coords, &coords);CHKERRQ(ierr);
241   ierr = VecGetArray(v, &a);CHKERRQ(ierr);
242   for (p = 0; p < ctx->n; ++p) {
243     PetscInt     c = ctx->cells[p];
244     PetscScalar *x = NULL;
245     PetscReal    xi[4];
246     PetscInt     d, f, comp;
247 
248     ierr = DMPlexComputeCellGeometryFEM(dm, c, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
249     if (detJ <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %d", detJ, c);
250     ierr = DMPlexVecGetClosure(dm, NULL, xLocal, c, NULL, &x);CHKERRQ(ierr);
251     for (comp = 0; comp < ctx->dof; ++comp) a[p*ctx->dof+comp] = x[0*ctx->dof+comp];
252 
253     for (d = 0; d < ctx->dim; ++d) {
254       xi[d] = 0.0;
255       for (f = 0; f < ctx->dim; ++f) xi[d] += invJ[d*ctx->dim+f]*0.5*PetscRealPart(coords[p*ctx->dim+f] - v0[f]);
256       for (comp = 0; comp < ctx->dof; ++comp) a[p*ctx->dof+comp] += PetscRealPart(x[(d+1)*ctx->dof+comp] - x[0*ctx->dof+comp])*xi[d];
257     }
258     ierr = DMPlexVecRestoreClosure(dm, NULL, xLocal, c, NULL, &x);CHKERRQ(ierr);
259   }
260   ierr = VecRestoreArray(v, &a);CHKERRQ(ierr);
261   ierr = VecRestoreArrayRead(ctx->coords, &coords);CHKERRQ(ierr);
262   ierr = PetscFree3(v0, J, invJ);CHKERRQ(ierr);
263   PetscFunctionReturn(0);
264 }
265 
266 #undef __FUNCT__
267 #define __FUNCT__ "DMInterpolate_Tetrahedron_Private"
268 PETSC_STATIC_INLINE PetscErrorCode DMInterpolate_Tetrahedron_Private(DMInterpolationInfo ctx, DM dm, Vec xLocal, Vec v)
269 {
270   PetscReal      *v0, *J, *invJ, detJ;
271   const PetscScalar *coords;
272   PetscScalar    *a;
273   PetscInt       p;
274   PetscErrorCode ierr;
275 
276   PetscFunctionBegin;
277   ierr = PetscMalloc3(ctx->dim,&v0,ctx->dim*ctx->dim,&J,ctx->dim*ctx->dim,&invJ);CHKERRQ(ierr);
278   ierr = VecGetArrayRead(ctx->coords, &coords);CHKERRQ(ierr);
279   ierr = VecGetArray(v, &a);CHKERRQ(ierr);
280   for (p = 0; p < ctx->n; ++p) {
281     PetscInt       c = ctx->cells[p];
282     const PetscInt order[3] = {2, 1, 3};
283     PetscScalar   *x = NULL;
284     PetscReal      xi[4];
285     PetscInt       d, f, comp;
286 
287     ierr = DMPlexComputeCellGeometryFEM(dm, c, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
288     if (detJ <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %d", detJ, c);
289     ierr = DMPlexVecGetClosure(dm, NULL, xLocal, c, NULL, &x);CHKERRQ(ierr);
290     for (comp = 0; comp < ctx->dof; ++comp) a[p*ctx->dof+comp] = x[0*ctx->dof+comp];
291 
292     for (d = 0; d < ctx->dim; ++d) {
293       xi[d] = 0.0;
294       for (f = 0; f < ctx->dim; ++f) xi[d] += invJ[d*ctx->dim+f]*0.5*PetscRealPart(coords[p*ctx->dim+f] - v0[f]);
295       for (comp = 0; comp < ctx->dof; ++comp) a[p*ctx->dof+comp] += PetscRealPart(x[order[d]*ctx->dof+comp] - x[0*ctx->dof+comp])*xi[d];
296     }
297     ierr = DMPlexVecRestoreClosure(dm, NULL, xLocal, c, NULL, &x);CHKERRQ(ierr);
298   }
299   ierr = VecRestoreArray(v, &a);CHKERRQ(ierr);
300   ierr = VecRestoreArrayRead(ctx->coords, &coords);CHKERRQ(ierr);
301   ierr = PetscFree3(v0, J, invJ);CHKERRQ(ierr);
302   PetscFunctionReturn(0);
303 }
304 
305 #undef __FUNCT__
306 #define __FUNCT__ "QuadMap_Private"
307 PETSC_STATIC_INLINE PetscErrorCode QuadMap_Private(SNES snes, Vec Xref, Vec Xreal, void *ctx)
308 {
309   const PetscScalar *vertices = (const PetscScalar*) ctx;
310   const PetscScalar x0        = vertices[0];
311   const PetscScalar y0        = vertices[1];
312   const PetscScalar x1        = vertices[2];
313   const PetscScalar y1        = vertices[3];
314   const PetscScalar x2        = vertices[4];
315   const PetscScalar y2        = vertices[5];
316   const PetscScalar x3        = vertices[6];
317   const PetscScalar y3        = vertices[7];
318   const PetscScalar f_1       = x1 - x0;
319   const PetscScalar g_1       = y1 - y0;
320   const PetscScalar f_3       = x3 - x0;
321   const PetscScalar g_3       = y3 - y0;
322   const PetscScalar f_01      = x2 - x1 - x3 + x0;
323   const PetscScalar g_01      = y2 - y1 - y3 + y0;
324   const PetscScalar *ref;
325   PetscScalar       *real;
326   PetscErrorCode    ierr;
327 
328   PetscFunctionBegin;
329   ierr = VecGetArrayRead(Xref,  &ref);CHKERRQ(ierr);
330   ierr = VecGetArray(Xreal, &real);CHKERRQ(ierr);
331   {
332     const PetscScalar p0 = ref[0];
333     const PetscScalar p1 = ref[1];
334 
335     real[0] = x0 + f_1 * p0 + f_3 * p1 + f_01 * p0 * p1;
336     real[1] = y0 + g_1 * p0 + g_3 * p1 + g_01 * p0 * p1;
337   }
338   ierr = PetscLogFlops(28);CHKERRQ(ierr);
339   ierr = VecRestoreArrayRead(Xref,  &ref);CHKERRQ(ierr);
340   ierr = VecRestoreArray(Xreal, &real);CHKERRQ(ierr);
341   PetscFunctionReturn(0);
342 }
343 
344 #include <petsc/private/dmimpl.h>
345 #undef __FUNCT__
346 #define __FUNCT__ "QuadJacobian_Private"
347 PETSC_STATIC_INLINE PetscErrorCode QuadJacobian_Private(SNES snes, Vec Xref, Mat J, Mat M, void *ctx)
348 {
349   const PetscScalar *vertices = (const PetscScalar*) ctx;
350   const PetscScalar x0        = vertices[0];
351   const PetscScalar y0        = vertices[1];
352   const PetscScalar x1        = vertices[2];
353   const PetscScalar y1        = vertices[3];
354   const PetscScalar x2        = vertices[4];
355   const PetscScalar y2        = vertices[5];
356   const PetscScalar x3        = vertices[6];
357   const PetscScalar y3        = vertices[7];
358   const PetscScalar f_01      = x2 - x1 - x3 + x0;
359   const PetscScalar g_01      = y2 - y1 - y3 + y0;
360   const PetscScalar *ref;
361   PetscErrorCode    ierr;
362 
363   PetscFunctionBegin;
364   ierr = VecGetArrayRead(Xref,  &ref);CHKERRQ(ierr);
365   {
366     const PetscScalar x       = ref[0];
367     const PetscScalar y       = ref[1];
368     const PetscInt    rows[2] = {0, 1};
369     PetscScalar       values[4];
370 
371     values[0] = (x1 - x0 + f_01*y) * 0.5; values[1] = (x3 - x0 + f_01*x) * 0.5;
372     values[2] = (y1 - y0 + g_01*y) * 0.5; values[3] = (y3 - y0 + g_01*x) * 0.5;
373     ierr      = MatSetValues(J, 2, rows, 2, rows, values, INSERT_VALUES);CHKERRQ(ierr);
374   }
375   ierr = PetscLogFlops(30);CHKERRQ(ierr);
376   ierr = VecRestoreArrayRead(Xref,  &ref);CHKERRQ(ierr);
377   ierr = MatAssemblyBegin(J, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
378   ierr = MatAssemblyEnd(J, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
379   PetscFunctionReturn(0);
380 }
381 
382 #undef __FUNCT__
383 #define __FUNCT__ "DMInterpolate_Quad_Private"
384 PETSC_STATIC_INLINE PetscErrorCode DMInterpolate_Quad_Private(DMInterpolationInfo ctx, DM dm, Vec xLocal, Vec v)
385 {
386   DM             dmCoord;
387   SNES           snes;
388   KSP            ksp;
389   PC             pc;
390   Vec            coordsLocal, r, ref, real;
391   Mat            J;
392   const PetscScalar *coords;
393   PetscScalar    *a;
394   PetscInt       p;
395   PetscErrorCode ierr;
396 
397   PetscFunctionBegin;
398   ierr = DMGetCoordinatesLocal(dm, &coordsLocal);CHKERRQ(ierr);
399   ierr = DMGetCoordinateDM(dm, &dmCoord);CHKERRQ(ierr);
400   ierr = SNESCreate(PETSC_COMM_SELF, &snes);CHKERRQ(ierr);
401   ierr = SNESSetOptionsPrefix(snes, "quad_interp_");CHKERRQ(ierr);
402   ierr = VecCreate(PETSC_COMM_SELF, &r);CHKERRQ(ierr);
403   ierr = VecSetSizes(r, 2, 2);CHKERRQ(ierr);
404   ierr = VecSetType(r,dm->vectype);CHKERRQ(ierr);
405   ierr = VecDuplicate(r, &ref);CHKERRQ(ierr);
406   ierr = VecDuplicate(r, &real);CHKERRQ(ierr);
407   ierr = MatCreate(PETSC_COMM_SELF, &J);CHKERRQ(ierr);
408   ierr = MatSetSizes(J, 2, 2, 2, 2);CHKERRQ(ierr);
409   ierr = MatSetType(J, MATSEQDENSE);CHKERRQ(ierr);
410   ierr = MatSetUp(J);CHKERRQ(ierr);
411   ierr = SNESSetFunction(snes, r, QuadMap_Private, NULL);CHKERRQ(ierr);
412   ierr = SNESSetJacobian(snes, J, J, QuadJacobian_Private, NULL);CHKERRQ(ierr);
413   ierr = SNESGetKSP(snes, &ksp);CHKERRQ(ierr);
414   ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr);
415   ierr = PCSetType(pc, PCLU);CHKERRQ(ierr);
416   ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
417 
418   ierr = VecGetArrayRead(ctx->coords, &coords);CHKERRQ(ierr);
419   ierr = VecGetArray(v, &a);CHKERRQ(ierr);
420   for (p = 0; p < ctx->n; ++p) {
421     PetscScalar *x = NULL, *vertices = NULL;
422     PetscScalar *xi;
423     PetscReal    xir[2];
424     PetscInt     c = ctx->cells[p], comp, coordSize, xSize;
425 
426     /* Can make this do all points at once */
427     ierr = DMPlexVecGetClosure(dmCoord, NULL, coordsLocal, c, &coordSize, &vertices);CHKERRQ(ierr);
428     if (4*2 != coordSize) SETERRQ2(ctx->comm, PETSC_ERR_ARG_SIZ, "Invalid closure size %d should be %d", coordSize, 4*2);
429     ierr = DMPlexVecGetClosure(dm, NULL, xLocal, c, &xSize, &x);CHKERRQ(ierr);
430     if (4*ctx->dof != xSize) SETERRQ2(ctx->comm, PETSC_ERR_ARG_SIZ, "Invalid closure size %d should be %d", xSize, 4*ctx->dof);
431     ierr   = SNESSetFunction(snes, NULL, NULL, (void*) vertices);CHKERRQ(ierr);
432     ierr   = SNESSetJacobian(snes, NULL, NULL, NULL, (void*) vertices);CHKERRQ(ierr);
433     ierr   = VecGetArray(real, &xi);CHKERRQ(ierr);
434     xi[0]  = coords[p*ctx->dim+0];
435     xi[1]  = coords[p*ctx->dim+1];
436     ierr   = VecRestoreArray(real, &xi);CHKERRQ(ierr);
437     ierr   = SNESSolve(snes, real, ref);CHKERRQ(ierr);
438     ierr   = VecGetArray(ref, &xi);CHKERRQ(ierr);
439     xir[0] = PetscRealPart(xi[0]);
440     xir[1] = PetscRealPart(xi[1]);
441     for (comp = 0; comp < ctx->dof; ++comp) a[p*ctx->dof+comp] = x[0*ctx->dof+comp]*(1 - xir[0])*(1 - xir[1]) + x[1*ctx->dof+comp]*xir[0]*(1 - xir[1]) + x[2*ctx->dof+comp]*xir[0]*xir[1] + x[3*ctx->dof+comp]*(1 - xir[0])*xir[1];
442 
443     ierr = VecRestoreArray(ref, &xi);CHKERRQ(ierr);
444     ierr = DMPlexVecRestoreClosure(dmCoord, NULL, coordsLocal, c, &coordSize, &vertices);CHKERRQ(ierr);
445     ierr = DMPlexVecRestoreClosure(dm, NULL, xLocal, c, &xSize, &x);CHKERRQ(ierr);
446   }
447   ierr = VecRestoreArray(v, &a);CHKERRQ(ierr);
448   ierr = VecRestoreArrayRead(ctx->coords, &coords);CHKERRQ(ierr);
449 
450   ierr = SNESDestroy(&snes);CHKERRQ(ierr);
451   ierr = VecDestroy(&r);CHKERRQ(ierr);
452   ierr = VecDestroy(&ref);CHKERRQ(ierr);
453   ierr = VecDestroy(&real);CHKERRQ(ierr);
454   ierr = MatDestroy(&J);CHKERRQ(ierr);
455   PetscFunctionReturn(0);
456 }
457 
458 #undef __FUNCT__
459 #define __FUNCT__ "HexMap_Private"
460 PETSC_STATIC_INLINE PetscErrorCode HexMap_Private(SNES snes, Vec Xref, Vec Xreal, void *ctx)
461 {
462   const PetscScalar *vertices = (const PetscScalar*) ctx;
463   const PetscScalar x0        = vertices[0];
464   const PetscScalar y0        = vertices[1];
465   const PetscScalar z0        = vertices[2];
466   const PetscScalar x1        = vertices[9];
467   const PetscScalar y1        = vertices[10];
468   const PetscScalar z1        = vertices[11];
469   const PetscScalar x2        = vertices[6];
470   const PetscScalar y2        = vertices[7];
471   const PetscScalar z2        = vertices[8];
472   const PetscScalar x3        = vertices[3];
473   const PetscScalar y3        = vertices[4];
474   const PetscScalar z3        = vertices[5];
475   const PetscScalar x4        = vertices[12];
476   const PetscScalar y4        = vertices[13];
477   const PetscScalar z4        = vertices[14];
478   const PetscScalar x5        = vertices[15];
479   const PetscScalar y5        = vertices[16];
480   const PetscScalar z5        = vertices[17];
481   const PetscScalar x6        = vertices[18];
482   const PetscScalar y6        = vertices[19];
483   const PetscScalar z6        = vertices[20];
484   const PetscScalar x7        = vertices[21];
485   const PetscScalar y7        = vertices[22];
486   const PetscScalar z7        = vertices[23];
487   const PetscScalar f_1       = x1 - x0;
488   const PetscScalar g_1       = y1 - y0;
489   const PetscScalar h_1       = z1 - z0;
490   const PetscScalar f_3       = x3 - x0;
491   const PetscScalar g_3       = y3 - y0;
492   const PetscScalar h_3       = z3 - z0;
493   const PetscScalar f_4       = x4 - x0;
494   const PetscScalar g_4       = y4 - y0;
495   const PetscScalar h_4       = z4 - z0;
496   const PetscScalar f_01      = x2 - x1 - x3 + x0;
497   const PetscScalar g_01      = y2 - y1 - y3 + y0;
498   const PetscScalar h_01      = z2 - z1 - z3 + z0;
499   const PetscScalar f_12      = x7 - x3 - x4 + x0;
500   const PetscScalar g_12      = y7 - y3 - y4 + y0;
501   const PetscScalar h_12      = z7 - z3 - z4 + z0;
502   const PetscScalar f_02      = x5 - x1 - x4 + x0;
503   const PetscScalar g_02      = y5 - y1 - y4 + y0;
504   const PetscScalar h_02      = z5 - z1 - z4 + z0;
505   const PetscScalar f_012     = x6 - x0 + x1 - x2 + x3 + x4 - x5 - x7;
506   const PetscScalar g_012     = y6 - y0 + y1 - y2 + y3 + y4 - y5 - y7;
507   const PetscScalar h_012     = z6 - z0 + z1 - z2 + z3 + z4 - z5 - z7;
508   const PetscScalar *ref;
509   PetscScalar       *real;
510   PetscErrorCode    ierr;
511 
512   PetscFunctionBegin;
513   ierr = VecGetArrayRead(Xref,  &ref);CHKERRQ(ierr);
514   ierr = VecGetArray(Xreal, &real);CHKERRQ(ierr);
515   {
516     const PetscScalar p0 = ref[0];
517     const PetscScalar p1 = ref[1];
518     const PetscScalar p2 = ref[2];
519 
520     real[0] = x0 + f_1*p0 + f_3*p1 + f_4*p2 + f_01*p0*p1 + f_12*p1*p2 + f_02*p0*p2 + f_012*p0*p1*p2;
521     real[1] = y0 + g_1*p0 + g_3*p1 + g_4*p2 + g_01*p0*p1 + g_01*p0*p1 + g_12*p1*p2 + g_02*p0*p2 + g_012*p0*p1*p2;
522     real[2] = z0 + h_1*p0 + h_3*p1 + h_4*p2 + h_01*p0*p1 + h_01*p0*p1 + h_12*p1*p2 + h_02*p0*p2 + h_012*p0*p1*p2;
523   }
524   ierr = PetscLogFlops(114);CHKERRQ(ierr);
525   ierr = VecRestoreArrayRead(Xref,  &ref);CHKERRQ(ierr);
526   ierr = VecRestoreArray(Xreal, &real);CHKERRQ(ierr);
527   PetscFunctionReturn(0);
528 }
529 
530 #undef __FUNCT__
531 #define __FUNCT__ "HexJacobian_Private"
532 PETSC_STATIC_INLINE PetscErrorCode HexJacobian_Private(SNES snes, Vec Xref, Mat J, Mat M, void *ctx)
533 {
534   const PetscScalar *vertices = (const PetscScalar*) ctx;
535   const PetscScalar x0        = vertices[0];
536   const PetscScalar y0        = vertices[1];
537   const PetscScalar z0        = vertices[2];
538   const PetscScalar x1        = vertices[9];
539   const PetscScalar y1        = vertices[10];
540   const PetscScalar z1        = vertices[11];
541   const PetscScalar x2        = vertices[6];
542   const PetscScalar y2        = vertices[7];
543   const PetscScalar z2        = vertices[8];
544   const PetscScalar x3        = vertices[3];
545   const PetscScalar y3        = vertices[4];
546   const PetscScalar z3        = vertices[5];
547   const PetscScalar x4        = vertices[12];
548   const PetscScalar y4        = vertices[13];
549   const PetscScalar z4        = vertices[14];
550   const PetscScalar x5        = vertices[15];
551   const PetscScalar y5        = vertices[16];
552   const PetscScalar z5        = vertices[17];
553   const PetscScalar x6        = vertices[18];
554   const PetscScalar y6        = vertices[19];
555   const PetscScalar z6        = vertices[20];
556   const PetscScalar x7        = vertices[21];
557   const PetscScalar y7        = vertices[22];
558   const PetscScalar z7        = vertices[23];
559   const PetscScalar f_xy      = x2 - x1 - x3 + x0;
560   const PetscScalar g_xy      = y2 - y1 - y3 + y0;
561   const PetscScalar h_xy      = z2 - z1 - z3 + z0;
562   const PetscScalar f_yz      = x7 - x3 - x4 + x0;
563   const PetscScalar g_yz      = y7 - y3 - y4 + y0;
564   const PetscScalar h_yz      = z7 - z3 - z4 + z0;
565   const PetscScalar f_xz      = x5 - x1 - x4 + x0;
566   const PetscScalar g_xz      = y5 - y1 - y4 + y0;
567   const PetscScalar h_xz      = z5 - z1 - z4 + z0;
568   const PetscScalar f_xyz     = x6 - x0 + x1 - x2 + x3 + x4 - x5 - x7;
569   const PetscScalar g_xyz     = y6 - y0 + y1 - y2 + y3 + y4 - y5 - y7;
570   const PetscScalar h_xyz     = z6 - z0 + z1 - z2 + z3 + z4 - z5 - z7;
571   const PetscScalar *ref;
572   PetscErrorCode    ierr;
573 
574   PetscFunctionBegin;
575   ierr = VecGetArrayRead(Xref,  &ref);CHKERRQ(ierr);
576   {
577     const PetscScalar x       = ref[0];
578     const PetscScalar y       = ref[1];
579     const PetscScalar z       = ref[2];
580     const PetscInt    rows[3] = {0, 1, 2};
581     PetscScalar       values[9];
582 
583     values[0] = (x1 - x0 + f_xy*y + f_xz*z + f_xyz*y*z) / 2.0;
584     values[1] = (x3 - x0 + f_xy*x + f_yz*z + f_xyz*x*z) / 2.0;
585     values[2] = (x4 - x0 + f_yz*y + f_xz*x + f_xyz*x*y) / 2.0;
586     values[3] = (y1 - y0 + g_xy*y + g_xz*z + g_xyz*y*z) / 2.0;
587     values[4] = (y3 - y0 + g_xy*x + g_yz*z + g_xyz*x*z) / 2.0;
588     values[5] = (y4 - y0 + g_yz*y + g_xz*x + g_xyz*x*y) / 2.0;
589     values[6] = (z1 - z0 + h_xy*y + h_xz*z + h_xyz*y*z) / 2.0;
590     values[7] = (z3 - z0 + h_xy*x + h_yz*z + h_xyz*x*z) / 2.0;
591     values[8] = (z4 - z0 + h_yz*y + h_xz*x + h_xyz*x*y) / 2.0;
592 
593     ierr = MatSetValues(J, 3, rows, 3, rows, values, INSERT_VALUES);CHKERRQ(ierr);
594   }
595   ierr = PetscLogFlops(152);CHKERRQ(ierr);
596   ierr = VecRestoreArrayRead(Xref,  &ref);CHKERRQ(ierr);
597   ierr = MatAssemblyBegin(J, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
598   ierr = MatAssemblyEnd(J, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
599   PetscFunctionReturn(0);
600 }
601 
602 #undef __FUNCT__
603 #define __FUNCT__ "DMInterpolate_Hex_Private"
604 PETSC_STATIC_INLINE PetscErrorCode DMInterpolate_Hex_Private(DMInterpolationInfo ctx, DM dm, Vec xLocal, Vec v)
605 {
606   DM             dmCoord;
607   SNES           snes;
608   KSP            ksp;
609   PC             pc;
610   Vec            coordsLocal, r, ref, real;
611   Mat            J;
612   const PetscScalar *coords;
613   PetscScalar    *a;
614   PetscInt       p;
615   PetscErrorCode ierr;
616 
617   PetscFunctionBegin;
618   ierr = DMGetCoordinatesLocal(dm, &coordsLocal);CHKERRQ(ierr);
619   ierr = DMGetCoordinateDM(dm, &dmCoord);CHKERRQ(ierr);
620   ierr = SNESCreate(PETSC_COMM_SELF, &snes);CHKERRQ(ierr);
621   ierr = SNESSetOptionsPrefix(snes, "hex_interp_");CHKERRQ(ierr);
622   ierr = VecCreate(PETSC_COMM_SELF, &r);CHKERRQ(ierr);
623   ierr = VecSetSizes(r, 3, 3);CHKERRQ(ierr);
624   ierr = VecSetType(r,dm->vectype);CHKERRQ(ierr);
625   ierr = VecDuplicate(r, &ref);CHKERRQ(ierr);
626   ierr = VecDuplicate(r, &real);CHKERRQ(ierr);
627   ierr = MatCreate(PETSC_COMM_SELF, &J);CHKERRQ(ierr);
628   ierr = MatSetSizes(J, 3, 3, 3, 3);CHKERRQ(ierr);
629   ierr = MatSetType(J, MATSEQDENSE);CHKERRQ(ierr);
630   ierr = MatSetUp(J);CHKERRQ(ierr);
631   ierr = SNESSetFunction(snes, r, HexMap_Private, NULL);CHKERRQ(ierr);
632   ierr = SNESSetJacobian(snes, J, J, HexJacobian_Private, NULL);CHKERRQ(ierr);
633   ierr = SNESGetKSP(snes, &ksp);CHKERRQ(ierr);
634   ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr);
635   ierr = PCSetType(pc, PCLU);CHKERRQ(ierr);
636   ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
637 
638   ierr = VecGetArrayRead(ctx->coords, &coords);CHKERRQ(ierr);
639   ierr = VecGetArray(v, &a);CHKERRQ(ierr);
640   for (p = 0; p < ctx->n; ++p) {
641     PetscScalar *x = NULL, *vertices = NULL;
642     PetscScalar *xi;
643     PetscReal    xir[3];
644     PetscInt     c = ctx->cells[p], comp, coordSize, xSize;
645 
646     /* Can make this do all points at once */
647     ierr = DMPlexVecGetClosure(dmCoord, NULL, coordsLocal, c, &coordSize, &vertices);CHKERRQ(ierr);
648     if (8*3 != coordSize) SETERRQ2(ctx->comm, PETSC_ERR_ARG_SIZ, "Invalid closure size %d should be %d", coordSize, 8*3);
649     ierr = DMPlexVecGetClosure(dm, NULL, xLocal, c, &xSize, &x);CHKERRQ(ierr);
650     if (8*ctx->dof != xSize) SETERRQ2(ctx->comm, PETSC_ERR_ARG_SIZ, "Invalid closure size %d should be %d", xSize, 8*ctx->dof);
651     ierr   = SNESSetFunction(snes, NULL, NULL, (void*) vertices);CHKERRQ(ierr);
652     ierr   = SNESSetJacobian(snes, NULL, NULL, NULL, (void*) vertices);CHKERRQ(ierr);
653     ierr   = VecGetArray(real, &xi);CHKERRQ(ierr);
654     xi[0]  = coords[p*ctx->dim+0];
655     xi[1]  = coords[p*ctx->dim+1];
656     xi[2]  = coords[p*ctx->dim+2];
657     ierr   = VecRestoreArray(real, &xi);CHKERRQ(ierr);
658     ierr   = SNESSolve(snes, real, ref);CHKERRQ(ierr);
659     ierr   = VecGetArray(ref, &xi);CHKERRQ(ierr);
660     xir[0] = PetscRealPart(xi[0]);
661     xir[1] = PetscRealPart(xi[1]);
662     xir[2] = PetscRealPart(xi[2]);
663     for (comp = 0; comp < ctx->dof; ++comp) {
664       a[p*ctx->dof+comp] =
665         x[0*ctx->dof+comp]*(1-xir[0])*(1-xir[1])*(1-xir[2]) +
666         x[3*ctx->dof+comp]*    xir[0]*(1-xir[1])*(1-xir[2]) +
667         x[2*ctx->dof+comp]*    xir[0]*    xir[1]*(1-xir[2]) +
668         x[1*ctx->dof+comp]*(1-xir[0])*    xir[1]*(1-xir[2]) +
669         x[4*ctx->dof+comp]*(1-xir[0])*(1-xir[1])*   xir[2] +
670         x[5*ctx->dof+comp]*    xir[0]*(1-xir[1])*   xir[2] +
671         x[6*ctx->dof+comp]*    xir[0]*    xir[1]*   xir[2] +
672         x[7*ctx->dof+comp]*(1-xir[0])*    xir[1]*   xir[2];
673     }
674     ierr = VecRestoreArray(ref, &xi);CHKERRQ(ierr);
675     ierr = DMPlexVecRestoreClosure(dmCoord, NULL, coordsLocal, c, &coordSize, &vertices);CHKERRQ(ierr);
676     ierr = DMPlexVecRestoreClosure(dm, NULL, xLocal, c, &xSize, &x);CHKERRQ(ierr);
677   }
678   ierr = VecRestoreArray(v, &a);CHKERRQ(ierr);
679   ierr = VecRestoreArrayRead(ctx->coords, &coords);CHKERRQ(ierr);
680 
681   ierr = SNESDestroy(&snes);CHKERRQ(ierr);
682   ierr = VecDestroy(&r);CHKERRQ(ierr);
683   ierr = VecDestroy(&ref);CHKERRQ(ierr);
684   ierr = VecDestroy(&real);CHKERRQ(ierr);
685   ierr = MatDestroy(&J);CHKERRQ(ierr);
686   PetscFunctionReturn(0);
687 }
688 
689 #undef __FUNCT__
690 #define __FUNCT__ "DMInterpolationEvaluate"
691 /*
692   Input Parameters:
693 + ctx - The DMInterpolationInfo context
694 . dm  - The DM
695 - x   - The local vector containing the field to be interpolated
696 
697   Output Parameters:
698 . v   - The vector containing the interpolated values
699 */
700 PetscErrorCode DMInterpolationEvaluate(DMInterpolationInfo ctx, DM dm, Vec x, Vec v)
701 {
702   PetscInt       dim, coneSize, n;
703   PetscErrorCode ierr;
704 
705   PetscFunctionBegin;
706   PetscValidHeaderSpecific(dm, DM_CLASSID, 2);
707   PetscValidHeaderSpecific(x, VEC_CLASSID, 3);
708   PetscValidHeaderSpecific(v, VEC_CLASSID, 4);
709   ierr = VecGetLocalSize(v, &n);CHKERRQ(ierr);
710   if (n != ctx->n*ctx->dof) SETERRQ2(ctx->comm, PETSC_ERR_ARG_SIZ, "Invalid input vector size %d should be %d", n, ctx->n*ctx->dof);
711   if (n) {
712     ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
713     ierr = DMPlexGetConeSize(dm, ctx->cells[0], &coneSize);CHKERRQ(ierr);
714     if (dim == 2) {
715       if (coneSize == 3) {
716         ierr = DMInterpolate_Triangle_Private(ctx, dm, x, v);CHKERRQ(ierr);
717       } else if (coneSize == 4) {
718         ierr = DMInterpolate_Quad_Private(ctx, dm, x, v);CHKERRQ(ierr);
719       } else SETERRQ1(ctx->comm, PETSC_ERR_ARG_OUTOFRANGE, "Unsupported dimension %d for point interpolation", dim);
720     } else if (dim == 3) {
721       if (coneSize == 4) {
722         ierr = DMInterpolate_Tetrahedron_Private(ctx, dm, x, v);CHKERRQ(ierr);
723       } else {
724         ierr = DMInterpolate_Hex_Private(ctx, dm, x, v);CHKERRQ(ierr);
725       }
726     } else SETERRQ1(ctx->comm, PETSC_ERR_ARG_OUTOFRANGE, "Unsupported dimension %d for point interpolation", dim);
727   }
728   PetscFunctionReturn(0);
729 }
730 
731 #undef __FUNCT__
732 #define __FUNCT__ "DMInterpolationDestroy"
733 PetscErrorCode DMInterpolationDestroy(DMInterpolationInfo *ctx)
734 {
735   PetscErrorCode ierr;
736 
737   PetscFunctionBegin;
738   PetscValidPointer(ctx, 2);
739   ierr = VecDestroy(&(*ctx)->coords);CHKERRQ(ierr);
740   ierr = PetscFree((*ctx)->points);CHKERRQ(ierr);
741   ierr = PetscFree((*ctx)->cells);CHKERRQ(ierr);
742   ierr = PetscFree(*ctx);CHKERRQ(ierr);
743   *ctx = NULL;
744   PetscFunctionReturn(0);
745 }
746 
747 #undef __FUNCT__
748 #define __FUNCT__ "SNESMonitorFields"
749 /*@C
750   SNESMonitorFields - Monitors the residual for each field separately
751 
752   Collective on SNES
753 
754   Input Parameters:
755 + snes   - the SNES context
756 . its    - iteration number
757 . fgnorm - 2-norm of residual
758 - dummy  - PetscViewer of type ASCII
759 
760   Notes:
761   This routine prints the residual norm at each iteration.
762 
763   Level: intermediate
764 
765 .keywords: SNES, nonlinear, default, monitor, norm
766 .seealso: SNESMonitorSet(), SNESMonitorDefault()
767 @*/
768 PetscErrorCode SNESMonitorFields(SNES snes, PetscInt its, PetscReal fgnorm, void *dummy)
769 {
770   PetscViewer        viewer = (PetscViewer) dummy;
771   Vec                res;
772   DM                 dm;
773   PetscSection       s;
774   const PetscScalar *r;
775   PetscReal         *lnorms, *norms;
776   PetscInt           numFields, f, pStart, pEnd, p;
777   PetscErrorCode     ierr;
778 
779   PetscFunctionBegin;
780   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,4);
781   ierr = SNESGetFunction(snes, &res, 0, 0);CHKERRQ(ierr);
782   ierr = SNESGetDM(snes, &dm);CHKERRQ(ierr);
783   ierr = DMGetDefaultSection(dm, &s);CHKERRQ(ierr);
784   ierr = PetscSectionGetNumFields(s, &numFields);CHKERRQ(ierr);
785   ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
786   ierr = PetscCalloc2(numFields, &lnorms, numFields, &norms);CHKERRQ(ierr);
787   ierr = VecGetArrayRead(res, &r);CHKERRQ(ierr);
788   for (p = pStart; p < pEnd; ++p) {
789     for (f = 0; f < numFields; ++f) {
790       PetscInt fdof, foff, d;
791 
792       ierr = PetscSectionGetFieldDof(s, p, f, &fdof);CHKERRQ(ierr);
793       ierr = PetscSectionGetFieldOffset(s, p, f, &foff);CHKERRQ(ierr);
794       for (d = 0; d < fdof; ++d) lnorms[f] += PetscRealPart(PetscSqr(r[foff+d]));
795     }
796   }
797   ierr = VecRestoreArrayRead(res, &r);CHKERRQ(ierr);
798   ierr = MPIU_Allreduce(lnorms, norms, numFields, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject) dm));CHKERRQ(ierr);
799   ierr = PetscViewerASCIIAddTab(viewer, ((PetscObject) snes)->tablevel);CHKERRQ(ierr);
800   ierr = PetscViewerASCIIPrintf(viewer, "%3D SNES Function norm %14.12e [", its, (double) fgnorm);CHKERRQ(ierr);
801   for (f = 0; f < numFields; ++f) {
802     if (f > 0) {ierr = PetscViewerASCIIPrintf(viewer, ", ");CHKERRQ(ierr);}
803     ierr = PetscViewerASCIIPrintf(viewer, "%14.12e", (double) PetscSqrtReal(norms[f]));CHKERRQ(ierr);
804   }
805   ierr = PetscViewerASCIIPrintf(viewer, "]\n");CHKERRQ(ierr);
806   ierr = PetscViewerASCIISubtractTab(viewer, ((PetscObject) snes)->tablevel);CHKERRQ(ierr);
807   ierr = PetscFree2(lnorms, norms);CHKERRQ(ierr);
808   PetscFunctionReturn(0);
809 }
810 
811 /********************* Residual Computation **************************/
812 
813 #undef __FUNCT__
814 #define __FUNCT__ "DMPlexSNESGetGeometryFEM"
815 /*@
816   DMPlexSNESGetGeometryFEM - Return precomputed geometric data
817 
818   Input Parameter:
819 . dm - The DM
820 
821   Output Parameters:
822 . cellgeom - The values precomputed from cell geometry
823 
824   Level: developer
825 
826 .seealso: DMPlexSNESSetFunctionLocal()
827 @*/
828 PetscErrorCode DMPlexSNESGetGeometryFEM(DM dm, Vec *cellgeom)
829 {
830   DMSNES         dmsnes;
831   PetscObject    obj;
832   PetscErrorCode ierr;
833 
834   PetscFunctionBegin;
835   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
836   ierr = DMGetDMSNES(dm, &dmsnes);CHKERRQ(ierr);
837   ierr = PetscObjectQuery((PetscObject) dmsnes, "DMPlexSNES_cellgeom_fem", &obj);CHKERRQ(ierr);
838   if (!obj) {
839     Vec cellgeom;
840 
841     ierr = DMPlexComputeGeometryFEM(dm, &cellgeom);CHKERRQ(ierr);
842     ierr = PetscObjectCompose((PetscObject) dmsnes, "DMPlexSNES_cellgeom_fem", (PetscObject) cellgeom);CHKERRQ(ierr);
843     ierr = VecDestroy(&cellgeom);CHKERRQ(ierr);
844   }
845   if (cellgeom) {PetscValidPointer(cellgeom, 3); ierr = PetscObjectQuery((PetscObject) dmsnes, "DMPlexSNES_cellgeom_fem", (PetscObject *) cellgeom);CHKERRQ(ierr);}
846   PetscFunctionReturn(0);
847 }
848 
849 #undef __FUNCT__
850 #define __FUNCT__ "DMPlexSNESGetGeometryFVM"
851 /*@
852   DMPlexSNESGetGeometryFVM - Return precomputed geometric data
853 
854   Input Parameter:
855 . dm - The DM
856 
857   Output Parameters:
858 + facegeom - The values precomputed from face geometry
859 . cellgeom - The values precomputed from cell geometry
860 - minRadius - The minimum radius over the mesh of an inscribed sphere in a cell
861 
862   Level: developer
863 
864 .seealso: DMPlexTSSetRHSFunctionLocal()
865 @*/
866 PetscErrorCode DMPlexSNESGetGeometryFVM(DM dm, Vec *facegeom, Vec *cellgeom, PetscReal *minRadius)
867 {
868   DMSNES         dmsnes;
869   PetscObject    obj;
870   PetscErrorCode ierr;
871 
872   PetscFunctionBegin;
873   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
874   ierr = DMGetDMSNES(dm, &dmsnes);CHKERRQ(ierr);
875   ierr = PetscObjectQuery((PetscObject) dmsnes, "DMPlexSNES_facegeom_fvm", &obj);CHKERRQ(ierr);
876   if (!obj) {
877     Vec cellgeom, facegeom;
878 
879     ierr = DMPlexComputeGeometryFVM(dm, &cellgeom, &facegeom);CHKERRQ(ierr);
880     ierr = PetscObjectCompose((PetscObject) dmsnes, "DMPlexSNES_facegeom_fvm", (PetscObject) facegeom);CHKERRQ(ierr);
881     ierr = PetscObjectCompose((PetscObject) dmsnes, "DMPlexSNES_cellgeom_fvm", (PetscObject) cellgeom);CHKERRQ(ierr);
882     ierr = VecDestroy(&facegeom);CHKERRQ(ierr);
883     ierr = VecDestroy(&cellgeom);CHKERRQ(ierr);
884   }
885   if (facegeom) {PetscValidPointer(facegeom, 2); ierr = PetscObjectQuery((PetscObject) dmsnes, "DMPlexSNES_facegeom_fvm", (PetscObject *) facegeom);CHKERRQ(ierr);}
886   if (cellgeom) {PetscValidPointer(cellgeom, 3); ierr = PetscObjectQuery((PetscObject) dmsnes, "DMPlexSNES_cellgeom_fvm", (PetscObject *) cellgeom);CHKERRQ(ierr);}
887   if (minRadius) {ierr = DMPlexGetMinRadius(dm, minRadius);CHKERRQ(ierr);}
888   PetscFunctionReturn(0);
889 }
890 
891 #undef __FUNCT__
892 #define __FUNCT__ "DMPlexSNESGetGradientDM"
893 /*@
894   DMPlexSNESGetGradientDM - Return gradient data layout
895 
896   Input Parameters:
897 + dm - The DM
898 - fv - The PetscFV
899 
900   Output Parameter:
901 . dmGrad - The layout for gradient values
902 
903   Level: developer
904 
905 .seealso: DMPlexSNESGetGeometryFVM()
906 @*/
907 PetscErrorCode DMPlexSNESGetGradientDM(DM dm, PetscFV fv, DM *dmGrad)
908 {
909   DMSNES         dmsnes;
910   PetscObject    obj;
911   PetscBool      computeGradients;
912   PetscErrorCode ierr;
913 
914   PetscFunctionBegin;
915   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
916   PetscValidHeaderSpecific(fv,PETSCFV_CLASSID,2);
917   PetscValidPointer(dmGrad,3);
918   ierr = PetscFVGetComputeGradients(fv, &computeGradients);CHKERRQ(ierr);
919   if (!computeGradients) {*dmGrad = NULL; PetscFunctionReturn(0);}
920   ierr = DMGetDMSNES(dm, &dmsnes);CHKERRQ(ierr);
921   ierr = PetscObjectQuery((PetscObject) dmsnes, "DMPlexSNES_dmgrad_fvm", &obj);CHKERRQ(ierr);
922   if (!obj) {
923     DM  dmGrad;
924     Vec faceGeometry, cellGeometry;
925 
926     ierr = DMPlexSNESGetGeometryFVM(dm, &faceGeometry, &cellGeometry, NULL);CHKERRQ(ierr);
927     ierr = DMPlexComputeGradientFVM(dm, fv, faceGeometry, cellGeometry, &dmGrad);CHKERRQ(ierr);
928     ierr = PetscObjectCompose((PetscObject) dmsnes, "DMPlexSNES_dmgrad_fvm", (PetscObject) dmGrad);CHKERRQ(ierr);
929     ierr = DMDestroy(&dmGrad);CHKERRQ(ierr);
930   }
931   ierr = PetscObjectQuery((PetscObject) dmsnes, "DMPlexSNES_dmgrad_fvm", (PetscObject *) dmGrad);CHKERRQ(ierr);
932   PetscFunctionReturn(0);
933 }
934 
935 #undef __FUNCT__
936 #define __FUNCT__ "DMPlexGetCellFields"
937 /*@C
938   DMPlexGetCellFields - Retrieve the field values values for a chunk of cells
939 
940   Input Parameters:
941 + dm     - The DM
942 . cStart - The first cell to include
943 . cEnd   - The first cell to exclude
944 . locX   - A local vector with the solution fields
945 . locX_t - A local vector with solution field time derivatives, or NULL
946 - locA   - A local vector with auxiliary fields, or NULL
947 
948   Output Parameters:
949 + u   - The field coefficients
950 . u_t - The fields derivative coefficients
951 - a   - The auxiliary field coefficients
952 
953   Level: developer
954 
955 .seealso: DMPlexGetFaceFields()
956 @*/
957 PetscErrorCode DMPlexGetCellFields(DM dm, PetscInt cStart, PetscInt cEnd, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a)
958 {
959   DM             dmAux;
960   PetscSection   section, sectionAux;
961   PetscDS        prob;
962   PetscInt       numCells = cEnd - cStart, totDim, totDimAux, c;
963   PetscErrorCode ierr;
964 
965   PetscFunctionBegin;
966   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
967   PetscValidHeaderSpecific(locX, VEC_CLASSID, 4);
968   if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 5);}
969   if (locA)   {PetscValidHeaderSpecific(locA, VEC_CLASSID, 6);}
970   PetscValidPointer(u, 7);
971   PetscValidPointer(u_t, 8);
972   PetscValidPointer(a, 9);
973   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
974   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
975   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
976   if (locA) {
977     PetscDS probAux;
978 
979     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
980     ierr = DMGetDefaultSection(dmAux, &sectionAux);CHKERRQ(ierr);
981     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
982     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
983   }
984   ierr = DMGetWorkArray(dm, numCells*totDim, PETSC_SCALAR, u);CHKERRQ(ierr);
985   if (locX_t) {ierr = DMGetWorkArray(dm, numCells*totDim, PETSC_SCALAR, u_t);CHKERRQ(ierr);} else {*u_t = NULL;}
986   if (locA)   {ierr = DMGetWorkArray(dm, numCells*totDimAux, PETSC_SCALAR, a);CHKERRQ(ierr);} else {*a = NULL;}
987   for (c = cStart; c < cEnd; ++c) {
988     PetscScalar *x = NULL, *x_t = NULL, *ul = *u, *ul_t = *u_t, *al = *a;
989     PetscInt     i;
990 
991     ierr = DMPlexVecGetClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr);
992     for (i = 0; i < totDim; ++i) ul[(c-cStart)*totDim+i] = x[i];
993     ierr = DMPlexVecRestoreClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr);
994     if (locX_t) {
995       ierr = DMPlexVecGetClosure(dm, section, locX_t, c, NULL, &x_t);CHKERRQ(ierr);
996       for (i = 0; i < totDim; ++i) ul_t[(c-cStart)*totDim+i] = x_t[i];
997       ierr = DMPlexVecRestoreClosure(dm, section, locX_t, c, NULL, &x_t);CHKERRQ(ierr);
998     }
999     if (locA) {
1000       ierr = DMPlexVecGetClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr);
1001       for (i = 0; i < totDimAux; ++i) al[(c-cStart)*totDimAux+i] = x[i];
1002       ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr);
1003     }
1004   }
1005   PetscFunctionReturn(0);
1006 }
1007 
1008 #undef __FUNCT__
1009 #define __FUNCT__ "DMPlexRestoreCellFields"
1010 /*@C
1011   DMPlexRestoreCellFields - Restore the field values values for a chunk of cells
1012 
1013   Input Parameters:
1014 + dm     - The DM
1015 . cStart - The first cell to include
1016 . cEnd   - The first cell to exclude
1017 . locX   - A local vector with the solution fields
1018 . locX_t - A local vector with solution field time derivatives, or NULL
1019 - locA   - A local vector with auxiliary fields, or NULL
1020 
1021   Output Parameters:
1022 + u   - The field coefficients
1023 . u_t - The fields derivative coefficients
1024 - a   - The auxiliary field coefficients
1025 
1026   Level: developer
1027 
1028 .seealso: DMPlexGetFaceFields()
1029 @*/
1030 PetscErrorCode DMPlexRestoreCellFields(DM dm, PetscInt cStart, PetscInt cEnd, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a)
1031 {
1032   PetscErrorCode ierr;
1033 
1034   PetscFunctionBegin;
1035   ierr = DMRestoreWorkArray(dm, 0, PETSC_SCALAR, u);CHKERRQ(ierr);
1036   if (*u_t) {ierr = DMRestoreWorkArray(dm, 0, PETSC_SCALAR, u_t);CHKERRQ(ierr);}
1037   if (*a)   {ierr = DMRestoreWorkArray(dm, 0, PETSC_SCALAR, a);CHKERRQ(ierr);}
1038   PetscFunctionReturn(0);
1039 }
1040 
1041 #undef __FUNCT__
1042 #define __FUNCT__ "DMPlexGetFaceFields"
1043 /*@C
1044   DMPlexGetFaceFields - Retrieve the field values values for a chunk of faces
1045 
1046   Input Parameters:
1047 + dm     - The DM
1048 . fStart - The first face to include
1049 . fEnd   - The first face to exclude
1050 . locX   - A local vector with the solution fields
1051 . locX_t - A local vector with solution field time derivatives, or NULL
1052 . faceGeometry - A local vector with face geometry
1053 . cellGeometry - A local vector with cell geometry
1054 - locaGrad - A local vector with field gradients, or NULL
1055 
1056   Output Parameters:
1057 + uL - The field values at the left side of the face
1058 - uR - The field values at the right side of the face
1059 
1060   Level: developer
1061 
1062 .seealso: DMPlexGetCellFields()
1063 @*/
1064 PetscErrorCode DMPlexGetFaceFields(DM dm, PetscInt fStart, PetscInt fEnd, Vec locX, Vec locX_t, Vec faceGeometry, Vec cellGeometry, Vec locGrad, PetscScalar **uL, PetscScalar **uR)
1065 {
1066   DM                 dmFace, dmCell, dmGrad = NULL;
1067   PetscSection       section;
1068   PetscDS            prob;
1069   DMLabel            ghostLabel;
1070   const PetscScalar *facegeom, *cellgeom, *x, *lgrad;
1071   PetscBool         *isFE;
1072   PetscInt           dim, Nf, f, Nc, numFaces = fEnd - fStart, iface, face;
1073   PetscErrorCode     ierr;
1074 
1075   PetscFunctionBegin;
1076   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1077   PetscValidHeaderSpecific(locX, VEC_CLASSID, 4);
1078   if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 5);}
1079   PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 6);
1080   PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 7);
1081   if (locGrad) {PetscValidHeaderSpecific(locGrad, VEC_CLASSID, 8);}
1082   PetscValidPointer(uL, 9);
1083   PetscValidPointer(uR, 10);
1084   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1085   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1086   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
1087   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
1088   ierr = PetscDSGetTotalComponents(prob, &Nc);CHKERRQ(ierr);
1089   ierr = PetscMalloc1(Nf, &isFE);CHKERRQ(ierr);
1090   for (f = 0; f < Nf; ++f) {
1091     PetscObject  obj;
1092     PetscClassId id;
1093 
1094     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
1095     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1096     if (id == PETSCFE_CLASSID)      {isFE[f] = PETSC_TRUE;}
1097     else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
1098     else                            {isFE[f] = PETSC_FALSE;}
1099   }
1100   ierr = DMPlexGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
1101   ierr = VecGetArrayRead(locX, &x);CHKERRQ(ierr);
1102   ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
1103   ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
1104   ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
1105   ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
1106   if (locGrad) {
1107     ierr = VecGetDM(locGrad, &dmGrad);CHKERRQ(ierr);
1108     ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
1109   }
1110   ierr = DMGetWorkArray(dm, numFaces*Nc, PETSC_SCALAR, uL);CHKERRQ(ierr);
1111   ierr = DMGetWorkArray(dm, numFaces*Nc, PETSC_SCALAR, uR);CHKERRQ(ierr);
1112   /* Right now just eat the extra work for FE (could make a cell loop) */
1113   for (face = fStart, iface = 0; face < fEnd; ++face) {
1114     const PetscInt        *cells;
1115     const PetscFVFaceGeom *fg;
1116     const PetscFVCellGeom *cgL, *cgR;
1117     const PetscScalar     *xL, *xR, *gL, *gR;
1118     PetscScalar           *uLl = *uL, *uRl = *uR;
1119     PetscInt               ghost, nsupp;
1120 
1121     ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
1122     ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr);
1123     if (ghost >= 0) continue;
1124     ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
1125     ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
1126     ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr);
1127     ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr);
1128     for (f = 0; f < Nf; ++f) {
1129       PetscInt off;
1130 
1131       ierr = PetscDSGetComponentOffset(prob, f, &off);CHKERRQ(ierr);
1132       if (isFE[f]) {
1133         const PetscInt *cone;
1134         PetscInt        comp, coneSize, faceLocL, faceLocR, ldof, rdof, d;
1135 
1136         xL = xR = NULL;
1137         ierr = DMPlexVecGetClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL);CHKERRQ(ierr);
1138         ierr = DMPlexVecGetClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR);CHKERRQ(ierr);
1139         ierr = DMPlexGetCone(dm, cells[0], &cone);CHKERRQ(ierr);
1140         ierr = DMPlexGetConeSize(dm, cells[0], &coneSize);CHKERRQ(ierr);
1141         for (faceLocL = 0; faceLocL < coneSize; ++faceLocL) if (cone[faceLocL] == face) break;
1142         if (faceLocL == coneSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Could not find face %d in cone of cell %d", face, cells[0]);
1143         ierr = DMPlexGetCone(dm, cells[1], &cone);CHKERRQ(ierr);
1144         ierr = DMPlexGetConeSize(dm, cells[1], &coneSize);CHKERRQ(ierr);
1145         for (faceLocR = 0; faceLocR < coneSize; ++faceLocR) if (cone[faceLocR] == face) break;
1146         if (faceLocR == coneSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Could not find face %d in cone of cell %d", face, cells[1]);
1147         /* Check that FEM field has values in the right cell (sometimes its an FV ghost cell) */
1148         ierr = EvaluateFaceFields(prob, f, faceLocL, xL, &uLl[iface*Nc+off]);CHKERRQ(ierr);
1149         if (rdof == ldof) {ierr = EvaluateFaceFields(prob, f, faceLocR, xR, &uRl[iface*Nc+off]);CHKERRQ(ierr);}
1150         else              {ierr = PetscSectionGetFieldComponents(section, f, &comp);CHKERRQ(ierr); for(d = 0; d < comp; ++d) uRl[iface*Nc+off+d] = uLl[iface*Nc+off+d];}
1151         ierr = DMPlexVecRestoreClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL);CHKERRQ(ierr);
1152         ierr = DMPlexVecRestoreClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR);CHKERRQ(ierr);
1153       } else {
1154         PetscFV  fv;
1155         PetscInt numComp, c;
1156 
1157         ierr = PetscDSGetDiscretization(prob, f, (PetscObject *) &fv);CHKERRQ(ierr);
1158         ierr = PetscFVGetNumComponents(fv, &numComp);CHKERRQ(ierr);
1159         if (nsupp > 2) {
1160           for (f = 0; f < Nf; ++f) {
1161             PetscInt off;
1162 
1163             ierr = PetscDSGetComponentOffset(prob, f, &off);CHKERRQ(ierr);
1164             ierr = PetscFVGetNumComponents(fv, &numComp);CHKERRQ(ierr);
1165             for (c = 0; c < numComp; ++c) {
1166               uLl[iface*Nc+off+c] = 0.;
1167               uRl[iface*Nc+off+c] = 0.;
1168             }
1169           }
1170           continue;
1171         }
1172         ierr = DMPlexPointLocalFieldRead(dm, cells[0], f, x, &xL);CHKERRQ(ierr);
1173         ierr = DMPlexPointLocalFieldRead(dm, cells[1], f, x, &xR);CHKERRQ(ierr);
1174         if (dmGrad) {
1175           PetscReal dxL[3], dxR[3];
1176 
1177           ierr = DMPlexPointLocalRead(dmGrad, cells[0], lgrad, &gL);CHKERRQ(ierr);
1178           ierr = DMPlexPointLocalRead(dmGrad, cells[1], lgrad, &gR);CHKERRQ(ierr);
1179           DMPlex_WaxpyD_Internal(dim, -1, cgL->centroid, fg->centroid, dxL);
1180           DMPlex_WaxpyD_Internal(dim, -1, cgR->centroid, fg->centroid, dxR);
1181           for (c = 0; c < numComp; ++c) {
1182             uLl[iface*Nc+off+c] = xL[c] + DMPlex_DotD_Internal(dim, &gL[c*dim], dxL);
1183             uRl[iface*Nc+off+c] = xR[c] + DMPlex_DotD_Internal(dim, &gR[c*dim], dxR);
1184           }
1185         } else {
1186           for (c = 0; c < numComp; ++c) {
1187             uLl[iface*Nc+off+c] = xL[c];
1188             uRl[iface*Nc+off+c] = xR[c];
1189           }
1190         }
1191       }
1192     }
1193     ++iface;
1194   }
1195   ierr = VecRestoreArrayRead(locX, &x);CHKERRQ(ierr);
1196   ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
1197   ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
1198   if (locGrad) {
1199     ierr = VecRestoreArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
1200   }
1201   ierr = PetscFree(isFE);CHKERRQ(ierr);
1202   PetscFunctionReturn(0);
1203 }
1204 
1205 #undef __FUNCT__
1206 #define __FUNCT__ "DMPlexRestoreFaceFields"
1207 /*@C
1208   DMPlexRestoreFaceFields - Restore the field values values for a chunk of faces
1209 
1210   Input Parameters:
1211 + dm     - The DM
1212 . fStart - The first face to include
1213 . fEnd   - The first face to exclude
1214 . locX   - A local vector with the solution fields
1215 . locX_t - A local vector with solution field time derivatives, or NULL
1216 . faceGeometry - A local vector with face geometry
1217 . cellGeometry - A local vector with cell geometry
1218 - locaGrad - A local vector with field gradients, or NULL
1219 
1220   Output Parameters:
1221 + uL - The field values at the left side of the face
1222 - uR - The field values at the right side of the face
1223 
1224   Level: developer
1225 
1226 .seealso: DMPlexGetFaceFields()
1227 @*/
1228 PetscErrorCode DMPlexRestoreFaceFields(DM dm, PetscInt fStart, PetscInt fEnd, Vec locX, Vec locX_t, Vec faceGeometry, Vec cellGeometry, Vec locGrad, PetscScalar **uL, PetscScalar **uR)
1229 {
1230   PetscErrorCode ierr;
1231 
1232   PetscFunctionBegin;
1233   ierr = DMRestoreWorkArray(dm, 0, PETSC_SCALAR, uL);CHKERRQ(ierr);
1234   ierr = DMRestoreWorkArray(dm, 0, PETSC_SCALAR, uR);CHKERRQ(ierr);
1235   PetscFunctionReturn(0);
1236 }
1237 
1238 #undef __FUNCT__
1239 #define __FUNCT__ "DMPlexGetFaceGeometry"
1240 /*@C
1241   DMPlexGetFaceGeometry - Retrieve the geometric values for a chunk of faces
1242 
1243   Input Parameters:
1244 + dm     - The DM
1245 . fStart - The first face to include
1246 . fEnd   - The first face to exclude
1247 . faceGeometry - A local vector with face geometry
1248 - cellGeometry - A local vector with cell geometry
1249 
1250   Output Parameters:
1251 + fgeom - The extract the face centroid and normal
1252 - vol   - The cell volume
1253 
1254   Level: developer
1255 
1256 .seealso: DMPlexGetCellFields()
1257 @*/
1258 PetscErrorCode DMPlexGetFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscFVFaceGeom **fgeom, PetscReal **vol)
1259 {
1260   DM                 dmFace, dmCell;
1261   DMLabel            ghostLabel;
1262   const PetscScalar *facegeom, *cellgeom;
1263   PetscInt           dim, numFaces = fEnd - fStart, iface, face;
1264   PetscErrorCode     ierr;
1265 
1266   PetscFunctionBegin;
1267   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1268   PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 4);
1269   PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 5);
1270   PetscValidPointer(fgeom, 6);
1271   PetscValidPointer(vol, 7);
1272   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1273   ierr = DMPlexGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
1274   ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
1275   ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
1276   ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
1277   ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
1278   ierr = PetscMalloc1(numFaces, fgeom);CHKERRQ(ierr);
1279   ierr = DMGetWorkArray(dm, numFaces*2, PETSC_SCALAR, vol);CHKERRQ(ierr);
1280   for (face = fStart, iface = 0; face < fEnd; ++face) {
1281     const PetscInt        *cells;
1282     const PetscFVFaceGeom *fg;
1283     const PetscFVCellGeom *cgL, *cgR;
1284     PetscFVFaceGeom       *fgeoml = *fgeom;
1285     PetscReal             *voll   = *vol;
1286     PetscInt               ghost, d;
1287 
1288     ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
1289     if (ghost >= 0) continue;
1290     ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
1291     ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
1292     ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr);
1293     ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr);
1294     for (d = 0; d < dim; ++d) {
1295       fgeoml[iface].centroid[d] = fg->centroid[d];
1296       fgeoml[iface].normal[d]   = fg->normal[d];
1297     }
1298     voll[iface*2+0] = cgL->volume;
1299     voll[iface*2+1] = cgR->volume;
1300     ++iface;
1301   }
1302   ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
1303   ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
1304   PetscFunctionReturn(0);
1305 }
1306 
1307 #undef __FUNCT__
1308 #define __FUNCT__ "DMPlexRestoreFaceGeometry"
1309 /*@C
1310   DMPlexRestoreFaceGeometry - Restore the field values values for a chunk of faces
1311 
1312   Input Parameters:
1313 + dm     - The DM
1314 . fStart - The first face to include
1315 . fEnd   - The first face to exclude
1316 . faceGeometry - A local vector with face geometry
1317 - cellGeometry - A local vector with cell geometry
1318 
1319   Output Parameters:
1320 + fgeom - The extract the face centroid and normal
1321 - vol   - The cell volume
1322 
1323   Level: developer
1324 
1325 .seealso: DMPlexGetFaceFields()
1326 @*/
1327 PetscErrorCode DMPlexRestoreFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscFVFaceGeom **fgeom, PetscReal **vol)
1328 {
1329   PetscErrorCode ierr;
1330 
1331   PetscFunctionBegin;
1332   ierr = PetscFree(*fgeom);CHKERRQ(ierr);
1333   ierr = DMRestoreWorkArray(dm, 0, PETSC_REAL, vol);CHKERRQ(ierr);
1334   PetscFunctionReturn(0);
1335 }
1336 
1337 #undef __FUNCT__
1338 #define __FUNCT__ "DMPlexApplyLimiter_Internal"
1339 static PetscErrorCode DMPlexApplyLimiter_Internal (DM dm, DM dmCell, PetscLimiter lim, PetscInt dim, PetscInt totDim, PetscInt cell, PetscInt face, PetscInt fStart, PetscInt fEnd, PetscReal *cellPhi, const PetscScalar *x,
1340                                                    const PetscScalar *cellgeom, const PetscFVCellGeom *cg, const PetscScalar *cx, const PetscScalar *cgrad)
1341 {
1342   const PetscInt        *children;
1343   PetscInt               numChildren;
1344   PetscErrorCode         ierr;
1345 
1346   PetscFunctionBegin;
1347   ierr = DMPlexGetTreeChildren(dm,face,&numChildren,&children);CHKERRQ(ierr);
1348   if (numChildren) {
1349     PetscInt c;
1350 
1351     for (c = 0; c < numChildren; c++) {
1352       PetscInt childFace = children[c];
1353 
1354       if (childFace >= fStart && childFace < fEnd) {
1355         ierr = DMPlexApplyLimiter_Internal(dm,dmCell,lim,dim,totDim,cell,childFace,fStart,fEnd,cellPhi,x,cellgeom,cg,cx,cgrad);CHKERRQ(ierr);
1356       }
1357     }
1358   }
1359   else {
1360     const PetscScalar     *ncx;
1361     const PetscFVCellGeom *ncg;
1362     const PetscInt        *fcells;
1363     PetscInt               ncell, d;
1364     PetscReal              v[3];
1365 
1366     ierr  = DMPlexGetSupport(dm, face, &fcells);CHKERRQ(ierr);
1367     ncell = cell == fcells[0] ? fcells[1] : fcells[0];
1368     ierr  = DMPlexPointLocalRead(dm, ncell, x, &ncx);CHKERRQ(ierr);
1369     ierr  = DMPlexPointLocalRead(dmCell, ncell, cellgeom, &ncg);CHKERRQ(ierr);
1370     DMPlex_WaxpyD_Internal(dim, -1, cg->centroid, ncg->centroid, v);
1371     for (d = 0; d < totDim; ++d) {
1372       /* We use the symmetric slope limited form of Berger, Aftosmis, and Murman 2005 */
1373       PetscReal phi, flim = 0.5 * PetscRealPart(ncx[d] - cx[d]) / DMPlex_DotD_Internal(dim, &cgrad[d*dim], v);
1374 
1375       ierr = PetscLimiterLimit(lim, flim, &phi);CHKERRQ(ierr);
1376       cellPhi[d] = PetscMin(cellPhi[d], phi);
1377     }
1378   }
1379   PetscFunctionReturn(0);
1380 }
1381 
1382 #undef __FUNCT__
1383 #define __FUNCT__ "DMPlexReconstructGradients_Internal"
1384 PetscErrorCode DMPlexReconstructGradients_Internal(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, Vec locX, Vec grad)
1385 {
1386   DM                 dmFace, dmCell, dmGrad;
1387   DMLabel            ghostLabel;
1388   PetscDS            prob;
1389   PetscFV            fvm;
1390   PetscLimiter       lim;
1391   const PetscScalar *facegeom, *cellgeom, *x;
1392   PetscScalar       *gr;
1393   PetscReal         *cellPhi;
1394   PetscInt           dim, face, cell, totDim, cStart, cEnd, cEndInterior;
1395   PetscErrorCode     ierr;
1396 
1397   PetscFunctionBegin;
1398   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1399   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1400   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
1401   ierr = DMPlexGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
1402   ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fvm);CHKERRQ(ierr);
1403   ierr = PetscFVGetLimiter(fvm, &lim);CHKERRQ(ierr);
1404   ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
1405   ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
1406   ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
1407   ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
1408   ierr = VecGetArrayRead(locX, &x);CHKERRQ(ierr);
1409   ierr = VecGetDM(grad, &dmGrad);CHKERRQ(ierr);
1410   ierr = VecZeroEntries(grad);CHKERRQ(ierr);
1411   ierr = VecGetArray(grad, &gr);CHKERRQ(ierr);
1412   /* Reconstruct gradients */
1413   for (face = fStart; face < fEnd; ++face) {
1414     const PetscInt        *cells;
1415     const PetscFVFaceGeom *fg;
1416     const PetscScalar     *cx[2];
1417     PetscScalar           *cgrad[2];
1418     PetscBool              boundary;
1419     PetscInt               ghost, c, pd, d, numChildren, numCells;
1420 
1421     ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
1422     ierr = DMPlexIsBoundaryPoint(dm, face, &boundary);CHKERRQ(ierr);
1423     ierr = DMPlexGetTreeChildren(dm, face, &numChildren, NULL);CHKERRQ(ierr);
1424     if (ghost >= 0 || boundary || numChildren) continue;
1425     ierr = DMPlexGetSupportSize(dm, face, &numCells);CHKERRQ(ierr);
1426     if (numCells != 2) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "facet %d has %d support points: expected 2",face,numCells);
1427     ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
1428     ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
1429     for (c = 0; c < 2; ++c) {
1430       ierr = DMPlexPointLocalRead(dm, cells[c], x, &cx[c]);CHKERRQ(ierr);
1431       ierr = DMPlexPointGlobalRef(dmGrad, cells[c], gr, &cgrad[c]);CHKERRQ(ierr);
1432     }
1433     for (pd = 0; pd < totDim; ++pd) {
1434       PetscScalar delta = cx[1][pd] - cx[0][pd];
1435 
1436       for (d = 0; d < dim; ++d) {
1437         if (cgrad[0]) cgrad[0][pd*dim+d] += fg->grad[0][d] * delta;
1438         if (cgrad[1]) cgrad[1][pd*dim+d] -= fg->grad[1][d] * delta;
1439       }
1440     }
1441   }
1442   /* Limit interior gradients (using cell-based loop because it generalizes better to vector limiters) */
1443   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1444   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
1445   cEndInterior = cEndInterior < 0 ? cEnd : cEndInterior;
1446   ierr = DMGetWorkArray(dm, totDim, PETSC_REAL, &cellPhi);CHKERRQ(ierr);
1447   for (cell = dmGrad && lim ? cStart : cEnd; cell < cEndInterior; ++cell) {
1448     const PetscInt        *faces;
1449     const PetscScalar     *cx;
1450     const PetscFVCellGeom *cg;
1451     PetscScalar           *cgrad;
1452     PetscInt               coneSize, f, pd, d;
1453 
1454     ierr = DMPlexGetConeSize(dm, cell, &coneSize);CHKERRQ(ierr);
1455     ierr = DMPlexGetCone(dm, cell, &faces);CHKERRQ(ierr);
1456     ierr = DMPlexPointLocalRead(dm, cell, x, &cx);CHKERRQ(ierr);
1457     ierr = DMPlexPointLocalRead(dmCell, cell, cellgeom, &cg);CHKERRQ(ierr);
1458     ierr = DMPlexPointGlobalRef(dmGrad, cell, gr, &cgrad);CHKERRQ(ierr);
1459     if (!cgrad) continue; /* Unowned overlap cell, we do not compute */
1460     /* Limiter will be minimum value over all neighbors */
1461     for (d = 0; d < totDim; ++d) cellPhi[d] = PETSC_MAX_REAL;
1462     for (f = 0; f < coneSize; ++f) {
1463       ierr = DMPlexApplyLimiter_Internal(dm,dmCell,lim,dim,totDim,cell,faces[f],fStart,fEnd,cellPhi,x,cellgeom,cg,cx,cgrad);CHKERRQ(ierr);
1464     }
1465     /* Apply limiter to gradient */
1466     for (pd = 0; pd < totDim; ++pd)
1467       /* Scalar limiter applied to each component separately */
1468       for (d = 0; d < dim; ++d) cgrad[pd*dim+d] *= cellPhi[pd];
1469   }
1470   ierr = DMRestoreWorkArray(dm, totDim, PETSC_REAL, &cellPhi);CHKERRQ(ierr);
1471   ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
1472   ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
1473   ierr = VecRestoreArrayRead(locX, &x);CHKERRQ(ierr);
1474   ierr = VecRestoreArray(grad, &gr);CHKERRQ(ierr);
1475   PetscFunctionReturn(0);
1476 }
1477 
1478 #undef __FUNCT__
1479 #define __FUNCT__ "DMPlexComputeBdResidual_Internal"
1480 PetscErrorCode DMPlexComputeBdResidual_Internal(DM dm, Vec locX, Vec locX_t, Vec locF, void *user)
1481 {
1482   DM_Plex         *mesh = (DM_Plex *) dm->data;
1483   PetscSection     section;
1484   PetscDS          prob;
1485   DMLabel          depth;
1486   PetscFECellGeom *cgeom;
1487   PetscScalar     *u = NULL, *u_t = NULL, *elemVec = NULL;
1488   PetscInt         dim, Nf, f, totDimBd, numBd, bd;
1489   PetscErrorCode   ierr;
1490 
1491   PetscFunctionBegin;
1492   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1493   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
1494   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1495   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
1496   ierr = PetscDSGetTotalBdDimension(prob, &totDimBd);CHKERRQ(ierr);
1497   ierr = DMPlexGetDepthLabel(dm, &depth);CHKERRQ(ierr);
1498   ierr = DMPlexGetNumBoundary(dm, &numBd);CHKERRQ(ierr);
1499   for (bd = 0; bd < numBd; ++bd) {
1500     const char     *bdLabel;
1501     DMLabel         label;
1502     IS              pointIS;
1503     const PetscInt *points;
1504     const PetscInt *values;
1505     PetscInt        field, numValues, numPoints, p, dep, numFaces;
1506     PetscBool       isEssential;
1507 
1508     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, &bdLabel, &field, NULL, NULL, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
1509     if (isEssential) continue;
1510     if (numValues != 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Bug me and I will fix this");
1511     ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
1512     ierr = DMLabelGetStratumSize(label, 1, &numPoints);CHKERRQ(ierr);
1513     ierr = DMLabelGetStratumIS(label, 1, &pointIS);CHKERRQ(ierr);
1514     ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
1515     for (p = 0, numFaces = 0; p < numPoints; ++p) {
1516       ierr = DMLabelGetValue(depth, points[p], &dep);CHKERRQ(ierr);
1517       if (dep == dim-1) ++numFaces;
1518     }
1519     ierr = PetscMalloc3(numFaces*totDimBd,&u,numFaces,&cgeom,numFaces*totDimBd,&elemVec);CHKERRQ(ierr);
1520     if (locX_t) {ierr = PetscMalloc1(numFaces*totDimBd,&u_t);CHKERRQ(ierr);}
1521     for (p = 0, f = 0; p < numPoints; ++p) {
1522       const PetscInt point = points[p];
1523       PetscScalar   *x     = NULL;
1524       PetscInt       i;
1525 
1526       ierr = DMLabelGetValue(depth, points[p], &dep);CHKERRQ(ierr);
1527       if (dep != dim-1) continue;
1528       ierr = DMPlexComputeCellGeometryFEM(dm, point, NULL, cgeom[f].v0, cgeom[f].J, cgeom[f].invJ, &cgeom[f].detJ);CHKERRQ(ierr);
1529       ierr = DMPlexComputeCellGeometryFVM(dm, point, NULL, NULL, cgeom[f].n);CHKERRQ(ierr);
1530       if (cgeom[f].detJ <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for face %d", cgeom[f].detJ, point);
1531       ierr = DMPlexVecGetClosure(dm, section, locX, point, NULL, &x);CHKERRQ(ierr);
1532       for (i = 0; i < totDimBd; ++i) u[f*totDimBd+i] = x[i];
1533       ierr = DMPlexVecRestoreClosure(dm, section, locX, point, NULL, &x);CHKERRQ(ierr);
1534       if (locX_t) {
1535         ierr = DMPlexVecGetClosure(dm, section, locX_t, point, NULL, &x);CHKERRQ(ierr);
1536         for (i = 0; i < totDimBd; ++i) u_t[f*totDimBd+i] = x[i];
1537         ierr = DMPlexVecRestoreClosure(dm, section, locX_t, point, NULL, &x);CHKERRQ(ierr);
1538       }
1539       ++f;
1540     }
1541     for (f = 0; f < Nf; ++f) {
1542       PetscFE         fe;
1543       PetscQuadrature q;
1544       PetscInt        numQuadPoints, Nb;
1545       /* Conforming batches */
1546       PetscInt        numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
1547       /* Remainder */
1548       PetscInt        Nr, offset;
1549 
1550       ierr = PetscDSGetBdDiscretization(prob, f, (PetscObject *) &fe);CHKERRQ(ierr);
1551       ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
1552       ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
1553       ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
1554       ierr = PetscQuadratureGetData(q, NULL, &numQuadPoints, NULL, NULL);CHKERRQ(ierr);
1555       blockSize = Nb*numQuadPoints;
1556       batchSize = numBlocks * blockSize;
1557       ierr =  PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
1558       numChunks = numFaces / (numBatches*batchSize);
1559       Ne        = numChunks*numBatches*batchSize;
1560       Nr        = numFaces % (numBatches*batchSize);
1561       offset    = numFaces - Nr;
1562       ierr = PetscFEIntegrateBdResidual(fe, prob, f, Ne, cgeom, u, u_t, NULL, NULL, elemVec);CHKERRQ(ierr);
1563       ierr = PetscFEIntegrateBdResidual(fe, prob, f, Nr, &cgeom[offset], &u[offset*totDimBd], u_t ? &u_t[offset*totDimBd] : NULL, NULL, NULL, &elemVec[offset*totDimBd]);CHKERRQ(ierr);
1564     }
1565     for (p = 0, f = 0; p < numPoints; ++p) {
1566       const PetscInt point = points[p];
1567 
1568       ierr = DMLabelGetValue(depth, point, &dep);CHKERRQ(ierr);
1569       if (dep != dim-1) continue;
1570       if (mesh->printFEM > 1) {ierr = DMPrintCellVector(point, "BdResidual", totDimBd, &elemVec[f*totDimBd]);CHKERRQ(ierr);}
1571       ierr = DMPlexVecSetClosure(dm, NULL, locF, point, &elemVec[f*totDimBd], ADD_VALUES);CHKERRQ(ierr);
1572       ++f;
1573     }
1574     ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
1575     ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
1576     ierr = PetscFree3(u,cgeom,elemVec);CHKERRQ(ierr);
1577     if (locX_t) {ierr = PetscFree(u_t);CHKERRQ(ierr);}
1578   }
1579   PetscFunctionReturn(0);
1580 }
1581 
1582 #undef __FUNCT__
1583 #define __FUNCT__ "DMPlexReconstructGradientsFVM"
1584 /*@
1585   DMPlexReconstructGradientsFVM - reconstruct the gradient of a vector using a finite volume method.
1586 
1587   Input Parameters:
1588 + dm - the mesh
1589 - locX - the local representation of the vector
1590 
1591   Output Parameter:
1592 . grad - the global representation of the gradient
1593 
1594   Level: developer
1595 
1596 .seealso: DMPlexSNESGetGradientDM()
1597 @*/
1598 PetscErrorCode DMPlexReconstructGradientsFVM(DM dm, Vec locX, Vec grad)
1599 {
1600   PetscDS          prob;
1601   PetscInt         Nf, f, fStart, fEnd;
1602   PetscBool        useFVM;
1603   PetscFV          fvm = NULL;
1604   Vec              faceGeometryFVM, cellGeometryFVM;
1605   PetscFVCellGeom  *cgeomFVM   = NULL;
1606   PetscFVFaceGeom  *fgeomFVM   = NULL;
1607   DM               dmGrad = NULL;
1608   PetscErrorCode   ierr;
1609 
1610   PetscFunctionBegin;
1611   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1612   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
1613   for (f = 0; f < Nf; ++f) {
1614     PetscObject  obj;
1615     PetscClassId id;
1616 
1617     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1618     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1619     if (id == PETSCFV_CLASSID) {useFVM = PETSC_TRUE; fvm = (PetscFV) obj;}
1620   }
1621   if (!useFVM) SETERRQ(PetscObjectComm((PetscObject)dm),PETSC_ERR_SUP,"This dm does not have a finite volume discretization");
1622   ierr = DMPlexSNESGetGradientDM(dm, fvm, &dmGrad);CHKERRQ(ierr);
1623   if (!dmGrad) SETERRQ(PetscObjectComm((PetscObject)dm),PETSC_ERR_SUP,"This dm's finite volume discretization does not reconstruct gradients");
1624   ierr = DMPlexSNESGetGeometryFVM(dm, &faceGeometryFVM, &cellGeometryFVM, NULL);CHKERRQ(ierr);
1625   ierr = VecGetArrayRead(faceGeometryFVM, (const PetscScalar **) &fgeomFVM);CHKERRQ(ierr);
1626   ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr);
1627   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
1628   ierr = DMPlexReconstructGradients_Internal(dm, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr);
1629   PetscFunctionReturn(0);
1630 }
1631 
1632 #undef __FUNCT__
1633 #define __FUNCT__ "DMPlexComputeResidual_Internal"
1634 PetscErrorCode DMPlexComputeResidual_Internal(DM dm, PetscInt cStart, PetscInt cEnd, PetscReal time, Vec locX, Vec locX_t, Vec locF, void *user)
1635 {
1636   DM_Plex          *mesh       = (DM_Plex *) dm->data;
1637   const char       *name       = "Residual";
1638   DM                dmAux      = NULL;
1639   DM                dmGrad     = NULL;
1640   DMLabel           ghostLabel = NULL;
1641   PetscDS           prob       = NULL;
1642   PetscDS           probAux    = NULL;
1643   PetscSection      section    = NULL;
1644   PetscBool         useFEM     = PETSC_FALSE;
1645   PetscBool         useFVM     = PETSC_FALSE;
1646   PetscBool         isImplicit = (locX_t || time == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE;
1647   PetscFV           fvm        = NULL;
1648   PetscFECellGeom  *cgeomFEM   = NULL;
1649   PetscScalar      *cgeomScal;
1650   PetscFVCellGeom  *cgeomFVM   = NULL;
1651   PetscFVFaceGeom  *fgeomFVM   = NULL;
1652   Vec               locA, cellGeometryFEM = NULL, cellGeometryFVM = NULL, faceGeometryFVM = NULL, grad, locGrad = NULL;
1653   PetscScalar      *u, *u_t, *a, *uL, *uR;
1654   PetscInt          Nf, f, totDim, totDimAux, numChunks, cellChunkSize, faceChunkSize, chunk, fStart, fEnd;
1655   PetscErrorCode    ierr;
1656 
1657   PetscFunctionBegin;
1658   ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
1659   /* TODO The places where we have to use isFE are probably the member functions for the PetscDisc class */
1660   /* TODO The FVM geometry is over-manipulated. Make the precalc functions return exactly what we need */
1661   /* FEM+FVM */
1662   /* 1: Get sizes from dm and dmAux */
1663   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
1664   ierr = DMPlexGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
1665   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1666   ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
1667   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
1668   ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr);
1669   if (locA) {
1670     ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
1671     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
1672     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
1673   }
1674   /* 2: Get geometric data */
1675   for (f = 0; f < Nf; ++f) {
1676     PetscObject  obj;
1677     PetscClassId id;
1678     PetscBool    fimp;
1679 
1680     ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
1681     if (isImplicit != fimp) continue;
1682     ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1683     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1684     if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;}
1685     if (id == PETSCFV_CLASSID) {useFVM = PETSC_TRUE; fvm = (PetscFV) obj;}
1686   }
1687   if (useFEM) {
1688     ierr = DMPlexSNESGetGeometryFEM(dm, &cellGeometryFEM);CHKERRQ(ierr);
1689     ierr = VecGetArray(cellGeometryFEM, &cgeomScal);CHKERRQ(ierr);
1690     if (sizeof(PetscFECellGeom) % sizeof(PetscScalar)) {
1691       DM dmCell;
1692       PetscInt c;
1693 
1694       ierr = VecGetDM(cellGeometryFEM,&dmCell);CHKERRQ(ierr);
1695       ierr = PetscMalloc1(cEnd-cStart,&cgeomFEM);CHKERRQ(ierr);
1696       for (c = 0; c < cEnd - cStart; c++) {
1697         PetscScalar *thisgeom;
1698 
1699         ierr = DMPlexPointLocalRef(dmCell, c + cStart, cgeomScal, &thisgeom);CHKERRQ(ierr);
1700         cgeomFEM[c] = *((PetscFECellGeom *) thisgeom);
1701       }
1702     }
1703     else {
1704       cgeomFEM = (PetscFECellGeom *) cgeomScal;
1705     }
1706   }
1707   if (useFVM) {
1708     ierr = DMPlexSNESGetGeometryFVM(dm, &faceGeometryFVM, &cellGeometryFVM, NULL);CHKERRQ(ierr);
1709     ierr = VecGetArrayRead(faceGeometryFVM, (const PetscScalar **) &fgeomFVM);CHKERRQ(ierr);
1710     ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr);
1711     /* Reconstruct and limit cell gradients */
1712     ierr = DMPlexSNESGetGradientDM(dm, fvm, &dmGrad);CHKERRQ(ierr);
1713     if (dmGrad) {
1714       ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
1715       ierr = DMGetGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
1716       ierr = DMPlexReconstructGradients_Internal(dm, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr);
1717       /* Communicate gradient values */
1718       ierr = DMGetLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);
1719       ierr = DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
1720       ierr = DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
1721       ierr = DMRestoreGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
1722     }
1723   }
1724   /* Handle boundary values */
1725   ierr = DMPlexInsertBoundaryValues(dm, locX, time, faceGeometryFVM, cellGeometryFVM, locGrad);CHKERRQ(ierr);
1726   /* Loop over chunks */
1727   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
1728   numChunks     = 1;
1729   cellChunkSize = (cEnd - cStart)/numChunks;
1730   faceChunkSize = (fEnd - fStart)/numChunks;
1731   for (chunk = 0; chunk < numChunks; ++chunk) {
1732     PetscScalar     *elemVec, *fluxL, *fluxR;
1733     PetscReal       *vol;
1734     PetscFVFaceGeom *fgeom;
1735     PetscInt         cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, cell;
1736     PetscInt         fS = fStart+chunk*faceChunkSize, fE = PetscMin(fS+faceChunkSize, fEnd), numFaces = fE - fS, face;
1737 
1738     /* Extract field coefficients */
1739     if (useFEM) {
1740       ierr = DMPlexGetCellFields(dm, cS, cE, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
1741       ierr = DMGetWorkArray(dm, numCells*totDim, PETSC_SCALAR, &elemVec);CHKERRQ(ierr);
1742       ierr = PetscMemzero(elemVec, numCells*totDim * sizeof(PetscScalar));CHKERRQ(ierr);
1743     }
1744     if (useFVM) {
1745       ierr = DMPlexGetFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &uL, &uR);CHKERRQ(ierr);
1746       ierr = DMPlexGetFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &fgeom, &vol);CHKERRQ(ierr);
1747       ierr = DMGetWorkArray(dm, numFaces*totDim, PETSC_SCALAR, &fluxL);CHKERRQ(ierr);
1748       ierr = DMGetWorkArray(dm, numFaces*totDim, PETSC_SCALAR, &fluxR);CHKERRQ(ierr);
1749       ierr = PetscMemzero(fluxL, numFaces*totDim * sizeof(PetscScalar));CHKERRQ(ierr);
1750       ierr = PetscMemzero(fluxR, numFaces*totDim * sizeof(PetscScalar));CHKERRQ(ierr);
1751     }
1752     /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */
1753     /* Loop over fields */
1754     for (f = 0; f < Nf; ++f) {
1755       PetscObject  obj;
1756       PetscClassId id;
1757       PetscBool    fimp;
1758       PetscInt     numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;
1759 
1760       ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
1761       if (isImplicit != fimp) continue;
1762       ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1763       ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1764       if (id == PETSCFE_CLASSID) {
1765         PetscFE         fe = (PetscFE) obj;
1766         PetscQuadrature q;
1767         PetscInt        Nq, Nb;
1768 
1769         ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
1770 
1771         ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
1772         ierr = PetscQuadratureGetData(q, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
1773         ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
1774         blockSize = Nb*Nq;
1775         batchSize = numBlocks * blockSize;
1776         ierr =  PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
1777         numChunks = numCells / (numBatches*batchSize);
1778         Ne        = numChunks*numBatches*batchSize;
1779         Nr        = numCells % (numBatches*batchSize);
1780         offset    = numCells - Nr;
1781         /* Integrate FE residual to get elemVec (need fields at quadrature points) */
1782         /*   For FV, I think we use a P0 basis and the cell coefficients (for subdivided cells, we can tweak the basis tabulation to be the indicator function) */
1783         ierr = PetscFEIntegrateResidual(fe, prob, f, Ne, cgeomFEM, u, u_t, probAux, a, elemVec);CHKERRQ(ierr);
1784         ierr = PetscFEIntegrateResidual(fe, prob, f, Nr, &cgeomFEM[offset], &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], &elemVec[offset*totDim]);CHKERRQ(ierr);
1785       } else if (id == PETSCFV_CLASSID) {
1786         PetscFV fv = (PetscFV) obj;
1787 
1788         Ne = numFaces;
1789         Nr = 0;
1790         /* Riemann solve over faces (need fields at face centroids) */
1791         /*   We need to evaluate FE fields at those coordinates */
1792         ierr = PetscFVIntegrateRHSFunction(fv, prob, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR);CHKERRQ(ierr);
1793       } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", f);
1794     }
1795     if (sizeof(PetscFECellGeom) % sizeof(PetscScalar)) {
1796       ierr = PetscFree(cgeomFEM);CHKERRQ(ierr);
1797     }
1798     else {
1799       cgeomFEM = NULL;
1800     }
1801     if (cellGeometryFEM) {ierr = VecRestoreArray(cellGeometryFEM, &cgeomScal);CHKERRQ(ierr);}
1802     /* Loop over domain */
1803     if (useFEM) {
1804       /* Add elemVec to locX */
1805       for (cell = cS; cell < cE; ++cell) {
1806         if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cell*totDim]);CHKERRQ(ierr);}
1807         ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cell*totDim], ADD_VALUES);CHKERRQ(ierr);
1808       }
1809     }
1810     if (useFVM) {
1811       PetscScalar *fa;
1812       PetscInt     iface;
1813 
1814       ierr = VecGetArray(locF, &fa);CHKERRQ(ierr);
1815       for (f = 0; f < Nf; ++f) {
1816         PetscFV      fv;
1817         PetscObject  obj;
1818         PetscClassId id;
1819         PetscInt     foff, pdim;
1820 
1821         ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1822         ierr = PetscDSGetFieldOffset(prob, f, &foff);CHKERRQ(ierr);
1823         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1824         if (id != PETSCFV_CLASSID) continue;
1825         fv   = (PetscFV) obj;
1826         ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
1827         /* Accumulate fluxes to cells */
1828         for (face = fS, iface = 0; face < fE; ++face) {
1829           const PetscInt *cells;
1830           PetscScalar    *fL, *fR;
1831           PetscInt        ghost, d, nsupp;
1832 
1833           ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
1834           ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr);
1835           if (ghost >= 0 || nsupp > 2) continue;
1836           ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
1837           ierr = DMPlexPointGlobalFieldRef(dm, cells[0], f, fa, &fL);CHKERRQ(ierr);
1838           ierr = DMPlexPointGlobalFieldRef(dm, cells[1], f, fa, &fR);CHKERRQ(ierr);
1839           for (d = 0; d < pdim; ++d) {
1840             if (fL) fL[d] -= fluxL[iface*totDim+foff+d];
1841             if (fR) fR[d] += fluxR[iface*totDim+foff+d];
1842           }
1843           ++iface;
1844         }
1845       }
1846       ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr);
1847     }
1848     /* Handle time derivative */
1849     if (locX_t) {
1850       PetscScalar *x_t, *fa;
1851 
1852       ierr = VecGetArray(locF, &fa);CHKERRQ(ierr);
1853       ierr = VecGetArray(locX_t, &x_t);CHKERRQ(ierr);
1854       for (f = 0; f < Nf; ++f) {
1855         PetscFV      fv;
1856         PetscObject  obj;
1857         PetscClassId id;
1858         PetscInt     pdim, d;
1859 
1860         ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1861         ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1862         if (id != PETSCFV_CLASSID) continue;
1863         fv   = (PetscFV) obj;
1864         ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
1865         for (cell = cS; cell < cE; ++cell) {
1866           PetscScalar *u_t, *r;
1867 
1868           ierr = DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t);CHKERRQ(ierr);
1869           ierr = DMPlexPointLocalFieldRef(dm, cell, f, fa, &r);CHKERRQ(ierr);
1870           for (d = 0; d < pdim; ++d) r[d] += u_t[d];
1871         }
1872       }
1873       ierr = VecRestoreArray(locX_t, &x_t);CHKERRQ(ierr);
1874       ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr);
1875     }
1876     if (useFEM) {
1877       ierr = DMPlexRestoreCellFields(dm, cS, cE, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
1878       ierr = DMRestoreWorkArray(dm, numCells*totDim, PETSC_SCALAR, &elemVec);CHKERRQ(ierr);
1879     }
1880     if (useFVM) {
1881       ierr = DMPlexRestoreFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &uL, &uR);CHKERRQ(ierr);
1882       ierr = DMPlexRestoreFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &fgeom, &vol);CHKERRQ(ierr);
1883       ierr = DMRestoreWorkArray(dm, numFaces*totDim, PETSC_SCALAR, &fluxL);CHKERRQ(ierr);
1884       ierr = DMRestoreWorkArray(dm, numFaces*totDim, PETSC_SCALAR, &fluxR);CHKERRQ(ierr);
1885       if (dmGrad) {ierr = DMRestoreLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);}
1886     }
1887   }
1888 
1889   if (useFEM) {ierr = DMPlexComputeBdResidual_Internal(dm, locX, locX_t, locF, user);CHKERRQ(ierr);}
1890 
1891   /* FEM */
1892   /* 1: Get sizes from dm and dmAux */
1893   /* 2: Get geometric data */
1894   /* 3: Handle boundary values */
1895   /* 4: Loop over domain */
1896   /*   Extract coefficients */
1897   /* Loop over fields */
1898   /*   Set tiling for FE*/
1899   /*   Integrate FE residual to get elemVec */
1900   /*     Loop over subdomain */
1901   /*       Loop over quad points */
1902   /*         Transform coords to real space */
1903   /*         Evaluate field and aux fields at point */
1904   /*         Evaluate residual at point */
1905   /*         Transform residual to real space */
1906   /*       Add residual to elemVec */
1907   /* Loop over domain */
1908   /*   Add elemVec to locX */
1909 
1910   /* FVM */
1911   /* Get geometric data */
1912   /* If using gradients */
1913   /*   Compute gradient data */
1914   /*   Loop over domain faces */
1915   /*     Count computational faces */
1916   /*     Reconstruct cell gradient */
1917   /*   Loop over domain cells */
1918   /*     Limit cell gradients */
1919   /* Handle boundary values */
1920   /* Loop over domain faces */
1921   /*   Read out field, centroid, normal, volume for each side of face */
1922   /* Riemann solve over faces */
1923   /* Loop over domain faces */
1924   /*   Accumulate fluxes to cells */
1925   /* TODO Change printFEM to printDisc here */
1926   if (mesh->printFEM) {ierr = DMPrintLocalVec(dm, name, mesh->printTol, locF);CHKERRQ(ierr);}
1927   ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
1928   PetscFunctionReturn(0);
1929 }
1930 
1931 #undef __FUNCT__
1932 #define __FUNCT__ "DMPlexComputeResidualFEM_Check_Internal"
1933 static PetscErrorCode DMPlexComputeResidualFEM_Check_Internal(DM dm, Vec X, Vec X_t, Vec F, void *user)
1934 {
1935   DM                dmCh, dmAux;
1936   Vec               A, cellgeom;
1937   PetscDS           prob, probCh, probAux = NULL;
1938   PetscQuadrature   q;
1939   PetscSection      section, sectionAux;
1940   PetscFECellGeom  *cgeom = NULL;
1941   PetscScalar      *cgeomScal;
1942   PetscScalar      *elemVec, *elemVecCh, *u, *u_t, *a = NULL;
1943   PetscInt          dim, Nf, f, numCells, cStart, cEnd, c;
1944   PetscInt          totDim, totDimAux, diffCell = 0;
1945   PetscErrorCode    ierr;
1946 
1947   PetscFunctionBegin;
1948   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1949   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
1950   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1951   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
1952   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
1953   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1954   numCells = cEnd - cStart;
1955   ierr = PetscObjectQuery((PetscObject) dm, "dmCh", (PetscObject *) &dmCh);CHKERRQ(ierr);
1956   ierr = DMGetDS(dmCh, &probCh);CHKERRQ(ierr);
1957   ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr);
1958   ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr);
1959   if (dmAux) {
1960     ierr = DMGetDefaultSection(dmAux, &sectionAux);CHKERRQ(ierr);
1961     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
1962     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
1963   }
1964   ierr = DMPlexInsertBoundaryValues(dm, X, 0.0, NULL, NULL, NULL);CHKERRQ(ierr);
1965   ierr = VecSet(F, 0.0);CHKERRQ(ierr);
1966   ierr = PetscMalloc3(numCells*totDim,&u,X_t ? numCells*totDim : 0,&u_t,numCells*totDim,&elemVec);CHKERRQ(ierr);
1967   ierr = PetscMalloc1(numCells*totDim,&elemVecCh);CHKERRQ(ierr);
1968   if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);}
1969   ierr = DMPlexSNESGetGeometryFEM(dm, &cellgeom);CHKERRQ(ierr);
1970   ierr = VecGetArray(cellgeom, &cgeomScal);CHKERRQ(ierr);
1971   if (sizeof(PetscFECellGeom) % sizeof(PetscScalar)) {
1972     DM dmCell;
1973 
1974     ierr = VecGetDM(cellgeom,&dmCell);CHKERRQ(ierr);
1975     ierr = PetscMalloc1(cEnd-cStart,&cgeom);CHKERRQ(ierr);
1976     for (c = 0; c < cEnd - cStart; c++) {
1977       PetscScalar *thisgeom;
1978 
1979       ierr = DMPlexPointLocalRef(dmCell, c + cStart, cgeomScal, &thisgeom);CHKERRQ(ierr);
1980       cgeom[c] = *((PetscFECellGeom *) thisgeom);
1981     }
1982   }
1983   else {
1984     cgeom = (PetscFECellGeom *) cgeomScal;
1985   }
1986   for (c = cStart; c < cEnd; ++c) {
1987     PetscScalar *x = NULL, *x_t = NULL;
1988     PetscInt     i;
1989 
1990     ierr = DMPlexVecGetClosure(dm, section, X, c, NULL, &x);CHKERRQ(ierr);
1991     for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
1992     ierr = DMPlexVecRestoreClosure(dm, section, X, c, NULL, &x);CHKERRQ(ierr);
1993     if (X_t) {
1994       ierr = DMPlexVecGetClosure(dm, section, X_t, c, NULL, &x_t);CHKERRQ(ierr);
1995       for (i = 0; i < totDim; ++i) u_t[c*totDim+i] = x_t[i];
1996       ierr = DMPlexVecRestoreClosure(dm, section, X_t, c, NULL, &x_t);CHKERRQ(ierr);
1997     }
1998     if (dmAux) {
1999       ierr = DMPlexVecGetClosure(dmAux, sectionAux, A, c, NULL, &x);CHKERRQ(ierr);
2000       for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
2001       ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, A, c, NULL, &x);CHKERRQ(ierr);
2002     }
2003   }
2004   for (f = 0; f < Nf; ++f) {
2005     PetscFE  fe, feCh;
2006     PetscInt numQuadPoints, Nb;
2007     /* Conforming batches */
2008     PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
2009     /* Remainder */
2010     PetscInt Nr, offset;
2011 
2012     ierr = PetscDSGetDiscretization(prob, f, (PetscObject *) &fe);CHKERRQ(ierr);
2013     ierr = PetscDSGetDiscretization(probCh, f, (PetscObject *) &feCh);CHKERRQ(ierr);
2014     ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
2015     ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
2016     ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
2017     ierr = PetscQuadratureGetData(q, NULL, &numQuadPoints, NULL, NULL);CHKERRQ(ierr);
2018     blockSize = Nb*numQuadPoints;
2019     batchSize = numBlocks * blockSize;
2020     ierr =  PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
2021     numChunks = numCells / (numBatches*batchSize);
2022     Ne        = numChunks*numBatches*batchSize;
2023     Nr        = numCells % (numBatches*batchSize);
2024     offset    = numCells - Nr;
2025     ierr = PetscFEIntegrateResidual(fe, prob, f, Ne, cgeom, u, u_t, probAux, a, elemVec);CHKERRQ(ierr);
2026     ierr = PetscFEIntegrateResidual(feCh, prob, f, Ne, cgeom, u, u_t, probAux, a, elemVecCh);CHKERRQ(ierr);
2027     ierr = PetscFEIntegrateResidual(fe, prob, f, Nr, &cgeom[offset], &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], &elemVec[offset*totDim]);CHKERRQ(ierr);
2028     ierr = PetscFEIntegrateResidual(feCh, prob, f, Nr, &cgeom[offset], &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], &elemVecCh[offset*totDim]);CHKERRQ(ierr);
2029   }
2030   for (c = cStart; c < cEnd; ++c) {
2031     PetscBool diff = PETSC_FALSE;
2032     PetscInt  d;
2033 
2034     for (d = 0; d < totDim; ++d) if (PetscAbsScalar(elemVec[c*totDim+d] - elemVecCh[c*totDim+d]) > 1.0e-7) {diff = PETSC_TRUE;break;}
2035     if (diff) {
2036       ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "Different cell %d\n", c);CHKERRQ(ierr);
2037       ierr = DMPrintCellVector(c, "Residual", totDim, &elemVec[c*totDim]);CHKERRQ(ierr);
2038       ierr = DMPrintCellVector(c, "Check Residual", totDim, &elemVecCh[c*totDim]);CHKERRQ(ierr);
2039       ++diffCell;
2040     }
2041     if (diffCell > 9) break;
2042     ierr = DMPlexVecSetClosure(dm, section, F, c, &elemVec[c*totDim], ADD_VALUES);CHKERRQ(ierr);
2043   }
2044   if (sizeof(PetscFECellGeom) % sizeof(PetscScalar)) {
2045     ierr = PetscFree(cgeom);CHKERRQ(ierr);
2046   }
2047   else {
2048     cgeom = NULL;
2049   }
2050   ierr = VecRestoreArray(cellgeom, &cgeomScal);CHKERRQ(ierr);
2051   ierr = PetscFree3(u,u_t,elemVec);CHKERRQ(ierr);
2052   ierr = PetscFree(elemVecCh);CHKERRQ(ierr);
2053   if (dmAux) {ierr = PetscFree(a);CHKERRQ(ierr);}
2054   PetscFunctionReturn(0);
2055 }
2056 
2057 #undef __FUNCT__
2058 #define __FUNCT__ "DMPlexSNESComputeResidualFEM"
2059 /*@
2060   DMPlexSNESComputeResidualFEM - Form the local residual F from the local input X using pointwise functions specified by the user
2061 
2062   Input Parameters:
2063 + dm - The mesh
2064 . X  - Local solution
2065 - user - The user context
2066 
2067   Output Parameter:
2068 . F  - Local output vector
2069 
2070   Level: developer
2071 
2072 .seealso: DMPlexComputeJacobianActionFEM()
2073 @*/
2074 PetscErrorCode DMPlexSNESComputeResidualFEM(DM dm, Vec X, Vec F, void *user)
2075 {
2076   PetscObject    check;
2077   PetscInt       cStart, cEnd, cEndInterior;
2078   PetscErrorCode ierr;
2079 
2080   PetscFunctionBegin;
2081   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2082   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
2083   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
2084   /* The dmCh is used to check two mathematically equivalent discretizations for computational equivalence */
2085   ierr = PetscObjectQuery((PetscObject) dm, "dmCh", &check);CHKERRQ(ierr);
2086   if (check) {ierr = DMPlexComputeResidualFEM_Check_Internal(dm, X, NULL, F, user);CHKERRQ(ierr);}
2087   else       {ierr = DMPlexComputeResidual_Internal(dm, cStart, cEnd, PETSC_MIN_REAL, X, NULL, F, user);CHKERRQ(ierr);}
2088   PetscFunctionReturn(0);
2089 }
2090 
2091 #undef __FUNCT__
2092 #define __FUNCT__ "DMPlexComputeJacobian_Internal"
2093 PetscErrorCode DMPlexComputeJacobian_Internal(DM dm, PetscInt cStart, PetscInt cEnd, PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP,void *user)
2094 {
2095   DM_Plex          *mesh  = (DM_Plex *) dm->data;
2096   const char       *name  = "Jacobian";
2097   DM                dmAux;
2098   DMLabel           depth;
2099   Vec               A, cellgeom;
2100   PetscDS           prob, probAux = NULL;
2101   PetscQuadrature   quad;
2102   PetscSection      section, globalSection, sectionAux;
2103   PetscFECellGeom  *cgeom = NULL;
2104   PetscScalar      *cgeomScal;
2105   PetscScalar      *elemMat, *elemMatP, *u, *u_t, *a = NULL;
2106   PetscInt          dim, Nf, f, fieldI, fieldJ, numCells, c;
2107   PetscInt          totDim, totDimBd, totDimAux, numBd, bd;
2108   PetscBool         isShell, hasPrec;
2109   PetscErrorCode    ierr;
2110 
2111   PetscFunctionBegin;
2112   ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
2113   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2114   ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
2115   ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);
2116   ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
2117   ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
2118   ierr = PetscDSGetTotalBdDimension(prob, &totDimBd);CHKERRQ(ierr);
2119   ierr = PetscDSHasJacobianPreconditioner(prob, &hasPrec);CHKERRQ(ierr);
2120   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
2121   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2122   numCells = cEnd - cStart;
2123   ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr);
2124   ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr);
2125   if (dmAux) {
2126     ierr = DMGetDefaultSection(dmAux, &sectionAux);CHKERRQ(ierr);
2127     ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
2128     ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
2129   }
2130   ierr = DMPlexInsertBoundaryValues(dm, X, 0.0, NULL, NULL, NULL);CHKERRQ(ierr);
2131   ierr = MatZeroEntries(JacP);CHKERRQ(ierr);
2132   ierr = PetscMalloc4(numCells*totDim,&u,X_t ? numCells*totDim : 0,&u_t,numCells*totDim*totDim,&elemMat,hasPrec ? numCells*totDim*totDim : 0, &elemMatP);CHKERRQ(ierr);
2133   if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);}
2134   ierr = DMPlexSNESGetGeometryFEM(dm, &cellgeom);CHKERRQ(ierr);
2135   ierr = VecGetArray(cellgeom, &cgeomScal);CHKERRQ(ierr);
2136   if (sizeof(PetscFECellGeom) % sizeof(PetscScalar)) {
2137     DM dmCell;
2138 
2139     ierr = VecGetDM(cellgeom,&dmCell);CHKERRQ(ierr);
2140     ierr = PetscMalloc1(cEnd-cStart,&cgeom);CHKERRQ(ierr);
2141     for (c = 0; c < cEnd - cStart; c++) {
2142       PetscScalar *thisgeom;
2143 
2144       ierr = DMPlexPointLocalRef(dmCell, c + cStart, cgeomScal, &thisgeom);CHKERRQ(ierr);
2145       cgeom[c] = *((PetscFECellGeom *) thisgeom);
2146     }
2147   }
2148   else {
2149     cgeom = (PetscFECellGeom *) cgeomScal;
2150   }
2151   for (c = cStart; c < cEnd; ++c) {
2152     PetscScalar *x = NULL,  *x_t = NULL;
2153     PetscInt     i;
2154 
2155     ierr = DMPlexVecGetClosure(dm, section, X, c, NULL, &x);CHKERRQ(ierr);
2156     for (i = 0; i < totDim; ++i) u[(c-cStart)*totDim+i] = x[i];
2157     ierr = DMPlexVecRestoreClosure(dm, section, X, c, NULL, &x);CHKERRQ(ierr);
2158     if (X_t) {
2159       ierr = DMPlexVecGetClosure(dm, section, X_t, c, NULL, &x_t);CHKERRQ(ierr);
2160       for (i = 0; i < totDim; ++i) u_t[(c-cStart)*totDim+i] = x_t[i];
2161       ierr = DMPlexVecRestoreClosure(dm, section, X_t, c, NULL, &x_t);CHKERRQ(ierr);
2162     }
2163     if (dmAux) {
2164       ierr = DMPlexVecGetClosure(dmAux, sectionAux, A, c, NULL, &x);CHKERRQ(ierr);
2165       for (i = 0; i < totDimAux; ++i) a[(c-cStart)*totDimAux+i] = x[i];
2166       ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, A, c, NULL, &x);CHKERRQ(ierr);
2167     }
2168   }
2169   ierr = PetscMemzero(elemMat, numCells*totDim*totDim * sizeof(PetscScalar));CHKERRQ(ierr);
2170   if (hasPrec) {ierr = PetscMemzero(elemMatP, numCells*totDim*totDim * sizeof(PetscScalar));CHKERRQ(ierr);}
2171   for (fieldI = 0; fieldI < Nf; ++fieldI) {
2172     PetscFE  fe;
2173     PetscInt numQuadPoints, Nb;
2174     /* Conforming batches */
2175     PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
2176     /* Remainder */
2177     PetscInt Nr, offset;
2178 
2179     ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
2180     ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
2181     ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
2182     ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
2183     ierr = PetscQuadratureGetData(quad, NULL, &numQuadPoints, NULL, NULL);CHKERRQ(ierr);
2184     blockSize = Nb*numQuadPoints;
2185     batchSize = numBlocks * blockSize;
2186     ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
2187     numChunks = numCells / (numBatches*batchSize);
2188     Ne        = numChunks*numBatches*batchSize;
2189     Nr        = numCells % (numBatches*batchSize);
2190     offset    = numCells - Nr;
2191     for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
2192       ierr = PetscFEIntegrateJacobian(fe, prob, PETSC_FALSE, fieldI, fieldJ, Ne, cgeom, u, u_t, probAux, a, elemMat);CHKERRQ(ierr);
2193       ierr = PetscFEIntegrateJacobian(fe, prob, PETSC_FALSE, fieldI, fieldJ, Nr, &cgeom[offset], &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], &elemMat[offset*totDim*totDim]);CHKERRQ(ierr);
2194       if (hasPrec) {
2195         ierr = PetscFEIntegrateJacobian(fe, prob, PETSC_TRUE, fieldI, fieldJ, Ne, cgeom, u, u_t, probAux, a, elemMatP);CHKERRQ(ierr);
2196         ierr = PetscFEIntegrateJacobian(fe, prob, PETSC_TRUE, fieldI, fieldJ, Nr, &cgeom[offset], &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], &elemMatP[offset*totDim*totDim]);CHKERRQ(ierr);
2197       }
2198     }
2199   }
2200   for (c = cStart; c < cEnd; ++c) {
2201     if (hasPrec) {
2202       if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(c, name, totDim, totDim, &elemMat[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);}
2203       ierr = DMPlexMatSetClosure(dm, section, globalSection, Jac, c, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
2204       if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(c, name, totDim, totDim, &elemMatP[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);}
2205       ierr = DMPlexMatSetClosure(dm, section, globalSection, JacP, c, &elemMatP[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
2206     } else {
2207       if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(c, name, totDim, totDim, &elemMat[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);}
2208       ierr = DMPlexMatSetClosure(dm, section, globalSection, JacP, c, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
2209     }
2210   }
2211   if (sizeof(PetscFECellGeom) % sizeof(PetscScalar)) {
2212     ierr = PetscFree(cgeom);CHKERRQ(ierr);
2213   }
2214   else {
2215     cgeom = NULL;
2216   }
2217   ierr = VecRestoreArray(cellgeom, &cgeomScal);CHKERRQ(ierr);
2218   ierr = PetscFree4(u,u_t,elemMat,elemMatP);CHKERRQ(ierr);
2219   if (dmAux) {ierr = PetscFree(a);CHKERRQ(ierr);}
2220   ierr = DMPlexGetDepthLabel(dm, &depth);CHKERRQ(ierr);
2221   ierr = DMPlexGetNumBoundary(dm, &numBd);CHKERRQ(ierr);
2222   ierr = DMPlexGetDepthLabel(dm, &depth);CHKERRQ(ierr);
2223   ierr = DMPlexGetNumBoundary(dm, &numBd);CHKERRQ(ierr);
2224   for (bd = 0; bd < numBd; ++bd) {
2225     const char     *bdLabel;
2226     DMLabel         label;
2227     IS              pointIS;
2228     const PetscInt *points;
2229     const PetscInt *values;
2230     PetscInt        field, numValues, numPoints, p, dep, numFaces;
2231     PetscBool       isEssential;
2232 
2233     ierr = DMPlexGetBoundary(dm, bd, &isEssential, NULL, &bdLabel, &field, NULL, NULL, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
2234     if (isEssential) continue;
2235     if (numValues != 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Bug me and I will fix this");
2236     ierr = DMPlexGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
2237     ierr = DMLabelGetStratumSize(label, 1, &numPoints);CHKERRQ(ierr);
2238     ierr = DMLabelGetStratumIS(label, 1, &pointIS);CHKERRQ(ierr);
2239     ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
2240     for (p = 0, numFaces = 0; p < numPoints; ++p) {
2241       ierr = DMLabelGetValue(depth, points[p], &dep);CHKERRQ(ierr);
2242       if (dep == dim-1) ++numFaces;
2243     }
2244     ierr = PetscMalloc3(numFaces*totDimBd,&u,numFaces,&cgeom,numFaces*totDimBd*totDimBd,&elemMat);CHKERRQ(ierr);
2245     if (X_t) {ierr = PetscMalloc1(numFaces*totDimBd,&u_t);CHKERRQ(ierr);}
2246     for (p = 0, f = 0; p < numPoints; ++p) {
2247       const PetscInt point = points[p];
2248       PetscScalar   *x     = NULL;
2249       PetscInt       i;
2250 
2251       ierr = DMLabelGetValue(depth, points[p], &dep);CHKERRQ(ierr);
2252       if (dep != dim-1) continue;
2253       ierr = DMPlexComputeCellGeometryFEM(dm, point, NULL, cgeom[f].v0, cgeom[f].J, cgeom[f].invJ, &cgeom[f].detJ);CHKERRQ(ierr);
2254       ierr = DMPlexComputeCellGeometryFVM(dm, point, NULL, NULL, cgeom[f].n);CHKERRQ(ierr);
2255       if (cgeom[f].detJ <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for face %d", cgeom[f].detJ, point);
2256       ierr = DMPlexVecGetClosure(dm, section, X, point, NULL, &x);CHKERRQ(ierr);
2257       for (i = 0; i < totDimBd; ++i) u[f*totDimBd+i] = x[i];
2258       ierr = DMPlexVecRestoreClosure(dm, section, X, point, NULL, &x);CHKERRQ(ierr);
2259       if (X_t) {
2260         ierr = DMPlexVecGetClosure(dm, section, X_t, point, NULL, &x);CHKERRQ(ierr);
2261         for (i = 0; i < totDimBd; ++i) u_t[f*totDimBd+i] = x[i];
2262         ierr = DMPlexVecRestoreClosure(dm, section, X_t, point, NULL, &x);CHKERRQ(ierr);
2263       }
2264       ++f;
2265     }
2266     ierr = PetscMemzero(elemMat, numFaces*totDimBd*totDimBd * sizeof(PetscScalar));CHKERRQ(ierr);
2267     for (fieldI = 0; fieldI < Nf; ++fieldI) {
2268       PetscFE  fe;
2269       PetscInt numQuadPoints, Nb;
2270       /* Conforming batches */
2271       PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
2272       /* Remainder */
2273       PetscInt Nr, offset;
2274 
2275       ierr = PetscDSGetBdDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
2276       ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
2277       ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
2278       ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
2279       ierr = PetscQuadratureGetData(quad, NULL, &numQuadPoints, NULL, NULL);CHKERRQ(ierr);
2280       blockSize = Nb*numQuadPoints;
2281       batchSize = numBlocks * blockSize;
2282       ierr =  PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
2283       numChunks = numFaces / (numBatches*batchSize);
2284       Ne        = numChunks*numBatches*batchSize;
2285       Nr        = numFaces % (numBatches*batchSize);
2286       offset    = numFaces - Nr;
2287       for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
2288         ierr = PetscFEIntegrateBdJacobian(fe, prob, fieldI, fieldJ, Ne, cgeom, u, u_t, NULL, NULL, elemMat);CHKERRQ(ierr);
2289         ierr = PetscFEIntegrateBdJacobian(fe, prob, fieldI, fieldJ, Nr, &cgeom[offset], &u[offset*totDimBd], u_t ? &u_t[offset*totDimBd] : NULL, NULL, NULL, &elemMat[offset*totDimBd*totDimBd]);CHKERRQ(ierr);
2290       }
2291     }
2292     for (p = 0, f = 0; p < numPoints; ++p) {
2293       const PetscInt point = points[p];
2294 
2295       ierr = DMLabelGetValue(depth, point, &dep);CHKERRQ(ierr);
2296       if (dep != dim-1) continue;
2297       if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(point, "BdJacobian", totDimBd, totDimBd, &elemMat[f*totDimBd*totDimBd]);CHKERRQ(ierr);}
2298       ierr = DMPlexMatSetClosure(dm, section, globalSection, JacP, point, &elemMat[f*totDimBd*totDimBd], ADD_VALUES);CHKERRQ(ierr);
2299       ++f;
2300     }
2301     ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
2302     ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2303     ierr = PetscFree3(u,cgeom,elemMat);CHKERRQ(ierr);
2304     if (X_t) {ierr = PetscFree(u_t);CHKERRQ(ierr);}
2305   }
2306   ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2307   ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2308   if (mesh->printFEM) {
2309     ierr = PetscPrintf(PETSC_COMM_WORLD, "%s:\n", name);CHKERRQ(ierr);
2310     ierr = MatChop(JacP, 1.0e-10);CHKERRQ(ierr);
2311     ierr = MatView(JacP, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
2312   }
2313   ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
2314   ierr = PetscObjectTypeCompare((PetscObject) Jac, MATSHELL, &isShell);CHKERRQ(ierr);
2315   if (isShell) {
2316     JacActionCtx *jctx;
2317 
2318     ierr = MatShellGetContext(Jac, &jctx);CHKERRQ(ierr);
2319     ierr = VecCopy(X, jctx->u);CHKERRQ(ierr);
2320   }
2321   PetscFunctionReturn(0);
2322 }
2323 
2324 #undef __FUNCT__
2325 #define __FUNCT__ "DMPlexSNESComputeJacobianFEM"
2326 /*@
2327   DMPlexSNESComputeJacobianFEM - Form the local portion of the Jacobian matrix J at the local solution X using pointwise functions specified by the user.
2328 
2329   Input Parameters:
2330 + dm - The mesh
2331 . X  - Local input vector
2332 - user - The user context
2333 
2334   Output Parameter:
2335 . Jac  - Jacobian matrix
2336 
2337   Note:
2338   The first member of the user context must be an FEMContext.
2339 
2340   We form the residual one batch of elements at a time. This allows us to offload work onto an accelerator,
2341   like a GPU, or vectorize on a multicore machine.
2342 
2343   Level: developer
2344 
2345 .seealso: FormFunctionLocal()
2346 @*/
2347 PetscErrorCode DMPlexSNESComputeJacobianFEM(DM dm, Vec X, Mat Jac, Mat JacP,void *user)
2348 {
2349   PetscInt       cStart, cEnd, cEndInterior;
2350   PetscErrorCode ierr;
2351 
2352   PetscFunctionBegin;
2353   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2354   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
2355   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
2356   ierr = DMPlexComputeJacobian_Internal(dm, cStart, cEnd, 0.0, 0.0, X, NULL, Jac, JacP, user);CHKERRQ(ierr);
2357   PetscFunctionReturn(0);
2358 }
2359 
2360 #undef __FUNCT__
2361 #define __FUNCT__ "DMSNESCheckFromOptions_Internal"
2362 PetscErrorCode DMSNESCheckFromOptions_Internal(SNES snes, DM dm, Vec u, Vec sol, PetscErrorCode (**exactFuncs)(PetscInt, PetscReal, const PetscReal x[], PetscInt, PetscScalar *u, void *ctx), void **ctxs)
2363 {
2364   Mat            J, M;
2365   Vec            r, b;
2366   MatNullSpace   nullSpace;
2367   PetscReal     *error, res = 0.0;
2368   PetscInt       numFields;
2369   PetscErrorCode ierr;
2370 
2371   PetscFunctionBegin;
2372   ierr = VecDuplicate(u, &r);CHKERRQ(ierr);
2373   ierr = DMCreateMatrix(dm, &J);CHKERRQ(ierr);
2374   M    = J;
2375   /* TODO Null space for J */
2376   /* Check discretization error */
2377   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
2378   ierr = PetscMalloc1(PetscMax(1, numFields), &error);CHKERRQ(ierr);
2379   if (numFields > 1) {
2380     PetscInt f;
2381 
2382     ierr = DMPlexComputeL2FieldDiff(dm, 0.0, exactFuncs, ctxs, u, error);CHKERRQ(ierr);
2383     ierr = PetscPrintf(PETSC_COMM_WORLD, "L_2 Error: [");CHKERRQ(ierr);
2384     for (f = 0; f < numFields; ++f) {
2385       if (f) {ierr = PetscPrintf(PETSC_COMM_WORLD, ", ");CHKERRQ(ierr);}
2386       if (error[f] >= 1.0e-11) {ierr = PetscPrintf(PETSC_COMM_WORLD, "%g", error[f]);CHKERRQ(ierr);}
2387       else                     {ierr = PetscPrintf(PETSC_COMM_WORLD, "< 1.0e-11");CHKERRQ(ierr);}
2388     }
2389     ierr = PetscPrintf(PETSC_COMM_WORLD, "]\n");CHKERRQ(ierr);
2390   } else {
2391     ierr = DMPlexComputeL2Diff(dm, 0.0, exactFuncs, ctxs, u, &error[0]);CHKERRQ(ierr);
2392     if (error[0] >= 1.0e-11) {ierr = PetscPrintf(PETSC_COMM_WORLD, "L_2 Error: %g\n", error[0]);CHKERRQ(ierr);}
2393     else                     {ierr = PetscPrintf(PETSC_COMM_WORLD, "L_2 Error: < 1.0e-11\n");CHKERRQ(ierr);}
2394   }
2395   ierr = PetscFree(error);CHKERRQ(ierr);
2396   /* Check residual */
2397   ierr = SNESComputeFunction(snes, u, r);CHKERRQ(ierr);
2398   ierr = VecNorm(r, NORM_2, &res);CHKERRQ(ierr);
2399   ierr = PetscPrintf(PETSC_COMM_WORLD, "L_2 Residual: %g\n", res);CHKERRQ(ierr);
2400   ierr = VecChop(r, 1.0e-10);CHKERRQ(ierr);
2401   ierr = PetscObjectSetName((PetscObject) r, "Initial Residual");CHKERRQ(ierr);
2402   ierr = PetscObjectSetOptionsPrefix((PetscObject)r,"res_");CHKERRQ(ierr);
2403   ierr = VecViewFromOptions(r, NULL, "-vec_view");CHKERRQ(ierr);
2404   /* Check Jacobian */
2405   ierr = SNESComputeJacobian(snes, u, M, M);CHKERRQ(ierr);
2406   ierr = MatGetNullSpace(J, &nullSpace);CHKERRQ(ierr);
2407   if (nullSpace) {
2408     PetscBool isNull;
2409     ierr = MatNullSpaceTest(nullSpace, J, &isNull);CHKERRQ(ierr);
2410     if (!isNull) SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_PLIB, "The null space calculated for the system operator is invalid.");
2411   }
2412   ierr = VecDuplicate(u, &b);CHKERRQ(ierr);
2413   ierr = VecSet(r, 0.0);CHKERRQ(ierr);
2414   ierr = SNESComputeFunction(snes, r, b);CHKERRQ(ierr);
2415   ierr = MatMult(M, u, r);CHKERRQ(ierr);
2416   ierr = VecAXPY(r, 1.0, b);CHKERRQ(ierr);
2417   ierr = VecDestroy(&b);CHKERRQ(ierr);
2418   ierr = VecNorm(r, NORM_2, &res);CHKERRQ(ierr);
2419   ierr = PetscPrintf(PETSC_COMM_WORLD, "Linear L_2 Residual: %g\n", res);CHKERRQ(ierr);
2420   ierr = VecChop(r, 1.0e-10);CHKERRQ(ierr);
2421   ierr = PetscObjectSetName((PetscObject) r, "Au - b = Au + F(0)");CHKERRQ(ierr);
2422   ierr = PetscObjectSetOptionsPrefix((PetscObject)r,"linear_res_");CHKERRQ(ierr);
2423   ierr = VecViewFromOptions(r, NULL, "-vec_view");CHKERRQ(ierr);
2424   ierr = VecDestroy(&r);CHKERRQ(ierr);
2425   ierr = MatNullSpaceDestroy(&nullSpace);CHKERRQ(ierr);
2426   ierr = MatDestroy(&J);CHKERRQ(ierr);
2427   PetscFunctionReturn(0);
2428 }
2429 
2430 #undef __FUNCT__
2431 #define __FUNCT__ "DMSNESCheckFromOptions"
2432 PetscErrorCode DMSNESCheckFromOptions(SNES snes, Vec u, PetscErrorCode (**exactFuncs)(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nf, PetscScalar *u, void *ctx), void **ctxs)
2433 {
2434   DM             dm;
2435   Vec            sol;
2436   PetscBool      check;
2437   PetscErrorCode ierr;
2438 
2439   PetscFunctionBegin;
2440   ierr = PetscOptionsHasName(((PetscObject)snes)->options,((PetscObject)snes)->prefix, "-dmsnes_check", &check);CHKERRQ(ierr);
2441   if (!check) PetscFunctionReturn(0);
2442   ierr = SNESGetDM(snes, &dm);CHKERRQ(ierr);
2443   ierr = VecDuplicate(u, &sol);CHKERRQ(ierr);
2444   ierr = SNESSetSolution(snes, sol);CHKERRQ(ierr);
2445   ierr = DMSNESCheckFromOptions_Internal(snes, dm, u, sol, exactFuncs, ctxs);CHKERRQ(ierr);
2446   ierr = VecDestroy(&sol);CHKERRQ(ierr);
2447   PetscFunctionReturn(0);
2448 }
2449