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