xref: /petsc/src/dm/impls/plex/plexgeometry.c (revision ef0bb6c736604ce380bf8bea4ebd4a7bda431d97)
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   PetscTabulation T;
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 = PetscFEGetCellTabulation(fe, &T);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 = PetscFECreateTabulation(fe, 1, Nq, quadPoints, J ? 1 : 0, &T);CHKERRQ(ierr);
1720   }
1721   if (qdim != dim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Point dimension %d != quadrature dimension %d", dim, qdim);
1722   {
1723     const PetscReal *basis    = T->T[0];
1724     const PetscReal *basisDer = T->T[1];
1725     PetscReal        detJt;
1726 
1727     if (v) {
1728       ierr = PetscArrayzero(v, Nq*cdim);CHKERRQ(ierr);
1729       for (q = 0; q < Nq; ++q) {
1730         PetscInt i, k;
1731 
1732         for (k = 0; k < pdim; ++k)
1733           for (i = 0; i < cdim; ++i)
1734             v[q*cdim + i] += basis[q*pdim + k] * PetscRealPart(coords[k*cdim + i]);
1735         ierr = PetscLogFlops(2.0*pdim*cdim);CHKERRQ(ierr);
1736       }
1737     }
1738     if (J) {
1739       ierr = PetscArrayzero(J, Nq*cdim*cdim);CHKERRQ(ierr);
1740       for (q = 0; q < Nq; ++q) {
1741         PetscInt i, j, k, c, r;
1742 
1743         /* J = dx_i/d\xi_j = sum[k=0,n-1] dN_k/d\xi_j * x_i(k) */
1744         for (k = 0; k < pdim; ++k)
1745           for (j = 0; j < dim; ++j)
1746             for (i = 0; i < cdim; ++i)
1747               J[(q*cdim + i)*cdim + j] += basisDer[(q*pdim + k)*dim + j] * PetscRealPart(coords[k*cdim + i]);
1748         ierr = PetscLogFlops(2.0*pdim*dim*cdim);CHKERRQ(ierr);
1749         if (cdim > dim) {
1750           for (c = dim; c < cdim; ++c)
1751             for (r = 0; r < cdim; ++r)
1752               J[r*cdim+c] = r == c ? 1.0 : 0.0;
1753         }
1754         if (!detJ && !invJ) continue;
1755         detJt = 0.;
1756         switch (cdim) {
1757         case 3:
1758           DMPlex_Det3D_Internal(&detJt, &J[q*cdim*dim]);
1759           if (invJ) {DMPlex_Invert3D_Internal(&invJ[q*cdim*dim], &J[q*cdim*dim], detJt);}
1760           break;
1761         case 2:
1762           DMPlex_Det2D_Internal(&detJt, &J[q*cdim*dim]);
1763           if (invJ) {DMPlex_Invert2D_Internal(&invJ[q*cdim*dim], &J[q*cdim*dim], detJt);}
1764           break;
1765         case 1:
1766           detJt = J[q*cdim*dim];
1767           if (invJ) invJ[q*cdim*dim] = 1.0/detJt;
1768         }
1769         if (detJ) detJ[q] = detJt;
1770       }
1771     } else if (detJ || invJ) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Need J to compute invJ or detJ");
1772   }
1773   if (feQuad != quad) {ierr = PetscTabulationDestroy(&T);CHKERRQ(ierr);}
1774   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, point, &numCoords, &coords);CHKERRQ(ierr);
1775   PetscFunctionReturn(0);
1776 }
1777 
1778 /*@C
1779   DMPlexComputeCellGeometryFEM - Compute the Jacobian, inverse Jacobian, and Jacobian determinant at each quadrature point in the given cell
1780 
1781   Collective on dm
1782 
1783   Input Arguments:
1784 + dm   - the DM
1785 . cell - the cell
1786 - quad - the quadrature containing the points in the reference element where the geometry will be evaluated.  If quad == NULL, geometry will be
1787          evaluated at the first vertex of the reference element
1788 
1789   Output Arguments:
1790 + v    - the image of the transformed quadrature points, otherwise the image of the first vertex in the closure of the reference element
1791 . J    - the Jacobian of the transform from the reference element at each quadrature point
1792 . invJ - the inverse of the Jacobian at each quadrature point
1793 - detJ - the Jacobian determinant at each quadrature point
1794 
1795   Level: advanced
1796 
1797   Fortran Notes:
1798   Since it returns arrays, this routine is only available in Fortran 90, and you must
1799   include petsc.h90 in your code.
1800 
1801 .seealso: DMGetCoordinateSection(), DMGetCoordinates()
1802 @*/
1803 PetscErrorCode DMPlexComputeCellGeometryFEM(DM dm, PetscInt cell, PetscQuadrature quad, PetscReal *v, PetscReal *J, PetscReal *invJ, PetscReal *detJ)
1804 {
1805   DM             cdm;
1806   PetscFE        fe = NULL;
1807   PetscErrorCode ierr;
1808 
1809   PetscFunctionBegin;
1810   PetscValidPointer(detJ, 7);
1811   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
1812   if (cdm) {
1813     PetscClassId id;
1814     PetscInt     numFields;
1815     PetscDS      prob;
1816     PetscObject  disc;
1817 
1818     ierr = DMGetNumFields(cdm, &numFields);CHKERRQ(ierr);
1819     if (numFields) {
1820       ierr = DMGetDS(cdm, &prob);CHKERRQ(ierr);
1821       ierr = PetscDSGetDiscretization(prob,0,&disc);CHKERRQ(ierr);
1822       ierr = PetscObjectGetClassId(disc,&id);CHKERRQ(ierr);
1823       if (id == PETSCFE_CLASSID) {
1824         fe = (PetscFE) disc;
1825       }
1826     }
1827   }
1828   if (!fe) {ierr = DMPlexComputeCellGeometryFEM_Implicit(dm, cell, quad, v, J, invJ, detJ);CHKERRQ(ierr);}
1829   else     {ierr = DMPlexComputeCellGeometryFEM_FE(dm, fe, cell, quad, v, J, invJ, detJ);CHKERRQ(ierr);}
1830   PetscFunctionReturn(0);
1831 }
1832 
1833 static PetscErrorCode DMPlexComputeGeometryFVM_1D_Internal(DM dm, PetscInt dim, PetscInt cell, PetscReal *vol, PetscReal centroid[], PetscReal normal[])
1834 {
1835   PetscSection   coordSection;
1836   Vec            coordinates;
1837   PetscScalar   *coords = NULL;
1838   PetscScalar    tmp[2];
1839   PetscInt       coordSize, d;
1840   PetscErrorCode ierr;
1841 
1842   PetscFunctionBegin;
1843   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1844   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1845   ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, cell, &coordSize, &coords);CHKERRQ(ierr);
1846   ierr = DMLocalizeCoordinate_Internal(dm, dim, coords, &coords[dim], tmp);CHKERRQ(ierr);
1847   if (centroid) {
1848     for (d = 0; d < dim; ++d) centroid[d] = 0.5*PetscRealPart(coords[d] + tmp[d]);
1849   }
1850   if (normal) {
1851     PetscReal norm;
1852 
1853     if (dim != 2) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "We only support 2D edges right now");
1854     normal[0]  = -PetscRealPart(coords[1] - tmp[1]);
1855     normal[1]  =  PetscRealPart(coords[0] - tmp[0]);
1856     norm       = DMPlex_NormD_Internal(dim, normal);
1857     for (d = 0; d < dim; ++d) normal[d] /= norm;
1858   }
1859   if (vol) {
1860     *vol = 0.0;
1861     for (d = 0; d < dim; ++d) *vol += PetscSqr(PetscRealPart(coords[d] - tmp[d]));
1862     *vol = PetscSqrtReal(*vol);
1863   }
1864   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, cell, &coordSize, &coords);CHKERRQ(ierr);
1865   PetscFunctionReturn(0);
1866 }
1867 
1868 /* Centroid_i = (\sum_n A_n Cn_i ) / A */
1869 static PetscErrorCode DMPlexComputeGeometryFVM_2D_Internal(DM dm, PetscInt dim, PetscInt cell, PetscReal *vol, PetscReal centroid[], PetscReal normal[])
1870 {
1871   DMLabel        depth;
1872   PetscSection   coordSection;
1873   Vec            coordinates;
1874   PetscScalar   *coords = NULL;
1875   PetscReal      vsum = 0.0, csum[3] = {0.0, 0.0, 0.0}, vtmp, ctmp[4], v0[3], R[9];
1876   PetscBool      isHybrid = PETSC_FALSE;
1877   PetscInt       fv[4] = {0, 1, 2, 3};
1878   PetscInt       pEndInterior[4], cdepth, tdim = 2, coordSize, numCorners, p, d, e;
1879   PetscErrorCode ierr;
1880 
1881   PetscFunctionBegin;
1882   /* Must check for hybrid cells because prisms have a different orientation scheme */
1883   ierr = DMPlexGetDepthLabel(dm, &depth);CHKERRQ(ierr);
1884   ierr = DMLabelGetValue(depth, cell, &cdepth);CHKERRQ(ierr);
1885   ierr = DMPlexGetHybridBounds(dm, &pEndInterior[3], &pEndInterior[2], &pEndInterior[1], &pEndInterior[0]);CHKERRQ(ierr);
1886   if ((pEndInterior[cdepth]) >=0 && (cell >= pEndInterior[cdepth])) isHybrid = PETSC_TRUE;
1887   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1888   ierr = DMPlexGetConeSize(dm, cell, &numCorners);CHKERRQ(ierr);
1889   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1890   ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, cell, &coordSize, &coords);CHKERRQ(ierr);
1891   ierr = DMGetCoordinateDim(dm, &dim);CHKERRQ(ierr);
1892   /* Side faces for hybrid cells are are stored as tensor products */
1893   if (isHybrid && numCorners == 4) {fv[2] = 3; fv[3] = 2;}
1894 
1895   if (dim > 2 && centroid) {
1896     v0[0] = PetscRealPart(coords[0]);
1897     v0[1] = PetscRealPart(coords[1]);
1898     v0[2] = PetscRealPart(coords[2]);
1899   }
1900   if (normal) {
1901     if (dim > 2) {
1902       const PetscReal x0 = PetscRealPart(coords[dim*fv[1]+0] - coords[0]), x1 = PetscRealPart(coords[dim*fv[2]+0] - coords[0]);
1903       const PetscReal y0 = PetscRealPart(coords[dim*fv[1]+1] - coords[1]), y1 = PetscRealPart(coords[dim*fv[2]+1] - coords[1]);
1904       const PetscReal z0 = PetscRealPart(coords[dim*fv[1]+2] - coords[2]), z1 = PetscRealPart(coords[dim*fv[2]+2] - coords[2]);
1905       PetscReal       norm;
1906 
1907       normal[0] = y0*z1 - z0*y1;
1908       normal[1] = z0*x1 - x0*z1;
1909       normal[2] = x0*y1 - y0*x1;
1910       norm = PetscSqrtReal(normal[0]*normal[0] + normal[1]*normal[1] + normal[2]*normal[2]);
1911       normal[0] /= norm;
1912       normal[1] /= norm;
1913       normal[2] /= norm;
1914     } else {
1915       for (d = 0; d < dim; ++d) normal[d] = 0.0;
1916     }
1917   }
1918   if (dim == 3) {ierr = DMPlexComputeProjection3Dto2D(coordSize, coords, R);CHKERRQ(ierr);}
1919   for (p = 0; p < numCorners; ++p) {
1920     const PetscInt pi  = p < 4 ? fv[p] : p;
1921     const PetscInt pin = p < 3 ? fv[(p+1)%numCorners] : (p+1)%numCorners;
1922     /* Need to do this copy to get types right */
1923     for (d = 0; d < tdim; ++d) {
1924       ctmp[d]      = PetscRealPart(coords[pi*tdim+d]);
1925       ctmp[tdim+d] = PetscRealPart(coords[pin*tdim+d]);
1926     }
1927     Volume_Triangle_Origin_Internal(&vtmp, ctmp);
1928     vsum += vtmp;
1929     for (d = 0; d < tdim; ++d) {
1930       csum[d] += (ctmp[d] + ctmp[tdim+d])*vtmp;
1931     }
1932   }
1933   for (d = 0; d < tdim; ++d) {
1934     csum[d] /= (tdim+1)*vsum;
1935   }
1936   ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, cell, &coordSize, &coords);CHKERRQ(ierr);
1937   if (vol) *vol = PetscAbsReal(vsum);
1938   if (centroid) {
1939     if (dim > 2) {
1940       for (d = 0; d < dim; ++d) {
1941         centroid[d] = v0[d];
1942         for (e = 0; e < dim; ++e) {
1943           centroid[d] += R[d*dim+e]*csum[e];
1944         }
1945       }
1946     } else for (d = 0; d < dim; ++d) centroid[d] = csum[d];
1947   }
1948   PetscFunctionReturn(0);
1949 }
1950 
1951 /* Centroid_i = (\sum_n V_n Cn_i ) / V */
1952 static PetscErrorCode DMPlexComputeGeometryFVM_3D_Internal(DM dm, PetscInt dim, PetscInt cell, PetscReal *vol, PetscReal centroid[], PetscReal normal[])
1953 {
1954   DMLabel         depth;
1955   PetscSection    coordSection;
1956   Vec             coordinates;
1957   PetscScalar    *coords = NULL;
1958   PetscReal       vsum = 0.0, vtmp, coordsTmp[3*3];
1959   const PetscInt *faces, *facesO;
1960   PetscBool       isHybrid = PETSC_FALSE;
1961   PetscInt        pEndInterior[4], cdepth, numFaces, f, coordSize, numCorners, p, d;
1962   PetscErrorCode  ierr;
1963 
1964   PetscFunctionBegin;
1965   if (PetscUnlikely(dim > 3)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"No support for dim %D > 3",dim);
1966   /* Must check for hybrid cells because prisms have a different orientation scheme */
1967   ierr = DMPlexGetDepthLabel(dm, &depth);CHKERRQ(ierr);
1968   ierr = DMLabelGetValue(depth, cell, &cdepth);CHKERRQ(ierr);
1969   ierr = DMPlexGetHybridBounds(dm, &pEndInterior[3], &pEndInterior[2], &pEndInterior[1], &pEndInterior[0]);CHKERRQ(ierr);
1970   if ((pEndInterior[cdepth]) >=0 && (cell >= pEndInterior[cdepth])) isHybrid = PETSC_TRUE;
1971 
1972   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
1973   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
1974 
1975   if (centroid) for (d = 0; d < dim; ++d) centroid[d] = 0.0;
1976   ierr = DMPlexGetConeSize(dm, cell, &numFaces);CHKERRQ(ierr);
1977   ierr = DMPlexGetCone(dm, cell, &faces);CHKERRQ(ierr);
1978   ierr = DMPlexGetConeOrientation(dm, cell, &facesO);CHKERRQ(ierr);
1979   for (f = 0; f < numFaces; ++f) {
1980     PetscBool flip = isHybrid && f == 0 ? PETSC_TRUE : PETSC_FALSE; /* The first hybrid face is reversed */
1981 
1982     ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, faces[f], &coordSize, &coords);CHKERRQ(ierr);
1983     numCorners = coordSize/dim;
1984     switch (numCorners) {
1985     case 3:
1986       for (d = 0; d < dim; ++d) {
1987         coordsTmp[0*dim+d] = PetscRealPart(coords[0*dim+d]);
1988         coordsTmp[1*dim+d] = PetscRealPart(coords[1*dim+d]);
1989         coordsTmp[2*dim+d] = PetscRealPart(coords[2*dim+d]);
1990       }
1991       Volume_Tetrahedron_Origin_Internal(&vtmp, coordsTmp);
1992       if (facesO[f] < 0 || flip) vtmp = -vtmp;
1993       vsum += vtmp;
1994       if (centroid) {           /* Centroid of OABC = (a+b+c)/4 */
1995         for (d = 0; d < dim; ++d) {
1996           for (p = 0; p < 3; ++p) centroid[d] += coordsTmp[p*dim+d]*vtmp;
1997         }
1998       }
1999       break;
2000     case 4:
2001     {
2002       PetscInt fv[4] = {0, 1, 2, 3};
2003 
2004       /* Side faces for hybrid cells are are stored as tensor products */
2005       if (isHybrid && f > 1) {fv[2] = 3; fv[3] = 2;}
2006       /* DO FOR PYRAMID */
2007       /* First tet */
2008       for (d = 0; d < dim; ++d) {
2009         coordsTmp[0*dim+d] = PetscRealPart(coords[fv[0]*dim+d]);
2010         coordsTmp[1*dim+d] = PetscRealPart(coords[fv[1]*dim+d]);
2011         coordsTmp[2*dim+d] = PetscRealPart(coords[fv[3]*dim+d]);
2012       }
2013       Volume_Tetrahedron_Origin_Internal(&vtmp, coordsTmp);
2014       if (facesO[f] < 0 || flip) vtmp = -vtmp;
2015       vsum += vtmp;
2016       if (centroid) {
2017         for (d = 0; d < dim; ++d) {
2018           for (p = 0; p < 3; ++p) centroid[d] += coordsTmp[p*dim+d]*vtmp;
2019         }
2020       }
2021       /* Second tet */
2022       for (d = 0; d < dim; ++d) {
2023         coordsTmp[0*dim+d] = PetscRealPart(coords[fv[1]*dim+d]);
2024         coordsTmp[1*dim+d] = PetscRealPart(coords[fv[2]*dim+d]);
2025         coordsTmp[2*dim+d] = PetscRealPart(coords[fv[3]*dim+d]);
2026       }
2027       Volume_Tetrahedron_Origin_Internal(&vtmp, coordsTmp);
2028       if (facesO[f] < 0 || flip) vtmp = -vtmp;
2029       vsum += vtmp;
2030       if (centroid) {
2031         for (d = 0; d < dim; ++d) {
2032           for (p = 0; p < 3; ++p) centroid[d] += coordsTmp[p*dim+d]*vtmp;
2033         }
2034       }
2035       break;
2036     }
2037     default:
2038       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle faces with %D vertices", numCorners);
2039     }
2040     ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, faces[f], &coordSize, &coords);CHKERRQ(ierr);
2041   }
2042   if (vol)     *vol = PetscAbsReal(vsum);
2043   if (normal)   for (d = 0; d < dim; ++d) normal[d]    = 0.0;
2044   if (centroid) for (d = 0; d < dim; ++d) centroid[d] /= (vsum*4);
2045   PetscFunctionReturn(0);
2046 }
2047 
2048 /*@C
2049   DMPlexComputeCellGeometryFVM - Compute the volume for a given cell
2050 
2051   Collective on dm
2052 
2053   Input Arguments:
2054 + dm   - the DM
2055 - cell - the cell
2056 
2057   Output Arguments:
2058 + volume   - the cell volume
2059 . centroid - the cell centroid
2060 - normal - the cell normal, if appropriate
2061 
2062   Level: advanced
2063 
2064   Fortran Notes:
2065   Since it returns arrays, this routine is only available in Fortran 90, and you must
2066   include petsc.h90 in your code.
2067 
2068 .seealso: DMGetCoordinateSection(), DMGetCoordinates()
2069 @*/
2070 PetscErrorCode DMPlexComputeCellGeometryFVM(DM dm, PetscInt cell, PetscReal *vol, PetscReal centroid[], PetscReal normal[])
2071 {
2072   PetscInt       depth, dim;
2073   PetscErrorCode ierr;
2074 
2075   PetscFunctionBegin;
2076   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2077   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2078   if (depth != dim) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Mesh must be interpolated");
2079   /* We need to keep a pointer to the depth label */
2080   ierr = DMGetLabelValue(dm, "depth", cell, &depth);CHKERRQ(ierr);
2081   /* Cone size is now the number of faces */
2082   switch (depth) {
2083   case 1:
2084     ierr = DMPlexComputeGeometryFVM_1D_Internal(dm, dim, cell, vol, centroid, normal);CHKERRQ(ierr);
2085     break;
2086   case 2:
2087     ierr = DMPlexComputeGeometryFVM_2D_Internal(dm, dim, cell, vol, centroid, normal);CHKERRQ(ierr);
2088     break;
2089   case 3:
2090     ierr = DMPlexComputeGeometryFVM_3D_Internal(dm, dim, cell, vol, centroid, normal);CHKERRQ(ierr);
2091     break;
2092   default:
2093     SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unsupported dimension %D (depth %D) for element geometry computation", dim, depth);
2094   }
2095   PetscFunctionReturn(0);
2096 }
2097 
2098 /*@
2099   DMPlexComputeGeometryFEM - Precompute cell geometry for the entire mesh
2100 
2101   Collective on dm
2102 
2103   Input Parameter:
2104 . dm - The DMPlex
2105 
2106   Output Parameter:
2107 . cellgeom - A vector with the cell geometry data for each cell
2108 
2109   Level: beginner
2110 
2111 @*/
2112 PetscErrorCode DMPlexComputeGeometryFEM(DM dm, Vec *cellgeom)
2113 {
2114   DM             dmCell;
2115   Vec            coordinates;
2116   PetscSection   coordSection, sectionCell;
2117   PetscScalar   *cgeom;
2118   PetscInt       cStart, cEnd, cMax, c;
2119   PetscErrorCode ierr;
2120 
2121   PetscFunctionBegin;
2122   ierr = DMClone(dm, &dmCell);CHKERRQ(ierr);
2123   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
2124   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
2125   ierr = DMSetCoordinateSection(dmCell, PETSC_DETERMINE, coordSection);CHKERRQ(ierr);
2126   ierr = DMSetCoordinatesLocal(dmCell, coordinates);CHKERRQ(ierr);
2127   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &sectionCell);CHKERRQ(ierr);
2128   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2129   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
2130   cEnd = cMax < 0 ? cEnd : cMax;
2131   ierr = PetscSectionSetChart(sectionCell, cStart, cEnd);CHKERRQ(ierr);
2132   /* TODO This needs to be multiplied by Nq for non-affine */
2133   for (c = cStart; c < cEnd; ++c) {ierr = PetscSectionSetDof(sectionCell, c, (PetscInt) PetscCeilReal(((PetscReal) sizeof(PetscFEGeom))/sizeof(PetscScalar)));CHKERRQ(ierr);}
2134   ierr = PetscSectionSetUp(sectionCell);CHKERRQ(ierr);
2135   ierr = DMSetLocalSection(dmCell, sectionCell);CHKERRQ(ierr);
2136   ierr = PetscSectionDestroy(&sectionCell);CHKERRQ(ierr);
2137   ierr = DMCreateLocalVector(dmCell, cellgeom);CHKERRQ(ierr);
2138   ierr = VecGetArray(*cellgeom, &cgeom);CHKERRQ(ierr);
2139   for (c = cStart; c < cEnd; ++c) {
2140     PetscFEGeom *cg;
2141 
2142     ierr = DMPlexPointLocalRef(dmCell, c, cgeom, &cg);CHKERRQ(ierr);
2143     ierr = PetscArrayzero(cg, 1);CHKERRQ(ierr);
2144     ierr = DMPlexComputeCellGeometryFEM(dmCell, c, NULL, cg->v, cg->J, cg->invJ, cg->detJ);CHKERRQ(ierr);
2145     if (*cg->detJ <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D", (double) *cg->detJ, c);
2146   }
2147   PetscFunctionReturn(0);
2148 }
2149 
2150 /*@
2151   DMPlexComputeGeometryFVM - Computes the cell and face geometry for a finite volume method
2152 
2153   Input Parameter:
2154 . dm - The DM
2155 
2156   Output Parameters:
2157 + cellgeom - A Vec of PetscFVCellGeom data
2158 - facegeom - A Vec of PetscFVFaceGeom data
2159 
2160   Level: developer
2161 
2162 .seealso: PetscFVFaceGeom, PetscFVCellGeom, DMPlexComputeGeometryFEM()
2163 @*/
2164 PetscErrorCode DMPlexComputeGeometryFVM(DM dm, Vec *cellgeom, Vec *facegeom)
2165 {
2166   DM             dmFace, dmCell;
2167   DMLabel        ghostLabel;
2168   PetscSection   sectionFace, sectionCell;
2169   PetscSection   coordSection;
2170   Vec            coordinates;
2171   PetscScalar   *fgeom, *cgeom;
2172   PetscReal      minradius, gminradius;
2173   PetscInt       dim, cStart, cEnd, cEndInterior, c, fStart, fEnd, f;
2174   PetscErrorCode ierr;
2175 
2176   PetscFunctionBegin;
2177   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2178   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
2179   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
2180   /* Make cell centroids and volumes */
2181   ierr = DMClone(dm, &dmCell);CHKERRQ(ierr);
2182   ierr = DMSetCoordinateSection(dmCell, PETSC_DETERMINE, coordSection);CHKERRQ(ierr);
2183   ierr = DMSetCoordinatesLocal(dmCell, coordinates);CHKERRQ(ierr);
2184   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &sectionCell);CHKERRQ(ierr);
2185   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2186   ierr = DMPlexGetGhostCellStratum(dm, &cEndInterior, NULL);CHKERRQ(ierr);
2187   ierr = PetscSectionSetChart(sectionCell, cStart, cEnd);CHKERRQ(ierr);
2188   for (c = cStart; c < cEnd; ++c) {ierr = PetscSectionSetDof(sectionCell, c, (PetscInt) PetscCeilReal(((PetscReal) sizeof(PetscFVCellGeom))/sizeof(PetscScalar)));CHKERRQ(ierr);}
2189   ierr = PetscSectionSetUp(sectionCell);CHKERRQ(ierr);
2190   ierr = DMSetLocalSection(dmCell, sectionCell);CHKERRQ(ierr);
2191   ierr = PetscSectionDestroy(&sectionCell);CHKERRQ(ierr);
2192   ierr = DMCreateLocalVector(dmCell, cellgeom);CHKERRQ(ierr);
2193   if (cEndInterior < 0) cEndInterior = cEnd;
2194   ierr = VecGetArray(*cellgeom, &cgeom);CHKERRQ(ierr);
2195   for (c = cStart; c < cEndInterior; ++c) {
2196     PetscFVCellGeom *cg;
2197 
2198     ierr = DMPlexPointLocalRef(dmCell, c, cgeom, &cg);CHKERRQ(ierr);
2199     ierr = PetscArrayzero(cg, 1);CHKERRQ(ierr);
2200     ierr = DMPlexComputeCellGeometryFVM(dmCell, c, &cg->volume, cg->centroid, NULL);CHKERRQ(ierr);
2201   }
2202   /* Compute face normals and minimum cell radius */
2203   ierr = DMClone(dm, &dmFace);CHKERRQ(ierr);
2204   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &sectionFace);CHKERRQ(ierr);
2205   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
2206   ierr = PetscSectionSetChart(sectionFace, fStart, fEnd);CHKERRQ(ierr);
2207   for (f = fStart; f < fEnd; ++f) {ierr = PetscSectionSetDof(sectionFace, f, (PetscInt) PetscCeilReal(((PetscReal) sizeof(PetscFVFaceGeom))/sizeof(PetscScalar)));CHKERRQ(ierr);}
2208   ierr = PetscSectionSetUp(sectionFace);CHKERRQ(ierr);
2209   ierr = DMSetLocalSection(dmFace, sectionFace);CHKERRQ(ierr);
2210   ierr = PetscSectionDestroy(&sectionFace);CHKERRQ(ierr);
2211   ierr = DMCreateLocalVector(dmFace, facegeom);CHKERRQ(ierr);
2212   ierr = VecGetArray(*facegeom, &fgeom);CHKERRQ(ierr);
2213   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
2214   minradius = PETSC_MAX_REAL;
2215   for (f = fStart; f < fEnd; ++f) {
2216     PetscFVFaceGeom *fg;
2217     PetscReal        area;
2218     PetscInt         ghost = -1, d, numChildren;
2219 
2220     if (ghostLabel) {ierr = DMLabelGetValue(ghostLabel, f, &ghost);CHKERRQ(ierr);}
2221     ierr = DMPlexGetTreeChildren(dm,f,&numChildren,NULL);CHKERRQ(ierr);
2222     if (ghost >= 0 || numChildren) continue;
2223     ierr = DMPlexPointLocalRef(dmFace, f, fgeom, &fg);CHKERRQ(ierr);
2224     ierr = DMPlexComputeCellGeometryFVM(dm, f, &area, fg->centroid, fg->normal);CHKERRQ(ierr);
2225     for (d = 0; d < dim; ++d) fg->normal[d] *= area;
2226     /* Flip face orientation if necessary to match ordering in support, and Update minimum radius */
2227     {
2228       PetscFVCellGeom *cL, *cR;
2229       PetscInt         ncells;
2230       const PetscInt  *cells;
2231       PetscReal       *lcentroid, *rcentroid;
2232       PetscReal        l[3], r[3], v[3];
2233 
2234       ierr = DMPlexGetSupport(dm, f, &cells);CHKERRQ(ierr);
2235       ierr = DMPlexGetSupportSize(dm, f, &ncells);CHKERRQ(ierr);
2236       ierr = DMPlexPointLocalRead(dmCell, cells[0], cgeom, &cL);CHKERRQ(ierr);
2237       lcentroid = cells[0] >= cEndInterior ? fg->centroid : cL->centroid;
2238       if (ncells > 1) {
2239         ierr = DMPlexPointLocalRead(dmCell, cells[1], cgeom, &cR);CHKERRQ(ierr);
2240         rcentroid = cells[1] >= cEndInterior ? fg->centroid : cR->centroid;
2241       }
2242       else {
2243         rcentroid = fg->centroid;
2244       }
2245       ierr = DMLocalizeCoordinateReal_Internal(dm, dim, fg->centroid, lcentroid, l);CHKERRQ(ierr);
2246       ierr = DMLocalizeCoordinateReal_Internal(dm, dim, fg->centroid, rcentroid, r);CHKERRQ(ierr);
2247       DMPlex_WaxpyD_Internal(dim, -1, l, r, v);
2248       if (DMPlex_DotRealD_Internal(dim, fg->normal, v) < 0) {
2249         for (d = 0; d < dim; ++d) fg->normal[d] = -fg->normal[d];
2250       }
2251       if (DMPlex_DotRealD_Internal(dim, fg->normal, v) <= 0) {
2252         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]);
2253         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]);
2254         SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Direction for face %d could not be fixed", f);
2255       }
2256       if (cells[0] < cEndInterior) {
2257         DMPlex_WaxpyD_Internal(dim, -1, fg->centroid, cL->centroid, v);
2258         minradius = PetscMin(minradius, DMPlex_NormD_Internal(dim, v));
2259       }
2260       if (ncells > 1 && cells[1] < cEndInterior) {
2261         DMPlex_WaxpyD_Internal(dim, -1, fg->centroid, cR->centroid, v);
2262         minradius = PetscMin(minradius, DMPlex_NormD_Internal(dim, v));
2263       }
2264     }
2265   }
2266   ierr = MPIU_Allreduce(&minradius, &gminradius, 1, MPIU_REAL, MPIU_MIN, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
2267   ierr = DMPlexSetMinRadius(dm, gminradius);CHKERRQ(ierr);
2268   /* Compute centroids of ghost cells */
2269   for (c = cEndInterior; c < cEnd; ++c) {
2270     PetscFVFaceGeom *fg;
2271     const PetscInt  *cone,    *support;
2272     PetscInt         coneSize, supportSize, s;
2273 
2274     ierr = DMPlexGetConeSize(dmCell, c, &coneSize);CHKERRQ(ierr);
2275     if (coneSize != 1) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Ghost cell %d has cone size %d != 1", c, coneSize);
2276     ierr = DMPlexGetCone(dmCell, c, &cone);CHKERRQ(ierr);
2277     ierr = DMPlexGetSupportSize(dmCell, cone[0], &supportSize);CHKERRQ(ierr);
2278     if (supportSize != 2) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %d has support size %d != 2", cone[0], supportSize);
2279     ierr = DMPlexGetSupport(dmCell, cone[0], &support);CHKERRQ(ierr);
2280     ierr = DMPlexPointLocalRef(dmFace, cone[0], fgeom, &fg);CHKERRQ(ierr);
2281     for (s = 0; s < 2; ++s) {
2282       /* Reflect ghost centroid across plane of face */
2283       if (support[s] == c) {
2284         PetscFVCellGeom       *ci;
2285         PetscFVCellGeom       *cg;
2286         PetscReal              c2f[3], a;
2287 
2288         ierr = DMPlexPointLocalRead(dmCell, support[(s+1)%2], cgeom, &ci);CHKERRQ(ierr);
2289         DMPlex_WaxpyD_Internal(dim, -1, ci->centroid, fg->centroid, c2f); /* cell to face centroid */
2290         a    = DMPlex_DotRealD_Internal(dim, c2f, fg->normal)/DMPlex_DotRealD_Internal(dim, fg->normal, fg->normal);
2291         ierr = DMPlexPointLocalRef(dmCell, support[s], cgeom, &cg);CHKERRQ(ierr);
2292         DMPlex_WaxpyD_Internal(dim, 2*a, fg->normal, ci->centroid, cg->centroid);
2293         cg->volume = ci->volume;
2294       }
2295     }
2296   }
2297   ierr = VecRestoreArray(*facegeom, &fgeom);CHKERRQ(ierr);
2298   ierr = VecRestoreArray(*cellgeom, &cgeom);CHKERRQ(ierr);
2299   ierr = DMDestroy(&dmCell);CHKERRQ(ierr);
2300   ierr = DMDestroy(&dmFace);CHKERRQ(ierr);
2301   PetscFunctionReturn(0);
2302 }
2303 
2304 /*@C
2305   DMPlexGetMinRadius - Returns the minimum distance from any cell centroid to a face
2306 
2307   Not collective
2308 
2309   Input Argument:
2310 . dm - the DM
2311 
2312   Output Argument:
2313 . minradius - the minium cell radius
2314 
2315   Level: developer
2316 
2317 .seealso: DMGetCoordinates()
2318 @*/
2319 PetscErrorCode DMPlexGetMinRadius(DM dm, PetscReal *minradius)
2320 {
2321   PetscFunctionBegin;
2322   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
2323   PetscValidPointer(minradius,2);
2324   *minradius = ((DM_Plex*) dm->data)->minradius;
2325   PetscFunctionReturn(0);
2326 }
2327 
2328 /*@C
2329   DMPlexSetMinRadius - Sets the minimum distance from the cell centroid to a face
2330 
2331   Logically collective
2332 
2333   Input Arguments:
2334 + dm - the DM
2335 - minradius - the minium cell radius
2336 
2337   Level: developer
2338 
2339 .seealso: DMSetCoordinates()
2340 @*/
2341 PetscErrorCode DMPlexSetMinRadius(DM dm, PetscReal minradius)
2342 {
2343   PetscFunctionBegin;
2344   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
2345   ((DM_Plex*) dm->data)->minradius = minradius;
2346   PetscFunctionReturn(0);
2347 }
2348 
2349 static PetscErrorCode BuildGradientReconstruction_Internal(DM dm, PetscFV fvm, DM dmFace, PetscScalar *fgeom, DM dmCell, PetscScalar *cgeom)
2350 {
2351   DMLabel        ghostLabel;
2352   PetscScalar   *dx, *grad, **gref;
2353   PetscInt       dim, cStart, cEnd, c, cEndInterior, maxNumFaces;
2354   PetscErrorCode ierr;
2355 
2356   PetscFunctionBegin;
2357   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2358   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2359   ierr = DMPlexGetGhostCellStratum(dm, &cEndInterior, NULL);CHKERRQ(ierr);
2360   ierr = DMPlexGetMaxSizes(dm, &maxNumFaces, NULL);CHKERRQ(ierr);
2361   ierr = PetscFVLeastSquaresSetMaxFaces(fvm, maxNumFaces);CHKERRQ(ierr);
2362   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
2363   ierr = PetscMalloc3(maxNumFaces*dim, &dx, maxNumFaces*dim, &grad, maxNumFaces, &gref);CHKERRQ(ierr);
2364   for (c = cStart; c < cEndInterior; c++) {
2365     const PetscInt        *faces;
2366     PetscInt               numFaces, usedFaces, f, d;
2367     PetscFVCellGeom        *cg;
2368     PetscBool              boundary;
2369     PetscInt               ghost;
2370 
2371     ierr = DMPlexPointLocalRead(dmCell, c, cgeom, &cg);CHKERRQ(ierr);
2372     ierr = DMPlexGetConeSize(dm, c, &numFaces);CHKERRQ(ierr);
2373     ierr = DMPlexGetCone(dm, c, &faces);CHKERRQ(ierr);
2374     if (numFaces < dim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Cell %D has only %D faces, not enough for gradient reconstruction", c, numFaces);
2375     for (f = 0, usedFaces = 0; f < numFaces; ++f) {
2376       PetscFVCellGeom       *cg1;
2377       PetscFVFaceGeom       *fg;
2378       const PetscInt        *fcells;
2379       PetscInt               ncell, side;
2380 
2381       ierr = DMLabelGetValue(ghostLabel, faces[f], &ghost);CHKERRQ(ierr);
2382       ierr = DMIsBoundaryPoint(dm, faces[f], &boundary);CHKERRQ(ierr);
2383       if ((ghost >= 0) || boundary) continue;
2384       ierr  = DMPlexGetSupport(dm, faces[f], &fcells);CHKERRQ(ierr);
2385       side  = (c != fcells[0]); /* c is on left=0 or right=1 of face */
2386       ncell = fcells[!side];    /* the neighbor */
2387       ierr  = DMPlexPointLocalRef(dmFace, faces[f], fgeom, &fg);CHKERRQ(ierr);
2388       ierr  = DMPlexPointLocalRead(dmCell, ncell, cgeom, &cg1);CHKERRQ(ierr);
2389       for (d = 0; d < dim; ++d) dx[usedFaces*dim+d] = cg1->centroid[d] - cg->centroid[d];
2390       gref[usedFaces++] = fg->grad[side];  /* Gradient reconstruction term will go here */
2391     }
2392     if (!usedFaces) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_USER, "Mesh contains isolated cell (no neighbors). Is it intentional?");
2393     ierr = PetscFVComputeGradient(fvm, usedFaces, dx, grad);CHKERRQ(ierr);
2394     for (f = 0, usedFaces = 0; f < numFaces; ++f) {
2395       ierr = DMLabelGetValue(ghostLabel, faces[f], &ghost);CHKERRQ(ierr);
2396       ierr = DMIsBoundaryPoint(dm, faces[f], &boundary);CHKERRQ(ierr);
2397       if ((ghost >= 0) || boundary) continue;
2398       for (d = 0; d < dim; ++d) gref[usedFaces][d] = grad[usedFaces*dim+d];
2399       ++usedFaces;
2400     }
2401   }
2402   ierr = PetscFree3(dx, grad, gref);CHKERRQ(ierr);
2403   PetscFunctionReturn(0);
2404 }
2405 
2406 static PetscErrorCode BuildGradientReconstruction_Internal_Tree(DM dm, PetscFV fvm, DM dmFace, PetscScalar *fgeom, DM dmCell, PetscScalar *cgeom)
2407 {
2408   DMLabel        ghostLabel;
2409   PetscScalar   *dx, *grad, **gref;
2410   PetscInt       dim, cStart, cEnd, c, cEndInterior, fStart, fEnd, f, nStart, nEnd, maxNumFaces = 0;
2411   PetscSection   neighSec;
2412   PetscInt     (*neighbors)[2];
2413   PetscInt      *counter;
2414   PetscErrorCode ierr;
2415 
2416   PetscFunctionBegin;
2417   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2418   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2419   ierr = DMPlexGetGhostCellStratum(dm, &cEndInterior, NULL);CHKERRQ(ierr);
2420   if (cEndInterior < 0) cEndInterior = cEnd;
2421   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm),&neighSec);CHKERRQ(ierr);
2422   ierr = PetscSectionSetChart(neighSec,cStart,cEndInterior);CHKERRQ(ierr);
2423   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
2424   ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
2425   for (f = fStart; f < fEnd; f++) {
2426     const PetscInt        *fcells;
2427     PetscBool              boundary;
2428     PetscInt               ghost = -1;
2429     PetscInt               numChildren, numCells, c;
2430 
2431     if (ghostLabel) {ierr = DMLabelGetValue(ghostLabel, f, &ghost);CHKERRQ(ierr);}
2432     ierr = DMIsBoundaryPoint(dm, f, &boundary);CHKERRQ(ierr);
2433     ierr = DMPlexGetTreeChildren(dm, f, &numChildren, NULL);CHKERRQ(ierr);
2434     if ((ghost >= 0) || boundary || numChildren) continue;
2435     ierr = DMPlexGetSupportSize(dm, f, &numCells);CHKERRQ(ierr);
2436     if (numCells == 2) {
2437       ierr = DMPlexGetSupport(dm, f, &fcells);CHKERRQ(ierr);
2438       for (c = 0; c < 2; c++) {
2439         PetscInt cell = fcells[c];
2440 
2441         if (cell >= cStart && cell < cEndInterior) {
2442           ierr = PetscSectionAddDof(neighSec,cell,1);CHKERRQ(ierr);
2443         }
2444       }
2445     }
2446   }
2447   ierr = PetscSectionSetUp(neighSec);CHKERRQ(ierr);
2448   ierr = PetscSectionGetMaxDof(neighSec,&maxNumFaces);CHKERRQ(ierr);
2449   ierr = PetscFVLeastSquaresSetMaxFaces(fvm, maxNumFaces);CHKERRQ(ierr);
2450   nStart = 0;
2451   ierr = PetscSectionGetStorageSize(neighSec,&nEnd);CHKERRQ(ierr);
2452   ierr = PetscMalloc1((nEnd-nStart),&neighbors);CHKERRQ(ierr);
2453   ierr = PetscCalloc1((cEndInterior-cStart),&counter);CHKERRQ(ierr);
2454   for (f = fStart; f < fEnd; f++) {
2455     const PetscInt        *fcells;
2456     PetscBool              boundary;
2457     PetscInt               ghost = -1;
2458     PetscInt               numChildren, numCells, c;
2459 
2460     if (ghostLabel) {ierr = DMLabelGetValue(ghostLabel, f, &ghost);CHKERRQ(ierr);}
2461     ierr = DMIsBoundaryPoint(dm, f, &boundary);CHKERRQ(ierr);
2462     ierr = DMPlexGetTreeChildren(dm, f, &numChildren, NULL);CHKERRQ(ierr);
2463     if ((ghost >= 0) || boundary || numChildren) continue;
2464     ierr = DMPlexGetSupportSize(dm, f, &numCells);CHKERRQ(ierr);
2465     if (numCells == 2) {
2466       ierr  = DMPlexGetSupport(dm, f, &fcells);CHKERRQ(ierr);
2467       for (c = 0; c < 2; c++) {
2468         PetscInt cell = fcells[c], off;
2469 
2470         if (cell >= cStart && cell < cEndInterior) {
2471           ierr = PetscSectionGetOffset(neighSec,cell,&off);CHKERRQ(ierr);
2472           off += counter[cell - cStart]++;
2473           neighbors[off][0] = f;
2474           neighbors[off][1] = fcells[1 - c];
2475         }
2476       }
2477     }
2478   }
2479   ierr = PetscFree(counter);CHKERRQ(ierr);
2480   ierr = PetscMalloc3(maxNumFaces*dim, &dx, maxNumFaces*dim, &grad, maxNumFaces, &gref);CHKERRQ(ierr);
2481   for (c = cStart; c < cEndInterior; c++) {
2482     PetscInt               numFaces, f, d, off, ghost = -1;
2483     PetscFVCellGeom        *cg;
2484 
2485     ierr = DMPlexPointLocalRead(dmCell, c, cgeom, &cg);CHKERRQ(ierr);
2486     ierr = PetscSectionGetDof(neighSec, c, &numFaces);CHKERRQ(ierr);
2487     ierr = PetscSectionGetOffset(neighSec, c, &off);CHKERRQ(ierr);
2488     if (ghostLabel) {ierr = DMLabelGetValue(ghostLabel, c, &ghost);CHKERRQ(ierr);}
2489     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);
2490     for (f = 0; f < numFaces; ++f) {
2491       PetscFVCellGeom       *cg1;
2492       PetscFVFaceGeom       *fg;
2493       const PetscInt        *fcells;
2494       PetscInt               ncell, side, nface;
2495 
2496       nface = neighbors[off + f][0];
2497       ncell = neighbors[off + f][1];
2498       ierr  = DMPlexGetSupport(dm,nface,&fcells);CHKERRQ(ierr);
2499       side  = (c != fcells[0]);
2500       ierr  = DMPlexPointLocalRef(dmFace, nface, fgeom, &fg);CHKERRQ(ierr);
2501       ierr  = DMPlexPointLocalRead(dmCell, ncell, cgeom, &cg1);CHKERRQ(ierr);
2502       for (d = 0; d < dim; ++d) dx[f*dim+d] = cg1->centroid[d] - cg->centroid[d];
2503       gref[f] = fg->grad[side];  /* Gradient reconstruction term will go here */
2504     }
2505     ierr = PetscFVComputeGradient(fvm, numFaces, dx, grad);CHKERRQ(ierr);
2506     for (f = 0; f < numFaces; ++f) {
2507       for (d = 0; d < dim; ++d) gref[f][d] = grad[f*dim+d];
2508     }
2509   }
2510   ierr = PetscFree3(dx, grad, gref);CHKERRQ(ierr);
2511   ierr = PetscSectionDestroy(&neighSec);CHKERRQ(ierr);
2512   ierr = PetscFree(neighbors);CHKERRQ(ierr);
2513   PetscFunctionReturn(0);
2514 }
2515 
2516 /*@
2517   DMPlexComputeGradientFVM - Compute geometric factors for gradient reconstruction, which are stored in the geometry data, and compute layout for gradient data
2518 
2519   Collective on dm
2520 
2521   Input Arguments:
2522 + dm  - The DM
2523 . fvm - The PetscFV
2524 . faceGeometry - The face geometry from DMPlexComputeFaceGeometryFVM()
2525 - cellGeometry - The face geometry from DMPlexComputeCellGeometryFVM()
2526 
2527   Output Parameters:
2528 + faceGeometry - The geometric factors for gradient calculation are inserted
2529 - dmGrad - The DM describing the layout of gradient data
2530 
2531   Level: developer
2532 
2533 .seealso: DMPlexGetFaceGeometryFVM(), DMPlexGetCellGeometryFVM()
2534 @*/
2535 PetscErrorCode DMPlexComputeGradientFVM(DM dm, PetscFV fvm, Vec faceGeometry, Vec cellGeometry, DM *dmGrad)
2536 {
2537   DM             dmFace, dmCell;
2538   PetscScalar   *fgeom, *cgeom;
2539   PetscSection   sectionGrad, parentSection;
2540   PetscInt       dim, pdim, cStart, cEnd, cEndInterior, c;
2541   PetscErrorCode ierr;
2542 
2543   PetscFunctionBegin;
2544   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2545   ierr = PetscFVGetNumComponents(fvm, &pdim);CHKERRQ(ierr);
2546   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
2547   ierr = DMPlexGetGhostCellStratum(dm, &cEndInterior, NULL);CHKERRQ(ierr);
2548   /* Construct the interpolant corresponding to each face from the least-square solution over the cell neighborhood */
2549   ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
2550   ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
2551   ierr = VecGetArray(faceGeometry, &fgeom);CHKERRQ(ierr);
2552   ierr = VecGetArray(cellGeometry, &cgeom);CHKERRQ(ierr);
2553   ierr = DMPlexGetTree(dm,&parentSection,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
2554   if (!parentSection) {
2555     ierr = BuildGradientReconstruction_Internal(dm, fvm, dmFace, fgeom, dmCell, cgeom);CHKERRQ(ierr);
2556   } else {
2557     ierr = BuildGradientReconstruction_Internal_Tree(dm, fvm, dmFace, fgeom, dmCell, cgeom);CHKERRQ(ierr);
2558   }
2559   ierr = VecRestoreArray(faceGeometry, &fgeom);CHKERRQ(ierr);
2560   ierr = VecRestoreArray(cellGeometry, &cgeom);CHKERRQ(ierr);
2561   /* Create storage for gradients */
2562   ierr = DMClone(dm, dmGrad);CHKERRQ(ierr);
2563   ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &sectionGrad);CHKERRQ(ierr);
2564   ierr = PetscSectionSetChart(sectionGrad, cStart, cEnd);CHKERRQ(ierr);
2565   for (c = cStart; c < cEnd; ++c) {ierr = PetscSectionSetDof(sectionGrad, c, pdim*dim);CHKERRQ(ierr);}
2566   ierr = PetscSectionSetUp(sectionGrad);CHKERRQ(ierr);
2567   ierr = DMSetLocalSection(*dmGrad, sectionGrad);CHKERRQ(ierr);
2568   ierr = PetscSectionDestroy(&sectionGrad);CHKERRQ(ierr);
2569   PetscFunctionReturn(0);
2570 }
2571 
2572 /*@
2573   DMPlexGetDataFVM - Retrieve precomputed cell geometry
2574 
2575   Collective on dm
2576 
2577   Input Arguments:
2578 + dm  - The DM
2579 - fvm - The PetscFV
2580 
2581   Output Parameters:
2582 + cellGeometry - The cell geometry
2583 . faceGeometry - The face geometry
2584 - dmGrad       - The gradient matrices
2585 
2586   Level: developer
2587 
2588 .seealso: DMPlexComputeGeometryFVM()
2589 @*/
2590 PetscErrorCode DMPlexGetDataFVM(DM dm, PetscFV fv, Vec *cellgeom, Vec *facegeom, DM *gradDM)
2591 {
2592   PetscObject    cellgeomobj, facegeomobj;
2593   PetscErrorCode ierr;
2594 
2595   PetscFunctionBegin;
2596   ierr = PetscObjectQuery((PetscObject) dm, "DMPlex_cellgeom_fvm", &cellgeomobj);CHKERRQ(ierr);
2597   if (!cellgeomobj) {
2598     Vec cellgeomInt, facegeomInt;
2599 
2600     ierr = DMPlexComputeGeometryFVM(dm, &cellgeomInt, &facegeomInt);CHKERRQ(ierr);
2601     ierr = PetscObjectCompose((PetscObject) dm, "DMPlex_cellgeom_fvm",(PetscObject)cellgeomInt);CHKERRQ(ierr);
2602     ierr = PetscObjectCompose((PetscObject) dm, "DMPlex_facegeom_fvm",(PetscObject)facegeomInt);CHKERRQ(ierr);
2603     ierr = VecDestroy(&cellgeomInt);CHKERRQ(ierr);
2604     ierr = VecDestroy(&facegeomInt);CHKERRQ(ierr);
2605     ierr = PetscObjectQuery((PetscObject) dm, "DMPlex_cellgeom_fvm", &cellgeomobj);CHKERRQ(ierr);
2606   }
2607   ierr = PetscObjectQuery((PetscObject) dm, "DMPlex_facegeom_fvm", &facegeomobj);CHKERRQ(ierr);
2608   if (cellgeom) *cellgeom = (Vec) cellgeomobj;
2609   if (facegeom) *facegeom = (Vec) facegeomobj;
2610   if (gradDM) {
2611     PetscObject gradobj;
2612     PetscBool   computeGradients;
2613 
2614     ierr = PetscFVGetComputeGradients(fv,&computeGradients);CHKERRQ(ierr);
2615     if (!computeGradients) {
2616       *gradDM = NULL;
2617       PetscFunctionReturn(0);
2618     }
2619     ierr = PetscObjectQuery((PetscObject) dm, "DMPlex_dmgrad_fvm", &gradobj);CHKERRQ(ierr);
2620     if (!gradobj) {
2621       DM dmGradInt;
2622 
2623       ierr = DMPlexComputeGradientFVM(dm,fv,(Vec) facegeomobj,(Vec) cellgeomobj,&dmGradInt);CHKERRQ(ierr);
2624       ierr = PetscObjectCompose((PetscObject) dm, "DMPlex_dmgrad_fvm", (PetscObject)dmGradInt);CHKERRQ(ierr);
2625       ierr = DMDestroy(&dmGradInt);CHKERRQ(ierr);
2626       ierr = PetscObjectQuery((PetscObject) dm, "DMPlex_dmgrad_fvm", &gradobj);CHKERRQ(ierr);
2627     }
2628     *gradDM = (DM) gradobj;
2629   }
2630   PetscFunctionReturn(0);
2631 }
2632 
2633 static PetscErrorCode DMPlexCoordinatesToReference_NewtonUpdate(PetscInt dimC, PetscInt dimR, PetscScalar *J, PetscScalar *invJ, PetscScalar *work,  PetscReal *resNeg, PetscReal *guess)
2634 {
2635   PetscInt l, m;
2636 
2637   PetscFunctionBeginHot;
2638   if (dimC == dimR && dimR <= 3) {
2639     /* invert Jacobian, multiply */
2640     PetscScalar det, idet;
2641 
2642     switch (dimR) {
2643     case 1:
2644       invJ[0] = 1./ J[0];
2645       break;
2646     case 2:
2647       det = J[0] * J[3] - J[1] * J[2];
2648       idet = 1./det;
2649       invJ[0] =  J[3] * idet;
2650       invJ[1] = -J[1] * idet;
2651       invJ[2] = -J[2] * idet;
2652       invJ[3] =  J[0] * idet;
2653       break;
2654     case 3:
2655       {
2656         invJ[0] = J[4] * J[8] - J[5] * J[7];
2657         invJ[1] = J[2] * J[7] - J[1] * J[8];
2658         invJ[2] = J[1] * J[5] - J[2] * J[4];
2659         det = invJ[0] * J[0] + invJ[1] * J[3] + invJ[2] * J[6];
2660         idet = 1./det;
2661         invJ[0] *= idet;
2662         invJ[1] *= idet;
2663         invJ[2] *= idet;
2664         invJ[3]  = idet * (J[5] * J[6] - J[3] * J[8]);
2665         invJ[4]  = idet * (J[0] * J[8] - J[2] * J[6]);
2666         invJ[5]  = idet * (J[2] * J[3] - J[0] * J[5]);
2667         invJ[6]  = idet * (J[3] * J[7] - J[4] * J[6]);
2668         invJ[7]  = idet * (J[1] * J[6] - J[0] * J[7]);
2669         invJ[8]  = idet * (J[0] * J[4] - J[1] * J[3]);
2670       }
2671       break;
2672     }
2673     for (l = 0; l < dimR; l++) {
2674       for (m = 0; m < dimC; m++) {
2675         guess[l] += PetscRealPart(invJ[l * dimC + m]) * resNeg[m];
2676       }
2677     }
2678   } else {
2679 #if defined(PETSC_USE_COMPLEX)
2680     char transpose = 'C';
2681 #else
2682     char transpose = 'T';
2683 #endif
2684     PetscBLASInt m = dimR;
2685     PetscBLASInt n = dimC;
2686     PetscBLASInt one = 1;
2687     PetscBLASInt worksize = dimR * dimC, info;
2688 
2689     for (l = 0; l < dimC; l++) {invJ[l] = resNeg[l];}
2690 
2691     PetscStackCallBLAS("LAPACKgels",LAPACKgels_(&transpose,&m,&n,&one,J,&m,invJ,&n,work,&worksize, &info));
2692     if (info != 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad argument to GELS");
2693 
2694     for (l = 0; l < dimR; l++) {guess[l] += PetscRealPart(invJ[l]);}
2695   }
2696   PetscFunctionReturn(0);
2697 }
2698 
2699 static PetscErrorCode DMPlexCoordinatesToReference_Tensor(DM dm, PetscInt cell, PetscInt numPoints, const PetscReal realCoords[], PetscReal refCoords[], Vec coords, PetscInt dimC, PetscInt dimR)
2700 {
2701   PetscInt       coordSize, i, j, k, l, m, maxIts = 7, numV = (1 << dimR);
2702   PetscScalar    *coordsScalar = NULL;
2703   PetscReal      *cellData, *cellCoords, *cellCoeffs, *extJ, *resNeg;
2704   PetscScalar    *J, *invJ, *work;
2705   PetscErrorCode ierr;
2706 
2707   PetscFunctionBegin;
2708   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
2709   ierr = DMPlexVecGetClosure(dm, NULL, coords, cell, &coordSize, &coordsScalar);CHKERRQ(ierr);
2710   if (coordSize < dimC * numV) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expecting at least %D coordinates, got %D",dimC * (1 << dimR), coordSize);
2711   ierr = DMGetWorkArray(dm, 2 * coordSize + dimR + dimC, MPIU_REAL, &cellData);CHKERRQ(ierr);
2712   ierr = DMGetWorkArray(dm, 3 * dimR * dimC, MPIU_SCALAR, &J);CHKERRQ(ierr);
2713   cellCoords = &cellData[0];
2714   cellCoeffs = &cellData[coordSize];
2715   extJ       = &cellData[2 * coordSize];
2716   resNeg     = &cellData[2 * coordSize + dimR];
2717   invJ       = &J[dimR * dimC];
2718   work       = &J[2 * dimR * dimC];
2719   if (dimR == 2) {
2720     const PetscInt zToPlex[4] = {0, 1, 3, 2};
2721 
2722     for (i = 0; i < 4; i++) {
2723       PetscInt plexI = zToPlex[i];
2724 
2725       for (j = 0; j < dimC; j++) {
2726         cellCoords[dimC * i + j] = PetscRealPart(coordsScalar[dimC * plexI + j]);
2727       }
2728     }
2729   } else if (dimR == 3) {
2730     const PetscInt zToPlex[8] = {0, 3, 1, 2, 4, 5, 7, 6};
2731 
2732     for (i = 0; i < 8; i++) {
2733       PetscInt plexI = zToPlex[i];
2734 
2735       for (j = 0; j < dimC; j++) {
2736         cellCoords[dimC * i + j] = PetscRealPart(coordsScalar[dimC * plexI + j]);
2737       }
2738     }
2739   } else {
2740     for (i = 0; i < coordSize; i++) {cellCoords[i] = PetscRealPart(coordsScalar[i]);}
2741   }
2742   /* Perform the shuffling transform that converts values at the corners of [-1,1]^d to coefficients */
2743   for (i = 0; i < dimR; i++) {
2744     PetscReal *swap;
2745 
2746     for (j = 0; j < (numV / 2); j++) {
2747       for (k = 0; k < dimC; k++) {
2748         cellCoeffs[dimC * j + k]                = 0.5 * (cellCoords[dimC * (2 * j + 1) + k] + cellCoords[dimC * 2 * j + k]);
2749         cellCoeffs[dimC * (j + (numV / 2)) + k] = 0.5 * (cellCoords[dimC * (2 * j + 1) + k] - cellCoords[dimC * 2 * j + k]);
2750       }
2751     }
2752 
2753     if (i < dimR - 1) {
2754       swap = cellCoeffs;
2755       cellCoeffs = cellCoords;
2756       cellCoords = swap;
2757     }
2758   }
2759   ierr = PetscArrayzero(refCoords,numPoints * dimR);CHKERRQ(ierr);
2760   for (j = 0; j < numPoints; j++) {
2761     for (i = 0; i < maxIts; i++) {
2762       PetscReal *guess = &refCoords[dimR * j];
2763 
2764       /* compute -residual and Jacobian */
2765       for (k = 0; k < dimC; k++) {resNeg[k] = realCoords[dimC * j + k];}
2766       for (k = 0; k < dimC * dimR; k++) {J[k] = 0.;}
2767       for (k = 0; k < numV; k++) {
2768         PetscReal extCoord = 1.;
2769         for (l = 0; l < dimR; l++) {
2770           PetscReal coord = guess[l];
2771           PetscInt  dep   = (k & (1 << l)) >> l;
2772 
2773           extCoord *= dep * coord + !dep;
2774           extJ[l] = dep;
2775 
2776           for (m = 0; m < dimR; m++) {
2777             PetscReal coord = guess[m];
2778             PetscInt  dep   = ((k & (1 << m)) >> m) && (m != l);
2779             PetscReal mult  = dep * coord + !dep;
2780 
2781             extJ[l] *= mult;
2782           }
2783         }
2784         for (l = 0; l < dimC; l++) {
2785           PetscReal coeff = cellCoeffs[dimC * k + l];
2786 
2787           resNeg[l] -= coeff * extCoord;
2788           for (m = 0; m < dimR; m++) {
2789             J[dimR * l + m] += coeff * extJ[m];
2790           }
2791         }
2792       }
2793 #if 0 && defined(PETSC_USE_DEBUG)
2794       {
2795         PetscReal maxAbs = 0.;
2796 
2797         for (l = 0; l < dimC; l++) {
2798           maxAbs = PetscMax(maxAbs,PetscAbsReal(resNeg[l]));
2799         }
2800         ierr = PetscInfo4(dm,"cell %D, point %D, iter %D: res %g\n",cell,j,i,(double) maxAbs);CHKERRQ(ierr);
2801       }
2802 #endif
2803 
2804       ierr = DMPlexCoordinatesToReference_NewtonUpdate(dimC,dimR,J,invJ,work,resNeg,guess);CHKERRQ(ierr);
2805     }
2806   }
2807   ierr = DMRestoreWorkArray(dm, 3 * dimR * dimC, MPIU_SCALAR, &J);CHKERRQ(ierr);
2808   ierr = DMRestoreWorkArray(dm, 2 * coordSize + dimR + dimC, MPIU_REAL, &cellData);CHKERRQ(ierr);
2809   ierr = DMPlexVecRestoreClosure(dm, NULL, coords, cell, &coordSize, &coordsScalar);CHKERRQ(ierr);
2810   PetscFunctionReturn(0);
2811 }
2812 
2813 static PetscErrorCode DMPlexReferenceToCoordinates_Tensor(DM dm, PetscInt cell, PetscInt numPoints, const PetscReal refCoords[], PetscReal realCoords[], Vec coords, PetscInt dimC, PetscInt dimR)
2814 {
2815   PetscInt       coordSize, i, j, k, l, numV = (1 << dimR);
2816   PetscScalar    *coordsScalar = NULL;
2817   PetscReal      *cellData, *cellCoords, *cellCoeffs;
2818   PetscErrorCode ierr;
2819 
2820   PetscFunctionBegin;
2821   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
2822   ierr = DMPlexVecGetClosure(dm, NULL, coords, cell, &coordSize, &coordsScalar);CHKERRQ(ierr);
2823   if (coordSize < dimC * numV) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expecting at least %D coordinates, got %D",dimC * (1 << dimR), coordSize);
2824   ierr = DMGetWorkArray(dm, 2 * coordSize, MPIU_REAL, &cellData);CHKERRQ(ierr);
2825   cellCoords = &cellData[0];
2826   cellCoeffs = &cellData[coordSize];
2827   if (dimR == 2) {
2828     const PetscInt zToPlex[4] = {0, 1, 3, 2};
2829 
2830     for (i = 0; i < 4; i++) {
2831       PetscInt plexI = zToPlex[i];
2832 
2833       for (j = 0; j < dimC; j++) {
2834         cellCoords[dimC * i + j] = PetscRealPart(coordsScalar[dimC * plexI + j]);
2835       }
2836     }
2837   } else if (dimR == 3) {
2838     const PetscInt zToPlex[8] = {0, 3, 1, 2, 4, 5, 7, 6};
2839 
2840     for (i = 0; i < 8; i++) {
2841       PetscInt plexI = zToPlex[i];
2842 
2843       for (j = 0; j < dimC; j++) {
2844         cellCoords[dimC * i + j] = PetscRealPart(coordsScalar[dimC * plexI + j]);
2845       }
2846     }
2847   } else {
2848     for (i = 0; i < coordSize; i++) {cellCoords[i] = PetscRealPart(coordsScalar[i]);}
2849   }
2850   /* Perform the shuffling transform that converts values at the corners of [-1,1]^d to coefficients */
2851   for (i = 0; i < dimR; i++) {
2852     PetscReal *swap;
2853 
2854     for (j = 0; j < (numV / 2); j++) {
2855       for (k = 0; k < dimC; k++) {
2856         cellCoeffs[dimC * j + k]                = 0.5 * (cellCoords[dimC * (2 * j + 1) + k] + cellCoords[dimC * 2 * j + k]);
2857         cellCoeffs[dimC * (j + (numV / 2)) + k] = 0.5 * (cellCoords[dimC * (2 * j + 1) + k] - cellCoords[dimC * 2 * j + k]);
2858       }
2859     }
2860 
2861     if (i < dimR - 1) {
2862       swap = cellCoeffs;
2863       cellCoeffs = cellCoords;
2864       cellCoords = swap;
2865     }
2866   }
2867   ierr = PetscArrayzero(realCoords,numPoints * dimC);CHKERRQ(ierr);
2868   for (j = 0; j < numPoints; j++) {
2869     const PetscReal *guess  = &refCoords[dimR * j];
2870     PetscReal       *mapped = &realCoords[dimC * j];
2871 
2872     for (k = 0; k < numV; k++) {
2873       PetscReal extCoord = 1.;
2874       for (l = 0; l < dimR; l++) {
2875         PetscReal coord = guess[l];
2876         PetscInt  dep   = (k & (1 << l)) >> l;
2877 
2878         extCoord *= dep * coord + !dep;
2879       }
2880       for (l = 0; l < dimC; l++) {
2881         PetscReal coeff = cellCoeffs[dimC * k + l];
2882 
2883         mapped[l] += coeff * extCoord;
2884       }
2885     }
2886   }
2887   ierr = DMRestoreWorkArray(dm, 2 * coordSize, MPIU_REAL, &cellData);CHKERRQ(ierr);
2888   ierr = DMPlexVecRestoreClosure(dm, NULL, coords, cell, &coordSize, &coordsScalar);CHKERRQ(ierr);
2889   PetscFunctionReturn(0);
2890 }
2891 
2892 /* TODO: TOBY please fix this for Nc > 1 */
2893 static PetscErrorCode DMPlexCoordinatesToReference_FE(DM dm, PetscFE fe, PetscInt cell, PetscInt numPoints, const PetscReal realCoords[], PetscReal refCoords[], Vec coords, PetscInt Nc, PetscInt dimR)
2894 {
2895   PetscInt       numComp, pdim, i, j, k, l, m, maxIter = 7, coordSize;
2896   PetscScalar    *nodes = NULL;
2897   PetscReal      *invV, *modes;
2898   PetscReal      *B, *D, *resNeg;
2899   PetscScalar    *J, *invJ, *work;
2900   PetscErrorCode ierr;
2901 
2902   PetscFunctionBegin;
2903   ierr = PetscFEGetDimension(fe, &pdim);CHKERRQ(ierr);
2904   ierr = PetscFEGetNumComponents(fe, &numComp);CHKERRQ(ierr);
2905   if (numComp != Nc) SETERRQ2(PetscObjectComm((PetscObject)dm),PETSC_ERR_SUP,"coordinate discretization must have as many components (%D) as embedding dimension (!= %D)",numComp,Nc);
2906   ierr = DMPlexVecGetClosure(dm, NULL, coords, cell, &coordSize, &nodes);CHKERRQ(ierr);
2907   /* convert nodes to values in the stable evaluation basis */
2908   ierr = DMGetWorkArray(dm,pdim,MPIU_REAL,&modes);CHKERRQ(ierr);
2909   invV = fe->invV;
2910   for (i = 0; i < pdim; ++i) {
2911     modes[i] = 0.;
2912     for (j = 0; j < pdim; ++j) {
2913       modes[i] += invV[i * pdim + j] * PetscRealPart(nodes[j]);
2914     }
2915   }
2916   ierr   = DMGetWorkArray(dm,pdim * Nc + pdim * Nc * dimR + Nc,MPIU_REAL,&B);CHKERRQ(ierr);
2917   D      = &B[pdim*Nc];
2918   resNeg = &D[pdim*Nc * dimR];
2919   ierr = DMGetWorkArray(dm,3 * Nc * dimR,MPIU_SCALAR,&J);CHKERRQ(ierr);
2920   invJ = &J[Nc * dimR];
2921   work = &invJ[Nc * dimR];
2922   for (i = 0; i < numPoints * dimR; i++) {refCoords[i] = 0.;}
2923   for (j = 0; j < numPoints; j++) {
2924       for (i = 0; i < maxIter; i++) { /* we could batch this so that we're not making big B and D arrays all the time */
2925       PetscReal *guess = &refCoords[j * dimR];
2926       ierr = PetscSpaceEvaluate(fe->basisSpace, 1, guess, B, D, NULL);CHKERRQ(ierr);
2927       for (k = 0; k < Nc; k++) {resNeg[k] = realCoords[j * Nc + k];}
2928       for (k = 0; k < Nc * dimR; k++) {J[k] = 0.;}
2929       for (k = 0; k < pdim; k++) {
2930         for (l = 0; l < Nc; l++) {
2931           resNeg[l] -= modes[k] * B[k * Nc + l];
2932           for (m = 0; m < dimR; m++) {
2933             J[l * dimR + m] += modes[k] * D[(k * Nc + l) * dimR + m];
2934           }
2935         }
2936       }
2937 #if 0 && defined(PETSC_USE_DEBUG)
2938       {
2939         PetscReal maxAbs = 0.;
2940 
2941         for (l = 0; l < Nc; l++) {
2942           maxAbs = PetscMax(maxAbs,PetscAbsReal(resNeg[l]));
2943         }
2944         ierr = PetscInfo4(dm,"cell %D, point %D, iter %D: res %g\n",cell,j,i,(double) maxAbs);CHKERRQ(ierr);
2945       }
2946 #endif
2947       ierr = DMPlexCoordinatesToReference_NewtonUpdate(Nc,dimR,J,invJ,work,resNeg,guess);CHKERRQ(ierr);
2948     }
2949   }
2950   ierr = DMRestoreWorkArray(dm,3 * Nc * dimR,MPIU_SCALAR,&J);CHKERRQ(ierr);
2951   ierr = DMRestoreWorkArray(dm,pdim * Nc + pdim * Nc * dimR + Nc,MPIU_REAL,&B);CHKERRQ(ierr);
2952   ierr = DMRestoreWorkArray(dm,pdim,MPIU_REAL,&modes);CHKERRQ(ierr);
2953   ierr = DMPlexVecRestoreClosure(dm, NULL, coords, cell, &coordSize, &nodes);CHKERRQ(ierr);
2954   PetscFunctionReturn(0);
2955 }
2956 
2957 /* TODO: TOBY please fix this for Nc > 1 */
2958 static PetscErrorCode DMPlexReferenceToCoordinates_FE(DM dm, PetscFE fe, PetscInt cell, PetscInt numPoints, const PetscReal refCoords[], PetscReal realCoords[], Vec coords, PetscInt Nc, PetscInt dimR)
2959 {
2960   PetscInt       numComp, pdim, i, j, k, l, coordSize;
2961   PetscScalar    *nodes = NULL;
2962   PetscReal      *invV, *modes;
2963   PetscReal      *B;
2964   PetscErrorCode ierr;
2965 
2966   PetscFunctionBegin;
2967   ierr = PetscFEGetDimension(fe, &pdim);CHKERRQ(ierr);
2968   ierr = PetscFEGetNumComponents(fe, &numComp);CHKERRQ(ierr);
2969   if (numComp != Nc) SETERRQ2(PetscObjectComm((PetscObject)dm),PETSC_ERR_SUP,"coordinate discretization must have as many components (%D) as embedding dimension (!= %D)",numComp,Nc);
2970   ierr = DMPlexVecGetClosure(dm, NULL, coords, cell, &coordSize, &nodes);CHKERRQ(ierr);
2971   /* convert nodes to values in the stable evaluation basis */
2972   ierr = DMGetWorkArray(dm,pdim,MPIU_REAL,&modes);CHKERRQ(ierr);
2973   invV = fe->invV;
2974   for (i = 0; i < pdim; ++i) {
2975     modes[i] = 0.;
2976     for (j = 0; j < pdim; ++j) {
2977       modes[i] += invV[i * pdim + j] * PetscRealPart(nodes[j]);
2978     }
2979   }
2980   ierr = DMGetWorkArray(dm,numPoints * pdim * Nc,MPIU_REAL,&B);CHKERRQ(ierr);
2981   ierr = PetscSpaceEvaluate(fe->basisSpace, numPoints, refCoords, B, NULL, NULL);CHKERRQ(ierr);
2982   for (i = 0; i < numPoints * Nc; i++) {realCoords[i] = 0.;}
2983   for (j = 0; j < numPoints; j++) {
2984     PetscReal *mapped = &realCoords[j * Nc];
2985 
2986     for (k = 0; k < pdim; k++) {
2987       for (l = 0; l < Nc; l++) {
2988         mapped[l] += modes[k] * B[(j * pdim + k) * Nc + l];
2989       }
2990     }
2991   }
2992   ierr = DMRestoreWorkArray(dm,numPoints * pdim * Nc,MPIU_REAL,&B);CHKERRQ(ierr);
2993   ierr = DMRestoreWorkArray(dm,pdim,MPIU_REAL,&modes);CHKERRQ(ierr);
2994   ierr = DMPlexVecRestoreClosure(dm, NULL, coords, cell, &coordSize, &nodes);CHKERRQ(ierr);
2995   PetscFunctionReturn(0);
2996 }
2997 
2998 /*@
2999   DMPlexCoordinatesToReference - Pull coordinates back from the mesh to the reference element using a single element
3000   map.  This inversion will be accurate inside the reference element, but may be inaccurate for mappings that do not
3001   extend uniquely outside the reference cell (e.g, most non-affine maps)
3002 
3003   Not collective
3004 
3005   Input Parameters:
3006 + dm         - The mesh, with coordinate maps defined either by a PetscDS for the coordinate DM (see DMGetCoordinateDM()) or
3007                implicitly by the coordinates of the corner vertices of the cell: as an affine map for simplicial elements, or
3008                as a multilinear map for tensor-product elements
3009 . cell       - the cell whose map is used.
3010 . numPoints  - the number of points to locate
3011 - realCoords - (numPoints x coordinate dimension) array of coordinates (see DMGetCoordinateDim())
3012 
3013   Output Parameters:
3014 . refCoords  - (numPoints x dimension) array of reference coordinates (see DMGetDimension())
3015 
3016   Level: intermediate
3017 
3018 .seealso: DMPlexReferenceToCoordinates()
3019 @*/
3020 PetscErrorCode DMPlexCoordinatesToReference(DM dm, PetscInt cell, PetscInt numPoints, const PetscReal realCoords[], PetscReal refCoords[])
3021 {
3022   PetscInt       dimC, dimR, depth, cStart, cEnd, i;
3023   DM             coordDM = NULL;
3024   Vec            coords;
3025   PetscFE        fe = NULL;
3026   PetscErrorCode ierr;
3027 
3028   PetscFunctionBegin;
3029   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
3030   ierr = DMGetDimension(dm,&dimR);CHKERRQ(ierr);
3031   ierr = DMGetCoordinateDim(dm,&dimC);CHKERRQ(ierr);
3032   if (dimR <= 0 || dimC <= 0 || numPoints <= 0) PetscFunctionReturn(0);
3033   ierr = DMPlexGetDepth(dm,&depth);CHKERRQ(ierr);
3034   ierr = DMGetCoordinatesLocal(dm,&coords);CHKERRQ(ierr);
3035   ierr = DMGetCoordinateDM(dm,&coordDM);CHKERRQ(ierr);
3036   if (coordDM) {
3037     PetscInt coordFields;
3038 
3039     ierr = DMGetNumFields(coordDM,&coordFields);CHKERRQ(ierr);
3040     if (coordFields) {
3041       PetscClassId id;
3042       PetscObject  disc;
3043 
3044       ierr = DMGetField(coordDM,0,NULL,&disc);CHKERRQ(ierr);
3045       ierr = PetscObjectGetClassId(disc,&id);CHKERRQ(ierr);
3046       if (id == PETSCFE_CLASSID) {
3047         fe = (PetscFE) disc;
3048       }
3049     }
3050   }
3051   ierr = DMPlexGetInteriorCellStratum(dm,&cStart,&cEnd);CHKERRQ(ierr);
3052   if (cell < cStart || cell >= cEnd) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"point %D not in cell range [%D,%D)",cell,cStart,cEnd);
3053   if (!fe) { /* implicit discretization: affine or multilinear */
3054     PetscInt  coneSize;
3055     PetscBool isSimplex, isTensor;
3056 
3057     ierr = DMPlexGetConeSize(dm,cell,&coneSize);CHKERRQ(ierr);
3058     isSimplex = (coneSize == (dimR + 1)) ? PETSC_TRUE : PETSC_FALSE;
3059     isTensor  = (coneSize == ((depth == 1) ? (1 << dimR) : (2 * dimR))) ? PETSC_TRUE : PETSC_FALSE;
3060     if (isSimplex) {
3061       PetscReal detJ, *v0, *J, *invJ;
3062 
3063       ierr = DMGetWorkArray(dm,dimC + 2 * dimC * dimC, MPIU_REAL, &v0);CHKERRQ(ierr);
3064       J    = &v0[dimC];
3065       invJ = &J[dimC * dimC];
3066       ierr = DMPlexComputeCellGeometryAffineFEM(dm, cell, v0, J, invJ, &detJ);CHKERRQ(ierr);
3067       for (i = 0; i < numPoints; i++) { /* Apply the inverse affine transformation for each point */
3068         const PetscReal x0[3] = {-1.,-1.,-1.};
3069 
3070         CoordinatesRealToRef(dimC, dimR, x0, v0, invJ, &realCoords[dimC * i], &refCoords[dimR * i]);
3071       }
3072       ierr = DMRestoreWorkArray(dm,dimC + 2 * dimC * dimC, MPIU_REAL, &v0);CHKERRQ(ierr);
3073     } else if (isTensor) {
3074       ierr = DMPlexCoordinatesToReference_Tensor(coordDM, cell, numPoints, realCoords, refCoords, coords, dimC, dimR);CHKERRQ(ierr);
3075     } else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unrecognized cone size %D",coneSize);
3076   } else {
3077     ierr = DMPlexCoordinatesToReference_FE(coordDM, fe, cell, numPoints, realCoords, refCoords, coords, dimC, dimR);CHKERRQ(ierr);
3078   }
3079   PetscFunctionReturn(0);
3080 }
3081 
3082 /*@
3083   DMPlexReferenceToCoordinates - Map references coordinates to coordinates in the the mesh for a single element map.
3084 
3085   Not collective
3086 
3087   Input Parameters:
3088 + dm         - The mesh, with coordinate maps defined either by a PetscDS for the coordinate DM (see DMGetCoordinateDM()) or
3089                implicitly by the coordinates of the corner vertices of the cell: as an affine map for simplicial elements, or
3090                as a multilinear map for tensor-product elements
3091 . cell       - the cell whose map is used.
3092 . numPoints  - the number of points to locate
3093 - refCoords  - (numPoints x dimension) array of reference coordinates (see DMGetDimension())
3094 
3095   Output Parameters:
3096 . realCoords - (numPoints x coordinate dimension) array of coordinates (see DMGetCoordinateDim())
3097 
3098    Level: intermediate
3099 
3100 .seealso: DMPlexCoordinatesToReference()
3101 @*/
3102 PetscErrorCode DMPlexReferenceToCoordinates(DM dm, PetscInt cell, PetscInt numPoints, const PetscReal refCoords[], PetscReal realCoords[])
3103 {
3104   PetscInt       dimC, dimR, depth, cStart, cEnd, i;
3105   DM             coordDM = NULL;
3106   Vec            coords;
3107   PetscFE        fe = NULL;
3108   PetscErrorCode ierr;
3109 
3110   PetscFunctionBegin;
3111   PetscValidHeaderSpecific(dm,DM_CLASSID,1);
3112   ierr = DMGetDimension(dm,&dimR);CHKERRQ(ierr);
3113   ierr = DMGetCoordinateDim(dm,&dimC);CHKERRQ(ierr);
3114   if (dimR <= 0 || dimC <= 0 || numPoints <= 0) PetscFunctionReturn(0);
3115   ierr = DMPlexGetDepth(dm,&depth);CHKERRQ(ierr);
3116   ierr = DMGetCoordinatesLocal(dm,&coords);CHKERRQ(ierr);
3117   ierr = DMGetCoordinateDM(dm,&coordDM);CHKERRQ(ierr);
3118   if (coordDM) {
3119     PetscInt coordFields;
3120 
3121     ierr = DMGetNumFields(coordDM,&coordFields);CHKERRQ(ierr);
3122     if (coordFields) {
3123       PetscClassId id;
3124       PetscObject  disc;
3125 
3126       ierr = DMGetField(coordDM,0,NULL,&disc);CHKERRQ(ierr);
3127       ierr = PetscObjectGetClassId(disc,&id);CHKERRQ(ierr);
3128       if (id == PETSCFE_CLASSID) {
3129         fe = (PetscFE) disc;
3130       }
3131     }
3132   }
3133   ierr = DMPlexGetInteriorCellStratum(dm,&cStart,&cEnd);CHKERRQ(ierr);
3134   if (cell < cStart || cell >= cEnd) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"point %D not in cell range [%D,%D)",cell,cStart,cEnd);
3135   if (!fe) { /* implicit discretization: affine or multilinear */
3136     PetscInt  coneSize;
3137     PetscBool isSimplex, isTensor;
3138 
3139     ierr = DMPlexGetConeSize(dm,cell,&coneSize);CHKERRQ(ierr);
3140     isSimplex = (coneSize == (dimR + 1)) ? PETSC_TRUE : PETSC_FALSE;
3141     isTensor  = (coneSize == ((depth == 1) ? (1 << dimR) : (2 * dimR))) ? PETSC_TRUE : PETSC_FALSE;
3142     if (isSimplex) {
3143       PetscReal detJ, *v0, *J;
3144 
3145       ierr = DMGetWorkArray(dm,dimC + 2 * dimC * dimC, MPIU_REAL, &v0);CHKERRQ(ierr);
3146       J    = &v0[dimC];
3147       ierr = DMPlexComputeCellGeometryAffineFEM(dm, cell, v0, J, NULL, &detJ);CHKERRQ(ierr);
3148       for (i = 0; i < numPoints; i++) { /* Apply the affine transformation for each point */
3149         const PetscReal xi0[3] = {-1.,-1.,-1.};
3150 
3151         CoordinatesRefToReal(dimC, dimR, xi0, v0, J, &refCoords[dimR * i], &realCoords[dimC * i]);
3152       }
3153       ierr = DMRestoreWorkArray(dm,dimC + 2 * dimC * dimC, MPIU_REAL, &v0);CHKERRQ(ierr);
3154     } else if (isTensor) {
3155       ierr = DMPlexReferenceToCoordinates_Tensor(coordDM, cell, numPoints, refCoords, realCoords, coords, dimC, dimR);CHKERRQ(ierr);
3156     } else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unrecognized cone size %D",coneSize);
3157   } else {
3158     ierr = DMPlexReferenceToCoordinates_FE(coordDM, fe, cell, numPoints, refCoords, realCoords, coords, dimC, dimR);CHKERRQ(ierr);
3159   }
3160   PetscFunctionReturn(0);
3161 }
3162 
3163 /*@C
3164   DMPlexRemapGeometry - This function maps the original DM coordinates to new coordinates.
3165 
3166   Not collective
3167 
3168   Input Parameters:
3169 + dm      - The DM
3170 . time    - The time
3171 - func    - The function transforming current coordinates to new coordaintes
3172 
3173    Calling sequence of func:
3174 $    func(PetscInt dim, PetscInt Nf, PetscInt NfAux,
3175 $         const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
3176 $         const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
3177 $         PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f[]);
3178 
3179 +  dim          - The spatial dimension
3180 .  Nf           - The number of input fields (here 1)
3181 .  NfAux        - The number of input auxiliary fields
3182 .  uOff         - The offset of the coordinates in u[] (here 0)
3183 .  uOff_x       - The offset of the coordinates in u_x[] (here 0)
3184 .  u            - The coordinate values at this point in space
3185 .  u_t          - The coordinate time derivative at this point in space (here NULL)
3186 .  u_x          - The coordinate derivatives at this point in space
3187 .  aOff         - The offset of each auxiliary field in u[]
3188 .  aOff_x       - The offset of each auxiliary field in u_x[]
3189 .  a            - The auxiliary field values at this point in space
3190 .  a_t          - The auxiliary field time derivative at this point in space (or NULL)
3191 .  a_x          - The auxiliary field derivatives at this point in space
3192 .  t            - The current time
3193 .  x            - The coordinates of this point (here not used)
3194 .  numConstants - The number of constants
3195 .  constants    - The value of each constant
3196 -  f            - The new coordinates at this point in space
3197 
3198   Level: intermediate
3199 
3200 .seealso: DMGetCoordinates(), DMGetCoordinatesLocal(), DMGetCoordinateDM(), DMProjectFieldLocal(), DMProjectFieldLabelLocal()
3201 @*/
3202 PetscErrorCode DMPlexRemapGeometry(DM dm, PetscReal time,
3203                                    void (*func)(PetscInt, PetscInt, PetscInt,
3204                                                 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
3205                                                 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
3206                                                 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]))
3207 {
3208   DM             cdm;
3209   Vec            lCoords, tmpCoords;
3210   PetscErrorCode ierr;
3211 
3212   PetscFunctionBegin;
3213   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
3214   ierr = DMGetCoordinatesLocal(dm, &lCoords);CHKERRQ(ierr);
3215   ierr = DMGetLocalVector(cdm, &tmpCoords);CHKERRQ(ierr);
3216   ierr = VecCopy(lCoords, tmpCoords);CHKERRQ(ierr);
3217   ierr = DMProjectFieldLocal(cdm, time, tmpCoords, &func, INSERT_VALUES, lCoords);CHKERRQ(ierr);
3218   ierr = DMRestoreLocalVector(cdm, &tmpCoords);CHKERRQ(ierr);
3219   PetscFunctionReturn(0);
3220 }
3221 
3222 /* Shear applies the transformation, assuming we fix z,
3223   / 1  0  m_0 \
3224   | 0  1  m_1 |
3225   \ 0  0   1  /
3226 */
3227 static void f0_shear(PetscInt dim, PetscInt Nf, PetscInt NfAux,
3228                      const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[],
3229                      const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[],
3230                      PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar coords[])
3231 {
3232   const PetscInt Nc = uOff[1]-uOff[0];
3233   const PetscInt ax = (PetscInt) PetscRealPart(constants[0]);
3234   PetscInt       c;
3235 
3236   for (c = 0; c < Nc; ++c) {
3237     coords[c] = u[c] + constants[c+1]*u[ax];
3238   }
3239 }
3240 
3241 /*@C
3242   DMPlexShearGeometry - This shears the domain, meaning adds a multiple of the shear coordinate to all other coordinates.
3243 
3244   Not collective
3245 
3246   Input Parameters:
3247 + dm          - The DM
3248 . direction   - The shear coordinate direction, e.g. 0 is the x-axis
3249 - multipliers - The multiplier m for each direction which is not the shear direction
3250 
3251   Level: intermediate
3252 
3253 .seealso: DMPlexRemapGeometry()
3254 @*/
3255 PetscErrorCode DMPlexShearGeometry(DM dm, DMDirection direction, PetscReal multipliers[])
3256 {
3257   DM             cdm;
3258   PetscDS        cds;
3259   PetscObject    obj;
3260   PetscClassId   id;
3261   PetscScalar   *moduli;
3262   const PetscInt dir = (PetscInt) direction;
3263   PetscInt       dE, d, e;
3264   PetscErrorCode ierr;
3265 
3266   PetscFunctionBegin;
3267   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
3268   ierr = DMGetCoordinateDim(dm, &dE);CHKERRQ(ierr);
3269   ierr = PetscMalloc1(dE+1, &moduli);CHKERRQ(ierr);
3270   moduli[0] = dir;
3271   for (d = 0, e = 0; d < dE; ++d) moduli[d] = d == dir ? 0.0 : (multipliers ? multipliers[e++] : 1.0);
3272   ierr = DMGetDS(cdm, &cds);CHKERRQ(ierr);
3273   ierr = PetscDSGetDiscretization(cds, 0, &obj);CHKERRQ(ierr);
3274   ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3275   if (id != PETSCFE_CLASSID) {
3276     Vec           lCoords;
3277     PetscSection  cSection;
3278     PetscScalar  *coords;
3279     PetscInt      vStart, vEnd, v;
3280 
3281     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
3282     ierr = DMGetCoordinateSection(dm, &cSection);CHKERRQ(ierr);
3283     ierr = DMGetCoordinatesLocal(dm, &lCoords);CHKERRQ(ierr);
3284     ierr = VecGetArray(lCoords, &coords);CHKERRQ(ierr);
3285     for (v = vStart; v < vEnd; ++v) {
3286       PetscReal ds;
3287       PetscInt  off, c;
3288 
3289       ierr = PetscSectionGetOffset(cSection, v, &off);CHKERRQ(ierr);
3290       ds   = PetscRealPart(coords[off+dir]);
3291       for (c = 0; c < dE; ++c) coords[off+c] += moduli[c]*ds;
3292     }
3293     ierr = VecRestoreArray(lCoords, &coords);CHKERRQ(ierr);
3294   } else {
3295     ierr = PetscDSSetConstants(cds, dE+1, moduli);CHKERRQ(ierr);
3296     ierr = DMPlexRemapGeometry(dm, 0.0, f0_shear);CHKERRQ(ierr);
3297   }
3298   ierr = PetscFree(moduli);CHKERRQ(ierr);
3299   PetscFunctionReturn(0);
3300 }
3301