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