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