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