xref: /petsc/src/dm/impls/plex/plexsubmesh.c (revision 015d8f87d72b705c0d5d39fa909bf6b903dc7b1b)
1 #include <petsc-private/dmpleximpl.h>   /*I      "petscdmplex.h"   I*/
2 #include <petscsf.h>
3 
4 #undef __FUNCT__
5 #define __FUNCT__ "DMPlexMarkBoundaryFaces"
6 /*@
7   DMPlexMarkBoundaryFaces - Mark all faces on the boundary
8 
9   Not Collective
10 
11   Input Parameter:
12 . dm - The original DM
13 
14   Output Parameter:
15 . label - The DMLabel marking boundary faces with value 1
16 
17   Level: developer
18 
19 .seealso: DMLabelCreate(), DMPlexCreateLabel()
20 @*/
21 PetscErrorCode DMPlexMarkBoundaryFaces(DM dm, DMLabel label)
22 {
23   PetscInt       fStart, fEnd, f;
24   PetscErrorCode ierr;
25 
26   PetscFunctionBegin;
27   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
28   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
29   for (f = fStart; f < fEnd; ++f) {
30     PetscInt supportSize;
31 
32     ierr = DMPlexGetSupportSize(dm, f, &supportSize);CHKERRQ(ierr);
33     if (supportSize == 1) {
34       ierr = DMLabelSetValue(label, f, 1);CHKERRQ(ierr);
35     }
36   }
37   PetscFunctionReturn(0);
38 }
39 
40 #undef __FUNCT__
41 #define __FUNCT__ "DMPlexLabelComplete"
42 /*@
43   DMPlexLabelComplete - Starting with a label marking points on a surface, we add the transitive closure to the surface
44 
45   Input Parameters:
46 + dm - The DM
47 - label - A DMLabel marking the surface points
48 
49   Output Parameter:
50 . label - A DMLabel marking all surface points in the transitive closure
51 
52   Level: developer
53 
54 .seealso: DMPlexLabelCohesiveComplete()
55 @*/
56 PetscErrorCode DMPlexLabelComplete(DM dm, DMLabel label)
57 {
58   IS              valueIS;
59   const PetscInt *values;
60   PetscInt        numValues, v;
61   PetscErrorCode  ierr;
62 
63   PetscFunctionBegin;
64   ierr = DMLabelGetNumValues(label, &numValues);CHKERRQ(ierr);
65   ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
66   ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
67   for (v = 0; v < numValues; ++v) {
68     IS              pointIS;
69     const PetscInt *points;
70     PetscInt        numPoints, p;
71 
72     ierr = DMLabelGetStratumSize(label, values[v], &numPoints);CHKERRQ(ierr);
73     ierr = DMLabelGetStratumIS(label, values[v], &pointIS);CHKERRQ(ierr);
74     ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
75     for (p = 0; p < numPoints; ++p) {
76       PetscInt *closure = NULL;
77       PetscInt  closureSize, c;
78 
79       ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
80       for (c = 0; c < closureSize*2; c += 2) {
81         ierr = DMLabelSetValue(label, closure[c], values[v]);CHKERRQ(ierr);
82       }
83       ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
84     }
85     ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
86     ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
87   }
88   ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
89   ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
90   PetscFunctionReturn(0);
91 }
92 
93 #undef __FUNCT__
94 #define __FUNCT__ "DMPlexShiftPoint_Internal"
95 PETSC_STATIC_INLINE PetscInt DMPlexShiftPoint_Internal(PetscInt p, PetscInt depth, PetscInt depthEnd[], PetscInt depthShift[])
96 {
97   if (depth < 0) return p;
98   /* Cells    */ if (p < depthEnd[depth])   return p;
99   /* Vertices */ if (p < depthEnd[0])       return p + depthShift[depth];
100   /* Faces    */ if (p < depthEnd[depth-1]) return p + depthShift[depth] + depthShift[0];
101   /* Edges    */                            return p + depthShift[depth] + depthShift[0] + depthShift[depth-1];
102 }
103 
104 #undef __FUNCT__
105 #define __FUNCT__ "DMPlexShiftSizes_Internal"
106 static PetscErrorCode DMPlexShiftSizes_Internal(DM dm, PetscInt depthShift[], DM dmNew)
107 {
108   PetscInt      *depthEnd;
109   PetscInt       depth = 0, d, pStart, pEnd, p;
110   PetscErrorCode ierr;
111 
112   PetscFunctionBegin;
113   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
114   if (depth < 0) PetscFunctionReturn(0);
115   ierr = PetscMalloc1((depth+1), &depthEnd);CHKERRQ(ierr);
116   /* Step 1: Expand chart */
117   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
118   for (d = 0; d <= depth; ++d) {
119     pEnd += depthShift[d];
120     ierr  = DMPlexGetDepthStratum(dm, d, NULL, &depthEnd[d]);CHKERRQ(ierr);
121   }
122   ierr = DMPlexSetChart(dmNew, pStart, pEnd);CHKERRQ(ierr);
123   /* Step 2: Set cone and support sizes */
124   for (d = 0; d <= depth; ++d) {
125     ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
126     for (p = pStart; p < pEnd; ++p) {
127       PetscInt newp = DMPlexShiftPoint_Internal(p, depth, depthEnd, depthShift);
128       PetscInt size;
129 
130       ierr = DMPlexGetConeSize(dm, p, &size);CHKERRQ(ierr);
131       ierr = DMPlexSetConeSize(dmNew, newp, size);CHKERRQ(ierr);
132       ierr = DMPlexGetSupportSize(dm, p, &size);CHKERRQ(ierr);
133       ierr = DMPlexSetSupportSize(dmNew, newp, size);CHKERRQ(ierr);
134     }
135   }
136   ierr = PetscFree(depthEnd);CHKERRQ(ierr);
137   PetscFunctionReturn(0);
138 }
139 
140 #undef __FUNCT__
141 #define __FUNCT__ "DMPlexShiftPoints_Internal"
142 static PetscErrorCode DMPlexShiftPoints_Internal(DM dm, PetscInt depthShift[], DM dmNew)
143 {
144   PetscInt      *depthEnd, *newpoints;
145   PetscInt       depth = 0, d, maxConeSize, maxSupportSize, maxConeSizeNew, maxSupportSizeNew, pStart, pEnd, p;
146   PetscErrorCode ierr;
147 
148   PetscFunctionBegin;
149   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
150   if (depth < 0) PetscFunctionReturn(0);
151   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
152   ierr = DMPlexGetMaxSizes(dmNew, &maxConeSizeNew, &maxSupportSizeNew);CHKERRQ(ierr);
153   ierr = PetscMalloc2(depth+1,&depthEnd,PetscMax(PetscMax(maxConeSize, maxSupportSize), PetscMax(maxConeSizeNew, maxSupportSizeNew)),&newpoints);CHKERRQ(ierr);
154   for (d = 0; d <= depth; ++d) {
155     ierr = DMPlexGetDepthStratum(dm, d, NULL, &depthEnd[d]);CHKERRQ(ierr);
156   }
157   /* Step 5: Set cones and supports */
158   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
159   for (p = pStart; p < pEnd; ++p) {
160     const PetscInt *points = NULL, *orientations = NULL;
161     PetscInt        size,sizeNew, i, newp = DMPlexShiftPoint_Internal(p, depth, depthEnd, depthShift);
162 
163     ierr = DMPlexGetConeSize(dm, p, &size);CHKERRQ(ierr);
164     ierr = DMPlexGetCone(dm, p, &points);CHKERRQ(ierr);
165     ierr = DMPlexGetConeOrientation(dm, p, &orientations);CHKERRQ(ierr);
166     for (i = 0; i < size; ++i) {
167       newpoints[i] = DMPlexShiftPoint_Internal(points[i], depth, depthEnd, depthShift);
168     }
169     ierr = DMPlexSetCone(dmNew, newp, newpoints);CHKERRQ(ierr);
170     ierr = DMPlexSetConeOrientation(dmNew, newp, orientations);CHKERRQ(ierr);
171     ierr = DMPlexGetSupportSize(dm, p, &size);CHKERRQ(ierr);
172     ierr = DMPlexGetSupportSize(dmNew, newp, &sizeNew);CHKERRQ(ierr);
173     ierr = DMPlexGetSupport(dm, p, &points);CHKERRQ(ierr);
174     for (i = 0; i < size; ++i) {
175       newpoints[i] = DMPlexShiftPoint_Internal(points[i], depth, depthEnd, depthShift);
176     }
177     for (i = size; i < sizeNew; ++i) newpoints[i] = 0;
178     ierr = DMPlexSetSupport(dmNew, newp, newpoints);CHKERRQ(ierr);
179   }
180   ierr = PetscFree2(depthEnd,newpoints);CHKERRQ(ierr);
181   PetscFunctionReturn(0);
182 }
183 
184 #undef __FUNCT__
185 #define __FUNCT__ "DMPlexShiftCoordinates_Internal"
186 static PetscErrorCode DMPlexShiftCoordinates_Internal(DM dm, PetscInt depthShift[], DM dmNew)
187 {
188   PetscSection   coordSection, newCoordSection;
189   Vec            coordinates, newCoordinates;
190   PetscScalar   *coords, *newCoords;
191   PetscInt      *depthEnd, coordSize;
192   PetscInt       dim, depth = 0, d, vStart, vEnd, vStartNew, vEndNew, v;
193   PetscErrorCode ierr;
194 
195   PetscFunctionBegin;
196   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
197   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
198   ierr = PetscMalloc1((depth+1), &depthEnd);CHKERRQ(ierr);
199   for (d = 0; d <= depth; ++d) {
200     ierr = DMPlexGetDepthStratum(dm, d, NULL, &depthEnd[d]);CHKERRQ(ierr);
201   }
202   /* Step 8: Convert coordinates */
203   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
204   ierr = DMPlexGetDepthStratum(dmNew, 0, &vStartNew, &vEndNew);CHKERRQ(ierr);
205   ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
206   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &newCoordSection);CHKERRQ(ierr);
207   ierr = PetscSectionSetNumFields(newCoordSection, 1);CHKERRQ(ierr);
208   ierr = PetscSectionSetFieldComponents(newCoordSection, 0, dim);CHKERRQ(ierr);
209   ierr = PetscSectionSetChart(newCoordSection, vStartNew, vEndNew);CHKERRQ(ierr);
210   for (v = vStartNew; v < vEndNew; ++v) {
211     ierr = PetscSectionSetDof(newCoordSection, v, dim);CHKERRQ(ierr);
212     ierr = PetscSectionSetFieldDof(newCoordSection, v, 0, dim);CHKERRQ(ierr);
213   }
214   ierr = PetscSectionSetUp(newCoordSection);CHKERRQ(ierr);
215   ierr = DMPlexSetCoordinateSection(dmNew, newCoordSection);CHKERRQ(ierr);
216   ierr = PetscSectionGetStorageSize(newCoordSection, &coordSize);CHKERRQ(ierr);
217   ierr = VecCreate(PetscObjectComm((PetscObject)dm), &newCoordinates);CHKERRQ(ierr);
218   ierr = PetscObjectSetName((PetscObject) newCoordinates, "coordinates");CHKERRQ(ierr);
219   ierr = VecSetSizes(newCoordinates, coordSize, PETSC_DETERMINE);CHKERRQ(ierr);
220   ierr = VecSetType(newCoordinates,VECSTANDARD);CHKERRQ(ierr);
221   ierr = DMSetCoordinatesLocal(dmNew, newCoordinates);CHKERRQ(ierr);
222   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
223   ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
224   ierr = VecGetArray(newCoordinates, &newCoords);CHKERRQ(ierr);
225   for (v = vStart; v < vEnd; ++v) {
226     PetscInt dof, off, noff, d;
227 
228     ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
229     ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
230     ierr = PetscSectionGetOffset(newCoordSection, DMPlexShiftPoint_Internal(v, depth, depthEnd, depthShift), &noff);CHKERRQ(ierr);
231     for (d = 0; d < dof; ++d) {
232       newCoords[noff+d] = coords[off+d];
233     }
234   }
235   ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
236   ierr = VecRestoreArray(newCoordinates, &newCoords);CHKERRQ(ierr);
237   ierr = VecDestroy(&newCoordinates);CHKERRQ(ierr);
238   ierr = PetscSectionDestroy(&newCoordSection);CHKERRQ(ierr);
239   ierr = PetscFree(depthEnd);CHKERRQ(ierr);
240   PetscFunctionReturn(0);
241 }
242 
243 #undef __FUNCT__
244 #define __FUNCT__ "DMPlexShiftSF_Internal"
245 static PetscErrorCode DMPlexShiftSF_Internal(DM dm, PetscInt depthShift[], DM dmNew)
246 {
247   PetscInt          *depthEnd;
248   PetscInt           depth = 0, d;
249   PetscSF            sfPoint, sfPointNew;
250   const PetscSFNode *remotePoints;
251   PetscSFNode       *gremotePoints;
252   const PetscInt    *localPoints;
253   PetscInt          *glocalPoints, *newLocation, *newRemoteLocation;
254   PetscInt           numRoots, numLeaves, l, pStart, pEnd, totShift = 0;
255   PetscErrorCode     ierr;
256 
257   PetscFunctionBegin;
258   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
259   ierr = PetscMalloc1((depth+1), &depthEnd);CHKERRQ(ierr);
260   for (d = 0; d <= depth; ++d) {
261     totShift += depthShift[d];
262     ierr      = DMPlexGetDepthStratum(dm, d, NULL, &depthEnd[d]);CHKERRQ(ierr);
263   }
264   /* Step 9: Convert pointSF */
265   ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
266   ierr = DMGetPointSF(dmNew, &sfPointNew);CHKERRQ(ierr);
267   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
268   ierr = PetscSFGetGraph(sfPoint, &numRoots, &numLeaves, &localPoints, &remotePoints);CHKERRQ(ierr);
269   if (numRoots >= 0) {
270     ierr = PetscMalloc2(numRoots,&newLocation,pEnd-pStart,&newRemoteLocation);CHKERRQ(ierr);
271     for (l=0; l<numRoots; l++) newLocation[l] = DMPlexShiftPoint_Internal(l, depth, depthEnd, depthShift);
272     ierr = PetscSFBcastBegin(sfPoint, MPIU_INT, newLocation, newRemoteLocation);CHKERRQ(ierr);
273     ierr = PetscSFBcastEnd(sfPoint, MPIU_INT, newLocation, newRemoteLocation);CHKERRQ(ierr);
274     ierr = PetscMalloc1(numLeaves,    &glocalPoints);CHKERRQ(ierr);
275     ierr = PetscMalloc1(numLeaves, &gremotePoints);CHKERRQ(ierr);
276     for (l = 0; l < numLeaves; ++l) {
277       glocalPoints[l]        = DMPlexShiftPoint_Internal(localPoints[l], depth, depthEnd, depthShift);
278       gremotePoints[l].rank  = remotePoints[l].rank;
279       gremotePoints[l].index = newRemoteLocation[localPoints[l]];
280     }
281     ierr = PetscFree2(newLocation,newRemoteLocation);CHKERRQ(ierr);
282     ierr = PetscSFSetGraph(sfPointNew, numRoots + totShift, numLeaves, glocalPoints, PETSC_OWN_POINTER, gremotePoints, PETSC_OWN_POINTER);CHKERRQ(ierr);
283   }
284   ierr = PetscFree(depthEnd);CHKERRQ(ierr);
285   PetscFunctionReturn(0);
286 }
287 
288 #undef __FUNCT__
289 #define __FUNCT__ "DMPlexShiftLabels_Internal"
290 static PetscErrorCode DMPlexShiftLabels_Internal(DM dm, PetscInt depthShift[], DM dmNew)
291 {
292   PetscSF            sfPoint;
293   DMLabel            vtkLabel, ghostLabel;
294   PetscInt          *depthEnd;
295   const PetscSFNode *leafRemote;
296   const PetscInt    *leafLocal;
297   PetscInt           depth = 0, d, numLeaves, numLabels, l, cStart, cEnd, c, fStart, fEnd, f;
298   PetscMPIInt        rank;
299   PetscErrorCode     ierr;
300 
301   PetscFunctionBegin;
302   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
303   ierr = PetscMalloc1((depth+1), &depthEnd);CHKERRQ(ierr);
304   for (d = 0; d <= depth; ++d) {
305     ierr = DMPlexGetDepthStratum(dm, d, NULL, &depthEnd[d]);CHKERRQ(ierr);
306   }
307   /* Step 10: Convert labels */
308   ierr = DMPlexGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
309   for (l = 0; l < numLabels; ++l) {
310     DMLabel         label, newlabel;
311     const char     *lname;
312     PetscBool       isDepth;
313     IS              valueIS;
314     const PetscInt *values;
315     PetscInt        numValues, val;
316 
317     ierr = DMPlexGetLabelName(dm, l, &lname);CHKERRQ(ierr);
318     ierr = PetscStrcmp(lname, "depth", &isDepth);CHKERRQ(ierr);
319     if (isDepth) continue;
320     ierr = DMPlexCreateLabel(dmNew, lname);CHKERRQ(ierr);
321     ierr = DMPlexGetLabel(dm, lname, &label);CHKERRQ(ierr);
322     ierr = DMPlexGetLabel(dmNew, lname, &newlabel);CHKERRQ(ierr);
323     ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
324     ierr = ISGetLocalSize(valueIS, &numValues);CHKERRQ(ierr);
325     ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
326     for (val = 0; val < numValues; ++val) {
327       IS              pointIS;
328       const PetscInt *points;
329       PetscInt        numPoints, p;
330 
331       ierr = DMLabelGetStratumIS(label, values[val], &pointIS);CHKERRQ(ierr);
332       ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);
333       ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
334       for (p = 0; p < numPoints; ++p) {
335         const PetscInt newpoint = DMPlexShiftPoint_Internal(points[p], depth, depthEnd, depthShift);
336 
337         ierr = DMLabelSetValue(newlabel, newpoint, values[val]);CHKERRQ(ierr);
338       }
339       ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
340       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
341     }
342     ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
343     ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
344   }
345   ierr = PetscFree(depthEnd);CHKERRQ(ierr);
346   /* Step 11: Make label for output (vtk) and to mark ghost points (ghost) */
347   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
348   ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
349   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
350   ierr = PetscSFGetGraph(sfPoint, NULL, &numLeaves, &leafLocal, &leafRemote);CHKERRQ(ierr);
351   ierr = DMPlexCreateLabel(dmNew, "vtk");CHKERRQ(ierr);
352   ierr = DMPlexCreateLabel(dmNew, "ghost");CHKERRQ(ierr);
353   ierr = DMPlexGetLabel(dmNew, "vtk", &vtkLabel);CHKERRQ(ierr);
354   ierr = DMPlexGetLabel(dmNew, "ghost", &ghostLabel);CHKERRQ(ierr);
355   for (l = 0, c = cStart; l < numLeaves && c < cEnd; ++l, ++c) {
356     for (; c < leafLocal[l] && c < cEnd; ++c) {
357       ierr = DMLabelSetValue(vtkLabel, c, 1);CHKERRQ(ierr);
358     }
359     if (leafLocal[l] >= cEnd) break;
360     if (leafRemote[l].rank == rank) {
361       ierr = DMLabelSetValue(vtkLabel, c, 1);CHKERRQ(ierr);
362     } else {
363       ierr = DMLabelSetValue(ghostLabel, c, 2);CHKERRQ(ierr);
364     }
365   }
366   for (; c < cEnd; ++c) {
367     ierr = DMLabelSetValue(vtkLabel, c, 1);CHKERRQ(ierr);
368   }
369   if (0) {
370     ierr = PetscViewerASCIISynchronizedAllow(PETSC_VIEWER_STDOUT_WORLD, PETSC_TRUE);CHKERRQ(ierr);
371     ierr = DMLabelView(vtkLabel, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
372     ierr = PetscViewerFlush(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
373   }
374   ierr = DMPlexGetHeightStratum(dmNew, 1, &fStart, &fEnd);CHKERRQ(ierr);
375   for (f = fStart; f < fEnd; ++f) {
376     PetscInt numCells;
377 
378     ierr = DMPlexGetSupportSize(dmNew, f, &numCells);CHKERRQ(ierr);
379     if (numCells < 2) {
380       ierr = DMLabelSetValue(ghostLabel, f, 1);CHKERRQ(ierr);
381     } else {
382       const PetscInt *cells = NULL;
383       PetscInt        vA, vB;
384 
385       ierr = DMPlexGetSupport(dmNew, f, &cells);CHKERRQ(ierr);
386       ierr = DMLabelGetValue(vtkLabel, cells[0], &vA);CHKERRQ(ierr);
387       ierr = DMLabelGetValue(vtkLabel, cells[1], &vB);CHKERRQ(ierr);
388       if (!vA && !vB) {ierr = DMLabelSetValue(ghostLabel, f, 1);CHKERRQ(ierr);}
389     }
390   }
391   if (0) {
392     ierr = PetscViewerASCIISynchronizedAllow(PETSC_VIEWER_STDOUT_WORLD, PETSC_TRUE);CHKERRQ(ierr);
393     ierr = DMLabelView(ghostLabel, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
394     ierr = PetscViewerFlush(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
395   }
396   PetscFunctionReturn(0);
397 }
398 
399 #undef __FUNCT__
400 #define __FUNCT__ "DMPlexConstructGhostCells_Internal"
401 static PetscErrorCode DMPlexConstructGhostCells_Internal(DM dm, DMLabel label, PetscInt *numGhostCells, DM gdm)
402 {
403   IS              valueIS;
404   const PetscInt *values;
405   PetscInt       *depthShift;
406   PetscInt        depth = 0, numFS, fs, fStart, fEnd, ghostCell, cEnd, c;
407   PetscErrorCode  ierr;
408 
409   PetscFunctionBegin;
410   ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
411   /* Count ghost cells */
412   ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
413   ierr = ISGetLocalSize(valueIS, &numFS);CHKERRQ(ierr);
414   ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
415   *numGhostCells = 0;
416   for (fs = 0; fs < numFS; ++fs) {
417     IS              faceIS;
418     const PetscInt *faces;
419     PetscInt        numFaces, f, numBdFaces = 0;
420 
421     ierr = DMLabelGetStratumIS(label, values[fs], &faceIS);CHKERRQ(ierr);
422     ierr = ISGetLocalSize(faceIS, &numFaces);CHKERRQ(ierr);
423     ierr = ISGetIndices(faceIS, &faces);CHKERRQ(ierr);
424     for (f = 0; f < numFaces; ++f) {
425       if ((faces[f] >= fStart) && (faces[f] < fEnd)) ++numBdFaces;
426     }
427     *numGhostCells += numBdFaces;
428     ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
429   }
430   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
431   ierr = PetscMalloc1((depth+1), &depthShift);CHKERRQ(ierr);
432   ierr = PetscMemzero(depthShift, (depth+1) * sizeof(PetscInt));CHKERRQ(ierr);
433   if (depth >= 0) depthShift[depth] = *numGhostCells;
434   ierr = DMPlexShiftSizes_Internal(dm, depthShift, gdm);CHKERRQ(ierr);
435   /* Step 3: Set cone/support sizes for new points */
436   ierr = DMPlexGetHeightStratum(dm, 0, NULL, &cEnd);CHKERRQ(ierr);
437   for (c = cEnd; c < cEnd + *numGhostCells; ++c) {
438     ierr = DMPlexSetConeSize(gdm, c, 1);CHKERRQ(ierr);
439   }
440   for (fs = 0; fs < numFS; ++fs) {
441     IS              faceIS;
442     const PetscInt *faces;
443     PetscInt        numFaces, f;
444 
445     ierr = DMLabelGetStratumIS(label, values[fs], &faceIS);CHKERRQ(ierr);
446     ierr = ISGetLocalSize(faceIS, &numFaces);CHKERRQ(ierr);
447     ierr = ISGetIndices(faceIS, &faces);CHKERRQ(ierr);
448     for (f = 0; f < numFaces; ++f) {
449       PetscInt size;
450 
451       if ((faces[f] < fStart) || (faces[f] >= fEnd)) continue;
452       ierr = DMPlexGetSupportSize(dm, faces[f], &size);CHKERRQ(ierr);
453       if (size != 1) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "DM has boundary face %d with %d support cells", faces[f], size);
454       ierr = DMPlexSetSupportSize(gdm, faces[f] + *numGhostCells, 2);CHKERRQ(ierr);
455     }
456     ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr);
457     ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
458   }
459   /* Step 4: Setup ghosted DM */
460   ierr = DMSetUp(gdm);CHKERRQ(ierr);
461   ierr = DMPlexShiftPoints_Internal(dm, depthShift, gdm);CHKERRQ(ierr);
462   /* Step 6: Set cones and supports for new points */
463   ghostCell = cEnd;
464   for (fs = 0; fs < numFS; ++fs) {
465     IS              faceIS;
466     const PetscInt *faces;
467     PetscInt        numFaces, f;
468 
469     ierr = DMLabelGetStratumIS(label, values[fs], &faceIS);CHKERRQ(ierr);
470     ierr = ISGetLocalSize(faceIS, &numFaces);CHKERRQ(ierr);
471     ierr = ISGetIndices(faceIS, &faces);CHKERRQ(ierr);
472     for (f = 0; f < numFaces; ++f) {
473       PetscInt newFace = faces[f] + *numGhostCells;
474 
475       if ((faces[f] < fStart) || (faces[f] >= fEnd)) continue;
476       ierr = DMPlexSetCone(gdm, ghostCell, &newFace);CHKERRQ(ierr);
477       ierr = DMPlexInsertSupport(gdm, newFace, 1, ghostCell);CHKERRQ(ierr);
478       ++ghostCell;
479     }
480     ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr);
481     ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
482   }
483   ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
484   ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
485   /* Step 7: Stratify */
486   ierr = DMPlexStratify(gdm);CHKERRQ(ierr);
487   ierr = DMPlexShiftCoordinates_Internal(dm, depthShift, gdm);CHKERRQ(ierr);
488   ierr = DMPlexShiftSF_Internal(dm, depthShift, gdm);CHKERRQ(ierr);
489   ierr = DMPlexShiftLabels_Internal(dm, depthShift, gdm);CHKERRQ(ierr);
490   ierr = PetscFree(depthShift);CHKERRQ(ierr);
491   PetscFunctionReturn(0);
492 }
493 
494 #undef __FUNCT__
495 #define __FUNCT__ "DMPlexConstructGhostCells"
496 /*@C
497   DMPlexConstructGhostCells - Construct ghost cells which connect to every boundary face
498 
499   Collective on dm
500 
501   Input Parameters:
502 + dm - The original DM
503 - labelName - The label specifying the boundary faces, or "Face Sets" if this is NULL
504 
505   Output Parameters:
506 + numGhostCells - The number of ghost cells added to the DM
507 - dmGhosted - The new DM
508 
509   Note: If no label exists of that name, one will be created marking all boundary faces
510 
511   Level: developer
512 
513 .seealso: DMCreate()
514 @*/
515 PetscErrorCode DMPlexConstructGhostCells(DM dm, const char labelName[], PetscInt *numGhostCells, DM *dmGhosted)
516 {
517   DM             gdm;
518   DMLabel        label;
519   const char    *name = labelName ? labelName : "Face Sets";
520   PetscInt       dim;
521   PetscErrorCode ierr;
522 
523   PetscFunctionBegin;
524   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
525   PetscValidPointer(numGhostCells, 3);
526   PetscValidPointer(dmGhosted, 4);
527   ierr = DMCreate(PetscObjectComm((PetscObject)dm), &gdm);CHKERRQ(ierr);
528   ierr = DMSetType(gdm, DMPLEX);CHKERRQ(ierr);
529   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
530   ierr = DMPlexSetDimension(gdm, dim);CHKERRQ(ierr);
531   ierr = DMPlexGetLabel(dm, name, &label);CHKERRQ(ierr);
532   if (!label) {
533     /* Get label for boundary faces */
534     ierr = DMPlexCreateLabel(dm, name);CHKERRQ(ierr);
535     ierr = DMPlexGetLabel(dm, name, &label);CHKERRQ(ierr);
536     ierr = DMPlexMarkBoundaryFaces(dm, label);CHKERRQ(ierr);
537   }
538   ierr = DMPlexConstructGhostCells_Internal(dm, label, numGhostCells, gdm);CHKERRQ(ierr);
539   ierr = DMSetFromOptions(gdm);CHKERRQ(ierr);
540   *dmGhosted = gdm;
541   PetscFunctionReturn(0);
542 }
543 
544 #undef __FUNCT__
545 #define __FUNCT__ "DMPlexConstructCohesiveCells_Internal"
546 /*
547   We are adding three kinds of points here:
548     Replicated:     Copies of points which exist in the mesh, such as vertices identified across a fault
549     Non-replicated: Points which exist on the fault, but are not replicated
550     Hybrid:         Entirely new points, such as cohesive cells
551 */
552 static PetscErrorCode DMPlexConstructCohesiveCells_Internal(DM dm, DMLabel label, DM sdm)
553 {
554   MPI_Comm         comm;
555   IS               valueIS;
556   PetscInt         numSP = 0;       /* The number of depths for which we have replicated points */
557   const PetscInt  *values;          /* List of depths for which we have replicated points */
558   IS              *splitIS;
559   IS              *unsplitIS;
560   PetscInt        *numSplitPoints;   /* The number of replicated points at each depth */
561   PetscInt        *numUnsplitPoints; /* The number of non-replicated points at each depth which still give rise to hybrid points */
562   PetscInt        *numHybridPoints;  /* The number of hybrid points at each depth */
563   const PetscInt **splitPoints;      /* Replicated points for each depth */
564   const PetscInt **unsplitPoints;    /* Non-replicated points for each depth */
565   PetscSection     coordSection;
566   Vec              coordinates;
567   PetscScalar     *coords;
568   PetscInt         depths[4];       /* Depths in the order that plex points are numbered */
569   PetscInt        *depthShift;      /* Number of replicated+hybrid points at each depth */
570   PetscInt        *depthOffset;     /* Prefix sums of depthShift */
571   PetscInt        *pMaxNew;         /* The first replicated point at each depth in the new mesh, hybrids come after this */
572   PetscInt        *coneNew, *coneONew, *supportNew;
573   PetscInt         shift = 100, shift2 = 200, depth = 0, dep, dim, d, sp, maxConeSize, maxSupportSize, maxConeSizeNew, maxSupportSizeNew, numLabels, vStart, vEnd, pEnd, p, v;
574   PetscErrorCode   ierr;
575 
576   PetscFunctionBegin;
577   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
578   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
579   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
580   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
581   depths[0] = depth;
582   depths[1] = 0;
583   depths[2] = depth-1;
584   depths[3] = 1;
585   /* Count split points and add cohesive cells */
586   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
587   ierr = PetscMalloc3(depth+1,&depthShift,depth+1,&depthOffset,depth+1,&pMaxNew);CHKERRQ(ierr);
588   ierr = PetscMalloc7(depth+1,&splitIS,depth+1,&unsplitIS,depth+1,&numSplitPoints,depth+1,&numUnsplitPoints,depth+1,&numHybridPoints,depth+1,&splitPoints,depth+1,&unsplitPoints);CHKERRQ(ierr);
589   ierr = PetscMemzero(depthShift,  (depth+1) * sizeof(PetscInt));CHKERRQ(ierr);
590   ierr = PetscMemzero(depthOffset, (depth+1) * sizeof(PetscInt));CHKERRQ(ierr);
591   for (d = 0; d <= depth; ++d) {
592     ierr                = DMPlexGetDepthStratum(dm, d, NULL, &pMaxNew[d]);CHKERRQ(ierr);
593     numSplitPoints[d]   = 0;
594     numUnsplitPoints[d] = 0;
595     numHybridPoints[d]  = 0;
596     splitPoints[d]      = NULL;
597     unsplitPoints[d]    = NULL;
598     splitIS[d]          = NULL;
599     unsplitIS[d]        = NULL;
600   }
601   if (label) {
602     ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
603     ierr = ISGetLocalSize(valueIS, &numSP);CHKERRQ(ierr);
604     ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
605   }
606   for (sp = 0; sp < numSP; ++sp) {
607     const PetscInt dep = values[sp];
608 
609     if ((dep < 0) || (dep > depth)) continue;
610     ierr = DMLabelGetStratumIS(label, dep, &splitIS[dep]);CHKERRQ(ierr);
611     if (splitIS[dep]) {
612       ierr = ISGetLocalSize(splitIS[dep], &numSplitPoints[dep]);CHKERRQ(ierr);
613       ierr = ISGetIndices(splitIS[dep], &splitPoints[dep]);CHKERRQ(ierr);
614     }
615     ierr = DMLabelGetStratumIS(label, shift2+dep, &unsplitIS[dep]);CHKERRQ(ierr);
616     if (unsplitIS[dep]) {
617       ierr = ISGetLocalSize(unsplitIS[dep], &numUnsplitPoints[dep]);CHKERRQ(ierr);
618       ierr = ISGetIndices(unsplitIS[dep], &unsplitPoints[dep]);CHKERRQ(ierr);
619     }
620   }
621   /* Calculate number of hybrid points */
622   for (d = 1; d <= depth; ++d) numHybridPoints[d]     = numSplitPoints[d-1] + numUnsplitPoints[d-1]; /* There is a hybrid cell/face/edge for every split face/edge/vertex   */
623   for (d = 0; d <= depth; ++d) depthShift[d]          = numSplitPoints[d] + numHybridPoints[d];
624   for (d = 1; d <= depth; ++d) depthOffset[depths[d]] = depthOffset[depths[d-1]] + depthShift[depths[d-1]];
625   for (d = 0; d <= depth; ++d) pMaxNew[d]            += depthOffset[d];
626   ierr = DMPlexShiftSizes_Internal(dm, depthShift, sdm);CHKERRQ(ierr);
627   /* Step 3: Set cone/support sizes for new points */
628   for (dep = 0; dep <= depth; ++dep) {
629     for (p = 0; p < numSplitPoints[dep]; ++p) {
630       const PetscInt  oldp   = splitPoints[dep][p];
631       const PetscInt  newp   = oldp + depthOffset[dep];
632       const PetscInt  splitp = p    + pMaxNew[dep];
633       const PetscInt *support;
634       PetscInt        coneSize, supportSize, qf, qn, qp, e;
635 
636       ierr = DMPlexGetConeSize(dm, oldp, &coneSize);CHKERRQ(ierr);
637       ierr = DMPlexSetConeSize(sdm, splitp, coneSize);CHKERRQ(ierr);
638       ierr = DMPlexGetSupportSize(dm, oldp, &supportSize);CHKERRQ(ierr);
639       ierr = DMPlexSetSupportSize(sdm, splitp, supportSize);CHKERRQ(ierr);
640       if (dep == depth-1) {
641         const PetscInt hybcell = p + pMaxNew[dep+1] + numSplitPoints[dep+1];
642 
643         /* Add cohesive cells, they are prisms */
644         ierr = DMPlexSetConeSize(sdm, hybcell, 2 + coneSize);CHKERRQ(ierr);
645       } else if (dep == 0) {
646         const PetscInt hybedge = p + pMaxNew[dep+1] + numSplitPoints[dep+1];
647 
648         ierr = DMPlexGetSupport(dm, oldp, &support);CHKERRQ(ierr);
649         for (e = 0, qn = 0, qp = 0, qf = 0; e < supportSize; ++e) {
650           PetscInt val;
651 
652           ierr = DMLabelGetValue(label, support[e], &val);CHKERRQ(ierr);
653           if (val == 1) ++qf;
654           if ((val == 1) || (val ==  (shift + 1))) ++qn;
655           if ((val == 1) || (val == -(shift + 1))) ++qp;
656         }
657         /* Split old vertex: Edges into original vertex and new cohesive edge */
658         ierr = DMPlexSetSupportSize(sdm, newp, qn+1);CHKERRQ(ierr);
659         /* Split new vertex: Edges into split vertex and new cohesive edge */
660         ierr = DMPlexSetSupportSize(sdm, splitp, qp+1);CHKERRQ(ierr);
661         /* Add hybrid edge */
662         ierr = DMPlexSetConeSize(sdm, hybedge, 2);CHKERRQ(ierr);
663         ierr = DMPlexSetSupportSize(sdm, hybedge, qf);CHKERRQ(ierr);
664       } else if (dep == dim-2) {
665         const PetscInt hybface = p + pMaxNew[dep+1] + numSplitPoints[dep+1];
666 
667         ierr = DMPlexGetSupport(dm, oldp, &support);CHKERRQ(ierr);
668         for (e = 0, qn = 0, qp = 0, qf = 0; e < supportSize; ++e) {
669           PetscInt val;
670 
671           ierr = DMLabelGetValue(label, support[e], &val);CHKERRQ(ierr);
672           if (val == dim-1) ++qf;
673           if ((val == dim-1) || (val ==  (shift + dim-1))) ++qn;
674           if ((val == dim-1) || (val == -(shift + dim-1))) ++qp;
675         }
676         /* Split old edge: Faces into original edge and cohesive face (positive side?) */
677         ierr = DMPlexSetSupportSize(sdm, newp, qn+1);CHKERRQ(ierr);
678         /* Split new edge: Faces into split edge and cohesive face (negative side?) */
679         ierr = DMPlexSetSupportSize(sdm, splitp, qp+1);CHKERRQ(ierr);
680         /* Add hybrid face */
681         ierr = DMPlexSetConeSize(sdm, hybface, 4);CHKERRQ(ierr);
682         ierr = DMPlexSetSupportSize(sdm, hybface, qf);CHKERRQ(ierr);
683       }
684     }
685   }
686   for (dep = 0; dep <= depth; ++dep) {
687     for (p = 0; p < numUnsplitPoints[dep]; ++p) {
688       const PetscInt  oldp   = unsplitPoints[dep][p];
689       const PetscInt  newp   = oldp + depthOffset[dep];
690       const PetscInt *support;
691       PetscInt        coneSize, supportSize, qf, qn, qp, e;
692 
693       ierr = DMPlexGetConeSize(dm, oldp, &coneSize);CHKERRQ(ierr);
694       ierr = DMPlexGetSupportSize(dm, oldp, &supportSize);CHKERRQ(ierr);
695       if (dep == 0) {
696         const PetscInt hybedge = p + pMaxNew[dep+1] + numSplitPoints[dep+1] + numSplitPoints[dep];
697 
698         /* Unsplit vertex: Edges into original vertex, split edge, and new cohesive edge twice */
699         ierr = DMPlexSetSupportSize(sdm, newp, supportSize+3);CHKERRQ(ierr);
700         /* Add hybrid edge */
701         ierr = DMPlexSetConeSize(sdm, hybedge, 2);CHKERRQ(ierr);
702         ierr = DMPlexSetSupportSize(sdm, hybedge, 1);CHKERRQ(ierr);
703       } else if (dep == dim-2) {
704         const PetscInt hybface = p + pMaxNew[dep+1] + numSplitPoints[dep+1] + numSplitPoints[dep];
705 
706         ierr = DMPlexGetSupport(dm, oldp, &support);CHKERRQ(ierr);
707         for (e = 0, qn = 0, qp = 0, qf = 0; e < supportSize; ++e) {
708           PetscInt val;
709 
710           ierr = DMLabelGetValue(label, support[e], &val);CHKERRQ(ierr);
711           if (val == dim-1) ++qf;
712           if ((val == dim-1) || (val ==  (shift + dim-1))) ++qn;
713           if ((val == dim-1) || (val == -(shift + dim-1))) ++qp;
714         }
715         /* Unsplit edge: Faces into original edge, split face, and cohesive face twice */
716         ierr = DMPlexSetSupportSize(sdm, newp, supportSize+3);CHKERRQ(ierr);
717         /* Add hybrid face */
718         ierr = DMPlexSetConeSize(sdm, hybface, 4);CHKERRQ(ierr);
719         ierr = DMPlexSetSupportSize(sdm, hybface, 1);CHKERRQ(ierr);
720       }
721     }
722   }
723   /* Step 4: Setup split DM */
724   ierr = DMSetUp(sdm);CHKERRQ(ierr);
725   ierr = DMPlexShiftPoints_Internal(dm, depthShift, sdm);CHKERRQ(ierr);
726   ierr = DMPlexGetMaxSizes(sdm, &maxConeSizeNew, &maxSupportSizeNew);CHKERRQ(ierr);
727   ierr = PetscMalloc3(PetscMax(maxConeSize, maxConeSizeNew)*3,&coneNew,PetscMax(maxConeSize, maxConeSizeNew)*3,&coneONew,PetscMax(maxSupportSize, maxSupportSizeNew),&supportNew);CHKERRQ(ierr);
728   /* Step 6: Set cones and supports for new points */
729   for (dep = 0; dep <= depth; ++dep) {
730     for (p = 0; p < numSplitPoints[dep]; ++p) {
731       const PetscInt  oldp   = splitPoints[dep][p];
732       const PetscInt  newp   = oldp + depthOffset[dep];
733       const PetscInt  splitp = p    + pMaxNew[dep];
734       const PetscInt *cone, *support, *ornt;
735       PetscInt        coneSize, supportSize, q, qf, qn, qp, v, e, s;
736 
737       ierr = DMPlexGetConeSize(dm, oldp, &coneSize);CHKERRQ(ierr);
738       ierr = DMPlexGetCone(dm, oldp, &cone);CHKERRQ(ierr);
739       ierr = DMPlexGetConeOrientation(dm, oldp, &ornt);CHKERRQ(ierr);
740       ierr = DMPlexGetSupportSize(dm, oldp, &supportSize);CHKERRQ(ierr);
741       ierr = DMPlexGetSupport(dm, oldp, &support);CHKERRQ(ierr);
742       if (dep == depth-1) {
743         const PetscInt  hybcell = p + pMaxNew[dep+1] + numSplitPoints[dep+1];
744         const PetscInt *supportF;
745 
746         /* Split face:       copy in old face to new face to start */
747         ierr = DMPlexGetSupport(sdm, newp,  &supportF);CHKERRQ(ierr);
748         ierr = DMPlexSetSupport(sdm, splitp, supportF);CHKERRQ(ierr);
749         /* Split old face:   old vertices/edges in cone so no change */
750         /* Split new face:   new vertices/edges in cone */
751         for (q = 0; q < coneSize; ++q) {
752           ierr = PetscFindInt(cone[q], numSplitPoints[dep-1], splitPoints[dep-1], &v);CHKERRQ(ierr);
753           if (v < 0) {
754             ierr = PetscFindInt(cone[q], numUnsplitPoints[dep-1], unsplitPoints[dep-1], &v);CHKERRQ(ierr);
755             if (v < 0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not locate point %d in split or unsplit points of depth %d", cone[q], dep-1);
756             coneNew[2+q] = cone[q] + depthOffset[dep-1];
757           } else {
758             coneNew[2+q] = v + pMaxNew[dep-1];
759           }
760         }
761         ierr = DMPlexSetCone(sdm, splitp, &coneNew[2]);CHKERRQ(ierr);
762         ierr = DMPlexSetConeOrientation(sdm, splitp, ornt);CHKERRQ(ierr);
763         /* Face support */
764         for (s = 0; s < supportSize; ++s) {
765           PetscInt val;
766 
767           ierr = DMLabelGetValue(label, support[s], &val);CHKERRQ(ierr);
768           if (val < 0) {
769             /* Split old face:   Replace negative side cell with cohesive cell */
770              ierr = DMPlexInsertSupport(sdm, newp, s, hybcell);CHKERRQ(ierr);
771           } else {
772             /* Split new face:   Replace positive side cell with cohesive cell */
773             ierr = DMPlexInsertSupport(sdm, splitp, s, hybcell);CHKERRQ(ierr);
774             /* Get orientation for cohesive face */
775             {
776               const PetscInt *ncone, *nconeO;
777               PetscInt        nconeSize, nc;
778 
779               ierr = DMPlexGetConeSize(dm, support[s], &nconeSize);CHKERRQ(ierr);
780               ierr = DMPlexGetCone(dm, support[s], &ncone);CHKERRQ(ierr);
781               ierr = DMPlexGetConeOrientation(dm, support[s], &nconeO);CHKERRQ(ierr);
782               for (nc = 0; nc < nconeSize; ++nc) {
783                 if (ncone[nc] == oldp) {
784                   coneONew[0] = nconeO[nc];
785                   break;
786                 }
787               }
788               if (nc >= nconeSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not locate face %d in neighboring cell %d", oldp, support[s]);
789             }
790           }
791         }
792         /* Cohesive cell:    Old and new split face, then new cohesive faces */
793         coneNew[0]  = newp;   /* Extracted negative side orientation above */
794         coneNew[1]  = splitp;
795         coneONew[1] = coneONew[0];
796         for (q = 0; q < coneSize; ++q) {
797           ierr = PetscFindInt(cone[q], numSplitPoints[dep-1], splitPoints[dep-1], &v);CHKERRQ(ierr);
798           if (v < 0) {
799             ierr = PetscFindInt(cone[q], numUnsplitPoints[dep-1], unsplitPoints[dep-1], &v);CHKERRQ(ierr);
800             coneNew[2+q]  = v + pMaxNew[dep] + numSplitPoints[dep] + numSplitPoints[dep-1];
801             coneONew[2+q] = 0;
802           } else {
803             coneNew[2+q]  = v + pMaxNew[dep] + numSplitPoints[dep];
804           }
805           coneONew[2+q] = 0;
806         }
807         ierr = DMPlexSetCone(sdm, hybcell, coneNew);CHKERRQ(ierr);
808         ierr = DMPlexSetConeOrientation(sdm, hybcell, coneONew);CHKERRQ(ierr);
809       } else if (dep == 0) {
810         const PetscInt hybedge = p + pMaxNew[dep+1] + numSplitPoints[dep+1];
811 
812         /* Split old vertex: Edges in old split faces and new cohesive edge */
813         for (e = 0, qn = 0; e < supportSize; ++e) {
814           PetscInt val;
815 
816           ierr = DMLabelGetValue(label, support[e], &val);CHKERRQ(ierr);
817           if ((val == 1) || (val == (shift + 1))) {
818             supportNew[qn++] = support[e] + depthOffset[dep+1];
819           }
820         }
821         supportNew[qn] = hybedge;
822         ierr = DMPlexSetSupport(sdm, newp, supportNew);CHKERRQ(ierr);
823         /* Split new vertex: Edges in new split faces and new cohesive edge */
824         for (e = 0, qp = 0; e < supportSize; ++e) {
825           PetscInt val, edge;
826 
827           ierr = DMLabelGetValue(label, support[e], &val);CHKERRQ(ierr);
828           if (val == 1) {
829             ierr = PetscFindInt(support[e], numSplitPoints[dep+1], splitPoints[dep+1], &edge);CHKERRQ(ierr);
830             if (edge < 0) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Edge %d is not a split edge", support[e]);
831             supportNew[qp++] = edge + pMaxNew[dep+1];
832           } else if (val == -(shift + 1)) {
833             supportNew[qp++] = support[e] + depthOffset[dep+1];
834           }
835         }
836         supportNew[qp] = hybedge;
837         ierr = DMPlexSetSupport(sdm, splitp, supportNew);CHKERRQ(ierr);
838         /* Hybrid edge:    Old and new split vertex */
839         coneNew[0] = newp;
840         coneNew[1] = splitp;
841         ierr = DMPlexSetCone(sdm, hybedge, coneNew);CHKERRQ(ierr);
842         for (e = 0, qf = 0; e < supportSize; ++e) {
843           PetscInt val, edge;
844 
845           ierr = DMLabelGetValue(label, support[e], &val);CHKERRQ(ierr);
846           if (val == 1) {
847             ierr = PetscFindInt(support[e], numSplitPoints[dep+1], splitPoints[dep+1], &edge);CHKERRQ(ierr);
848             if (edge < 0) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Edge %d is not a split edge", support[e]);
849             supportNew[qf++] = edge + pMaxNew[dep+2] + numSplitPoints[dep+2];
850           }
851         }
852         ierr = DMPlexSetSupport(sdm, hybedge, supportNew);CHKERRQ(ierr);
853       } else if (dep == dim-2) {
854         const PetscInt hybface = p + pMaxNew[dep+1] + numSplitPoints[dep+1];
855 
856         /* Split old edge:   old vertices in cone so no change */
857         /* Split new edge:   new vertices in cone */
858         for (q = 0; q < coneSize; ++q) {
859           ierr = PetscFindInt(cone[q], numSplitPoints[dep-1], splitPoints[dep-1], &v);CHKERRQ(ierr);
860 
861           coneNew[q] = v + pMaxNew[dep-1];
862         }
863         ierr = DMPlexSetCone(sdm, splitp, coneNew);CHKERRQ(ierr);
864         /* Split old edge: Faces in positive side cells and old split faces */
865         for (e = 0, q = 0; e < supportSize; ++e) {
866           PetscInt val;
867 
868           ierr = DMLabelGetValue(label, support[e], &val);CHKERRQ(ierr);
869           if (val == dim-1) {
870             supportNew[q++] = support[e] + depthOffset[dep+1];
871           } else if (val == (shift + dim-1)) {
872             supportNew[q++] = support[e] + depthOffset[dep+1];
873           }
874         }
875         supportNew[q++] = p + pMaxNew[dep+1] + numSplitPoints[dep+1];
876         ierr = DMPlexSetSupport(sdm, newp, supportNew);CHKERRQ(ierr);
877         /* Split new edge: Faces in negative side cells and new split faces */
878         for (e = 0, q = 0; e < supportSize; ++e) {
879           PetscInt val, face;
880 
881           ierr = DMLabelGetValue(label, support[e], &val);CHKERRQ(ierr);
882           if (val == dim-1) {
883             ierr = PetscFindInt(support[e], numSplitPoints[dep+1], splitPoints[dep+1], &face);CHKERRQ(ierr);
884             if (face < 0) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Face %d is not a split face", support[e]);
885             supportNew[q++] = face + pMaxNew[dep+1];
886           } else if (val == -(shift + dim-1)) {
887             supportNew[q++] = support[e] + depthOffset[dep+1];
888           }
889         }
890         supportNew[q++] = p + pMaxNew[dep+1] + numSplitPoints[dep+1];
891         ierr = DMPlexSetSupport(sdm, splitp, supportNew);CHKERRQ(ierr);
892         /* Hybrid face */
893         coneNew[0] = newp;
894         coneNew[1] = splitp;
895         for (v = 0; v < coneSize; ++v) {
896           PetscInt vertex;
897           ierr = PetscFindInt(cone[v], numSplitPoints[dep-1], splitPoints[dep-1], &vertex);CHKERRQ(ierr);
898           if (vertex < 0) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Vertex %d is not a split vertex", support[e]);
899           coneNew[2+v] = vertex + pMaxNew[dep] + numSplitPoints[dep];
900         }
901         ierr = DMPlexSetCone(sdm, hybface, coneNew);CHKERRQ(ierr);
902         for (e = 0, qf = 0; e < supportSize; ++e) {
903           PetscInt val, face;
904 
905           ierr = DMLabelGetValue(label, support[e], &val);CHKERRQ(ierr);
906           if (val == dim-1) {
907             ierr = PetscFindInt(support[e], numSplitPoints[dep+1], splitPoints[dep+1], &face);CHKERRQ(ierr);
908             if (face < 0) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Face %d is not a split face", support[e]);
909             supportNew[qf++] = face + pMaxNew[dep+2] + numSplitPoints[dep+2];
910           }
911         }
912         ierr = DMPlexSetSupport(sdm, hybface, supportNew);CHKERRQ(ierr);
913       }
914     }
915   }
916   for (dep = 0; dep <= depth; ++dep) {
917     for (p = 0; p < numUnsplitPoints[dep]; ++p) {
918       const PetscInt  oldp   = unsplitPoints[dep][p];
919       const PetscInt  newp   = oldp + depthOffset[dep];
920       const PetscInt *cone, *support, *ornt;
921       PetscInt        coneSize, supportSize, supportSizeNew, q, qf, e, s;
922 
923       ierr = DMPlexGetConeSize(dm, oldp, &coneSize);CHKERRQ(ierr);
924       ierr = DMPlexGetCone(dm, oldp, &cone);CHKERRQ(ierr);
925       ierr = DMPlexGetConeOrientation(dm, oldp, &ornt);CHKERRQ(ierr);
926       ierr = DMPlexGetSupportSize(dm, oldp, &supportSize);CHKERRQ(ierr);
927       ierr = DMPlexGetSupport(dm, oldp, &support);CHKERRQ(ierr);
928       if (dep == 0) {
929         const PetscInt hybedge = p + pMaxNew[dep+1] + numSplitPoints[dep+1] + numSplitPoints[dep];
930 
931         /* Unsplit vertex */
932         ierr = DMPlexGetSupportSize(sdm, newp, &supportSizeNew);CHKERRQ(ierr);
933         for (s = 0, q = 0; s < supportSize; ++s) {
934           supportNew[q++] = support[s] + depthOffset[dep+1];
935           ierr = PetscFindInt(support[s], numSplitPoints[dep+1], splitPoints[dep+1], &e);CHKERRQ(ierr);
936           if (e >= 0) {
937             supportNew[q++] = e + pMaxNew[dep+1];
938           }
939         }
940         supportNew[q++] = hybedge;
941         supportNew[q++] = hybedge;
942         if (q != supportSizeNew) SETERRQ3(comm, PETSC_ERR_ARG_WRONG, "Support size %d != %d for vertex %d", q, supportSizeNew, newp);
943         ierr = DMPlexSetSupport(sdm, newp, supportNew);CHKERRQ(ierr);
944         /* Hybrid edge */
945         coneNew[0] = newp;
946         coneNew[1] = newp;
947         ierr = DMPlexSetCone(sdm, hybedge, coneNew);CHKERRQ(ierr);
948         for (e = 0, qf = 0; e < supportSize; ++e) {
949           PetscInt val, edge;
950 
951           ierr = DMLabelGetValue(label, support[e], &val);CHKERRQ(ierr);
952           if (val == 1) {
953             ierr = PetscFindInt(support[e], numSplitPoints[dep+1], splitPoints[dep+1], &edge);CHKERRQ(ierr);
954             if (edge < 0) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Edge %d is not a split edge", support[e]);
955             supportNew[qf++] = edge + pMaxNew[dep+2] + numSplitPoints[dep+2];
956           }
957         }
958         ierr = DMPlexSetSupport(sdm, hybedge, supportNew);CHKERRQ(ierr);
959       }
960     }
961   }
962   /* Step 6b: Replace split points in negative side cones */
963   for (sp = 0; sp < numSP; ++sp) {
964     PetscInt        dep = values[sp];
965     IS              pIS;
966     PetscInt        numPoints;
967     const PetscInt *points;
968 
969     if (dep >= 0) continue;
970     ierr = DMLabelGetStratumIS(label, dep, &pIS);CHKERRQ(ierr);
971     if (!pIS) continue;
972     dep  = -dep - shift;
973     ierr = ISGetLocalSize(pIS, &numPoints);CHKERRQ(ierr);
974     ierr = ISGetIndices(pIS, &points);CHKERRQ(ierr);
975     for (p = 0; p < numPoints; ++p) {
976       const PetscInt  oldp = points[p];
977       const PetscInt  newp = depthOffset[dep] + oldp;
978       const PetscInt *cone;
979       PetscInt        coneSize, c;
980       /* PetscBool       replaced = PETSC_FALSE; */
981 
982       /* Negative edge: replace split vertex */
983       /* Negative cell: replace split face */
984       ierr = DMPlexGetConeSize(sdm, newp, &coneSize);CHKERRQ(ierr);
985       ierr = DMPlexGetCone(sdm, newp, &cone);CHKERRQ(ierr);
986       for (c = 0; c < coneSize; ++c) {
987         const PetscInt coldp = cone[c] - depthOffset[dep-1];
988         PetscInt       csplitp, cp, val;
989 
990         ierr = DMLabelGetValue(label, coldp, &val);CHKERRQ(ierr);
991         if (val == dep-1) {
992           ierr = PetscFindInt(coldp, numSplitPoints[dep-1], splitPoints[dep-1], &cp);CHKERRQ(ierr);
993           if (cp < 0) SETERRQ2(comm, PETSC_ERR_ARG_WRONG, "Point %d is not a split point of dimension %d", oldp, dep-1);
994           csplitp  = pMaxNew[dep-1] + cp;
995           ierr     = DMPlexInsertCone(sdm, newp, c, csplitp);CHKERRQ(ierr);
996           /* replaced = PETSC_TRUE; */
997         }
998       }
999       /* Cells with only a vertex or edge on the submesh have no replacement */
1000       /* if (!replaced) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "The cone of point %d does not contain split points", oldp); */
1001     }
1002     ierr = ISRestoreIndices(pIS, &points);CHKERRQ(ierr);
1003     ierr = ISDestroy(&pIS);CHKERRQ(ierr);
1004   }
1005   /* Step 7: Stratify */
1006   ierr = DMPlexStratify(sdm);CHKERRQ(ierr);
1007   /* Step 8: Coordinates */
1008   ierr = DMPlexShiftCoordinates_Internal(dm, depthShift, sdm);CHKERRQ(ierr);
1009   ierr = DMPlexGetCoordinateSection(sdm, &coordSection);CHKERRQ(ierr);
1010   ierr = DMGetCoordinatesLocal(sdm, &coordinates);CHKERRQ(ierr);
1011   ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
1012   for (v = 0; v < (numSplitPoints ? numSplitPoints[0] : 0); ++v) {
1013     const PetscInt newp   = depthOffset[0] + splitPoints[0][v];
1014     const PetscInt splitp = pMaxNew[0] + v;
1015     PetscInt       dof, off, soff, d;
1016 
1017     ierr = PetscSectionGetDof(coordSection, newp, &dof);CHKERRQ(ierr);
1018     ierr = PetscSectionGetOffset(coordSection, newp, &off);CHKERRQ(ierr);
1019     ierr = PetscSectionGetOffset(coordSection, splitp, &soff);CHKERRQ(ierr);
1020     for (d = 0; d < dof; ++d) coords[soff+d] = coords[off+d];
1021   }
1022   ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
1023   /* Step 9: SF, if I can figure this out we can split the mesh in parallel */
1024   ierr = DMPlexShiftSF_Internal(dm, depthShift, sdm);CHKERRQ(ierr);
1025   /* Step 10: Labels */
1026   ierr = DMPlexShiftLabels_Internal(dm, depthShift, sdm);CHKERRQ(ierr);
1027   ierr = DMPlexGetNumLabels(sdm, &numLabels);CHKERRQ(ierr);
1028   for (dep = 0; dep <= depth; ++dep) {
1029     for (p = 0; p < numSplitPoints[dep]; ++p) {
1030       const PetscInt newp   = depthOffset[dep] + splitPoints[dep][p];
1031       const PetscInt splitp = pMaxNew[dep] + p;
1032       PetscInt       l;
1033 
1034       for (l = 0; l < numLabels; ++l) {
1035         DMLabel     mlabel;
1036         const char *lname;
1037         PetscInt    val;
1038         PetscBool   isDepth;
1039 
1040         ierr = DMPlexGetLabelName(sdm, l, &lname);CHKERRQ(ierr);
1041         ierr = PetscStrcmp(lname, "depth", &isDepth);CHKERRQ(ierr);
1042         if (isDepth) continue;
1043         ierr = DMPlexGetLabel(sdm, lname, &mlabel);CHKERRQ(ierr);
1044         ierr = DMLabelGetValue(mlabel, newp, &val);CHKERRQ(ierr);
1045         if (val >= 0) {
1046           ierr = DMLabelSetValue(mlabel, splitp, val);CHKERRQ(ierr);
1047 #if 0
1048           /* Do not put cohesive edges into the label */
1049           if (dep == 0) {
1050             const PetscInt cedge = p + pMaxNew[dep+1] + numSplitPoints[dep+1];
1051             ierr = DMLabelSetValue(mlabel, cedge, val);CHKERRQ(ierr);
1052           } else if (dep == dim-2) {
1053             const PetscInt cface = p + pMaxNew[dep+1] + numSplitPoints[dep+1];
1054             ierr = DMLabelSetValue(mlabel, cface, val);CHKERRQ(ierr);
1055           }
1056           /* Do not put cohesive faces into the label */
1057 #endif
1058         }
1059       }
1060     }
1061   }
1062   for (sp = 0; sp < numSP; ++sp) {
1063     const PetscInt dep = values[sp];
1064 
1065     if ((dep < 0) || (dep > depth)) continue;
1066     if (splitIS[dep]) {ierr = ISRestoreIndices(splitIS[dep], &splitPoints[dep]);CHKERRQ(ierr);}
1067     ierr = ISDestroy(&splitIS[dep]);CHKERRQ(ierr);
1068     if (unsplitIS[dep]) {ierr = ISRestoreIndices(unsplitIS[dep], &unsplitPoints[dep]);CHKERRQ(ierr);}
1069     ierr = ISDestroy(&unsplitIS[dep]);CHKERRQ(ierr);
1070   }
1071   if (label) {
1072     ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
1073     ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
1074   }
1075   for (d = 0; d <= depth; ++d) {
1076     ierr = DMPlexGetDepthStratum(sdm, d, NULL, &pEnd);CHKERRQ(ierr);
1077     pMaxNew[d] = pEnd - numHybridPoints[d];
1078   }
1079   ierr = DMPlexSetHybridBounds(sdm, depth >= 0 ? pMaxNew[depth] : PETSC_DETERMINE, depth>1 ? pMaxNew[depth-1] : PETSC_DETERMINE, depth>2 ? pMaxNew[1] : PETSC_DETERMINE, depth >= 0 ? pMaxNew[0] : PETSC_DETERMINE);CHKERRQ(ierr);
1080   ierr = PetscFree3(depthShift, depthOffset, pMaxNew);CHKERRQ(ierr);
1081   ierr = PetscFree3(coneNew, coneONew, supportNew);CHKERRQ(ierr);
1082   ierr = PetscFree7(splitIS, unsplitIS, numSplitPoints, numUnsplitPoints, numHybridPoints, splitPoints, unsplitPoints);CHKERRQ(ierr);
1083   PetscFunctionReturn(0);
1084 }
1085 
1086 #undef __FUNCT__
1087 #define __FUNCT__ "DMPlexConstructCohesiveCells"
1088 /*@C
1089   DMPlexConstructCohesiveCells - Construct cohesive cells which split the face along an internal interface
1090 
1091   Collective on dm
1092 
1093   Input Parameters:
1094 + dm - The original DM
1095 - label - The label specifying the boundary faces (this could be auto-generated)
1096 
1097   Output Parameters:
1098 - dmSplit - The new DM
1099 
1100   Level: developer
1101 
1102 .seealso: DMCreate(), DMPlexLabelCohesiveComplete()
1103 @*/
1104 PetscErrorCode DMPlexConstructCohesiveCells(DM dm, DMLabel label, DM *dmSplit)
1105 {
1106   DM             sdm;
1107   PetscInt       dim;
1108   PetscErrorCode ierr;
1109 
1110   PetscFunctionBegin;
1111   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1112   PetscValidPointer(dmSplit, 3);
1113   ierr = DMCreate(PetscObjectComm((PetscObject)dm), &sdm);CHKERRQ(ierr);
1114   ierr = DMSetType(sdm, DMPLEX);CHKERRQ(ierr);
1115   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
1116   ierr = DMPlexSetDimension(sdm, dim);CHKERRQ(ierr);
1117   switch (dim) {
1118   case 2:
1119   case 3:
1120     ierr = DMPlexConstructCohesiveCells_Internal(dm, label, sdm);CHKERRQ(ierr);
1121     break;
1122   default:
1123     SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot construct cohesive cells for dimension %d", dim);
1124   }
1125   *dmSplit = sdm;
1126   PetscFunctionReturn(0);
1127 }
1128 
1129 #undef __FUNCT__
1130 #define __FUNCT__ "DMPlexLabelCohesiveComplete"
1131 /*@
1132   DMPlexLabelCohesiveComplete - Starting with a label marking vertices on an internal surface, we add all other mesh pieces
1133   to complete the surface
1134 
1135   Input Parameters:
1136 + dm - The DM
1137 . label - A DMLabel marking the surface vertices
1138 . flip  - Flag to flip the submesh normal and replace points on the other side
1139 - subdm - The subDM associated with the label, or NULL
1140 
1141   Output Parameter:
1142 . label - A DMLabel marking all surface points
1143 
1144   Level: developer
1145 
1146 .seealso: DMPlexConstructCohesiveCells(), DMPlexLabelComplete()
1147 @*/
1148 PetscErrorCode DMPlexLabelCohesiveComplete(DM dm, DMLabel label, PetscBool flip, DM subdm)
1149 {
1150   DMLabel         depthLabel;
1151   IS              dimIS, subpointIS, facePosIS, faceNegIS;
1152   const PetscInt *points, *subpoints;
1153   const PetscInt  rev   = flip ? -1 : 1;
1154   PetscInt        shift = 100, shift2 = 200, dim, dep, cStart, cEnd, numPoints, numSubpoints, p, val;
1155   PetscErrorCode  ierr;
1156 
1157   PetscFunctionBegin;
1158   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
1159   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
1160   if (subdm) {
1161     ierr = DMPlexCreateSubpointIS(subdm, &subpointIS);CHKERRQ(ierr);
1162     if (subpointIS) {
1163       ierr = ISGetLocalSize(subpointIS, &numSubpoints);CHKERRQ(ierr);
1164       ierr = ISGetIndices(subpointIS, &subpoints);CHKERRQ(ierr);
1165     }
1166   }
1167   /* Mark cell on the fault, and its faces which touch the fault: cell orientation for face gives the side of the fault */
1168   ierr = DMLabelGetStratumIS(label, dim-1, &dimIS);CHKERRQ(ierr);
1169   if (!dimIS) PetscFunctionReturn(0);
1170   ierr = ISGetLocalSize(dimIS, &numPoints);CHKERRQ(ierr);
1171   ierr = ISGetIndices(dimIS, &points);CHKERRQ(ierr);
1172   for (p = 0; p < numPoints; ++p) { /* Loop over fault faces */
1173     const PetscInt *support;
1174     PetscInt        supportSize, s;
1175 
1176     ierr = DMPlexGetSupportSize(dm, points[p], &supportSize);CHKERRQ(ierr);
1177     if (supportSize != 2) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Split face %d has %d != 2 supports", points[p], supportSize);
1178     ierr = DMPlexGetSupport(dm, points[p], &support);CHKERRQ(ierr);
1179     for (s = 0; s < supportSize; ++s) {
1180       const PetscInt *cone, *ornt;
1181       PetscInt        coneSize, c;
1182       PetscBool       pos = PETSC_TRUE;
1183 
1184       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
1185       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
1186       ierr = DMPlexGetConeOrientation(dm, support[s], &ornt);CHKERRQ(ierr);
1187       for (c = 0; c < coneSize; ++c) {
1188         if (cone[c] == points[p]) {
1189           PetscInt o = ornt[c];
1190 
1191           if (subdm) {
1192             const PetscInt *subcone, *subornt;
1193             PetscInt        subpoint, subface, subconeSize, sc;
1194 
1195             ierr = PetscFindInt(support[s], numSubpoints, subpoints, &subpoint);CHKERRQ(ierr);
1196             ierr = PetscFindInt(points[p],  numSubpoints, subpoints, &subface);CHKERRQ(ierr);
1197             ierr = DMPlexGetConeSize(subdm, subpoint, &subconeSize);CHKERRQ(ierr);
1198             ierr = DMPlexGetCone(subdm, subpoint, &subcone);CHKERRQ(ierr);
1199             ierr = DMPlexGetConeOrientation(subdm, subpoint, &subornt);CHKERRQ(ierr);
1200             for (sc = 0; sc < subconeSize; ++sc) {
1201               if (subcone[sc] == subface) {
1202                 o = subornt[0];
1203                 break;
1204               }
1205             }
1206             if (sc >= subconeSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not find point %d in cone for subpoint %d", points[p], subpoint);
1207           }
1208           if (o >= 0) {
1209             ierr = DMLabelSetValue(label, support[s],  rev*(shift+dim));CHKERRQ(ierr);
1210             pos  = rev > 0 ? PETSC_TRUE : PETSC_FALSE;
1211           } else {
1212             ierr = DMLabelSetValue(label, support[s], -rev*(shift+dim));CHKERRQ(ierr);
1213             pos  = rev > 0 ? PETSC_FALSE : PETSC_TRUE;
1214           }
1215           break;
1216         }
1217       }
1218       if (c == coneSize) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Cell split face %d support does not have it in the cone", points[p]);
1219       /* Put faces touching the fault in the label */
1220       for (c = 0; c < coneSize; ++c) {
1221         const PetscInt point = cone[c];
1222 
1223         ierr = DMLabelGetValue(label, point, &val);CHKERRQ(ierr);
1224         if (val == -1) {
1225           PetscInt *closure = NULL;
1226           PetscInt  closureSize, cl;
1227 
1228           ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
1229           for (cl = 0; cl < closureSize*2; cl += 2) {
1230             const PetscInt clp = closure[cl];
1231 
1232             ierr = DMLabelGetValue(label, clp, &val);CHKERRQ(ierr);
1233             if ((val >= 0) && (val < dim-1)) {
1234               ierr = DMLabelSetValue(label, point, pos == PETSC_TRUE ? shift+dim-1 : -(shift+dim-1));CHKERRQ(ierr);
1235               break;
1236             }
1237           }
1238           ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
1239         }
1240       }
1241     }
1242   }
1243   if (subdm) {
1244     if (subpointIS) {ierr = ISRestoreIndices(subpointIS, &subpoints);CHKERRQ(ierr);}
1245     ierr = ISDestroy(&subpointIS);CHKERRQ(ierr);
1246   }
1247   ierr = ISRestoreIndices(dimIS, &points);CHKERRQ(ierr);
1248   ierr = ISDestroy(&dimIS);CHKERRQ(ierr);
1249   /* Search for other cells/faces/edges connected to the fault by a vertex */
1250   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1251   ierr = DMLabelGetStratumIS(label, 0, &dimIS);CHKERRQ(ierr);
1252   if (!dimIS) PetscFunctionReturn(0);
1253   ierr = ISGetLocalSize(dimIS, &numPoints);CHKERRQ(ierr);
1254   ierr = ISGetIndices(dimIS, &points);CHKERRQ(ierr);
1255   for (p = 0; p < numPoints; ++p) { /* Loop over fault vertices */
1256     PetscInt *star = NULL;
1257     PetscInt  starSize, s;
1258     PetscInt  again = 1;  /* 0: Finished 1: Keep iterating after a change 2: No change */
1259 
1260     /* All points connected to the fault are inside a cell, so at the top level we will only check cells */
1261     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_FALSE, &starSize, &star);CHKERRQ(ierr);
1262     while (again) {
1263       if (again > 1) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Could not classify all cells connected to the fault");
1264       again = 0;
1265       for (s = 0; s < starSize*2; s += 2) {
1266         const PetscInt  point = star[s];
1267         const PetscInt *cone;
1268         PetscInt        coneSize, c;
1269 
1270         if ((point < cStart) || (point >= cEnd)) continue;
1271         ierr = DMLabelGetValue(label, point, &val);CHKERRQ(ierr);
1272         if (val != -1) continue;
1273         again = again == 1 ? 1 : 2;
1274         ierr  = DMPlexGetConeSize(dm, point, &coneSize);CHKERRQ(ierr);
1275         ierr  = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
1276         for (c = 0; c < coneSize; ++c) {
1277           ierr = DMLabelGetValue(label, cone[c], &val);CHKERRQ(ierr);
1278           if (val != -1) {
1279             const PetscInt *ccone;
1280             PetscInt        cconeSize, cc, side;
1281 
1282             if (abs(val) < shift) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Face %d on cell %d has an invalid label %d", cone[c], point, val);
1283             if (val > 0) side =  1;
1284             else         side = -1;
1285             ierr = DMLabelSetValue(label, point, side*(shift+dim));CHKERRQ(ierr);
1286             /* Mark cell faces which touch the fault */
1287             ierr = DMPlexGetConeSize(dm, point, &cconeSize);CHKERRQ(ierr);
1288             ierr = DMPlexGetCone(dm, point, &ccone);CHKERRQ(ierr);
1289             for (cc = 0; cc < cconeSize; ++cc) {
1290               PetscInt *closure = NULL;
1291               PetscInt  closureSize, cl;
1292 
1293               ierr = DMLabelGetValue(label, ccone[cc], &val);CHKERRQ(ierr);
1294               if (val != -1) continue;
1295               ierr = DMPlexGetTransitiveClosure(dm, ccone[cc], PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
1296               for (cl = 0; cl < closureSize*2; cl += 2) {
1297                 const PetscInt clp = closure[cl];
1298 
1299                 ierr = DMLabelGetValue(label, clp, &val);CHKERRQ(ierr);
1300                 if (val == -1) continue;
1301                 ierr = DMLabelSetValue(label, ccone[cc], side*(shift+dim-1));CHKERRQ(ierr);
1302                 break;
1303               }
1304               ierr = DMPlexRestoreTransitiveClosure(dm, ccone[cc], PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
1305             }
1306             again = 1;
1307             break;
1308           }
1309         }
1310       }
1311     }
1312     /* Classify the rest by cell membership */
1313     for (s = 0; s < starSize*2; s += 2) {
1314       const PetscInt point = star[s];
1315 
1316       ierr = DMLabelGetValue(label, point, &val);CHKERRQ(ierr);
1317       if (val == -1) {
1318         PetscInt  *sstar = NULL;
1319         PetscInt   sstarSize, ss;
1320         PetscBool  marked = PETSC_FALSE;
1321 
1322         ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_FALSE, &sstarSize, &sstar);CHKERRQ(ierr);
1323         for (ss = 0; ss < sstarSize*2; ss += 2) {
1324           const PetscInt spoint = sstar[ss];
1325 
1326           if ((spoint < cStart) || (spoint >= cEnd)) continue;
1327           ierr = DMLabelGetValue(label, spoint, &val);CHKERRQ(ierr);
1328           if (val == -1) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Cell %d in star of %d does not have a valid label", spoint, point);
1329           ierr = DMLabelGetValue(depthLabel, point, &dep);CHKERRQ(ierr);
1330           if (val > 0) {
1331             ierr = DMLabelSetValue(label, point,   shift+dep);CHKERRQ(ierr);
1332           } else {
1333             ierr = DMLabelSetValue(label, point, -(shift+dep));CHKERRQ(ierr);
1334           }
1335           marked = PETSC_TRUE;
1336           break;
1337         }
1338         ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_FALSE, &sstarSize, &sstar);CHKERRQ(ierr);
1339         if (!marked) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Point %d could not be classified", point);
1340       }
1341     }
1342     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_FALSE, &starSize, &star);CHKERRQ(ierr);
1343   }
1344   ierr = ISRestoreIndices(dimIS, &points);CHKERRQ(ierr);
1345   ierr = ISDestroy(&dimIS);CHKERRQ(ierr);
1346   /* If any faces touching the fault divide cells on either side, split them */
1347   ierr = DMLabelGetStratumIS(label,   shift+dim-1,  &facePosIS);CHKERRQ(ierr);
1348   ierr = DMLabelGetStratumIS(label, -(shift+dim-1), &faceNegIS);CHKERRQ(ierr);
1349   ierr = ISExpand(facePosIS, faceNegIS, &dimIS);CHKERRQ(ierr);
1350   ierr = ISDestroy(&facePosIS);CHKERRQ(ierr);
1351   ierr = ISDestroy(&faceNegIS);CHKERRQ(ierr);
1352   ierr = ISGetLocalSize(dimIS, &numPoints);CHKERRQ(ierr);
1353   ierr = ISGetIndices(dimIS, &points);CHKERRQ(ierr);
1354   for (p = 0; p < numPoints; ++p) {
1355     const PetscInt  point = points[p];
1356     const PetscInt *support;
1357     PetscInt        supportSize, valA, valB;
1358 
1359     ierr = DMPlexGetSupportSize(dm, point, &supportSize);CHKERRQ(ierr);
1360     if (supportSize != 2) continue;
1361     ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
1362     ierr = DMLabelGetValue(label, support[0], &valA);CHKERRQ(ierr);
1363     ierr = DMLabelGetValue(label, support[1], &valB);CHKERRQ(ierr);
1364     if ((valA == -1) || (valB == -1)) continue;
1365     if (valA*valB > 0) continue;
1366     /* Split the face */
1367     ierr = DMLabelGetValue(label, point, &valA);CHKERRQ(ierr);
1368     ierr = DMLabelClearValue(label, point, valA);CHKERRQ(ierr);
1369     ierr = DMLabelSetValue(label, point, dim-1);CHKERRQ(ierr);
1370     /* Label its closure as unsplit */
1371     {
1372       PetscInt *closure = NULL;
1373       PetscInt  closureSize, cl;
1374 
1375       ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
1376       for (cl = 0; cl < closureSize*2; cl += 2) {
1377         ierr = DMLabelGetValue(label, closure[cl], &valA);CHKERRQ(ierr);
1378         if (valA != -1) continue;
1379         ierr = DMLabelGetValue(depthLabel, closure[cl], &dep);CHKERRQ(ierr);
1380         ierr = DMLabelSetValue(label, closure[cl], shift2+dep);CHKERRQ(ierr);
1381       }
1382       ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
1383     }
1384   }
1385   ierr = ISRestoreIndices(dimIS, &points);CHKERRQ(ierr);
1386   ierr = ISDestroy(&dimIS);CHKERRQ(ierr);
1387   PetscFunctionReturn(0);
1388 }
1389 
1390 #undef __FUNCT__
1391 #define __FUNCT__ "DMPlexCreateHybridMesh"
1392 /*@C
1393   DMPlexCreateHybridMesh - Create a mesh with hybrid cells along an internal interface
1394 
1395   Collective on dm
1396 
1397   Input Parameters:
1398 + dm - The original DM
1399 - labelName - The label specifying the interface vertices
1400 
1401   Output Parameters:
1402 + hybridLabel - The label fully marking the interface
1403 - dmHybrid - The new DM
1404 
1405   Level: developer
1406 
1407 .seealso: DMPlexConstructCohesiveCells(), DMPlexLabelCohesiveComplete(), DMCreate()
1408 @*/
1409 PetscErrorCode DMPlexCreateHybridMesh(DM dm, DMLabel label, DMLabel *hybridLabel, DM *dmHybrid)
1410 {
1411   DM             idm;
1412   DMLabel        subpointMap, hlabel;
1413   PetscInt       dim;
1414   PetscErrorCode ierr;
1415 
1416   PetscFunctionBegin;
1417   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1418   if (hybridLabel) PetscValidPointer(hybridLabel, 3);
1419   PetscValidPointer(dmHybrid, 4);
1420   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
1421   ierr = DMPlexCreateSubmesh(dm, label, 1, &idm);CHKERRQ(ierr);
1422   ierr = DMPlexOrient(idm);CHKERRQ(ierr);
1423   ierr = DMPlexGetSubpointMap(idm, &subpointMap);CHKERRQ(ierr);
1424   ierr = DMLabelDuplicate(subpointMap, &hlabel);CHKERRQ(ierr);
1425   ierr = DMLabelClearStratum(hlabel, dim);CHKERRQ(ierr);
1426   ierr = DMPlexLabelCohesiveComplete(dm, hlabel, PETSC_FALSE, idm);CHKERRQ(ierr);
1427   ierr = DMDestroy(&idm);CHKERRQ(ierr);
1428   ierr = DMPlexConstructCohesiveCells(dm, hlabel, dmHybrid);CHKERRQ(ierr);
1429   if (hybridLabel) *hybridLabel = hlabel;
1430   else             {ierr = DMLabelDestroy(&hlabel);CHKERRQ(ierr);}
1431   PetscFunctionReturn(0);
1432 }
1433 
1434 #undef __FUNCT__
1435 #define __FUNCT__ "DMPlexMarkSubmesh_Uninterpolated"
1436 /* Here we need the explicit assumption that:
1437 
1438      For any marked cell, the marked vertices constitute a single face
1439 */
1440 static PetscErrorCode DMPlexMarkSubmesh_Uninterpolated(DM dm, DMLabel vertexLabel, PetscInt value, DMLabel subpointMap, PetscInt *numFaces, PetscInt *nFV, DM subdm)
1441 {
1442   IS               subvertexIS = NULL;
1443   const PetscInt  *subvertices;
1444   PetscInt        *pStart, *pEnd, *pMax, pSize;
1445   PetscInt         depth, dim, d, numSubVerticesInitial = 0, v;
1446   PetscErrorCode   ierr;
1447 
1448   PetscFunctionBegin;
1449   *numFaces = 0;
1450   *nFV      = 0;
1451   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1452   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
1453   pSize = PetscMax(depth, dim) + 1;
1454   ierr = PetscMalloc3(pSize,&pStart,pSize,&pEnd,pSize,&pMax);CHKERRQ(ierr);
1455   ierr = DMPlexGetHybridBounds(dm, depth >= 0 ? &pMax[depth] : NULL, depth>1 ? &pMax[depth-1] : NULL, depth>2 ? &pMax[1] : NULL, &pMax[0]);CHKERRQ(ierr);
1456   for (d = 0; d <= depth; ++d) {
1457     ierr = DMPlexGetDepthStratum(dm, d, &pStart[d], &pEnd[d]);CHKERRQ(ierr);
1458     if (pMax[d] >= 0) pEnd[d] = PetscMin(pEnd[d], pMax[d]);
1459   }
1460   /* Loop over initial vertices and mark all faces in the collective star() */
1461   if (vertexLabel) {ierr = DMLabelGetStratumIS(vertexLabel, value, &subvertexIS);CHKERRQ(ierr);}
1462   if (subvertexIS) {
1463     ierr = ISGetSize(subvertexIS, &numSubVerticesInitial);CHKERRQ(ierr);
1464     ierr = ISGetIndices(subvertexIS, &subvertices);CHKERRQ(ierr);
1465   }
1466   for (v = 0; v < numSubVerticesInitial; ++v) {
1467     const PetscInt vertex = subvertices[v];
1468     PetscInt      *star   = NULL;
1469     PetscInt       starSize, s, numCells = 0, c;
1470 
1471     ierr = DMPlexGetTransitiveClosure(dm, vertex, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr);
1472     for (s = 0; s < starSize*2; s += 2) {
1473       const PetscInt point = star[s];
1474       if ((point >= pStart[depth]) && (point < pEnd[depth])) star[numCells++] = point;
1475     }
1476     for (c = 0; c < numCells; ++c) {
1477       const PetscInt cell    = star[c];
1478       PetscInt      *closure = NULL;
1479       PetscInt       closureSize, cl;
1480       PetscInt       cellLoc, numCorners = 0, faceSize = 0;
1481 
1482       ierr = DMLabelGetValue(subpointMap, cell, &cellLoc);CHKERRQ(ierr);
1483       if (cellLoc == 2) continue;
1484       if (cellLoc >= 0) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Cell %d has dimension %d in the surface label", cell, cellLoc);
1485       ierr = DMPlexGetTransitiveClosure(dm, cell, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
1486       for (cl = 0; cl < closureSize*2; cl += 2) {
1487         const PetscInt point = closure[cl];
1488         PetscInt       vertexLoc;
1489 
1490         if ((point >= pStart[0]) && (point < pEnd[0])) {
1491           ++numCorners;
1492           ierr = DMLabelGetValue(vertexLabel, point, &vertexLoc);CHKERRQ(ierr);
1493           if (vertexLoc == value) closure[faceSize++] = point;
1494         }
1495       }
1496       if (!(*nFV)) {ierr = DMPlexGetNumFaceVertices(dm, dim, numCorners, nFV);CHKERRQ(ierr);}
1497       if (faceSize > *nFV) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Invalid submesh: Too many vertices %d of an element on the surface", faceSize);
1498       if (faceSize == *nFV) {
1499         const PetscInt *cells = NULL;
1500         PetscInt        numCells, nc;
1501 
1502         ++(*numFaces);
1503         for (cl = 0; cl < faceSize; ++cl) {
1504           ierr = DMLabelSetValue(subpointMap, closure[cl], 0);CHKERRQ(ierr);
1505         }
1506         ierr = DMPlexGetJoin(dm, faceSize, closure, &numCells, &cells);CHKERRQ(ierr);
1507         for (nc = 0; nc < numCells; ++nc) {
1508           ierr = DMLabelSetValue(subpointMap, cells[nc], 2);CHKERRQ(ierr);
1509         }
1510         ierr = DMPlexRestoreJoin(dm, faceSize, closure, &numCells, &cells);CHKERRQ(ierr);
1511       }
1512       ierr = DMPlexRestoreTransitiveClosure(dm, cell, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
1513     }
1514     ierr = DMPlexRestoreTransitiveClosure(dm, vertex, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr);
1515   }
1516   if (subvertexIS) {
1517     ierr = ISRestoreIndices(subvertexIS, &subvertices);CHKERRQ(ierr);
1518   }
1519   ierr = ISDestroy(&subvertexIS);CHKERRQ(ierr);
1520   ierr = PetscFree3(pStart,pEnd,pMax);CHKERRQ(ierr);
1521   PetscFunctionReturn(0);
1522 }
1523 
1524 #undef __FUNCT__
1525 #define __FUNCT__ "DMPlexMarkSubmesh_Interpolated"
1526 static PetscErrorCode DMPlexMarkSubmesh_Interpolated(DM dm, DMLabel vertexLabel, PetscInt value, DMLabel subpointMap, DM subdm)
1527 {
1528   IS               subvertexIS;
1529   const PetscInt  *subvertices;
1530   PetscInt        *pStart, *pEnd, *pMax;
1531   PetscInt         dim, d, numSubVerticesInitial = 0, v;
1532   PetscErrorCode   ierr;
1533 
1534   PetscFunctionBegin;
1535   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
1536   ierr = PetscMalloc3(dim+1,&pStart,dim+1,&pEnd,dim+1,&pMax);CHKERRQ(ierr);
1537   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], dim>1 ? &pMax[dim-1] : NULL, dim > 2 ? &pMax[1] : NULL, &pMax[0]);CHKERRQ(ierr);
1538   for (d = 0; d <= dim; ++d) {
1539     ierr = DMPlexGetDepthStratum(dm, d, &pStart[d], &pEnd[d]);CHKERRQ(ierr);
1540     if (pMax[d] >= 0) pEnd[d] = PetscMin(pEnd[d], pMax[d]);
1541   }
1542   /* Loop over initial vertices and mark all faces in the collective star() */
1543   ierr = DMLabelGetStratumIS(vertexLabel, value, &subvertexIS);CHKERRQ(ierr);
1544   if (subvertexIS) {
1545     ierr = ISGetSize(subvertexIS, &numSubVerticesInitial);CHKERRQ(ierr);
1546     ierr = ISGetIndices(subvertexIS, &subvertices);CHKERRQ(ierr);
1547   }
1548   for (v = 0; v < numSubVerticesInitial; ++v) {
1549     const PetscInt vertex = subvertices[v];
1550     PetscInt      *star   = NULL;
1551     PetscInt       starSize, s, numFaces = 0, f;
1552 
1553     ierr = DMPlexGetTransitiveClosure(dm, vertex, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr);
1554     for (s = 0; s < starSize*2; s += 2) {
1555       const PetscInt point = star[s];
1556       if ((point >= pStart[dim-1]) && (point < pEnd[dim-1])) star[numFaces++] = point;
1557     }
1558     for (f = 0; f < numFaces; ++f) {
1559       const PetscInt face    = star[f];
1560       PetscInt      *closure = NULL;
1561       PetscInt       closureSize, c;
1562       PetscInt       faceLoc;
1563 
1564       ierr = DMLabelGetValue(subpointMap, face, &faceLoc);CHKERRQ(ierr);
1565       if (faceLoc == dim-1) continue;
1566       if (faceLoc >= 0) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Face %d has dimension %d in the surface label", face, faceLoc);
1567       ierr = DMPlexGetTransitiveClosure(dm, face, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
1568       for (c = 0; c < closureSize*2; c += 2) {
1569         const PetscInt point = closure[c];
1570         PetscInt       vertexLoc;
1571 
1572         if ((point >= pStart[0]) && (point < pEnd[0])) {
1573           ierr = DMLabelGetValue(vertexLabel, point, &vertexLoc);CHKERRQ(ierr);
1574           if (vertexLoc != value) break;
1575         }
1576       }
1577       if (c == closureSize*2) {
1578         const PetscInt *support;
1579         PetscInt        supportSize, s;
1580 
1581         for (c = 0; c < closureSize*2; c += 2) {
1582           const PetscInt point = closure[c];
1583 
1584           for (d = 0; d < dim; ++d) {
1585             if ((point >= pStart[d]) && (point < pEnd[d])) {
1586               ierr = DMLabelSetValue(subpointMap, point, d);CHKERRQ(ierr);
1587               break;
1588             }
1589           }
1590         }
1591         ierr = DMPlexGetSupportSize(dm, face, &supportSize);CHKERRQ(ierr);
1592         ierr = DMPlexGetSupport(dm, face, &support);CHKERRQ(ierr);
1593         for (s = 0; s < supportSize; ++s) {
1594           ierr = DMLabelSetValue(subpointMap, support[s], dim);CHKERRQ(ierr);
1595         }
1596       }
1597       ierr = DMPlexRestoreTransitiveClosure(dm, face, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
1598     }
1599     ierr = DMPlexRestoreTransitiveClosure(dm, vertex, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr);
1600   }
1601   if (subvertexIS) {
1602     ierr = ISRestoreIndices(subvertexIS, &subvertices);CHKERRQ(ierr);
1603   }
1604   ierr = ISDestroy(&subvertexIS);CHKERRQ(ierr);
1605   ierr = PetscFree3(pStart,pEnd,pMax);CHKERRQ(ierr);
1606   PetscFunctionReturn(0);
1607 }
1608 
1609 #undef __FUNCT__
1610 #define __FUNCT__ "DMPlexMarkCohesiveSubmesh_Uninterpolated"
1611 static PetscErrorCode DMPlexMarkCohesiveSubmesh_Uninterpolated(DM dm, PetscBool hasLagrange, const char labelname[], PetscInt value, DMLabel subpointMap, PetscInt *numFaces, PetscInt *nFV, PetscInt *subCells[], DM subdm)
1612 {
1613   DMLabel         label = NULL;
1614   const PetscInt *cone;
1615   PetscInt        dim, cMax, cEnd, c, subc = 0, p, coneSize;
1616   PetscErrorCode  ierr;
1617 
1618   PetscFunctionBegin;
1619   *numFaces = 0;
1620   *nFV = 0;
1621   if (labelname) {ierr = DMPlexGetLabel(dm, labelname, &label);CHKERRQ(ierr);}
1622   *subCells = NULL;
1623   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
1624   ierr = DMPlexGetHeightStratum(dm, 0, NULL, &cEnd);CHKERRQ(ierr);
1625   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
1626   if (cMax < 0) PetscFunctionReturn(0);
1627   if (label) {
1628     for (c = cMax; c < cEnd; ++c) {
1629       PetscInt val;
1630 
1631       ierr = DMLabelGetValue(label, c, &val);CHKERRQ(ierr);
1632       if (val == value) {
1633         ++(*numFaces);
1634         ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
1635       }
1636     }
1637   } else {
1638     *numFaces = cEnd - cMax;
1639     ierr = DMPlexGetConeSize(dm, cMax, &coneSize);CHKERRQ(ierr);
1640   }
1641   *nFV = hasLagrange ? coneSize/3 : coneSize/2;
1642   ierr = PetscMalloc1(*numFaces *2, subCells);CHKERRQ(ierr);
1643   for (c = cMax; c < cEnd; ++c) {
1644     const PetscInt *cells;
1645     PetscInt        numCells;
1646 
1647     if (label) {
1648       PetscInt val;
1649 
1650       ierr = DMLabelGetValue(label, c, &val);CHKERRQ(ierr);
1651       if (val != value) continue;
1652     }
1653     ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
1654     for (p = 0; p < *nFV; ++p) {
1655       ierr = DMLabelSetValue(subpointMap, cone[p], 0);CHKERRQ(ierr);
1656     }
1657     /* Negative face */
1658     ierr = DMPlexGetJoin(dm, *nFV, cone, &numCells, &cells);CHKERRQ(ierr);
1659     /* Not true in parallel
1660     if (numCells != 2) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cohesive cells should separate two cells"); */
1661     for (p = 0; p < numCells; ++p) {
1662       ierr = DMLabelSetValue(subpointMap, cells[p], 2);CHKERRQ(ierr);
1663       (*subCells)[subc++] = cells[p];
1664     }
1665     ierr = DMPlexRestoreJoin(dm, *nFV, cone, &numCells, &cells);CHKERRQ(ierr);
1666     /* Positive face is not included */
1667   }
1668   PetscFunctionReturn(0);
1669 }
1670 
1671 #undef __FUNCT__
1672 #define __FUNCT__ "DMPlexMarkCohesiveSubmesh_Interpolated"
1673 static PetscErrorCode DMPlexMarkCohesiveSubmesh_Interpolated(DM dm, const char labelname[], PetscInt value, DMLabel subpointMap, DM subdm)
1674 {
1675   DMLabel        label = NULL;
1676   PetscInt      *pStart, *pEnd;
1677   PetscInt       dim, cMax, cEnd, c, d;
1678   PetscErrorCode ierr;
1679 
1680   PetscFunctionBegin;
1681   if (labelname) {ierr = DMPlexGetLabel(dm, labelname, &label);CHKERRQ(ierr);}
1682   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
1683   ierr = DMPlexGetHeightStratum(dm, 0, NULL, &cEnd);CHKERRQ(ierr);
1684   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
1685   if (cMax < 0) PetscFunctionReturn(0);
1686   ierr = PetscMalloc2(dim+1,&pStart,dim+1,&pEnd);CHKERRQ(ierr);
1687   for (d = 0; d <= dim; ++d) {ierr = DMPlexGetDepthStratum(dm, d, &pStart[d], &pEnd[d]);CHKERRQ(ierr);}
1688   for (c = cMax; c < cEnd; ++c) {
1689     const PetscInt *cone;
1690     PetscInt       *closure = NULL;
1691     PetscInt        fconeSize, coneSize, closureSize, cl, val;
1692 
1693     if (label) {
1694       ierr = DMLabelGetValue(label, c, &val);CHKERRQ(ierr);
1695       if (val != value) continue;
1696     }
1697     ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
1698     ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
1699     ierr = DMPlexGetConeSize(dm, cone[0], &fconeSize);CHKERRQ(ierr);
1700     if (coneSize != (fconeSize ? fconeSize : 1) + 2) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cohesive cells should separate two cells");
1701     /* Negative face */
1702     ierr = DMPlexGetTransitiveClosure(dm, cone[0], PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
1703     for (cl = 0; cl < closureSize*2; cl += 2) {
1704       const PetscInt point = closure[cl];
1705 
1706       for (d = 0; d <= dim; ++d) {
1707         if ((point >= pStart[d]) && (point < pEnd[d])) {
1708           ierr = DMLabelSetValue(subpointMap, point, d);CHKERRQ(ierr);
1709           break;
1710         }
1711       }
1712     }
1713     ierr = DMPlexRestoreTransitiveClosure(dm, cone[0], PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
1714     /* Cells -- positive face is not included */
1715     for (cl = 0; cl < 1; ++cl) {
1716       const PetscInt *support;
1717       PetscInt        supportSize, s;
1718 
1719       ierr = DMPlexGetSupportSize(dm, cone[cl], &supportSize);CHKERRQ(ierr);
1720       /* if (supportSize != 2) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cohesive faces should separate two cells"); */
1721       ierr = DMPlexGetSupport(dm, cone[cl], &support);CHKERRQ(ierr);
1722       for (s = 0; s < supportSize; ++s) {
1723         ierr = DMLabelSetValue(subpointMap, support[s], dim);CHKERRQ(ierr);
1724       }
1725     }
1726   }
1727   ierr = PetscFree2(pStart, pEnd);CHKERRQ(ierr);
1728   PetscFunctionReturn(0);
1729 }
1730 
1731 #undef __FUNCT__
1732 #define __FUNCT__ "DMPlexGetFaceOrientation"
1733 PetscErrorCode DMPlexGetFaceOrientation(DM dm, PetscInt cell, PetscInt numCorners, PetscInt indices[], PetscInt oppositeVertex, PetscInt origVertices[], PetscInt faceVertices[], PetscBool *posOriented)
1734 {
1735   MPI_Comm       comm;
1736   PetscBool      posOrient = PETSC_FALSE;
1737   const PetscInt debug     = 0;
1738   PetscInt       cellDim, faceSize, f;
1739   PetscErrorCode ierr;
1740 
1741   PetscFunctionBegin;
1742   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
1743   ierr = DMPlexGetDimension(dm, &cellDim);CHKERRQ(ierr);
1744   if (debug) {PetscPrintf(comm, "cellDim: %d numCorners: %d\n", cellDim, numCorners);CHKERRQ(ierr);}
1745 
1746   if (cellDim == 1 && numCorners == 2) {
1747     /* Triangle */
1748     faceSize  = numCorners-1;
1749     posOrient = !(oppositeVertex%2) ? PETSC_TRUE : PETSC_FALSE;
1750   } else if (cellDim == 2 && numCorners == 3) {
1751     /* Triangle */
1752     faceSize  = numCorners-1;
1753     posOrient = !(oppositeVertex%2) ? PETSC_TRUE : PETSC_FALSE;
1754   } else if (cellDim == 3 && numCorners == 4) {
1755     /* Tetrahedron */
1756     faceSize  = numCorners-1;
1757     posOrient = (oppositeVertex%2) ? PETSC_TRUE : PETSC_FALSE;
1758   } else if (cellDim == 1 && numCorners == 3) {
1759     /* Quadratic line */
1760     faceSize  = 1;
1761     posOrient = PETSC_TRUE;
1762   } else if (cellDim == 2 && numCorners == 4) {
1763     /* Quads */
1764     faceSize = 2;
1765     if ((indices[1] > indices[0]) && (indices[1] - indices[0] == 1)) {
1766       posOrient = PETSC_TRUE;
1767     } else if ((indices[0] == 3) && (indices[1] == 0)) {
1768       posOrient = PETSC_TRUE;
1769     } else {
1770       if (((indices[0] > indices[1]) && (indices[0] - indices[1] == 1)) || ((indices[0] == 0) && (indices[1] == 3))) {
1771         posOrient = PETSC_FALSE;
1772       } else SETERRQ(comm, PETSC_ERR_ARG_WRONG, "Invalid quad crossedge");
1773     }
1774   } else if (cellDim == 2 && numCorners == 6) {
1775     /* Quadratic triangle (I hate this) */
1776     /* Edges are determined by the first 2 vertices (corners of edges) */
1777     const PetscInt faceSizeTri = 3;
1778     PetscInt       sortedIndices[3], i, iFace;
1779     PetscBool      found                    = PETSC_FALSE;
1780     PetscInt       faceVerticesTriSorted[9] = {
1781       0, 3,  4, /* bottom */
1782       1, 4,  5, /* right */
1783       2, 3,  5, /* left */
1784     };
1785     PetscInt       faceVerticesTri[9] = {
1786       0, 3,  4, /* bottom */
1787       1, 4,  5, /* right */
1788       2, 5,  3, /* left */
1789     };
1790 
1791     faceSize = faceSizeTri;
1792     for (i = 0; i < faceSizeTri; ++i) sortedIndices[i] = indices[i];
1793     ierr = PetscSortInt(faceSizeTri, sortedIndices);CHKERRQ(ierr);
1794     for (iFace = 0; iFace < 3; ++iFace) {
1795       const PetscInt ii = iFace*faceSizeTri;
1796       PetscInt       fVertex, cVertex;
1797 
1798       if ((sortedIndices[0] == faceVerticesTriSorted[ii+0]) &&
1799           (sortedIndices[1] == faceVerticesTriSorted[ii+1])) {
1800         for (fVertex = 0; fVertex < faceSizeTri; ++fVertex) {
1801           for (cVertex = 0; cVertex < faceSizeTri; ++cVertex) {
1802             if (indices[cVertex] == faceVerticesTri[ii+fVertex]) {
1803               faceVertices[fVertex] = origVertices[cVertex];
1804               break;
1805             }
1806           }
1807         }
1808         found = PETSC_TRUE;
1809         break;
1810       }
1811     }
1812     if (!found) SETERRQ(comm, PETSC_ERR_ARG_WRONG, "Invalid tri crossface");
1813     if (posOriented) *posOriented = PETSC_TRUE;
1814     PetscFunctionReturn(0);
1815   } else if (cellDim == 2 && numCorners == 9) {
1816     /* Quadratic quad (I hate this) */
1817     /* Edges are determined by the first 2 vertices (corners of edges) */
1818     const PetscInt faceSizeQuad = 3;
1819     PetscInt       sortedIndices[3], i, iFace;
1820     PetscBool      found                      = PETSC_FALSE;
1821     PetscInt       faceVerticesQuadSorted[12] = {
1822       0, 1,  4, /* bottom */
1823       1, 2,  5, /* right */
1824       2, 3,  6, /* top */
1825       0, 3,  7, /* left */
1826     };
1827     PetscInt       faceVerticesQuad[12] = {
1828       0, 1,  4, /* bottom */
1829       1, 2,  5, /* right */
1830       2, 3,  6, /* top */
1831       3, 0,  7, /* left */
1832     };
1833 
1834     faceSize = faceSizeQuad;
1835     for (i = 0; i < faceSizeQuad; ++i) sortedIndices[i] = indices[i];
1836     ierr = PetscSortInt(faceSizeQuad, sortedIndices);CHKERRQ(ierr);
1837     for (iFace = 0; iFace < 4; ++iFace) {
1838       const PetscInt ii = iFace*faceSizeQuad;
1839       PetscInt       fVertex, cVertex;
1840 
1841       if ((sortedIndices[0] == faceVerticesQuadSorted[ii+0]) &&
1842           (sortedIndices[1] == faceVerticesQuadSorted[ii+1])) {
1843         for (fVertex = 0; fVertex < faceSizeQuad; ++fVertex) {
1844           for (cVertex = 0; cVertex < faceSizeQuad; ++cVertex) {
1845             if (indices[cVertex] == faceVerticesQuad[ii+fVertex]) {
1846               faceVertices[fVertex] = origVertices[cVertex];
1847               break;
1848             }
1849           }
1850         }
1851         found = PETSC_TRUE;
1852         break;
1853       }
1854     }
1855     if (!found) SETERRQ(comm, PETSC_ERR_ARG_WRONG, "Invalid quad crossface");
1856     if (posOriented) *posOriented = PETSC_TRUE;
1857     PetscFunctionReturn(0);
1858   } else if (cellDim == 3 && numCorners == 8) {
1859     /* Hexes
1860        A hex is two oriented quads with the normal of the first
1861        pointing up at the second.
1862 
1863           7---6
1864          /|  /|
1865         4---5 |
1866         | 1-|-2
1867         |/  |/
1868         0---3
1869 
1870         Faces are determined by the first 4 vertices (corners of faces) */
1871     const PetscInt faceSizeHex = 4;
1872     PetscInt       sortedIndices[4], i, iFace;
1873     PetscBool      found                     = PETSC_FALSE;
1874     PetscInt       faceVerticesHexSorted[24] = {
1875       0, 1, 2, 3,  /* bottom */
1876       4, 5, 6, 7,  /* top */
1877       0, 3, 4, 5,  /* front */
1878       2, 3, 5, 6,  /* right */
1879       1, 2, 6, 7,  /* back */
1880       0, 1, 4, 7,  /* left */
1881     };
1882     PetscInt       faceVerticesHex[24] = {
1883       1, 2, 3, 0,  /* bottom */
1884       4, 5, 6, 7,  /* top */
1885       0, 3, 5, 4,  /* front */
1886       3, 2, 6, 5,  /* right */
1887       2, 1, 7, 6,  /* back */
1888       1, 0, 4, 7,  /* left */
1889     };
1890 
1891     faceSize = faceSizeHex;
1892     for (i = 0; i < faceSizeHex; ++i) sortedIndices[i] = indices[i];
1893     ierr = PetscSortInt(faceSizeHex, sortedIndices);CHKERRQ(ierr);
1894     for (iFace = 0; iFace < 6; ++iFace) {
1895       const PetscInt ii = iFace*faceSizeHex;
1896       PetscInt       fVertex, cVertex;
1897 
1898       if ((sortedIndices[0] == faceVerticesHexSorted[ii+0]) &&
1899           (sortedIndices[1] == faceVerticesHexSorted[ii+1]) &&
1900           (sortedIndices[2] == faceVerticesHexSorted[ii+2]) &&
1901           (sortedIndices[3] == faceVerticesHexSorted[ii+3])) {
1902         for (fVertex = 0; fVertex < faceSizeHex; ++fVertex) {
1903           for (cVertex = 0; cVertex < faceSizeHex; ++cVertex) {
1904             if (indices[cVertex] == faceVerticesHex[ii+fVertex]) {
1905               faceVertices[fVertex] = origVertices[cVertex];
1906               break;
1907             }
1908           }
1909         }
1910         found = PETSC_TRUE;
1911         break;
1912       }
1913     }
1914     if (!found) SETERRQ(comm, PETSC_ERR_ARG_WRONG, "Invalid hex crossface");
1915     if (posOriented) *posOriented = PETSC_TRUE;
1916     PetscFunctionReturn(0);
1917   } else if (cellDim == 3 && numCorners == 10) {
1918     /* Quadratic tet */
1919     /* Faces are determined by the first 3 vertices (corners of faces) */
1920     const PetscInt faceSizeTet = 6;
1921     PetscInt       sortedIndices[6], i, iFace;
1922     PetscBool      found                     = PETSC_FALSE;
1923     PetscInt       faceVerticesTetSorted[24] = {
1924       0, 1, 2,  6, 7, 8, /* bottom */
1925       0, 3, 4,  6, 7, 9,  /* front */
1926       1, 4, 5,  7, 8, 9,  /* right */
1927       2, 3, 5,  6, 8, 9,  /* left */
1928     };
1929     PetscInt       faceVerticesTet[24] = {
1930       0, 1, 2,  6, 7, 8, /* bottom */
1931       0, 4, 3,  6, 7, 9,  /* front */
1932       1, 5, 4,  7, 8, 9,  /* right */
1933       2, 3, 5,  8, 6, 9,  /* left */
1934     };
1935 
1936     faceSize = faceSizeTet;
1937     for (i = 0; i < faceSizeTet; ++i) sortedIndices[i] = indices[i];
1938     ierr = PetscSortInt(faceSizeTet, sortedIndices);CHKERRQ(ierr);
1939     for (iFace=0; iFace < 4; ++iFace) {
1940       const PetscInt ii = iFace*faceSizeTet;
1941       PetscInt       fVertex, cVertex;
1942 
1943       if ((sortedIndices[0] == faceVerticesTetSorted[ii+0]) &&
1944           (sortedIndices[1] == faceVerticesTetSorted[ii+1]) &&
1945           (sortedIndices[2] == faceVerticesTetSorted[ii+2]) &&
1946           (sortedIndices[3] == faceVerticesTetSorted[ii+3])) {
1947         for (fVertex = 0; fVertex < faceSizeTet; ++fVertex) {
1948           for (cVertex = 0; cVertex < faceSizeTet; ++cVertex) {
1949             if (indices[cVertex] == faceVerticesTet[ii+fVertex]) {
1950               faceVertices[fVertex] = origVertices[cVertex];
1951               break;
1952             }
1953           }
1954         }
1955         found = PETSC_TRUE;
1956         break;
1957       }
1958     }
1959     if (!found) SETERRQ(comm, PETSC_ERR_ARG_WRONG, "Invalid tet crossface");
1960     if (posOriented) *posOriented = PETSC_TRUE;
1961     PetscFunctionReturn(0);
1962   } else if (cellDim == 3 && numCorners == 27) {
1963     /* Quadratic hexes (I hate this)
1964        A hex is two oriented quads with the normal of the first
1965        pointing up at the second.
1966 
1967          7---6
1968         /|  /|
1969        4---5 |
1970        | 3-|-2
1971        |/  |/
1972        0---1
1973 
1974        Faces are determined by the first 4 vertices (corners of faces) */
1975     const PetscInt faceSizeQuadHex = 9;
1976     PetscInt       sortedIndices[9], i, iFace;
1977     PetscBool      found                         = PETSC_FALSE;
1978     PetscInt       faceVerticesQuadHexSorted[54] = {
1979       0, 1, 2, 3,  8, 9, 10, 11,  24, /* bottom */
1980       4, 5, 6, 7,  12, 13, 14, 15,  25, /* top */
1981       0, 1, 4, 5,  8, 12, 16, 17,  22, /* front */
1982       1, 2, 5, 6,  9, 13, 17, 18,  21, /* right */
1983       2, 3, 6, 7,  10, 14, 18, 19,  23, /* back */
1984       0, 3, 4, 7,  11, 15, 16, 19,  20, /* left */
1985     };
1986     PetscInt       faceVerticesQuadHex[54] = {
1987       3, 2, 1, 0,  10, 9, 8, 11,  24, /* bottom */
1988       4, 5, 6, 7,  12, 13, 14, 15,  25, /* top */
1989       0, 1, 5, 4,  8, 17, 12, 16,  22, /* front */
1990       1, 2, 6, 5,  9, 18, 13, 17,  21, /* right */
1991       2, 3, 7, 6,  10, 19, 14, 18,  23, /* back */
1992       3, 0, 4, 7,  11, 16, 15, 19,  20 /* left */
1993     };
1994 
1995     faceSize = faceSizeQuadHex;
1996     for (i = 0; i < faceSizeQuadHex; ++i) sortedIndices[i] = indices[i];
1997     ierr = PetscSortInt(faceSizeQuadHex, sortedIndices);CHKERRQ(ierr);
1998     for (iFace = 0; iFace < 6; ++iFace) {
1999       const PetscInt ii = iFace*faceSizeQuadHex;
2000       PetscInt       fVertex, cVertex;
2001 
2002       if ((sortedIndices[0] == faceVerticesQuadHexSorted[ii+0]) &&
2003           (sortedIndices[1] == faceVerticesQuadHexSorted[ii+1]) &&
2004           (sortedIndices[2] == faceVerticesQuadHexSorted[ii+2]) &&
2005           (sortedIndices[3] == faceVerticesQuadHexSorted[ii+3])) {
2006         for (fVertex = 0; fVertex < faceSizeQuadHex; ++fVertex) {
2007           for (cVertex = 0; cVertex < faceSizeQuadHex; ++cVertex) {
2008             if (indices[cVertex] == faceVerticesQuadHex[ii+fVertex]) {
2009               faceVertices[fVertex] = origVertices[cVertex];
2010               break;
2011             }
2012           }
2013         }
2014         found = PETSC_TRUE;
2015         break;
2016       }
2017     }
2018     if (!found) SETERRQ(comm, PETSC_ERR_ARG_WRONG, "Invalid hex crossface");
2019     if (posOriented) *posOriented = PETSC_TRUE;
2020     PetscFunctionReturn(0);
2021   } else SETERRQ(comm, PETSC_ERR_ARG_WRONG, "Unknown cell type for faceOrientation().");
2022   if (!posOrient) {
2023     if (debug) {ierr = PetscPrintf(comm, "  Reversing initial face orientation\n");CHKERRQ(ierr);}
2024     for (f = 0; f < faceSize; ++f) faceVertices[f] = origVertices[faceSize-1 - f];
2025   } else {
2026     if (debug) {ierr = PetscPrintf(comm, "  Keeping initial face orientation\n");CHKERRQ(ierr);}
2027     for (f = 0; f < faceSize; ++f) faceVertices[f] = origVertices[f];
2028   }
2029   if (posOriented) *posOriented = posOrient;
2030   PetscFunctionReturn(0);
2031 }
2032 
2033 #undef __FUNCT__
2034 #define __FUNCT__ "DMPlexGetOrientedFace"
2035 /*
2036     Given a cell and a face, as a set of vertices,
2037       return the oriented face, as a set of vertices, in faceVertices
2038     The orientation is such that the face normal points out of the cell
2039 */
2040 PetscErrorCode DMPlexGetOrientedFace(DM dm, PetscInt cell, PetscInt faceSize, const PetscInt face[], PetscInt numCorners, PetscInt indices[], PetscInt origVertices[], PetscInt faceVertices[], PetscBool *posOriented)
2041 {
2042   const PetscInt *cone = NULL;
2043   PetscInt        coneSize, v, f, v2;
2044   PetscInt        oppositeVertex = -1;
2045   PetscErrorCode  ierr;
2046 
2047   PetscFunctionBegin;
2048   ierr = DMPlexGetConeSize(dm, cell, &coneSize);CHKERRQ(ierr);
2049   ierr = DMPlexGetCone(dm, cell, &cone);CHKERRQ(ierr);
2050   for (v = 0, v2 = 0; v < coneSize; ++v) {
2051     PetscBool found = PETSC_FALSE;
2052 
2053     for (f = 0; f < faceSize; ++f) {
2054       if (face[f] == cone[v]) {
2055         found = PETSC_TRUE; break;
2056       }
2057     }
2058     if (found) {
2059       indices[v2]      = v;
2060       origVertices[v2] = cone[v];
2061       ++v2;
2062     } else {
2063       oppositeVertex = v;
2064     }
2065   }
2066   ierr = DMPlexGetFaceOrientation(dm, cell, numCorners, indices, oppositeVertex, origVertices, faceVertices, posOriented);CHKERRQ(ierr);
2067   PetscFunctionReturn(0);
2068 }
2069 
2070 #undef __FUNCT__
2071 #define __FUNCT__ "DMPlexInsertFace_Internal"
2072 /*
2073   DMPlexInsertFace_Internal - Puts a face into the mesh
2074 
2075   Not collective
2076 
2077   Input Parameters:
2078   + dm              - The DMPlex
2079   . numFaceVertex   - The number of vertices in the face
2080   . faceVertices    - The vertices in the face for dm
2081   . subfaceVertices - The vertices in the face for subdm
2082   . numCorners      - The number of vertices in the cell
2083   . cell            - A cell in dm containing the face
2084   . subcell         - A cell in subdm containing the face
2085   . firstFace       - First face in the mesh
2086   - newFacePoint    - Next face in the mesh
2087 
2088   Output Parameters:
2089   . newFacePoint - Contains next face point number on input, updated on output
2090 
2091   Level: developer
2092 */
2093 static PetscErrorCode DMPlexInsertFace_Internal(DM dm, DM subdm, PetscInt numFaceVertices, const PetscInt faceVertices[], const PetscInt subfaceVertices[], PetscInt numCorners, PetscInt cell, PetscInt subcell, PetscInt firstFace, PetscInt *newFacePoint)
2094 {
2095   MPI_Comm        comm;
2096   DM_Plex        *submesh = (DM_Plex*) subdm->data;
2097   const PetscInt *faces;
2098   PetscInt        numFaces, coneSize;
2099   PetscErrorCode  ierr;
2100 
2101   PetscFunctionBegin;
2102   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2103   ierr = DMPlexGetConeSize(subdm, subcell, &coneSize);CHKERRQ(ierr);
2104   if (coneSize != 1) SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Cone size of cell %d is %d != 1", cell, coneSize);
2105 #if 0
2106   /* Cannot use this because support() has not been constructed yet */
2107   ierr = DMPlexGetJoin(subdm, numFaceVertices, subfaceVertices, &numFaces, &faces);CHKERRQ(ierr);
2108 #else
2109   {
2110     PetscInt f;
2111 
2112     numFaces = 0;
2113     ierr     = DMGetWorkArray(subdm, 1, PETSC_INT, (void **) &faces);CHKERRQ(ierr);
2114     for (f = firstFace; f < *newFacePoint; ++f) {
2115       PetscInt dof, off, d;
2116 
2117       ierr = PetscSectionGetDof(submesh->coneSection, f, &dof);CHKERRQ(ierr);
2118       ierr = PetscSectionGetOffset(submesh->coneSection, f, &off);CHKERRQ(ierr);
2119       /* Yes, I know this is quadratic, but I expect the sizes to be <5 */
2120       for (d = 0; d < dof; ++d) {
2121         const PetscInt p = submesh->cones[off+d];
2122         PetscInt       v;
2123 
2124         for (v = 0; v < numFaceVertices; ++v) {
2125           if (subfaceVertices[v] == p) break;
2126         }
2127         if (v == numFaceVertices) break;
2128       }
2129       if (d == dof) {
2130         numFaces               = 1;
2131         ((PetscInt*) faces)[0] = f;
2132       }
2133     }
2134   }
2135 #endif
2136   if (numFaces > 1) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Vertex set had %d faces, not one", numFaces);
2137   else if (numFaces == 1) {
2138     /* Add the other cell neighbor for this face */
2139     ierr = DMPlexSetCone(subdm, subcell, faces);CHKERRQ(ierr);
2140   } else {
2141     PetscInt *indices, *origVertices, *orientedVertices, *orientedSubVertices, v, ov;
2142     PetscBool posOriented;
2143 
2144     ierr                = DMGetWorkArray(subdm, 4*numFaceVertices * sizeof(PetscInt), PETSC_INT, &orientedVertices);CHKERRQ(ierr);
2145     origVertices        = &orientedVertices[numFaceVertices];
2146     indices             = &orientedVertices[numFaceVertices*2];
2147     orientedSubVertices = &orientedVertices[numFaceVertices*3];
2148     ierr                = DMPlexGetOrientedFace(dm, cell, numFaceVertices, faceVertices, numCorners, indices, origVertices, orientedVertices, &posOriented);CHKERRQ(ierr);
2149     /* TODO: I know that routine should return a permutation, not the indices */
2150     for (v = 0; v < numFaceVertices; ++v) {
2151       const PetscInt vertex = faceVertices[v], subvertex = subfaceVertices[v];
2152       for (ov = 0; ov < numFaceVertices; ++ov) {
2153         if (orientedVertices[ov] == vertex) {
2154           orientedSubVertices[ov] = subvertex;
2155           break;
2156         }
2157       }
2158       if (ov == numFaceVertices) SETERRQ1(comm, PETSC_ERR_PLIB, "Could not find face vertex %d in orientated set", vertex);
2159     }
2160     ierr = DMPlexSetCone(subdm, *newFacePoint, orientedSubVertices);CHKERRQ(ierr);
2161     ierr = DMPlexSetCone(subdm, subcell, newFacePoint);CHKERRQ(ierr);
2162     ierr = DMRestoreWorkArray(subdm, 4*numFaceVertices * sizeof(PetscInt), PETSC_INT, &orientedVertices);CHKERRQ(ierr);
2163     ++(*newFacePoint);
2164   }
2165 #if 0
2166   ierr = DMPlexRestoreJoin(subdm, numFaceVertices, subfaceVertices, &numFaces, &faces);CHKERRQ(ierr);
2167 #else
2168   ierr = DMRestoreWorkArray(subdm, 1, PETSC_INT, (void **) &faces);CHKERRQ(ierr);
2169 #endif
2170   PetscFunctionReturn(0);
2171 }
2172 
2173 #undef __FUNCT__
2174 #define __FUNCT__ "DMPlexCreateSubmesh_Uninterpolated"
2175 static PetscErrorCode DMPlexCreateSubmesh_Uninterpolated(DM dm, DMLabel vertexLabel, PetscInt value, DM subdm)
2176 {
2177   MPI_Comm        comm;
2178   DMLabel         subpointMap;
2179   IS              subvertexIS,  subcellIS;
2180   const PetscInt *subVertices, *subCells;
2181   PetscInt        numSubVertices, firstSubVertex, numSubCells;
2182   PetscInt       *subface, maxConeSize, numSubFaces = 0, firstSubFace, newFacePoint, nFV = 0;
2183   PetscInt        vStart, vEnd, c, f;
2184   PetscErrorCode  ierr;
2185 
2186   PetscFunctionBegin;
2187   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2188   /* Create subpointMap which marks the submesh */
2189   ierr = DMLabelCreate("subpoint_map", &subpointMap);CHKERRQ(ierr);
2190   ierr = DMPlexSetSubpointMap(subdm, subpointMap);CHKERRQ(ierr);
2191   ierr = DMLabelDestroy(&subpointMap);CHKERRQ(ierr);
2192   if (vertexLabel) {ierr = DMPlexMarkSubmesh_Uninterpolated(dm, vertexLabel, value, subpointMap, &numSubFaces, &nFV, subdm);CHKERRQ(ierr);}
2193   /* Setup chart */
2194   ierr = DMLabelGetStratumSize(subpointMap, 0, &numSubVertices);CHKERRQ(ierr);
2195   ierr = DMLabelGetStratumSize(subpointMap, 2, &numSubCells);CHKERRQ(ierr);
2196   ierr = DMPlexSetChart(subdm, 0, numSubCells+numSubFaces+numSubVertices);CHKERRQ(ierr);
2197   ierr = DMPlexSetVTKCellHeight(subdm, 1);CHKERRQ(ierr);
2198   /* Set cone sizes */
2199   firstSubVertex = numSubCells;
2200   firstSubFace   = numSubCells+numSubVertices;
2201   newFacePoint   = firstSubFace;
2202   ierr = DMLabelGetStratumIS(subpointMap, 0, &subvertexIS);CHKERRQ(ierr);
2203   if (subvertexIS) {ierr = ISGetIndices(subvertexIS, &subVertices);CHKERRQ(ierr);}
2204   ierr = DMLabelGetStratumIS(subpointMap, 2, &subcellIS);CHKERRQ(ierr);
2205   if (subcellIS) {ierr = ISGetIndices(subcellIS, &subCells);CHKERRQ(ierr);}
2206   for (c = 0; c < numSubCells; ++c) {
2207     ierr = DMPlexSetConeSize(subdm, c, 1);CHKERRQ(ierr);
2208   }
2209   for (f = firstSubFace; f < firstSubFace+numSubFaces; ++f) {
2210     ierr = DMPlexSetConeSize(subdm, f, nFV);CHKERRQ(ierr);
2211   }
2212   ierr = DMSetUp(subdm);CHKERRQ(ierr);
2213   /* Create face cones */
2214   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
2215   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, NULL);CHKERRQ(ierr);
2216   ierr = DMGetWorkArray(subdm, maxConeSize, PETSC_INT, (void**) &subface);CHKERRQ(ierr);
2217   for (c = 0; c < numSubCells; ++c) {
2218     const PetscInt cell    = subCells[c];
2219     const PetscInt subcell = c;
2220     PetscInt      *closure = NULL;
2221     PetscInt       closureSize, cl, numCorners = 0, faceSize = 0;
2222 
2223     ierr = DMPlexGetTransitiveClosure(dm, cell, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
2224     for (cl = 0; cl < closureSize*2; cl += 2) {
2225       const PetscInt point = closure[cl];
2226       PetscInt       subVertex;
2227 
2228       if ((point >= vStart) && (point < vEnd)) {
2229         ++numCorners;
2230         ierr = PetscFindInt(point, numSubVertices, subVertices, &subVertex);CHKERRQ(ierr);
2231         if (subVertex >= 0) {
2232           closure[faceSize] = point;
2233           subface[faceSize] = firstSubVertex+subVertex;
2234           ++faceSize;
2235         }
2236       }
2237     }
2238     if (faceSize > nFV) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Invalid submesh: Too many vertices %d of an element on the surface", faceSize);
2239     if (faceSize == nFV) {
2240       ierr = DMPlexInsertFace_Internal(dm, subdm, faceSize, closure, subface, numCorners, cell, subcell, firstSubFace, &newFacePoint);CHKERRQ(ierr);
2241     }
2242     ierr = DMPlexRestoreTransitiveClosure(dm, cell, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
2243   }
2244   ierr = DMRestoreWorkArray(subdm, maxConeSize, PETSC_INT, (void**) &subface);CHKERRQ(ierr);
2245   ierr = DMPlexSymmetrize(subdm);CHKERRQ(ierr);
2246   ierr = DMPlexStratify(subdm);CHKERRQ(ierr);
2247   /* Build coordinates */
2248   {
2249     PetscSection coordSection, subCoordSection;
2250     Vec          coordinates, subCoordinates;
2251     PetscScalar *coords, *subCoords;
2252     PetscInt     numComp, coordSize, v;
2253 
2254     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
2255     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
2256     ierr = DMPlexGetCoordinateSection(subdm, &subCoordSection);CHKERRQ(ierr);
2257     ierr = PetscSectionSetNumFields(subCoordSection, 1);CHKERRQ(ierr);
2258     ierr = PetscSectionGetFieldComponents(coordSection, 0, &numComp);CHKERRQ(ierr);
2259     ierr = PetscSectionSetFieldComponents(subCoordSection, 0, numComp);CHKERRQ(ierr);
2260     ierr = PetscSectionSetChart(subCoordSection, firstSubVertex, firstSubVertex+numSubVertices);CHKERRQ(ierr);
2261     for (v = 0; v < numSubVertices; ++v) {
2262       const PetscInt vertex    = subVertices[v];
2263       const PetscInt subvertex = firstSubVertex+v;
2264       PetscInt       dof;
2265 
2266       ierr = PetscSectionGetDof(coordSection, vertex, &dof);CHKERRQ(ierr);
2267       ierr = PetscSectionSetDof(subCoordSection, subvertex, dof);CHKERRQ(ierr);
2268       ierr = PetscSectionSetFieldDof(subCoordSection, subvertex, 0, dof);CHKERRQ(ierr);
2269     }
2270     ierr = PetscSectionSetUp(subCoordSection);CHKERRQ(ierr);
2271     ierr = PetscSectionGetStorageSize(subCoordSection, &coordSize);CHKERRQ(ierr);
2272     ierr = VecCreate(comm, &subCoordinates);CHKERRQ(ierr);
2273     ierr = VecSetSizes(subCoordinates, coordSize, PETSC_DETERMINE);CHKERRQ(ierr);
2274     ierr = VecSetType(subCoordinates,VECSTANDARD);CHKERRQ(ierr);
2275     if (coordSize) {
2276       ierr = VecGetArray(coordinates,    &coords);CHKERRQ(ierr);
2277       ierr = VecGetArray(subCoordinates, &subCoords);CHKERRQ(ierr);
2278       for (v = 0; v < numSubVertices; ++v) {
2279         const PetscInt vertex    = subVertices[v];
2280         const PetscInt subvertex = firstSubVertex+v;
2281         PetscInt       dof, off, sdof, soff, d;
2282 
2283         ierr = PetscSectionGetDof(coordSection, vertex, &dof);CHKERRQ(ierr);
2284         ierr = PetscSectionGetOffset(coordSection, vertex, &off);CHKERRQ(ierr);
2285         ierr = PetscSectionGetDof(subCoordSection, subvertex, &sdof);CHKERRQ(ierr);
2286         ierr = PetscSectionGetOffset(subCoordSection, subvertex, &soff);CHKERRQ(ierr);
2287         if (dof != sdof) SETERRQ4(comm, PETSC_ERR_PLIB, "Coordinate dimension %d on subvertex %d, vertex %d should be %d", sdof, subvertex, vertex, dof);
2288         for (d = 0; d < dof; ++d) subCoords[soff+d] = coords[off+d];
2289       }
2290       ierr = VecRestoreArray(coordinates,    &coords);CHKERRQ(ierr);
2291       ierr = VecRestoreArray(subCoordinates, &subCoords);CHKERRQ(ierr);
2292     }
2293     ierr = DMSetCoordinatesLocal(subdm, subCoordinates);CHKERRQ(ierr);
2294     ierr = VecDestroy(&subCoordinates);CHKERRQ(ierr);
2295   }
2296   /* Cleanup */
2297   if (subvertexIS) {ierr = ISRestoreIndices(subvertexIS, &subVertices);CHKERRQ(ierr);}
2298   ierr = ISDestroy(&subvertexIS);CHKERRQ(ierr);
2299   if (subcellIS) {ierr = ISRestoreIndices(subcellIS, &subCells);CHKERRQ(ierr);}
2300   ierr = ISDestroy(&subcellIS);CHKERRQ(ierr);
2301   PetscFunctionReturn(0);
2302 }
2303 
2304 #undef __FUNCT__
2305 #define __FUNCT__ "DMPlexCreateSubmesh_Interpolated"
2306 static PetscErrorCode DMPlexCreateSubmesh_Interpolated(DM dm, DMLabel vertexLabel, PetscInt value, DM subdm)
2307 {
2308   MPI_Comm         comm;
2309   DMLabel          subpointMap;
2310   IS              *subpointIS;
2311   const PetscInt **subpoints;
2312   PetscInt        *numSubPoints, *firstSubPoint, *coneNew, *coneONew;
2313   PetscInt         totSubPoints = 0, maxConeSize, dim, p, d, v;
2314   PetscErrorCode   ierr;
2315 
2316   PetscFunctionBegin;
2317   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2318   /* Create subpointMap which marks the submesh */
2319   ierr = DMLabelCreate("subpoint_map", &subpointMap);CHKERRQ(ierr);
2320   ierr = DMPlexSetSubpointMap(subdm, subpointMap);CHKERRQ(ierr);
2321   ierr = DMLabelDestroy(&subpointMap);CHKERRQ(ierr);
2322   if (vertexLabel) {ierr = DMPlexMarkSubmesh_Interpolated(dm, vertexLabel, value, subpointMap, subdm);CHKERRQ(ierr);}
2323   /* Setup chart */
2324   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
2325   ierr = PetscMalloc4(dim+1,&numSubPoints,dim+1,&firstSubPoint,dim+1,&subpointIS,dim+1,&subpoints);CHKERRQ(ierr);
2326   for (d = 0; d <= dim; ++d) {
2327     ierr = DMLabelGetStratumSize(subpointMap, d, &numSubPoints[d]);CHKERRQ(ierr);
2328     totSubPoints += numSubPoints[d];
2329   }
2330   ierr = DMPlexSetChart(subdm, 0, totSubPoints);CHKERRQ(ierr);
2331   ierr = DMPlexSetVTKCellHeight(subdm, 1);CHKERRQ(ierr);
2332   /* Set cone sizes */
2333   firstSubPoint[dim] = 0;
2334   firstSubPoint[0]   = firstSubPoint[dim] + numSubPoints[dim];
2335   if (dim > 1) {firstSubPoint[dim-1] = firstSubPoint[0]     + numSubPoints[0];}
2336   if (dim > 2) {firstSubPoint[dim-2] = firstSubPoint[dim-1] + numSubPoints[dim-1];}
2337   for (d = 0; d <= dim; ++d) {
2338     ierr = DMLabelGetStratumIS(subpointMap, d, &subpointIS[d]);CHKERRQ(ierr);
2339     if (subpointIS[d]) {ierr = ISGetIndices(subpointIS[d], &subpoints[d]);CHKERRQ(ierr);}
2340   }
2341   for (d = 0; d <= dim; ++d) {
2342     for (p = 0; p < numSubPoints[d]; ++p) {
2343       const PetscInt  point    = subpoints[d][p];
2344       const PetscInt  subpoint = firstSubPoint[d] + p;
2345       const PetscInt *cone;
2346       PetscInt        coneSize, coneSizeNew, c, val;
2347 
2348       ierr = DMPlexGetConeSize(dm, point, &coneSize);CHKERRQ(ierr);
2349       ierr = DMPlexSetConeSize(subdm, subpoint, coneSize);CHKERRQ(ierr);
2350       if (d == dim) {
2351         ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
2352         for (c = 0, coneSizeNew = 0; c < coneSize; ++c) {
2353           ierr = DMLabelGetValue(subpointMap, cone[c], &val);CHKERRQ(ierr);
2354           if (val >= 0) coneSizeNew++;
2355         }
2356         ierr = DMPlexSetConeSize(subdm, subpoint, coneSizeNew);CHKERRQ(ierr);
2357       }
2358     }
2359   }
2360   ierr = DMSetUp(subdm);CHKERRQ(ierr);
2361   /* Set cones */
2362   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, NULL);CHKERRQ(ierr);
2363   ierr = PetscMalloc2(maxConeSize,&coneNew,maxConeSize,&coneONew);CHKERRQ(ierr);
2364   for (d = 0; d <= dim; ++d) {
2365     for (p = 0; p < numSubPoints[d]; ++p) {
2366       const PetscInt  point    = subpoints[d][p];
2367       const PetscInt  subpoint = firstSubPoint[d] + p;
2368       const PetscInt *cone, *ornt;
2369       PetscInt        coneSize, subconeSize, coneSizeNew, c, subc;
2370 
2371       ierr = DMPlexGetConeSize(dm, point, &coneSize);CHKERRQ(ierr);
2372       ierr = DMPlexGetConeSize(subdm, subpoint, &subconeSize);CHKERRQ(ierr);
2373       ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
2374       ierr = DMPlexGetConeOrientation(dm, point, &ornt);CHKERRQ(ierr);
2375       for (c = 0, coneSizeNew = 0; c < coneSize; ++c) {
2376         ierr = PetscFindInt(cone[c], numSubPoints[d-1], subpoints[d-1], &subc);CHKERRQ(ierr);
2377         if (subc >= 0) {
2378           coneNew[coneSizeNew]  = firstSubPoint[d-1] + subc;
2379           coneONew[coneSizeNew] = ornt[c];
2380           ++coneSizeNew;
2381         }
2382       }
2383       if (coneSizeNew != subconeSize) SETERRQ2(comm, PETSC_ERR_PLIB, "Number of cone points located %d does not match subcone size %d", coneSizeNew, subconeSize);
2384       ierr = DMPlexSetCone(subdm, subpoint, coneNew);CHKERRQ(ierr);
2385       ierr = DMPlexSetConeOrientation(subdm, subpoint, coneONew);CHKERRQ(ierr);
2386     }
2387   }
2388   ierr = PetscFree2(coneNew,coneONew);CHKERRQ(ierr);
2389   ierr = DMPlexSymmetrize(subdm);CHKERRQ(ierr);
2390   ierr = DMPlexStratify(subdm);CHKERRQ(ierr);
2391   /* Build coordinates */
2392   {
2393     PetscSection coordSection, subCoordSection;
2394     Vec          coordinates, subCoordinates;
2395     PetscScalar *coords, *subCoords;
2396     PetscInt     numComp, coordSize;
2397 
2398     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
2399     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
2400     ierr = DMPlexGetCoordinateSection(subdm, &subCoordSection);CHKERRQ(ierr);
2401     ierr = PetscSectionSetNumFields(subCoordSection, 1);CHKERRQ(ierr);
2402     ierr = PetscSectionGetFieldComponents(coordSection, 0, &numComp);CHKERRQ(ierr);
2403     ierr = PetscSectionSetFieldComponents(subCoordSection, 0, numComp);CHKERRQ(ierr);
2404     ierr = PetscSectionSetChart(subCoordSection, firstSubPoint[0], firstSubPoint[0]+numSubPoints[0]);CHKERRQ(ierr);
2405     for (v = 0; v < numSubPoints[0]; ++v) {
2406       const PetscInt vertex    = subpoints[0][v];
2407       const PetscInt subvertex = firstSubPoint[0]+v;
2408       PetscInt       dof;
2409 
2410       ierr = PetscSectionGetDof(coordSection, vertex, &dof);CHKERRQ(ierr);
2411       ierr = PetscSectionSetDof(subCoordSection, subvertex, dof);CHKERRQ(ierr);
2412       ierr = PetscSectionSetFieldDof(subCoordSection, subvertex, 0, dof);CHKERRQ(ierr);
2413     }
2414     ierr = PetscSectionSetUp(subCoordSection);CHKERRQ(ierr);
2415     ierr = PetscSectionGetStorageSize(subCoordSection, &coordSize);CHKERRQ(ierr);
2416     ierr = VecCreate(comm, &subCoordinates);CHKERRQ(ierr);
2417     ierr = VecSetSizes(subCoordinates, coordSize, PETSC_DETERMINE);CHKERRQ(ierr);
2418     ierr = VecSetType(subCoordinates,VECSTANDARD);CHKERRQ(ierr);
2419     ierr = VecGetArray(coordinates,    &coords);CHKERRQ(ierr);
2420     ierr = VecGetArray(subCoordinates, &subCoords);CHKERRQ(ierr);
2421     for (v = 0; v < numSubPoints[0]; ++v) {
2422       const PetscInt vertex    = subpoints[0][v];
2423       const PetscInt subvertex = firstSubPoint[0]+v;
2424       PetscInt dof, off, sdof, soff, d;
2425 
2426       ierr = PetscSectionGetDof(coordSection, vertex, &dof);CHKERRQ(ierr);
2427       ierr = PetscSectionGetOffset(coordSection, vertex, &off);CHKERRQ(ierr);
2428       ierr = PetscSectionGetDof(subCoordSection, subvertex, &sdof);CHKERRQ(ierr);
2429       ierr = PetscSectionGetOffset(subCoordSection, subvertex, &soff);CHKERRQ(ierr);
2430       if (dof != sdof) SETERRQ4(comm, PETSC_ERR_PLIB, "Coordinate dimension %d on subvertex %d, vertex %d should be %d", sdof, subvertex, vertex, dof);
2431       for (d = 0; d < dof; ++d) subCoords[soff+d] = coords[off+d];
2432     }
2433     ierr = VecRestoreArray(coordinates,    &coords);CHKERRQ(ierr);
2434     ierr = VecRestoreArray(subCoordinates, &subCoords);CHKERRQ(ierr);
2435     ierr = DMSetCoordinatesLocal(subdm, subCoordinates);CHKERRQ(ierr);
2436     ierr = VecDestroy(&subCoordinates);CHKERRQ(ierr);
2437   }
2438   /* Cleanup */
2439   for (d = 0; d <= dim; ++d) {
2440     if (subpointIS[d]) {ierr = ISRestoreIndices(subpointIS[d], &subpoints[d]);CHKERRQ(ierr);}
2441     ierr = ISDestroy(&subpointIS[d]);CHKERRQ(ierr);
2442   }
2443   ierr = PetscFree4(numSubPoints,firstSubPoint,subpointIS,subpoints);CHKERRQ(ierr);
2444   PetscFunctionReturn(0);
2445 }
2446 
2447 #undef __FUNCT__
2448 #define __FUNCT__ "DMPlexCreateSubmesh"
2449 /*@
2450   DMPlexCreateSubmesh - Extract a hypersurface from the mesh using vertices defined by a label
2451 
2452   Input Parameters:
2453 + dm           - The original mesh
2454 . vertexLabel  - The DMLabel marking vertices contained in the surface
2455 - value        - The label value to use
2456 
2457   Output Parameter:
2458 . subdm - The surface mesh
2459 
2460   Note: This function produces a DMLabel mapping original points in the submesh to their depth. This can be obtained using DMPlexGetSubpointMap().
2461 
2462   Level: developer
2463 
2464 .seealso: DMPlexGetSubpointMap(), DMPlexGetLabel(), DMLabelSetValue()
2465 @*/
2466 PetscErrorCode DMPlexCreateSubmesh(DM dm, DMLabel vertexLabel, PetscInt value, DM *subdm)
2467 {
2468   PetscInt       dim, depth;
2469   PetscErrorCode ierr;
2470 
2471   PetscFunctionBegin;
2472   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2473   PetscValidPointer(subdm, 3);
2474   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
2475   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2476   ierr = DMCreate(PetscObjectComm((PetscObject)dm), subdm);CHKERRQ(ierr);
2477   ierr = DMSetType(*subdm, DMPLEX);CHKERRQ(ierr);
2478   ierr = DMPlexSetDimension(*subdm, dim-1);CHKERRQ(ierr);
2479   if (depth == dim) {
2480     ierr = DMPlexCreateSubmesh_Interpolated(dm, vertexLabel, value, *subdm);CHKERRQ(ierr);
2481   } else {
2482     ierr = DMPlexCreateSubmesh_Uninterpolated(dm, vertexLabel, value, *subdm);CHKERRQ(ierr);
2483   }
2484   PetscFunctionReturn(0);
2485 }
2486 
2487 #undef __FUNCT__
2488 #define __FUNCT__ "DMPlexFilterPoint_Internal"
2489 PETSC_STATIC_INLINE PetscInt DMPlexFilterPoint_Internal(PetscInt point, PetscInt firstSubPoint, PetscInt numSubPoints, const PetscInt subPoints[])
2490 {
2491   PetscInt       subPoint;
2492   PetscErrorCode ierr;
2493 
2494   ierr = PetscFindInt(point, numSubPoints, subPoints, &subPoint); if (ierr < 0) return ierr;
2495   return subPoint < 0 ? subPoint : firstSubPoint+subPoint;
2496 }
2497 
2498 #undef __FUNCT__
2499 #define __FUNCT__ "DMPlexCreateCohesiveSubmesh_Uninterpolated"
2500 static PetscErrorCode DMPlexCreateCohesiveSubmesh_Uninterpolated(DM dm, PetscBool hasLagrange, const char label[], PetscInt value, DM subdm)
2501 {
2502   MPI_Comm        comm;
2503   DMLabel         subpointMap;
2504   IS              subvertexIS;
2505   const PetscInt *subVertices;
2506   PetscInt        numSubVertices, firstSubVertex, numSubCells, *subCells = NULL;
2507   PetscInt       *subface, maxConeSize, numSubFaces, firstSubFace, newFacePoint, nFV;
2508   PetscInt        cMax, c, f;
2509   PetscErrorCode  ierr;
2510 
2511   PetscFunctionBegin;
2512   ierr = PetscObjectGetComm((PetscObject)dm, &comm);CHKERRQ(ierr);
2513   /* Create subpointMap which marks the submesh */
2514   ierr = DMLabelCreate("subpoint_map", &subpointMap);CHKERRQ(ierr);
2515   ierr = DMPlexSetSubpointMap(subdm, subpointMap);CHKERRQ(ierr);
2516   ierr = DMLabelDestroy(&subpointMap);CHKERRQ(ierr);
2517   ierr = DMPlexMarkCohesiveSubmesh_Uninterpolated(dm, hasLagrange, label, value, subpointMap, &numSubFaces, &nFV, &subCells, subdm);CHKERRQ(ierr);
2518   /* Setup chart */
2519   ierr = DMLabelGetStratumSize(subpointMap, 0, &numSubVertices);CHKERRQ(ierr);
2520   ierr = DMLabelGetStratumSize(subpointMap, 2, &numSubCells);CHKERRQ(ierr);
2521   ierr = DMPlexSetChart(subdm, 0, numSubCells+numSubFaces+numSubVertices);CHKERRQ(ierr);
2522   ierr = DMPlexSetVTKCellHeight(subdm, 1);CHKERRQ(ierr);
2523   /* Set cone sizes */
2524   firstSubVertex = numSubCells;
2525   firstSubFace   = numSubCells+numSubVertices;
2526   newFacePoint   = firstSubFace;
2527   ierr = DMLabelGetStratumIS(subpointMap, 0, &subvertexIS);CHKERRQ(ierr);
2528   if (subvertexIS) {ierr = ISGetIndices(subvertexIS, &subVertices);CHKERRQ(ierr);}
2529   for (c = 0; c < numSubCells; ++c) {
2530     ierr = DMPlexSetConeSize(subdm, c, 1);CHKERRQ(ierr);
2531   }
2532   for (f = firstSubFace; f < firstSubFace+numSubFaces; ++f) {
2533     ierr = DMPlexSetConeSize(subdm, f, nFV);CHKERRQ(ierr);
2534   }
2535   ierr = DMSetUp(subdm);CHKERRQ(ierr);
2536   /* Create face cones */
2537   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, NULL);CHKERRQ(ierr);
2538   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
2539   ierr = DMGetWorkArray(subdm, maxConeSize, PETSC_INT, (void**) &subface);CHKERRQ(ierr);
2540   for (c = 0; c < numSubCells; ++c) {
2541     const PetscInt  cell    = subCells[c];
2542     const PetscInt  subcell = c;
2543     const PetscInt *cone, *cells;
2544     PetscInt        numCells, subVertex, p, v;
2545 
2546     if (cell < cMax) continue;
2547     ierr = DMPlexGetCone(dm, cell, &cone);CHKERRQ(ierr);
2548     for (v = 0; v < nFV; ++v) {
2549       ierr = PetscFindInt(cone[v], numSubVertices, subVertices, &subVertex);CHKERRQ(ierr);
2550       subface[v] = firstSubVertex+subVertex;
2551     }
2552     ierr = DMPlexSetCone(subdm, newFacePoint, subface);CHKERRQ(ierr);
2553     ierr = DMPlexSetCone(subdm, subcell, &newFacePoint);CHKERRQ(ierr);
2554     ierr = DMPlexGetJoin(dm, nFV, cone, &numCells, &cells);CHKERRQ(ierr);
2555     /* Not true in parallel
2556     if (numCells != 2) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cohesive cells should separate two cells"); */
2557     for (p = 0; p < numCells; ++p) {
2558       PetscInt negsubcell;
2559 
2560       if (cells[p] >= cMax) continue;
2561       /* I know this is a crap search */
2562       for (negsubcell = 0; negsubcell < numSubCells; ++negsubcell) {
2563         if (subCells[negsubcell] == cells[p]) break;
2564       }
2565       if (negsubcell == numSubCells) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not find negative face neighbor for cohesive cell %d", cell);
2566       ierr = DMPlexSetCone(subdm, negsubcell, &newFacePoint);CHKERRQ(ierr);
2567     }
2568     ierr = DMPlexRestoreJoin(dm, nFV, cone, &numCells, &cells);CHKERRQ(ierr);
2569     ++newFacePoint;
2570   }
2571   ierr = DMRestoreWorkArray(subdm, maxConeSize, PETSC_INT, (void**) &subface);CHKERRQ(ierr);
2572   ierr = DMPlexSymmetrize(subdm);CHKERRQ(ierr);
2573   ierr = DMPlexStratify(subdm);CHKERRQ(ierr);
2574   /* Build coordinates */
2575   {
2576     PetscSection coordSection, subCoordSection;
2577     Vec          coordinates, subCoordinates;
2578     PetscScalar *coords, *subCoords;
2579     PetscInt     numComp, coordSize, v;
2580 
2581     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
2582     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
2583     ierr = DMPlexGetCoordinateSection(subdm, &subCoordSection);CHKERRQ(ierr);
2584     ierr = PetscSectionSetNumFields(subCoordSection, 1);CHKERRQ(ierr);
2585     ierr = PetscSectionGetFieldComponents(coordSection, 0, &numComp);CHKERRQ(ierr);
2586     ierr = PetscSectionSetFieldComponents(subCoordSection, 0, numComp);CHKERRQ(ierr);
2587     ierr = PetscSectionSetChart(subCoordSection, firstSubVertex, firstSubVertex+numSubVertices);CHKERRQ(ierr);
2588     for (v = 0; v < numSubVertices; ++v) {
2589       const PetscInt vertex    = subVertices[v];
2590       const PetscInt subvertex = firstSubVertex+v;
2591       PetscInt       dof;
2592 
2593       ierr = PetscSectionGetDof(coordSection, vertex, &dof);CHKERRQ(ierr);
2594       ierr = PetscSectionSetDof(subCoordSection, subvertex, dof);CHKERRQ(ierr);
2595       ierr = PetscSectionSetFieldDof(subCoordSection, subvertex, 0, dof);CHKERRQ(ierr);
2596     }
2597     ierr = PetscSectionSetUp(subCoordSection);CHKERRQ(ierr);
2598     ierr = PetscSectionGetStorageSize(subCoordSection, &coordSize);CHKERRQ(ierr);
2599     ierr = VecCreate(comm, &subCoordinates);CHKERRQ(ierr);
2600     ierr = VecSetSizes(subCoordinates, coordSize, PETSC_DETERMINE);CHKERRQ(ierr);
2601     ierr = VecSetType(subCoordinates,VECSTANDARD);CHKERRQ(ierr);
2602     ierr = VecGetArray(coordinates,    &coords);CHKERRQ(ierr);
2603     ierr = VecGetArray(subCoordinates, &subCoords);CHKERRQ(ierr);
2604     for (v = 0; v < numSubVertices; ++v) {
2605       const PetscInt vertex    = subVertices[v];
2606       const PetscInt subvertex = firstSubVertex+v;
2607       PetscInt       dof, off, sdof, soff, d;
2608 
2609       ierr = PetscSectionGetDof(coordSection, vertex, &dof);CHKERRQ(ierr);
2610       ierr = PetscSectionGetOffset(coordSection, vertex, &off);CHKERRQ(ierr);
2611       ierr = PetscSectionGetDof(subCoordSection, subvertex, &sdof);CHKERRQ(ierr);
2612       ierr = PetscSectionGetOffset(subCoordSection, subvertex, &soff);CHKERRQ(ierr);
2613       if (dof != sdof) SETERRQ4(comm, PETSC_ERR_PLIB, "Coordinate dimension %d on subvertex %d, vertex %d should be %d", sdof, subvertex, vertex, dof);
2614       for (d = 0; d < dof; ++d) subCoords[soff+d] = coords[off+d];
2615     }
2616     ierr = VecRestoreArray(coordinates,    &coords);CHKERRQ(ierr);
2617     ierr = VecRestoreArray(subCoordinates, &subCoords);CHKERRQ(ierr);
2618     ierr = DMSetCoordinatesLocal(subdm, subCoordinates);CHKERRQ(ierr);
2619     ierr = VecDestroy(&subCoordinates);CHKERRQ(ierr);
2620   }
2621   /* Build SF */
2622   CHKMEMQ;
2623   {
2624     PetscSF            sfPoint, sfPointSub;
2625     const PetscSFNode *remotePoints;
2626     PetscSFNode       *sremotePoints, *newLocalPoints, *newOwners;
2627     const PetscInt    *localPoints;
2628     PetscInt          *slocalPoints;
2629     PetscInt           numRoots, numLeaves, numSubRoots = numSubCells+numSubFaces+numSubVertices, numSubLeaves = 0, l, sl, ll, pStart, pEnd, p, vStart, vEnd;
2630     PetscMPIInt        rank;
2631 
2632     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject) dm), &rank);CHKERRQ(ierr);
2633     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2634     ierr = DMGetPointSF(subdm, &sfPointSub);CHKERRQ(ierr);
2635     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2636     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
2637     ierr = PetscSFGetGraph(sfPoint, &numRoots, &numLeaves, &localPoints, &remotePoints);CHKERRQ(ierr);
2638     if (numRoots >= 0) {
2639       /* Only vertices should be shared */
2640       ierr = PetscMalloc2(pEnd-pStart,&newLocalPoints,numRoots,&newOwners);CHKERRQ(ierr);
2641       for (p = 0; p < pEnd-pStart; ++p) {
2642         newLocalPoints[p].rank  = -2;
2643         newLocalPoints[p].index = -2;
2644       }
2645       /* Set subleaves */
2646       for (l = 0; l < numLeaves; ++l) {
2647         const PetscInt point    = localPoints[l];
2648         const PetscInt subPoint = DMPlexFilterPoint_Internal(point, firstSubVertex, numSubVertices, subVertices);
2649 
2650         if ((point < vStart) && (point >= vEnd)) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Should not be mapping anything but vertices, %d", point);
2651         if (subPoint < 0) continue;
2652         newLocalPoints[point-pStart].rank  = rank;
2653         newLocalPoints[point-pStart].index = subPoint;
2654         ++numSubLeaves;
2655       }
2656       /* Must put in owned subpoints */
2657       for (p = pStart; p < pEnd; ++p) {
2658         const PetscInt subPoint = DMPlexFilterPoint_Internal(p, firstSubVertex, numSubVertices, subVertices);
2659 
2660         if (subPoint < 0) {
2661           newOwners[p-pStart].rank  = -3;
2662           newOwners[p-pStart].index = -3;
2663         } else {
2664           newOwners[p-pStart].rank  = rank;
2665           newOwners[p-pStart].index = subPoint;
2666         }
2667       }
2668       ierr = PetscSFReduceBegin(sfPoint, MPIU_2INT, newLocalPoints, newOwners, MPI_MAXLOC);CHKERRQ(ierr);
2669       ierr = PetscSFReduceEnd(sfPoint, MPIU_2INT, newLocalPoints, newOwners, MPI_MAXLOC);CHKERRQ(ierr);
2670       ierr = PetscSFBcastBegin(sfPoint, MPIU_2INT, newOwners, newLocalPoints);CHKERRQ(ierr);
2671       ierr = PetscSFBcastEnd(sfPoint, MPIU_2INT, newOwners, newLocalPoints);CHKERRQ(ierr);
2672       ierr = PetscMalloc1(numSubLeaves,    &slocalPoints);CHKERRQ(ierr);
2673       ierr = PetscMalloc1(numSubLeaves, &sremotePoints);CHKERRQ(ierr);
2674       for (l = 0, sl = 0, ll = 0; l < numLeaves; ++l) {
2675         const PetscInt point    = localPoints[l];
2676         const PetscInt subPoint = DMPlexFilterPoint_Internal(point, firstSubVertex, numSubVertices, subVertices);
2677 
2678         if (subPoint < 0) continue;
2679         if (newLocalPoints[point].rank == rank) {++ll; continue;}
2680         slocalPoints[sl]        = subPoint;
2681         sremotePoints[sl].rank  = newLocalPoints[point].rank;
2682         sremotePoints[sl].index = newLocalPoints[point].index;
2683         if (sremotePoints[sl].rank  < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid remote rank for local point %d", point);
2684         if (sremotePoints[sl].index < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid remote subpoint for local point %d", point);
2685         ++sl;
2686       }
2687       ierr = PetscFree2(newLocalPoints,newOwners);CHKERRQ(ierr);
2688       if (sl + ll != numSubLeaves) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Mismatch in number of subleaves %d + %d != %d", sl, ll, numSubLeaves);
2689       ierr = PetscSFSetGraph(sfPointSub, numSubRoots, sl, slocalPoints, PETSC_OWN_POINTER, sremotePoints, PETSC_OWN_POINTER);CHKERRQ(ierr);
2690     }
2691   }
2692   CHKMEMQ;
2693   /* Cleanup */
2694   if (subvertexIS) {ierr = ISRestoreIndices(subvertexIS, &subVertices);CHKERRQ(ierr);}
2695   ierr = ISDestroy(&subvertexIS);CHKERRQ(ierr);
2696   ierr = PetscFree(subCells);CHKERRQ(ierr);
2697   PetscFunctionReturn(0);
2698 }
2699 
2700 #undef __FUNCT__
2701 #define __FUNCT__ "DMPlexCreateCohesiveSubmesh_Interpolated"
2702 static PetscErrorCode DMPlexCreateCohesiveSubmesh_Interpolated(DM dm, const char label[], PetscInt value, DM subdm)
2703 {
2704   MPI_Comm         comm;
2705   DMLabel          subpointMap;
2706   IS              *subpointIS;
2707   const PetscInt **subpoints;
2708   PetscInt        *numSubPoints, *firstSubPoint, *coneNew, *orntNew;
2709   PetscInt         totSubPoints = 0, maxConeSize, dim, p, d, v;
2710   PetscErrorCode   ierr;
2711 
2712   PetscFunctionBegin;
2713   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2714   /* Create subpointMap which marks the submesh */
2715   ierr = DMLabelCreate("subpoint_map", &subpointMap);CHKERRQ(ierr);
2716   ierr = DMPlexSetSubpointMap(subdm, subpointMap);CHKERRQ(ierr);
2717   ierr = DMLabelDestroy(&subpointMap);CHKERRQ(ierr);
2718   ierr = DMPlexMarkCohesiveSubmesh_Interpolated(dm, label, value, subpointMap, subdm);CHKERRQ(ierr);
2719   /* Setup chart */
2720   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
2721   ierr = PetscMalloc4(dim+1,&numSubPoints,dim+1,&firstSubPoint,dim+1,&subpointIS,dim+1,&subpoints);CHKERRQ(ierr);
2722   for (d = 0; d <= dim; ++d) {
2723     ierr = DMLabelGetStratumSize(subpointMap, d, &numSubPoints[d]);CHKERRQ(ierr);
2724     totSubPoints += numSubPoints[d];
2725   }
2726   ierr = DMPlexSetChart(subdm, 0, totSubPoints);CHKERRQ(ierr);
2727   ierr = DMPlexSetVTKCellHeight(subdm, 1);CHKERRQ(ierr);
2728   /* Set cone sizes */
2729   firstSubPoint[dim] = 0;
2730   firstSubPoint[0]   = firstSubPoint[dim] + numSubPoints[dim];
2731   if (dim > 1) {firstSubPoint[dim-1] = firstSubPoint[0]     + numSubPoints[0];}
2732   if (dim > 2) {firstSubPoint[dim-2] = firstSubPoint[dim-1] + numSubPoints[dim-1];}
2733   for (d = 0; d <= dim; ++d) {
2734     ierr = DMLabelGetStratumIS(subpointMap, d, &subpointIS[d]);CHKERRQ(ierr);
2735     if (subpointIS[d]) {ierr = ISGetIndices(subpointIS[d], &subpoints[d]);CHKERRQ(ierr);}
2736   }
2737   for (d = 0; d <= dim; ++d) {
2738     for (p = 0; p < numSubPoints[d]; ++p) {
2739       const PetscInt  point    = subpoints[d][p];
2740       const PetscInt  subpoint = firstSubPoint[d] + p;
2741       const PetscInt *cone;
2742       PetscInt        coneSize, coneSizeNew, c, val;
2743 
2744       ierr = DMPlexGetConeSize(dm, point, &coneSize);CHKERRQ(ierr);
2745       ierr = DMPlexSetConeSize(subdm, subpoint, coneSize);CHKERRQ(ierr);
2746       if (d == dim) {
2747         ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
2748         for (c = 0, coneSizeNew = 0; c < coneSize; ++c) {
2749           ierr = DMLabelGetValue(subpointMap, cone[c], &val);CHKERRQ(ierr);
2750           if (val >= 0) coneSizeNew++;
2751         }
2752         ierr = DMPlexSetConeSize(subdm, subpoint, coneSizeNew);CHKERRQ(ierr);
2753       }
2754     }
2755   }
2756   ierr = DMSetUp(subdm);CHKERRQ(ierr);
2757   /* Set cones */
2758   ierr = DMPlexGetMaxSizes(dm, &maxConeSize, NULL);CHKERRQ(ierr);
2759   ierr = PetscMalloc2(maxConeSize,&coneNew,maxConeSize,&orntNew);CHKERRQ(ierr);
2760   for (d = 0; d <= dim; ++d) {
2761     for (p = 0; p < numSubPoints[d]; ++p) {
2762       const PetscInt  point    = subpoints[d][p];
2763       const PetscInt  subpoint = firstSubPoint[d] + p;
2764       const PetscInt *cone, *ornt;
2765       PetscInt        coneSize, subconeSize, coneSizeNew, c, subc;
2766 
2767       ierr = DMPlexGetConeSize(dm, point, &coneSize);CHKERRQ(ierr);
2768       ierr = DMPlexGetConeSize(subdm, subpoint, &subconeSize);CHKERRQ(ierr);
2769       ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
2770       ierr = DMPlexGetConeOrientation(dm, point, &ornt);CHKERRQ(ierr);
2771       for (c = 0, coneSizeNew = 0; c < coneSize; ++c) {
2772         ierr = PetscFindInt(cone[c], numSubPoints[d-1], subpoints[d-1], &subc);CHKERRQ(ierr);
2773         if (subc >= 0) {
2774           coneNew[coneSizeNew]   = firstSubPoint[d-1] + subc;
2775           orntNew[coneSizeNew++] = ornt[c];
2776         }
2777       }
2778       if (coneSizeNew != subconeSize) SETERRQ2(comm, PETSC_ERR_PLIB, "Number of cone points located %d does not match subcone size %d", coneSizeNew, subconeSize);
2779       ierr = DMPlexSetCone(subdm, subpoint, coneNew);CHKERRQ(ierr);
2780       ierr = DMPlexSetConeOrientation(subdm, subpoint, orntNew);CHKERRQ(ierr);
2781     }
2782   }
2783   ierr = PetscFree2(coneNew,orntNew);CHKERRQ(ierr);
2784   ierr = DMPlexSymmetrize(subdm);CHKERRQ(ierr);
2785   ierr = DMPlexStratify(subdm);CHKERRQ(ierr);
2786   /* Build coordinates */
2787   {
2788     PetscSection coordSection, subCoordSection;
2789     Vec          coordinates, subCoordinates;
2790     PetscScalar *coords, *subCoords;
2791     PetscInt     numComp, coordSize;
2792 
2793     ierr = DMPlexGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
2794     ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
2795     ierr = DMPlexGetCoordinateSection(subdm, &subCoordSection);CHKERRQ(ierr);
2796     ierr = PetscSectionSetNumFields(subCoordSection, 1);CHKERRQ(ierr);
2797     ierr = PetscSectionGetFieldComponents(coordSection, 0, &numComp);CHKERRQ(ierr);
2798     ierr = PetscSectionSetFieldComponents(subCoordSection, 0, numComp);CHKERRQ(ierr);
2799     ierr = PetscSectionSetChart(subCoordSection, firstSubPoint[0], firstSubPoint[0]+numSubPoints[0]);CHKERRQ(ierr);
2800     for (v = 0; v < numSubPoints[0]; ++v) {
2801       const PetscInt vertex    = subpoints[0][v];
2802       const PetscInt subvertex = firstSubPoint[0]+v;
2803       PetscInt       dof;
2804 
2805       ierr = PetscSectionGetDof(coordSection, vertex, &dof);CHKERRQ(ierr);
2806       ierr = PetscSectionSetDof(subCoordSection, subvertex, dof);CHKERRQ(ierr);
2807       ierr = PetscSectionSetFieldDof(subCoordSection, subvertex, 0, dof);CHKERRQ(ierr);
2808     }
2809     ierr = PetscSectionSetUp(subCoordSection);CHKERRQ(ierr);
2810     ierr = PetscSectionGetStorageSize(subCoordSection, &coordSize);CHKERRQ(ierr);
2811     ierr = VecCreate(comm, &subCoordinates);CHKERRQ(ierr);
2812     ierr = VecSetSizes(subCoordinates, coordSize, PETSC_DETERMINE);CHKERRQ(ierr);
2813     ierr = VecSetType(subCoordinates,VECSTANDARD);CHKERRQ(ierr);
2814     ierr = VecGetArray(coordinates,    &coords);CHKERRQ(ierr);
2815     ierr = VecGetArray(subCoordinates, &subCoords);CHKERRQ(ierr);
2816     for (v = 0; v < numSubPoints[0]; ++v) {
2817       const PetscInt vertex    = subpoints[0][v];
2818       const PetscInt subvertex = firstSubPoint[0]+v;
2819       PetscInt dof, off, sdof, soff, d;
2820 
2821       ierr = PetscSectionGetDof(coordSection, vertex, &dof);CHKERRQ(ierr);
2822       ierr = PetscSectionGetOffset(coordSection, vertex, &off);CHKERRQ(ierr);
2823       ierr = PetscSectionGetDof(subCoordSection, subvertex, &sdof);CHKERRQ(ierr);
2824       ierr = PetscSectionGetOffset(subCoordSection, subvertex, &soff);CHKERRQ(ierr);
2825       if (dof != sdof) SETERRQ4(comm, PETSC_ERR_PLIB, "Coordinate dimension %d on subvertex %d, vertex %d should be %d", sdof, subvertex, vertex, dof);
2826       for (d = 0; d < dof; ++d) subCoords[soff+d] = coords[off+d];
2827     }
2828     ierr = VecRestoreArray(coordinates,    &coords);CHKERRQ(ierr);
2829     ierr = VecRestoreArray(subCoordinates, &subCoords);CHKERRQ(ierr);
2830     ierr = DMSetCoordinatesLocal(subdm, subCoordinates);CHKERRQ(ierr);
2831     ierr = VecDestroy(&subCoordinates);CHKERRQ(ierr);
2832   }
2833   /* Build SF: We need this complexity because subpoints might not be selected on the owning process */
2834   {
2835     PetscSF            sfPoint, sfPointSub;
2836     IS                 subpIS;
2837     const PetscSFNode *remotePoints;
2838     PetscSFNode       *sremotePoints, *newLocalPoints, *newOwners;
2839     const PetscInt    *localPoints, *subpoints;
2840     PetscInt          *slocalPoints;
2841     PetscInt           numRoots, numLeaves, numSubpoints = 0, numSubroots, numSubleaves = 0, l, sl, ll, pStart, pEnd, p;
2842     PetscMPIInt        rank;
2843 
2844     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject) dm), &rank);CHKERRQ(ierr);
2845     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2846     ierr = DMGetPointSF(subdm, &sfPointSub);CHKERRQ(ierr);
2847     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2848     ierr = DMPlexGetChart(subdm, NULL, &numSubroots);CHKERRQ(ierr);
2849     ierr = DMPlexCreateSubpointIS(subdm, &subpIS);CHKERRQ(ierr);
2850     if (subpIS) {
2851       ierr = ISGetIndices(subpIS, &subpoints);CHKERRQ(ierr);
2852       ierr = ISGetLocalSize(subpIS, &numSubpoints);CHKERRQ(ierr);
2853     }
2854     ierr = PetscSFGetGraph(sfPoint, &numRoots, &numLeaves, &localPoints, &remotePoints);CHKERRQ(ierr);
2855     if (numRoots >= 0) {
2856       ierr = PetscMalloc2(pEnd-pStart,PetscSFNode,&newLocalPoints,numRoots,PetscSFNode,&newOwners);CHKERRQ(ierr);
2857       for (p = 0; p < pEnd-pStart; ++p) {
2858         newLocalPoints[p].rank  = -2;
2859         newLocalPoints[p].index = -2;
2860       }
2861       /* Set subleaves */
2862       for (l = 0; l < numLeaves; ++l) {
2863         const PetscInt point    = localPoints[l];
2864         const PetscInt subpoint = DMPlexFilterPoint_Internal(point, 0, numSubpoints, subpoints);
2865 
2866         if (subpoint < 0) continue;
2867         newLocalPoints[point-pStart].rank  = rank;
2868         newLocalPoints[point-pStart].index = subpoint;
2869         ++numSubleaves;
2870       }
2871       /* Must put in owned subpoints */
2872       for (p = pStart; p < pEnd; ++p) {
2873         const PetscInt subpoint = DMPlexFilterPoint_Internal(p, 0, numSubpoints, subpoints);
2874 
2875         if (subpoint < 0) {
2876           newOwners[p-pStart].rank  = -3;
2877           newOwners[p-pStart].index = -3;
2878         } else {
2879           newOwners[p-pStart].rank  = rank;
2880           newOwners[p-pStart].index = subpoint;
2881         }
2882       }
2883       ierr = PetscSFReduceBegin(sfPoint, MPIU_2INT, newLocalPoints, newOwners, MPI_MAXLOC);CHKERRQ(ierr);
2884       ierr = PetscSFReduceEnd(sfPoint, MPIU_2INT, newLocalPoints, newOwners, MPI_MAXLOC);CHKERRQ(ierr);
2885       ierr = PetscSFBcastBegin(sfPoint, MPIU_2INT, newOwners, newLocalPoints);CHKERRQ(ierr);
2886       ierr = PetscSFBcastEnd(sfPoint, MPIU_2INT, newOwners, newLocalPoints);CHKERRQ(ierr);
2887       ierr = PetscMalloc(numSubleaves * sizeof(PetscInt),    &slocalPoints);CHKERRQ(ierr);
2888       ierr = PetscMalloc(numSubleaves * sizeof(PetscSFNode), &sremotePoints);CHKERRQ(ierr);
2889       for (l = 0, sl = 0, ll = 0; l < numLeaves; ++l) {
2890         const PetscInt point    = localPoints[l];
2891         const PetscInt subpoint = DMPlexFilterPoint_Internal(point, 0, numSubpoints, subpoints);
2892 
2893         if (subpoint < 0) continue;
2894         if (newLocalPoints[point].rank == rank) {++ll; continue;}
2895         slocalPoints[sl]        = subpoint;
2896         sremotePoints[sl].rank  = newLocalPoints[point].rank;
2897         sremotePoints[sl].index = newLocalPoints[point].index;
2898         if (sremotePoints[sl].rank  < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid remote rank for local point %d", point);
2899         if (sremotePoints[sl].index < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid remote subpoint for local point %d", point);
2900         ++sl;
2901       }
2902       if (sl + ll != numSubleaves) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Mismatch in number of subleaves %d + %d != %d", sl, ll, numSubleaves);
2903       ierr = PetscFree2(newLocalPoints,newOwners);CHKERRQ(ierr);
2904       ierr = PetscSFSetGraph(sfPointSub, numSubroots, sl, slocalPoints, PETSC_OWN_POINTER, sremotePoints, PETSC_OWN_POINTER);CHKERRQ(ierr);
2905     }
2906     if (subpIS) {
2907       ierr = ISRestoreIndices(subpIS, &subpoints);CHKERRQ(ierr);
2908       ierr = ISDestroy(&subpIS);CHKERRQ(ierr);
2909     }
2910   }
2911   /* Cleanup */
2912   for (d = 0; d <= dim; ++d) {
2913     if (subpointIS[d]) {ierr = ISRestoreIndices(subpointIS[d], &subpoints[d]);CHKERRQ(ierr);}
2914     ierr = ISDestroy(&subpointIS[d]);CHKERRQ(ierr);
2915   }
2916   ierr = PetscFree4(numSubPoints,firstSubPoint,subpointIS,subpoints);CHKERRQ(ierr);
2917   PetscFunctionReturn(0);
2918 }
2919 
2920 #undef __FUNCT__
2921 #define __FUNCT__ "DMPlexCreateCohesiveSubmesh"
2922 /*
2923   DMPlexCreateCohesiveSubmesh - Extract from a mesh with cohesive cells the hypersurface defined by one face of the cells. Optionally, a Label an be given to restrict the cells.
2924 
2925   Input Parameters:
2926 + dm          - The original mesh
2927 . hasLagrange - The mesh has Lagrange unknowns in the cohesive cells
2928 . label       - A label name, or PETSC_NULL
2929 - value  - A label value
2930 
2931   Output Parameter:
2932 . subdm - The surface mesh
2933 
2934   Note: This function produces a DMLabel mapping original points in the submesh to their depth. This can be obtained using DMPlexGetSubpointMap().
2935 
2936   Level: developer
2937 
2938 .seealso: DMPlexGetSubpointMap(), DMPlexCreateSubmesh()
2939 */
2940 PetscErrorCode DMPlexCreateCohesiveSubmesh(DM dm, PetscBool hasLagrange, const char label[], PetscInt value, DM *subdm)
2941 {
2942   PetscInt       dim, depth;
2943   PetscErrorCode ierr;
2944 
2945   PetscFunctionBegin;
2946   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2947   PetscValidPointer(subdm, 5);
2948   ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
2949   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2950   ierr = DMCreate(PetscObjectComm((PetscObject)dm), subdm);CHKERRQ(ierr);
2951   ierr = DMSetType(*subdm, DMPLEX);CHKERRQ(ierr);
2952   ierr = DMPlexSetDimension(*subdm, dim-1);CHKERRQ(ierr);
2953   if (depth == dim) {
2954     ierr = DMPlexCreateCohesiveSubmesh_Interpolated(dm, label, value, *subdm);CHKERRQ(ierr);
2955   } else {
2956     ierr = DMPlexCreateCohesiveSubmesh_Uninterpolated(dm, hasLagrange, label, value, *subdm);CHKERRQ(ierr);
2957   }
2958   PetscFunctionReturn(0);
2959 }
2960 
2961 #undef __FUNCT__
2962 #define __FUNCT__ "DMPlexGetSubpointMap"
2963 /*@
2964   DMPlexGetSubpointMap - Returns a DMLabel with point dimension as values
2965 
2966   Input Parameter:
2967 . dm - The submesh DM
2968 
2969   Output Parameter:
2970 . subpointMap - The DMLabel of all the points from the original mesh in this submesh, or NULL if this is not a submesh
2971 
2972   Level: developer
2973 
2974 .seealso: DMPlexCreateSubmesh(), DMPlexCreateSubpointIS()
2975 @*/
2976 PetscErrorCode DMPlexGetSubpointMap(DM dm, DMLabel *subpointMap)
2977 {
2978   DM_Plex *mesh = (DM_Plex*) dm->data;
2979 
2980   PetscFunctionBegin;
2981   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2982   PetscValidPointer(subpointMap, 2);
2983   *subpointMap = mesh->subpointMap;
2984   PetscFunctionReturn(0);
2985 }
2986 
2987 #undef __FUNCT__
2988 #define __FUNCT__ "DMPlexSetSubpointMap"
2989 /* Note: Should normally not be called by the user, since it is set in DMPlexCreateSubmesh() */
2990 PetscErrorCode DMPlexSetSubpointMap(DM dm, DMLabel subpointMap)
2991 {
2992   DM_Plex       *mesh = (DM_Plex *) dm->data;
2993   DMLabel        tmp;
2994   PetscErrorCode ierr;
2995 
2996   PetscFunctionBegin;
2997   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2998   tmp  = mesh->subpointMap;
2999   mesh->subpointMap = subpointMap;
3000   ++mesh->subpointMap->refct;
3001   ierr = DMLabelDestroy(&tmp);CHKERRQ(ierr);
3002   PetscFunctionReturn(0);
3003 }
3004 
3005 #undef __FUNCT__
3006 #define __FUNCT__ "DMPlexCreateSubpointIS"
3007 /*@
3008   DMPlexCreateSubpointIS - Creates an IS covering the entire subdm chart with the original points as data
3009 
3010   Input Parameter:
3011 . dm - The submesh DM
3012 
3013   Output Parameter:
3014 . subpointIS - The IS of all the points from the original mesh in this submesh, or NULL if this is not a submesh
3015 
3016   Note: This is IS is guaranteed to be sorted by the construction of the submesh
3017 
3018   Level: developer
3019 
3020 .seealso: DMPlexCreateSubmesh(), DMPlexGetSubpointMap()
3021 @*/
3022 PetscErrorCode DMPlexCreateSubpointIS(DM dm, IS *subpointIS)
3023 {
3024   MPI_Comm        comm;
3025   DMLabel         subpointMap;
3026   IS              is;
3027   const PetscInt *opoints;
3028   PetscInt       *points, *depths;
3029   PetscInt        depth, depStart, depEnd, d, pStart, pEnd, p, n, off;
3030   PetscErrorCode  ierr;
3031 
3032   PetscFunctionBegin;
3033   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3034   PetscValidPointer(subpointIS, 2);
3035   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
3036   *subpointIS = NULL;
3037   ierr = DMPlexGetSubpointMap(dm, &subpointMap);CHKERRQ(ierr);
3038   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3039   if (subpointMap && depth >= 0) {
3040     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
3041     if (pStart) SETERRQ1(comm, PETSC_ERR_ARG_WRONG, "Submeshes must start the point numbering at 0, not %d", pStart);
3042     ierr = DMGetWorkArray(dm, depth+1, PETSC_INT, &depths);CHKERRQ(ierr);
3043     depths[0] = depth;
3044     depths[1] = 0;
3045     for(d = 2; d <= depth; ++d) {depths[d] = depth+1 - d;}
3046     ierr = PetscMalloc1(pEnd, &points);CHKERRQ(ierr);
3047     for(d = 0, off = 0; d <= depth; ++d) {
3048       const PetscInt dep = depths[d];
3049 
3050       ierr = DMPlexGetDepthStratum(dm, dep, &depStart, &depEnd);CHKERRQ(ierr);
3051       ierr = DMLabelGetStratumSize(subpointMap, dep, &n);CHKERRQ(ierr);
3052       if (((d < 2) && (depth > 1)) || (d == 1)) { /* Only check vertices and cells for now since the map is broken for others */
3053         if (n != depEnd-depStart) SETERRQ3(comm, PETSC_ERR_ARG_WRONG, "The number of mapped submesh points %d at depth %d should be %d", n, dep, depEnd-depStart);
3054       } else {
3055         if (!n) {
3056           if (d == 0) {
3057             /* Missing cells */
3058             for(p = 0; p < depEnd-depStart; ++p, ++off) points[off] = -1;
3059           } else {
3060             /* Missing faces */
3061             for(p = 0; p < depEnd-depStart; ++p, ++off) points[off] = PETSC_MAX_INT;
3062           }
3063         }
3064       }
3065       if (n) {
3066         ierr = DMLabelGetStratumIS(subpointMap, dep, &is);CHKERRQ(ierr);
3067         ierr = ISGetIndices(is, &opoints);CHKERRQ(ierr);
3068         for(p = 0; p < n; ++p, ++off) points[off] = opoints[p];
3069         ierr = ISRestoreIndices(is, &opoints);CHKERRQ(ierr);
3070         ierr = ISDestroy(&is);CHKERRQ(ierr);
3071       }
3072     }
3073     ierr = DMRestoreWorkArray(dm, depth+1, PETSC_INT, &depths);CHKERRQ(ierr);
3074     if (off != pEnd) SETERRQ2(comm, PETSC_ERR_ARG_WRONG, "The number of mapped submesh points %d should be %d", off, pEnd);
3075     ierr = ISCreateGeneral(PETSC_COMM_SELF, pEnd, points, PETSC_OWN_POINTER, subpointIS);CHKERRQ(ierr);
3076   }
3077   PetscFunctionReturn(0);
3078 }
3079