xref: /petsc/src/dm/impls/plex/plexgeometry.c (revision 4e278199b78715991f5c71ebbd945c1489263e6c)
1 #include <petsc/private/dmpleximpl.h>   /*I      "petscdmplex.h"   I*/
2 #include <petsc/private/petscfeimpl.h>  /*I      "petscfe.h"       I*/
3 #include <petscblaslapack.h>
4 #include <petsctime.h>
5 
6 /*@
7   DMPlexFindVertices - Try to find DAG points based on their coordinates.
8 
9   Not Collective (provided DMGetCoordinatesLocalSetUp() has been called already)
10 
11   Input Parameters:
12 + dm - The DMPlex object
13 . npoints - The number of sought points
14 . coords - The array of coordinates of the sought points
15 - eps - The tolerance or PETSC_DEFAULT
16 
17   Output Parameters:
18 . dagPoints - The array of found DAG points, or -1 if not found
19 
20   Level: intermediate
21 
22   Notes:
23   The length of the array coords must be npoints * dim where dim is the spatial dimension returned by DMGetDimension().
24 
25   The output array dagPoints is NOT newly allocated; the user must pass an array of length npoints.
26 
27   Each rank does the search independently; a nonnegative value is returned only if this rank's local DMPlex portion contains the point.
28 
29   The tolerance is interpreted as the maximum Euclidean (L2) distance of the sought point from the specified coordinates.
30 
31   Complexity of this function is currently O(mn) with m number of vertices to find and n number of vertices in the local mesh. This could probably be improved.
32 
33 .seealso: DMPlexCreate(), DMGetCoordinatesLocal()
34 @*/
35 PetscErrorCode DMPlexFindVertices(DM dm, PetscInt npoints, const PetscReal coord[], PetscReal eps, PetscInt dagPoints[])
36 {
37   PetscInt          c, cdim, i, j, o, p, vStart, vEnd;
38   Vec               allCoordsVec;
39   const PetscScalar *allCoords;
40   PetscReal         norm;
41   PetscErrorCode    ierr;
42 
43   PetscFunctionBegin;
44   if (eps < 0) eps = PETSC_SQRT_MACHINE_EPSILON;
45   ierr = DMGetCoordinateDim(dm, &cdim);CHKERRQ(ierr);
46   ierr = DMGetCoordinatesLocal(dm, &allCoordsVec);CHKERRQ(ierr);
47   ierr = VecGetArrayRead(allCoordsVec, &allCoords);CHKERRQ(ierr);
48   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
49   if (PetscDefined(USE_DEBUG)) {
50     /* check coordinate section is consistent with DM dimension */
51     PetscSection      cs;
52     PetscInt          ndof;
53 
54     ierr = DMGetCoordinateSection(dm, &cs);CHKERRQ(ierr);
55     for (p = vStart; p < vEnd; p++) {
56       ierr = PetscSectionGetDof(cs, p, &ndof);CHKERRQ(ierr);
57       if (PetscUnlikely(ndof != cdim)) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "point %D: ndof = %D != %D = cdim", p, ndof, cdim);
58     }
59   }
60   if (eps == 0.0) {
61     for (i=0,j=0; i < npoints; i++,j+=cdim) {
62       dagPoints[i] = -1;
63       for (p = vStart,o=0; p < vEnd; p++,o+=cdim) {
64         for (c = 0; c < cdim; c++) {
65           if (coord[j+c] != PetscRealPart(allCoords[o+c])) break;
66         }
67         if (c == cdim) {
68           dagPoints[i] = p;
69           break;
70         }
71       }
72     }
73     ierr = VecRestoreArrayRead(allCoordsVec, &allCoords);CHKERRQ(ierr);
74     PetscFunctionReturn(0);
75   }
76   for (i=0,j=0; i < npoints; i++,j+=cdim) {
77     dagPoints[i] = -1;
78     for (p = vStart,o=0; p < vEnd; p++,o+=cdim) {
79       norm = 0.0;
80       for (c = 0; c < cdim; c++) {
81         norm += PetscSqr(coord[j+c] - PetscRealPart(allCoords[o+c]));
82       }
83       norm = PetscSqrtReal(norm);
84       if (norm <= eps) {
85         dagPoints[i] = p;
86         break;
87       }
88     }
89   }
90   ierr = VecRestoreArrayRead(allCoordsVec, &allCoords);CHKERRQ(ierr);
91   PetscFunctionReturn(0);
92 }
93 
94 static PetscErrorCode DMPlexGetLineIntersection_2D_Internal(const PetscReal segmentA[], const PetscReal segmentB[], PetscReal intersection[], PetscBool *hasIntersection)
95 {
96   const PetscReal p0_x  = segmentA[0*2+0];
97   const PetscReal p0_y  = segmentA[0*2+1];
98   const PetscReal p1_x  = segmentA[1*2+0];
99   const PetscReal p1_y  = segmentA[1*2+1];
100   const PetscReal p2_x  = segmentB[0*2+0];
101   const PetscReal p2_y  = segmentB[0*2+1];
102   const PetscReal p3_x  = segmentB[1*2+0];
103   const PetscReal p3_y  = segmentB[1*2+1];
104   const PetscReal s1_x  = p1_x - p0_x;
105   const PetscReal s1_y  = p1_y - p0_y;
106   const PetscReal s2_x  = p3_x - p2_x;
107   const PetscReal s2_y  = p3_y - p2_y;
108   const PetscReal denom = (-s2_x * s1_y + s1_x * s2_y);
109 
110   PetscFunctionBegin;
111   *hasIntersection = PETSC_FALSE;
112   /* Non-parallel lines */
113   if (denom != 0.0) {
114     const PetscReal s = (-s1_y * (p0_x - p2_x) + s1_x * (p0_y - p2_y)) / denom;
115     const PetscReal t = ( s2_x * (p0_y - p2_y) - s2_y * (p0_x - p2_x)) / denom;
116 
117     if (s >= 0 && s <= 1 && t >= 0 && t <= 1) {
118       *hasIntersection = PETSC_TRUE;
119       if (intersection) {
120         intersection[0] = p0_x + (t * s1_x);
121         intersection[1] = p0_y + (t * s1_y);
122       }
123     }
124   }
125   PetscFunctionReturn(0);
126 }
127 
128 static PetscErrorCode DMPlexLocatePoint_Simplex_2D_Internal(DM dm, const PetscScalar point[], PetscInt c, PetscInt *cell)
129 {
130   const PetscInt  embedDim = 2;
131   const PetscReal eps      = PETSC_SQRT_MACHINE_EPSILON;
132   PetscReal       x        = PetscRealPart(point[0]);
133   PetscReal       y        = PetscRealPart(point[1]);
134   PetscReal       v0[2], J[4], invJ[4], detJ;
135   PetscReal       xi, eta;
136   PetscErrorCode  ierr;
137 
138   PetscFunctionBegin;
139   ierr = DMPlexComputeCellGeometryFEM(dm, c, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
140   xi  = invJ[0*embedDim+0]*(x - v0[0]) + invJ[0*embedDim+1]*(y - v0[1]);
141   eta = invJ[1*embedDim+0]*(x - v0[0]) + invJ[1*embedDim+1]*(y - v0[1]);
142 
143   if ((xi >= -eps) && (eta >= -eps) && (xi + eta <= 2.0+eps)) *cell = c;
144   else *cell = DMLOCATEPOINT_POINT_NOT_FOUND;
145   PetscFunctionReturn(0);
146 }
147 
148 static PetscErrorCode DMPlexClosestPoint_Simplex_2D_Internal(DM dm, const PetscScalar point[], PetscInt c, PetscReal cpoint[])
149 {
150   const PetscInt  embedDim = 2;
151   PetscReal       x        = PetscRealPart(point[0]);
152   PetscReal       y        = PetscRealPart(point[1]);
153   PetscReal       v0[2], J[4], invJ[4], detJ;
154   PetscReal       xi, eta, r;
155   PetscErrorCode  ierr;
156 
157   PetscFunctionBegin;
158   ierr = DMPlexComputeCellGeometryFEM(dm, c, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
159   xi  = invJ[0*embedDim+0]*(x - v0[0]) + invJ[0*embedDim+1]*(y - v0[1]);
160   eta = invJ[1*embedDim+0]*(x - v0[0]) + invJ[1*embedDim+1]*(y - v0[1]);
161 
162   xi  = PetscMax(xi,  0.0);
163   eta = PetscMax(eta, 0.0);
164   if (xi + eta > 2.0) {
165     r    = (xi + eta)/2.0;
166     xi  /= r;
167     eta /= r;
168   }
169   cpoint[0] = J[0*embedDim+0]*xi + J[0*embedDim+1]*eta + v0[0];
170   cpoint[1] = J[1*embedDim+0]*xi + J[1*embedDim+1]*eta + v0[1];
171   PetscFunctionReturn(0);
172 }
173 
174 static PetscErrorCode DMPlexLocatePoint_Quad_2D_Internal(DM dm, const PetscScalar point[], PetscInt c, PetscInt *cell)
175 {
176   PetscSection       coordSection;
177   Vec             coordsLocal;
178   PetscScalar    *coords = NULL;
179   const PetscInt  faces[8]  = {0, 1, 1, 2, 2, 3, 3, 0};
180   PetscReal       x         = PetscRealPart(point[0]);
181   PetscReal       y         = PetscRealPart(point[1]);
182   PetscInt        crossings = 0, f;
183   PetscErrorCode  ierr;
184 
185   PetscFunctionBegin;
186   ierr = DMGetCoordinatesLocal(dm, &coordsLocal);CHKERRQ(ierr);
187   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
188   ierr = DMPlexVecGetClosure(dm, coordSection, coordsLocal, c, NULL, &coords);CHKERRQ(ierr);
189   for (f = 0; f < 4; ++f) {
190     PetscReal x_i   = PetscRealPart(coords[faces[2*f+0]*2+0]);
191     PetscReal y_i   = PetscRealPart(coords[faces[2*f+0]*2+1]);
192     PetscReal x_j   = PetscRealPart(coords[faces[2*f+1]*2+0]);
193     PetscReal y_j   = PetscRealPart(coords[faces[2*f+1]*2+1]);
194     PetscReal slope = (y_j - y_i) / (x_j - x_i);
195     PetscBool cond1 = (x_i <= x) && (x < x_j) ? PETSC_TRUE : PETSC_FALSE;
196     PetscBool cond2 = (x_j <= x) && (x < x_i) ? PETSC_TRUE : PETSC_FALSE;
197     PetscBool above = (y < slope * (x - x_i) + y_i) ? PETSC_TRUE : PETSC_FALSE;
198     if ((cond1 || cond2)  && above) ++crossings;
199   }
200   if (crossings % 2) *cell = c;
201   else *cell = DMLOCATEPOINT_POINT_NOT_FOUND;
202   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordsLocal, c, NULL, &coords);CHKERRQ(ierr);
203   PetscFunctionReturn(0);
204 }
205 
206 static PetscErrorCode DMPlexLocatePoint_Simplex_3D_Internal(DM dm, const PetscScalar point[], PetscInt c, PetscInt *cell)
207 {
208   const PetscInt  embedDim = 3;
209   const PetscReal eps      = PETSC_SQRT_MACHINE_EPSILON;
210   PetscReal       v0[3], J[9], invJ[9], detJ;
211   PetscReal       x = PetscRealPart(point[0]);
212   PetscReal       y = PetscRealPart(point[1]);
213   PetscReal       z = PetscRealPart(point[2]);
214   PetscReal       xi, eta, zeta;
215   PetscErrorCode  ierr;
216 
217   PetscFunctionBegin;
218   ierr = DMPlexComputeCellGeometryFEM(dm, c, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
219   xi   = invJ[0*embedDim+0]*(x - v0[0]) + invJ[0*embedDim+1]*(y - v0[1]) + invJ[0*embedDim+2]*(z - v0[2]);
220   eta  = invJ[1*embedDim+0]*(x - v0[0]) + invJ[1*embedDim+1]*(y - v0[1]) + invJ[1*embedDim+2]*(z - v0[2]);
221   zeta = invJ[2*embedDim+0]*(x - v0[0]) + invJ[2*embedDim+1]*(y - v0[1]) + invJ[2*embedDim+2]*(z - v0[2]);
222 
223   if ((xi >= -eps) && (eta >= -eps) && (zeta >= -eps) && (xi + eta + zeta <= 2.0+eps)) *cell = c;
224   else *cell = DMLOCATEPOINT_POINT_NOT_FOUND;
225   PetscFunctionReturn(0);
226 }
227 
228 static PetscErrorCode DMPlexLocatePoint_General_3D_Internal(DM dm, const PetscScalar point[], PetscInt c, PetscInt *cell)
229 {
230   PetscSection   coordSection;
231   Vec            coordsLocal;
232   PetscScalar   *coords = NULL;
233   const PetscInt faces[24] = {0, 3, 2, 1,  5, 4, 7, 6,  3, 0, 4, 5,
234                               1, 2, 6, 7,  3, 5, 6, 2,  0, 1, 7, 4};
235   PetscBool      found = PETSC_TRUE;
236   PetscInt       f;
237   PetscErrorCode ierr;
238 
239   PetscFunctionBegin;
240   ierr = DMGetCoordinatesLocal(dm, &coordsLocal);CHKERRQ(ierr);
241   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
242   ierr = DMPlexVecGetClosure(dm, coordSection, coordsLocal, c, NULL, &coords);CHKERRQ(ierr);
243   for (f = 0; f < 6; ++f) {
244     /* Check the point is under plane */
245     /*   Get face normal */
246     PetscReal v_i[3];
247     PetscReal v_j[3];
248     PetscReal normal[3];
249     PetscReal pp[3];
250     PetscReal dot;
251 
252     v_i[0]    = PetscRealPart(coords[faces[f*4+3]*3+0]-coords[faces[f*4+0]*3+0]);
253     v_i[1]    = PetscRealPart(coords[faces[f*4+3]*3+1]-coords[faces[f*4+0]*3+1]);
254     v_i[2]    = PetscRealPart(coords[faces[f*4+3]*3+2]-coords[faces[f*4+0]*3+2]);
255     v_j[0]    = PetscRealPart(coords[faces[f*4+1]*3+0]-coords[faces[f*4+0]*3+0]);
256     v_j[1]    = PetscRealPart(coords[faces[f*4+1]*3+1]-coords[faces[f*4+0]*3+1]);
257     v_j[2]    = PetscRealPart(coords[faces[f*4+1]*3+2]-coords[faces[f*4+0]*3+2]);
258     normal[0] = v_i[1]*v_j[2] - v_i[2]*v_j[1];
259     normal[1] = v_i[2]*v_j[0] - v_i[0]*v_j[2];
260     normal[2] = v_i[0]*v_j[1] - v_i[1]*v_j[0];
261     pp[0]     = PetscRealPart(coords[faces[f*4+0]*3+0] - point[0]);
262     pp[1]     = PetscRealPart(coords[faces[f*4+0]*3+1] - point[1]);
263     pp[2]     = PetscRealPart(coords[faces[f*4+0]*3+2] - point[2]);
264     dot       = normal[0]*pp[0] + normal[1]*pp[1] + normal[2]*pp[2];
265 
266     /* Check that projected point is in face (2D location problem) */
267     if (dot < 0.0) {
268       found = PETSC_FALSE;
269       break;
270     }
271   }
272   if (found) *cell = c;
273   else *cell = DMLOCATEPOINT_POINT_NOT_FOUND;
274   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordsLocal, c, NULL, &coords);CHKERRQ(ierr);
275   PetscFunctionReturn(0);
276 }
277 
278 static PetscErrorCode PetscGridHashInitialize_Internal(PetscGridHash box, PetscInt dim, const PetscScalar point[])
279 {
280   PetscInt d;
281 
282   PetscFunctionBegin;
283   box->dim = dim;
284   for (d = 0; d < dim; ++d) box->lower[d] = box->upper[d] = PetscRealPart(point[d]);
285   PetscFunctionReturn(0);
286 }
287 
288 PetscErrorCode PetscGridHashCreate(MPI_Comm comm, PetscInt dim, const PetscScalar point[], PetscGridHash *box)
289 {
290   PetscErrorCode ierr;
291 
292   PetscFunctionBegin;
293   ierr = PetscMalloc1(1, box);CHKERRQ(ierr);
294   ierr = PetscGridHashInitialize_Internal(*box, dim, point);CHKERRQ(ierr);
295   PetscFunctionReturn(0);
296 }
297 
298 PetscErrorCode PetscGridHashEnlarge(PetscGridHash box, const PetscScalar point[])
299 {
300   PetscInt d;
301 
302   PetscFunctionBegin;
303   for (d = 0; d < box->dim; ++d) {
304     box->lower[d] = PetscMin(box->lower[d], PetscRealPart(point[d]));
305     box->upper[d] = PetscMax(box->upper[d], PetscRealPart(point[d]));
306   }
307   PetscFunctionReturn(0);
308 }
309 
310 /*
311   PetscGridHashSetGrid - Divide the grid into boxes
312 
313   Not collective
314 
315   Input Parameters:
316 + box - The grid hash object
317 . n   - The number of boxes in each dimension, or PETSC_DETERMINE
318 - h   - The box size in each dimension, only used if n[d] == PETSC_DETERMINE
319 
320   Level: developer
321 
322 .seealso: PetscGridHashCreate()
323 */
324 PetscErrorCode PetscGridHashSetGrid(PetscGridHash box, const PetscInt n[], const PetscReal h[])
325 {
326   PetscInt d;
327 
328   PetscFunctionBegin;
329   for (d = 0; d < box->dim; ++d) {
330     box->extent[d] = box->upper[d] - box->lower[d];
331     if (n[d] == PETSC_DETERMINE) {
332       box->h[d] = h[d];
333       box->n[d] = PetscCeilReal(box->extent[d]/h[d]);
334     } else {
335       box->n[d] = n[d];
336       box->h[d] = box->extent[d]/n[d];
337     }
338   }
339   PetscFunctionReturn(0);
340 }
341 
342 /*
343   PetscGridHashGetEnclosingBox - Find the grid boxes containing each input point
344 
345   Not collective
346 
347   Input Parameters:
348 + box       - The grid hash object
349 . numPoints - The number of input points
350 - points    - The input point coordinates
351 
352   Output Parameters:
353 + dboxes    - An array of numPoints*dim integers expressing the enclosing box as (i_0, i_1, ..., i_dim)
354 - boxes     - An array of numPoints integers expressing the enclosing box as single number, or NULL
355 
356   Level: developer
357 
358 .seealso: PetscGridHashCreate()
359 */
360 PetscErrorCode PetscGridHashGetEnclosingBox(PetscGridHash box, PetscInt numPoints, const PetscScalar points[], PetscInt dboxes[], PetscInt boxes[])
361 {
362   const PetscReal *lower = box->lower;
363   const PetscReal *upper = box->upper;
364   const PetscReal *h     = box->h;
365   const PetscInt  *n     = box->n;
366   const PetscInt   dim   = box->dim;
367   PetscInt         d, p;
368 
369   PetscFunctionBegin;
370   for (p = 0; p < numPoints; ++p) {
371     for (d = 0; d < dim; ++d) {
372       PetscInt dbox = PetscFloorReal((PetscRealPart(points[p*dim+d]) - lower[d])/h[d]);
373 
374       if (dbox == n[d] && PetscAbsReal(PetscRealPart(points[p*dim+d]) - upper[d]) < 1.0e-9) dbox = n[d]-1;
375       if (dbox == -1   && PetscAbsReal(PetscRealPart(points[p*dim+d]) - lower[d]) < 1.0e-9) dbox = 0;
376       if (dbox < 0 || dbox >= n[d]) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Input point %d (%g, %g, %g) is outside of our bounding box",
377                                              p, (double) PetscRealPart(points[p*dim+0]), dim > 1 ? (double) PetscRealPart(points[p*dim+1]) : 0.0, dim > 2 ? (double) PetscRealPart(points[p*dim+2]) : 0.0);
378       dboxes[p*dim+d] = dbox;
379     }
380     if (boxes) for (d = 1, boxes[p] = dboxes[p*dim]; d < dim; ++d) boxes[p] += dboxes[p*dim+d]*n[d-1];
381   }
382   PetscFunctionReturn(0);
383 }
384 
385 /*
386  PetscGridHashGetEnclosingBoxQuery - Find the grid boxes containing each input point
387 
388  Not collective
389 
390   Input Parameters:
391 + box       - The grid hash object
392 . numPoints - The number of input points
393 - points    - The input point coordinates
394 
395   Output Parameters:
396 + dboxes    - An array of numPoints*dim integers expressing the enclosing box as (i_0, i_1, ..., i_dim)
397 . boxes     - An array of numPoints integers expressing the enclosing box as single number, or NULL
398 - found     - Flag indicating if point was located within a box
399 
400   Level: developer
401 
402 .seealso: PetscGridHashGetEnclosingBox()
403 */
404 PetscErrorCode PetscGridHashGetEnclosingBoxQuery(PetscGridHash box, PetscInt numPoints, const PetscScalar points[], PetscInt dboxes[], PetscInt boxes[],PetscBool *found)
405 {
406   const PetscReal *lower = box->lower;
407   const PetscReal *upper = box->upper;
408   const PetscReal *h     = box->h;
409   const PetscInt  *n     = box->n;
410   const PetscInt   dim   = box->dim;
411   PetscInt         d, p;
412 
413   PetscFunctionBegin;
414   *found = PETSC_FALSE;
415   for (p = 0; p < numPoints; ++p) {
416     for (d = 0; d < dim; ++d) {
417       PetscInt dbox = PetscFloorReal((PetscRealPart(points[p*dim+d]) - lower[d])/h[d]);
418 
419       if (dbox == n[d] && PetscAbsReal(PetscRealPart(points[p*dim+d]) - upper[d]) < 1.0e-9) dbox = n[d]-1;
420       if (dbox < 0 || dbox >= n[d]) {
421         PetscFunctionReturn(0);
422       }
423       dboxes[p*dim+d] = dbox;
424     }
425     if (boxes) for (d = 1, boxes[p] = dboxes[p*dim]; d < dim; ++d) boxes[p] += dboxes[p*dim+d]*n[d-1];
426   }
427   *found = PETSC_TRUE;
428   PetscFunctionReturn(0);
429 }
430 
431 PetscErrorCode PetscGridHashDestroy(PetscGridHash *box)
432 {
433   PetscErrorCode ierr;
434 
435   PetscFunctionBegin;
436   if (*box) {
437     ierr = PetscSectionDestroy(&(*box)->cellSection);CHKERRQ(ierr);
438     ierr = ISDestroy(&(*box)->cells);CHKERRQ(ierr);
439     ierr = DMLabelDestroy(&(*box)->cellsSparse);CHKERRQ(ierr);
440   }
441   ierr = PetscFree(*box);CHKERRQ(ierr);
442   PetscFunctionReturn(0);
443 }
444 
445 PetscErrorCode DMPlexLocatePoint_Internal(DM dm, PetscInt dim, const PetscScalar point[], PetscInt cellStart, PetscInt *cell)
446 {
447   DMPolytopeType ct;
448   PetscErrorCode ierr;
449 
450   PetscFunctionBegin;
451   ierr = DMPlexGetCellType(dm, cellStart, &ct);CHKERRQ(ierr);
452   switch (ct) {
453     case DM_POLYTOPE_TRIANGLE:
454     ierr = DMPlexLocatePoint_Simplex_2D_Internal(dm, point, cellStart, cell);CHKERRQ(ierr);break;
455     case DM_POLYTOPE_QUADRILATERAL:
456     ierr = DMPlexLocatePoint_Quad_2D_Internal(dm, point, cellStart, cell);CHKERRQ(ierr);break;
457     case DM_POLYTOPE_TETRAHEDRON:
458     ierr = DMPlexLocatePoint_Simplex_3D_Internal(dm, point, cellStart, cell);CHKERRQ(ierr);break;
459     case DM_POLYTOPE_HEXAHEDRON:
460     ierr = DMPlexLocatePoint_General_3D_Internal(dm, point, cellStart, cell);CHKERRQ(ierr);break;
461     default: SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "No point location for cell %D with type %s", cellStart, DMPolytopeTypes[ct]);
462   }
463   PetscFunctionReturn(0);
464 }
465 
466 /*
467   DMPlexClosestPoint_Internal - Returns the closest point in the cell to the given point
468 */
469 PetscErrorCode DMPlexClosestPoint_Internal(DM dm, PetscInt dim, const PetscScalar point[], PetscInt cell, PetscReal cpoint[])
470 {
471   DMPolytopeType ct;
472   PetscErrorCode ierr;
473 
474   PetscFunctionBegin;
475   ierr = DMPlexGetCellType(dm, cell, &ct);CHKERRQ(ierr);
476   switch (ct) {
477     case DM_POLYTOPE_TRIANGLE:
478     ierr = DMPlexClosestPoint_Simplex_2D_Internal(dm, point, cell, cpoint);CHKERRQ(ierr);break;
479 #if 0
480     case DM_POLYTOPE_QUADRILATERAL:
481     ierr = DMPlexClosestPoint_General_2D_Internal(dm, point, cell, cpoint);CHKERRQ(ierr);break;
482     case DM_POLYTOPE_TETRAHEDRON:
483     ierr = DMPlexClosestPoint_Simplex_3D_Internal(dm, point, cell, cpoint);CHKERRQ(ierr);break;
484     case DM_POLYTOPE_HEXAHEDRON:
485     ierr = DMPlexClosestPoint_General_3D_Internal(dm, point, cell, cpoint);CHKERRQ(ierr);break;
486 #endif
487     default: SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "No closest point location for cell %D with type %s", cell, DMPolytopeTypes[ct]);
488   }
489   PetscFunctionReturn(0);
490 }
491 
492 /*
493   DMPlexComputeGridHash_Internal - Create a grid hash structure covering the Plex
494 
495   Collective on dm
496 
497   Input Parameter:
498 . dm - The Plex
499 
500   Output Parameter:
501 . localBox - The grid hash object
502 
503   Level: developer
504 
505 .seealso: PetscGridHashCreate(), PetscGridHashGetEnclosingBox()
506 */
507 PetscErrorCode DMPlexComputeGridHash_Internal(DM dm, PetscGridHash *localBox)
508 {
509   MPI_Comm           comm;
510   PetscGridHash      lbox;
511   Vec                coordinates;
512   PetscSection       coordSection;
513   Vec                coordsLocal;
514   const PetscScalar *coords;
515   PetscInt          *dboxes, *boxes;
516   PetscInt           n[3] = {10, 10, 10};
517   PetscInt           dim, N, cStart, cEnd, c, i;
518   PetscErrorCode     ierr;
519 
520   PetscFunctionBegin;
521   ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
522   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
523   ierr = DMGetCoordinateDim(dm, &dim);CHKERRQ(ierr);
524   if (dim != 2) SETERRQ(comm, PETSC_ERR_SUP, "I have only coded this for 2D");
525   ierr = VecGetLocalSize(coordinates, &N);CHKERRQ(ierr);
526   ierr = VecGetArrayRead(coordinates, &coords);CHKERRQ(ierr);
527   ierr = PetscGridHashCreate(comm, dim, coords, &lbox);CHKERRQ(ierr);
528   for (i = 0; i < N; i += dim) {ierr = PetscGridHashEnlarge(lbox, &coords[i]);CHKERRQ(ierr);}
529   ierr = VecRestoreArrayRead(coordinates, &coords);CHKERRQ(ierr);
530   ierr = PetscOptionsGetInt(NULL,NULL,"-dm_plex_hash_box_nijk",&n[0],NULL);CHKERRQ(ierr);
531   n[1] = n[0];
532   n[2] = n[0];
533   ierr = PetscGridHashSetGrid(lbox, n, NULL);CHKERRQ(ierr);
534 #if 0
535   /* Could define a custom reduction to merge these */
536   ierr = MPIU_Allreduce(lbox->lower, gbox->lower, 3, MPIU_REAL, MPI_MIN, comm);CHKERRMPI(ierr);
537   ierr = MPIU_Allreduce(lbox->upper, gbox->upper, 3, MPIU_REAL, MPI_MAX, comm);CHKERRMPI(ierr);
538 #endif
539   /* Is there a reason to snap the local bounding box to a division of the global box? */
540   /* Should we compute all overlaps of local boxes? We could do this with a rendevouz scheme partitioning the global box */
541   /* Create label */
542   ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
543   ierr = DMLabelCreate(PETSC_COMM_SELF, "cells", &lbox->cellsSparse);CHKERRQ(ierr);
544   ierr = DMLabelCreateIndex(lbox->cellsSparse, cStart, cEnd);CHKERRQ(ierr);
545   /* Compute boxes which overlap each cell: https://stackoverflow.com/questions/13790208/triangle-square-intersection-test-in-2d */
546   ierr = DMGetCoordinatesLocal(dm, &coordsLocal);CHKERRQ(ierr);
547   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
548   ierr = PetscCalloc2(16 * dim, &dboxes, 16, &boxes);CHKERRQ(ierr);
549   for (c = cStart; c < cEnd; ++c) {
550     const PetscReal *h       = lbox->h;
551     PetscScalar     *ccoords = NULL;
552     PetscInt         csize   = 0;
553     PetscScalar      point[3];
554     PetscInt         dlim[6], d, e, i, j, k;
555 
556     /* Find boxes enclosing each vertex */
557     ierr = DMPlexVecGetClosure(dm, coordSection, coordsLocal, c, &csize, &ccoords);CHKERRQ(ierr);
558     ierr = PetscGridHashGetEnclosingBox(lbox, csize/dim, ccoords, dboxes, boxes);CHKERRQ(ierr);
559     /* Mark cells containing the vertices */
560     for (e = 0; e < csize/dim; ++e) {ierr = DMLabelSetValue(lbox->cellsSparse, c, boxes[e]);CHKERRQ(ierr);}
561     /* Get grid of boxes containing these */
562     for (d = 0;   d < dim; ++d) {dlim[d*2+0] = dlim[d*2+1] = dboxes[d];}
563     for (d = dim; d < 3;   ++d) {dlim[d*2+0] = dlim[d*2+1] = 0;}
564     for (e = 1; e < dim+1; ++e) {
565       for (d = 0; d < dim; ++d) {
566         dlim[d*2+0] = PetscMin(dlim[d*2+0], dboxes[e*dim+d]);
567         dlim[d*2+1] = PetscMax(dlim[d*2+1], dboxes[e*dim+d]);
568       }
569     }
570     /* Check for intersection of box with cell */
571     for (k = dlim[2*2+0], point[2] = lbox->lower[2] + k*h[2]; k <= dlim[2*2+1]; ++k, point[2] += h[2]) {
572       for (j = dlim[1*2+0], point[1] = lbox->lower[1] + j*h[1]; j <= dlim[1*2+1]; ++j, point[1] += h[1]) {
573         for (i = dlim[0*2+0], point[0] = lbox->lower[0] + i*h[0]; i <= dlim[0*2+1]; ++i, point[0] += h[0]) {
574           const PetscInt box = (k*lbox->n[1] + j)*lbox->n[0] + i;
575           PetscScalar    cpoint[3];
576           PetscInt       cell, edge, ii, jj, kk;
577 
578           /* Check whether cell contains any vertex of these subboxes TODO vectorize this */
579           for (kk = 0, cpoint[2] = point[2]; kk < (dim > 2 ? 2 : 1); ++kk, cpoint[2] += h[2]) {
580             for (jj = 0, cpoint[1] = point[1]; jj < (dim > 1 ? 2 : 1); ++jj, cpoint[1] += h[1]) {
581               for (ii = 0, cpoint[0] = point[0]; ii < 2; ++ii, cpoint[0] += h[0]) {
582 
583                 ierr = DMPlexLocatePoint_Internal(dm, dim, cpoint, c, &cell);CHKERRQ(ierr);
584                 if (cell >= 0) { ierr = DMLabelSetValue(lbox->cellsSparse, c, box);CHKERRQ(ierr); ii = jj = kk = 2;}
585               }
586             }
587           }
588           /* Check whether cell edge intersects any edge of these subboxes TODO vectorize this */
589           for (edge = 0; edge < dim+1; ++edge) {
590             PetscReal segA[6], segB[6];
591 
592             if (PetscUnlikely(dim > 3)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected dim %d > 3",dim);
593             for (d = 0; d < dim; ++d) {segA[d] = PetscRealPart(ccoords[edge*dim+d]); segA[dim+d] = PetscRealPart(ccoords[((edge+1)%(dim+1))*dim+d]);}
594             for (kk = 0; kk < (dim > 2 ? 2 : 1); ++kk) {
595               if (dim > 2) {segB[2]     = PetscRealPart(point[2]);
596                             segB[dim+2] = PetscRealPart(point[2]) + kk*h[2];}
597               for (jj = 0; jj < (dim > 1 ? 2 : 1); ++jj) {
598                 if (dim > 1) {segB[1]     = PetscRealPart(point[1]);
599                               segB[dim+1] = PetscRealPart(point[1]) + jj*h[1];}
600                 for (ii = 0; ii < 2; ++ii) {
601                   PetscBool intersects;
602 
603                   segB[0]     = PetscRealPart(point[0]);
604                   segB[dim+0] = PetscRealPart(point[0]) + ii*h[0];
605                   ierr = DMPlexGetLineIntersection_2D_Internal(segA, segB, NULL, &intersects);CHKERRQ(ierr);
606                   if (intersects) { ierr = DMLabelSetValue(lbox->cellsSparse, c, box);CHKERRQ(ierr); edge = ii = jj = kk = dim+1;}
607                 }
608               }
609             }
610           }
611         }
612       }
613     }
614     ierr = DMPlexVecRestoreClosure(dm, coordSection, coordsLocal, c, NULL, &ccoords);CHKERRQ(ierr);
615   }
616   ierr = PetscFree2(dboxes, boxes);CHKERRQ(ierr);
617   ierr = DMLabelConvertToSection(lbox->cellsSparse, &lbox->cellSection, &lbox->cells);CHKERRQ(ierr);
618   ierr = DMLabelDestroy(&lbox->cellsSparse);CHKERRQ(ierr);
619   *localBox = lbox;
620   PetscFunctionReturn(0);
621 }
622 
623 PetscErrorCode DMLocatePoints_Plex(DM dm, Vec v, DMPointLocationType ltype, PetscSF cellSF)
624 {
625   DM_Plex        *mesh = (DM_Plex *) dm->data;
626   PetscBool       hash = mesh->useHashLocation, reuse = PETSC_FALSE;
627   PetscInt        bs, numPoints, p, numFound, *found = NULL;
628   PetscInt        dim, cStart, cEnd, numCells, c, d;
629   const PetscInt *boxCells;
630   PetscSFNode    *cells;
631   PetscScalar    *a;
632   PetscMPIInt     result;
633   PetscLogDouble  t0,t1;
634   PetscReal       gmin[3],gmax[3];
635   PetscInt        terminating_query_type[] = { 0, 0, 0 };
636   PetscErrorCode  ierr;
637 
638   PetscFunctionBegin;
639   ierr = PetscLogEventBegin(DMPLEX_LocatePoints,0,0,0,0);CHKERRQ(ierr);
640   ierr = PetscTime(&t0);CHKERRQ(ierr);
641   if (ltype == DM_POINTLOCATION_NEAREST && !hash) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Nearest point location only supported with grid hashing. Use -dm_plex_hash_location to enable it.");
642   ierr = DMGetCoordinateDim(dm, &dim);CHKERRQ(ierr);
643   ierr = VecGetBlockSize(v, &bs);CHKERRQ(ierr);
644   ierr = MPI_Comm_compare(PetscObjectComm((PetscObject)cellSF),PETSC_COMM_SELF,&result);CHKERRMPI(ierr);
645   if (result != MPI_IDENT && result != MPI_CONGRUENT) SETERRQ(PetscObjectComm((PetscObject)cellSF),PETSC_ERR_SUP, "Trying parallel point location: only local point location supported");
646   if (bs != dim) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Block size for point vector %D must be the mesh coordinate dimension %D", bs, dim);
647   ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
648   ierr = VecGetLocalSize(v, &numPoints);CHKERRQ(ierr);
649   ierr = VecGetArray(v, &a);CHKERRQ(ierr);
650   numPoints /= bs;
651   {
652     const PetscSFNode *sf_cells;
653 
654     ierr = PetscSFGetGraph(cellSF,NULL,NULL,NULL,&sf_cells);CHKERRQ(ierr);
655     if (sf_cells) {
656       ierr = PetscInfo(dm,"[DMLocatePoints_Plex] Re-using existing StarForest node list\n");CHKERRQ(ierr);
657       cells = (PetscSFNode*)sf_cells;
658       reuse = PETSC_TRUE;
659     } else {
660       ierr = PetscInfo(dm,"[DMLocatePoints_Plex] Creating and initializing new StarForest node list\n");CHKERRQ(ierr);
661       ierr = PetscMalloc1(numPoints, &cells);CHKERRQ(ierr);
662       /* initialize cells if created */
663       for (p=0; p<numPoints; p++) {
664         cells[p].rank  = 0;
665         cells[p].index = DMLOCATEPOINT_POINT_NOT_FOUND;
666       }
667     }
668   }
669   /* define domain bounding box */
670   {
671     Vec coorglobal;
672 
673     ierr = DMGetCoordinates(dm,&coorglobal);CHKERRQ(ierr);
674     ierr = VecStrideMaxAll(coorglobal,NULL,gmax);CHKERRQ(ierr);
675     ierr = VecStrideMinAll(coorglobal,NULL,gmin);CHKERRQ(ierr);
676   }
677   if (hash) {
678     if (!mesh->lbox) {ierr = PetscInfo(dm, "Initializing grid hashing");CHKERRQ(ierr);ierr = DMPlexComputeGridHash_Internal(dm, &mesh->lbox);CHKERRQ(ierr);}
679     /* Designate the local box for each point */
680     /* Send points to correct process */
681     /* Search cells that lie in each subbox */
682     /*   Should we bin points before doing search? */
683     ierr = ISGetIndices(mesh->lbox->cells, &boxCells);CHKERRQ(ierr);
684   }
685   for (p = 0, numFound = 0; p < numPoints; ++p) {
686     const PetscScalar *point = &a[p*bs];
687     PetscInt           dbin[3] = {-1,-1,-1}, bin, cell = -1, cellOffset;
688     PetscBool          point_outside_domain = PETSC_FALSE;
689 
690     /* check bounding box of domain */
691     for (d=0; d<dim; d++) {
692       if (PetscRealPart(point[d]) < gmin[d]) { point_outside_domain = PETSC_TRUE; break; }
693       if (PetscRealPart(point[d]) > gmax[d]) { point_outside_domain = PETSC_TRUE; break; }
694     }
695     if (point_outside_domain) {
696       cells[p].rank = 0;
697       cells[p].index = DMLOCATEPOINT_POINT_NOT_FOUND;
698       terminating_query_type[0]++;
699       continue;
700     }
701 
702     /* check initial values in cells[].index - abort early if found */
703     if (cells[p].index != DMLOCATEPOINT_POINT_NOT_FOUND) {
704       c = cells[p].index;
705       cells[p].index = DMLOCATEPOINT_POINT_NOT_FOUND;
706       ierr = DMPlexLocatePoint_Internal(dm, dim, point, c, &cell);CHKERRQ(ierr);
707       if (cell >= 0) {
708         cells[p].rank = 0;
709         cells[p].index = cell;
710         numFound++;
711       }
712     }
713     if (cells[p].index != DMLOCATEPOINT_POINT_NOT_FOUND) {
714       terminating_query_type[1]++;
715       continue;
716     }
717 
718     if (hash) {
719       PetscBool found_box;
720 
721       /* allow for case that point is outside box - abort early */
722       ierr = PetscGridHashGetEnclosingBoxQuery(mesh->lbox, 1, point, dbin, &bin,&found_box);CHKERRQ(ierr);
723       if (found_box) {
724         /* TODO Lay an interface over this so we can switch between Section (dense) and Label (sparse) */
725         ierr = PetscSectionGetDof(mesh->lbox->cellSection, bin, &numCells);CHKERRQ(ierr);
726         ierr = PetscSectionGetOffset(mesh->lbox->cellSection, bin, &cellOffset);CHKERRQ(ierr);
727         for (c = cellOffset; c < cellOffset + numCells; ++c) {
728           ierr = DMPlexLocatePoint_Internal(dm, dim, point, boxCells[c], &cell);CHKERRQ(ierr);
729           if (cell >= 0) {
730             cells[p].rank = 0;
731             cells[p].index = cell;
732             numFound++;
733             terminating_query_type[2]++;
734             break;
735           }
736         }
737       }
738     } else {
739       for (c = cStart; c < cEnd; ++c) {
740         ierr = DMPlexLocatePoint_Internal(dm, dim, point, c, &cell);CHKERRQ(ierr);
741         if (cell >= 0) {
742           cells[p].rank = 0;
743           cells[p].index = cell;
744           numFound++;
745           terminating_query_type[2]++;
746           break;
747         }
748       }
749     }
750   }
751   if (hash) {ierr = ISRestoreIndices(mesh->lbox->cells, &boxCells);CHKERRQ(ierr);}
752   if (ltype == DM_POINTLOCATION_NEAREST && hash && numFound < numPoints) {
753     for (p = 0; p < numPoints; p++) {
754       const PetscScalar *point = &a[p*bs];
755       PetscReal          cpoint[3], diff[3], dist, distMax = PETSC_MAX_REAL;
756       PetscInt           dbin[3] = {-1,-1,-1}, bin, cellOffset, d;
757 
758       if (cells[p].index < 0) {
759         ++numFound;
760         ierr = PetscGridHashGetEnclosingBox(mesh->lbox, 1, point, dbin, &bin);CHKERRQ(ierr);
761         ierr = PetscSectionGetDof(mesh->lbox->cellSection, bin, &numCells);CHKERRQ(ierr);
762         ierr = PetscSectionGetOffset(mesh->lbox->cellSection, bin, &cellOffset);CHKERRQ(ierr);
763         for (c = cellOffset; c < cellOffset + numCells; ++c) {
764           ierr = DMPlexClosestPoint_Internal(dm, dim, point, boxCells[c], cpoint);CHKERRQ(ierr);
765           for (d = 0; d < dim; ++d) diff[d] = cpoint[d] - PetscRealPart(point[d]);
766           dist = DMPlex_NormD_Internal(dim, diff);
767           if (dist < distMax) {
768             for (d = 0; d < dim; ++d) a[p*bs+d] = cpoint[d];
769             cells[p].rank  = 0;
770             cells[p].index = boxCells[c];
771             distMax = dist;
772             break;
773           }
774         }
775       }
776     }
777   }
778   /* This code is only be relevant when interfaced to parallel point location */
779   /* Check for highest numbered proc that claims a point (do we care?) */
780   if (ltype == DM_POINTLOCATION_REMOVE && numFound < numPoints) {
781     ierr = PetscMalloc1(numFound,&found);CHKERRQ(ierr);
782     for (p = 0, numFound = 0; p < numPoints; p++) {
783       if (cells[p].rank >= 0 && cells[p].index >= 0) {
784         if (numFound < p) {
785           cells[numFound] = cells[p];
786         }
787         found[numFound++] = p;
788       }
789     }
790   }
791   ierr = VecRestoreArray(v, &a);CHKERRQ(ierr);
792   if (!reuse) {
793     ierr = PetscSFSetGraph(cellSF, cEnd - cStart, numFound, found, PETSC_OWN_POINTER, cells, PETSC_OWN_POINTER);CHKERRQ(ierr);
794   }
795   ierr = PetscTime(&t1);CHKERRQ(ierr);
796   if (hash) {
797     ierr = PetscInfo3(dm,"[DMLocatePoints_Plex] terminating_query_type : %D [outside domain] : %D [inside initial cell] : %D [hash]\n",terminating_query_type[0],terminating_query_type[1],terminating_query_type[2]);CHKERRQ(ierr);
798   } else {
799     ierr = PetscInfo3(dm,"[DMLocatePoints_Plex] terminating_query_type : %D [outside domain] : %D [inside initial cell] : %D [brute-force]\n",terminating_query_type[0],terminating_query_type[1],terminating_query_type[2]);CHKERRQ(ierr);
800   }
801   ierr = PetscInfo3(dm,"[DMLocatePoints_Plex] npoints %D : time(rank0) %1.2e (sec): points/sec %1.4e\n",numPoints,t1-t0,(double)((double)numPoints/(t1-t0)));CHKERRQ(ierr);
802   ierr = PetscLogEventEnd(DMPLEX_LocatePoints,0,0,0,0);CHKERRQ(ierr);
803   PetscFunctionReturn(0);
804 }
805 
806 /*@C
807   DMPlexComputeProjection2Dto1D - Rewrite coordinates to be the 1D projection of the 2D coordinates
808 
809   Not collective
810 
811   Input Parameter:
812 . coords - The coordinates of a segment
813 
814   Output Parameters:
815 + coords - The new y-coordinate, and 0 for x
816 - R - The rotation which accomplishes the projection
817 
818   Level: developer
819 
820 .seealso: DMPlexComputeProjection3Dto1D(), DMPlexComputeProjection3Dto2D()
821 @*/
822 PetscErrorCode DMPlexComputeProjection2Dto1D(PetscScalar coords[], PetscReal R[])
823 {
824   const PetscReal x = PetscRealPart(coords[2] - coords[0]);
825   const PetscReal y = PetscRealPart(coords[3] - coords[1]);
826   const PetscReal r = PetscSqrtReal(x*x + y*y), c = x/r, s = y/r;
827 
828   PetscFunctionBegin;
829   R[0] = c; R[1] = -s;
830   R[2] = s; R[3] =  c;
831   coords[0] = 0.0;
832   coords[1] = r;
833   PetscFunctionReturn(0);
834 }
835 
836 /*@C
837   DMPlexComputeProjection3Dto1D - Rewrite coordinates to be the 1D projection of the 3D coordinates
838 
839   Not collective
840 
841   Input Parameter:
842 . coords - The coordinates of a segment
843 
844   Output Parameters:
845 + coords - The new y-coordinate, and 0 for x and z
846 - R - The rotation which accomplishes the projection
847 
848   Note: This uses the basis completion described by Frisvad in http://www.imm.dtu.dk/~jerf/papers/abstracts/onb.html, DOI:10.1080/2165347X.2012.689606
849 
850   Level: developer
851 
852 .seealso: DMPlexComputeProjection2Dto1D(), DMPlexComputeProjection3Dto2D()
853 @*/
854 PetscErrorCode DMPlexComputeProjection3Dto1D(PetscScalar coords[], PetscReal R[])
855 {
856   PetscReal      x    = PetscRealPart(coords[3] - coords[0]);
857   PetscReal      y    = PetscRealPart(coords[4] - coords[1]);
858   PetscReal      z    = PetscRealPart(coords[5] - coords[2]);
859   PetscReal      r    = PetscSqrtReal(x*x + y*y + z*z);
860   PetscReal      rinv = 1. / r;
861   PetscFunctionBegin;
862 
863   x *= rinv; y *= rinv; z *= rinv;
864   if (x > 0.) {
865     PetscReal inv1pX   = 1./ (1. + x);
866 
867     R[0] = x; R[1] = -y;              R[2] = -z;
868     R[3] = y; R[4] = 1. - y*y*inv1pX; R[5] =     -y*z*inv1pX;
869     R[6] = z; R[7] =     -y*z*inv1pX; R[8] = 1. - z*z*inv1pX;
870   }
871   else {
872     PetscReal inv1mX   = 1./ (1. - x);
873 
874     R[0] = x; R[1] = z;               R[2] = y;
875     R[3] = y; R[4] =     -y*z*inv1mX; R[5] = 1. - y*y*inv1mX;
876     R[6] = z; R[7] = 1. - z*z*inv1mX; R[8] =     -y*z*inv1mX;
877   }
878   coords[0] = 0.0;
879   coords[1] = r;
880   PetscFunctionReturn(0);
881 }
882 
883 /*@
884   DMPlexComputeProjection3Dto2D - Rewrite coordinates of 3 or more coplanar 3D points to a common 2D basis for the
885     plane.  The normal is defined by positive orientation of the first 3 points.
886 
887   Not collective
888 
889   Input Parameter:
890 + coordSize - Length of coordinate array (3x number of points); must be at least 9 (3 points)
891 - coords - The interlaced coordinates of each coplanar 3D point
892 
893   Output Parameters:
894 + coords - The first 2*coordSize/3 entries contain interlaced 2D points, with the rest undefined
895 - R - 3x3 row-major rotation matrix whose columns are the tangent basis [t1, t2, n].  Multiplying by R^T transforms from original frame to tangent frame.
896 
897   Level: developer
898 
899 .seealso: DMPlexComputeProjection2Dto1D(), DMPlexComputeProjection3Dto1D()
900 @*/
901 PetscErrorCode DMPlexComputeProjection3Dto2D(PetscInt coordSize, PetscScalar coords[], PetscReal R[])
902 {
903   PetscReal x1[3], x2[3], n[3], c[3], norm;
904   const PetscInt dim = 3;
905   PetscInt       d, p;
906 
907   PetscFunctionBegin;
908   /* 0) Calculate normal vector */
909   for (d = 0; d < dim; ++d) {
910     x1[d] = PetscRealPart(coords[1*dim+d] - coords[0*dim+d]);
911     x2[d] = PetscRealPart(coords[2*dim+d] - coords[0*dim+d]);
912   }
913   // n = x1 \otimes x2
914   n[0] = x1[1]*x2[2] - x1[2]*x2[1];
915   n[1] = x1[2]*x2[0] - x1[0]*x2[2];
916   n[2] = x1[0]*x2[1] - x1[1]*x2[0];
917   norm = PetscSqrtReal(n[0]*n[0] + n[1]*n[1] + n[2]*n[2]);
918   for (d = 0; d < dim; d++) n[d] /= norm;
919   norm = PetscSqrtReal(x1[0] * x1[0] + x1[1] * x1[1] + x1[2] * x1[2]);
920   for (d = 0; d < dim; d++) x1[d] /= norm;
921   // x2 = n \otimes x1
922   x2[0] = n[1] * x1[2] - n[2] * x1[1];
923   x2[1] = n[2] * x1[0] - n[0] * x1[2];
924   x2[2] = n[0] * x1[1] - n[1] * x1[0];
925   for (d=0; d<dim; d++) {
926     R[d * dim + 0] = x1[d];
927     R[d * dim + 1] = x2[d];
928     R[d * dim + 2] = n[d];
929     c[d] = PetscRealPart(coords[0*dim + d]);
930   }
931   for (p=0; p<coordSize/dim; p++) {
932     PetscReal y[3];
933     for (d=0; d<dim; d++) y[d] = PetscRealPart(coords[p*dim + d]) - c[d];
934     for (d=0; d<2; d++) coords[p*2+d] = R[0*dim + d] * y[0] + R[1*dim + d] * y[1] + R[2*dim + d] * y[2];
935   }
936   PetscFunctionReturn(0);
937 }
938 
939 PETSC_UNUSED
940 PETSC_STATIC_INLINE void Volume_Triangle_Internal(PetscReal *vol, PetscReal coords[])
941 {
942   /* Signed volume is 1/2 the determinant
943 
944    |  1  1  1 |
945    | x0 x1 x2 |
946    | y0 y1 y2 |
947 
948      but if x0,y0 is the origin, we have
949 
950    | x1 x2 |
951    | y1 y2 |
952   */
953   const PetscReal x1 = coords[2] - coords[0], y1 = coords[3] - coords[1];
954   const PetscReal x2 = coords[4] - coords[0], y2 = coords[5] - coords[1];
955   PetscReal       M[4], detM;
956   M[0] = x1; M[1] = x2;
957   M[2] = y1; M[3] = y2;
958   DMPlex_Det2D_Internal(&detM, M);
959   *vol = 0.5*detM;
960   (void)PetscLogFlops(5.0);
961 }
962 
963 PETSC_STATIC_INLINE void Volume_Triangle_Origin_Internal(PetscReal *vol, PetscReal coords[])
964 {
965   DMPlex_Det2D_Internal(vol, coords);
966   *vol *= 0.5;
967 }
968 
969 PETSC_UNUSED
970 PETSC_STATIC_INLINE void Volume_Tetrahedron_Internal(PetscReal *vol, PetscReal coords[])
971 {
972   /* Signed volume is 1/6th of the determinant
973 
974    |  1  1  1  1 |
975    | x0 x1 x2 x3 |
976    | y0 y1 y2 y3 |
977    | z0 z1 z2 z3 |
978 
979      but if x0,y0,z0 is the origin, we have
980 
981    | x1 x2 x3 |
982    | y1 y2 y3 |
983    | z1 z2 z3 |
984   */
985   const PetscReal x1 = coords[3] - coords[0], y1 = coords[4]  - coords[1], z1 = coords[5]  - coords[2];
986   const PetscReal x2 = coords[6] - coords[0], y2 = coords[7]  - coords[1], z2 = coords[8]  - coords[2];
987   const PetscReal x3 = coords[9] - coords[0], y3 = coords[10] - coords[1], z3 = coords[11] - coords[2];
988   const PetscReal onesixth = ((PetscReal)1./(PetscReal)6.);
989   PetscReal       M[9], detM;
990   M[0] = x1; M[1] = x2; M[2] = x3;
991   M[3] = y1; M[4] = y2; M[5] = y3;
992   M[6] = z1; M[7] = z2; M[8] = z3;
993   DMPlex_Det3D_Internal(&detM, M);
994   *vol = -onesixth*detM;
995   (void)PetscLogFlops(10.0);
996 }
997 
998 PETSC_STATIC_INLINE void Volume_Tetrahedron_Origin_Internal(PetscReal *vol, PetscReal coords[])
999 {
1000   const PetscReal onesixth = ((PetscReal)1./(PetscReal)6.);
1001   DMPlex_Det3D_Internal(vol, coords);
1002   *vol *= -onesixth;
1003 }
1004 
1005 static PetscErrorCode DMPlexComputePointGeometry_Internal(DM dm, PetscInt e, PetscReal v0[], PetscReal J[], PetscReal invJ[], PetscReal *detJ)
1006 {
1007   PetscSection   coordSection;
1008   Vec            coordinates;
1009   const PetscScalar *coords;
1010   PetscInt       dim, d, off;
1011   PetscErrorCode ierr;
1012 
1013   PetscFunctionBegin;
1014   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1015   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1016   ierr = PetscSectionGetDof(coordSection,e,&dim);CHKERRQ(ierr);
1017   if (!dim) PetscFunctionReturn(0);
1018   ierr = PetscSectionGetOffset(coordSection,e,&off);CHKERRQ(ierr);
1019   ierr = VecGetArrayRead(coordinates,&coords);CHKERRQ(ierr);
1020   if (v0) {for (d = 0; d < dim; d++) v0[d] = PetscRealPart(coords[off + d]);}
1021   ierr = VecRestoreArrayRead(coordinates,&coords);CHKERRQ(ierr);
1022   *detJ = 1.;
1023   if (J) {
1024     for (d = 0; d < dim * dim; d++) J[d] = 0.;
1025     for (d = 0; d < dim; d++) J[d * dim + d] = 1.;
1026     if (invJ) {
1027       for (d = 0; d < dim * dim; d++) invJ[d] = 0.;
1028       for (d = 0; d < dim; d++) invJ[d * dim + d] = 1.;
1029     }
1030   }
1031   PetscFunctionReturn(0);
1032 }
1033 
1034 static PetscErrorCode DMPlexComputeLineGeometry_Internal(DM dm, PetscInt e, PetscReal v0[], PetscReal J[], PetscReal invJ[], PetscReal *detJ)
1035 {
1036   PetscSection   coordSection;
1037   Vec            coordinates;
1038   PetscScalar   *coords = NULL;
1039   PetscInt       numCoords, d, pStart, pEnd, numSelfCoords = 0;
1040   PetscErrorCode ierr;
1041 
1042   PetscFunctionBegin;
1043   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1044   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1045   ierr = PetscSectionGetChart(coordSection,&pStart,&pEnd);CHKERRQ(ierr);
1046   if (e >= pStart && e < pEnd) {ierr = PetscSectionGetDof(coordSection,e,&numSelfCoords);CHKERRQ(ierr);}
1047   ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, e, &numCoords, &coords);CHKERRQ(ierr);
1048   numCoords = numSelfCoords ? numSelfCoords : numCoords;
1049   if (invJ && !J) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "In order to compute invJ, J must not be NULL");
1050   *detJ = 0.0;
1051   if (numCoords == 6) {
1052     const PetscInt dim = 3;
1053     PetscReal      R[9], J0;
1054 
1055     if (v0)   {for (d = 0; d < dim; d++) v0[d] = PetscRealPart(coords[d]);}
1056     ierr = DMPlexComputeProjection3Dto1D(coords, R);CHKERRQ(ierr);
1057     if (J)    {
1058       J0   = 0.5*PetscRealPart(coords[1]);
1059       J[0] = R[0]*J0; J[1] = R[1]; J[2] = R[2];
1060       J[3] = R[3]*J0; J[4] = R[4]; J[5] = R[5];
1061       J[6] = R[6]*J0; J[7] = R[7]; J[8] = R[8];
1062       DMPlex_Det3D_Internal(detJ, J);
1063       if (invJ) {DMPlex_Invert2D_Internal(invJ, J, *detJ);}
1064     }
1065   } else if (numCoords == 4) {
1066     const PetscInt dim = 2;
1067     PetscReal      R[4], J0;
1068 
1069     if (v0)   {for (d = 0; d < dim; d++) v0[d] = PetscRealPart(coords[d]);}
1070     ierr = DMPlexComputeProjection2Dto1D(coords, R);CHKERRQ(ierr);
1071     if (J)    {
1072       J0   = 0.5*PetscRealPart(coords[1]);
1073       J[0] = R[0]*J0; J[1] = R[1];
1074       J[2] = R[2]*J0; J[3] = R[3];
1075       DMPlex_Det2D_Internal(detJ, J);
1076       if (invJ) {DMPlex_Invert2D_Internal(invJ, J, *detJ);}
1077     }
1078   } else if (numCoords == 2) {
1079     const PetscInt dim = 1;
1080 
1081     if (v0)   {for (d = 0; d < dim; d++) v0[d] = PetscRealPart(coords[d]);}
1082     if (J)    {
1083       J[0]  = 0.5*(PetscRealPart(coords[1]) - PetscRealPart(coords[0]));
1084       *detJ = J[0];
1085       ierr = PetscLogFlops(2.0);CHKERRQ(ierr);
1086       if (invJ) {invJ[0] = 1.0/J[0]; ierr = PetscLogFlops(1.0);CHKERRQ(ierr);}
1087     }
1088   } else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "The number of coordinates for this segment is %D != 2", numCoords);
1089   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, e, &numCoords, &coords);CHKERRQ(ierr);
1090   PetscFunctionReturn(0);
1091 }
1092 
1093 static PetscErrorCode DMPlexComputeTriangleGeometry_Internal(DM dm, PetscInt e, PetscReal v0[], PetscReal J[], PetscReal invJ[], PetscReal *detJ)
1094 {
1095   PetscSection   coordSection;
1096   Vec            coordinates;
1097   PetscScalar   *coords = NULL;
1098   PetscInt       numCoords, numSelfCoords = 0, d, f, g, pStart, pEnd;
1099   PetscErrorCode ierr;
1100 
1101   PetscFunctionBegin;
1102   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1103   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1104   ierr = PetscSectionGetChart(coordSection,&pStart,&pEnd);CHKERRQ(ierr);
1105   if (e >= pStart && e < pEnd) {ierr = PetscSectionGetDof(coordSection,e,&numSelfCoords);CHKERRQ(ierr);}
1106   ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, e, &numCoords, &coords);CHKERRQ(ierr);
1107   numCoords = numSelfCoords ? numSelfCoords : numCoords;
1108   *detJ = 0.0;
1109   if (numCoords == 9) {
1110     const PetscInt dim = 3;
1111     PetscReal      R[9], J0[9] = {1.0,0.0,0.0,0.0,1.0,0.0,0.0,0.0,1.0};
1112 
1113     if (v0)   {for (d = 0; d < dim; d++) v0[d] = PetscRealPart(coords[d]);}
1114     ierr = DMPlexComputeProjection3Dto2D(numCoords, coords, R);CHKERRQ(ierr);
1115     if (J)    {
1116       const PetscInt pdim = 2;
1117 
1118       for (d = 0; d < pdim; d++) {
1119         for (f = 0; f < pdim; f++) {
1120           J0[d*dim+f] = 0.5*(PetscRealPart(coords[(f+1)*pdim+d]) - PetscRealPart(coords[0*pdim+d]));
1121         }
1122       }
1123       ierr = PetscLogFlops(8.0);CHKERRQ(ierr);
1124       DMPlex_Det3D_Internal(detJ, J0);
1125       for (d = 0; d < dim; d++) {
1126         for (f = 0; f < dim; f++) {
1127           J[d*dim+f] = 0.0;
1128           for (g = 0; g < dim; g++) {
1129             J[d*dim+f] += R[d*dim+g]*J0[g*dim+f];
1130           }
1131         }
1132       }
1133       ierr = PetscLogFlops(18.0);CHKERRQ(ierr);
1134     }
1135     if (invJ) {DMPlex_Invert3D_Internal(invJ, J, *detJ);}
1136   } else if (numCoords == 6) {
1137     const PetscInt dim = 2;
1138 
1139     if (v0)   {for (d = 0; d < dim; d++) v0[d] = PetscRealPart(coords[d]);}
1140     if (J)    {
1141       for (d = 0; d < dim; d++) {
1142         for (f = 0; f < dim; f++) {
1143           J[d*dim+f] = 0.5*(PetscRealPart(coords[(f+1)*dim+d]) - PetscRealPart(coords[0*dim+d]));
1144         }
1145       }
1146       ierr = PetscLogFlops(8.0);CHKERRQ(ierr);
1147       DMPlex_Det2D_Internal(detJ, J);
1148     }
1149     if (invJ) {DMPlex_Invert2D_Internal(invJ, J, *detJ);}
1150   } else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "The number of coordinates for this triangle is %D != 6 or 9", numCoords);
1151   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, e, &numCoords, &coords);CHKERRQ(ierr);
1152   PetscFunctionReturn(0);
1153 }
1154 
1155 static PetscErrorCode DMPlexComputeRectangleGeometry_Internal(DM dm, PetscInt e, PetscBool isTensor, PetscInt Nq, const PetscReal points[], PetscReal v[], PetscReal J[], PetscReal invJ[], PetscReal *detJ)
1156 {
1157   PetscSection   coordSection;
1158   Vec            coordinates;
1159   PetscScalar   *coords = NULL;
1160   PetscInt       numCoords, numSelfCoords = 0, d, f, g, pStart, pEnd;
1161   PetscErrorCode ierr;
1162 
1163   PetscFunctionBegin;
1164   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1165   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1166   ierr = PetscSectionGetChart(coordSection,&pStart,&pEnd);CHKERRQ(ierr);
1167   if (e >= pStart && e < pEnd) {ierr = PetscSectionGetDof(coordSection,e,&numSelfCoords);CHKERRQ(ierr);}
1168   ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, e, &numCoords, &coords);CHKERRQ(ierr);
1169   numCoords = numSelfCoords ? numSelfCoords : numCoords;
1170   if (!Nq) {
1171     PetscInt vorder[4] = {0, 1, 2, 3};
1172 
1173     if (isTensor) {vorder[2] = 3; vorder[3] = 2;}
1174     *detJ = 0.0;
1175     if (numCoords == 12) {
1176       const PetscInt dim = 3;
1177       PetscReal      R[9], J0[9] = {1.0,0.0,0.0,0.0,1.0,0.0,0.0,0.0,1.0};
1178 
1179       if (v)   {for (d = 0; d < dim; d++) v[d] = PetscRealPart(coords[d]);}
1180       ierr = DMPlexComputeProjection3Dto2D(numCoords, coords, R);CHKERRQ(ierr);
1181       if (J)    {
1182         const PetscInt pdim = 2;
1183 
1184         for (d = 0; d < pdim; d++) {
1185           J0[d*dim+0] = 0.5*(PetscRealPart(coords[vorder[1]*pdim+d]) - PetscRealPart(coords[vorder[0]*pdim+d]));
1186           J0[d*dim+1] = 0.5*(PetscRealPart(coords[vorder[2]*pdim+d]) - PetscRealPart(coords[vorder[1]*pdim+d]));
1187         }
1188         ierr = PetscLogFlops(8.0);CHKERRQ(ierr);
1189         DMPlex_Det3D_Internal(detJ, J0);
1190         for (d = 0; d < dim; d++) {
1191           for (f = 0; f < dim; f++) {
1192             J[d*dim+f] = 0.0;
1193             for (g = 0; g < dim; g++) {
1194               J[d*dim+f] += R[d*dim+g]*J0[g*dim+f];
1195             }
1196           }
1197         }
1198         ierr = PetscLogFlops(18.0);CHKERRQ(ierr);
1199       }
1200       if (invJ) {DMPlex_Invert3D_Internal(invJ, J, *detJ);}
1201     } else if (numCoords == 8) {
1202       const PetscInt dim = 2;
1203 
1204       if (v)   {for (d = 0; d < dim; d++) v[d] = PetscRealPart(coords[d]);}
1205       if (J)    {
1206         for (d = 0; d < dim; d++) {
1207           J[d*dim+0] = 0.5*(PetscRealPart(coords[vorder[1]*dim+d]) - PetscRealPart(coords[vorder[0]*dim+d]));
1208           J[d*dim+1] = 0.5*(PetscRealPart(coords[vorder[3]*dim+d]) - PetscRealPart(coords[vorder[0]*dim+d]));
1209         }
1210         ierr = PetscLogFlops(8.0);CHKERRQ(ierr);
1211         DMPlex_Det2D_Internal(detJ, J);
1212       }
1213       if (invJ) {DMPlex_Invert2D_Internal(invJ, J, *detJ);}
1214     } else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "The number of coordinates for this quadrilateral is %D != 8 or 12", numCoords);
1215   } else {
1216     const PetscInt Nv = 4;
1217     const PetscInt dimR = 2;
1218     PetscInt  zToPlex[4] = {0, 1, 3, 2};
1219     PetscReal zOrder[12];
1220     PetscReal zCoeff[12];
1221     PetscInt  i, j, k, l, dim;
1222 
1223     if (isTensor) {zToPlex[2] = 2; zToPlex[3] = 3;}
1224     if (numCoords == 12) {
1225       dim = 3;
1226     } else if (numCoords == 8) {
1227       dim = 2;
1228     } else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "The number of coordinates for this quadrilateral is %D != 8 or 12", numCoords);
1229     for (i = 0; i < Nv; i++) {
1230       PetscInt zi = zToPlex[i];
1231 
1232       for (j = 0; j < dim; j++) {
1233         zOrder[dim * i + j] = PetscRealPart(coords[dim * zi + j]);
1234       }
1235     }
1236     for (j = 0; j < dim; j++) {
1237       zCoeff[dim * 0 + j] = 0.25 * (  zOrder[dim * 0 + j] + zOrder[dim * 1 + j] + zOrder[dim * 2 + j] + zOrder[dim * 3 + j]);
1238       zCoeff[dim * 1 + j] = 0.25 * (- zOrder[dim * 0 + j] + zOrder[dim * 1 + j] - zOrder[dim * 2 + j] + zOrder[dim * 3 + j]);
1239       zCoeff[dim * 2 + j] = 0.25 * (- zOrder[dim * 0 + j] - zOrder[dim * 1 + j] + zOrder[dim * 2 + j] + zOrder[dim * 3 + j]);
1240       zCoeff[dim * 3 + j] = 0.25 * (  zOrder[dim * 0 + j] - zOrder[dim * 1 + j] - zOrder[dim * 2 + j] + zOrder[dim * 3 + j]);
1241     }
1242     for (i = 0; i < Nq; i++) {
1243       PetscReal xi = points[dimR * i], eta = points[dimR * i + 1];
1244 
1245       if (v) {
1246         PetscReal extPoint[4];
1247 
1248         extPoint[0] = 1.;
1249         extPoint[1] = xi;
1250         extPoint[2] = eta;
1251         extPoint[3] = xi * eta;
1252         for (j = 0; j < dim; j++) {
1253           PetscReal val = 0.;
1254 
1255           for (k = 0; k < Nv; k++) {
1256             val += extPoint[k] * zCoeff[dim * k + j];
1257           }
1258           v[i * dim + j] = val;
1259         }
1260       }
1261       if (J) {
1262         PetscReal extJ[8];
1263 
1264         extJ[0] = 0.;
1265         extJ[1] = 0.;
1266         extJ[2] = 1.;
1267         extJ[3] = 0.;
1268         extJ[4] = 0.;
1269         extJ[5] = 1.;
1270         extJ[6] = eta;
1271         extJ[7] = xi;
1272         for (j = 0; j < dim; j++) {
1273           for (k = 0; k < dimR; k++) {
1274             PetscReal val = 0.;
1275 
1276             for (l = 0; l < Nv; l++) {
1277               val += zCoeff[dim * l + j] * extJ[dimR * l + k];
1278             }
1279             J[i * dim * dim + dim * j + k] = val;
1280           }
1281         }
1282         if (dim == 3) { /* put the cross product in the third component of the Jacobian */
1283           PetscReal x, y, z;
1284           PetscReal *iJ = &J[i * dim * dim];
1285           PetscReal norm;
1286 
1287           x = iJ[1 * dim + 0] * iJ[2 * dim + 1] - iJ[1 * dim + 1] * iJ[2 * dim + 0];
1288           y = iJ[0 * dim + 1] * iJ[2 * dim + 0] - iJ[0 * dim + 0] * iJ[2 * dim + 1];
1289           z = iJ[0 * dim + 0] * iJ[1 * dim + 1] - iJ[0 * dim + 1] * iJ[1 * dim + 0];
1290           norm = PetscSqrtReal(x * x + y * y + z * z);
1291           iJ[2] = x / norm;
1292           iJ[5] = y / norm;
1293           iJ[8] = z / norm;
1294           DMPlex_Det3D_Internal(&detJ[i], &J[i * dim * dim]);
1295           if (invJ) {DMPlex_Invert3D_Internal(&invJ[i * dim * dim], &J[i * dim * dim], detJ[i]);}
1296         } else {
1297           DMPlex_Det2D_Internal(&detJ[i], &J[i * dim * dim]);
1298           if (invJ) {DMPlex_Invert2D_Internal(&invJ[i * dim * dim], &J[i * dim * dim], detJ[i]);}
1299         }
1300       }
1301     }
1302   }
1303   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, e, &numCoords, &coords);CHKERRQ(ierr);
1304   PetscFunctionReturn(0);
1305 }
1306 
1307 static PetscErrorCode DMPlexComputeTetrahedronGeometry_Internal(DM dm, PetscInt e, PetscReal v0[], PetscReal J[], PetscReal invJ[], PetscReal *detJ)
1308 {
1309   PetscSection   coordSection;
1310   Vec            coordinates;
1311   PetscScalar   *coords = NULL;
1312   const PetscInt dim = 3;
1313   PetscInt       d;
1314   PetscErrorCode ierr;
1315 
1316   PetscFunctionBegin;
1317   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1318   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1319   ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, e, NULL, &coords);CHKERRQ(ierr);
1320   *detJ = 0.0;
1321   if (v0)   {for (d = 0; d < dim; d++) v0[d] = PetscRealPart(coords[d]);}
1322   if (J)    {
1323     for (d = 0; d < dim; d++) {
1324       /* I orient with outward face normals */
1325       J[d*dim+0] = 0.5*(PetscRealPart(coords[2*dim+d]) - PetscRealPart(coords[0*dim+d]));
1326       J[d*dim+1] = 0.5*(PetscRealPart(coords[1*dim+d]) - PetscRealPart(coords[0*dim+d]));
1327       J[d*dim+2] = 0.5*(PetscRealPart(coords[3*dim+d]) - PetscRealPart(coords[0*dim+d]));
1328     }
1329     ierr = PetscLogFlops(18.0);CHKERRQ(ierr);
1330     DMPlex_Det3D_Internal(detJ, J);
1331   }
1332   if (invJ) {DMPlex_Invert3D_Internal(invJ, J, *detJ);}
1333   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, e, NULL, &coords);CHKERRQ(ierr);
1334   PetscFunctionReturn(0);
1335 }
1336 
1337 static PetscErrorCode DMPlexComputeHexahedronGeometry_Internal(DM dm, PetscInt e, PetscInt Nq, const PetscReal points[], PetscReal v[], PetscReal J[], PetscReal invJ[], PetscReal *detJ)
1338 {
1339   PetscSection   coordSection;
1340   Vec            coordinates;
1341   PetscScalar   *coords = NULL;
1342   const PetscInt dim = 3;
1343   PetscInt       d;
1344   PetscErrorCode ierr;
1345 
1346   PetscFunctionBegin;
1347   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1348   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1349   ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, e, NULL, &coords);CHKERRQ(ierr);
1350   if (!Nq) {
1351     *detJ = 0.0;
1352     if (v)   {for (d = 0; d < dim; d++) v[d] = PetscRealPart(coords[d]);}
1353     if (J)    {
1354       for (d = 0; d < dim; d++) {
1355         J[d*dim+0] = 0.5*(PetscRealPart(coords[3*dim+d]) - PetscRealPart(coords[0*dim+d]));
1356         J[d*dim+1] = 0.5*(PetscRealPart(coords[1*dim+d]) - PetscRealPart(coords[0*dim+d]));
1357         J[d*dim+2] = 0.5*(PetscRealPart(coords[4*dim+d]) - PetscRealPart(coords[0*dim+d]));
1358       }
1359       ierr = PetscLogFlops(18.0);CHKERRQ(ierr);
1360       DMPlex_Det3D_Internal(detJ, J);
1361     }
1362     if (invJ) {DMPlex_Invert3D_Internal(invJ, J, *detJ);}
1363   } else {
1364     const PetscInt Nv = 8;
1365     const PetscInt zToPlex[8] = {0, 3, 1, 2, 4, 5, 7, 6};
1366     const PetscInt dim = 3;
1367     const PetscInt dimR = 3;
1368     PetscReal zOrder[24];
1369     PetscReal zCoeff[24];
1370     PetscInt  i, j, k, l;
1371 
1372     for (i = 0; i < Nv; i++) {
1373       PetscInt zi = zToPlex[i];
1374 
1375       for (j = 0; j < dim; j++) {
1376         zOrder[dim * i + j] = PetscRealPart(coords[dim * zi + j]);
1377       }
1378     }
1379     for (j = 0; j < dim; j++) {
1380       zCoeff[dim * 0 + j] = 0.125 * (  zOrder[dim * 0 + j] + zOrder[dim * 1 + j] + zOrder[dim * 2 + j] + zOrder[dim * 3 + j] + zOrder[dim * 4 + j] + zOrder[dim * 5 + j] + zOrder[dim * 6 + j] + zOrder[dim * 7 + j]);
1381       zCoeff[dim * 1 + j] = 0.125 * (- zOrder[dim * 0 + j] + zOrder[dim * 1 + j] - zOrder[dim * 2 + j] + zOrder[dim * 3 + j] - zOrder[dim * 4 + j] + zOrder[dim * 5 + j] - zOrder[dim * 6 + j] + zOrder[dim * 7 + j]);
1382       zCoeff[dim * 2 + j] = 0.125 * (- zOrder[dim * 0 + j] - zOrder[dim * 1 + j] + zOrder[dim * 2 + j] + zOrder[dim * 3 + j] - zOrder[dim * 4 + j] - zOrder[dim * 5 + j] + zOrder[dim * 6 + j] + zOrder[dim * 7 + j]);
1383       zCoeff[dim * 3 + j] = 0.125 * (  zOrder[dim * 0 + j] - zOrder[dim * 1 + j] - zOrder[dim * 2 + j] + zOrder[dim * 3 + j] + zOrder[dim * 4 + j] - zOrder[dim * 5 + j] - zOrder[dim * 6 + j] + zOrder[dim * 7 + j]);
1384       zCoeff[dim * 4 + j] = 0.125 * (- zOrder[dim * 0 + j] - zOrder[dim * 1 + j] - zOrder[dim * 2 + j] - zOrder[dim * 3 + j] + zOrder[dim * 4 + j] + zOrder[dim * 5 + j] + zOrder[dim * 6 + j] + zOrder[dim * 7 + j]);
1385       zCoeff[dim * 5 + j] = 0.125 * (+ zOrder[dim * 0 + j] - zOrder[dim * 1 + j] + zOrder[dim * 2 + j] - zOrder[dim * 3 + j] - zOrder[dim * 4 + j] + zOrder[dim * 5 + j] - zOrder[dim * 6 + j] + zOrder[dim * 7 + j]);
1386       zCoeff[dim * 6 + j] = 0.125 * (+ zOrder[dim * 0 + j] + zOrder[dim * 1 + j] - zOrder[dim * 2 + j] - zOrder[dim * 3 + j] - zOrder[dim * 4 + j] - zOrder[dim * 5 + j] + zOrder[dim * 6 + j] + zOrder[dim * 7 + j]);
1387       zCoeff[dim * 7 + j] = 0.125 * (- zOrder[dim * 0 + j] + zOrder[dim * 1 + j] + zOrder[dim * 2 + j] - zOrder[dim * 3 + j] + zOrder[dim * 4 + j] - zOrder[dim * 5 + j] - zOrder[dim * 6 + j] + zOrder[dim * 7 + j]);
1388     }
1389     for (i = 0; i < Nq; i++) {
1390       PetscReal xi = points[dimR * i], eta = points[dimR * i + 1], theta = points[dimR * i + 2];
1391 
1392       if (v) {
1393         PetscReal extPoint[8];
1394 
1395         extPoint[0] = 1.;
1396         extPoint[1] = xi;
1397         extPoint[2] = eta;
1398         extPoint[3] = xi * eta;
1399         extPoint[4] = theta;
1400         extPoint[5] = theta * xi;
1401         extPoint[6] = theta * eta;
1402         extPoint[7] = theta * eta * xi;
1403         for (j = 0; j < dim; j++) {
1404           PetscReal val = 0.;
1405 
1406           for (k = 0; k < Nv; k++) {
1407             val += extPoint[k] * zCoeff[dim * k + j];
1408           }
1409           v[i * dim + j] = val;
1410         }
1411       }
1412       if (J) {
1413         PetscReal extJ[24];
1414 
1415         extJ[0]  = 0.         ; extJ[1]  = 0.        ; extJ[2]  = 0.      ;
1416         extJ[3]  = 1.         ; extJ[4]  = 0.        ; extJ[5]  = 0.      ;
1417         extJ[6]  = 0.         ; extJ[7]  = 1.        ; extJ[8]  = 0.      ;
1418         extJ[9]  = eta        ; extJ[10] = xi        ; extJ[11] = 0.      ;
1419         extJ[12] = 0.         ; extJ[13] = 0.        ; extJ[14] = 1.      ;
1420         extJ[15] = theta      ; extJ[16] = 0.        ; extJ[17] = xi      ;
1421         extJ[18] = 0.         ; extJ[19] = theta     ; extJ[20] = eta     ;
1422         extJ[21] = theta * eta; extJ[22] = theta * xi; extJ[23] = eta * xi;
1423 
1424         for (j = 0; j < dim; j++) {
1425           for (k = 0; k < dimR; k++) {
1426             PetscReal val = 0.;
1427 
1428             for (l = 0; l < Nv; l++) {
1429               val += zCoeff[dim * l + j] * extJ[dimR * l + k];
1430             }
1431             J[i * dim * dim + dim * j + k] = val;
1432           }
1433         }
1434         DMPlex_Det3D_Internal(&detJ[i], &J[i * dim * dim]);
1435         if (invJ) {DMPlex_Invert3D_Internal(&invJ[i * dim * dim], &J[i * dim * dim], detJ[i]);}
1436       }
1437     }
1438   }
1439   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, e, NULL, &coords);CHKERRQ(ierr);
1440   PetscFunctionReturn(0);
1441 }
1442 
1443 static PetscErrorCode DMPlexComputeCellGeometryFEM_Implicit(DM dm, PetscInt cell, PetscQuadrature quad, PetscReal *v, PetscReal *J, PetscReal *invJ, PetscReal *detJ)
1444 {
1445   DMPolytopeType  ct;
1446   PetscInt        depth, dim, coordDim, coneSize, i;
1447   PetscInt        Nq = 0;
1448   const PetscReal *points = NULL;
1449   DMLabel         depthLabel;
1450   PetscReal       xi0[3] = {-1.,-1.,-1.}, v0[3], J0[9], detJ0;
1451   PetscBool       isAffine = PETSC_TRUE;
1452   PetscErrorCode  ierr;
1453 
1454   PetscFunctionBegin;
1455   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1456   ierr = DMPlexGetConeSize(dm, cell, &coneSize);CHKERRQ(ierr);
1457   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
1458   ierr = DMLabelGetValue(depthLabel, cell, &dim);CHKERRQ(ierr);
1459   if (depth == 1 && dim == 1) {
1460     ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1461   }
1462   ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
1463   if (coordDim > 3) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unsupported coordinate dimension %D > 3", coordDim);
1464   if (quad) {ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, &points, NULL);CHKERRQ(ierr);}
1465   ierr = DMPlexGetCellType(dm, cell, &ct);CHKERRQ(ierr);
1466   switch (ct) {
1467     case DM_POLYTOPE_POINT:
1468     ierr = DMPlexComputePointGeometry_Internal(dm, cell, v, J, invJ, detJ);CHKERRQ(ierr);
1469     isAffine = PETSC_FALSE;
1470     break;
1471     case DM_POLYTOPE_SEGMENT:
1472     case DM_POLYTOPE_POINT_PRISM_TENSOR:
1473     if (Nq) {ierr = DMPlexComputeLineGeometry_Internal(dm, cell, v0, J0, NULL, &detJ0);CHKERRQ(ierr);}
1474     else    {ierr = DMPlexComputeLineGeometry_Internal(dm, cell, v,  J,  invJ,  detJ);CHKERRQ(ierr);}
1475     break;
1476     case DM_POLYTOPE_TRIANGLE:
1477     if (Nq) {ierr = DMPlexComputeTriangleGeometry_Internal(dm, cell, v0, J0, NULL, &detJ0);CHKERRQ(ierr);}
1478     else    {ierr = DMPlexComputeTriangleGeometry_Internal(dm, cell, v,  J,  invJ,  detJ);CHKERRQ(ierr);}
1479     break;
1480     case DM_POLYTOPE_QUADRILATERAL:
1481     ierr = DMPlexComputeRectangleGeometry_Internal(dm, cell, PETSC_FALSE, Nq, points, v, J, invJ, detJ);CHKERRQ(ierr);
1482     isAffine = PETSC_FALSE;
1483     break;
1484     case DM_POLYTOPE_SEG_PRISM_TENSOR:
1485     ierr = DMPlexComputeRectangleGeometry_Internal(dm, cell, PETSC_TRUE, Nq, points, v, J, invJ, detJ);CHKERRQ(ierr);
1486     isAffine = PETSC_FALSE;
1487     break;
1488     case DM_POLYTOPE_TETRAHEDRON:
1489     if (Nq) {ierr = DMPlexComputeTetrahedronGeometry_Internal(dm, cell, v0, J0, NULL, &detJ0);CHKERRQ(ierr);}
1490     else    {ierr = DMPlexComputeTetrahedronGeometry_Internal(dm, cell, v,  J,  invJ,  detJ);CHKERRQ(ierr);}
1491     break;
1492     case DM_POLYTOPE_HEXAHEDRON:
1493     ierr = DMPlexComputeHexahedronGeometry_Internal(dm, cell, Nq, points, v, J, invJ, detJ);CHKERRQ(ierr);
1494     isAffine = PETSC_FALSE;
1495     break;
1496     default: SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "No element geometry for cell %D with type %s", cell, DMPolytopeTypes[ct]);
1497   }
1498   if (isAffine && Nq) {
1499     if (v) {
1500       for (i = 0; i < Nq; i++) {
1501         CoordinatesRefToReal(coordDim, dim, xi0, v0, J0, &points[dim * i], &v[coordDim * i]);
1502       }
1503     }
1504     if (detJ) {
1505       for (i = 0; i < Nq; i++) {
1506         detJ[i] = detJ0;
1507       }
1508     }
1509     if (J) {
1510       PetscInt k;
1511 
1512       for (i = 0, k = 0; i < Nq; i++) {
1513         PetscInt j;
1514 
1515         for (j = 0; j < coordDim * coordDim; j++, k++) {
1516           J[k] = J0[j];
1517         }
1518       }
1519     }
1520     if (invJ) {
1521       PetscInt k;
1522       switch (coordDim) {
1523       case 0:
1524         break;
1525       case 1:
1526         invJ[0] = 1./J0[0];
1527         break;
1528       case 2:
1529         DMPlex_Invert2D_Internal(invJ, J0, detJ0);
1530         break;
1531       case 3:
1532         DMPlex_Invert3D_Internal(invJ, J0, detJ0);
1533         break;
1534       }
1535       for (i = 1, k = coordDim * coordDim; i < Nq; i++) {
1536         PetscInt j;
1537 
1538         for (j = 0; j < coordDim * coordDim; j++, k++) {
1539           invJ[k] = invJ[j];
1540         }
1541       }
1542     }
1543   }
1544   PetscFunctionReturn(0);
1545 }
1546 
1547 /*@C
1548   DMPlexComputeCellGeometryAffineFEM - Assuming an affine map, compute the Jacobian, inverse Jacobian, and Jacobian determinant for a given cell
1549 
1550   Collective on dm
1551 
1552   Input Arguments:
1553 + dm   - the DM
1554 - cell - the cell
1555 
1556   Output Arguments:
1557 + v0   - the translation part of this affine transform
1558 . J    - the Jacobian of the transform from the reference element
1559 . invJ - the inverse of the Jacobian
1560 - detJ - the Jacobian determinant
1561 
1562   Level: advanced
1563 
1564   Fortran Notes:
1565   Since it returns arrays, this routine is only available in Fortran 90, and you must
1566   include petsc.h90 in your code.
1567 
1568 .seealso: DMPlexComputeCellGeometryFEM(), DMGetCoordinateSection(), DMGetCoordinates()
1569 @*/
1570 PetscErrorCode DMPlexComputeCellGeometryAffineFEM(DM dm, PetscInt cell, PetscReal *v0, PetscReal *J, PetscReal *invJ, PetscReal *detJ)
1571 {
1572   PetscErrorCode ierr;
1573 
1574   PetscFunctionBegin;
1575   ierr = DMPlexComputeCellGeometryFEM_Implicit(dm,cell,NULL,v0,J,invJ,detJ);CHKERRQ(ierr);
1576   PetscFunctionReturn(0);
1577 }
1578 
1579 static PetscErrorCode DMPlexComputeCellGeometryFEM_FE(DM dm, PetscFE fe, PetscInt point, PetscQuadrature quad, PetscReal v[], PetscReal J[], PetscReal invJ[], PetscReal *detJ)
1580 {
1581   PetscQuadrature   feQuad;
1582   PetscSection      coordSection;
1583   Vec               coordinates;
1584   PetscScalar      *coords = NULL;
1585   const PetscReal  *quadPoints;
1586   PetscTabulation T;
1587   PetscInt          dim, cdim, pdim, qdim, Nq, numCoords, q;
1588   PetscErrorCode    ierr;
1589 
1590   PetscFunctionBegin;
1591   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1592   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1593   ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, point, &numCoords, &coords);CHKERRQ(ierr);
1594   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1595   ierr = DMGetCoordinateDim(dm, &cdim);CHKERRQ(ierr);
1596   if (!quad) { /* use the first point of the first functional of the dual space */
1597     PetscDualSpace dsp;
1598 
1599     ierr = PetscFEGetDualSpace(fe, &dsp);CHKERRQ(ierr);
1600     ierr = PetscDualSpaceGetFunctional(dsp, 0, &quad);CHKERRQ(ierr);
1601     ierr = PetscQuadratureGetData(quad, &qdim, NULL, &Nq, &quadPoints, NULL);CHKERRQ(ierr);
1602     Nq = 1;
1603   } else {
1604     ierr = PetscQuadratureGetData(quad, &qdim, NULL, &Nq, &quadPoints, NULL);CHKERRQ(ierr);
1605   }
1606   ierr = PetscFEGetDimension(fe, &pdim);CHKERRQ(ierr);
1607   ierr = PetscFEGetQuadrature(fe, &feQuad);CHKERRQ(ierr);
1608   if (feQuad == quad) {
1609     ierr = PetscFEGetCellTabulation(fe, J ? 1 : 0, &T);CHKERRQ(ierr);
1610     if (numCoords != pdim*cdim) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "There are %d coordinates for point %d != %d*%d", numCoords, point, pdim, cdim);
1611   } else {
1612     ierr = PetscFECreateTabulation(fe, 1, Nq, quadPoints, J ? 1 : 0, &T);CHKERRQ(ierr);
1613   }
1614   if (qdim != dim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Point dimension %d != quadrature dimension %d", dim, qdim);
1615   {
1616     const PetscReal *basis    = T->T[0];
1617     const PetscReal *basisDer = T->T[1];
1618     PetscReal        detJt;
1619 
1620 #if defined(PETSC_USE_DEBUG)
1621     if (Nq != T->Np)     SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Np %D != %D", Nq, T->Np);
1622     if (pdim != T->Nb)   SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Nb %D != %D", pdim, T->Nb);
1623     if (dim != T->Nc)    SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Nc %D != %D", dim, T->Nc);
1624     if (cdim != T->cdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "cdim %D != %D", cdim, T->cdim);
1625 #endif
1626     if (v) {
1627       ierr = PetscArrayzero(v, Nq*cdim);CHKERRQ(ierr);
1628       for (q = 0; q < Nq; ++q) {
1629         PetscInt i, k;
1630 
1631         for (k = 0; k < pdim; ++k) {
1632           const PetscInt vertex = k/cdim;
1633           for (i = 0; i < cdim; ++i) {
1634             v[q*cdim + i] += basis[(q*pdim + k)*cdim + i] * PetscRealPart(coords[vertex*cdim + i]);
1635           }
1636         }
1637         ierr = PetscLogFlops(2.0*pdim*cdim);CHKERRQ(ierr);
1638       }
1639     }
1640     if (J) {
1641       ierr = PetscArrayzero(J, Nq*cdim*cdim);CHKERRQ(ierr);
1642       for (q = 0; q < Nq; ++q) {
1643         PetscInt i, j, k, c, r;
1644 
1645         /* J = dx_i/d\xi_j = sum[k=0,n-1] dN_k/d\xi_j * x_i(k) */
1646         for (k = 0; k < pdim; ++k) {
1647           const PetscInt vertex = k/cdim;
1648           for (j = 0; j < dim; ++j) {
1649             for (i = 0; i < cdim; ++i) {
1650               J[(q*cdim + i)*cdim + j] += basisDer[((q*pdim + k)*cdim + i)*dim + j] * PetscRealPart(coords[vertex*cdim + i]);
1651             }
1652           }
1653         }
1654         ierr = PetscLogFlops(2.0*pdim*dim*cdim);CHKERRQ(ierr);
1655         if (cdim > dim) {
1656           for (c = dim; c < cdim; ++c)
1657             for (r = 0; r < cdim; ++r)
1658               J[r*cdim+c] = r == c ? 1.0 : 0.0;
1659         }
1660         if (!detJ && !invJ) continue;
1661         detJt = 0.;
1662         switch (cdim) {
1663         case 3:
1664           DMPlex_Det3D_Internal(&detJt, &J[q*cdim*dim]);
1665           if (invJ) {DMPlex_Invert3D_Internal(&invJ[q*cdim*dim], &J[q*cdim*dim], detJt);}
1666           break;
1667         case 2:
1668           DMPlex_Det2D_Internal(&detJt, &J[q*cdim*dim]);
1669           if (invJ) {DMPlex_Invert2D_Internal(&invJ[q*cdim*dim], &J[q*cdim*dim], detJt);}
1670           break;
1671         case 1:
1672           detJt = J[q*cdim*dim];
1673           if (invJ) invJ[q*cdim*dim] = 1.0/detJt;
1674         }
1675         if (detJ) detJ[q] = detJt;
1676       }
1677     } else if (detJ || invJ) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Need J to compute invJ or detJ");
1678   }
1679   if (feQuad != quad) {ierr = PetscTabulationDestroy(&T);CHKERRQ(ierr);}
1680   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, point, &numCoords, &coords);CHKERRQ(ierr);
1681   PetscFunctionReturn(0);
1682 }
1683 
1684 /*@C
1685   DMPlexComputeCellGeometryFEM - Compute the Jacobian, inverse Jacobian, and Jacobian determinant at each quadrature point in the given cell
1686 
1687   Collective on dm
1688 
1689   Input Arguments:
1690 + dm   - the DM
1691 . cell - the cell
1692 - quad - the quadrature containing the points in the reference element where the geometry will be evaluated.  If quad == NULL, geometry will be
1693          evaluated at the first vertex of the reference element
1694 
1695   Output Arguments:
1696 + v    - the image of the transformed quadrature points, otherwise the image of the first vertex in the closure of the reference element
1697 . J    - the Jacobian of the transform from the reference element at each quadrature point
1698 . invJ - the inverse of the Jacobian at each quadrature point
1699 - detJ - the Jacobian determinant at each quadrature point
1700 
1701   Level: advanced
1702 
1703   Fortran Notes:
1704   Since it returns arrays, this routine is only available in Fortran 90, and you must
1705   include petsc.h90 in your code.
1706 
1707 .seealso: DMGetCoordinateSection(), DMGetCoordinates()
1708 @*/
1709 PetscErrorCode DMPlexComputeCellGeometryFEM(DM dm, PetscInt cell, PetscQuadrature quad, PetscReal *v, PetscReal *J, PetscReal *invJ, PetscReal *detJ)
1710 {
1711   DM             cdm;
1712   PetscFE        fe = NULL;
1713   PetscErrorCode ierr;
1714 
1715   PetscFunctionBegin;
1716   PetscValidPointer(detJ, 7);
1717   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
1718   if (cdm) {
1719     PetscClassId id;
1720     PetscInt     numFields;
1721     PetscDS      prob;
1722     PetscObject  disc;
1723 
1724     ierr = DMGetNumFields(cdm, &numFields);CHKERRQ(ierr);
1725     if (numFields) {
1726       ierr = DMGetDS(cdm, &prob);CHKERRQ(ierr);
1727       ierr = PetscDSGetDiscretization(prob,0,&disc);CHKERRQ(ierr);
1728       ierr = PetscObjectGetClassId(disc,&id);CHKERRQ(ierr);
1729       if (id == PETSCFE_CLASSID) {
1730         fe = (PetscFE) disc;
1731       }
1732     }
1733   }
1734   if (!fe) {ierr = DMPlexComputeCellGeometryFEM_Implicit(dm, cell, quad, v, J, invJ, detJ);CHKERRQ(ierr);}
1735   else     {ierr = DMPlexComputeCellGeometryFEM_FE(dm, fe, cell, quad, v, J, invJ, detJ);CHKERRQ(ierr);}
1736   PetscFunctionReturn(0);
1737 }
1738 
1739 static PetscErrorCode DMPlexComputeGeometryFVM_1D_Internal(DM dm, PetscInt dim, PetscInt cell, PetscReal *vol, PetscReal centroid[], PetscReal normal[])
1740 {
1741   PetscSection   coordSection;
1742   Vec            coordinates;
1743   PetscScalar   *coords = NULL;
1744   PetscScalar    tmp[2];
1745   PetscInt       coordSize, d;
1746   PetscErrorCode ierr;
1747 
1748   PetscFunctionBegin;
1749   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1750   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1751   ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, cell, &coordSize, &coords);CHKERRQ(ierr);
1752   ierr = DMLocalizeCoordinate_Internal(dm, dim, coords, &coords[dim], tmp);CHKERRQ(ierr);
1753   if (centroid) {
1754     for (d = 0; d < dim; ++d) centroid[d] = 0.5*PetscRealPart(coords[d] + tmp[d]);
1755   }
1756   if (normal) {
1757     PetscReal norm;
1758 
1759     if (dim != 2) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "We only support 2D edges right now");
1760     normal[0]  = -PetscRealPart(coords[1] - tmp[1]);
1761     normal[1]  =  PetscRealPart(coords[0] - tmp[0]);
1762     norm       = DMPlex_NormD_Internal(dim, normal);
1763     for (d = 0; d < dim; ++d) normal[d] /= norm;
1764   }
1765   if (vol) {
1766     *vol = 0.0;
1767     for (d = 0; d < dim; ++d) *vol += PetscSqr(PetscRealPart(coords[d] - tmp[d]));
1768     *vol = PetscSqrtReal(*vol);
1769   }
1770   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, cell, &coordSize, &coords);CHKERRQ(ierr);
1771   PetscFunctionReturn(0);
1772 }
1773 
1774 /* Centroid_i = (\sum_n A_n Cn_i) / A */
1775 static PetscErrorCode DMPlexComputeGeometryFVM_2D_Internal(DM dm, PetscInt dim, PetscInt cell, PetscReal *vol, PetscReal centroid[], PetscReal normal[])
1776 {
1777   DMPolytopeType ct;
1778   PetscSection   coordSection;
1779   Vec            coordinates;
1780   PetscScalar   *coords = NULL;
1781   PetscReal      vsum = 0.0, csum[3] = {0.0, 0.0, 0.0}, vtmp, ctmp[4], v0[3], R[9];
1782   PetscBool      isHybrid = PETSC_FALSE;
1783   PetscInt       fv[4] = {0, 1, 2, 3};
1784   PetscInt       tdim = 2, coordSize, numCorners, p, d, e;
1785   PetscErrorCode ierr;
1786 
1787   PetscFunctionBegin;
1788   /* Must check for hybrid cells because prisms have a different orientation scheme */
1789   ierr = DMPlexGetCellType(dm, cell, &ct);CHKERRQ(ierr);
1790   switch (ct) {
1791     case DM_POLYTOPE_POINT_PRISM_TENSOR:
1792     case DM_POLYTOPE_SEG_PRISM_TENSOR:
1793     case DM_POLYTOPE_TRI_PRISM_TENSOR:
1794     case DM_POLYTOPE_QUAD_PRISM_TENSOR:
1795       isHybrid = PETSC_TRUE;
1796     default: break;
1797   }
1798   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1799   ierr = DMPlexGetConeSize(dm, cell, &numCorners);CHKERRQ(ierr);
1800   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1801   ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, cell, &coordSize, &coords);CHKERRQ(ierr);
1802   ierr = DMGetCoordinateDim(dm, &dim);CHKERRQ(ierr);
1803   /* Side faces for hybrid cells are are stored as tensor products */
1804   if (isHybrid && numCorners == 4) {fv[2] = 3; fv[3] = 2;}
1805 
1806   if (dim > 2 && centroid) {
1807     v0[0] = PetscRealPart(coords[0]);
1808     v0[1] = PetscRealPart(coords[1]);
1809     v0[2] = PetscRealPart(coords[2]);
1810   }
1811   if (normal) {
1812     if (dim > 2) {
1813       const PetscReal x0 = PetscRealPart(coords[dim*fv[1]+0] - coords[0]), x1 = PetscRealPart(coords[dim*fv[2]+0] - coords[0]);
1814       const PetscReal y0 = PetscRealPart(coords[dim*fv[1]+1] - coords[1]), y1 = PetscRealPart(coords[dim*fv[2]+1] - coords[1]);
1815       const PetscReal z0 = PetscRealPart(coords[dim*fv[1]+2] - coords[2]), z1 = PetscRealPart(coords[dim*fv[2]+2] - coords[2]);
1816       PetscReal       norm;
1817 
1818       normal[0] = y0*z1 - z0*y1;
1819       normal[1] = z0*x1 - x0*z1;
1820       normal[2] = x0*y1 - y0*x1;
1821       norm = PetscSqrtReal(normal[0]*normal[0] + normal[1]*normal[1] + normal[2]*normal[2]);
1822       normal[0] /= norm;
1823       normal[1] /= norm;
1824       normal[2] /= norm;
1825     } else {
1826       for (d = 0; d < dim; ++d) normal[d] = 0.0;
1827     }
1828   }
1829   if (dim == 3) {ierr = DMPlexComputeProjection3Dto2D(coordSize, coords, R);CHKERRQ(ierr);}
1830   for (p = 0; p < numCorners; ++p) {
1831     const PetscInt pi  = p < 4 ? fv[p] : p;
1832     const PetscInt pin = p < 3 ? fv[(p+1)%numCorners] : (p+1)%numCorners;
1833     /* Need to do this copy to get types right */
1834     for (d = 0; d < tdim; ++d) {
1835       ctmp[d]      = PetscRealPart(coords[pi*tdim+d]);
1836       ctmp[tdim+d] = PetscRealPart(coords[pin*tdim+d]);
1837     }
1838     Volume_Triangle_Origin_Internal(&vtmp, ctmp);
1839     vsum += vtmp;
1840     for (d = 0; d < tdim; ++d) {
1841       csum[d] += (ctmp[d] + ctmp[tdim+d])*vtmp;
1842     }
1843   }
1844   for (d = 0; d < tdim; ++d) {
1845     csum[d] /= (tdim+1)*vsum;
1846   }
1847   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, cell, &coordSize, &coords);CHKERRQ(ierr);
1848   if (vol) *vol = PetscAbsReal(vsum);
1849   if (centroid) {
1850     if (dim > 2) {
1851       for (d = 0; d < dim; ++d) {
1852         centroid[d] = v0[d];
1853         for (e = 0; e < dim; ++e) {
1854           centroid[d] += R[d*dim+e]*csum[e];
1855         }
1856       }
1857     } else for (d = 0; d < dim; ++d) centroid[d] = csum[d];
1858   }
1859   PetscFunctionReturn(0);
1860 }
1861 
1862 /* Centroid_i = (\sum_n V_n Cn_i) / V */
1863 static PetscErrorCode DMPlexComputeGeometryFVM_3D_Internal(DM dm, PetscInt dim, PetscInt cell, PetscReal *vol, PetscReal centroid[], PetscReal normal[])
1864 {
1865   DMPolytopeType  ct;
1866   PetscSection    coordSection;
1867   Vec             coordinates;
1868   PetscScalar    *coords = NULL;
1869   PetscReal       vsum = 0.0, vtmp, coordsTmp[3*3];
1870   const PetscInt *faces, *facesO;
1871   PetscBool       isHybrid = PETSC_FALSE;
1872   PetscInt        numFaces, f, coordSize, p, d;
1873   PetscErrorCode  ierr;
1874 
1875   PetscFunctionBegin;
1876   if (PetscUnlikely(dim > 3)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"No support for dim %D > 3",dim);
1877   /* Must check for hybrid cells because prisms have a different orientation scheme */
1878   ierr = DMPlexGetCellType(dm, cell, &ct);CHKERRQ(ierr);
1879   switch (ct) {
1880     case DM_POLYTOPE_POINT_PRISM_TENSOR:
1881     case DM_POLYTOPE_SEG_PRISM_TENSOR:
1882     case DM_POLYTOPE_TRI_PRISM_TENSOR:
1883     case DM_POLYTOPE_QUAD_PRISM_TENSOR:
1884       isHybrid = PETSC_TRUE;
1885     default: break;
1886   }
1887 
1888   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1889   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1890 
1891   if (centroid) for (d = 0; d < dim; ++d) centroid[d] = 0.0;
1892   ierr = DMPlexGetConeSize(dm, cell, &numFaces);CHKERRQ(ierr);
1893   ierr = DMPlexGetCone(dm, cell, &faces);CHKERRQ(ierr);
1894   ierr = DMPlexGetConeOrientation(dm, cell, &facesO);CHKERRQ(ierr);
1895   for (f = 0; f < numFaces; ++f) {
1896     PetscBool      flip = isHybrid && f == 0 ? PETSC_TRUE : PETSC_FALSE; /* The first hybrid face is reversed */
1897     DMPolytopeType ct;
1898 
1899     ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, faces[f], &coordSize, &coords);CHKERRQ(ierr);
1900     ierr = DMPlexGetCellType(dm, faces[f], &ct);CHKERRQ(ierr);
1901     switch (ct) {
1902     case DM_POLYTOPE_TRIANGLE:
1903       for (d = 0; d < dim; ++d) {
1904         coordsTmp[0*dim+d] = PetscRealPart(coords[0*dim+d]);
1905         coordsTmp[1*dim+d] = PetscRealPart(coords[1*dim+d]);
1906         coordsTmp[2*dim+d] = PetscRealPart(coords[2*dim+d]);
1907       }
1908       Volume_Tetrahedron_Origin_Internal(&vtmp, coordsTmp);
1909       if (facesO[f] < 0 || flip) vtmp = -vtmp;
1910       vsum += vtmp;
1911       if (centroid) {           /* Centroid of OABC = (a+b+c)/4 */
1912         for (d = 0; d < dim; ++d) {
1913           for (p = 0; p < 3; ++p) centroid[d] += coordsTmp[p*dim+d]*vtmp;
1914         }
1915       }
1916       break;
1917     case DM_POLYTOPE_QUADRILATERAL:
1918     case DM_POLYTOPE_SEG_PRISM_TENSOR:
1919     {
1920       PetscInt fv[4] = {0, 1, 2, 3};
1921 
1922       /* Side faces for hybrid cells are are stored as tensor products */
1923       if (isHybrid && f > 1) {fv[2] = 3; fv[3] = 2;}
1924       /* DO FOR PYRAMID */
1925       /* First tet */
1926       for (d = 0; d < dim; ++d) {
1927         coordsTmp[0*dim+d] = PetscRealPart(coords[fv[0]*dim+d]);
1928         coordsTmp[1*dim+d] = PetscRealPart(coords[fv[1]*dim+d]);
1929         coordsTmp[2*dim+d] = PetscRealPart(coords[fv[3]*dim+d]);
1930       }
1931       Volume_Tetrahedron_Origin_Internal(&vtmp, coordsTmp);
1932       if (facesO[f] < 0 || flip) vtmp = -vtmp;
1933       vsum += vtmp;
1934       if (centroid) {
1935         for (d = 0; d < dim; ++d) {
1936           for (p = 0; p < 3; ++p) centroid[d] += coordsTmp[p*dim+d]*vtmp;
1937         }
1938       }
1939       /* Second tet */
1940       for (d = 0; d < dim; ++d) {
1941         coordsTmp[0*dim+d] = PetscRealPart(coords[fv[1]*dim+d]);
1942         coordsTmp[1*dim+d] = PetscRealPart(coords[fv[2]*dim+d]);
1943         coordsTmp[2*dim+d] = PetscRealPart(coords[fv[3]*dim+d]);
1944       }
1945       Volume_Tetrahedron_Origin_Internal(&vtmp, coordsTmp);
1946       if (facesO[f] < 0 || flip) vtmp = -vtmp;
1947       vsum += vtmp;
1948       if (centroid) {
1949         for (d = 0; d < dim; ++d) {
1950           for (p = 0; p < 3; ++p) centroid[d] += coordsTmp[p*dim+d]*vtmp;
1951         }
1952       }
1953       break;
1954     }
1955     default:
1956       SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle face %D of type %s", faces[f], DMPolytopeTypes[ct]);
1957     }
1958     ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, faces[f], &coordSize, &coords);CHKERRQ(ierr);
1959   }
1960   if (vol)     *vol = PetscAbsReal(vsum);
1961   if (normal)   for (d = 0; d < dim; ++d) normal[d]    = 0.0;
1962   if (centroid) for (d = 0; d < dim; ++d) centroid[d] /= (vsum*4);
1963   PetscFunctionReturn(0);
1964 }
1965 
1966 /*@C
1967   DMPlexComputeCellGeometryFVM - Compute the volume for a given cell
1968 
1969   Collective on dm
1970 
1971   Input Arguments:
1972 + dm   - the DM
1973 - cell - the cell
1974 
1975   Output Arguments:
1976 + volume   - the cell volume
1977 . centroid - the cell centroid
1978 - normal - the cell normal, if appropriate
1979 
1980   Level: advanced
1981 
1982   Fortran Notes:
1983   Since it returns arrays, this routine is only available in Fortran 90, and you must
1984   include petsc.h90 in your code.
1985 
1986 .seealso: DMGetCoordinateSection(), DMGetCoordinates()
1987 @*/
1988 PetscErrorCode DMPlexComputeCellGeometryFVM(DM dm, PetscInt cell, PetscReal *vol, PetscReal centroid[], PetscReal normal[])
1989 {
1990   PetscInt       depth, dim;
1991   PetscErrorCode ierr;
1992 
1993   PetscFunctionBegin;
1994   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1995   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1996   if (depth != dim) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Mesh must be interpolated");
1997   ierr = DMPlexGetPointDepth(dm, cell, &depth);CHKERRQ(ierr);
1998   switch (depth) {
1999   case 1:
2000     ierr = DMPlexComputeGeometryFVM_1D_Internal(dm, dim, cell, vol, centroid, normal);CHKERRQ(ierr);
2001     break;
2002   case 2:
2003     ierr = DMPlexComputeGeometryFVM_2D_Internal(dm, dim, cell, vol, centroid, normal);CHKERRQ(ierr);
2004     break;
2005   case 3:
2006     ierr = DMPlexComputeGeometryFVM_3D_Internal(dm, dim, cell, vol, centroid, normal);CHKERRQ(ierr);
2007     break;
2008   default:
2009     SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unsupported dimension %D (depth %D) for element geometry computation", dim, depth);
2010   }
2011   PetscFunctionReturn(0);
2012 }
2013 
2014 /*@
2015   DMPlexComputeGeometryFEM - Precompute cell geometry for the entire mesh
2016 
2017   Collective on dm
2018 
2019   Input Parameter:
2020 . dm - The DMPlex
2021 
2022   Output Parameter:
2023 . cellgeom - A vector with the cell geometry data for each cell
2024 
2025   Level: beginner
2026 
2027 @*/
2028 PetscErrorCode DMPlexComputeGeometryFEM(DM dm, Vec *cellgeom)
2029 {
2030   DM             dmCell;
2031   Vec            coordinates;
2032   PetscSection   coordSection, sectionCell;
2033   PetscScalar   *cgeom;
2034   PetscInt       cStart, cEnd, c;
2035   PetscErrorCode ierr;
2036 
2037   PetscFunctionBegin;
2038   ierr = DMClone(dm, &dmCell);CHKERRQ(ierr);
2039   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
2040   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
2041   ierr = DMSetCoordinateSection(dmCell, PETSC_DETERMINE, coordSection);CHKERRQ(ierr);
2042   ierr = DMSetCoordinatesLocal(dmCell, coordinates);CHKERRQ(ierr);
2043   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &sectionCell);CHKERRQ(ierr);
2044   ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2045   ierr = PetscSectionSetChart(sectionCell, cStart, cEnd);CHKERRQ(ierr);
2046   /* TODO This needs to be multiplied by Nq for non-affine */
2047   for (c = cStart; c < cEnd; ++c) {ierr = PetscSectionSetDof(sectionCell, c, (PetscInt) PetscCeilReal(((PetscReal) sizeof(PetscFEGeom))/sizeof(PetscScalar)));CHKERRQ(ierr);}
2048   ierr = PetscSectionSetUp(sectionCell);CHKERRQ(ierr);
2049   ierr = DMSetLocalSection(dmCell, sectionCell);CHKERRQ(ierr);
2050   ierr = PetscSectionDestroy(&sectionCell);CHKERRQ(ierr);
2051   ierr = DMCreateLocalVector(dmCell, cellgeom);CHKERRQ(ierr);
2052   ierr = VecGetArray(*cellgeom, &cgeom);CHKERRQ(ierr);
2053   for (c = cStart; c < cEnd; ++c) {
2054     PetscFEGeom *cg;
2055 
2056     ierr = DMPlexPointLocalRef(dmCell, c, cgeom, &cg);CHKERRQ(ierr);
2057     ierr = PetscArrayzero(cg, 1);CHKERRQ(ierr);
2058     ierr = DMPlexComputeCellGeometryFEM(dmCell, c, NULL, cg->v, cg->J, cg->invJ, cg->detJ);CHKERRQ(ierr);
2059     if (*cg->detJ <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D", (double) *cg->detJ, c);
2060   }
2061   PetscFunctionReturn(0);
2062 }
2063 
2064 /*@
2065   DMPlexComputeGeometryFVM - Computes the cell and face geometry for a finite volume method
2066 
2067   Input Parameter:
2068 . dm - The DM
2069 
2070   Output Parameters:
2071 + cellgeom - A Vec of PetscFVCellGeom data
2072 - facegeom - A Vec of PetscFVFaceGeom data
2073 
2074   Level: developer
2075 
2076 .seealso: PetscFVFaceGeom, PetscFVCellGeom, DMPlexComputeGeometryFEM()
2077 @*/
2078 PetscErrorCode DMPlexComputeGeometryFVM(DM dm, Vec *cellgeom, Vec *facegeom)
2079 {
2080   DM             dmFace, dmCell;
2081   DMLabel        ghostLabel;
2082   PetscSection   sectionFace, sectionCell;
2083   PetscSection   coordSection;
2084   Vec            coordinates;
2085   PetscScalar   *fgeom, *cgeom;
2086   PetscReal      minradius, gminradius;
2087   PetscInt       dim, cStart, cEnd, cEndInterior, c, fStart, fEnd, f;
2088   PetscErrorCode ierr;
2089 
2090   PetscFunctionBegin;
2091   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2092   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
2093   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
2094   /* Make cell centroids and volumes */
2095   ierr = DMClone(dm, &dmCell);CHKERRQ(ierr);
2096   ierr = DMSetCoordinateSection(dmCell, PETSC_DETERMINE, coordSection);CHKERRQ(ierr);
2097   ierr = DMSetCoordinatesLocal(dmCell, coordinates);CHKERRQ(ierr);
2098   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &sectionCell);CHKERRQ(ierr);
2099   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2100   ierr = DMPlexGetGhostCellStratum(dm, &cEndInterior, NULL);CHKERRQ(ierr);
2101   ierr = PetscSectionSetChart(sectionCell, cStart, cEnd);CHKERRQ(ierr);
2102   for (c = cStart; c < cEnd; ++c) {ierr = PetscSectionSetDof(sectionCell, c, (PetscInt) PetscCeilReal(((PetscReal) sizeof(PetscFVCellGeom))/sizeof(PetscScalar)));CHKERRQ(ierr);}
2103   ierr = PetscSectionSetUp(sectionCell);CHKERRQ(ierr);
2104   ierr = DMSetLocalSection(dmCell, sectionCell);CHKERRQ(ierr);
2105   ierr = PetscSectionDestroy(&sectionCell);CHKERRQ(ierr);
2106   ierr = DMCreateLocalVector(dmCell, cellgeom);CHKERRQ(ierr);
2107   if (cEndInterior < 0) cEndInterior = cEnd;
2108   ierr = VecGetArray(*cellgeom, &cgeom);CHKERRQ(ierr);
2109   for (c = cStart; c < cEndInterior; ++c) {
2110     PetscFVCellGeom *cg;
2111 
2112     ierr = DMPlexPointLocalRef(dmCell, c, cgeom, &cg);CHKERRQ(ierr);
2113     ierr = PetscArrayzero(cg, 1);CHKERRQ(ierr);
2114     ierr = DMPlexComputeCellGeometryFVM(dmCell, c, &cg->volume, cg->centroid, NULL);CHKERRQ(ierr);
2115   }
2116   /* Compute face normals and minimum cell radius */
2117   ierr = DMClone(dm, &dmFace);CHKERRQ(ierr);
2118   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &sectionFace);CHKERRQ(ierr);
2119   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
2120   ierr = PetscSectionSetChart(sectionFace, fStart, fEnd);CHKERRQ(ierr);
2121   for (f = fStart; f < fEnd; ++f) {ierr = PetscSectionSetDof(sectionFace, f, (PetscInt) PetscCeilReal(((PetscReal) sizeof(PetscFVFaceGeom))/sizeof(PetscScalar)));CHKERRQ(ierr);}
2122   ierr = PetscSectionSetUp(sectionFace);CHKERRQ(ierr);
2123   ierr = DMSetLocalSection(dmFace, sectionFace);CHKERRQ(ierr);
2124   ierr = PetscSectionDestroy(&sectionFace);CHKERRQ(ierr);
2125   ierr = DMCreateLocalVector(dmFace, facegeom);CHKERRQ(ierr);
2126   ierr = VecGetArray(*facegeom, &fgeom);CHKERRQ(ierr);
2127   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
2128   minradius = PETSC_MAX_REAL;
2129   for (f = fStart; f < fEnd; ++f) {
2130     PetscFVFaceGeom *fg;
2131     PetscReal        area;
2132     const PetscInt  *cells;
2133     PetscInt         ncells, ghost = -1, d, numChildren;
2134 
2135     if (ghostLabel) {ierr = DMLabelGetValue(ghostLabel, f, &ghost);CHKERRQ(ierr);}
2136     ierr = DMPlexGetTreeChildren(dm,f,&numChildren,NULL);CHKERRQ(ierr);
2137     ierr = DMPlexGetSupport(dm, f, &cells);CHKERRQ(ierr);
2138     ierr = DMPlexGetSupportSize(dm, f, &ncells);CHKERRQ(ierr);
2139     /* It is possible to get a face with no support when using partition overlap */
2140     if (!ncells || ghost >= 0 || numChildren) continue;
2141     ierr = DMPlexPointLocalRef(dmFace, f, fgeom, &fg);CHKERRQ(ierr);
2142     ierr = DMPlexComputeCellGeometryFVM(dm, f, &area, fg->centroid, fg->normal);CHKERRQ(ierr);
2143     for (d = 0; d < dim; ++d) fg->normal[d] *= area;
2144     /* Flip face orientation if necessary to match ordering in support, and Update minimum radius */
2145     {
2146       PetscFVCellGeom *cL, *cR;
2147       PetscReal       *lcentroid, *rcentroid;
2148       PetscReal        l[3], r[3], v[3];
2149 
2150       ierr = DMPlexPointLocalRead(dmCell, cells[0], cgeom, &cL);CHKERRQ(ierr);
2151       lcentroid = cells[0] >= cEndInterior ? fg->centroid : cL->centroid;
2152       if (ncells > 1) {
2153         ierr = DMPlexPointLocalRead(dmCell, cells[1], cgeom, &cR);CHKERRQ(ierr);
2154         rcentroid = cells[1] >= cEndInterior ? fg->centroid : cR->centroid;
2155       }
2156       else {
2157         rcentroid = fg->centroid;
2158       }
2159       ierr = DMLocalizeCoordinateReal_Internal(dm, dim, fg->centroid, lcentroid, l);CHKERRQ(ierr);
2160       ierr = DMLocalizeCoordinateReal_Internal(dm, dim, fg->centroid, rcentroid, r);CHKERRQ(ierr);
2161       DMPlex_WaxpyD_Internal(dim, -1, l, r, v);
2162       if (DMPlex_DotRealD_Internal(dim, fg->normal, v) < 0) {
2163         for (d = 0; d < dim; ++d) fg->normal[d] = -fg->normal[d];
2164       }
2165       if (DMPlex_DotRealD_Internal(dim, fg->normal, v) <= 0) {
2166         if (dim == 2) SETERRQ5(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Direction for face %d could not be fixed, normal (%g,%g) v (%g,%g)", f, (double) fg->normal[0], (double) fg->normal[1], (double) v[0], (double) v[1]);
2167         if (dim == 3) SETERRQ7(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Direction for face %d could not be fixed, normal (%g,%g,%g) v (%g,%g,%g)", f, (double) fg->normal[0], (double) fg->normal[1], (double) fg->normal[2], (double) v[0], (double) v[1], (double) v[2]);
2168         SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Direction for face %d could not be fixed", f);
2169       }
2170       if (cells[0] < cEndInterior) {
2171         DMPlex_WaxpyD_Internal(dim, -1, fg->centroid, cL->centroid, v);
2172         minradius = PetscMin(minradius, DMPlex_NormD_Internal(dim, v));
2173       }
2174       if (ncells > 1 && cells[1] < cEndInterior) {
2175         DMPlex_WaxpyD_Internal(dim, -1, fg->centroid, cR->centroid, v);
2176         minradius = PetscMin(minradius, DMPlex_NormD_Internal(dim, v));
2177       }
2178     }
2179   }
2180   ierr = MPIU_Allreduce(&minradius, &gminradius, 1, MPIU_REAL, MPIU_MIN, PetscObjectComm((PetscObject)dm));CHKERRMPI(ierr);
2181   ierr = DMPlexSetMinRadius(dm, gminradius);CHKERRQ(ierr);
2182   /* Compute centroids of ghost cells */
2183   for (c = cEndInterior; c < cEnd; ++c) {
2184     PetscFVFaceGeom *fg;
2185     const PetscInt  *cone,    *support;
2186     PetscInt         coneSize, supportSize, s;
2187 
2188     ierr = DMPlexGetConeSize(dmCell, c, &coneSize);CHKERRQ(ierr);
2189     if (coneSize != 1) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Ghost cell %d has cone size %d != 1", c, coneSize);
2190     ierr = DMPlexGetCone(dmCell, c, &cone);CHKERRQ(ierr);
2191     ierr = DMPlexGetSupportSize(dmCell, cone[0], &supportSize);CHKERRQ(ierr);
2192     if (supportSize != 2) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %d has support size %d != 2", cone[0], supportSize);
2193     ierr = DMPlexGetSupport(dmCell, cone[0], &support);CHKERRQ(ierr);
2194     ierr = DMPlexPointLocalRef(dmFace, cone[0], fgeom, &fg);CHKERRQ(ierr);
2195     for (s = 0; s < 2; ++s) {
2196       /* Reflect ghost centroid across plane of face */
2197       if (support[s] == c) {
2198         PetscFVCellGeom       *ci;
2199         PetscFVCellGeom       *cg;
2200         PetscReal              c2f[3], a;
2201 
2202         ierr = DMPlexPointLocalRead(dmCell, support[(s+1)%2], cgeom, &ci);CHKERRQ(ierr);
2203         DMPlex_WaxpyD_Internal(dim, -1, ci->centroid, fg->centroid, c2f); /* cell to face centroid */
2204         a    = DMPlex_DotRealD_Internal(dim, c2f, fg->normal)/DMPlex_DotRealD_Internal(dim, fg->normal, fg->normal);
2205         ierr = DMPlexPointLocalRef(dmCell, support[s], cgeom, &cg);CHKERRQ(ierr);
2206         DMPlex_WaxpyD_Internal(dim, 2*a, fg->normal, ci->centroid, cg->centroid);
2207         cg->volume = ci->volume;
2208       }
2209     }
2210   }
2211   ierr = VecRestoreArray(*facegeom, &fgeom);CHKERRQ(ierr);
2212   ierr = VecRestoreArray(*cellgeom, &cgeom);CHKERRQ(ierr);
2213   ierr = DMDestroy(&dmCell);CHKERRQ(ierr);
2214   ierr = DMDestroy(&dmFace);CHKERRQ(ierr);
2215   PetscFunctionReturn(0);
2216 }
2217 
2218 /*@C
2219   DMPlexGetMinRadius - Returns the minimum distance from any cell centroid to a face
2220 
2221   Not collective
2222 
2223   Input Argument:
2224 . dm - the DM
2225 
2226   Output Argument:
2227 . minradius - the minium cell radius
2228 
2229   Level: developer
2230 
2231 .seealso: DMGetCoordinates()
2232 @*/
2233 PetscErrorCode DMPlexGetMinRadius(DM dm, PetscReal *minradius)
2234 {
2235   PetscFunctionBegin;
2236   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
2237   PetscValidPointer(minradius,2);
2238   *minradius = ((DM_Plex*) dm->data)->minradius;
2239   PetscFunctionReturn(0);
2240 }
2241 
2242 /*@C
2243   DMPlexSetMinRadius - Sets the minimum distance from the cell centroid to a face
2244 
2245   Logically collective
2246 
2247   Input Arguments:
2248 + dm - the DM
2249 - minradius - the minium cell radius
2250 
2251   Level: developer
2252 
2253 .seealso: DMSetCoordinates()
2254 @*/
2255 PetscErrorCode DMPlexSetMinRadius(DM dm, PetscReal minradius)
2256 {
2257   PetscFunctionBegin;
2258   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
2259   ((DM_Plex*) dm->data)->minradius = minradius;
2260   PetscFunctionReturn(0);
2261 }
2262 
2263 static PetscErrorCode BuildGradientReconstruction_Internal(DM dm, PetscFV fvm, DM dmFace, PetscScalar *fgeom, DM dmCell, PetscScalar *cgeom)
2264 {
2265   DMLabel        ghostLabel;
2266   PetscScalar   *dx, *grad, **gref;
2267   PetscInt       dim, cStart, cEnd, c, cEndInterior, maxNumFaces;
2268   PetscErrorCode ierr;
2269 
2270   PetscFunctionBegin;
2271   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2272   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2273   ierr = DMPlexGetGhostCellStratum(dm, &cEndInterior, NULL);CHKERRQ(ierr);
2274   cEndInterior = cEndInterior < 0 ? cEnd : cEndInterior;
2275   ierr = DMPlexGetMaxSizes(dm, &maxNumFaces, NULL);CHKERRQ(ierr);
2276   ierr = PetscFVLeastSquaresSetMaxFaces(fvm, maxNumFaces);CHKERRQ(ierr);
2277   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
2278   ierr = PetscMalloc3(maxNumFaces*dim, &dx, maxNumFaces*dim, &grad, maxNumFaces, &gref);CHKERRQ(ierr);
2279   for (c = cStart; c < cEndInterior; c++) {
2280     const PetscInt        *faces;
2281     PetscInt               numFaces, usedFaces, f, d;
2282     PetscFVCellGeom        *cg;
2283     PetscBool              boundary;
2284     PetscInt               ghost;
2285 
2286     ierr = DMPlexPointLocalRead(dmCell, c, cgeom, &cg);CHKERRQ(ierr);
2287     ierr = DMPlexGetConeSize(dm, c, &numFaces);CHKERRQ(ierr);
2288     ierr = DMPlexGetCone(dm, c, &faces);CHKERRQ(ierr);
2289     if (numFaces < dim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Cell %D has only %D faces, not enough for gradient reconstruction", c, numFaces);
2290     for (f = 0, usedFaces = 0; f < numFaces; ++f) {
2291       PetscFVCellGeom       *cg1;
2292       PetscFVFaceGeom       *fg;
2293       const PetscInt        *fcells;
2294       PetscInt               ncell, side;
2295 
2296       ierr = DMLabelGetValue(ghostLabel, faces[f], &ghost);CHKERRQ(ierr);
2297       ierr = DMIsBoundaryPoint(dm, faces[f], &boundary);CHKERRQ(ierr);
2298       if ((ghost >= 0) || boundary) continue;
2299       ierr  = DMPlexGetSupport(dm, faces[f], &fcells);CHKERRQ(ierr);
2300       side  = (c != fcells[0]); /* c is on left=0 or right=1 of face */
2301       ncell = fcells[!side];    /* the neighbor */
2302       ierr  = DMPlexPointLocalRef(dmFace, faces[f], fgeom, &fg);CHKERRQ(ierr);
2303       ierr  = DMPlexPointLocalRead(dmCell, ncell, cgeom, &cg1);CHKERRQ(ierr);
2304       for (d = 0; d < dim; ++d) dx[usedFaces*dim+d] = cg1->centroid[d] - cg->centroid[d];
2305       gref[usedFaces++] = fg->grad[side];  /* Gradient reconstruction term will go here */
2306     }
2307     if (!usedFaces) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_USER, "Mesh contains isolated cell (no neighbors). Is it intentional?");
2308     ierr = PetscFVComputeGradient(fvm, usedFaces, dx, grad);CHKERRQ(ierr);
2309     for (f = 0, usedFaces = 0; f < numFaces; ++f) {
2310       ierr = DMLabelGetValue(ghostLabel, faces[f], &ghost);CHKERRQ(ierr);
2311       ierr = DMIsBoundaryPoint(dm, faces[f], &boundary);CHKERRQ(ierr);
2312       if ((ghost >= 0) || boundary) continue;
2313       for (d = 0; d < dim; ++d) gref[usedFaces][d] = grad[usedFaces*dim+d];
2314       ++usedFaces;
2315     }
2316   }
2317   ierr = PetscFree3(dx, grad, gref);CHKERRQ(ierr);
2318   PetscFunctionReturn(0);
2319 }
2320 
2321 static PetscErrorCode BuildGradientReconstruction_Internal_Tree(DM dm, PetscFV fvm, DM dmFace, PetscScalar *fgeom, DM dmCell, PetscScalar *cgeom)
2322 {
2323   DMLabel        ghostLabel;
2324   PetscScalar   *dx, *grad, **gref;
2325   PetscInt       dim, cStart, cEnd, c, cEndInterior, fStart, fEnd, f, nStart, nEnd, maxNumFaces = 0;
2326   PetscSection   neighSec;
2327   PetscInt     (*neighbors)[2];
2328   PetscInt      *counter;
2329   PetscErrorCode ierr;
2330 
2331   PetscFunctionBegin;
2332   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2333   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2334   ierr = DMPlexGetGhostCellStratum(dm, &cEndInterior, NULL);CHKERRQ(ierr);
2335   if (cEndInterior < 0) cEndInterior = cEnd;
2336   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm),&neighSec);CHKERRQ(ierr);
2337   ierr = PetscSectionSetChart(neighSec,cStart,cEndInterior);CHKERRQ(ierr);
2338   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
2339   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
2340   for (f = fStart; f < fEnd; f++) {
2341     const PetscInt        *fcells;
2342     PetscBool              boundary;
2343     PetscInt               ghost = -1;
2344     PetscInt               numChildren, numCells, c;
2345 
2346     if (ghostLabel) {ierr = DMLabelGetValue(ghostLabel, f, &ghost);CHKERRQ(ierr);}
2347     ierr = DMIsBoundaryPoint(dm, f, &boundary);CHKERRQ(ierr);
2348     ierr = DMPlexGetTreeChildren(dm, f, &numChildren, NULL);CHKERRQ(ierr);
2349     if ((ghost >= 0) || boundary || numChildren) continue;
2350     ierr = DMPlexGetSupportSize(dm, f, &numCells);CHKERRQ(ierr);
2351     if (numCells == 2) {
2352       ierr = DMPlexGetSupport(dm, f, &fcells);CHKERRQ(ierr);
2353       for (c = 0; c < 2; c++) {
2354         PetscInt cell = fcells[c];
2355 
2356         if (cell >= cStart && cell < cEndInterior) {
2357           ierr = PetscSectionAddDof(neighSec,cell,1);CHKERRQ(ierr);
2358         }
2359       }
2360     }
2361   }
2362   ierr = PetscSectionSetUp(neighSec);CHKERRQ(ierr);
2363   ierr = PetscSectionGetMaxDof(neighSec,&maxNumFaces);CHKERRQ(ierr);
2364   ierr = PetscFVLeastSquaresSetMaxFaces(fvm, maxNumFaces);CHKERRQ(ierr);
2365   nStart = 0;
2366   ierr = PetscSectionGetStorageSize(neighSec,&nEnd);CHKERRQ(ierr);
2367   ierr = PetscMalloc1((nEnd-nStart),&neighbors);CHKERRQ(ierr);
2368   ierr = PetscCalloc1((cEndInterior-cStart),&counter);CHKERRQ(ierr);
2369   for (f = fStart; f < fEnd; f++) {
2370     const PetscInt        *fcells;
2371     PetscBool              boundary;
2372     PetscInt               ghost = -1;
2373     PetscInt               numChildren, numCells, c;
2374 
2375     if (ghostLabel) {ierr = DMLabelGetValue(ghostLabel, f, &ghost);CHKERRQ(ierr);}
2376     ierr = DMIsBoundaryPoint(dm, f, &boundary);CHKERRQ(ierr);
2377     ierr = DMPlexGetTreeChildren(dm, f, &numChildren, NULL);CHKERRQ(ierr);
2378     if ((ghost >= 0) || boundary || numChildren) continue;
2379     ierr = DMPlexGetSupportSize(dm, f, &numCells);CHKERRQ(ierr);
2380     if (numCells == 2) {
2381       ierr  = DMPlexGetSupport(dm, f, &fcells);CHKERRQ(ierr);
2382       for (c = 0; c < 2; c++) {
2383         PetscInt cell = fcells[c], off;
2384 
2385         if (cell >= cStart && cell < cEndInterior) {
2386           ierr = PetscSectionGetOffset(neighSec,cell,&off);CHKERRQ(ierr);
2387           off += counter[cell - cStart]++;
2388           neighbors[off][0] = f;
2389           neighbors[off][1] = fcells[1 - c];
2390         }
2391       }
2392     }
2393   }
2394   ierr = PetscFree(counter);CHKERRQ(ierr);
2395   ierr = PetscMalloc3(maxNumFaces*dim, &dx, maxNumFaces*dim, &grad, maxNumFaces, &gref);CHKERRQ(ierr);
2396   for (c = cStart; c < cEndInterior; c++) {
2397     PetscInt               numFaces, f, d, off, ghost = -1;
2398     PetscFVCellGeom        *cg;
2399 
2400     ierr = DMPlexPointLocalRead(dmCell, c, cgeom, &cg);CHKERRQ(ierr);
2401     ierr = PetscSectionGetDof(neighSec, c, &numFaces);CHKERRQ(ierr);
2402     ierr = PetscSectionGetOffset(neighSec, c, &off);CHKERRQ(ierr);
2403     if (ghostLabel) {ierr = DMLabelGetValue(ghostLabel, c, &ghost);CHKERRQ(ierr);}
2404     if (ghost < 0 && numFaces < dim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Cell %D has only %D faces, not enough for gradient reconstruction", c, numFaces);
2405     for (f = 0; f < numFaces; ++f) {
2406       PetscFVCellGeom       *cg1;
2407       PetscFVFaceGeom       *fg;
2408       const PetscInt        *fcells;
2409       PetscInt               ncell, side, nface;
2410 
2411       nface = neighbors[off + f][0];
2412       ncell = neighbors[off + f][1];
2413       ierr  = DMPlexGetSupport(dm,nface,&fcells);CHKERRQ(ierr);
2414       side  = (c != fcells[0]);
2415       ierr  = DMPlexPointLocalRef(dmFace, nface, fgeom, &fg);CHKERRQ(ierr);
2416       ierr  = DMPlexPointLocalRead(dmCell, ncell, cgeom, &cg1);CHKERRQ(ierr);
2417       for (d = 0; d < dim; ++d) dx[f*dim+d] = cg1->centroid[d] - cg->centroid[d];
2418       gref[f] = fg->grad[side];  /* Gradient reconstruction term will go here */
2419     }
2420     ierr = PetscFVComputeGradient(fvm, numFaces, dx, grad);CHKERRQ(ierr);
2421     for (f = 0; f < numFaces; ++f) {
2422       for (d = 0; d < dim; ++d) gref[f][d] = grad[f*dim+d];
2423     }
2424   }
2425   ierr = PetscFree3(dx, grad, gref);CHKERRQ(ierr);
2426   ierr = PetscSectionDestroy(&neighSec);CHKERRQ(ierr);
2427   ierr = PetscFree(neighbors);CHKERRQ(ierr);
2428   PetscFunctionReturn(0);
2429 }
2430 
2431 /*@
2432   DMPlexComputeGradientFVM - Compute geometric factors for gradient reconstruction, which are stored in the geometry data, and compute layout for gradient data
2433 
2434   Collective on dm
2435 
2436   Input Arguments:
2437 + dm  - The DM
2438 . fvm - The PetscFV
2439 . faceGeometry - The face geometry from DMPlexComputeFaceGeometryFVM()
2440 - cellGeometry - The face geometry from DMPlexComputeCellGeometryFVM()
2441 
2442   Output Parameters:
2443 + faceGeometry - The geometric factors for gradient calculation are inserted
2444 - dmGrad - The DM describing the layout of gradient data
2445 
2446   Level: developer
2447 
2448 .seealso: DMPlexGetFaceGeometryFVM(), DMPlexGetCellGeometryFVM()
2449 @*/
2450 PetscErrorCode DMPlexComputeGradientFVM(DM dm, PetscFV fvm, Vec faceGeometry, Vec cellGeometry, DM *dmGrad)
2451 {
2452   DM             dmFace, dmCell;
2453   PetscScalar   *fgeom, *cgeom;
2454   PetscSection   sectionGrad, parentSection;
2455   PetscInt       dim, pdim, cStart, cEnd, cEndInterior, c;
2456   PetscErrorCode ierr;
2457 
2458   PetscFunctionBegin;
2459   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2460   ierr = PetscFVGetNumComponents(fvm, &pdim);CHKERRQ(ierr);
2461   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2462   ierr = DMPlexGetGhostCellStratum(dm, &cEndInterior, NULL);CHKERRQ(ierr);
2463   /* Construct the interpolant corresponding to each face from the least-square solution over the cell neighborhood */
2464   ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
2465   ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
2466   ierr = VecGetArray(faceGeometry, &fgeom);CHKERRQ(ierr);
2467   ierr = VecGetArray(cellGeometry, &cgeom);CHKERRQ(ierr);
2468   ierr = DMPlexGetTree(dm,&parentSection,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
2469   if (!parentSection) {
2470     ierr = BuildGradientReconstruction_Internal(dm, fvm, dmFace, fgeom, dmCell, cgeom);CHKERRQ(ierr);
2471   } else {
2472     ierr = BuildGradientReconstruction_Internal_Tree(dm, fvm, dmFace, fgeom, dmCell, cgeom);CHKERRQ(ierr);
2473   }
2474   ierr = VecRestoreArray(faceGeometry, &fgeom);CHKERRQ(ierr);
2475   ierr = VecRestoreArray(cellGeometry, &cgeom);CHKERRQ(ierr);
2476   /* Create storage for gradients */
2477   ierr = DMClone(dm, dmGrad);CHKERRQ(ierr);
2478   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &sectionGrad);CHKERRQ(ierr);
2479   ierr = PetscSectionSetChart(sectionGrad, cStart, cEnd);CHKERRQ(ierr);
2480   for (c = cStart; c < cEnd; ++c) {ierr = PetscSectionSetDof(sectionGrad, c, pdim*dim);CHKERRQ(ierr);}
2481   ierr = PetscSectionSetUp(sectionGrad);CHKERRQ(ierr);
2482   ierr = DMSetLocalSection(*dmGrad, sectionGrad);CHKERRQ(ierr);
2483   ierr = PetscSectionDestroy(&sectionGrad);CHKERRQ(ierr);
2484   PetscFunctionReturn(0);
2485 }
2486 
2487 /*@
2488   DMPlexGetDataFVM - Retrieve precomputed cell geometry
2489 
2490   Collective on dm
2491 
2492   Input Arguments:
2493 + dm  - The DM
2494 - fvm - The PetscFV
2495 
2496   Output Parameters:
2497 + cellGeometry - The cell geometry
2498 . faceGeometry - The face geometry
2499 - dmGrad       - The gradient matrices
2500 
2501   Level: developer
2502 
2503 .seealso: DMPlexComputeGeometryFVM()
2504 @*/
2505 PetscErrorCode DMPlexGetDataFVM(DM dm, PetscFV fv, Vec *cellgeom, Vec *facegeom, DM *gradDM)
2506 {
2507   PetscObject    cellgeomobj, facegeomobj;
2508   PetscErrorCode ierr;
2509 
2510   PetscFunctionBegin;
2511   ierr = PetscObjectQuery((PetscObject) dm, "DMPlex_cellgeom_fvm", &cellgeomobj);CHKERRQ(ierr);
2512   if (!cellgeomobj) {
2513     Vec cellgeomInt, facegeomInt;
2514 
2515     ierr = DMPlexComputeGeometryFVM(dm, &cellgeomInt, &facegeomInt);CHKERRQ(ierr);
2516     ierr = PetscObjectCompose((PetscObject) dm, "DMPlex_cellgeom_fvm",(PetscObject)cellgeomInt);CHKERRQ(ierr);
2517     ierr = PetscObjectCompose((PetscObject) dm, "DMPlex_facegeom_fvm",(PetscObject)facegeomInt);CHKERRQ(ierr);
2518     ierr = VecDestroy(&cellgeomInt);CHKERRQ(ierr);
2519     ierr = VecDestroy(&facegeomInt);CHKERRQ(ierr);
2520     ierr = PetscObjectQuery((PetscObject) dm, "DMPlex_cellgeom_fvm", &cellgeomobj);CHKERRQ(ierr);
2521   }
2522   ierr = PetscObjectQuery((PetscObject) dm, "DMPlex_facegeom_fvm", &facegeomobj);CHKERRQ(ierr);
2523   if (cellgeom) *cellgeom = (Vec) cellgeomobj;
2524   if (facegeom) *facegeom = (Vec) facegeomobj;
2525   if (gradDM) {
2526     PetscObject gradobj;
2527     PetscBool   computeGradients;
2528 
2529     ierr = PetscFVGetComputeGradients(fv,&computeGradients);CHKERRQ(ierr);
2530     if (!computeGradients) {
2531       *gradDM = NULL;
2532       PetscFunctionReturn(0);
2533     }
2534     ierr = PetscObjectQuery((PetscObject) dm, "DMPlex_dmgrad_fvm", &gradobj);CHKERRQ(ierr);
2535     if (!gradobj) {
2536       DM dmGradInt;
2537 
2538       ierr = DMPlexComputeGradientFVM(dm,fv,(Vec) facegeomobj,(Vec) cellgeomobj,&dmGradInt);CHKERRQ(ierr);
2539       ierr = PetscObjectCompose((PetscObject) dm, "DMPlex_dmgrad_fvm", (PetscObject)dmGradInt);CHKERRQ(ierr);
2540       ierr = DMDestroy(&dmGradInt);CHKERRQ(ierr);
2541       ierr = PetscObjectQuery((PetscObject) dm, "DMPlex_dmgrad_fvm", &gradobj);CHKERRQ(ierr);
2542     }
2543     *gradDM = (DM) gradobj;
2544   }
2545   PetscFunctionReturn(0);
2546 }
2547 
2548 static PetscErrorCode DMPlexCoordinatesToReference_NewtonUpdate(PetscInt dimC, PetscInt dimR, PetscScalar *J, PetscScalar *invJ, PetscScalar *work,  PetscReal *resNeg, PetscReal *guess)
2549 {
2550   PetscInt l, m;
2551 
2552   PetscFunctionBeginHot;
2553   if (dimC == dimR && dimR <= 3) {
2554     /* invert Jacobian, multiply */
2555     PetscScalar det, idet;
2556 
2557     switch (dimR) {
2558     case 1:
2559       invJ[0] = 1./ J[0];
2560       break;
2561     case 2:
2562       det = J[0] * J[3] - J[1] * J[2];
2563       idet = 1./det;
2564       invJ[0] =  J[3] * idet;
2565       invJ[1] = -J[1] * idet;
2566       invJ[2] = -J[2] * idet;
2567       invJ[3] =  J[0] * idet;
2568       break;
2569     case 3:
2570       {
2571         invJ[0] = J[4] * J[8] - J[5] * J[7];
2572         invJ[1] = J[2] * J[7] - J[1] * J[8];
2573         invJ[2] = J[1] * J[5] - J[2] * J[4];
2574         det = invJ[0] * J[0] + invJ[1] * J[3] + invJ[2] * J[6];
2575         idet = 1./det;
2576         invJ[0] *= idet;
2577         invJ[1] *= idet;
2578         invJ[2] *= idet;
2579         invJ[3]  = idet * (J[5] * J[6] - J[3] * J[8]);
2580         invJ[4]  = idet * (J[0] * J[8] - J[2] * J[6]);
2581         invJ[5]  = idet * (J[2] * J[3] - J[0] * J[5]);
2582         invJ[6]  = idet * (J[3] * J[7] - J[4] * J[6]);
2583         invJ[7]  = idet * (J[1] * J[6] - J[0] * J[7]);
2584         invJ[8]  = idet * (J[0] * J[4] - J[1] * J[3]);
2585       }
2586       break;
2587     }
2588     for (l = 0; l < dimR; l++) {
2589       for (m = 0; m < dimC; m++) {
2590         guess[l] += PetscRealPart(invJ[l * dimC + m]) * resNeg[m];
2591       }
2592     }
2593   } else {
2594 #if defined(PETSC_USE_COMPLEX)
2595     char transpose = 'C';
2596 #else
2597     char transpose = 'T';
2598 #endif
2599     PetscBLASInt m = dimR;
2600     PetscBLASInt n = dimC;
2601     PetscBLASInt one = 1;
2602     PetscBLASInt worksize = dimR * dimC, info;
2603 
2604     for (l = 0; l < dimC; l++) {invJ[l] = resNeg[l];}
2605 
2606     PetscStackCallBLAS("LAPACKgels",LAPACKgels_(&transpose,&m,&n,&one,J,&m,invJ,&n,work,&worksize, &info));
2607     if (info != 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad argument to GELS");
2608 
2609     for (l = 0; l < dimR; l++) {guess[l] += PetscRealPart(invJ[l]);}
2610   }
2611   PetscFunctionReturn(0);
2612 }
2613 
2614 static PetscErrorCode DMPlexCoordinatesToReference_Tensor(DM dm, PetscInt cell, PetscInt numPoints, const PetscReal realCoords[], PetscReal refCoords[], Vec coords, PetscInt dimC, PetscInt dimR)
2615 {
2616   PetscInt       coordSize, i, j, k, l, m, maxIts = 7, numV = (1 << dimR);
2617   PetscScalar    *coordsScalar = NULL;
2618   PetscReal      *cellData, *cellCoords, *cellCoeffs, *extJ, *resNeg;
2619   PetscScalar    *J, *invJ, *work;
2620   PetscErrorCode ierr;
2621 
2622   PetscFunctionBegin;
2623   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
2624   ierr = DMPlexVecGetClosure(dm, NULL, coords, cell, &coordSize, &coordsScalar);CHKERRQ(ierr);
2625   if (coordSize < dimC * numV) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expecting at least %D coordinates, got %D",dimC * (1 << dimR), coordSize);
2626   ierr = DMGetWorkArray(dm, 2 * coordSize + dimR + dimC, MPIU_REAL, &cellData);CHKERRQ(ierr);
2627   ierr = DMGetWorkArray(dm, 3 * dimR * dimC, MPIU_SCALAR, &J);CHKERRQ(ierr);
2628   cellCoords = &cellData[0];
2629   cellCoeffs = &cellData[coordSize];
2630   extJ       = &cellData[2 * coordSize];
2631   resNeg     = &cellData[2 * coordSize + dimR];
2632   invJ       = &J[dimR * dimC];
2633   work       = &J[2 * dimR * dimC];
2634   if (dimR == 2) {
2635     const PetscInt zToPlex[4] = {0, 1, 3, 2};
2636 
2637     for (i = 0; i < 4; i++) {
2638       PetscInt plexI = zToPlex[i];
2639 
2640       for (j = 0; j < dimC; j++) {
2641         cellCoords[dimC * i + j] = PetscRealPart(coordsScalar[dimC * plexI + j]);
2642       }
2643     }
2644   } else if (dimR == 3) {
2645     const PetscInt zToPlex[8] = {0, 3, 1, 2, 4, 5, 7, 6};
2646 
2647     for (i = 0; i < 8; i++) {
2648       PetscInt plexI = zToPlex[i];
2649 
2650       for (j = 0; j < dimC; j++) {
2651         cellCoords[dimC * i + j] = PetscRealPart(coordsScalar[dimC * plexI + j]);
2652       }
2653     }
2654   } else {
2655     for (i = 0; i < coordSize; i++) {cellCoords[i] = PetscRealPart(coordsScalar[i]);}
2656   }
2657   /* Perform the shuffling transform that converts values at the corners of [-1,1]^d to coefficients */
2658   for (i = 0; i < dimR; i++) {
2659     PetscReal *swap;
2660 
2661     for (j = 0; j < (numV / 2); j++) {
2662       for (k = 0; k < dimC; k++) {
2663         cellCoeffs[dimC * j + k]                = 0.5 * (cellCoords[dimC * (2 * j + 1) + k] + cellCoords[dimC * 2 * j + k]);
2664         cellCoeffs[dimC * (j + (numV / 2)) + k] = 0.5 * (cellCoords[dimC * (2 * j + 1) + k] - cellCoords[dimC * 2 * j + k]);
2665       }
2666     }
2667 
2668     if (i < dimR - 1) {
2669       swap = cellCoeffs;
2670       cellCoeffs = cellCoords;
2671       cellCoords = swap;
2672     }
2673   }
2674   ierr = PetscArrayzero(refCoords,numPoints * dimR);CHKERRQ(ierr);
2675   for (j = 0; j < numPoints; j++) {
2676     for (i = 0; i < maxIts; i++) {
2677       PetscReal *guess = &refCoords[dimR * j];
2678 
2679       /* compute -residual and Jacobian */
2680       for (k = 0; k < dimC; k++) {resNeg[k] = realCoords[dimC * j + k];}
2681       for (k = 0; k < dimC * dimR; k++) {J[k] = 0.;}
2682       for (k = 0; k < numV; k++) {
2683         PetscReal extCoord = 1.;
2684         for (l = 0; l < dimR; l++) {
2685           PetscReal coord = guess[l];
2686           PetscInt  dep   = (k & (1 << l)) >> l;
2687 
2688           extCoord *= dep * coord + !dep;
2689           extJ[l] = dep;
2690 
2691           for (m = 0; m < dimR; m++) {
2692             PetscReal coord = guess[m];
2693             PetscInt  dep   = ((k & (1 << m)) >> m) && (m != l);
2694             PetscReal mult  = dep * coord + !dep;
2695 
2696             extJ[l] *= mult;
2697           }
2698         }
2699         for (l = 0; l < dimC; l++) {
2700           PetscReal coeff = cellCoeffs[dimC * k + l];
2701 
2702           resNeg[l] -= coeff * extCoord;
2703           for (m = 0; m < dimR; m++) {
2704             J[dimR * l + m] += coeff * extJ[m];
2705           }
2706         }
2707       }
2708       if (0 && PetscDefined(USE_DEBUG)) {
2709         PetscReal maxAbs = 0.;
2710 
2711         for (l = 0; l < dimC; l++) {
2712           maxAbs = PetscMax(maxAbs,PetscAbsReal(resNeg[l]));
2713         }
2714         ierr = PetscInfo4(dm,"cell %D, point %D, iter %D: res %g\n",cell,j,i,(double) maxAbs);CHKERRQ(ierr);
2715       }
2716 
2717       ierr = DMPlexCoordinatesToReference_NewtonUpdate(dimC,dimR,J,invJ,work,resNeg,guess);CHKERRQ(ierr);
2718     }
2719   }
2720   ierr = DMRestoreWorkArray(dm, 3 * dimR * dimC, MPIU_SCALAR, &J);CHKERRQ(ierr);
2721   ierr = DMRestoreWorkArray(dm, 2 * coordSize + dimR + dimC, MPIU_REAL, &cellData);CHKERRQ(ierr);
2722   ierr = DMPlexVecRestoreClosure(dm, NULL, coords, cell, &coordSize, &coordsScalar);CHKERRQ(ierr);
2723   PetscFunctionReturn(0);
2724 }
2725 
2726 static PetscErrorCode DMPlexReferenceToCoordinates_Tensor(DM dm, PetscInt cell, PetscInt numPoints, const PetscReal refCoords[], PetscReal realCoords[], Vec coords, PetscInt dimC, PetscInt dimR)
2727 {
2728   PetscInt       coordSize, i, j, k, l, numV = (1 << dimR);
2729   PetscScalar    *coordsScalar = NULL;
2730   PetscReal      *cellData, *cellCoords, *cellCoeffs;
2731   PetscErrorCode ierr;
2732 
2733   PetscFunctionBegin;
2734   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
2735   ierr = DMPlexVecGetClosure(dm, NULL, coords, cell, &coordSize, &coordsScalar);CHKERRQ(ierr);
2736   if (coordSize < dimC * numV) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expecting at least %D coordinates, got %D",dimC * (1 << dimR), coordSize);
2737   ierr = DMGetWorkArray(dm, 2 * coordSize, MPIU_REAL, &cellData);CHKERRQ(ierr);
2738   cellCoords = &cellData[0];
2739   cellCoeffs = &cellData[coordSize];
2740   if (dimR == 2) {
2741     const PetscInt zToPlex[4] = {0, 1, 3, 2};
2742 
2743     for (i = 0; i < 4; i++) {
2744       PetscInt plexI = zToPlex[i];
2745 
2746       for (j = 0; j < dimC; j++) {
2747         cellCoords[dimC * i + j] = PetscRealPart(coordsScalar[dimC * plexI + j]);
2748       }
2749     }
2750   } else if (dimR == 3) {
2751     const PetscInt zToPlex[8] = {0, 3, 1, 2, 4, 5, 7, 6};
2752 
2753     for (i = 0; i < 8; i++) {
2754       PetscInt plexI = zToPlex[i];
2755 
2756       for (j = 0; j < dimC; j++) {
2757         cellCoords[dimC * i + j] = PetscRealPart(coordsScalar[dimC * plexI + j]);
2758       }
2759     }
2760   } else {
2761     for (i = 0; i < coordSize; i++) {cellCoords[i] = PetscRealPart(coordsScalar[i]);}
2762   }
2763   /* Perform the shuffling transform that converts values at the corners of [-1,1]^d to coefficients */
2764   for (i = 0; i < dimR; i++) {
2765     PetscReal *swap;
2766 
2767     for (j = 0; j < (numV / 2); j++) {
2768       for (k = 0; k < dimC; k++) {
2769         cellCoeffs[dimC * j + k]                = 0.5 * (cellCoords[dimC * (2 * j + 1) + k] + cellCoords[dimC * 2 * j + k]);
2770         cellCoeffs[dimC * (j + (numV / 2)) + k] = 0.5 * (cellCoords[dimC * (2 * j + 1) + k] - cellCoords[dimC * 2 * j + k]);
2771       }
2772     }
2773 
2774     if (i < dimR - 1) {
2775       swap = cellCoeffs;
2776       cellCoeffs = cellCoords;
2777       cellCoords = swap;
2778     }
2779   }
2780   ierr = PetscArrayzero(realCoords,numPoints * dimC);CHKERRQ(ierr);
2781   for (j = 0; j < numPoints; j++) {
2782     const PetscReal *guess  = &refCoords[dimR * j];
2783     PetscReal       *mapped = &realCoords[dimC * j];
2784 
2785     for (k = 0; k < numV; k++) {
2786       PetscReal extCoord = 1.;
2787       for (l = 0; l < dimR; l++) {
2788         PetscReal coord = guess[l];
2789         PetscInt  dep   = (k & (1 << l)) >> l;
2790 
2791         extCoord *= dep * coord + !dep;
2792       }
2793       for (l = 0; l < dimC; l++) {
2794         PetscReal coeff = cellCoeffs[dimC * k + l];
2795 
2796         mapped[l] += coeff * extCoord;
2797       }
2798     }
2799   }
2800   ierr = DMRestoreWorkArray(dm, 2 * coordSize, MPIU_REAL, &cellData);CHKERRQ(ierr);
2801   ierr = DMPlexVecRestoreClosure(dm, NULL, coords, cell, &coordSize, &coordsScalar);CHKERRQ(ierr);
2802   PetscFunctionReturn(0);
2803 }
2804 
2805 /* TODO: TOBY please fix this for Nc > 1 */
2806 static PetscErrorCode DMPlexCoordinatesToReference_FE(DM dm, PetscFE fe, PetscInt cell, PetscInt numPoints, const PetscReal realCoords[], PetscReal refCoords[], Vec coords, PetscInt Nc, PetscInt dimR)
2807 {
2808   PetscInt       numComp, pdim, i, j, k, l, m, maxIter = 7, coordSize;
2809   PetscScalar    *nodes = NULL;
2810   PetscReal      *invV, *modes;
2811   PetscReal      *B, *D, *resNeg;
2812   PetscScalar    *J, *invJ, *work;
2813   PetscErrorCode ierr;
2814 
2815   PetscFunctionBegin;
2816   ierr = PetscFEGetDimension(fe, &pdim);CHKERRQ(ierr);
2817   ierr = PetscFEGetNumComponents(fe, &numComp);CHKERRQ(ierr);
2818   if (numComp != Nc) SETERRQ2(PetscObjectComm((PetscObject)dm),PETSC_ERR_SUP,"coordinate discretization must have as many components (%D) as embedding dimension (!= %D)",numComp,Nc);
2819   ierr = DMPlexVecGetClosure(dm, NULL, coords, cell, &coordSize, &nodes);CHKERRQ(ierr);
2820   /* convert nodes to values in the stable evaluation basis */
2821   ierr = DMGetWorkArray(dm,pdim,MPIU_REAL,&modes);CHKERRQ(ierr);
2822   invV = fe->invV;
2823   for (i = 0; i < pdim; ++i) {
2824     modes[i] = 0.;
2825     for (j = 0; j < pdim; ++j) {
2826       modes[i] += invV[i * pdim + j] * PetscRealPart(nodes[j]);
2827     }
2828   }
2829   ierr   = DMGetWorkArray(dm,pdim * Nc + pdim * Nc * dimR + Nc,MPIU_REAL,&B);CHKERRQ(ierr);
2830   D      = &B[pdim*Nc];
2831   resNeg = &D[pdim*Nc * dimR];
2832   ierr = DMGetWorkArray(dm,3 * Nc * dimR,MPIU_SCALAR,&J);CHKERRQ(ierr);
2833   invJ = &J[Nc * dimR];
2834   work = &invJ[Nc * dimR];
2835   for (i = 0; i < numPoints * dimR; i++) {refCoords[i] = 0.;}
2836   for (j = 0; j < numPoints; j++) {
2837       for (i = 0; i < maxIter; i++) { /* we could batch this so that we're not making big B and D arrays all the time */
2838       PetscReal *guess = &refCoords[j * dimR];
2839       ierr = PetscSpaceEvaluate(fe->basisSpace, 1, guess, B, D, NULL);CHKERRQ(ierr);
2840       for (k = 0; k < Nc; k++) {resNeg[k] = realCoords[j * Nc + k];}
2841       for (k = 0; k < Nc * dimR; k++) {J[k] = 0.;}
2842       for (k = 0; k < pdim; k++) {
2843         for (l = 0; l < Nc; l++) {
2844           resNeg[l] -= modes[k] * B[k * Nc + l];
2845           for (m = 0; m < dimR; m++) {
2846             J[l * dimR + m] += modes[k] * D[(k * Nc + l) * dimR + m];
2847           }
2848         }
2849       }
2850       if (0 && PetscDefined(USE_DEBUG)) {
2851         PetscReal maxAbs = 0.;
2852 
2853         for (l = 0; l < Nc; l++) {
2854           maxAbs = PetscMax(maxAbs,PetscAbsReal(resNeg[l]));
2855         }
2856         ierr = PetscInfo4(dm,"cell %D, point %D, iter %D: res %g\n",cell,j,i,(double) maxAbs);CHKERRQ(ierr);
2857       }
2858       ierr = DMPlexCoordinatesToReference_NewtonUpdate(Nc,dimR,J,invJ,work,resNeg,guess);CHKERRQ(ierr);
2859     }
2860   }
2861   ierr = DMRestoreWorkArray(dm,3 * Nc * dimR,MPIU_SCALAR,&J);CHKERRQ(ierr);
2862   ierr = DMRestoreWorkArray(dm,pdim * Nc + pdim * Nc * dimR + Nc,MPIU_REAL,&B);CHKERRQ(ierr);
2863   ierr = DMRestoreWorkArray(dm,pdim,MPIU_REAL,&modes);CHKERRQ(ierr);
2864   ierr = DMPlexVecRestoreClosure(dm, NULL, coords, cell, &coordSize, &nodes);CHKERRQ(ierr);
2865   PetscFunctionReturn(0);
2866 }
2867 
2868 /* TODO: TOBY please fix this for Nc > 1 */
2869 static PetscErrorCode DMPlexReferenceToCoordinates_FE(DM dm, PetscFE fe, PetscInt cell, PetscInt numPoints, const PetscReal refCoords[], PetscReal realCoords[], Vec coords, PetscInt Nc, PetscInt dimR)
2870 {
2871   PetscInt       numComp, pdim, i, j, k, l, coordSize;
2872   PetscScalar    *nodes = NULL;
2873   PetscReal      *invV, *modes;
2874   PetscReal      *B;
2875   PetscErrorCode ierr;
2876 
2877   PetscFunctionBegin;
2878   ierr = PetscFEGetDimension(fe, &pdim);CHKERRQ(ierr);
2879   ierr = PetscFEGetNumComponents(fe, &numComp);CHKERRQ(ierr);
2880   if (numComp != Nc) SETERRQ2(PetscObjectComm((PetscObject)dm),PETSC_ERR_SUP,"coordinate discretization must have as many components (%D) as embedding dimension (!= %D)",numComp,Nc);
2881   ierr = DMPlexVecGetClosure(dm, NULL, coords, cell, &coordSize, &nodes);CHKERRQ(ierr);
2882   /* convert nodes to values in the stable evaluation basis */
2883   ierr = DMGetWorkArray(dm,pdim,MPIU_REAL,&modes);CHKERRQ(ierr);
2884   invV = fe->invV;
2885   for (i = 0; i < pdim; ++i) {
2886     modes[i] = 0.;
2887     for (j = 0; j < pdim; ++j) {
2888       modes[i] += invV[i * pdim + j] * PetscRealPart(nodes[j]);
2889     }
2890   }
2891   ierr = DMGetWorkArray(dm,numPoints * pdim * Nc,MPIU_REAL,&B);CHKERRQ(ierr);
2892   ierr = PetscSpaceEvaluate(fe->basisSpace, numPoints, refCoords, B, NULL, NULL);CHKERRQ(ierr);
2893   for (i = 0; i < numPoints * Nc; i++) {realCoords[i] = 0.;}
2894   for (j = 0; j < numPoints; j++) {
2895     PetscReal *mapped = &realCoords[j * Nc];
2896 
2897     for (k = 0; k < pdim; k++) {
2898       for (l = 0; l < Nc; l++) {
2899         mapped[l] += modes[k] * B[(j * pdim + k) * Nc + l];
2900       }
2901     }
2902   }
2903   ierr = DMRestoreWorkArray(dm,numPoints * pdim * Nc,MPIU_REAL,&B);CHKERRQ(ierr);
2904   ierr = DMRestoreWorkArray(dm,pdim,MPIU_REAL,&modes);CHKERRQ(ierr);
2905   ierr = DMPlexVecRestoreClosure(dm, NULL, coords, cell, &coordSize, &nodes);CHKERRQ(ierr);
2906   PetscFunctionReturn(0);
2907 }
2908 
2909 /*@
2910   DMPlexCoordinatesToReference - Pull coordinates back from the mesh to the reference element using a single element
2911   map.  This inversion will be accurate inside the reference element, but may be inaccurate for mappings that do not
2912   extend uniquely outside the reference cell (e.g, most non-affine maps)
2913 
2914   Not collective
2915 
2916   Input Parameters:
2917 + dm         - The mesh, with coordinate maps defined either by a PetscDS for the coordinate DM (see DMGetCoordinateDM()) or
2918                implicitly by the coordinates of the corner vertices of the cell: as an affine map for simplicial elements, or
2919                as a multilinear map for tensor-product elements
2920 . cell       - the cell whose map is used.
2921 . numPoints  - the number of points to locate
2922 - realCoords - (numPoints x coordinate dimension) array of coordinates (see DMGetCoordinateDim())
2923 
2924   Output Parameters:
2925 . refCoords  - (numPoints x dimension) array of reference coordinates (see DMGetDimension())
2926 
2927   Level: intermediate
2928 
2929 .seealso: DMPlexReferenceToCoordinates()
2930 @*/
2931 PetscErrorCode DMPlexCoordinatesToReference(DM dm, PetscInt cell, PetscInt numPoints, const PetscReal realCoords[], PetscReal refCoords[])
2932 {
2933   PetscInt       dimC, dimR, depth, cStart, cEnd, i;
2934   DM             coordDM = NULL;
2935   Vec            coords;
2936   PetscFE        fe = NULL;
2937   PetscErrorCode ierr;
2938 
2939   PetscFunctionBegin;
2940   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
2941   ierr = DMGetDimension(dm,&dimR);CHKERRQ(ierr);
2942   ierr = DMGetCoordinateDim(dm,&dimC);CHKERRQ(ierr);
2943   if (dimR <= 0 || dimC <= 0 || numPoints <= 0) PetscFunctionReturn(0);
2944   ierr = DMPlexGetDepth(dm,&depth);CHKERRQ(ierr);
2945   ierr = DMGetCoordinatesLocal(dm,&coords);CHKERRQ(ierr);
2946   ierr = DMGetCoordinateDM(dm,&coordDM);CHKERRQ(ierr);
2947   if (coordDM) {
2948     PetscInt coordFields;
2949 
2950     ierr = DMGetNumFields(coordDM,&coordFields);CHKERRQ(ierr);
2951     if (coordFields) {
2952       PetscClassId id;
2953       PetscObject  disc;
2954 
2955       ierr = DMGetField(coordDM,0,NULL,&disc);CHKERRQ(ierr);
2956       ierr = PetscObjectGetClassId(disc,&id);CHKERRQ(ierr);
2957       if (id == PETSCFE_CLASSID) {
2958         fe = (PetscFE) disc;
2959       }
2960     }
2961   }
2962   ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2963   if (cell < cStart || cell >= cEnd) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"point %D not in cell range [%D,%D)",cell,cStart,cEnd);
2964   if (!fe) { /* implicit discretization: affine or multilinear */
2965     PetscInt  coneSize;
2966     PetscBool isSimplex, isTensor;
2967 
2968     ierr = DMPlexGetConeSize(dm,cell,&coneSize);CHKERRQ(ierr);
2969     isSimplex = (coneSize == (dimR + 1)) ? PETSC_TRUE : PETSC_FALSE;
2970     isTensor  = (coneSize == ((depth == 1) ? (1 << dimR) : (2 * dimR))) ? PETSC_TRUE : PETSC_FALSE;
2971     if (isSimplex) {
2972       PetscReal detJ, *v0, *J, *invJ;
2973 
2974       ierr = DMGetWorkArray(dm,dimC + 2 * dimC * dimC, MPIU_REAL, &v0);CHKERRQ(ierr);
2975       J    = &v0[dimC];
2976       invJ = &J[dimC * dimC];
2977       ierr = DMPlexComputeCellGeometryAffineFEM(dm, cell, v0, J, invJ, &detJ);CHKERRQ(ierr);
2978       for (i = 0; i < numPoints; i++) { /* Apply the inverse affine transformation for each point */
2979         const PetscReal x0[3] = {-1.,-1.,-1.};
2980 
2981         CoordinatesRealToRef(dimC, dimR, x0, v0, invJ, &realCoords[dimC * i], &refCoords[dimR * i]);
2982       }
2983       ierr = DMRestoreWorkArray(dm,dimC + 2 * dimC * dimC, MPIU_REAL, &v0);CHKERRQ(ierr);
2984     } else if (isTensor) {
2985       ierr = DMPlexCoordinatesToReference_Tensor(coordDM, cell, numPoints, realCoords, refCoords, coords, dimC, dimR);CHKERRQ(ierr);
2986     } else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unrecognized cone size %D",coneSize);
2987   } else {
2988     ierr = DMPlexCoordinatesToReference_FE(coordDM, fe, cell, numPoints, realCoords, refCoords, coords, dimC, dimR);CHKERRQ(ierr);
2989   }
2990   PetscFunctionReturn(0);
2991 }
2992 
2993 /*@
2994   DMPlexReferenceToCoordinates - Map references coordinates to coordinates in the the mesh for a single element map.
2995 
2996   Not collective
2997 
2998   Input Parameters:
2999 + dm         - The mesh, with coordinate maps defined either by a PetscDS for the coordinate DM (see DMGetCoordinateDM()) or
3000                implicitly by the coordinates of the corner vertices of the cell: as an affine map for simplicial elements, or
3001                as a multilinear map for tensor-product elements
3002 . cell       - the cell whose map is used.
3003 . numPoints  - the number of points to locate
3004 - refCoords  - (numPoints x dimension) array of reference coordinates (see DMGetDimension())
3005 
3006   Output Parameters:
3007 . realCoords - (numPoints x coordinate dimension) array of coordinates (see DMGetCoordinateDim())
3008 
3009    Level: intermediate
3010 
3011 .seealso: DMPlexCoordinatesToReference()
3012 @*/
3013 PetscErrorCode DMPlexReferenceToCoordinates(DM dm, PetscInt cell, PetscInt numPoints, const PetscReal refCoords[], PetscReal realCoords[])
3014 {
3015   PetscInt       dimC, dimR, depth, cStart, cEnd, i;
3016   DM             coordDM = NULL;
3017   Vec            coords;
3018   PetscFE        fe = NULL;
3019   PetscErrorCode ierr;
3020 
3021   PetscFunctionBegin;
3022   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
3023   ierr = DMGetDimension(dm,&dimR);CHKERRQ(ierr);
3024   ierr = DMGetCoordinateDim(dm,&dimC);CHKERRQ(ierr);
3025   if (dimR <= 0 || dimC <= 0 || numPoints <= 0) PetscFunctionReturn(0);
3026   ierr = DMPlexGetDepth(dm,&depth);CHKERRQ(ierr);
3027   ierr = DMGetCoordinatesLocal(dm,&coords);CHKERRQ(ierr);
3028   ierr = DMGetCoordinateDM(dm,&coordDM);CHKERRQ(ierr);
3029   if (coordDM) {
3030     PetscInt coordFields;
3031 
3032     ierr = DMGetNumFields(coordDM,&coordFields);CHKERRQ(ierr);
3033     if (coordFields) {
3034       PetscClassId id;
3035       PetscObject  disc;
3036 
3037       ierr = DMGetField(coordDM,0,NULL,&disc);CHKERRQ(ierr);
3038       ierr = PetscObjectGetClassId(disc,&id);CHKERRQ(ierr);
3039       if (id == PETSCFE_CLASSID) {
3040         fe = (PetscFE) disc;
3041       }
3042     }
3043   }
3044   ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
3045   if (cell < cStart || cell >= cEnd) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"point %D not in cell range [%D,%D)",cell,cStart,cEnd);
3046   if (!fe) { /* implicit discretization: affine or multilinear */
3047     PetscInt  coneSize;
3048     PetscBool isSimplex, isTensor;
3049 
3050     ierr = DMPlexGetConeSize(dm,cell,&coneSize);CHKERRQ(ierr);
3051     isSimplex = (coneSize == (dimR + 1)) ? PETSC_TRUE : PETSC_FALSE;
3052     isTensor  = (coneSize == ((depth == 1) ? (1 << dimR) : (2 * dimR))) ? PETSC_TRUE : PETSC_FALSE;
3053     if (isSimplex) {
3054       PetscReal detJ, *v0, *J;
3055 
3056       ierr = DMGetWorkArray(dm,dimC + 2 * dimC * dimC, MPIU_REAL, &v0);CHKERRQ(ierr);
3057       J    = &v0[dimC];
3058       ierr = DMPlexComputeCellGeometryAffineFEM(dm, cell, v0, J, NULL, &detJ);CHKERRQ(ierr);
3059       for (i = 0; i < numPoints; i++) { /* Apply the affine transformation for each point */
3060         const PetscReal xi0[3] = {-1.,-1.,-1.};
3061 
3062         CoordinatesRefToReal(dimC, dimR, xi0, v0, J, &refCoords[dimR * i], &realCoords[dimC * i]);
3063       }
3064       ierr = DMRestoreWorkArray(dm,dimC + 2 * dimC * dimC, MPIU_REAL, &v0);CHKERRQ(ierr);
3065     } else if (isTensor) {
3066       ierr = DMPlexReferenceToCoordinates_Tensor(coordDM, cell, numPoints, refCoords, realCoords, coords, dimC, dimR);CHKERRQ(ierr);
3067     } else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unrecognized cone size %D",coneSize);
3068   } else {
3069     ierr = DMPlexReferenceToCoordinates_FE(coordDM, fe, cell, numPoints, refCoords, realCoords, coords, dimC, dimR);CHKERRQ(ierr);
3070   }
3071   PetscFunctionReturn(0);
3072 }
3073 
3074 /*@C
3075   DMPlexRemapGeometry - This function maps the original DM coordinates to new coordinates.
3076 
3077   Not collective
3078 
3079   Input Parameters:
3080 + dm      - The DM
3081 . time    - The time
3082 - func    - The function transforming current coordinates to new coordaintes
3083 
3084    Calling sequence of func:
3085 $    func(PetscInt dim, PetscInt Nf, PetscInt NfAux,
3086 $         const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
3087 $         const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
3088 $         PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f[]);
3089 
3090 +  dim          - The spatial dimension
3091 .  Nf           - The number of input fields (here 1)
3092 .  NfAux        - The number of input auxiliary fields
3093 .  uOff         - The offset of the coordinates in u[] (here 0)
3094 .  uOff_x       - The offset of the coordinates in u_x[] (here 0)
3095 .  u            - The coordinate values at this point in space
3096 .  u_t          - The coordinate time derivative at this point in space (here NULL)
3097 .  u_x          - The coordinate derivatives at this point in space
3098 .  aOff         - The offset of each auxiliary field in u[]
3099 .  aOff_x       - The offset of each auxiliary field in u_x[]
3100 .  a            - The auxiliary field values at this point in space
3101 .  a_t          - The auxiliary field time derivative at this point in space (or NULL)
3102 .  a_x          - The auxiliary field derivatives at this point in space
3103 .  t            - The current time
3104 .  x            - The coordinates of this point (here not used)
3105 .  numConstants - The number of constants
3106 .  constants    - The value of each constant
3107 -  f            - The new coordinates at this point in space
3108 
3109   Level: intermediate
3110 
3111 .seealso: DMGetCoordinates(), DMGetCoordinatesLocal(), DMGetCoordinateDM(), DMProjectFieldLocal(), DMProjectFieldLabelLocal()
3112 @*/
3113 PetscErrorCode DMPlexRemapGeometry(DM dm, PetscReal time,
3114                                    void (*func)(PetscInt, PetscInt, PetscInt,
3115                                                 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
3116                                                 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
3117                                                 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]))
3118 {
3119   DM             cdm;
3120   DMField        cf;
3121   Vec            lCoords, tmpCoords;
3122   PetscErrorCode ierr;
3123 
3124   PetscFunctionBegin;
3125   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
3126   ierr = DMGetCoordinatesLocal(dm, &lCoords);CHKERRQ(ierr);
3127   ierr = DMGetLocalVector(cdm, &tmpCoords);CHKERRQ(ierr);
3128   ierr = VecCopy(lCoords, tmpCoords);CHKERRQ(ierr);
3129   /* We have to do the coordinate field manually right now since the coordinate DM will not have its own */
3130   ierr = DMGetCoordinateField(dm, &cf);CHKERRQ(ierr);
3131   cdm->coordinateField = cf;
3132   ierr = DMProjectFieldLocal(cdm, time, tmpCoords, &func, INSERT_VALUES, lCoords);CHKERRQ(ierr);
3133   cdm->coordinateField = NULL;
3134   ierr = DMRestoreLocalVector(cdm, &tmpCoords);CHKERRQ(ierr);
3135   ierr = DMSetCoordinatesLocal(dm, lCoords);CHKERRQ(ierr);
3136   PetscFunctionReturn(0);
3137 }
3138 
3139 /* Shear applies the transformation, assuming we fix z,
3140   / 1  0  m_0 \
3141   | 0  1  m_1 |
3142   \ 0  0   1  /
3143 */
3144 static void f0_shear(PetscInt dim, PetscInt Nf, PetscInt NfAux,
3145                      const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
3146                      const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
3147                      PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar coords[])
3148 {
3149   const PetscInt Nc = uOff[1]-uOff[0];
3150   const PetscInt ax = (PetscInt) PetscRealPart(constants[0]);
3151   PetscInt       c;
3152 
3153   for (c = 0; c < Nc; ++c) {
3154     coords[c] = u[c] + constants[c+1]*u[ax];
3155   }
3156 }
3157 
3158 /*@C
3159   DMPlexShearGeometry - This shears the domain, meaning adds a multiple of the shear coordinate to all other coordinates.
3160 
3161   Not collective
3162 
3163   Input Parameters:
3164 + dm          - The DM
3165 . direction   - The shear coordinate direction, e.g. 0 is the x-axis
3166 - multipliers - The multiplier m for each direction which is not the shear direction
3167 
3168   Level: intermediate
3169 
3170 .seealso: DMPlexRemapGeometry()
3171 @*/
3172 PetscErrorCode DMPlexShearGeometry(DM dm, DMDirection direction, PetscReal multipliers[])
3173 {
3174   DM             cdm;
3175   PetscDS        cds;
3176   PetscObject    obj;
3177   PetscClassId   id;
3178   PetscScalar   *moduli;
3179   const PetscInt dir = (PetscInt) direction;
3180   PetscInt       dE, d, e;
3181   PetscErrorCode ierr;
3182 
3183   PetscFunctionBegin;
3184   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
3185   ierr = DMGetCoordinateDim(dm, &dE);CHKERRQ(ierr);
3186   ierr = PetscMalloc1(dE+1, &moduli);CHKERRQ(ierr);
3187   moduli[0] = dir;
3188   for (d = 0, e = 0; d < dE; ++d) moduli[d+1] = d == dir ? 0.0 : (multipliers ? multipliers[e++] : 1.0);
3189   ierr = DMGetDS(cdm, &cds);CHKERRQ(ierr);
3190   ierr = PetscDSGetDiscretization(cds, 0, &obj);CHKERRQ(ierr);
3191   ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3192   if (id != PETSCFE_CLASSID) {
3193     Vec           lCoords;
3194     PetscSection  cSection;
3195     PetscScalar  *coords;
3196     PetscInt      vStart, vEnd, v;
3197 
3198     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3199     ierr = DMGetCoordinateSection(dm, &cSection);CHKERRQ(ierr);
3200     ierr = DMGetCoordinatesLocal(dm, &lCoords);CHKERRQ(ierr);
3201     ierr = VecGetArray(lCoords, &coords);CHKERRQ(ierr);
3202     for (v = vStart; v < vEnd; ++v) {
3203       PetscReal ds;
3204       PetscInt  off, c;
3205 
3206       ierr = PetscSectionGetOffset(cSection, v, &off);CHKERRQ(ierr);
3207       ds   = PetscRealPart(coords[off+dir]);
3208       for (c = 0; c < dE; ++c) coords[off+c] += moduli[c]*ds;
3209     }
3210     ierr = VecRestoreArray(lCoords, &coords);CHKERRQ(ierr);
3211   } else {
3212     ierr = PetscDSSetConstants(cds, dE+1, moduli);CHKERRQ(ierr);
3213     ierr = DMPlexRemapGeometry(dm, 0.0, f0_shear);CHKERRQ(ierr);
3214   }
3215   ierr = PetscFree(moduli);CHKERRQ(ierr);
3216   PetscFunctionReturn(0);
3217 }
3218