xref: /petsc/src/dm/impls/plex/plex.c (revision 52a3aeb44792a5b9a7df0df0eecc05d5d6ae0e04)
1 #include <petsc/private/dmpleximpl.h>   /*I      "petscdmplex.h"   I*/
2 #include <petsc/private/isimpl.h>
3 #include <petsc/private/vecimpl.h>
4 #include <petscsf.h>
5 #include <petscds.h>
6 #include <petscdraw.h>
7 
8 /* Logging support */
9 PetscLogEvent DMPLEX_Interpolate, PETSCPARTITIONER_Partition, DMPLEX_Distribute, DMPLEX_DistributeCones, DMPLEX_DistributeLabels, DMPLEX_DistributeSF, DMPLEX_DistributeOverlap, DMPLEX_DistributeField, DMPLEX_DistributeData, DMPLEX_Migrate, DMPLEX_InterpolateSF, DMPLEX_GlobalToNaturalBegin, DMPLEX_GlobalToNaturalEnd, DMPLEX_NaturalToGlobalBegin, DMPLEX_NaturalToGlobalEnd, DMPLEX_Stratify, DMPLEX_Preallocate, DMPLEX_ResidualFEM, DMPLEX_JacobianFEM, DMPLEX_InterpolatorFEM, DMPLEX_InjectorFEM, DMPLEX_IntegralFEM, DMPLEX_CreateGmsh;
10 
11 PETSC_EXTERN PetscErrorCode VecView_MPI(Vec, PetscViewer);
12 PETSC_EXTERN PetscErrorCode VecLoad_Default(Vec, PetscViewer);
13 
14 PetscErrorCode DMPlexGetFieldType_Internal(DM dm, PetscSection section, PetscInt field, PetscInt *sStart, PetscInt *sEnd, PetscViewerVTKFieldType *ft)
15 {
16   PetscInt       dim, pStart, pEnd, vStart, vEnd, cStart, cEnd, cEndInterior, vdof = 0, cdof = 0;
17   PetscErrorCode ierr;
18 
19   PetscFunctionBegin;
20   *ft  = PETSC_VTK_POINT_FIELD;
21   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
22   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
23   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
24   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
25   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
26   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
27   if (field >= 0) {
28     if ((vStart >= pStart) && (vStart < pEnd)) {ierr = PetscSectionGetFieldDof(section, vStart, field, &vdof);CHKERRQ(ierr);}
29     if ((cStart >= pStart) && (cStart < pEnd)) {ierr = PetscSectionGetFieldDof(section, cStart, field, &cdof);CHKERRQ(ierr);}
30   } else {
31     if ((vStart >= pStart) && (vStart < pEnd)) {ierr = PetscSectionGetDof(section, vStart, &vdof);CHKERRQ(ierr);}
32     if ((cStart >= pStart) && (cStart < pEnd)) {ierr = PetscSectionGetDof(section, cStart, &cdof);CHKERRQ(ierr);}
33   }
34   if (vdof) {
35     *sStart = vStart;
36     *sEnd   = vEnd;
37     if (vdof == dim) *ft = PETSC_VTK_POINT_VECTOR_FIELD;
38     else             *ft = PETSC_VTK_POINT_FIELD;
39   } else if (cdof) {
40     *sStart = cStart;
41     *sEnd   = cEnd;
42     if (cdof == dim) *ft = PETSC_VTK_CELL_VECTOR_FIELD;
43     else             *ft = PETSC_VTK_CELL_FIELD;
44   } else SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Could not classify input Vec for VTK");
45   PetscFunctionReturn(0);
46 }
47 
48 PetscErrorCode VecView_Plex_Local_Draw(Vec v, PetscViewer viewer)
49 {
50   DM                 dm;
51   PetscSection       s;
52   PetscDraw          draw, popup;
53   DM                 cdm;
54   PetscSection       coordSection;
55   Vec                coordinates;
56   const PetscScalar *coords, *array;
57   PetscReal          bound[4] = {PETSC_MAX_REAL, PETSC_MAX_REAL, PETSC_MIN_REAL, PETSC_MIN_REAL};
58   PetscReal          vbound[2], time;
59   PetscBool          isnull, flg;
60   PetscInt           dim, Nf, f, Nc, comp, vStart, vEnd, cStart, cEnd, c, N, level, step, w = 0;
61   const char        *name;
62   char               title[PETSC_MAX_PATH_LEN];
63   PetscErrorCode     ierr;
64 
65   PetscFunctionBegin;
66   ierr = PetscViewerDrawGetDraw(viewer, 0, &draw);CHKERRQ(ierr);
67   ierr = PetscDrawIsNull(draw, &isnull);CHKERRQ(ierr);
68   if (isnull) PetscFunctionReturn(0);
69 
70   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
71   ierr = DMGetCoordinateDim(dm, &dim);CHKERRQ(ierr);
72   if (dim != 2) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Cannot draw meshes of dimension %D", dim);
73   ierr = DMGetDefaultSection(dm, &s);CHKERRQ(ierr);
74   ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr);
75   ierr = DMGetCoarsenLevel(dm, &level);CHKERRQ(ierr);
76   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
77   ierr = DMGetDefaultSection(cdm, &coordSection);CHKERRQ(ierr);
78   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
79   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
80   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
81 
82   ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
83   ierr = DMGetOutputSequenceNumber(dm, &step, &time);CHKERRQ(ierr);
84 
85   ierr = VecGetLocalSize(coordinates, &N);CHKERRQ(ierr);
86   ierr = VecGetArrayRead(coordinates, &coords);CHKERRQ(ierr);
87   for (c = 0; c < N; c += dim) {
88     bound[0] = PetscMin(bound[0], PetscRealPart(coords[c]));   bound[2] = PetscMax(bound[2], PetscRealPart(coords[c]));
89     bound[1] = PetscMin(bound[1], PetscRealPart(coords[c+1])); bound[3] = PetscMax(bound[3], PetscRealPart(coords[c+1]));
90   }
91   ierr = VecRestoreArrayRead(coordinates, &coords);CHKERRQ(ierr);
92   ierr = PetscDrawClear(draw);CHKERRQ(ierr);
93 
94   /* Could implement something like DMDASelectFields() */
95   for (f = 0; f < Nf; ++f) {
96     DM   fdm = dm;
97     Vec  fv  = v;
98     IS   fis;
99     char prefix[PETSC_MAX_PATH_LEN];
100     const char *fname;
101 
102     ierr = PetscSectionGetFieldComponents(s, f, &Nc);CHKERRQ(ierr);
103     ierr = PetscSectionGetFieldName(s, f, &fname);CHKERRQ(ierr);
104 
105     if (v->hdr.prefix) {ierr = PetscStrcpy(prefix, v->hdr.prefix);CHKERRQ(ierr);}
106     else               {prefix[0] = '\0';}
107     if (Nf > 1) {
108       ierr = DMCreateSubDM(dm, 1, &f, &fis, &fdm);CHKERRQ(ierr);
109       ierr = VecGetSubVector(v, fis, &fv);CHKERRQ(ierr);
110       ierr = PetscStrcat(prefix, fname);CHKERRQ(ierr);
111       ierr = PetscStrcat(prefix, "_");CHKERRQ(ierr);
112     }
113     for (comp = 0; comp < Nc; ++comp, ++w) {
114       PetscInt nmax = 2;
115 
116       ierr = PetscViewerDrawGetDraw(viewer, w, &draw);CHKERRQ(ierr);
117       if (Nc > 1) {ierr = PetscSNPrintf(title, sizeof(title), "%s:%s_%D Step: %D Time: %.4g", name, fname, comp, step, time);CHKERRQ(ierr);}
118       else        {ierr = PetscSNPrintf(title, sizeof(title), "%s:%s Step: %D Time: %.4g", name, fname, step, time);CHKERRQ(ierr);}
119       ierr = PetscDrawSetTitle(draw, title);CHKERRQ(ierr);
120 
121       /* TODO Get max and min only for this component */
122       ierr = PetscOptionsGetRealArray(NULL, prefix, "-vec_view_bounds", vbound, &nmax, &flg);CHKERRQ(ierr);
123       if (!flg) {
124         ierr = VecMin(fv, NULL, &vbound[0]);CHKERRQ(ierr);
125         ierr = VecMax(fv, NULL, &vbound[1]);CHKERRQ(ierr);
126         if (vbound[1] <= vbound[0]) vbound[1] = vbound[0] + 1.0;
127       }
128       ierr = PetscDrawGetPopup(draw, &popup);CHKERRQ(ierr);
129       ierr = PetscDrawScalePopup(popup, vbound[0], vbound[1]);CHKERRQ(ierr);
130       ierr = PetscDrawSetCoordinates(draw, bound[0], bound[1], bound[2], bound[3]);CHKERRQ(ierr);
131 
132       ierr = VecGetArrayRead(fv, &array);CHKERRQ(ierr);
133       for (c = cStart; c < cEnd; ++c) {
134         PetscScalar *coords = NULL, *a = NULL;
135         PetscInt     numCoords, color[4];
136 
137         ierr = DMPlexPointLocalRead(fdm, c, array, &a);CHKERRQ(ierr);
138         if (a) {
139           color[0] = PetscDrawRealToColor(PetscRealPart(a[comp]), vbound[0], vbound[1]);
140           color[1] = color[2] = color[3] = color[0];
141         } else {
142           PetscScalar *vals = NULL;
143           PetscInt     numVals, va;
144 
145           ierr = DMPlexVecGetClosure(fdm, NULL, fv, c, &numVals, &vals);CHKERRQ(ierr);
146           if (numVals % Nc) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "The number of components %D does not divide the number of values in the closure %D", Nc, numVals);
147           switch (numVals/Nc) {
148           case 3: /* P1 Triangle */
149           case 4: /* P1 Quadrangle */
150             for (va = 0; va < numVals/Nc; ++va) color[va] = PetscDrawRealToColor(PetscRealPart(vals[va*Nc+comp]), vbound[0], vbound[1]);
151             break;
152           case 6: /* P2 Triangle */
153           case 8: /* P2 Quadrangle */
154             for (va = 0; va < numVals/(Nc*2); ++va) color[va] = PetscDrawRealToColor(PetscRealPart(vals[va*Nc+comp + numVals/(Nc*2)]), vbound[0], vbound[1]);
155             break;
156           default: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of values for cell closure %D cannot be handled", numVals/Nc);
157           }
158           ierr = DMPlexVecRestoreClosure(fdm, NULL, fv, c, &numVals, &vals);CHKERRQ(ierr);
159         }
160         ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, &numCoords, &coords);CHKERRQ(ierr);
161         switch (numCoords) {
162         case 6:
163           ierr = PetscDrawTriangle(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]), color[0], color[1], color[2]);CHKERRQ(ierr);
164           break;
165         case 8:
166           ierr = PetscDrawTriangle(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]), color[0], color[1], color[2]);CHKERRQ(ierr);
167           ierr = PetscDrawTriangle(draw, PetscRealPart(coords[4]), PetscRealPart(coords[5]), PetscRealPart(coords[6]), PetscRealPart(coords[7]), PetscRealPart(coords[0]), PetscRealPart(coords[1]), color[2], color[3], color[0]);CHKERRQ(ierr);
168           break;
169         default: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot draw cells with %D coordinates", numCoords);
170         }
171         ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, c, &numCoords, &coords);CHKERRQ(ierr);
172       }
173       ierr = VecRestoreArrayRead(fv, &array);CHKERRQ(ierr);
174       ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
175       ierr = PetscDrawPause(draw);CHKERRQ(ierr);
176       ierr = PetscDrawSave(draw);CHKERRQ(ierr);
177     }
178     if (Nf > 1) {
179       ierr = VecRestoreSubVector(v, fis, &fv);CHKERRQ(ierr);
180       ierr = ISDestroy(&fis);CHKERRQ(ierr);
181       ierr = DMDestroy(&fdm);CHKERRQ(ierr);
182     }
183   }
184   PetscFunctionReturn(0);
185 }
186 
187 PetscErrorCode VecView_Plex_Local(Vec v, PetscViewer viewer)
188 {
189   DM             dm;
190   PetscBool      isvtk, ishdf5, isdraw, isseq;
191   PetscErrorCode ierr;
192 
193   PetscFunctionBegin;
194   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
195   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
196   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,  &isvtk);CHKERRQ(ierr);
197   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
198   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERDRAW, &isdraw);CHKERRQ(ierr);
199   ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
200   if (isvtk || ishdf5) {
201     PetscInt  numFields;
202     PetscBool fem = PETSC_FALSE;
203 
204     ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
205     if (numFields) {
206       PetscObject fe;
207 
208       ierr = DMGetField(dm, 0, &fe);CHKERRQ(ierr);
209       if (fe->classid == PETSCFE_CLASSID) fem = PETSC_TRUE;
210     }
211     if (fem) {ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, v, 0.0, NULL, NULL, NULL);CHKERRQ(ierr);}
212   }
213   if (isvtk) {
214     PetscSection            section;
215     PetscViewerVTKFieldType ft;
216     PetscInt                pStart, pEnd;
217 
218     ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
219     ierr = DMPlexGetFieldType_Internal(dm, section, PETSC_DETERMINE, &pStart, &pEnd, &ft);CHKERRQ(ierr);
220     ierr = PetscObjectReference((PetscObject) v);CHKERRQ(ierr);  /* viewer drops reference */
221     ierr = PetscViewerVTKAddField(viewer, (PetscObject) dm, DMPlexVTKWriteAll, ft, (PetscObject) v);CHKERRQ(ierr);
222   } else if (ishdf5) {
223 #if defined(PETSC_HAVE_HDF5)
224     ierr = VecView_Plex_Local_HDF5(v, viewer);CHKERRQ(ierr);
225 #else
226     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
227 #endif
228   } else if (isdraw) {
229     ierr = VecView_Plex_Local_Draw(v, viewer);CHKERRQ(ierr);
230   } else {
231     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
232     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
233   }
234   PetscFunctionReturn(0);
235 }
236 
237 PetscErrorCode VecView_Plex(Vec v, PetscViewer viewer)
238 {
239   DM             dm;
240   PetscReal      time = 0.0;
241   PetscBool      isvtk, ishdf5, isdraw, isseq;
242   PetscErrorCode ierr;
243 
244   PetscFunctionBegin;
245   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
246   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
247   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,  &isvtk);CHKERRQ(ierr);
248   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
249   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERDRAW, &isdraw);CHKERRQ(ierr);
250   ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
251   if (isvtk) {
252     Vec         locv;
253     const char *name;
254 
255     ierr = DMGetLocalVector(dm, &locv);CHKERRQ(ierr);
256     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
257     ierr = PetscObjectSetName((PetscObject) locv, name);CHKERRQ(ierr);
258     ierr = DMGlobalToLocalBegin(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
259     ierr = DMGlobalToLocalEnd(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
260     ierr = DMGetOutputSequenceNumber(dm, NULL, &time);CHKERRQ(ierr);
261     ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locv, time, NULL, NULL, NULL);CHKERRQ(ierr);
262     ierr = VecView_Plex_Local(locv, viewer);CHKERRQ(ierr);
263     ierr = DMRestoreLocalVector(dm, &locv);CHKERRQ(ierr);
264   } else if (ishdf5) {
265 #if defined(PETSC_HAVE_HDF5)
266     ierr = VecView_Plex_HDF5(v, viewer);CHKERRQ(ierr);
267 #else
268     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
269 #endif
270   } else if (isdraw) {
271     Vec         locv;
272     const char *name;
273 
274     ierr = DMGetLocalVector(dm, &locv);CHKERRQ(ierr);
275     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
276     ierr = PetscObjectSetName((PetscObject) locv, name);CHKERRQ(ierr);
277     ierr = DMGlobalToLocalBegin(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
278     ierr = DMGlobalToLocalEnd(dm, v, INSERT_VALUES, locv);CHKERRQ(ierr);
279     ierr = DMGetOutputSequenceNumber(dm, NULL, &time);CHKERRQ(ierr);
280     ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locv, time, NULL, NULL, NULL);CHKERRQ(ierr);
281     ierr = VecView_Plex_Local(locv, viewer);CHKERRQ(ierr);
282     ierr = DMRestoreLocalVector(dm, &locv);CHKERRQ(ierr);
283   } else {
284     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
285     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
286   }
287   PetscFunctionReturn(0);
288 }
289 
290 PetscErrorCode VecView_Plex_Native(Vec originalv, PetscViewer viewer)
291 {
292   DM                dm;
293   MPI_Comm          comm;
294   PetscViewerFormat format;
295   Vec               v;
296   PetscBool         isvtk, ishdf5;
297   PetscErrorCode    ierr;
298 
299   PetscFunctionBegin;
300   ierr = VecGetDM(originalv, &dm);CHKERRQ(ierr);
301   ierr = PetscObjectGetComm((PetscObject) originalv, &comm);CHKERRQ(ierr);
302   if (!dm) SETERRQ(comm, PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
303   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
304   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
305   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,  &isvtk);CHKERRQ(ierr);
306   if (format == PETSC_VIEWER_NATIVE) {
307     const char *vecname;
308     PetscInt    n, nroots;
309 
310     if (dm->sfNatural) {
311       ierr = VecGetLocalSize(originalv, &n);CHKERRQ(ierr);
312       ierr = PetscSFGetGraph(dm->sfNatural, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
313       if (n == nroots) {
314         ierr = DMGetGlobalVector(dm, &v);CHKERRQ(ierr);
315         ierr = DMPlexGlobalToNaturalBegin(dm, originalv, v);CHKERRQ(ierr);
316         ierr = DMPlexGlobalToNaturalEnd(dm, originalv, v);CHKERRQ(ierr);
317         ierr = PetscObjectGetName((PetscObject) originalv, &vecname);CHKERRQ(ierr);
318         ierr = PetscObjectSetName((PetscObject) v, vecname);CHKERRQ(ierr);
319       } else SETERRQ(comm, PETSC_ERR_ARG_WRONG, "DM global to natural SF only handles global vectors");
320     } else SETERRQ(comm, PETSC_ERR_ARG_WRONGSTATE, "DM global to natural SF was not created");
321   } else {
322     /* we are viewing a natural DMPlex vec. */
323     v = originalv;
324   }
325   if (ishdf5) {
326 #if defined(PETSC_HAVE_HDF5)
327     ierr = VecView_Plex_HDF5_Native(v, viewer);CHKERRQ(ierr);
328 #else
329     SETERRQ(comm, PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
330 #endif
331   } else if (isvtk) {
332     SETERRQ(comm, PETSC_ERR_SUP, "VTK format does not support viewing in natural order. Please switch to HDF5.");
333   } else {
334     PetscBool isseq;
335 
336     ierr = PetscObjectTypeCompare((PetscObject) v, VECSEQ, &isseq);CHKERRQ(ierr);
337     if (isseq) {ierr = VecView_Seq(v, viewer);CHKERRQ(ierr);}
338     else       {ierr = VecView_MPI(v, viewer);CHKERRQ(ierr);}
339   }
340   if (format == PETSC_VIEWER_NATIVE) {ierr = DMRestoreGlobalVector(dm, &v);CHKERRQ(ierr);}
341   PetscFunctionReturn(0);
342 }
343 
344 PetscErrorCode VecLoad_Plex_Local(Vec v, PetscViewer viewer)
345 {
346   DM             dm;
347   PetscBool      ishdf5;
348   PetscErrorCode ierr;
349 
350   PetscFunctionBegin;
351   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
352   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
353   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
354   if (ishdf5) {
355     DM          dmBC;
356     Vec         gv;
357     const char *name;
358 
359     ierr = DMGetOutputDM(dm, &dmBC);CHKERRQ(ierr);
360     ierr = DMGetGlobalVector(dmBC, &gv);CHKERRQ(ierr);
361     ierr = PetscObjectGetName((PetscObject) v, &name);CHKERRQ(ierr);
362     ierr = PetscObjectSetName((PetscObject) gv, name);CHKERRQ(ierr);
363     ierr = VecLoad_Default(gv, viewer);CHKERRQ(ierr);
364     ierr = DMGlobalToLocalBegin(dmBC, gv, INSERT_VALUES, v);CHKERRQ(ierr);
365     ierr = DMGlobalToLocalEnd(dmBC, gv, INSERT_VALUES, v);CHKERRQ(ierr);
366     ierr = DMRestoreGlobalVector(dmBC, &gv);CHKERRQ(ierr);
367   } else {
368     ierr = VecLoad_Default(v, viewer);CHKERRQ(ierr);
369   }
370   PetscFunctionReturn(0);
371 }
372 
373 PetscErrorCode VecLoad_Plex(Vec v, PetscViewer viewer)
374 {
375   DM             dm;
376   PetscBool      ishdf5;
377   PetscErrorCode ierr;
378 
379   PetscFunctionBegin;
380   ierr = VecGetDM(v, &dm);CHKERRQ(ierr);
381   if (!dm) SETERRQ(PetscObjectComm((PetscObject)v), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
382   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
383   if (ishdf5) {
384 #if defined(PETSC_HAVE_HDF5)
385     ierr = VecLoad_Plex_HDF5(v, viewer);CHKERRQ(ierr);
386 #else
387     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
388 #endif
389   } else {
390     ierr = VecLoad_Default(v, viewer);CHKERRQ(ierr);
391   }
392   PetscFunctionReturn(0);
393 }
394 
395 PetscErrorCode VecLoad_Plex_Native(Vec originalv, PetscViewer viewer)
396 {
397   DM                dm;
398   PetscViewerFormat format;
399   PetscBool         ishdf5;
400   PetscErrorCode    ierr;
401 
402   PetscFunctionBegin;
403   ierr = VecGetDM(originalv, &dm);CHKERRQ(ierr);
404   if (!dm) SETERRQ(PetscObjectComm((PetscObject) originalv), PETSC_ERR_ARG_WRONG, "Vector not generated from a DM");
405   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
406   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5, &ishdf5);CHKERRQ(ierr);
407   if (format == PETSC_VIEWER_NATIVE) {
408     if (dm->sfNatural) {
409       if (ishdf5) {
410 #if defined(PETSC_HAVE_HDF5)
411         Vec         v;
412         const char *vecname;
413 
414         ierr = DMGetGlobalVector(dm, &v);CHKERRQ(ierr);
415         ierr = PetscObjectGetName((PetscObject) originalv, &vecname);CHKERRQ(ierr);
416         ierr = PetscObjectSetName((PetscObject) v, vecname);CHKERRQ(ierr);
417         ierr = VecLoad_Plex_HDF5_Native(v, viewer);CHKERRQ(ierr);
418         ierr = DMPlexNaturalToGlobalBegin(dm, v, originalv);CHKERRQ(ierr);
419         ierr = DMPlexNaturalToGlobalEnd(dm, v, originalv);CHKERRQ(ierr);
420         ierr = DMRestoreGlobalVector(dm, &v);CHKERRQ(ierr);
421 #else
422         SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
423 #endif
424       } else SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Reading in natural order is not supported for anything but HDF5.");
425     }
426   }
427   PetscFunctionReturn(0);
428 }
429 
430 PetscErrorCode DMPlexView_Ascii_Geometry(DM dm, PetscViewer viewer)
431 {
432   PetscSection       coordSection;
433   Vec                coordinates;
434   DMLabel            depthLabel;
435   const char        *name[4];
436   const PetscScalar *a;
437   PetscInt           dim, pStart, pEnd, cStart, cEnd, c;
438   PetscErrorCode     ierr;
439 
440   PetscFunctionBegin;
441   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
442   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
443   ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
444   ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
445   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
446   ierr = PetscSectionGetChart(coordSection, &pStart, &pEnd);CHKERRQ(ierr);
447   ierr = VecGetArrayRead(coordinates, &a);CHKERRQ(ierr);
448   name[0]     = "vertex";
449   name[1]     = "edge";
450   name[dim-1] = "face";
451   name[dim]   = "cell";
452   for (c = cStart; c < cEnd; ++c) {
453     PetscInt *closure = NULL;
454     PetscInt  closureSize, cl;
455 
456     ierr = PetscViewerASCIIPrintf(viewer, "Geometry for cell %D:\n", c);CHKERRQ(ierr);
457     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
458     ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
459     for (cl = 0; cl < closureSize*2; cl += 2) {
460       PetscInt point = closure[cl], depth, dof, off, d, p;
461 
462       if ((point < pStart) || (point >= pEnd)) continue;
463       ierr = PetscSectionGetDof(coordSection, point, &dof);CHKERRQ(ierr);
464       if (!dof) continue;
465       ierr = DMLabelGetValue(depthLabel, point, &depth);CHKERRQ(ierr);
466       ierr = PetscSectionGetOffset(coordSection, point, &off);CHKERRQ(ierr);
467       ierr = PetscViewerASCIIPrintf(viewer, "%s %D coords:", name[depth], point);CHKERRQ(ierr);
468       for (p = 0; p < dof/dim; ++p) {
469         ierr = PetscViewerASCIIPrintf(viewer, " (");CHKERRQ(ierr);
470         for (d = 0; d < dim; ++d) {
471           if (d > 0) {ierr = PetscViewerASCIIPrintf(viewer, ", ");CHKERRQ(ierr);}
472           ierr = PetscViewerASCIIPrintf(viewer, "%g", PetscRealPart(a[off+p*dim+d]));CHKERRQ(ierr);
473         }
474         ierr = PetscViewerASCIIPrintf(viewer, ")");CHKERRQ(ierr);
475       }
476       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
477     }
478     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
479     ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
480   }
481   ierr = VecRestoreArrayRead(coordinates, &a);CHKERRQ(ierr);
482   PetscFunctionReturn(0);
483 }
484 
485 PetscErrorCode DMPlexView_Ascii(DM dm, PetscViewer viewer)
486 {
487   DM_Plex          *mesh = (DM_Plex*) dm->data;
488   DM                cdm;
489   DMLabel           markers;
490   PetscSection      coordSection;
491   Vec               coordinates;
492   PetscViewerFormat format;
493   PetscErrorCode    ierr;
494 
495   PetscFunctionBegin;
496   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
497   ierr = DMGetDefaultSection(cdm, &coordSection);CHKERRQ(ierr);
498   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
499   ierr = PetscViewerGetFormat(viewer, &format);CHKERRQ(ierr);
500   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
501     const char *name;
502     PetscInt    maxConeSize, maxSupportSize;
503     PetscInt    pStart, pEnd, p;
504     PetscMPIInt rank, size;
505 
506     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
507     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
508     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
509     ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
510     ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
511     ierr = PetscViewerASCIIPrintf(viewer, "Mesh '%s':\n", name);CHKERRQ(ierr);
512     ierr = PetscViewerASCIIPrintf(viewer, "orientation is missing\n", name);CHKERRQ(ierr);
513     ierr = PetscViewerASCIIPrintf(viewer, "cap --> base:\n", name);CHKERRQ(ierr);
514     ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
515     ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d] Max sizes cone: %D support: %D\n", rank,maxConeSize, maxSupportSize);CHKERRQ(ierr);
516     for (p = pStart; p < pEnd; ++p) {
517       PetscInt dof, off, s;
518 
519       ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
520       ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
521       for (s = off; s < off+dof; ++s) {
522         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d]: %D ----> %D\n", rank, p, mesh->supports[s]);CHKERRQ(ierr);
523       }
524     }
525     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
526     ierr = PetscViewerASCIIPrintf(viewer, "base <-- cap:\n", name);CHKERRQ(ierr);
527     for (p = pStart; p < pEnd; ++p) {
528       PetscInt dof, off, c;
529 
530       ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
531       ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
532       for (c = off; c < off+dof; ++c) {
533         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "[%d]: %D <---- %D (%D)\n", rank, p, mesh->cones[c], mesh->coneOrientations[c]);CHKERRQ(ierr);
534       }
535     }
536     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
537     ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr);
538     ierr = PetscSectionGetChart(coordSection, &pStart, NULL);CHKERRQ(ierr);
539     if (pStart >= 0) {ierr = PetscSectionVecView(coordSection, coordinates, viewer);CHKERRQ(ierr);}
540     ierr = DMGetLabel(dm, "marker", &markers);CHKERRQ(ierr);
541     ierr = DMLabelView(markers,viewer);CHKERRQ(ierr);
542     if (size > 1) {
543       PetscSF sf;
544 
545       ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
546       ierr = PetscSFView(sf, viewer);CHKERRQ(ierr);
547     }
548     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
549   } else if (format == PETSC_VIEWER_ASCII_LATEX) {
550     const char  *name, *color;
551     const char  *defcolors[3]  = {"gray", "orange", "green"};
552     const char  *deflcolors[4] = {"blue", "cyan", "red", "magenta"};
553     PetscReal    scale         = 2.0;
554     PetscBool    useNumbers    = PETSC_TRUE, useLabels, useColors;
555     double       tcoords[3];
556     PetscScalar *coords;
557     PetscInt     numLabels, l, numColors, numLColors, dim, depth, cStart, cEnd, c, vStart, vEnd, v, eStart = 0, eEnd = 0, e, p;
558     PetscMPIInt  rank, size;
559     char         **names, **colors, **lcolors;
560 
561     ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
562     ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
563     ierr = DMGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
564     numLabels  = PetscMax(numLabels, 10);
565     numColors  = 10;
566     numLColors = 10;
567     ierr = PetscCalloc3(numLabels, &names, numColors, &colors, numLColors, &lcolors);CHKERRQ(ierr);
568     ierr = PetscOptionsGetReal(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_scale", &scale, NULL);CHKERRQ(ierr);
569     ierr = PetscOptionsGetBool(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_numbers", &useNumbers, NULL);CHKERRQ(ierr);
570     ierr = PetscOptionsGetStringArray(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_labels", names, &numLabels, &useLabels);CHKERRQ(ierr);
571     if (!useLabels) numLabels = 0;
572     ierr = PetscOptionsGetStringArray(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_colors", colors, &numColors, &useColors);CHKERRQ(ierr);
573     if (!useColors) {
574       numColors = 3;
575       for (c = 0; c < numColors; ++c) {ierr = PetscStrallocpy(defcolors[c], &colors[c]);CHKERRQ(ierr);}
576     }
577     ierr = PetscOptionsGetStringArray(((PetscObject) viewer)->options,((PetscObject) viewer)->prefix, "-dm_plex_view_lcolors", lcolors, &numLColors, &useColors);CHKERRQ(ierr);
578     if (!useColors) {
579       numLColors = 4;
580       for (c = 0; c < numLColors; ++c) {ierr = PetscStrallocpy(deflcolors[c], &lcolors[c]);CHKERRQ(ierr);}
581     }
582     ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank);CHKERRQ(ierr);
583     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size);CHKERRQ(ierr);
584     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
585     ierr = PetscViewerASCIIPrintf(viewer, "\
586 \\documentclass[tikz]{standalone}\n\n\
587 \\usepackage{pgflibraryshapes}\n\
588 \\usetikzlibrary{backgrounds}\n\
589 \\usetikzlibrary{arrows}\n\
590 \\begin{document}\n");CHKERRQ(ierr);
591     if (size > 1) {
592       ierr = PetscViewerASCIIPrintf(viewer, "%s for process ", name);CHKERRQ(ierr);
593       for (p = 0; p < size; ++p) {
594         if (p > 0 && p == size-1) {
595           ierr = PetscViewerASCIIPrintf(viewer, ", and ", colors[p%numColors], p);CHKERRQ(ierr);
596         } else if (p > 0) {
597           ierr = PetscViewerASCIIPrintf(viewer, ", ", colors[p%numColors], p);CHKERRQ(ierr);
598         }
599         ierr = PetscViewerASCIIPrintf(viewer, "{\\textcolor{%s}%D}", colors[p%numColors], p);CHKERRQ(ierr);
600       }
601       ierr = PetscViewerASCIIPrintf(viewer, ".\n\n\n");CHKERRQ(ierr);
602     }
603     ierr = PetscViewerASCIIPrintf(viewer, "\\begin{tikzpicture}[scale = %g,font=\\fontsize{8}{8}\\selectfont]\n", 1.0);CHKERRQ(ierr);
604     /* Plot vertices */
605     ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
606     ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
607     ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
608     for (v = vStart; v < vEnd; ++v) {
609       PetscInt  off, dof, d;
610       PetscBool isLabeled = PETSC_FALSE;
611 
612       ierr = PetscSectionGetDof(coordSection, v, &dof);CHKERRQ(ierr);
613       ierr = PetscSectionGetOffset(coordSection, v, &off);CHKERRQ(ierr);
614       ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\path (");CHKERRQ(ierr);
615       if (PetscUnlikely(dof > 3)) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"coordSection vertex %D has dof %D > 3",v,dof);
616       for (d = 0; d < dof; ++d) {
617         tcoords[d] = (double) (scale*PetscRealPart(coords[off+d]));
618         tcoords[d] = PetscAbsReal(tcoords[d]) < 1e-10 ? 0.0 : tcoords[d];
619       }
620       /* Rotate coordinates since PGF makes z point out of the page instead of up */
621       if (dim == 3) {PetscReal tmp = tcoords[1]; tcoords[1] = tcoords[2]; tcoords[2] = -tmp;}
622       for (d = 0; d < dof; ++d) {
623         if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
624         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", tcoords[d]);CHKERRQ(ierr);
625       }
626       color = colors[rank%numColors];
627       for (l = 0; l < numLabels; ++l) {
628         PetscInt val;
629         ierr = DMGetLabelValue(dm, names[l], v, &val);CHKERRQ(ierr);
630         if (val >= 0) {color = lcolors[l%numLColors]; isLabeled = PETSC_TRUE; break;}
631       }
632       if (useNumbers) {
633         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [draw,shape=circle,color=%s] {%D};\n", v, rank, color, v);CHKERRQ(ierr);
634       } else {
635         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [fill,inner sep=%dpt,shape=circle,color=%s] {};\n", v, rank, !isLabeled ? 1 : 2, color);CHKERRQ(ierr);
636       }
637     }
638     ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
639     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
640     /* Plot edges */
641     if (depth > 1) {ierr = DMPlexGetDepthStratum(dm, 1, &eStart, &eEnd);CHKERRQ(ierr);}
642     if (dim < 3 && useNumbers) {
643       ierr = VecGetArray(coordinates, &coords);CHKERRQ(ierr);
644       ierr = PetscViewerASCIIPrintf(viewer, "\\path\n");CHKERRQ(ierr);
645       for (e = eStart; e < eEnd; ++e) {
646         const PetscInt *cone;
647         PetscInt        coneSize, offA, offB, dof, d;
648 
649         ierr = DMPlexGetConeSize(dm, e, &coneSize);CHKERRQ(ierr);
650         if (coneSize != 2) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Edge %D cone should have two vertices, not %D", e, coneSize);
651         ierr = DMPlexGetCone(dm, e, &cone);CHKERRQ(ierr);
652         ierr = PetscSectionGetDof(coordSection, cone[0], &dof);CHKERRQ(ierr);
653         ierr = PetscSectionGetOffset(coordSection, cone[0], &offA);CHKERRQ(ierr);
654         ierr = PetscSectionGetOffset(coordSection, cone[1], &offB);CHKERRQ(ierr);
655         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(");CHKERRQ(ierr);
656         for (d = 0; d < dof; ++d) {
657           tcoords[d] = (double) (scale*PetscRealPart(coords[offA+d]+coords[offB+d]));
658           tcoords[d] = PetscAbsReal(tcoords[d]) < 1e-10 ? 0.0 : tcoords[d];
659         }
660         /* Rotate coordinates since PGF makes z point out of the page instead of up */
661         if (dim == 3) {PetscReal tmp = tcoords[1]; tcoords[1] = tcoords[2]; tcoords[2] = -tmp;}
662         for (d = 0; d < dof; ++d) {
663           if (d > 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, ",");CHKERRQ(ierr);}
664           ierr = PetscViewerASCIISynchronizedPrintf(viewer, "%g", (double)tcoords[d]);CHKERRQ(ierr);
665         }
666         color = colors[rank%numColors];
667         for (l = 0; l < numLabels; ++l) {
668           PetscInt val;
669           ierr = DMGetLabelValue(dm, names[l], v, &val);CHKERRQ(ierr);
670           if (val >= 0) {color = lcolors[l%numLColors]; break;}
671         }
672         ierr = PetscViewerASCIISynchronizedPrintf(viewer, ") node(%D_%d) [draw,shape=circle,color=%s] {%D} --\n", e, rank, color, e);CHKERRQ(ierr);
673       }
674       ierr = VecRestoreArray(coordinates, &coords);CHKERRQ(ierr);
675       ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
676       ierr = PetscViewerASCIIPrintf(viewer, "(0,0);\n");CHKERRQ(ierr);
677     }
678     /* Plot cells */
679     if (dim == 3 || !useNumbers) {
680       for (e = eStart; e < eEnd; ++e) {
681         const PetscInt *cone;
682 
683         color = colors[rank%numColors];
684         for (l = 0; l < numLabels; ++l) {
685           PetscInt val;
686           ierr = DMGetLabelValue(dm, names[l], e, &val);CHKERRQ(ierr);
687           if (val >= 0) {color = lcolors[l%numLColors]; break;}
688         }
689         ierr = DMPlexGetCone(dm, e, &cone);CHKERRQ(ierr);
690         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\draw[color=%s] (%D_%d) -- (%D_%d);\n", color, cone[0], rank, cone[1], rank);CHKERRQ(ierr);
691       }
692     } else {
693       ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
694       for (c = cStart; c < cEnd; ++c) {
695         PetscInt *closure = NULL;
696         PetscInt  closureSize, firstPoint = -1;
697 
698         ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
699         ierr = PetscViewerASCIISynchronizedPrintf(viewer, "\\draw[color=%s] ", colors[rank%numColors]);CHKERRQ(ierr);
700         for (p = 0; p < closureSize*2; p += 2) {
701           const PetscInt point = closure[p];
702 
703           if ((point < vStart) || (point >= vEnd)) continue;
704           if (firstPoint >= 0) {ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- ");CHKERRQ(ierr);}
705           ierr = PetscViewerASCIISynchronizedPrintf(viewer, "(%D_%d)", point, rank);CHKERRQ(ierr);
706           if (firstPoint < 0) firstPoint = point;
707         }
708         /* Why doesn't this work? ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- cycle;\n");CHKERRQ(ierr); */
709         ierr = PetscViewerASCIISynchronizedPrintf(viewer, " -- (%D_%d);\n", firstPoint, rank);CHKERRQ(ierr);
710         ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
711       }
712     }
713     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
714     ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr);
715     ierr = PetscViewerASCIIPrintf(viewer, "\\end{tikzpicture}\n");CHKERRQ(ierr);
716     ierr = PetscViewerASCIIPrintf(viewer, "\\end{document}\n", name);CHKERRQ(ierr);
717     for (l = 0; l < numLabels;  ++l) {ierr = PetscFree(names[l]);CHKERRQ(ierr);}
718     for (c = 0; c < numColors;  ++c) {ierr = PetscFree(colors[c]);CHKERRQ(ierr);}
719     for (c = 0; c < numLColors; ++c) {ierr = PetscFree(lcolors[c]);CHKERRQ(ierr);}
720     ierr = PetscFree3(names, colors, lcolors);CHKERRQ(ierr);
721   } else {
722     MPI_Comm    comm;
723     PetscInt   *sizes, *hybsizes;
724     PetscInt    locDepth, depth, dim, d, pMax[4];
725     PetscInt    pStart, pEnd, p;
726     PetscInt    numLabels, l;
727     const char *name;
728     PetscMPIInt size;
729 
730     ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
731     ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
732     ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
733     ierr = PetscObjectGetName((PetscObject) dm, &name);CHKERRQ(ierr);
734     if (name) {ierr = PetscViewerASCIIPrintf(viewer, "%s in %D dimensions:\n", name, dim);CHKERRQ(ierr);}
735     else      {ierr = PetscViewerASCIIPrintf(viewer, "Mesh in %D dimensions:\n", dim);CHKERRQ(ierr);}
736     ierr = DMPlexGetDepth(dm, &locDepth);CHKERRQ(ierr);
737     ierr = MPIU_Allreduce(&locDepth, &depth, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
738     ierr = DMPlexGetHybridBounds(dm, &pMax[depth], depth > 0 ? &pMax[depth-1] : NULL, &pMax[1], &pMax[0]);CHKERRQ(ierr);
739     ierr = PetscMalloc2(size,&sizes,size,&hybsizes);CHKERRQ(ierr);
740     if (depth == 1) {
741       ierr = DMPlexGetDepthStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
742       pEnd = pEnd - pStart;
743       ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
744       ierr = PetscViewerASCIIPrintf(viewer, "  %d-cells:", 0);CHKERRQ(ierr);
745       for (p = 0; p < size; ++p) {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
746       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
747       ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
748       pEnd = pEnd - pStart;
749       ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
750       ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", dim);CHKERRQ(ierr);
751       for (p = 0; p < size; ++p) {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
752       ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
753     } else {
754       PetscMPIInt rank;
755       ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
756       for (d = 0; d <= dim; d++) {
757         ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
758         pEnd    -= pStart;
759         pMax[d] -= pStart;
760         ierr = MPI_Gather(&pEnd, 1, MPIU_INT, sizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
761         ierr = MPI_Gather(&pMax[d], 1, MPIU_INT, hybsizes, 1, MPIU_INT, 0, comm);CHKERRQ(ierr);
762         ierr = PetscViewerASCIIPrintf(viewer, "  %D-cells:", d);CHKERRQ(ierr);
763         for (p = 0; p < size; ++p) {
764           if (!rank) {
765             if (hybsizes[p] >= 0) {ierr = PetscViewerASCIIPrintf(viewer, " %D (%D)", sizes[p], sizes[p] - hybsizes[p]);CHKERRQ(ierr);}
766             else                  {ierr = PetscViewerASCIIPrintf(viewer, " %D", sizes[p]);CHKERRQ(ierr);}
767           }
768         }
769         ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
770       }
771     }
772     ierr = PetscFree2(sizes,hybsizes);CHKERRQ(ierr);
773     ierr = DMGetNumLabels(dm, &numLabels);CHKERRQ(ierr);
774     if (numLabels) {ierr = PetscViewerASCIIPrintf(viewer, "Labels:\n");CHKERRQ(ierr);}
775     for (l = 0; l < numLabels; ++l) {
776       DMLabel         label;
777       const char     *name;
778       IS              valueIS;
779       const PetscInt *values;
780       PetscInt        numValues, v;
781 
782       ierr = DMGetLabelName(dm, l, &name);CHKERRQ(ierr);
783       ierr = DMGetLabel(dm, name, &label);CHKERRQ(ierr);
784       ierr = DMLabelGetNumValues(label, &numValues);CHKERRQ(ierr);
785       ierr = PetscViewerASCIIPrintf(viewer, "  %s: %D strata of sizes (", name, numValues);CHKERRQ(ierr);
786       ierr = DMLabelGetValueIS(label, &valueIS);CHKERRQ(ierr);
787       ierr = ISGetIndices(valueIS, &values);CHKERRQ(ierr);
788       ierr = PetscViewerASCIIUseTabs(viewer, PETSC_FALSE);CHKERRQ(ierr);
789       for (v = 0; v < numValues; ++v) {
790         PetscInt size;
791 
792         ierr = DMLabelGetStratumSize(label, values[v], &size);CHKERRQ(ierr);
793         if (v > 0) {ierr = PetscViewerASCIIPrintf(viewer, ", ");CHKERRQ(ierr);}
794         ierr = PetscViewerASCIIPrintf(viewer, "%D", size);CHKERRQ(ierr);
795       }
796       ierr = PetscViewerASCIIPrintf(viewer, ")\n");CHKERRQ(ierr);
797       ierr = PetscViewerASCIIUseTabs(viewer, PETSC_TRUE);CHKERRQ(ierr);
798       ierr = ISRestoreIndices(valueIS, &values);CHKERRQ(ierr);
799       ierr = ISDestroy(&valueIS);CHKERRQ(ierr);
800     }
801     ierr = DMGetCoarseDM(dm, &cdm);CHKERRQ(ierr);
802     if (cdm) {
803       ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
804       ierr = DMPlexView_Ascii(cdm, viewer);CHKERRQ(ierr);
805       ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
806     }
807   }
808   PetscFunctionReturn(0);
809 }
810 
811 PetscErrorCode DMPlexView_Draw(DM dm, PetscViewer viewer)
812 {
813   PetscDraw          draw;
814   DM                 cdm;
815   PetscSection       coordSection;
816   Vec                coordinates;
817   const PetscScalar *coords;
818   PetscReal          bound[4] = {PETSC_MAX_REAL, PETSC_MAX_REAL, PETSC_MIN_REAL, PETSC_MIN_REAL};
819   PetscBool          isnull;
820   PetscInt           dim, vStart, vEnd, cStart, cEnd, c, N;
821   PetscErrorCode     ierr;
822 
823   PetscFunctionBegin;
824   ierr = DMGetCoordinateDim(dm, &dim);CHKERRQ(ierr);
825   if (dim != 2) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Cannot draw meshes of dimension %D", dim);
826   ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
827   ierr = DMGetDefaultSection(cdm, &coordSection);CHKERRQ(ierr);
828   ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
829   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
830   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
831 
832   ierr = PetscViewerDrawGetDraw(viewer, 0, &draw);CHKERRQ(ierr);
833   ierr = PetscDrawIsNull(draw, &isnull);CHKERRQ(ierr);
834   if (isnull) PetscFunctionReturn(0);
835   ierr = PetscDrawSetTitle(draw, "Mesh");CHKERRQ(ierr);
836 
837   ierr = VecGetLocalSize(coordinates, &N);CHKERRQ(ierr);
838   ierr = VecGetArrayRead(coordinates, &coords);CHKERRQ(ierr);
839   for (c = 0; c < N; c += dim) {
840     bound[0] = PetscMin(bound[0], PetscRealPart(coords[c]));   bound[2] = PetscMax(bound[2], PetscRealPart(coords[c]));
841     bound[1] = PetscMin(bound[1], PetscRealPart(coords[c+1])); bound[3] = PetscMax(bound[3], PetscRealPart(coords[c+1]));
842   }
843   ierr = VecRestoreArrayRead(coordinates, &coords);CHKERRQ(ierr);
844   ierr = PetscDrawSetCoordinates(draw, bound[0], bound[1], bound[2], bound[3]);CHKERRQ(ierr);
845   ierr = PetscDrawClear(draw);CHKERRQ(ierr);
846 
847   for (c = cStart; c < cEnd; ++c) {
848     PetscScalar *coords = NULL;
849     PetscInt     numCoords;
850 
851     ierr = DMPlexVecGetClosure(dm, coordSection, coordinates, c, &numCoords, &coords);CHKERRQ(ierr);
852     switch (numCoords) {
853     case 6:
854       ierr = PetscDrawLine(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
855       ierr = PetscDrawLine(draw, PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
856       ierr = PetscDrawLine(draw, PetscRealPart(coords[4]), PetscRealPart(coords[5]), PetscRealPart(coords[0]), PetscRealPart(coords[1]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
857       break;
858     case 8:
859       ierr = PetscDrawLine(draw, PetscRealPart(coords[0]), PetscRealPart(coords[1]), PetscRealPart(coords[2]), PetscRealPart(coords[3]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
860       ierr = PetscDrawLine(draw, PetscRealPart(coords[2]), PetscRealPart(coords[3]), PetscRealPart(coords[4]), PetscRealPart(coords[5]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
861       ierr = PetscDrawLine(draw, PetscRealPart(coords[4]), PetscRealPart(coords[5]), PetscRealPart(coords[6]), PetscRealPart(coords[7]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
862       ierr = PetscDrawLine(draw, PetscRealPart(coords[6]), PetscRealPart(coords[7]), PetscRealPart(coords[0]), PetscRealPart(coords[1]), PETSC_DRAW_BLACK);CHKERRQ(ierr);
863       break;
864     default: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot draw cells with %D coordinates", numCoords);
865     }
866     ierr = DMPlexVecRestoreClosure(dm, coordSection, coordinates, c, &numCoords, &coords);CHKERRQ(ierr);
867   }
868   ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
869   ierr = PetscDrawPause(draw);CHKERRQ(ierr);
870   ierr = PetscDrawSave(draw);CHKERRQ(ierr);
871   PetscFunctionReturn(0);
872 }
873 
874 PetscErrorCode DMView_Plex(DM dm, PetscViewer viewer)
875 {
876   PetscBool      iascii, ishdf5, isvtk, isdraw;
877   PetscErrorCode ierr;
878 
879   PetscFunctionBegin;
880   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
881   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
882   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr);
883   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERVTK,   &isvtk);CHKERRQ(ierr);
884   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,  &ishdf5);CHKERRQ(ierr);
885   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERDRAW,  &isdraw);CHKERRQ(ierr);
886   if (iascii) {
887     ierr = DMPlexView_Ascii(dm, viewer);CHKERRQ(ierr);
888   } else if (ishdf5) {
889 #if defined(PETSC_HAVE_HDF5)
890     ierr = PetscViewerPushFormat(viewer, PETSC_VIEWER_HDF5_VIZ);CHKERRQ(ierr);
891     ierr = DMPlexView_HDF5(dm, viewer);CHKERRQ(ierr);
892     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
893 #else
894     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
895 #endif
896   } else if (isvtk) {
897     ierr = DMPlexVTKWriteAll((PetscObject) dm,viewer);CHKERRQ(ierr);
898   } else if (isdraw) {
899     ierr = DMPlexView_Draw(dm, viewer);CHKERRQ(ierr);
900   }
901   PetscFunctionReturn(0);
902 }
903 
904 PetscErrorCode DMLoad_Plex(DM dm, PetscViewer viewer)
905 {
906   PetscBool      isbinary, ishdf5;
907   PetscErrorCode ierr;
908 
909   PetscFunctionBegin;
910   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
911   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
912   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERBINARY, &isbinary);CHKERRQ(ierr);
913   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERHDF5,   &ishdf5);CHKERRQ(ierr);
914   if (isbinary) {SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Do not yet support binary viewers");}
915   else if (ishdf5) {
916 #if defined(PETSC_HAVE_HDF5)
917     ierr = DMPlexLoad_HDF5(dm, viewer);CHKERRQ(ierr);
918 #else
919     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "HDF5 not supported in this build.\nPlease reconfigure using --download-hdf5");
920 #endif
921   }
922   PetscFunctionReturn(0);
923 }
924 
925 
926 PetscErrorCode DMDestroy_Plex(DM dm)
927 {
928   DM_Plex       *mesh = (DM_Plex*) dm->data;
929   PetscErrorCode ierr;
930 
931   PetscFunctionBegin;
932   if (--mesh->refct > 0) PetscFunctionReturn(0);
933   ierr = PetscSectionDestroy(&mesh->coneSection);CHKERRQ(ierr);
934   ierr = PetscFree(mesh->cones);CHKERRQ(ierr);
935   ierr = PetscFree(mesh->coneOrientations);CHKERRQ(ierr);
936   ierr = PetscSectionDestroy(&mesh->supportSection);CHKERRQ(ierr);
937   ierr = PetscSectionDestroy(&mesh->subdomainSection);CHKERRQ(ierr);
938   ierr = PetscFree(mesh->supports);CHKERRQ(ierr);
939   ierr = PetscFree(mesh->facesTmp);CHKERRQ(ierr);
940   ierr = PetscFree(mesh->tetgenOpts);CHKERRQ(ierr);
941   ierr = PetscFree(mesh->triangleOpts);CHKERRQ(ierr);
942   ierr = PetscPartitionerDestroy(&mesh->partitioner);CHKERRQ(ierr);
943   ierr = DMLabelDestroy(&mesh->subpointMap);CHKERRQ(ierr);
944   ierr = ISDestroy(&mesh->globalVertexNumbers);CHKERRQ(ierr);
945   ierr = ISDestroy(&mesh->globalCellNumbers);CHKERRQ(ierr);
946   ierr = PetscSectionDestroy(&mesh->anchorSection);CHKERRQ(ierr);
947   ierr = ISDestroy(&mesh->anchorIS);CHKERRQ(ierr);
948   ierr = PetscSectionDestroy(&mesh->parentSection);CHKERRQ(ierr);
949   ierr = PetscFree(mesh->parents);CHKERRQ(ierr);
950   ierr = PetscFree(mesh->childIDs);CHKERRQ(ierr);
951   ierr = PetscSectionDestroy(&mesh->childSection);CHKERRQ(ierr);
952   ierr = PetscFree(mesh->children);CHKERRQ(ierr);
953   ierr = DMDestroy(&mesh->referenceTree);CHKERRQ(ierr);
954   ierr = PetscGridHashDestroy(&mesh->lbox);CHKERRQ(ierr);
955   /* This was originally freed in DMDestroy(), but that prevents reference counting of backend objects */
956   ierr = PetscFree(mesh);CHKERRQ(ierr);
957   ierr = PetscObjectComposeFunction((PetscObject)dm,"DMAdaptLabel_C",NULL);CHKERRQ(ierr);
958   PetscFunctionReturn(0);
959 }
960 
961 PetscErrorCode DMCreateMatrix_Plex(DM dm, Mat *J)
962 {
963   PetscSection           sectionGlobal;
964   PetscInt               bs = -1, mbs;
965   PetscInt               localSize;
966   PetscBool              isShell, isBlock, isSeqBlock, isMPIBlock, isSymBlock, isSymSeqBlock, isSymMPIBlock, isMatIS;
967   PetscErrorCode         ierr;
968   MatType                mtype;
969   ISLocalToGlobalMapping ltog;
970 
971   PetscFunctionBegin;
972   ierr = MatInitializePackage();CHKERRQ(ierr);
973   mtype = dm->mattype;
974   ierr = DMGetDefaultGlobalSection(dm, &sectionGlobal);CHKERRQ(ierr);
975   /* ierr = PetscSectionGetStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr); */
976   ierr = PetscSectionGetConstrainedStorageSize(sectionGlobal, &localSize);CHKERRQ(ierr);
977   ierr = MatCreate(PetscObjectComm((PetscObject)dm), J);CHKERRQ(ierr);
978   ierr = MatSetSizes(*J, localSize, localSize, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
979   ierr = MatSetType(*J, mtype);CHKERRQ(ierr);
980   ierr = MatSetFromOptions(*J);CHKERRQ(ierr);
981   ierr = MatGetBlockSize(*J, &mbs);CHKERRQ(ierr);
982   if (mbs > 1) bs = mbs;
983   ierr = PetscStrcmp(mtype, MATSHELL, &isShell);CHKERRQ(ierr);
984   ierr = PetscStrcmp(mtype, MATBAIJ, &isBlock);CHKERRQ(ierr);
985   ierr = PetscStrcmp(mtype, MATSEQBAIJ, &isSeqBlock);CHKERRQ(ierr);
986   ierr = PetscStrcmp(mtype, MATMPIBAIJ, &isMPIBlock);CHKERRQ(ierr);
987   ierr = PetscStrcmp(mtype, MATSBAIJ, &isSymBlock);CHKERRQ(ierr);
988   ierr = PetscStrcmp(mtype, MATSEQSBAIJ, &isSymSeqBlock);CHKERRQ(ierr);
989   ierr = PetscStrcmp(mtype, MATMPISBAIJ, &isSymMPIBlock);CHKERRQ(ierr);
990   ierr = PetscStrcmp(mtype, MATIS, &isMatIS);CHKERRQ(ierr);
991   if (!isShell) {
992     PetscSection subSection;
993     PetscBool    fillMatrix = (PetscBool)(!dm->prealloc_only && !isMatIS);
994     PetscInt    *dnz, *onz, *dnzu, *onzu, bsLocal, bsMax, bsMin, *ltogidx, lsize;
995     PetscInt     pStart, pEnd, p, dof, cdof;
996 
997     /* Set localtoglobalmapping on the matrix for MatSetValuesLocal() to work (it also creates the local matrices in case of MATIS) */
998     if (isMatIS) { /* need a different l2g map than the one computed by DMGetLocalToGlobalMapping */
999       PetscSection section;
1000       PetscInt     size;
1001 
1002       ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);
1003       ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
1004       ierr = PetscMalloc1(size,&ltogidx);CHKERRQ(ierr);
1005       ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);
1006     } else {
1007       ierr = DMGetLocalToGlobalMapping(dm,&ltog);CHKERRQ(ierr);
1008     }
1009     ierr = PetscSectionGetChart(sectionGlobal, &pStart, &pEnd);CHKERRQ(ierr);
1010     for (p = pStart, lsize = 0; p < pEnd; ++p) {
1011       PetscInt bdof;
1012 
1013       ierr = PetscSectionGetDof(sectionGlobal, p, &dof);CHKERRQ(ierr);
1014       ierr = PetscSectionGetConstraintDof(sectionGlobal, p, &cdof);CHKERRQ(ierr);
1015       dof  = dof < 0 ? -(dof+1) : dof;
1016       bdof = cdof && (dof-cdof) ? 1 : dof;
1017       if (dof) {
1018         if (bs < 0)          {bs = bdof;}
1019         else if (bs != bdof) {bs = 1; if (!isMatIS) break;}
1020       }
1021       if (isMatIS) {
1022         PetscInt loff,c,off;
1023         ierr = PetscSectionGetOffset(subSection, p, &loff);CHKERRQ(ierr);
1024         ierr = PetscSectionGetOffset(sectionGlobal, p, &off);CHKERRQ(ierr);
1025         for (c = 0; c < dof-cdof; ++c, ++lsize) ltogidx[loff+c] = off > -1 ? off+c : -(off+1)+c;
1026       }
1027     }
1028     /* Must have same blocksize on all procs (some might have no points) */
1029     bsLocal = bs;
1030     ierr = MPIU_Allreduce(&bsLocal, &bsMax, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
1031     bsLocal = bs < 0 ? bsMax : bs;
1032     ierr = MPIU_Allreduce(&bsLocal, &bsMin, 1, MPIU_INT, MPI_MIN, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
1033     if (bsMin != bsMax) {bs = 1;}
1034     else                {bs = bsMax;}
1035     bs   = bs < 0 ? 1 : bs;
1036     if (isMatIS) {
1037       PetscInt l;
1038       /* Must reduce indices by blocksize */
1039       if (bs > 1) for (l = 0; l < lsize; ++l) ltogidx[l] /= bs;
1040       ierr = ISLocalToGlobalMappingCreate(PetscObjectComm((PetscObject)dm), bs, lsize, ltogidx, PETSC_OWN_POINTER, &ltog);CHKERRQ(ierr);
1041     }
1042     ierr = MatSetLocalToGlobalMapping(*J,ltog,ltog);CHKERRQ(ierr);
1043     if (isMatIS) {
1044       ierr = ISLocalToGlobalMappingDestroy(&ltog);CHKERRQ(ierr);
1045     }
1046     ierr = PetscCalloc4(localSize/bs, &dnz, localSize/bs, &onz, localSize/bs, &dnzu, localSize/bs, &onzu);CHKERRQ(ierr);
1047     ierr = DMPlexPreallocateOperator(dm, bs, dnz, onz, dnzu, onzu, *J, fillMatrix);CHKERRQ(ierr);
1048     ierr = PetscFree4(dnz, onz, dnzu, onzu);CHKERRQ(ierr);
1049   }
1050   ierr = MatSetDM(*J, dm);CHKERRQ(ierr);
1051   PetscFunctionReturn(0);
1052 }
1053 
1054 /*
1055   DMPlexGetSubdomainGlobalSection - Returns the section associated with the subdomain
1056 
1057   Not collective
1058 
1059   Input Parameter:
1060 . mesh - The DMPlex
1061 
1062   Output Parameters:
1063 . subsection - The subdomain section
1064 
1065   Level: developer
1066 
1067 .seealso:
1068 */
1069 PetscErrorCode DMPlexGetSubdomainSection(DM dm, PetscSection *subsection)
1070 {
1071   DM_Plex       *mesh = (DM_Plex*) dm->data;
1072   PetscErrorCode ierr;
1073 
1074   PetscFunctionBegin;
1075   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1076   if (!mesh->subdomainSection) {
1077     PetscSection section;
1078     PetscSF      sf;
1079 
1080     ierr = PetscSFCreate(PETSC_COMM_SELF,&sf);CHKERRQ(ierr);
1081     ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
1082     ierr = PetscSectionCreateGlobalSection(section,sf,PETSC_FALSE,PETSC_TRUE,&mesh->subdomainSection);CHKERRQ(ierr);
1083     ierr = PetscSFDestroy(&sf);CHKERRQ(ierr);
1084   }
1085   *subsection = mesh->subdomainSection;
1086   PetscFunctionReturn(0);
1087 }
1088 
1089 /*@
1090   DMPlexGetChart - Return the interval for all mesh points [pStart, pEnd)
1091 
1092   Not collective
1093 
1094   Input Parameter:
1095 . mesh - The DMPlex
1096 
1097   Output Parameters:
1098 + pStart - The first mesh point
1099 - pEnd   - The upper bound for mesh points
1100 
1101   Level: beginner
1102 
1103 .seealso: DMPlexCreate(), DMPlexSetChart()
1104 @*/
1105 PetscErrorCode DMPlexGetChart(DM dm, PetscInt *pStart, PetscInt *pEnd)
1106 {
1107   DM_Plex       *mesh = (DM_Plex*) dm->data;
1108   PetscErrorCode ierr;
1109 
1110   PetscFunctionBegin;
1111   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1112   ierr = PetscSectionGetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
1113   PetscFunctionReturn(0);
1114 }
1115 
1116 /*@
1117   DMPlexSetChart - Set the interval for all mesh points [pStart, pEnd)
1118 
1119   Not collective
1120 
1121   Input Parameters:
1122 + mesh - The DMPlex
1123 . pStart - The first mesh point
1124 - pEnd   - The upper bound for mesh points
1125 
1126   Output Parameters:
1127 
1128   Level: beginner
1129 
1130 .seealso: DMPlexCreate(), DMPlexGetChart()
1131 @*/
1132 PetscErrorCode DMPlexSetChart(DM dm, PetscInt pStart, PetscInt pEnd)
1133 {
1134   DM_Plex       *mesh = (DM_Plex*) dm->data;
1135   PetscErrorCode ierr;
1136 
1137   PetscFunctionBegin;
1138   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1139   ierr = PetscSectionSetChart(mesh->coneSection, pStart, pEnd);CHKERRQ(ierr);
1140   ierr = PetscSectionSetChart(mesh->supportSection, pStart, pEnd);CHKERRQ(ierr);
1141   PetscFunctionReturn(0);
1142 }
1143 
1144 /*@
1145   DMPlexGetConeSize - Return the number of in-edges for this point in the Sieve DAG
1146 
1147   Not collective
1148 
1149   Input Parameters:
1150 + mesh - The DMPlex
1151 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1152 
1153   Output Parameter:
1154 . size - The cone size for point p
1155 
1156   Level: beginner
1157 
1158 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
1159 @*/
1160 PetscErrorCode DMPlexGetConeSize(DM dm, PetscInt p, PetscInt *size)
1161 {
1162   DM_Plex       *mesh = (DM_Plex*) dm->data;
1163   PetscErrorCode ierr;
1164 
1165   PetscFunctionBegin;
1166   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1167   PetscValidPointer(size, 3);
1168   ierr = PetscSectionGetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
1169   PetscFunctionReturn(0);
1170 }
1171 
1172 /*@
1173   DMPlexSetConeSize - Set the number of in-edges for this point in the Sieve DAG
1174 
1175   Not collective
1176 
1177   Input Parameters:
1178 + mesh - The DMPlex
1179 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1180 - size - The cone size for point p
1181 
1182   Output Parameter:
1183 
1184   Note:
1185   This should be called after DMPlexSetChart().
1186 
1187   Level: beginner
1188 
1189 .seealso: DMPlexCreate(), DMPlexGetConeSize(), DMPlexSetChart()
1190 @*/
1191 PetscErrorCode DMPlexSetConeSize(DM dm, PetscInt p, PetscInt size)
1192 {
1193   DM_Plex       *mesh = (DM_Plex*) dm->data;
1194   PetscErrorCode ierr;
1195 
1196   PetscFunctionBegin;
1197   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1198   ierr = PetscSectionSetDof(mesh->coneSection, p, size);CHKERRQ(ierr);
1199 
1200   mesh->maxConeSize = PetscMax(mesh->maxConeSize, size);
1201   PetscFunctionReturn(0);
1202 }
1203 
1204 /*@
1205   DMPlexAddConeSize - Add the given number of in-edges to this point in the Sieve DAG
1206 
1207   Not collective
1208 
1209   Input Parameters:
1210 + mesh - The DMPlex
1211 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1212 - size - The additional cone size for point p
1213 
1214   Output Parameter:
1215 
1216   Note:
1217   This should be called after DMPlexSetChart().
1218 
1219   Level: beginner
1220 
1221 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexGetConeSize(), DMPlexSetChart()
1222 @*/
1223 PetscErrorCode DMPlexAddConeSize(DM dm, PetscInt p, PetscInt size)
1224 {
1225   DM_Plex       *mesh = (DM_Plex*) dm->data;
1226   PetscInt       csize;
1227   PetscErrorCode ierr;
1228 
1229   PetscFunctionBegin;
1230   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1231   ierr = PetscSectionAddDof(mesh->coneSection, p, size);CHKERRQ(ierr);
1232   ierr = PetscSectionGetDof(mesh->coneSection, p, &csize);CHKERRQ(ierr);
1233 
1234   mesh->maxConeSize = PetscMax(mesh->maxConeSize, csize);
1235   PetscFunctionReturn(0);
1236 }
1237 
1238 /*@C
1239   DMPlexGetCone - Return the points on the in-edges for this point in the Sieve DAG
1240 
1241   Not collective
1242 
1243   Input Parameters:
1244 + mesh - The DMPlex
1245 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1246 
1247   Output Parameter:
1248 . cone - An array of points which are on the in-edges for point p
1249 
1250   Level: beginner
1251 
1252   Fortran Notes:
1253   Since it returns an array, this routine is only available in Fortran 90, and you must
1254   include petsc.h90 in your code.
1255 
1256   You must also call DMPlexRestoreCone() after you finish using the returned array.
1257 
1258 .seealso: DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart()
1259 @*/
1260 PetscErrorCode DMPlexGetCone(DM dm, PetscInt p, const PetscInt *cone[])
1261 {
1262   DM_Plex       *mesh = (DM_Plex*) dm->data;
1263   PetscInt       off;
1264   PetscErrorCode ierr;
1265 
1266   PetscFunctionBegin;
1267   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1268   PetscValidPointer(cone, 3);
1269   ierr  = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1270   *cone = &mesh->cones[off];
1271   PetscFunctionReturn(0);
1272 }
1273 
1274 /*@
1275   DMPlexSetCone - Set the points on the in-edges for this point in the Sieve DAG
1276 
1277   Not collective
1278 
1279   Input Parameters:
1280 + mesh - The DMPlex
1281 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1282 - cone - An array of points which are on the in-edges for point p
1283 
1284   Output Parameter:
1285 
1286   Note:
1287   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
1288 
1289   Level: beginner
1290 
1291 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
1292 @*/
1293 PetscErrorCode DMPlexSetCone(DM dm, PetscInt p, const PetscInt cone[])
1294 {
1295   DM_Plex       *mesh = (DM_Plex*) dm->data;
1296   PetscInt       pStart, pEnd;
1297   PetscInt       dof, off, c;
1298   PetscErrorCode ierr;
1299 
1300   PetscFunctionBegin;
1301   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1302   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1303   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1304   if (dof) PetscValidPointer(cone, 3);
1305   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1306   if ((p < pStart) || (p >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Mesh point %D is not in the valid range [%D, %D)", p, pStart, pEnd);
1307   for (c = 0; c < dof; ++c) {
1308     if ((cone[c] < pStart) || (cone[c] >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Cone point %D is not in the valid range [%D, %D)", cone[c], pStart, pEnd);
1309     mesh->cones[off+c] = cone[c];
1310   }
1311   PetscFunctionReturn(0);
1312 }
1313 
1314 /*@C
1315   DMPlexGetConeOrientation - Return the orientations on the in-edges for this point in the Sieve DAG
1316 
1317   Not collective
1318 
1319   Input Parameters:
1320 + mesh - The DMPlex
1321 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1322 
1323   Output Parameter:
1324 . coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
1325                     integer giving the prescription for cone traversal. If it is negative, the cone is
1326                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
1327                     the index of the cone point on which to start.
1328 
1329   Level: beginner
1330 
1331   Fortran Notes:
1332   Since it returns an array, this routine is only available in Fortran 90, and you must
1333   include petsc.h90 in your code.
1334 
1335   You must also call DMPlexRestoreConeOrientation() after you finish using the returned array.
1336 
1337 .seealso: DMPlexCreate(), DMPlexGetCone(), DMPlexSetCone(), DMPlexSetChart()
1338 @*/
1339 PetscErrorCode DMPlexGetConeOrientation(DM dm, PetscInt p, const PetscInt *coneOrientation[])
1340 {
1341   DM_Plex       *mesh = (DM_Plex*) dm->data;
1342   PetscInt       off;
1343   PetscErrorCode ierr;
1344 
1345   PetscFunctionBegin;
1346   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1347 #if defined(PETSC_USE_DEBUG)
1348   {
1349     PetscInt dof;
1350     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1351     if (dof) PetscValidPointer(coneOrientation, 3);
1352   }
1353 #endif
1354   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1355 
1356   *coneOrientation = &mesh->coneOrientations[off];
1357   PetscFunctionReturn(0);
1358 }
1359 
1360 /*@
1361   DMPlexSetConeOrientation - Set the orientations on the in-edges for this point in the Sieve DAG
1362 
1363   Not collective
1364 
1365   Input Parameters:
1366 + mesh - The DMPlex
1367 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1368 - coneOrientation - An array of orientations which are on the in-edges for point p. An orientation is an
1369                     integer giving the prescription for cone traversal. If it is negative, the cone is
1370                     traversed in the opposite direction. Its value 'o', or if negative '-(o+1)', gives
1371                     the index of the cone point on which to start.
1372 
1373   Output Parameter:
1374 
1375   Note:
1376   This should be called after all calls to DMPlexSetConeSize() and DMSetUp().
1377 
1378   Level: beginner
1379 
1380 .seealso: DMPlexCreate(), DMPlexGetConeOrientation(), DMPlexSetCone(), DMPlexSetChart(), DMPlexSetConeSize(), DMSetUp()
1381 @*/
1382 PetscErrorCode DMPlexSetConeOrientation(DM dm, PetscInt p, const PetscInt coneOrientation[])
1383 {
1384   DM_Plex       *mesh = (DM_Plex*) dm->data;
1385   PetscInt       pStart, pEnd;
1386   PetscInt       dof, off, c;
1387   PetscErrorCode ierr;
1388 
1389   PetscFunctionBegin;
1390   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1391   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1392   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1393   if (dof) PetscValidPointer(coneOrientation, 3);
1394   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1395   if ((p < pStart) || (p >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Mesh point %D is not in the valid range [%D, %D)", p, pStart, pEnd);
1396   for (c = 0; c < dof; ++c) {
1397     PetscInt cdof, o = coneOrientation[c];
1398 
1399     ierr = PetscSectionGetDof(mesh->coneSection, mesh->cones[off+c], &cdof);CHKERRQ(ierr);
1400     if (o && ((o < -(cdof+1)) || (o >= cdof))) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Cone orientation %D is not in the valid range [%D. %D)", o, -(cdof+1), cdof);
1401     mesh->coneOrientations[off+c] = o;
1402   }
1403   PetscFunctionReturn(0);
1404 }
1405 
1406 PetscErrorCode DMPlexInsertCone(DM dm, PetscInt p, PetscInt conePos, PetscInt conePoint)
1407 {
1408   DM_Plex       *mesh = (DM_Plex*) dm->data;
1409   PetscInt       pStart, pEnd;
1410   PetscInt       dof, off;
1411   PetscErrorCode ierr;
1412 
1413   PetscFunctionBegin;
1414   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1415   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1416   if ((p < pStart) || (p >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Mesh point %D is not in the valid range [%D, %D)", p, pStart, pEnd);
1417   if ((conePoint < pStart) || (conePoint >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Cone point %D is not in the valid range [%D, %D)", conePoint, pStart, pEnd);
1418   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1419   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1420   if ((conePos < 0) || (conePos >= dof)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Cone position %D of point %D is not in the valid range [0, %D)", conePos, p, dof);
1421   mesh->cones[off+conePos] = conePoint;
1422   PetscFunctionReturn(0);
1423 }
1424 
1425 PetscErrorCode DMPlexInsertConeOrientation(DM dm, PetscInt p, PetscInt conePos, PetscInt coneOrientation)
1426 {
1427   DM_Plex       *mesh = (DM_Plex*) dm->data;
1428   PetscInt       pStart, pEnd;
1429   PetscInt       dof, off;
1430   PetscErrorCode ierr;
1431 
1432   PetscFunctionBegin;
1433   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1434   ierr = PetscSectionGetChart(mesh->coneSection, &pStart, &pEnd);CHKERRQ(ierr);
1435   if ((p < pStart) || (p >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Mesh point %D is not in the valid range [%D, %D)", p, pStart, pEnd);
1436   ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
1437   ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
1438   if ((conePos < 0) || (conePos >= dof)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Cone position %D of point %D is not in the valid range [0, %D)", conePos, p, dof);
1439   mesh->coneOrientations[off+conePos] = coneOrientation;
1440   PetscFunctionReturn(0);
1441 }
1442 
1443 /*@
1444   DMPlexGetSupportSize - Return the number of out-edges for this point in the Sieve DAG
1445 
1446   Not collective
1447 
1448   Input Parameters:
1449 + mesh - The DMPlex
1450 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1451 
1452   Output Parameter:
1453 . size - The support size for point p
1454 
1455   Level: beginner
1456 
1457 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart(), DMPlexGetConeSize()
1458 @*/
1459 PetscErrorCode DMPlexGetSupportSize(DM dm, PetscInt p, PetscInt *size)
1460 {
1461   DM_Plex       *mesh = (DM_Plex*) dm->data;
1462   PetscErrorCode ierr;
1463 
1464   PetscFunctionBegin;
1465   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1466   PetscValidPointer(size, 3);
1467   ierr = PetscSectionGetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
1468   PetscFunctionReturn(0);
1469 }
1470 
1471 /*@
1472   DMPlexSetSupportSize - Set the number of out-edges for this point in the Sieve DAG
1473 
1474   Not collective
1475 
1476   Input Parameters:
1477 + mesh - The DMPlex
1478 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1479 - size - The support size for point p
1480 
1481   Output Parameter:
1482 
1483   Note:
1484   This should be called after DMPlexSetChart().
1485 
1486   Level: beginner
1487 
1488 .seealso: DMPlexCreate(), DMPlexGetSupportSize(), DMPlexSetChart()
1489 @*/
1490 PetscErrorCode DMPlexSetSupportSize(DM dm, PetscInt p, PetscInt size)
1491 {
1492   DM_Plex       *mesh = (DM_Plex*) dm->data;
1493   PetscErrorCode ierr;
1494 
1495   PetscFunctionBegin;
1496   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1497   ierr = PetscSectionSetDof(mesh->supportSection, p, size);CHKERRQ(ierr);
1498 
1499   mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, size);
1500   PetscFunctionReturn(0);
1501 }
1502 
1503 /*@C
1504   DMPlexGetSupport - Return the points on the out-edges for this point in the Sieve DAG
1505 
1506   Not collective
1507 
1508   Input Parameters:
1509 + mesh - The DMPlex
1510 - p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1511 
1512   Output Parameter:
1513 . support - An array of points which are on the out-edges for point p
1514 
1515   Level: beginner
1516 
1517   Fortran Notes:
1518   Since it returns an array, this routine is only available in Fortran 90, and you must
1519   include petsc.h90 in your code.
1520 
1521   You must also call DMPlexRestoreSupport() after you finish using the returned array.
1522 
1523 .seealso: DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1524 @*/
1525 PetscErrorCode DMPlexGetSupport(DM dm, PetscInt p, const PetscInt *support[])
1526 {
1527   DM_Plex       *mesh = (DM_Plex*) dm->data;
1528   PetscInt       off;
1529   PetscErrorCode ierr;
1530 
1531   PetscFunctionBegin;
1532   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1533   PetscValidPointer(support, 3);
1534   ierr     = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1535   *support = &mesh->supports[off];
1536   PetscFunctionReturn(0);
1537 }
1538 
1539 /*@
1540   DMPlexSetSupport - Set the points on the out-edges for this point in the Sieve DAG
1541 
1542   Not collective
1543 
1544   Input Parameters:
1545 + mesh - The DMPlex
1546 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1547 - support - An array of points which are on the in-edges for point p
1548 
1549   Output Parameter:
1550 
1551   Note:
1552   This should be called after all calls to DMPlexSetSupportSize() and DMSetUp().
1553 
1554   Level: beginner
1555 
1556 .seealso: DMPlexCreate(), DMPlexGetSupport(), DMPlexSetChart(), DMPlexSetSupportSize(), DMSetUp()
1557 @*/
1558 PetscErrorCode DMPlexSetSupport(DM dm, PetscInt p, const PetscInt support[])
1559 {
1560   DM_Plex       *mesh = (DM_Plex*) dm->data;
1561   PetscInt       pStart, pEnd;
1562   PetscInt       dof, off, c;
1563   PetscErrorCode ierr;
1564 
1565   PetscFunctionBegin;
1566   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1567   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
1568   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1569   if (dof) PetscValidPointer(support, 3);
1570   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1571   if ((p < pStart) || (p >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Mesh point %D is not in the valid range [%D, %D)", p, pStart, pEnd);
1572   for (c = 0; c < dof; ++c) {
1573     if ((support[c] < pStart) || (support[c] >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Support point %D is not in the valid range [%D, %D)", support[c], pStart, pEnd);
1574     mesh->supports[off+c] = support[c];
1575   }
1576   PetscFunctionReturn(0);
1577 }
1578 
1579 PetscErrorCode DMPlexInsertSupport(DM dm, PetscInt p, PetscInt supportPos, PetscInt supportPoint)
1580 {
1581   DM_Plex       *mesh = (DM_Plex*) dm->data;
1582   PetscInt       pStart, pEnd;
1583   PetscInt       dof, off;
1584   PetscErrorCode ierr;
1585 
1586   PetscFunctionBegin;
1587   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1588   ierr = PetscSectionGetChart(mesh->supportSection, &pStart, &pEnd);CHKERRQ(ierr);
1589   ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
1590   ierr = PetscSectionGetOffset(mesh->supportSection, p, &off);CHKERRQ(ierr);
1591   if ((p < pStart) || (p >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Mesh point %D is not in the valid range [%D, %D)", p, pStart, pEnd);
1592   if ((supportPoint < pStart) || (supportPoint >= pEnd)) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Support point %D is not in the valid range [%D, %D)", supportPoint, pStart, pEnd);
1593   if (supportPos >= dof) SETERRQ3(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Support position %D of point %D is not in the valid range [0, %D)", supportPos, p, dof);
1594   mesh->supports[off+supportPos] = supportPoint;
1595   PetscFunctionReturn(0);
1596 }
1597 
1598 /*@C
1599   DMPlexGetTransitiveClosure - Return the points on the transitive closure of the in-edges or out-edges for this point in the Sieve DAG
1600 
1601   Not collective
1602 
1603   Input Parameters:
1604 + mesh - The DMPlex
1605 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1606 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1607 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
1608 
1609   Output Parameters:
1610 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
1611 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
1612 
1613   Note:
1614   If using internal storage (points is NULL on input), each call overwrites the last output.
1615 
1616   Fortran Notes:
1617   Since it returns an array, this routine is only available in Fortran 90, and you must
1618   include petsc.h90 in your code.
1619 
1620   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1621 
1622   Level: beginner
1623 
1624 .seealso: DMPlexRestoreTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1625 @*/
1626 PetscErrorCode DMPlexGetTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1627 {
1628   DM_Plex        *mesh = (DM_Plex*) dm->data;
1629   PetscInt       *closure, *fifo;
1630   const PetscInt *tmp = NULL, *tmpO = NULL;
1631   PetscInt        tmpSize, t;
1632   PetscInt        depth       = 0, maxSize;
1633   PetscInt        closureSize = 2, fifoSize = 0, fifoStart = 0;
1634   PetscErrorCode  ierr;
1635 
1636   PetscFunctionBegin;
1637   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1638   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1639   /* This is only 1-level */
1640   if (useCone) {
1641     ierr = DMPlexGetConeSize(dm, p, &tmpSize);CHKERRQ(ierr);
1642     ierr = DMPlexGetCone(dm, p, &tmp);CHKERRQ(ierr);
1643     ierr = DMPlexGetConeOrientation(dm, p, &tmpO);CHKERRQ(ierr);
1644   } else {
1645     ierr = DMPlexGetSupportSize(dm, p, &tmpSize);CHKERRQ(ierr);
1646     ierr = DMPlexGetSupport(dm, p, &tmp);CHKERRQ(ierr);
1647   }
1648   if (depth == 1) {
1649     if (*points) {
1650       closure = *points;
1651     } else {
1652       maxSize = 2*(PetscMax(mesh->maxConeSize, mesh->maxSupportSize)+1);
1653       ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1654     }
1655     closure[0] = p; closure[1] = 0;
1656     for (t = 0; t < tmpSize; ++t, closureSize += 2) {
1657       closure[closureSize]   = tmp[t];
1658       closure[closureSize+1] = tmpO ? tmpO[t] : 0;
1659     }
1660     if (numPoints) *numPoints = closureSize/2;
1661     if (points)    *points    = closure;
1662     PetscFunctionReturn(0);
1663   }
1664   {
1665     PetscInt c, coneSeries, s,supportSeries;
1666 
1667     c = mesh->maxConeSize;
1668     coneSeries = (c > 1) ? ((PetscPowInt(c,depth+1)-1)/(c-1)) : depth+1;
1669     s = mesh->maxSupportSize;
1670     supportSeries = (s > 1) ? ((PetscPowInt(s,depth+1)-1)/(s-1)) : depth+1;
1671     maxSize = 2*PetscMax(coneSeries,supportSeries);
1672   }
1673   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1674   if (*points) {
1675     closure = *points;
1676   } else {
1677     ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1678   }
1679   closure[0] = p; closure[1] = 0;
1680   for (t = 0; t < tmpSize; ++t, closureSize += 2, fifoSize += 2) {
1681     const PetscInt cp = tmp[t];
1682     const PetscInt co = tmpO ? tmpO[t] : 0;
1683 
1684     closure[closureSize]   = cp;
1685     closure[closureSize+1] = co;
1686     fifo[fifoSize]         = cp;
1687     fifo[fifoSize+1]       = co;
1688   }
1689   /* Should kick out early when depth is reached, rather than checking all vertices for empty cones */
1690   while (fifoSize - fifoStart) {
1691     const PetscInt q   = fifo[fifoStart];
1692     const PetscInt o   = fifo[fifoStart+1];
1693     const PetscInt rev = o >= 0 ? 0 : 1;
1694     const PetscInt off = rev ? -(o+1) : o;
1695 
1696     if (useCone) {
1697       ierr = DMPlexGetConeSize(dm, q, &tmpSize);CHKERRQ(ierr);
1698       ierr = DMPlexGetCone(dm, q, &tmp);CHKERRQ(ierr);
1699       ierr = DMPlexGetConeOrientation(dm, q, &tmpO);CHKERRQ(ierr);
1700     } else {
1701       ierr = DMPlexGetSupportSize(dm, q, &tmpSize);CHKERRQ(ierr);
1702       ierr = DMPlexGetSupport(dm, q, &tmp);CHKERRQ(ierr);
1703       tmpO = NULL;
1704     }
1705     for (t = 0; t < tmpSize; ++t) {
1706       const PetscInt i  = ((rev ? tmpSize-t : t) + off)%tmpSize;
1707       const PetscInt cp = tmp[i];
1708       /* Must propogate orientation: When we reverse orientation, we both reverse the direction of iteration and start at the other end of the chain. */
1709       /* HACK: It is worse to get the size here, than to change the interpretation of -(*+1)
1710        const PetscInt co = tmpO ? (rev ? -(tmpO[i]+1) : tmpO[i]) : 0; */
1711       PetscInt       co = tmpO ? tmpO[i] : 0;
1712       PetscInt       c;
1713 
1714       if (rev) {
1715         PetscInt childSize, coff;
1716         ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
1717         coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
1718         co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
1719       }
1720       /* Check for duplicate */
1721       for (c = 0; c < closureSize; c += 2) {
1722         if (closure[c] == cp) break;
1723       }
1724       if (c == closureSize) {
1725         closure[closureSize]   = cp;
1726         closure[closureSize+1] = co;
1727         fifo[fifoSize]         = cp;
1728         fifo[fifoSize+1]       = co;
1729         closureSize           += 2;
1730         fifoSize              += 2;
1731       }
1732     }
1733     fifoStart += 2;
1734   }
1735   if (numPoints) *numPoints = closureSize/2;
1736   if (points)    *points    = closure;
1737   ierr = DMRestoreWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1738   PetscFunctionReturn(0);
1739 }
1740 
1741 /*@C
1742   DMPlexGetTransitiveClosure_Internal - Return the points on the transitive closure of the in-edges or out-edges for this point in the Sieve DAG with a specified initial orientation
1743 
1744   Not collective
1745 
1746   Input Parameters:
1747 + mesh - The DMPlex
1748 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1749 . orientation - The orientation of the point
1750 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1751 - points - If points is NULL on input, internal storage will be returned, otherwise the provided array is used
1752 
1753   Output Parameters:
1754 + numPoints - The number of points in the closure, so points[] is of size 2*numPoints
1755 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...]
1756 
1757   Note:
1758   If using internal storage (points is NULL on input), each call overwrites the last output.
1759 
1760   Fortran Notes:
1761   Since it returns an array, this routine is only available in Fortran 90, and you must
1762   include petsc.h90 in your code.
1763 
1764   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1765 
1766   Level: beginner
1767 
1768 .seealso: DMPlexRestoreTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1769 @*/
1770 PetscErrorCode DMPlexGetTransitiveClosure_Internal(DM dm, PetscInt p, PetscInt ornt, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1771 {
1772   DM_Plex        *mesh = (DM_Plex*) dm->data;
1773   PetscInt       *closure, *fifo;
1774   const PetscInt *tmp = NULL, *tmpO = NULL;
1775   PetscInt        tmpSize, t;
1776   PetscInt        depth       = 0, maxSize;
1777   PetscInt        closureSize = 2, fifoSize = 0, fifoStart = 0;
1778   PetscErrorCode  ierr;
1779 
1780   PetscFunctionBegin;
1781   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1782   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
1783   /* This is only 1-level */
1784   if (useCone) {
1785     ierr = DMPlexGetConeSize(dm, p, &tmpSize);CHKERRQ(ierr);
1786     ierr = DMPlexGetCone(dm, p, &tmp);CHKERRQ(ierr);
1787     ierr = DMPlexGetConeOrientation(dm, p, &tmpO);CHKERRQ(ierr);
1788   } else {
1789     ierr = DMPlexGetSupportSize(dm, p, &tmpSize);CHKERRQ(ierr);
1790     ierr = DMPlexGetSupport(dm, p, &tmp);CHKERRQ(ierr);
1791   }
1792   if (depth == 1) {
1793     if (*points) {
1794       closure = *points;
1795     } else {
1796       maxSize = 2*(PetscMax(mesh->maxConeSize, mesh->maxSupportSize)+1);
1797       ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1798     }
1799     closure[0] = p; closure[1] = ornt;
1800     for (t = 0; t < tmpSize; ++t, closureSize += 2) {
1801       const PetscInt i = ornt >= 0 ? (t+ornt)%tmpSize : (-(ornt+1) + tmpSize-t)%tmpSize;
1802       closure[closureSize]   = tmp[i];
1803       closure[closureSize+1] = tmpO ? tmpO[i] : 0;
1804     }
1805     if (numPoints) *numPoints = closureSize/2;
1806     if (points)    *points    = closure;
1807     PetscFunctionReturn(0);
1808   }
1809   {
1810     PetscInt c, coneSeries, s,supportSeries;
1811 
1812     c = mesh->maxConeSize;
1813     coneSeries = (c > 1) ? ((PetscPowInt(c,depth+1)-1)/(c-1)) : depth+1;
1814     s = mesh->maxSupportSize;
1815     supportSeries = (s > 1) ? ((PetscPowInt(s,depth+1)-1)/(s-1)) : depth+1;
1816     maxSize = 2*PetscMax(coneSeries,supportSeries);
1817   }
1818   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1819   if (*points) {
1820     closure = *points;
1821   } else {
1822     ierr = DMGetWorkArray(dm, maxSize, PETSC_INT, &closure);CHKERRQ(ierr);
1823   }
1824   closure[0] = p; closure[1] = ornt;
1825   for (t = 0; t < tmpSize; ++t, closureSize += 2, fifoSize += 2) {
1826     const PetscInt i  = ornt >= 0 ? (t+ornt)%tmpSize : (-(ornt+1) + tmpSize-t)%tmpSize;
1827     const PetscInt cp = tmp[i];
1828     PetscInt       co = tmpO ? tmpO[i] : 0;
1829 
1830     if (ornt < 0) {
1831       PetscInt childSize, coff;
1832       ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
1833       coff = co < 0 ? -(tmpO[i]+1) : tmpO[i];
1834       co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
1835     }
1836     closure[closureSize]   = cp;
1837     closure[closureSize+1] = co;
1838     fifo[fifoSize]         = cp;
1839     fifo[fifoSize+1]       = co;
1840   }
1841   /* Should kick out early when depth is reached, rather than checking all vertices for empty cones */
1842   while (fifoSize - fifoStart) {
1843     const PetscInt q   = fifo[fifoStart];
1844     const PetscInt o   = fifo[fifoStart+1];
1845     const PetscInt rev = o >= 0 ? 0 : 1;
1846     const PetscInt off = rev ? -(o+1) : o;
1847 
1848     if (useCone) {
1849       ierr = DMPlexGetConeSize(dm, q, &tmpSize);CHKERRQ(ierr);
1850       ierr = DMPlexGetCone(dm, q, &tmp);CHKERRQ(ierr);
1851       ierr = DMPlexGetConeOrientation(dm, q, &tmpO);CHKERRQ(ierr);
1852     } else {
1853       ierr = DMPlexGetSupportSize(dm, q, &tmpSize);CHKERRQ(ierr);
1854       ierr = DMPlexGetSupport(dm, q, &tmp);CHKERRQ(ierr);
1855       tmpO = NULL;
1856     }
1857     for (t = 0; t < tmpSize; ++t) {
1858       const PetscInt i  = ((rev ? tmpSize-t : t) + off)%tmpSize;
1859       const PetscInt cp = tmp[i];
1860       /* Must propogate orientation: When we reverse orientation, we both reverse the direction of iteration and start at the other end of the chain. */
1861       /* HACK: It is worse to get the size here, than to change the interpretation of -(*+1)
1862        const PetscInt co = tmpO ? (rev ? -(tmpO[i]+1) : tmpO[i]) : 0; */
1863       PetscInt       co = tmpO ? tmpO[i] : 0;
1864       PetscInt       c;
1865 
1866       if (rev) {
1867         PetscInt childSize, coff;
1868         ierr = DMPlexGetConeSize(dm, cp, &childSize);CHKERRQ(ierr);
1869         coff = tmpO[i] < 0 ? -(tmpO[i]+1) : tmpO[i];
1870         co   = childSize ? -(((coff+childSize-1)%childSize)+1) : 0;
1871       }
1872       /* Check for duplicate */
1873       for (c = 0; c < closureSize; c += 2) {
1874         if (closure[c] == cp) break;
1875       }
1876       if (c == closureSize) {
1877         closure[closureSize]   = cp;
1878         closure[closureSize+1] = co;
1879         fifo[fifoSize]         = cp;
1880         fifo[fifoSize+1]       = co;
1881         closureSize           += 2;
1882         fifoSize              += 2;
1883       }
1884     }
1885     fifoStart += 2;
1886   }
1887   if (numPoints) *numPoints = closureSize/2;
1888   if (points)    *points    = closure;
1889   ierr = DMRestoreWorkArray(dm, maxSize, PETSC_INT, &fifo);CHKERRQ(ierr);
1890   PetscFunctionReturn(0);
1891 }
1892 
1893 /*@C
1894   DMPlexRestoreTransitiveClosure - Restore the array of points on the transitive closure of the in-edges or out-edges for this point in the Sieve DAG
1895 
1896   Not collective
1897 
1898   Input Parameters:
1899 + mesh - The DMPlex
1900 . p - The Sieve point, which must lie in the chart set with DMPlexSetChart()
1901 . useCone - PETSC_TRUE for in-edges,  otherwise use out-edges
1902 . numPoints - The number of points in the closure, so points[] is of size 2*numPoints, zeroed on exit
1903 - points - The points and point orientations, interleaved as pairs [p0, o0, p1, o1, ...], zeroed on exit
1904 
1905   Note:
1906   If not using internal storage (points is not NULL on input), this call is unnecessary
1907 
1908   Fortran Notes:
1909   Since it returns an array, this routine is only available in Fortran 90, and you must
1910   include petsc.h90 in your code.
1911 
1912   The numPoints argument is not present in the Fortran 90 binding since it is internal to the array.
1913 
1914   Level: beginner
1915 
1916 .seealso: DMPlexGetTransitiveClosure(), DMPlexCreate(), DMPlexSetCone(), DMPlexSetChart(), DMPlexGetCone()
1917 @*/
1918 PetscErrorCode DMPlexRestoreTransitiveClosure(DM dm, PetscInt p, PetscBool useCone, PetscInt *numPoints, PetscInt *points[])
1919 {
1920   PetscErrorCode ierr;
1921 
1922   PetscFunctionBegin;
1923   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1924   if (numPoints) PetscValidIntPointer(numPoints,4);
1925   if (points) PetscValidPointer(points,5);
1926   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, points);CHKERRQ(ierr);
1927   if (numPoints) *numPoints = 0;
1928   PetscFunctionReturn(0);
1929 }
1930 
1931 /*@
1932   DMPlexGetMaxSizes - Return the maximum number of in-edges (cone) and out-edges (support) for any point in the Sieve DAG
1933 
1934   Not collective
1935 
1936   Input Parameter:
1937 . mesh - The DMPlex
1938 
1939   Output Parameters:
1940 + maxConeSize - The maximum number of in-edges
1941 - maxSupportSize - The maximum number of out-edges
1942 
1943   Level: beginner
1944 
1945 .seealso: DMPlexCreate(), DMPlexSetConeSize(), DMPlexSetChart()
1946 @*/
1947 PetscErrorCode DMPlexGetMaxSizes(DM dm, PetscInt *maxConeSize, PetscInt *maxSupportSize)
1948 {
1949   DM_Plex *mesh = (DM_Plex*) dm->data;
1950 
1951   PetscFunctionBegin;
1952   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1953   if (maxConeSize)    *maxConeSize    = mesh->maxConeSize;
1954   if (maxSupportSize) *maxSupportSize = mesh->maxSupportSize;
1955   PetscFunctionReturn(0);
1956 }
1957 
1958 PetscErrorCode DMSetUp_Plex(DM dm)
1959 {
1960   DM_Plex       *mesh = (DM_Plex*) dm->data;
1961   PetscInt       size;
1962   PetscErrorCode ierr;
1963 
1964   PetscFunctionBegin;
1965   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1966   ierr = PetscSectionSetUp(mesh->coneSection);CHKERRQ(ierr);
1967   ierr = PetscSectionGetStorageSize(mesh->coneSection, &size);CHKERRQ(ierr);
1968   ierr = PetscMalloc1(size, &mesh->cones);CHKERRQ(ierr);
1969   ierr = PetscCalloc1(size, &mesh->coneOrientations);CHKERRQ(ierr);
1970   if (mesh->maxSupportSize) {
1971     ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
1972     ierr = PetscSectionGetStorageSize(mesh->supportSection, &size);CHKERRQ(ierr);
1973     ierr = PetscMalloc1(size, &mesh->supports);CHKERRQ(ierr);
1974   }
1975   PetscFunctionReturn(0);
1976 }
1977 
1978 PetscErrorCode DMCreateSubDM_Plex(DM dm, PetscInt numFields, PetscInt fields[], IS *is, DM *subdm)
1979 {
1980   PetscErrorCode ierr;
1981 
1982   PetscFunctionBegin;
1983   if (subdm) {ierr = DMClone(dm, subdm);CHKERRQ(ierr);}
1984   ierr = DMCreateSubDM_Section_Private(dm, numFields, fields, is, subdm);CHKERRQ(ierr);
1985   PetscFunctionReturn(0);
1986 }
1987 
1988 /*@
1989   DMPlexSymmetrize - Creates support (out-edge) information from cone (in-edge) inoformation
1990 
1991   Not collective
1992 
1993   Input Parameter:
1994 . mesh - The DMPlex
1995 
1996   Output Parameter:
1997 
1998   Note:
1999   This should be called after all calls to DMPlexSetCone()
2000 
2001   Level: beginner
2002 
2003 .seealso: DMPlexCreate(), DMPlexSetChart(), DMPlexSetConeSize(), DMPlexSetCone()
2004 @*/
2005 PetscErrorCode DMPlexSymmetrize(DM dm)
2006 {
2007   DM_Plex       *mesh = (DM_Plex*) dm->data;
2008   PetscInt      *offsets;
2009   PetscInt       supportSize;
2010   PetscInt       pStart, pEnd, p;
2011   PetscErrorCode ierr;
2012 
2013   PetscFunctionBegin;
2014   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2015   if (mesh->supports) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Supports were already setup in this DMPlex");
2016   /* Calculate support sizes */
2017   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2018   for (p = pStart; p < pEnd; ++p) {
2019     PetscInt dof, off, c;
2020 
2021     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2022     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2023     for (c = off; c < off+dof; ++c) {
2024       ierr = PetscSectionAddDof(mesh->supportSection, mesh->cones[c], 1);CHKERRQ(ierr);
2025     }
2026   }
2027   for (p = pStart; p < pEnd; ++p) {
2028     PetscInt dof;
2029 
2030     ierr = PetscSectionGetDof(mesh->supportSection, p, &dof);CHKERRQ(ierr);
2031 
2032     mesh->maxSupportSize = PetscMax(mesh->maxSupportSize, dof);
2033   }
2034   ierr = PetscSectionSetUp(mesh->supportSection);CHKERRQ(ierr);
2035   /* Calculate supports */
2036   ierr = PetscSectionGetStorageSize(mesh->supportSection, &supportSize);CHKERRQ(ierr);
2037   ierr = PetscMalloc1(supportSize, &mesh->supports);CHKERRQ(ierr);
2038   ierr = PetscCalloc1(pEnd - pStart, &offsets);CHKERRQ(ierr);
2039   for (p = pStart; p < pEnd; ++p) {
2040     PetscInt dof, off, c;
2041 
2042     ierr = PetscSectionGetDof(mesh->coneSection, p, &dof);CHKERRQ(ierr);
2043     ierr = PetscSectionGetOffset(mesh->coneSection, p, &off);CHKERRQ(ierr);
2044     for (c = off; c < off+dof; ++c) {
2045       const PetscInt q = mesh->cones[c];
2046       PetscInt       offS;
2047 
2048       ierr = PetscSectionGetOffset(mesh->supportSection, q, &offS);CHKERRQ(ierr);
2049 
2050       mesh->supports[offS+offsets[q]] = p;
2051       ++offsets[q];
2052     }
2053   }
2054   ierr = PetscFree(offsets);CHKERRQ(ierr);
2055   PetscFunctionReturn(0);
2056 }
2057 
2058 /*@
2059   DMPlexStratify - The Sieve DAG for most topologies is a graded poset (http://en.wikipedia.org/wiki/Graded_poset), and
2060   can be illustrated by Hasse Diagram (a http://en.wikipedia.org/wiki/Hasse_diagram). The strata group all points of the
2061   same grade, and this function calculates the strata. This grade can be seen as the height (or depth) of the point in
2062   the DAG.
2063 
2064   Collective on dm
2065 
2066   Input Parameter:
2067 . mesh - The DMPlex
2068 
2069   Output Parameter:
2070 
2071   Notes:
2072   Concretely, DMPlexStratify() creates a new label named "depth" containing the dimension of each element: 0 for vertices,
2073   1 for edges, and so on.  The depth label can be accessed through DMPlexGetDepthLabel() or DMPlexGetDepthStratum(), or
2074   manually via DMGetLabel().  The height is defined implicitly by height = maxDimension - depth, and can be accessed
2075   via DMPlexGetHeightStratum().  For example, cells have height 0 and faces have height 1.
2076 
2077   DMPlexStratify() should be called after all calls to DMPlexSymmetrize()
2078 
2079   Level: beginner
2080 
2081 .seealso: DMPlexCreate(), DMPlexSymmetrize()
2082 @*/
2083 PetscErrorCode DMPlexStratify(DM dm)
2084 {
2085   DM_Plex       *mesh = (DM_Plex*) dm->data;
2086   DMLabel        label;
2087   PetscInt       pStart, pEnd, p;
2088   PetscInt       numRoots = 0, numLeaves = 0;
2089   PetscErrorCode ierr;
2090 
2091   PetscFunctionBegin;
2092   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2093   ierr = PetscLogEventBegin(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
2094   /* Calculate depth */
2095   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2096   ierr = DMCreateLabel(dm, "depth");CHKERRQ(ierr);
2097   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2098   /* Initialize roots and count leaves */
2099   for (p = pStart; p < pEnd; ++p) {
2100     PetscInt coneSize, supportSize;
2101 
2102     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
2103     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2104     if (!coneSize && supportSize) {
2105       ++numRoots;
2106       ierr = DMLabelSetValue(label, p, 0);CHKERRQ(ierr);
2107     } else if (!supportSize && coneSize) {
2108       ++numLeaves;
2109     } else if (!supportSize && !coneSize) {
2110       /* Isolated points */
2111       ierr = DMLabelSetValue(label, p, 0);CHKERRQ(ierr);
2112     }
2113   }
2114   if (numRoots + numLeaves == (pEnd - pStart)) {
2115     for (p = pStart; p < pEnd; ++p) {
2116       PetscInt coneSize, supportSize;
2117 
2118       ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
2119       ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
2120       if (!supportSize && coneSize) {
2121         ierr = DMLabelSetValue(label, p, 1);CHKERRQ(ierr);
2122       }
2123     }
2124   } else {
2125     IS       pointIS;
2126     PetscInt numPoints = 0, level = 0;
2127 
2128     ierr = DMLabelGetStratumIS(label, level, &pointIS);CHKERRQ(ierr);
2129     if (pointIS) {ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);}
2130     while (numPoints) {
2131       const PetscInt *points;
2132       const PetscInt  newLevel = level+1;
2133 
2134       ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
2135       for (p = 0; p < numPoints; ++p) {
2136         const PetscInt  point = points[p];
2137         const PetscInt *support;
2138         PetscInt        supportSize, s;
2139 
2140         ierr = DMPlexGetSupportSize(dm, point, &supportSize);CHKERRQ(ierr);
2141         ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
2142         for (s = 0; s < supportSize; ++s) {
2143           ierr = DMLabelSetValue(label, support[s], newLevel);CHKERRQ(ierr);
2144         }
2145       }
2146       ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
2147       ++level;
2148       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2149       ierr = DMLabelGetStratumIS(label, level, &pointIS);CHKERRQ(ierr);
2150       if (pointIS) {ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);}
2151       else         {numPoints = 0;}
2152     }
2153     ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2154   }
2155   { /* just in case there is an empty process */
2156     PetscInt numValues, maxValues = 0, v;
2157 
2158     ierr = DMLabelGetNumValues(label,&numValues);CHKERRQ(ierr);
2159     for (v = 0; v < numValues; v++) {
2160       IS pointIS;
2161 
2162       ierr = DMLabelGetStratumIS(label, v, &pointIS);CHKERRQ(ierr);
2163       if (pointIS) {
2164         PetscInt  min, max, numPoints;
2165         PetscInt  start;
2166         PetscBool contig;
2167 
2168         ierr = ISGetLocalSize(pointIS, &numPoints);CHKERRQ(ierr);
2169         ierr = ISGetMinMax(pointIS, &min, &max);CHKERRQ(ierr);
2170         ierr = ISContiguousLocal(pointIS,min,max+1,&start,&contig);CHKERRQ(ierr);
2171         if (start == 0 && contig) {
2172           ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2173           ierr = ISCreateStride(PETSC_COMM_SELF,numPoints,min,1,&pointIS);CHKERRQ(ierr);
2174           ierr = DMLabelSetStratumIS(label, v, pointIS);CHKERRQ(ierr);
2175         }
2176       }
2177       ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2178     }
2179     ierr = MPI_Allreduce(&numValues,&maxValues,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
2180     for (v = numValues; v < maxValues; v++) {
2181       DMLabelAddStratum(label,v);CHKERRQ(ierr);
2182     }
2183   }
2184 
2185   ierr = DMLabelGetState(label, &mesh->depthState);CHKERRQ(ierr);
2186   ierr = PetscLogEventEnd(DMPLEX_Stratify,dm,0,0,0);CHKERRQ(ierr);
2187   PetscFunctionReturn(0);
2188 }
2189 
2190 /*@C
2191   DMPlexGetJoin - Get an array for the join of the set of points
2192 
2193   Not Collective
2194 
2195   Input Parameters:
2196 + dm - The DMPlex object
2197 . numPoints - The number of input points for the join
2198 - points - The input points
2199 
2200   Output Parameters:
2201 + numCoveredPoints - The number of points in the join
2202 - coveredPoints - The points in the join
2203 
2204   Level: intermediate
2205 
2206   Note: Currently, this is restricted to a single level join
2207 
2208   Fortran Notes:
2209   Since it returns an array, this routine is only available in Fortran 90, and you must
2210   include petsc.h90 in your code.
2211 
2212   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2213 
2214 .keywords: mesh
2215 .seealso: DMPlexRestoreJoin(), DMPlexGetMeet()
2216 @*/
2217 PetscErrorCode DMPlexGetJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2218 {
2219   DM_Plex       *mesh = (DM_Plex*) dm->data;
2220   PetscInt      *join[2];
2221   PetscInt       joinSize, i = 0;
2222   PetscInt       dof, off, p, c, m;
2223   PetscErrorCode ierr;
2224 
2225   PetscFunctionBegin;
2226   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2227   PetscValidPointer(points, 2);
2228   PetscValidPointer(numCoveredPoints, 3);
2229   PetscValidPointer(coveredPoints, 4);
2230   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[0]);CHKERRQ(ierr);
2231   ierr = DMGetWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1]);CHKERRQ(ierr);
2232   /* Copy in support of first point */
2233   ierr = PetscSectionGetDof(mesh->supportSection, points[0], &dof);CHKERRQ(ierr);
2234   ierr = PetscSectionGetOffset(mesh->supportSection, points[0], &off);CHKERRQ(ierr);
2235   for (joinSize = 0; joinSize < dof; ++joinSize) {
2236     join[i][joinSize] = mesh->supports[off+joinSize];
2237   }
2238   /* Check each successive support */
2239   for (p = 1; p < numPoints; ++p) {
2240     PetscInt newJoinSize = 0;
2241 
2242     ierr = PetscSectionGetDof(mesh->supportSection, points[p], &dof);CHKERRQ(ierr);
2243     ierr = PetscSectionGetOffset(mesh->supportSection, points[p], &off);CHKERRQ(ierr);
2244     for (c = 0; c < dof; ++c) {
2245       const PetscInt point = mesh->supports[off+c];
2246 
2247       for (m = 0; m < joinSize; ++m) {
2248         if (point == join[i][m]) {
2249           join[1-i][newJoinSize++] = point;
2250           break;
2251         }
2252       }
2253     }
2254     joinSize = newJoinSize;
2255     i        = 1-i;
2256   }
2257   *numCoveredPoints = joinSize;
2258   *coveredPoints    = join[i];
2259   ierr              = DMRestoreWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1-i]);CHKERRQ(ierr);
2260   PetscFunctionReturn(0);
2261 }
2262 
2263 /*@C
2264   DMPlexRestoreJoin - Restore an array for the join of the set of points
2265 
2266   Not Collective
2267 
2268   Input Parameters:
2269 + dm - The DMPlex object
2270 . numPoints - The number of input points for the join
2271 - points - The input points
2272 
2273   Output Parameters:
2274 + numCoveredPoints - The number of points in the join
2275 - coveredPoints - The points in the join
2276 
2277   Fortran Notes:
2278   Since it returns an array, this routine is only available in Fortran 90, and you must
2279   include petsc.h90 in your code.
2280 
2281   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2282 
2283   Level: intermediate
2284 
2285 .keywords: mesh
2286 .seealso: DMPlexGetJoin(), DMPlexGetFullJoin(), DMPlexGetMeet()
2287 @*/
2288 PetscErrorCode DMPlexRestoreJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2289 {
2290   PetscErrorCode ierr;
2291 
2292   PetscFunctionBegin;
2293   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2294   if (points) PetscValidIntPointer(points,3);
2295   if (numCoveredPoints) PetscValidIntPointer(numCoveredPoints,4);
2296   PetscValidPointer(coveredPoints, 5);
2297   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, (void*) coveredPoints);CHKERRQ(ierr);
2298   if (numCoveredPoints) *numCoveredPoints = 0;
2299   PetscFunctionReturn(0);
2300 }
2301 
2302 /*@C
2303   DMPlexGetFullJoin - Get an array for the join of the set of points
2304 
2305   Not Collective
2306 
2307   Input Parameters:
2308 + dm - The DMPlex object
2309 . numPoints - The number of input points for the join
2310 - points - The input points
2311 
2312   Output Parameters:
2313 + numCoveredPoints - The number of points in the join
2314 - coveredPoints - The points in the join
2315 
2316   Fortran Notes:
2317   Since it returns an array, this routine is only available in Fortran 90, and you must
2318   include petsc.h90 in your code.
2319 
2320   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2321 
2322   Level: intermediate
2323 
2324 .keywords: mesh
2325 .seealso: DMPlexGetJoin(), DMPlexRestoreJoin(), DMPlexGetMeet()
2326 @*/
2327 PetscErrorCode DMPlexGetFullJoin(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2328 {
2329   DM_Plex       *mesh = (DM_Plex*) dm->data;
2330   PetscInt      *offsets, **closures;
2331   PetscInt      *join[2];
2332   PetscInt       depth = 0, maxSize, joinSize = 0, i = 0;
2333   PetscInt       p, d, c, m, ms;
2334   PetscErrorCode ierr;
2335 
2336   PetscFunctionBegin;
2337   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2338   PetscValidPointer(points, 2);
2339   PetscValidPointer(numCoveredPoints, 3);
2340   PetscValidPointer(coveredPoints, 4);
2341 
2342   ierr    = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2343   ierr    = PetscCalloc1(numPoints, &closures);CHKERRQ(ierr);
2344   ierr    = DMGetWorkArray(dm, numPoints*(depth+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2345   ms      = mesh->maxSupportSize;
2346   maxSize = (ms > 1) ? ((PetscPowInt(ms,depth+1)-1)/(ms-1)) : depth + 1;
2347   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &join[0]);CHKERRQ(ierr);
2348   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &join[1]);CHKERRQ(ierr);
2349 
2350   for (p = 0; p < numPoints; ++p) {
2351     PetscInt closureSize;
2352 
2353     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_FALSE, &closureSize, &closures[p]);CHKERRQ(ierr);
2354 
2355     offsets[p*(depth+2)+0] = 0;
2356     for (d = 0; d < depth+1; ++d) {
2357       PetscInt pStart, pEnd, i;
2358 
2359       ierr = DMPlexGetDepthStratum(dm, d, &pStart, &pEnd);CHKERRQ(ierr);
2360       for (i = offsets[p*(depth+2)+d]; i < closureSize; ++i) {
2361         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
2362           offsets[p*(depth+2)+d+1] = i;
2363           break;
2364         }
2365       }
2366       if (i == closureSize) offsets[p*(depth+2)+d+1] = i;
2367     }
2368     if (offsets[p*(depth+2)+depth+1] != closureSize) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Total size of closure %D should be %D", offsets[p*(depth+2)+depth+1], closureSize);
2369   }
2370   for (d = 0; d < depth+1; ++d) {
2371     PetscInt dof;
2372 
2373     /* Copy in support of first point */
2374     dof = offsets[d+1] - offsets[d];
2375     for (joinSize = 0; joinSize < dof; ++joinSize) {
2376       join[i][joinSize] = closures[0][(offsets[d]+joinSize)*2];
2377     }
2378     /* Check each successive cone */
2379     for (p = 1; p < numPoints && joinSize; ++p) {
2380       PetscInt newJoinSize = 0;
2381 
2382       dof = offsets[p*(depth+2)+d+1] - offsets[p*(depth+2)+d];
2383       for (c = 0; c < dof; ++c) {
2384         const PetscInt point = closures[p][(offsets[p*(depth+2)+d]+c)*2];
2385 
2386         for (m = 0; m < joinSize; ++m) {
2387           if (point == join[i][m]) {
2388             join[1-i][newJoinSize++] = point;
2389             break;
2390           }
2391         }
2392       }
2393       joinSize = newJoinSize;
2394       i        = 1-i;
2395     }
2396     if (joinSize) break;
2397   }
2398   *numCoveredPoints = joinSize;
2399   *coveredPoints    = join[i];
2400   for (p = 0; p < numPoints; ++p) {
2401     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_FALSE, NULL, &closures[p]);CHKERRQ(ierr);
2402   }
2403   ierr = PetscFree(closures);CHKERRQ(ierr);
2404   ierr = DMRestoreWorkArray(dm, numPoints*(depth+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2405   ierr = DMRestoreWorkArray(dm, mesh->maxSupportSize, PETSC_INT, &join[1-i]);CHKERRQ(ierr);
2406   PetscFunctionReturn(0);
2407 }
2408 
2409 /*@C
2410   DMPlexGetMeet - Get an array for the meet of the set of points
2411 
2412   Not Collective
2413 
2414   Input Parameters:
2415 + dm - The DMPlex object
2416 . numPoints - The number of input points for the meet
2417 - points - The input points
2418 
2419   Output Parameters:
2420 + numCoveredPoints - The number of points in the meet
2421 - coveredPoints - The points in the meet
2422 
2423   Level: intermediate
2424 
2425   Note: Currently, this is restricted to a single level meet
2426 
2427   Fortran Notes:
2428   Since it returns an array, this routine is only available in Fortran 90, and you must
2429   include petsc.h90 in your code.
2430 
2431   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2432 
2433 .keywords: mesh
2434 .seealso: DMPlexRestoreMeet(), DMPlexGetJoin()
2435 @*/
2436 PetscErrorCode DMPlexGetMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveringPoints, const PetscInt **coveringPoints)
2437 {
2438   DM_Plex       *mesh = (DM_Plex*) dm->data;
2439   PetscInt      *meet[2];
2440   PetscInt       meetSize, i = 0;
2441   PetscInt       dof, off, p, c, m;
2442   PetscErrorCode ierr;
2443 
2444   PetscFunctionBegin;
2445   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2446   PetscValidPointer(points, 2);
2447   PetscValidPointer(numCoveringPoints, 3);
2448   PetscValidPointer(coveringPoints, 4);
2449   ierr = DMGetWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[0]);CHKERRQ(ierr);
2450   ierr = DMGetWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1]);CHKERRQ(ierr);
2451   /* Copy in cone of first point */
2452   ierr = PetscSectionGetDof(mesh->coneSection, points[0], &dof);CHKERRQ(ierr);
2453   ierr = PetscSectionGetOffset(mesh->coneSection, points[0], &off);CHKERRQ(ierr);
2454   for (meetSize = 0; meetSize < dof; ++meetSize) {
2455     meet[i][meetSize] = mesh->cones[off+meetSize];
2456   }
2457   /* Check each successive cone */
2458   for (p = 1; p < numPoints; ++p) {
2459     PetscInt newMeetSize = 0;
2460 
2461     ierr = PetscSectionGetDof(mesh->coneSection, points[p], &dof);CHKERRQ(ierr);
2462     ierr = PetscSectionGetOffset(mesh->coneSection, points[p], &off);CHKERRQ(ierr);
2463     for (c = 0; c < dof; ++c) {
2464       const PetscInt point = mesh->cones[off+c];
2465 
2466       for (m = 0; m < meetSize; ++m) {
2467         if (point == meet[i][m]) {
2468           meet[1-i][newMeetSize++] = point;
2469           break;
2470         }
2471       }
2472     }
2473     meetSize = newMeetSize;
2474     i        = 1-i;
2475   }
2476   *numCoveringPoints = meetSize;
2477   *coveringPoints    = meet[i];
2478   ierr               = DMRestoreWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1-i]);CHKERRQ(ierr);
2479   PetscFunctionReturn(0);
2480 }
2481 
2482 /*@C
2483   DMPlexRestoreMeet - Restore an array for the meet of the set of points
2484 
2485   Not Collective
2486 
2487   Input Parameters:
2488 + dm - The DMPlex object
2489 . numPoints - The number of input points for the meet
2490 - points - The input points
2491 
2492   Output Parameters:
2493 + numCoveredPoints - The number of points in the meet
2494 - coveredPoints - The points in the meet
2495 
2496   Level: intermediate
2497 
2498   Fortran Notes:
2499   Since it returns an array, this routine is only available in Fortran 90, and you must
2500   include petsc.h90 in your code.
2501 
2502   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2503 
2504 .keywords: mesh
2505 .seealso: DMPlexGetMeet(), DMPlexGetFullMeet(), DMPlexGetJoin()
2506 @*/
2507 PetscErrorCode DMPlexRestoreMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2508 {
2509   PetscErrorCode ierr;
2510 
2511   PetscFunctionBegin;
2512   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2513   if (points) PetscValidIntPointer(points,3);
2514   if (numCoveredPoints) PetscValidIntPointer(numCoveredPoints,4);
2515   PetscValidPointer(coveredPoints,5);
2516   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, (void*) coveredPoints);CHKERRQ(ierr);
2517   if (numCoveredPoints) *numCoveredPoints = 0;
2518   PetscFunctionReturn(0);
2519 }
2520 
2521 /*@C
2522   DMPlexGetFullMeet - Get an array for the meet of the set of points
2523 
2524   Not Collective
2525 
2526   Input Parameters:
2527 + dm - The DMPlex object
2528 . numPoints - The number of input points for the meet
2529 - points - The input points
2530 
2531   Output Parameters:
2532 + numCoveredPoints - The number of points in the meet
2533 - coveredPoints - The points in the meet
2534 
2535   Level: intermediate
2536 
2537   Fortran Notes:
2538   Since it returns an array, this routine is only available in Fortran 90, and you must
2539   include petsc.h90 in your code.
2540 
2541   The numCoveredPoints argument is not present in the Fortran 90 binding since it is internal to the array.
2542 
2543 .keywords: mesh
2544 .seealso: DMPlexGetMeet(), DMPlexRestoreMeet(), DMPlexGetJoin()
2545 @*/
2546 PetscErrorCode DMPlexGetFullMeet(DM dm, PetscInt numPoints, const PetscInt points[], PetscInt *numCoveredPoints, const PetscInt **coveredPoints)
2547 {
2548   DM_Plex       *mesh = (DM_Plex*) dm->data;
2549   PetscInt      *offsets, **closures;
2550   PetscInt      *meet[2];
2551   PetscInt       height = 0, maxSize, meetSize = 0, i = 0;
2552   PetscInt       p, h, c, m, mc;
2553   PetscErrorCode ierr;
2554 
2555   PetscFunctionBegin;
2556   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2557   PetscValidPointer(points, 2);
2558   PetscValidPointer(numCoveredPoints, 3);
2559   PetscValidPointer(coveredPoints, 4);
2560 
2561   ierr    = DMPlexGetDepth(dm, &height);CHKERRQ(ierr);
2562   ierr    = PetscMalloc1(numPoints, &closures);CHKERRQ(ierr);
2563   ierr    = DMGetWorkArray(dm, numPoints*(height+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2564   mc      = mesh->maxConeSize;
2565   maxSize = (mc > 1) ? ((PetscPowInt(mc,height+1)-1)/(mc-1)) : height + 1;
2566   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &meet[0]);CHKERRQ(ierr);
2567   ierr    = DMGetWorkArray(dm, maxSize, PETSC_INT, &meet[1]);CHKERRQ(ierr);
2568 
2569   for (p = 0; p < numPoints; ++p) {
2570     PetscInt closureSize;
2571 
2572     ierr = DMPlexGetTransitiveClosure(dm, points[p], PETSC_TRUE, &closureSize, &closures[p]);CHKERRQ(ierr);
2573 
2574     offsets[p*(height+2)+0] = 0;
2575     for (h = 0; h < height+1; ++h) {
2576       PetscInt pStart, pEnd, i;
2577 
2578       ierr = DMPlexGetHeightStratum(dm, h, &pStart, &pEnd);CHKERRQ(ierr);
2579       for (i = offsets[p*(height+2)+h]; i < closureSize; ++i) {
2580         if ((pStart > closures[p][i*2]) || (pEnd <= closures[p][i*2])) {
2581           offsets[p*(height+2)+h+1] = i;
2582           break;
2583         }
2584       }
2585       if (i == closureSize) offsets[p*(height+2)+h+1] = i;
2586     }
2587     if (offsets[p*(height+2)+height+1] != closureSize) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Total size of closure %D should be %D", offsets[p*(height+2)+height+1], closureSize);
2588   }
2589   for (h = 0; h < height+1; ++h) {
2590     PetscInt dof;
2591 
2592     /* Copy in cone of first point */
2593     dof = offsets[h+1] - offsets[h];
2594     for (meetSize = 0; meetSize < dof; ++meetSize) {
2595       meet[i][meetSize] = closures[0][(offsets[h]+meetSize)*2];
2596     }
2597     /* Check each successive cone */
2598     for (p = 1; p < numPoints && meetSize; ++p) {
2599       PetscInt newMeetSize = 0;
2600 
2601       dof = offsets[p*(height+2)+h+1] - offsets[p*(height+2)+h];
2602       for (c = 0; c < dof; ++c) {
2603         const PetscInt point = closures[p][(offsets[p*(height+2)+h]+c)*2];
2604 
2605         for (m = 0; m < meetSize; ++m) {
2606           if (point == meet[i][m]) {
2607             meet[1-i][newMeetSize++] = point;
2608             break;
2609           }
2610         }
2611       }
2612       meetSize = newMeetSize;
2613       i        = 1-i;
2614     }
2615     if (meetSize) break;
2616   }
2617   *numCoveredPoints = meetSize;
2618   *coveredPoints    = meet[i];
2619   for (p = 0; p < numPoints; ++p) {
2620     ierr = DMPlexRestoreTransitiveClosure(dm, points[p], PETSC_TRUE, NULL, &closures[p]);CHKERRQ(ierr);
2621   }
2622   ierr = PetscFree(closures);CHKERRQ(ierr);
2623   ierr = DMRestoreWorkArray(dm, numPoints*(height+2), PETSC_INT, &offsets);CHKERRQ(ierr);
2624   ierr = DMRestoreWorkArray(dm, mesh->maxConeSize, PETSC_INT, &meet[1-i]);CHKERRQ(ierr);
2625   PetscFunctionReturn(0);
2626 }
2627 
2628 /*@C
2629   DMPlexEqual - Determine if two DMs have the same topology
2630 
2631   Not Collective
2632 
2633   Input Parameters:
2634 + dmA - A DMPlex object
2635 - dmB - A DMPlex object
2636 
2637   Output Parameters:
2638 . equal - PETSC_TRUE if the topologies are identical
2639 
2640   Level: intermediate
2641 
2642   Notes:
2643   We are not solving graph isomorphism, so we do not permutation.
2644 
2645 .keywords: mesh
2646 .seealso: DMPlexGetCone()
2647 @*/
2648 PetscErrorCode DMPlexEqual(DM dmA, DM dmB, PetscBool *equal)
2649 {
2650   PetscInt       depth, depthB, pStart, pEnd, pStartB, pEndB, p;
2651   PetscErrorCode ierr;
2652 
2653   PetscFunctionBegin;
2654   PetscValidHeaderSpecific(dmA, DM_CLASSID, 1);
2655   PetscValidHeaderSpecific(dmB, DM_CLASSID, 2);
2656   PetscValidPointer(equal, 3);
2657 
2658   *equal = PETSC_FALSE;
2659   ierr = DMPlexGetDepth(dmA, &depth);CHKERRQ(ierr);
2660   ierr = DMPlexGetDepth(dmB, &depthB);CHKERRQ(ierr);
2661   if (depth != depthB) PetscFunctionReturn(0);
2662   ierr = DMPlexGetChart(dmA, &pStart,  &pEnd);CHKERRQ(ierr);
2663   ierr = DMPlexGetChart(dmB, &pStartB, &pEndB);CHKERRQ(ierr);
2664   if ((pStart != pStartB) || (pEnd != pEndB)) PetscFunctionReturn(0);
2665   for (p = pStart; p < pEnd; ++p) {
2666     const PetscInt *cone, *coneB, *ornt, *orntB, *support, *supportB;
2667     PetscInt        coneSize, coneSizeB, c, supportSize, supportSizeB, s;
2668 
2669     ierr = DMPlexGetConeSize(dmA, p, &coneSize);CHKERRQ(ierr);
2670     ierr = DMPlexGetCone(dmA, p, &cone);CHKERRQ(ierr);
2671     ierr = DMPlexGetConeOrientation(dmA, p, &ornt);CHKERRQ(ierr);
2672     ierr = DMPlexGetConeSize(dmB, p, &coneSizeB);CHKERRQ(ierr);
2673     ierr = DMPlexGetCone(dmB, p, &coneB);CHKERRQ(ierr);
2674     ierr = DMPlexGetConeOrientation(dmB, p, &orntB);CHKERRQ(ierr);
2675     if (coneSize != coneSizeB) PetscFunctionReturn(0);
2676     for (c = 0; c < coneSize; ++c) {
2677       if (cone[c] != coneB[c]) PetscFunctionReturn(0);
2678       if (ornt[c] != orntB[c]) PetscFunctionReturn(0);
2679     }
2680     ierr = DMPlexGetSupportSize(dmA, p, &supportSize);CHKERRQ(ierr);
2681     ierr = DMPlexGetSupport(dmA, p, &support);CHKERRQ(ierr);
2682     ierr = DMPlexGetSupportSize(dmB, p, &supportSizeB);CHKERRQ(ierr);
2683     ierr = DMPlexGetSupport(dmB, p, &supportB);CHKERRQ(ierr);
2684     if (supportSize != supportSizeB) PetscFunctionReturn(0);
2685     for (s = 0; s < supportSize; ++s) {
2686       if (support[s] != supportB[s]) PetscFunctionReturn(0);
2687     }
2688   }
2689   *equal = PETSC_TRUE;
2690   PetscFunctionReturn(0);
2691 }
2692 
2693 PetscErrorCode DMPlexGetNumFaceVertices(DM dm, PetscInt cellDim, PetscInt numCorners, PetscInt *numFaceVertices)
2694 {
2695   MPI_Comm       comm;
2696   PetscErrorCode ierr;
2697 
2698   PetscFunctionBegin;
2699   ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
2700   PetscValidPointer(numFaceVertices,3);
2701   switch (cellDim) {
2702   case 0:
2703     *numFaceVertices = 0;
2704     break;
2705   case 1:
2706     *numFaceVertices = 1;
2707     break;
2708   case 2:
2709     switch (numCorners) {
2710     case 3: /* triangle */
2711       *numFaceVertices = 2; /* Edge has 2 vertices */
2712       break;
2713     case 4: /* quadrilateral */
2714       *numFaceVertices = 2; /* Edge has 2 vertices */
2715       break;
2716     case 6: /* quadratic triangle, tri and quad cohesive Lagrange cells */
2717       *numFaceVertices = 3; /* Edge has 3 vertices */
2718       break;
2719     case 9: /* quadratic quadrilateral, quadratic quad cohesive Lagrange cells */
2720       *numFaceVertices = 3; /* Edge has 3 vertices */
2721       break;
2722     default:
2723       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %D for dimension %D", numCorners, cellDim);
2724     }
2725     break;
2726   case 3:
2727     switch (numCorners) {
2728     case 4: /* tetradehdron */
2729       *numFaceVertices = 3; /* Face has 3 vertices */
2730       break;
2731     case 6: /* tet cohesive cells */
2732       *numFaceVertices = 4; /* Face has 4 vertices */
2733       break;
2734     case 8: /* hexahedron */
2735       *numFaceVertices = 4; /* Face has 4 vertices */
2736       break;
2737     case 9: /* tet cohesive Lagrange cells */
2738       *numFaceVertices = 6; /* Face has 6 vertices */
2739       break;
2740     case 10: /* quadratic tetrahedron */
2741       *numFaceVertices = 6; /* Face has 6 vertices */
2742       break;
2743     case 12: /* hex cohesive Lagrange cells */
2744       *numFaceVertices = 6; /* Face has 6 vertices */
2745       break;
2746     case 18: /* quadratic tet cohesive Lagrange cells */
2747       *numFaceVertices = 6; /* Face has 6 vertices */
2748       break;
2749     case 27: /* quadratic hexahedron, quadratic hex cohesive Lagrange cells */
2750       *numFaceVertices = 9; /* Face has 9 vertices */
2751       break;
2752     default:
2753       SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid number of face corners %D for dimension %D", numCorners, cellDim);
2754     }
2755     break;
2756   default:
2757     SETERRQ1(comm, PETSC_ERR_ARG_OUTOFRANGE, "Invalid cell dimension %D", cellDim);
2758   }
2759   PetscFunctionReturn(0);
2760 }
2761 
2762 /*@
2763   DMPlexGetDepthLabel - Get the DMLabel recording the depth of each point
2764 
2765   Not Collective
2766 
2767   Input Parameter:
2768 . dm    - The DMPlex object
2769 
2770   Output Parameter:
2771 . depthLabel - The DMLabel recording point depth
2772 
2773   Level: developer
2774 
2775 .keywords: mesh, points
2776 .seealso: DMPlexGetDepth(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
2777 @*/
2778 PetscErrorCode DMPlexGetDepthLabel(DM dm, DMLabel *depthLabel)
2779 {
2780   PetscErrorCode ierr;
2781 
2782   PetscFunctionBegin;
2783   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2784   PetscValidPointer(depthLabel, 2);
2785   if (!dm->depthLabel) {ierr = DMGetLabel(dm, "depth", &dm->depthLabel);CHKERRQ(ierr);}
2786   *depthLabel = dm->depthLabel;
2787   PetscFunctionReturn(0);
2788 }
2789 
2790 /*@
2791   DMPlexGetDepth - Get the depth of the DAG representing this mesh
2792 
2793   Not Collective
2794 
2795   Input Parameter:
2796 . dm    - The DMPlex object
2797 
2798   Output Parameter:
2799 . depth - The number of strata (breadth first levels) in the DAG
2800 
2801   Level: developer
2802 
2803 .keywords: mesh, points
2804 .seealso: DMPlexGetDepthLabel(), DMPlexGetHeightStratum(), DMPlexGetDepthStratum()
2805 @*/
2806 PetscErrorCode DMPlexGetDepth(DM dm, PetscInt *depth)
2807 {
2808   DMLabel        label;
2809   PetscInt       d = 0;
2810   PetscErrorCode ierr;
2811 
2812   PetscFunctionBegin;
2813   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2814   PetscValidPointer(depth, 2);
2815   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2816   if (label) {ierr = DMLabelGetNumValues(label, &d);CHKERRQ(ierr);}
2817   *depth = d-1;
2818   PetscFunctionReturn(0);
2819 }
2820 
2821 /*@
2822   DMPlexGetDepthStratum - Get the bounds [start, end) for all points at a certain depth.
2823 
2824   Not Collective
2825 
2826   Input Parameters:
2827 + dm           - The DMPlex object
2828 - stratumValue - The requested depth
2829 
2830   Output Parameters:
2831 + start - The first point at this depth
2832 - end   - One beyond the last point at this depth
2833 
2834   Level: developer
2835 
2836 .keywords: mesh, points
2837 .seealso: DMPlexGetHeightStratum(), DMPlexGetDepth()
2838 @*/
2839 PetscErrorCode DMPlexGetDepthStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
2840 {
2841   DMLabel        label;
2842   PetscInt       pStart, pEnd;
2843   PetscErrorCode ierr;
2844 
2845   PetscFunctionBegin;
2846   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2847   if (start) {PetscValidPointer(start, 3); *start = 0;}
2848   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
2849   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2850   if (pStart == pEnd) PetscFunctionReturn(0);
2851   if (stratumValue < 0) {
2852     if (start) *start = pStart;
2853     if (end)   *end   = pEnd;
2854     PetscFunctionReturn(0);
2855   }
2856   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2857   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");
2858   ierr = DMLabelGetStratumBounds(label, stratumValue, start, end);CHKERRQ(ierr);
2859   PetscFunctionReturn(0);
2860 }
2861 
2862 /*@
2863   DMPlexGetHeightStratum - Get the bounds [start, end) for all points at a certain height.
2864 
2865   Not Collective
2866 
2867   Input Parameters:
2868 + dm           - The DMPlex object
2869 - stratumValue - The requested height
2870 
2871   Output Parameters:
2872 + start - The first point at this height
2873 - end   - One beyond the last point at this height
2874 
2875   Level: developer
2876 
2877 .keywords: mesh, points
2878 .seealso: DMPlexGetDepthStratum(), DMPlexGetDepth()
2879 @*/
2880 PetscErrorCode DMPlexGetHeightStratum(DM dm, PetscInt stratumValue, PetscInt *start, PetscInt *end)
2881 {
2882   DMLabel        label;
2883   PetscInt       depth, pStart, pEnd;
2884   PetscErrorCode ierr;
2885 
2886   PetscFunctionBegin;
2887   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2888   if (start) {PetscValidPointer(start, 3); *start = 0;}
2889   if (end)   {PetscValidPointer(end,   4); *end   = 0;}
2890   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2891   if (pStart == pEnd) PetscFunctionReturn(0);
2892   if (stratumValue < 0) {
2893     if (start) *start = pStart;
2894     if (end)   *end   = pEnd;
2895     PetscFunctionReturn(0);
2896   }
2897   ierr = DMPlexGetDepthLabel(dm, &label);CHKERRQ(ierr);
2898   if (!label) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "No label named depth was found");CHKERRQ(ierr);
2899   ierr = DMLabelGetNumValues(label, &depth);CHKERRQ(ierr);
2900   ierr = DMLabelGetStratumBounds(label, depth-1-stratumValue, start, end);CHKERRQ(ierr);
2901   PetscFunctionReturn(0);
2902 }
2903 
2904 /* Set the number of dof on each point and separate by fields */
2905 PetscErrorCode DMPlexCreateSectionInitial(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscSection *section)
2906 {
2907   PetscInt      *pMax;
2908   PetscInt       depth, pStart = 0, pEnd = 0;
2909   PetscInt       Nf, p, d, dep, f;
2910   PetscBool     *isFE;
2911   PetscErrorCode ierr;
2912 
2913   PetscFunctionBegin;
2914   ierr = PetscMalloc1(numFields, &isFE);CHKERRQ(ierr);
2915   ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
2916   for (f = 0; f < numFields; ++f) {
2917     PetscObject  obj;
2918     PetscClassId id;
2919 
2920     isFE[f] = PETSC_FALSE;
2921     if (f >= Nf) continue;
2922     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
2923     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2924     if (id == PETSCFE_CLASSID)      {isFE[f] = PETSC_TRUE;}
2925     else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
2926   }
2927   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), section);CHKERRQ(ierr);
2928   if (numFields > 0) {
2929     ierr = PetscSectionSetNumFields(*section, numFields);CHKERRQ(ierr);
2930     if (numComp) {
2931       for (f = 0; f < numFields; ++f) {
2932         ierr = PetscSectionSetFieldComponents(*section, f, numComp[f]);CHKERRQ(ierr);
2933         if (isFE[f]) {
2934           PetscFE           fe;
2935           PetscDualSpace    dspace;
2936           const PetscInt    ***perms;
2937           const PetscScalar ***flips;
2938           const PetscInt    *numDof;
2939 
2940           ierr = DMGetField(dm,f,(PetscObject *) &fe);CHKERRQ(ierr);
2941           ierr = PetscFEGetDualSpace(fe,&dspace);CHKERRQ(ierr);
2942           ierr = PetscDualSpaceGetSymmetries(dspace,&perms,&flips);CHKERRQ(ierr);
2943           ierr = PetscDualSpaceGetNumDof(dspace,&numDof);CHKERRQ(ierr);
2944           if (perms || flips) {
2945             DM               K;
2946             DMLabel          depthLabel;
2947             PetscInt         depth, h;
2948             PetscSectionSym  sym;
2949 
2950             ierr = PetscDualSpaceGetDM(dspace,&K);CHKERRQ(ierr);
2951             ierr = DMPlexGetDepthLabel(dm,&depthLabel);CHKERRQ(ierr);
2952             ierr = DMPlexGetDepth(dm,&depth);CHKERRQ(ierr);
2953             ierr = PetscSectionSymCreateLabel(PetscObjectComm((PetscObject)*section),depthLabel,&sym);CHKERRQ(ierr);
2954             for (h = 0; h <= depth; h++) {
2955               PetscDualSpace    hspace;
2956               PetscInt          kStart, kEnd;
2957               PetscInt          kConeSize;
2958               const PetscInt    **perms0 = NULL;
2959               const PetscScalar **flips0 = NULL;
2960 
2961               ierr = PetscDualSpaceGetHeightSubspace(dspace,h,&hspace);CHKERRQ(ierr);
2962               ierr = DMPlexGetHeightStratum(K,h,&kStart,&kEnd);CHKERRQ(ierr);
2963               if (!hspace) continue;
2964               ierr = PetscDualSpaceGetSymmetries(hspace,&perms,&flips);CHKERRQ(ierr);
2965               if (perms) perms0 = perms[0];
2966               if (flips) flips0 = flips[0];
2967               if (!(perms0 || flips0)) continue;
2968               ierr = DMPlexGetConeSize(K,kStart,&kConeSize);CHKERRQ(ierr);
2969               ierr = PetscSectionSymLabelSetStratum(sym,depth - h,numDof[depth - h],-kConeSize,kConeSize,PETSC_USE_POINTER,perms0 ? &perms0[-kConeSize] : NULL,flips0 ? &flips0[-kConeSize] : NULL);CHKERRQ(ierr);
2970             }
2971             ierr = PetscSectionSetFieldSym(*section,f,sym);CHKERRQ(ierr);
2972             ierr = PetscSectionSymDestroy(&sym);CHKERRQ(ierr);
2973           }
2974         }
2975       }
2976     }
2977   }
2978   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
2979   ierr = PetscSectionSetChart(*section, pStart, pEnd);CHKERRQ(ierr);
2980   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
2981   ierr = PetscMalloc1(depth+1,&pMax);CHKERRQ(ierr);
2982   ierr = DMPlexGetHybridBounds(dm, depth >= 0 ? &pMax[depth] : NULL, depth>1 ? &pMax[depth-1] : NULL, depth>2 ? &pMax[1] : NULL, &pMax[0]);CHKERRQ(ierr);
2983   for (dep = 0; dep <= depth; ++dep) {
2984     d    = dim == depth ? dep : (!dep ? 0 : dim);
2985     ierr = DMPlexGetDepthStratum(dm, dep, &pStart, &pEnd);CHKERRQ(ierr);
2986     pMax[dep] = pMax[dep] < 0 ? pEnd : pMax[dep];
2987     for (p = pStart; p < pEnd; ++p) {
2988       PetscInt tot = 0;
2989 
2990       for (f = 0; f < numFields; ++f) {
2991         if (isFE[f] && p >= pMax[dep]) continue;
2992         ierr = PetscSectionSetFieldDof(*section, p, f, numDof[f*(dim+1)+d]);CHKERRQ(ierr);
2993         tot += numDof[f*(dim+1)+d];
2994       }
2995       ierr = PetscSectionSetDof(*section, p, tot);CHKERRQ(ierr);
2996     }
2997   }
2998   ierr = PetscFree(pMax);CHKERRQ(ierr);
2999   ierr = PetscFree(isFE);CHKERRQ(ierr);
3000   PetscFunctionReturn(0);
3001 }
3002 
3003 /* Set the number of dof on each point and separate by fields
3004    If bcComps is NULL or the IS is NULL, constrain every dof on the point
3005 */
3006 PetscErrorCode DMPlexCreateSectionBCDof(DM dm, PetscInt numBC, const PetscInt bcField[], const IS bcComps[], const IS bcPoints[], PetscSection section)
3007 {
3008   PetscInt       numFields;
3009   PetscInt       bc;
3010   PetscSection   aSec;
3011   PetscErrorCode ierr;
3012 
3013   PetscFunctionBegin;
3014   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3015   for (bc = 0; bc < numBC; ++bc) {
3016     PetscInt        field = 0;
3017     const PetscInt *comp;
3018     const PetscInt *idx;
3019     PetscInt        Nc = -1, n, i;
3020 
3021     if (numFields) field = bcField[bc];
3022     if (bcComps && bcComps[bc]) {ierr = ISGetLocalSize(bcComps[bc], &Nc);CHKERRQ(ierr);}
3023     if (bcComps && bcComps[bc]) {ierr = ISGetIndices(bcComps[bc], &comp);CHKERRQ(ierr);}
3024     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
3025     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
3026     for (i = 0; i < n; ++i) {
3027       const PetscInt p = idx[i];
3028       PetscInt       numConst;
3029 
3030       if (numFields) {
3031         ierr = PetscSectionGetFieldDof(section, p, field, &numConst);CHKERRQ(ierr);
3032       } else {
3033         ierr = PetscSectionGetDof(section, p, &numConst);CHKERRQ(ierr);
3034       }
3035       /* If Nc < 0, constrain every dof on the point */
3036       if (Nc > 0) numConst = PetscMin(numConst, Nc);
3037       if (numFields) {ierr = PetscSectionAddFieldConstraintDof(section, p, field, numConst);CHKERRQ(ierr);}
3038       ierr = PetscSectionAddConstraintDof(section, p, numConst);CHKERRQ(ierr);
3039     }
3040     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
3041     if (bcComps && bcComps[bc]) {ierr = ISRestoreIndices(bcComps[bc], &comp);CHKERRQ(ierr);}
3042   }
3043   ierr = DMPlexGetAnchors(dm, &aSec, NULL);CHKERRQ(ierr);
3044   if (aSec) {
3045     PetscInt aStart, aEnd, a;
3046 
3047     ierr = PetscSectionGetChart(aSec, &aStart, &aEnd);CHKERRQ(ierr);
3048     for (a = aStart; a < aEnd; a++) {
3049       PetscInt dof, f;
3050 
3051       ierr = PetscSectionGetDof(aSec, a, &dof);CHKERRQ(ierr);
3052       if (dof) {
3053         /* if there are point-to-point constraints, then all dofs are constrained */
3054         ierr = PetscSectionGetDof(section, a, &dof);CHKERRQ(ierr);
3055         ierr = PetscSectionSetConstraintDof(section, a, dof);CHKERRQ(ierr);
3056         for (f = 0; f < numFields; f++) {
3057           ierr = PetscSectionGetFieldDof(section, a, f, &dof);CHKERRQ(ierr);
3058           ierr = PetscSectionSetFieldConstraintDof(section, a, f, dof);CHKERRQ(ierr);
3059         }
3060       }
3061     }
3062   }
3063   PetscFunctionReturn(0);
3064 }
3065 
3066 /* Set the constrained field indices on each point
3067    If bcComps is NULL or the IS is NULL, constrain every dof on the point
3068 */
3069 PetscErrorCode DMPlexCreateSectionBCIndicesField(DM dm, PetscInt numBC,const PetscInt bcField[], const IS bcComps[], const IS bcPoints[], PetscSection section)
3070 {
3071   PetscSection   aSec;
3072   PetscInt      *indices;
3073   PetscInt       numFields, maxDof, pStart, pEnd, p, bc, f, d;
3074   PetscErrorCode ierr;
3075 
3076   PetscFunctionBegin;
3077   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3078   if (!numFields) PetscFunctionReturn(0);
3079   /* Initialize all field indices to -1 */
3080   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3081   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
3082   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
3083   for (d = 0; d < maxDof; ++d) indices[d] = -1;
3084   for (p = pStart; p < pEnd; ++p) for (f = 0; f < numFields; ++f) {ierr = PetscSectionSetFieldConstraintIndices(section, p, f, indices);CHKERRQ(ierr);}
3085   /* Handle BC constraints */
3086   for (bc = 0; bc < numBC; ++bc) {
3087     const PetscInt  field = bcField[bc];
3088     const PetscInt *comp, *idx;
3089     PetscInt        Nc = -1, n, i;
3090 
3091     if (bcComps && bcComps[bc]) {ierr = ISGetLocalSize(bcComps[bc], &Nc);CHKERRQ(ierr);}
3092     if (bcComps && bcComps[bc]) {ierr = ISGetIndices(bcComps[bc], &comp);CHKERRQ(ierr);}
3093     ierr = ISGetLocalSize(bcPoints[bc], &n);CHKERRQ(ierr);
3094     ierr = ISGetIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
3095     for (i = 0; i < n; ++i) {
3096       const PetscInt  p = idx[i];
3097       const PetscInt *find;
3098       PetscInt        fcdof, c;
3099 
3100       ierr = PetscSectionGetFieldConstraintDof(section, p, field, &fcdof);CHKERRQ(ierr);
3101       if (Nc < 0) {
3102         for (d = 0; d < fcdof; ++d) indices[d] = d;
3103       } else {
3104         ierr = PetscSectionGetFieldConstraintIndices(section, p, field, &find);CHKERRQ(ierr);
3105         for (d = 0; d < fcdof; ++d) {if (find[d] < 0) break; indices[d] = find[d];}
3106         for (c = 0; c < Nc; ++c) indices[d+c] = comp[c];
3107         ierr = PetscSortInt(d+Nc, indices);CHKERRQ(ierr);
3108         for (c = d+Nc; c < fcdof; ++c) indices[c] = -1;
3109       }
3110       ierr = PetscSectionSetFieldConstraintIndices(section, p, field, indices);CHKERRQ(ierr);
3111     }
3112     if (bcComps && bcComps[bc]) {ierr = ISRestoreIndices(bcComps[bc], &comp);CHKERRQ(ierr);}
3113     ierr = ISRestoreIndices(bcPoints[bc], &idx);CHKERRQ(ierr);
3114   }
3115   /* Handle anchors */
3116   ierr = DMPlexGetAnchors(dm, &aSec, NULL);CHKERRQ(ierr);
3117   if (aSec) {
3118     PetscInt aStart, aEnd, a;
3119 
3120     for (d = 0; d < maxDof; ++d) indices[d] = d;
3121     ierr = PetscSectionGetChart(aSec, &aStart, &aEnd);CHKERRQ(ierr);
3122     for (a = aStart; a < aEnd; a++) {
3123       PetscInt dof, fdof, f;
3124 
3125       ierr = PetscSectionGetDof(aSec, a, &dof);CHKERRQ(ierr);
3126       if (dof) {
3127         /* if there are point-to-point constraints, then all dofs are constrained */
3128         for (f = 0; f < numFields; f++) {
3129           ierr = PetscSectionGetFieldDof(section, a, f, &fdof);CHKERRQ(ierr);
3130           ierr = PetscSectionSetFieldConstraintIndices(section, a, f, indices);CHKERRQ(ierr);
3131         }
3132       }
3133     }
3134   }
3135   ierr = PetscFree(indices);CHKERRQ(ierr);
3136   PetscFunctionReturn(0);
3137 }
3138 
3139 /* Set the constrained indices on each point */
3140 PetscErrorCode DMPlexCreateSectionBCIndices(DM dm, PetscSection section)
3141 {
3142   PetscInt      *indices;
3143   PetscInt       numFields, maxDof, pStart, pEnd, p, f, d;
3144   PetscErrorCode ierr;
3145 
3146   PetscFunctionBegin;
3147   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3148   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
3149   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3150   ierr = PetscMalloc1(maxDof, &indices);CHKERRQ(ierr);
3151   for (d = 0; d < maxDof; ++d) indices[d] = -1;
3152   for (p = pStart; p < pEnd; ++p) {
3153     PetscInt cdof, d;
3154 
3155     ierr = PetscSectionGetConstraintDof(section, p, &cdof);CHKERRQ(ierr);
3156     if (cdof) {
3157       if (numFields) {
3158         PetscInt numConst = 0, foff = 0;
3159 
3160         for (f = 0; f < numFields; ++f) {
3161           const PetscInt *find;
3162           PetscInt        fcdof, fdof;
3163 
3164           ierr = PetscSectionGetFieldDof(section, p, f, &fdof);CHKERRQ(ierr);
3165           ierr = PetscSectionGetFieldConstraintDof(section, p, f, &fcdof);CHKERRQ(ierr);
3166           /* Change constraint numbering from field component to local dof number */
3167           ierr = PetscSectionGetFieldConstraintIndices(section, p, f, &find);CHKERRQ(ierr);
3168           for (d = 0; d < fcdof; ++d) indices[numConst+d] = find[d] + foff;
3169           numConst += fcdof;
3170           foff     += fdof;
3171         }
3172         if (cdof != numConst) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_LIB, "Total number of field constraints %D should be %D", numConst, cdof);
3173       } else {
3174         for (d = 0; d < cdof; ++d) indices[d] = d;
3175       }
3176       ierr = PetscSectionSetConstraintIndices(section, p, indices);CHKERRQ(ierr);
3177     }
3178   }
3179   ierr = PetscFree(indices);CHKERRQ(ierr);
3180   PetscFunctionReturn(0);
3181 }
3182 
3183 /*@C
3184   DMPlexCreateSection - Create a PetscSection based upon the dof layout specification provided.
3185 
3186   Not Collective
3187 
3188   Input Parameters:
3189 + dm        - The DMPlex object
3190 . dim       - The spatial dimension of the problem
3191 . numFields - The number of fields in the problem
3192 . numComp   - An array of size numFields that holds the number of components for each field
3193 . numDof    - An array of size numFields*(dim+1) which holds the number of dof for each field on a mesh piece of dimension d
3194 . numBC     - The number of boundary conditions
3195 . bcField   - An array of size numBC giving the field number for each boundry condition
3196 . bcComps   - [Optional] An array of size numBC giving an IS holding the field components to which each boundary condition applies
3197 . bcPoints  - An array of size numBC giving an IS holding the Plex points to which each boundary condition applies
3198 - perm      - Optional permutation of the chart, or NULL
3199 
3200   Output Parameter:
3201 . section - The PetscSection object
3202 
3203   Notes: numDof[f*(dim+1)+d] gives the number of dof for field f on sieve points of dimension d. For instance, numDof[1] is the
3204   number of dof for field 0 on each edge.
3205 
3206   The chart permutation is the same one set using PetscSectionSetPermutation()
3207 
3208   Level: developer
3209 
3210   Fortran Notes:
3211   A Fortran 90 version is available as DMPlexCreateSectionF90()
3212 
3213 .keywords: mesh, elements
3214 .seealso: DMPlexCreate(), PetscSectionCreate(), PetscSectionSetPermutation()
3215 @*/
3216 PetscErrorCode DMPlexCreateSection(DM dm, PetscInt dim, PetscInt numFields,const PetscInt numComp[],const PetscInt numDof[], PetscInt numBC,const PetscInt bcField[], const IS bcComps[], const IS bcPoints[], IS perm, PetscSection *section)
3217 {
3218   PetscSection   aSec;
3219   PetscErrorCode ierr;
3220 
3221   PetscFunctionBegin;
3222   ierr = DMPlexCreateSectionInitial(dm, dim, numFields, numComp, numDof, section);CHKERRQ(ierr);
3223   ierr = DMPlexCreateSectionBCDof(dm, numBC, bcField, bcComps, bcPoints, *section);CHKERRQ(ierr);
3224   if (perm) {ierr = PetscSectionSetPermutation(*section, perm);CHKERRQ(ierr);}
3225   ierr = PetscSectionSetUp(*section);CHKERRQ(ierr);
3226   ierr = DMPlexGetAnchors(dm,&aSec,NULL);CHKERRQ(ierr);
3227   if (numBC || aSec) {
3228     ierr = DMPlexCreateSectionBCIndicesField(dm, numBC, bcField, bcComps, bcPoints, *section);CHKERRQ(ierr);
3229     ierr = DMPlexCreateSectionBCIndices(dm, *section);CHKERRQ(ierr);
3230   }
3231   ierr = PetscSectionViewFromOptions(*section,NULL,"-section_view");CHKERRQ(ierr);
3232   PetscFunctionReturn(0);
3233 }
3234 
3235 PetscErrorCode DMCreateCoordinateDM_Plex(DM dm, DM *cdm)
3236 {
3237   PetscSection   section, s;
3238   Mat            m;
3239   PetscInt       maxHeight;
3240   PetscErrorCode ierr;
3241 
3242   PetscFunctionBegin;
3243   ierr = DMClone(dm, cdm);CHKERRQ(ierr);
3244   ierr = DMPlexGetMaxProjectionHeight(dm, &maxHeight);CHKERRQ(ierr);
3245   ierr = DMPlexSetMaxProjectionHeight(*cdm, maxHeight);CHKERRQ(ierr);
3246   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
3247   ierr = DMSetDefaultSection(*cdm, section);CHKERRQ(ierr);
3248   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
3249   ierr = PetscSectionCreate(PETSC_COMM_SELF, &s);CHKERRQ(ierr);
3250   ierr = MatCreate(PETSC_COMM_SELF, &m);CHKERRQ(ierr);
3251   ierr = DMSetDefaultConstraints(*cdm, s, m);CHKERRQ(ierr);
3252   ierr = PetscSectionDestroy(&s);CHKERRQ(ierr);
3253   ierr = MatDestroy(&m);CHKERRQ(ierr);
3254   PetscFunctionReturn(0);
3255 }
3256 
3257 PetscErrorCode DMPlexGetConeSection(DM dm, PetscSection *section)
3258 {
3259   DM_Plex *mesh = (DM_Plex*) dm->data;
3260 
3261   PetscFunctionBegin;
3262   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3263   if (section) *section = mesh->coneSection;
3264   PetscFunctionReturn(0);
3265 }
3266 
3267 PetscErrorCode DMPlexGetSupportSection(DM dm, PetscSection *section)
3268 {
3269   DM_Plex *mesh = (DM_Plex*) dm->data;
3270 
3271   PetscFunctionBegin;
3272   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3273   if (section) *section = mesh->supportSection;
3274   PetscFunctionReturn(0);
3275 }
3276 
3277 PetscErrorCode DMPlexGetCones(DM dm, PetscInt *cones[])
3278 {
3279   DM_Plex *mesh = (DM_Plex*) dm->data;
3280 
3281   PetscFunctionBegin;
3282   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3283   if (cones) *cones = mesh->cones;
3284   PetscFunctionReturn(0);
3285 }
3286 
3287 PetscErrorCode DMPlexGetConeOrientations(DM dm, PetscInt *coneOrientations[])
3288 {
3289   DM_Plex *mesh = (DM_Plex*) dm->data;
3290 
3291   PetscFunctionBegin;
3292   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3293   if (coneOrientations) *coneOrientations = mesh->coneOrientations;
3294   PetscFunctionReturn(0);
3295 }
3296 
3297 /******************************** FEM Support **********************************/
3298 
3299 PetscErrorCode DMPlexCreateSpectralClosurePermutation(DM dm, PetscSection section)
3300 {
3301   PetscInt      *perm;
3302   PetscInt       dim, eStart, k, Nf, f, Nc, c, i, j, size = 0, offset = 0, foffset = 0;
3303   PetscErrorCode ierr;
3304 
3305   PetscFunctionBegin;
3306   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
3307   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
3308   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
3309   if (dim <= 1) PetscFunctionReturn(0);
3310   for (f = 0; f < Nf; ++f) {
3311     /* An order k SEM disc has k-1 dofs on an edge */
3312     ierr = DMPlexGetDepthStratum(dm, 1, &eStart, NULL);CHKERRQ(ierr);
3313     ierr = PetscSectionGetFieldDof(section, eStart, f, &k);CHKERRQ(ierr);
3314     ierr = PetscSectionGetFieldComponents(section, f, &Nc);CHKERRQ(ierr);
3315     k = k/Nc + 1;
3316     size += PetscPowInt(k+1, dim)*Nc;
3317   }
3318   ierr = PetscMalloc1(size, &perm);CHKERRQ(ierr);
3319   for (f = 0; f < Nf; ++f) {
3320     switch (dim) {
3321     case 2:
3322       /* The original quad closure is oriented clockwise, {f, e_b, e_r, e_t, e_l, v_lb, v_rb, v_tr, v_tl} */
3323       ierr = DMPlexGetDepthStratum(dm, 1, &eStart, NULL);CHKERRQ(ierr);
3324       ierr = PetscSectionGetFieldDof(section, eStart, f, &k);CHKERRQ(ierr);
3325       ierr = PetscSectionGetFieldComponents(section, f, &Nc);CHKERRQ(ierr);
3326       k = k/Nc + 1;
3327       /* The SEM order is
3328 
3329          v_lb, {e_b}, v_rb,
3330          e^{(k-1)-i}_l, {f^{i*(k-1)}}, e^i_r,
3331          v_lt, reverse {e_t}, v_rt
3332       */
3333       {
3334         const PetscInt of   = 0;
3335         const PetscInt oeb  = of   + PetscSqr(k-1);
3336         const PetscInt oer  = oeb  + (k-1);
3337         const PetscInt oet  = oer  + (k-1);
3338         const PetscInt oel  = oet  + (k-1);
3339         const PetscInt ovlb = oel  + (k-1);
3340         const PetscInt ovrb = ovlb + 1;
3341         const PetscInt ovrt = ovrb + 1;
3342         const PetscInt ovlt = ovrt + 1;
3343         PetscInt       o;
3344 
3345         /* bottom */
3346         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovlb*Nc + c + foffset;
3347         for (o = oeb; o < oer; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3348         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovrb*Nc + c + foffset;
3349         /* middle */
3350         for (i = 0; i < k-1; ++i) {
3351           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oel+(k-2)-i)*Nc + c + foffset;
3352           for (o = of+(k-1)*i; o < of+(k-1)*(i+1); ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3353           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oer+i)*Nc + c + foffset;
3354         }
3355         /* top */
3356         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovlt*Nc + c + foffset;
3357         for (o = oel-1; o >= oet; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3358         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovrt*Nc + c + foffset;
3359         foffset = offset;
3360       }
3361       break;
3362     case 3:
3363       /* The original hex closure is
3364 
3365          {c,
3366           f_b, f_t, f_f, f_b, f_r, f_l,
3367           e_bl, e_bb, e_br, e_bf,  e_tf, e_tr, e_tb, e_tl,  e_rf, e_lf, e_lb, e_rb,
3368           v_blf, v_blb, v_brb, v_brf, v_tlf, v_trf, v_trb, v_tlb}
3369       */
3370       ierr = DMPlexGetDepthStratum(dm, 1, &eStart, NULL);CHKERRQ(ierr);
3371       ierr = PetscSectionGetFieldDof(section, eStart, f, &k);CHKERRQ(ierr);
3372       ierr = PetscSectionGetFieldComponents(section, f, &Nc);CHKERRQ(ierr);
3373       k = k/Nc + 1;
3374       /* The SEM order is
3375          Bottom Slice
3376          v_blf, {e^{(k-1)-n}_bf}, v_brf,
3377          e^{i}_bl, f^{n*(k-1)+(k-1)-i}_b, e^{(k-1)-i}_br,
3378          v_blb, {e_bb}, v_brb,
3379 
3380          Middle Slice (j)
3381          {e^{(k-1)-j}_lf}, {f^{j*(k-1)+n}_f}, e^j_rf,
3382          f^{i*(k-1)+j}_l, {c^{(j*(k-1) + i)*(k-1)+n}_t}, f^{j*(k-1)+i}_r,
3383          e^j_lb, {f^{j*(k-1)+(k-1)-n}_b}, e^{(k-1)-j}_rb,
3384 
3385          Top Slice
3386          v_tlf, {e_tf}, v_trf,
3387          e^{(k-1)-i}_tl, {f^{i*(k-1)}_t}, e^{i}_tr,
3388          v_tlb, {e^{(k-1)-n}_tb}, v_trb,
3389       */
3390       {
3391         const PetscInt oc    = 0;
3392         const PetscInt ofb   = oc    + PetscSqr(k-1)*(k-1);
3393         const PetscInt oft   = ofb   + PetscSqr(k-1);
3394         const PetscInt off   = oft   + PetscSqr(k-1);
3395         const PetscInt ofk   = off   + PetscSqr(k-1);
3396         const PetscInt ofr   = ofk   + PetscSqr(k-1);
3397         const PetscInt ofl   = ofr   + PetscSqr(k-1);
3398         const PetscInt oebl  = ofl   + PetscSqr(k-1);
3399         const PetscInt oebb  = oebl  + (k-1);
3400         const PetscInt oebr  = oebb  + (k-1);
3401         const PetscInt oebf  = oebr  + (k-1);
3402         const PetscInt oetf  = oebf  + (k-1);
3403         const PetscInt oetr  = oetf  + (k-1);
3404         const PetscInt oetb  = oetr  + (k-1);
3405         const PetscInt oetl  = oetb  + (k-1);
3406         const PetscInt oerf  = oetl  + (k-1);
3407         const PetscInt oelf  = oerf  + (k-1);
3408         const PetscInt oelb  = oelf  + (k-1);
3409         const PetscInt oerb  = oelb  + (k-1);
3410         const PetscInt ovblf = oerb  + (k-1);
3411         const PetscInt ovblb = ovblf + 1;
3412         const PetscInt ovbrb = ovblb + 1;
3413         const PetscInt ovbrf = ovbrb + 1;
3414         const PetscInt ovtlf = ovbrf + 1;
3415         const PetscInt ovtrf = ovtlf + 1;
3416         const PetscInt ovtrb = ovtrf + 1;
3417         const PetscInt ovtlb = ovtrb + 1;
3418         PetscInt       o, n;
3419 
3420         /* Bottom Slice */
3421         /*   bottom */
3422         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovblf*Nc + c + foffset;
3423         for (o = oetf-1; o >= oebf; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3424         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovbrf*Nc + c + foffset;
3425         /*   middle */
3426         for (i = 0; i < k-1; ++i) {
3427           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oebl+i)*Nc + c + foffset;
3428           for (n = 0; n < k-1; ++n) {o = ofb+n*(k-1)+i; for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;}
3429           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oebr+(k-2)-i)*Nc + c + foffset;
3430         }
3431         /*   top */
3432         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovblb*Nc + c + foffset;
3433         for (o = oebb; o < oebr; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3434         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovbrb*Nc + c + foffset;
3435 
3436         /* Middle Slice */
3437         for (j = 0; j < k-1; ++j) {
3438           /*   bottom */
3439           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oelf+(k-2)-j)*Nc + c + foffset;
3440           for (o = off+j*(k-1); o < off+(j+1)*(k-1); ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3441           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oerf+j)*Nc + c + foffset;
3442           /*   middle */
3443           for (i = 0; i < k-1; ++i) {
3444             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (ofl+i*(k-1)+j)*Nc + c + foffset;
3445             for (n = 0; n < k-1; ++n) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oc+(j*(k-1)+i)*(k-1)+n)*Nc + c + foffset;
3446             for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (ofr+j*(k-1)+i)*Nc + c + foffset;
3447           }
3448           /*   top */
3449           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oelb+j)*Nc + c + foffset;
3450           for (o = ofk+j*(k-1)+(k-2); o >= ofk+j*(k-1); --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3451           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oerb+(k-2)-j)*Nc + c + foffset;
3452         }
3453 
3454         /* Top Slice */
3455         /*   bottom */
3456         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtlf*Nc + c + foffset;
3457         for (o = oetf; o < oetr; ++o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3458         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtrf*Nc + c + foffset;
3459         /*   middle */
3460         for (i = 0; i < k-1; ++i) {
3461           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oetl+(k-2)-i)*Nc + c + foffset;
3462           for (n = 0; n < k-1; ++n) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oft+i*(k-1)+n)*Nc + c + foffset;
3463           for (c = 0; c < Nc; ++c, ++offset) perm[offset] = (oetr+i)*Nc + c + foffset;
3464         }
3465         /*   top */
3466         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtlb*Nc + c + foffset;
3467         for (o = oetl-1; o >= oetb; --o) for (c = 0; c < Nc; ++c, ++offset) perm[offset] = o*Nc + c + foffset;
3468         for (c = 0; c < Nc; ++c, ++offset) perm[offset] = ovtrb*Nc + c + foffset;
3469 
3470         foffset = offset;
3471       }
3472       break;
3473     default: SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "No spectral ordering for dimension %D", dim);
3474     }
3475   }
3476   if (offset != size) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Number of permutation entries %D != %D", offset, size);
3477   /* Check permutation */
3478   {
3479     PetscInt *check;
3480 
3481     ierr = PetscMalloc1(size, &check);CHKERRQ(ierr);
3482     for (i = 0; i < size; ++i) {check[i] = -1; if (perm[i] < 0 || perm[i] >= size) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Invalid permutation index p[%D] = %D", i, perm[i]);}
3483     for (i = 0; i < size; ++i) check[perm[i]] = i;
3484     for (i = 0; i < size; ++i) {if (check[i] < 0) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Missing permutation index %D", i);}
3485     ierr = PetscFree(check);CHKERRQ(ierr);
3486   }
3487   ierr = PetscSectionSetClosurePermutation_Internal(section, (PetscObject) dm, size, PETSC_OWN_POINTER, perm);CHKERRQ(ierr);
3488   PetscFunctionReturn(0);
3489 }
3490 
3491 PetscErrorCode DMPlexGetPointDualSpaceFEM(DM dm, PetscInt point, PetscInt field, PetscDualSpace *dspace)
3492 {
3493   PetscDS        prob;
3494   PetscInt       depth, Nf, h;
3495   DMLabel        label;
3496   PetscErrorCode ierr;
3497 
3498   PetscFunctionBeginHot;
3499   prob    = dm->prob;
3500   Nf      = prob->Nf;
3501   label   = dm->depthLabel;
3502   *dspace = NULL;
3503   if (field < Nf) {
3504     PetscObject disc = prob->disc[field];
3505 
3506     if (disc->classid == PETSCFE_CLASSID) {
3507       PetscDualSpace dsp;
3508 
3509       ierr = PetscFEGetDualSpace((PetscFE)disc,&dsp);CHKERRQ(ierr);
3510       ierr = DMLabelGetNumValues(label,&depth);CHKERRQ(ierr);
3511       ierr = DMLabelGetValue(label,point,&h);CHKERRQ(ierr);
3512       h    = depth - 1 - h;
3513       if (h) {
3514         ierr = PetscDualSpaceGetHeightSubspace(dsp,h,dspace);CHKERRQ(ierr);
3515       } else {
3516         *dspace = dsp;
3517       }
3518     }
3519   }
3520   PetscFunctionReturn(0);
3521 }
3522 
3523 
3524 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3525 {
3526   PetscScalar    *array, *vArray;
3527   const PetscInt *cone, *coneO;
3528   PetscInt        pStart, pEnd, p, numPoints, size = 0, offset = 0;
3529   PetscErrorCode  ierr;
3530 
3531   PetscFunctionBeginHot;
3532   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3533   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
3534   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
3535   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
3536   if (!values || !*values) {
3537     if ((point >= pStart) && (point < pEnd)) {
3538       PetscInt dof;
3539 
3540       ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3541       size += dof;
3542     }
3543     for (p = 0; p < numPoints; ++p) {
3544       const PetscInt cp = cone[p];
3545       PetscInt       dof;
3546 
3547       if ((cp < pStart) || (cp >= pEnd)) continue;
3548       ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3549       size += dof;
3550     }
3551     if (!values) {
3552       if (csize) *csize = size;
3553       PetscFunctionReturn(0);
3554     }
3555     ierr = DMGetWorkArray(dm, size, PETSC_SCALAR, &array);CHKERRQ(ierr);
3556   } else {
3557     array = *values;
3558   }
3559   size = 0;
3560   ierr = VecGetArray(v, &vArray);CHKERRQ(ierr);
3561   if ((point >= pStart) && (point < pEnd)) {
3562     PetscInt     dof, off, d;
3563     PetscScalar *varr;
3564 
3565     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3566     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3567     varr = &vArray[off];
3568     for (d = 0; d < dof; ++d, ++offset) {
3569       array[offset] = varr[d];
3570     }
3571     size += dof;
3572   }
3573   for (p = 0; p < numPoints; ++p) {
3574     const PetscInt cp = cone[p];
3575     PetscInt       o  = coneO[p];
3576     PetscInt       dof, off, d;
3577     PetscScalar   *varr;
3578 
3579     if ((cp < pStart) || (cp >= pEnd)) continue;
3580     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
3581     ierr = PetscSectionGetOffset(section, cp, &off);CHKERRQ(ierr);
3582     varr = &vArray[off];
3583     if (o >= 0) {
3584       for (d = 0; d < dof; ++d, ++offset) {
3585         array[offset] = varr[d];
3586       }
3587     } else {
3588       for (d = dof-1; d >= 0; --d, ++offset) {
3589         array[offset] = varr[d];
3590       }
3591     }
3592     size += dof;
3593   }
3594   ierr = VecRestoreArray(v, &vArray);CHKERRQ(ierr);
3595   if (!*values) {
3596     if (csize) *csize = size;
3597     *values = array;
3598   } else {
3599     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %D < actual size %D", *csize, size);
3600     *csize = size;
3601   }
3602   PetscFunctionReturn(0);
3603 }
3604 
3605 static PetscErrorCode DMPlexGetCompressedClosure(DM dm, PetscSection section, PetscInt point, PetscInt *numPoints, PetscInt **points, PetscSection *clSec, IS *clPoints, const PetscInt **clp)
3606 {
3607   const PetscInt *cla;
3608   PetscInt       np, *pts = NULL;
3609   PetscErrorCode ierr;
3610 
3611   PetscFunctionBeginHot;
3612   ierr = PetscSectionGetClosureIndex(section, (PetscObject) dm, clSec, clPoints);CHKERRQ(ierr);
3613   if (!*clPoints) {
3614     PetscInt pStart, pEnd, p, q;
3615 
3616     ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
3617     ierr = DMPlexGetTransitiveClosure(dm, point, PETSC_TRUE, &np, &pts);CHKERRQ(ierr);
3618     /* Compress out points not in the section */
3619     for (p = 0, q = 0; p < np; p++) {
3620       PetscInt r = pts[2*p];
3621       if ((r >= pStart) && (r < pEnd)) {
3622         pts[q*2]   = r;
3623         pts[q*2+1] = pts[2*p+1];
3624         ++q;
3625       }
3626     }
3627     np = q;
3628     cla = NULL;
3629   } else {
3630     PetscInt dof, off;
3631 
3632     ierr = PetscSectionGetDof(*clSec, point, &dof);CHKERRQ(ierr);
3633     ierr = PetscSectionGetOffset(*clSec, point, &off);CHKERRQ(ierr);
3634     ierr = ISGetIndices(*clPoints, &cla);CHKERRQ(ierr);
3635     np   = dof/2;
3636     pts  = (PetscInt *) &cla[off];
3637   }
3638   *numPoints = np;
3639   *points    = pts;
3640   *clp       = cla;
3641 
3642   PetscFunctionReturn(0);
3643 }
3644 
3645 static PetscErrorCode DMPlexRestoreCompressedClosure(DM dm, PetscSection section, PetscInt point, PetscInt *numPoints, PetscInt **points, PetscSection *clSec, IS *clPoints, const PetscInt **clp)
3646 {
3647   PetscErrorCode ierr;
3648 
3649   PetscFunctionBeginHot;
3650   if (!*clPoints) {
3651     ierr = DMPlexRestoreTransitiveClosure(dm, point, PETSC_TRUE, numPoints, points);CHKERRQ(ierr);
3652   } else {
3653     ierr = ISRestoreIndices(*clPoints, clp);CHKERRQ(ierr);
3654   }
3655   *numPoints = 0;
3656   *points    = NULL;
3657   *clSec     = NULL;
3658   *clPoints  = NULL;
3659   *clp       = NULL;
3660   PetscFunctionReturn(0);
3661 }
3662 
3663 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Static(DM dm, PetscSection section, PetscInt numPoints, const PetscInt points[], const PetscInt clperm[], const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
3664 {
3665   PetscInt          offset = 0, p;
3666   const PetscInt    **perms = NULL;
3667   const PetscScalar **flips = NULL;
3668   PetscErrorCode    ierr;
3669 
3670   PetscFunctionBeginHot;
3671   *size = 0;
3672   ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
3673   for (p = 0; p < numPoints; p++) {
3674     const PetscInt    point = points[2*p];
3675     const PetscInt    *perm = perms ? perms[p] : NULL;
3676     const PetscScalar *flip = flips ? flips[p] : NULL;
3677     PetscInt          dof, off, d;
3678     const PetscScalar *varr;
3679 
3680     ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
3681     ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3682     varr = &vArray[off];
3683     if (clperm) {
3684       if (perm) {
3685         for (d = 0; d < dof; d++) array[clperm[offset + perm[d]]]  = varr[d];
3686       } else {
3687         for (d = 0; d < dof; d++) array[clperm[offset +      d ]]  = varr[d];
3688       }
3689       if (flip) {
3690         for (d = 0; d < dof; d++) array[clperm[offset +      d ]] *= flip[d];
3691       }
3692     } else {
3693       if (perm) {
3694         for (d = 0; d < dof; d++) array[offset + perm[d]]  = varr[d];
3695       } else {
3696         for (d = 0; d < dof; d++) array[offset +      d ]  = varr[d];
3697       }
3698       if (flip) {
3699         for (d = 0; d < dof; d++) array[offset +      d ] *= flip[d];
3700       }
3701     }
3702     offset += dof;
3703   }
3704   ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
3705   *size = offset;
3706   PetscFunctionReturn(0);
3707 }
3708 
3709 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecGetClosure_Fields_Static(DM dm, PetscSection section, PetscInt numPoints, const PetscInt points[], PetscInt numFields, const PetscInt clperm[], const PetscScalar vArray[], PetscInt *size, PetscScalar array[])
3710 {
3711   PetscInt          offset = 0, f;
3712   PetscErrorCode    ierr;
3713 
3714   PetscFunctionBeginHot;
3715   *size = 0;
3716   for (f = 0; f < numFields; ++f) {
3717     PetscInt          p;
3718     const PetscInt    **perms = NULL;
3719     const PetscScalar **flips = NULL;
3720 
3721     ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
3722     for (p = 0; p < numPoints; p++) {
3723       const PetscInt    point = points[2*p];
3724       PetscInt          fdof, foff, b;
3725       const PetscScalar *varr;
3726       const PetscInt    *perm = perms ? perms[p] : NULL;
3727       const PetscScalar *flip = flips ? flips[p] : NULL;
3728 
3729       ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
3730       ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
3731       varr = &vArray[foff];
3732       if (clperm) {
3733         if (perm) {for (b = 0; b < fdof; b++) {array[clperm[offset + perm[b]]]  = varr[b];}}
3734         else      {for (b = 0; b < fdof; b++) {array[clperm[offset +      b ]]  = varr[b];}}
3735         if (flip) {for (b = 0; b < fdof; b++) {array[clperm[offset +      b ]] *= flip[b];}}
3736       } else {
3737         if (perm) {for (b = 0; b < fdof; b++) {array[offset + perm[b]]  = varr[b];}}
3738         else      {for (b = 0; b < fdof; b++) {array[offset +      b ]  = varr[b];}}
3739         if (flip) {for (b = 0; b < fdof; b++) {array[offset +      b ] *= flip[b];}}
3740       }
3741       offset += fdof;
3742     }
3743     ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
3744   }
3745   *size = offset;
3746   PetscFunctionReturn(0);
3747 }
3748 
3749 /*@C
3750   DMPlexVecGetClosure - Get an array of the values on the closure of 'point'
3751 
3752   Not collective
3753 
3754   Input Parameters:
3755 + dm - The DM
3756 . section - The section describing the layout in v, or NULL to use the default section
3757 . v - The local vector
3758 - point - The sieve point in the DM
3759 
3760   Output Parameters:
3761 + csize - The number of values in the closure, or NULL
3762 - values - The array of values, which is a borrowed array and should not be freed
3763 
3764   Fortran Notes:
3765   Since it returns an array, this routine is only available in Fortran 90, and you must
3766   include petsc.h90 in your code.
3767 
3768   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
3769 
3770   Level: intermediate
3771 
3772 .seealso DMPlexVecRestoreClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
3773 @*/
3774 PetscErrorCode DMPlexVecGetClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3775 {
3776   PetscSection       clSection;
3777   IS                 clPoints;
3778   PetscScalar       *array;
3779   const PetscScalar *vArray;
3780   PetscInt          *points = NULL;
3781   const PetscInt    *clp, *perm;
3782   PetscInt           depth, numFields, numPoints, size;
3783   PetscErrorCode     ierr;
3784 
3785   PetscFunctionBeginHot;
3786   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3787   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
3788   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
3789   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
3790   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
3791   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
3792   if (depth == 1 && numFields < 2) {
3793     ierr = DMPlexVecGetClosure_Depth1_Static(dm, section, v, point, csize, values);CHKERRQ(ierr);
3794     PetscFunctionReturn(0);
3795   }
3796   /* Get points */
3797   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
3798   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, NULL, &perm);CHKERRQ(ierr);
3799   /* Get array */
3800   if (!values || !*values) {
3801     PetscInt asize = 0, dof, p;
3802 
3803     for (p = 0; p < numPoints*2; p += 2) {
3804       ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
3805       asize += dof;
3806     }
3807     if (!values) {
3808       ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
3809       if (csize) *csize = asize;
3810       PetscFunctionReturn(0);
3811     }
3812     ierr = DMGetWorkArray(dm, asize, PETSC_SCALAR, &array);CHKERRQ(ierr);
3813   } else {
3814     array = *values;
3815   }
3816   ierr = VecGetArrayRead(v, &vArray);CHKERRQ(ierr);
3817   /* Get values */
3818   if (numFields > 0) {ierr = DMPlexVecGetClosure_Fields_Static(dm, section, numPoints, points, numFields, perm, vArray, &size, array);CHKERRQ(ierr);}
3819   else               {ierr = DMPlexVecGetClosure_Static(dm, section, numPoints, points, perm, vArray, &size, array);CHKERRQ(ierr);}
3820   /* Cleanup points */
3821   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
3822   /* Cleanup array */
3823   ierr = VecRestoreArrayRead(v, &vArray);CHKERRQ(ierr);
3824   if (!*values) {
3825     if (csize) *csize = size;
3826     *values = array;
3827   } else {
3828     if (size > *csize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Size of input array %D < actual size %D", *csize, size);
3829     *csize = size;
3830   }
3831   PetscFunctionReturn(0);
3832 }
3833 
3834 /*@C
3835   DMPlexVecRestoreClosure - Restore the array of the values on the closure of 'point'
3836 
3837   Not collective
3838 
3839   Input Parameters:
3840 + dm - The DM
3841 . section - The section describing the layout in v, or NULL to use the default section
3842 . v - The local vector
3843 . point - The sieve point in the DM
3844 . csize - The number of values in the closure, or NULL
3845 - values - The array of values, which is a borrowed array and should not be freed
3846 
3847   Fortran Notes:
3848   Since it returns an array, this routine is only available in Fortran 90, and you must
3849   include petsc.h90 in your code.
3850 
3851   The csize argument is not present in the Fortran 90 binding since it is internal to the array.
3852 
3853   Level: intermediate
3854 
3855 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure(), DMPlexMatSetClosure()
3856 @*/
3857 PetscErrorCode DMPlexVecRestoreClosure(DM dm, PetscSection section, Vec v, PetscInt point, PetscInt *csize, PetscScalar *values[])
3858 {
3859   PetscInt       size = 0;
3860   PetscErrorCode ierr;
3861 
3862   PetscFunctionBegin;
3863   /* Should work without recalculating size */
3864   ierr = DMRestoreWorkArray(dm, size, PETSC_SCALAR, (void*) values);CHKERRQ(ierr);
3865   PetscFunctionReturn(0);
3866 }
3867 
3868 PETSC_STATIC_INLINE void add   (PetscScalar *x, PetscScalar y) {*x += y;}
3869 PETSC_STATIC_INLINE void insert(PetscScalar *x, PetscScalar y) {*x  = y;}
3870 
3871 PETSC_STATIC_INLINE PetscErrorCode updatePoint_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, const PetscInt perm[], const PetscScalar flip[], const PetscInt clperm[], const PetscScalar values[], PetscInt offset, PetscScalar array[])
3872 {
3873   PetscInt        cdof;   /* The number of constraints on this point */
3874   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3875   PetscScalar    *a;
3876   PetscInt        off, cind = 0, k;
3877   PetscErrorCode  ierr;
3878 
3879   PetscFunctionBegin;
3880   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
3881   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3882   a    = &array[off];
3883   if (!cdof || setBC) {
3884     if (clperm) {
3885       if (perm) {for (k = 0; k < dof; ++k) {fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));}}
3886       else      {for (k = 0; k < dof; ++k) {fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));}}
3887     } else {
3888       if (perm) {for (k = 0; k < dof; ++k) {fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));}}
3889       else      {for (k = 0; k < dof; ++k) {fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));}}
3890     }
3891   } else {
3892     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
3893     if (clperm) {
3894       if (perm) {for (k = 0; k < dof; ++k) {
3895           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3896           fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));
3897         }
3898       } else {
3899         for (k = 0; k < dof; ++k) {
3900           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3901           fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));
3902         }
3903       }
3904     } else {
3905       if (perm) {
3906         for (k = 0; k < dof; ++k) {
3907           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3908           fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));
3909         }
3910       } else {
3911         for (k = 0; k < dof; ++k) {
3912           if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
3913           fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));
3914         }
3915       }
3916     }
3917   }
3918   PetscFunctionReturn(0);
3919 }
3920 
3921 PETSC_STATIC_INLINE PetscErrorCode updatePointBC_private(PetscSection section, PetscInt point, PetscInt dof, void (*fuse)(PetscScalar*, PetscScalar), const PetscInt perm[], const PetscScalar flip[], const PetscInt clperm[], const PetscScalar values[], PetscInt offset, PetscScalar array[])
3922 {
3923   PetscInt        cdof;   /* The number of constraints on this point */
3924   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
3925   PetscScalar    *a;
3926   PetscInt        off, cind = 0, k;
3927   PetscErrorCode  ierr;
3928 
3929   PetscFunctionBegin;
3930   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
3931   ierr = PetscSectionGetOffset(section, point, &off);CHKERRQ(ierr);
3932   a    = &array[off];
3933   if (cdof) {
3934     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
3935     if (clperm) {
3936       if (perm) {
3937         for (k = 0; k < dof; ++k) {
3938           if ((cind < cdof) && (k == cdofs[cind])) {
3939             fuse(&a[k], values[clperm[offset+perm[k]]] * (flip ? flip[perm[k]] : 1.));
3940             cind++;
3941           }
3942         }
3943       } else {
3944         for (k = 0; k < dof; ++k) {
3945           if ((cind < cdof) && (k == cdofs[cind])) {
3946             fuse(&a[k], values[clperm[offset+     k ]] * (flip ? flip[     k ] : 1.));
3947             cind++;
3948           }
3949         }
3950       }
3951     } else {
3952       if (perm) {
3953         for (k = 0; k < dof; ++k) {
3954           if ((cind < cdof) && (k == cdofs[cind])) {
3955             fuse(&a[k], values[offset+perm[k]] * (flip ? flip[perm[k]] : 1.));
3956             cind++;
3957           }
3958         }
3959       } else {
3960         for (k = 0; k < dof; ++k) {
3961           if ((cind < cdof) && (k == cdofs[cind])) {
3962             fuse(&a[k], values[offset+     k ] * (flip ? flip[     k ] : 1.));
3963             cind++;
3964           }
3965         }
3966       }
3967     }
3968   }
3969   PetscFunctionReturn(0);
3970 }
3971 
3972 PETSC_STATIC_INLINE PetscErrorCode updatePointFields_private(PetscSection section, PetscInt point, const PetscInt *perm, const PetscScalar *flip, PetscInt f, void (*fuse)(PetscScalar*, PetscScalar), PetscBool setBC, const PetscInt clperm[], const PetscScalar values[], PetscInt *offset, PetscScalar array[])
3973 {
3974   PetscScalar    *a;
3975   PetscInt        fdof, foff, fcdof, foffset = *offset;
3976   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
3977   PetscInt        cind = 0, b;
3978   PetscErrorCode  ierr;
3979 
3980   PetscFunctionBegin;
3981   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
3982   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
3983   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
3984   a    = &array[foff];
3985   if (!fcdof || setBC) {
3986     if (clperm) {
3987       if (perm) {for (b = 0; b < fdof; b++) {fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));}}
3988       else      {for (b = 0; b < fdof; b++) {fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));}}
3989     } else {
3990       if (perm) {for (b = 0; b < fdof; b++) {fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));}}
3991       else      {for (b = 0; b < fdof; b++) {fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));}}
3992     }
3993   } else {
3994     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
3995     if (clperm) {
3996       if (perm) {
3997         for (b = 0; b < fdof; b++) {
3998           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
3999           fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));
4000         }
4001       } else {
4002         for (b = 0; b < fdof; b++) {
4003           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4004           fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));
4005         }
4006       }
4007     } else {
4008       if (perm) {
4009         for (b = 0; b < fdof; b++) {
4010           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4011           fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));
4012         }
4013       } else {
4014         for (b = 0; b < fdof; b++) {
4015           if ((cind < fcdof) && (b == fcdofs[cind])) {++cind; continue;}
4016           fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));
4017         }
4018       }
4019     }
4020   }
4021   *offset += fdof;
4022   PetscFunctionReturn(0);
4023 }
4024 
4025 PETSC_STATIC_INLINE PetscErrorCode updatePointFieldsBC_private(PetscSection section, PetscInt point, const PetscInt perm[], const PetscScalar flip[], PetscInt f, void (*fuse)(PetscScalar*, PetscScalar), const PetscInt clperm[], const PetscScalar values[], PetscInt *offset, PetscScalar array[])
4026 {
4027   PetscScalar    *a;
4028   PetscInt        fdof, foff, fcdof, foffset = *offset;
4029   const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4030   PetscInt        cind = 0, b;
4031   PetscErrorCode  ierr;
4032 
4033   PetscFunctionBegin;
4034   ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4035   ierr = PetscSectionGetFieldConstraintDof(section, point, f, &fcdof);CHKERRQ(ierr);
4036   ierr = PetscSectionGetFieldOffset(section, point, f, &foff);CHKERRQ(ierr);
4037   a    = &array[foff];
4038   if (fcdof) {
4039     ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4040     if (clperm) {
4041       if (perm) {
4042         for (b = 0; b < fdof; b++) {
4043           if ((cind < fcdof) && (b == fcdofs[cind])) {
4044             fuse(&a[b], values[clperm[foffset+perm[b]]] * (flip ? flip[perm[b]] : 1.));
4045             ++cind;
4046           }
4047         }
4048       } else {
4049         for (b = 0; b < fdof; b++) {
4050           if ((cind < fcdof) && (b == fcdofs[cind])) {
4051             fuse(&a[b], values[clperm[foffset+     b ]] * (flip ? flip[     b ] : 1.));
4052             ++cind;
4053           }
4054         }
4055       }
4056     } else {
4057       if (perm) {
4058         for (b = 0; b < fdof; b++) {
4059           if ((cind < fcdof) && (b == fcdofs[cind])) {
4060             fuse(&a[b], values[foffset+perm[b]] * (flip ? flip[perm[b]] : 1.));
4061             ++cind;
4062           }
4063         }
4064       } else {
4065         for (b = 0; b < fdof; b++) {
4066           if ((cind < fcdof) && (b == fcdofs[cind])) {
4067             fuse(&a[b], values[foffset+     b ] * (flip ? flip[     b ] : 1.));
4068             ++cind;
4069           }
4070         }
4071       }
4072     }
4073   }
4074   *offset += fdof;
4075   PetscFunctionReturn(0);
4076 }
4077 
4078 PETSC_STATIC_INLINE PetscErrorCode DMPlexVecSetClosure_Depth1_Static(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
4079 {
4080   PetscScalar    *array;
4081   const PetscInt *cone, *coneO;
4082   PetscInt        pStart, pEnd, p, numPoints, off, dof;
4083   PetscErrorCode  ierr;
4084 
4085   PetscFunctionBeginHot;
4086   ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
4087   ierr = DMPlexGetConeSize(dm, point, &numPoints);CHKERRQ(ierr);
4088   ierr = DMPlexGetCone(dm, point, &cone);CHKERRQ(ierr);
4089   ierr = DMPlexGetConeOrientation(dm, point, &coneO);CHKERRQ(ierr);
4090   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4091   for (p = 0, off = 0; p <= numPoints; ++p, off += dof) {
4092     const PetscInt cp = !p ? point : cone[p-1];
4093     const PetscInt o  = !p ? 0     : coneO[p-1];
4094 
4095     if ((cp < pStart) || (cp >= pEnd)) {dof = 0; continue;}
4096     ierr = PetscSectionGetDof(section, cp, &dof);CHKERRQ(ierr);
4097     /* ADD_VALUES */
4098     {
4099       const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4100       PetscScalar    *a;
4101       PetscInt        cdof, coff, cind = 0, k;
4102 
4103       ierr = PetscSectionGetConstraintDof(section, cp, &cdof);CHKERRQ(ierr);
4104       ierr = PetscSectionGetOffset(section, cp, &coff);CHKERRQ(ierr);
4105       a    = &array[coff];
4106       if (!cdof) {
4107         if (o >= 0) {
4108           for (k = 0; k < dof; ++k) {
4109             a[k] += values[off+k];
4110           }
4111         } else {
4112           for (k = 0; k < dof; ++k) {
4113             a[k] += values[off+dof-k-1];
4114           }
4115         }
4116       } else {
4117         ierr = PetscSectionGetConstraintIndices(section, cp, &cdofs);CHKERRQ(ierr);
4118         if (o >= 0) {
4119           for (k = 0; k < dof; ++k) {
4120             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4121             a[k] += values[off+k];
4122           }
4123         } else {
4124           for (k = 0; k < dof; ++k) {
4125             if ((cind < cdof) && (k == cdofs[cind])) {++cind; continue;}
4126             a[k] += values[off+dof-k-1];
4127           }
4128         }
4129       }
4130     }
4131   }
4132   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4133   PetscFunctionReturn(0);
4134 }
4135 
4136 /*@C
4137   DMPlexVecSetClosure - Set an array of the values on the closure of 'point'
4138 
4139   Not collective
4140 
4141   Input Parameters:
4142 + dm - The DM
4143 . section - The section describing the layout in v, or NULL to use the default section
4144 . v - The local vector
4145 . point - The sieve point in the DM
4146 . values - The array of values
4147 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
4148 
4149   Fortran Notes:
4150   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
4151 
4152   Level: intermediate
4153 
4154 .seealso DMPlexVecGetClosure(), DMPlexMatSetClosure()
4155 @*/
4156 PetscErrorCode DMPlexVecSetClosure(DM dm, PetscSection section, Vec v, PetscInt point, const PetscScalar values[], InsertMode mode)
4157 {
4158   PetscSection    clSection;
4159   IS              clPoints;
4160   PetscScalar    *array;
4161   PetscInt       *points = NULL;
4162   const PetscInt *clp, *clperm;
4163   PetscInt        depth, numFields, numPoints, p;
4164   PetscErrorCode  ierr;
4165 
4166   PetscFunctionBeginHot;
4167   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4168   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4169   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4170   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4171   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
4172   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4173   if (depth == 1 && numFields < 2 && mode == ADD_VALUES) {
4174     ierr = DMPlexVecSetClosure_Depth1_Static(dm, section, v, point, values, mode);CHKERRQ(ierr);
4175     PetscFunctionReturn(0);
4176   }
4177   /* Get points */
4178   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, NULL, &clperm);CHKERRQ(ierr);
4179   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4180   /* Get array */
4181   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4182   /* Get values */
4183   if (numFields > 0) {
4184     PetscInt offset = 0, f;
4185     for (f = 0; f < numFields; ++f) {
4186       const PetscInt    **perms = NULL;
4187       const PetscScalar **flips = NULL;
4188 
4189       ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4190       switch (mode) {
4191       case INSERT_VALUES:
4192         for (p = 0; p < numPoints; p++) {
4193           const PetscInt    point = points[2*p];
4194           const PetscInt    *perm = perms ? perms[p] : NULL;
4195           const PetscScalar *flip = flips ? flips[p] : NULL;
4196           updatePointFields_private(section, point, perm, flip, f, insert, PETSC_FALSE, clperm, values, &offset, array);
4197         } break;
4198       case INSERT_ALL_VALUES:
4199         for (p = 0; p < numPoints; p++) {
4200           const PetscInt    point = points[2*p];
4201           const PetscInt    *perm = perms ? perms[p] : NULL;
4202           const PetscScalar *flip = flips ? flips[p] : NULL;
4203           updatePointFields_private(section, point, perm, flip, f, insert, PETSC_TRUE, clperm, values, &offset, array);
4204         } break;
4205       case INSERT_BC_VALUES:
4206         for (p = 0; p < numPoints; p++) {
4207           const PetscInt    point = points[2*p];
4208           const PetscInt    *perm = perms ? perms[p] : NULL;
4209           const PetscScalar *flip = flips ? flips[p] : NULL;
4210           updatePointFieldsBC_private(section, point, perm, flip, f, insert, clperm, values, &offset, array);
4211         } break;
4212       case ADD_VALUES:
4213         for (p = 0; p < numPoints; p++) {
4214           const PetscInt    point = points[2*p];
4215           const PetscInt    *perm = perms ? perms[p] : NULL;
4216           const PetscScalar *flip = flips ? flips[p] : NULL;
4217           updatePointFields_private(section, point, perm, flip, f, add, PETSC_FALSE, clperm, values, &offset, array);
4218         } break;
4219       case ADD_ALL_VALUES:
4220         for (p = 0; p < numPoints; p++) {
4221           const PetscInt    point = points[2*p];
4222           const PetscInt    *perm = perms ? perms[p] : NULL;
4223           const PetscScalar *flip = flips ? flips[p] : NULL;
4224           updatePointFields_private(section, point, perm, flip, f, add, PETSC_TRUE, clperm, values, &offset, array);
4225         } break;
4226       case ADD_BC_VALUES:
4227         for (p = 0; p < numPoints; p++) {
4228           const PetscInt    point = points[2*p];
4229           const PetscInt    *perm = perms ? perms[p] : NULL;
4230           const PetscScalar *flip = flips ? flips[p] : NULL;
4231           updatePointFieldsBC_private(section, point, perm, flip, f, add, clperm, values, &offset, array);
4232         } break;
4233       default:
4234         SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
4235       }
4236       ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4237     }
4238   } else {
4239     PetscInt dof, off;
4240     const PetscInt    **perms = NULL;
4241     const PetscScalar **flips = NULL;
4242 
4243     ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4244     switch (mode) {
4245     case INSERT_VALUES:
4246       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4247         const PetscInt    point = points[2*p];
4248         const PetscInt    *perm = perms ? perms[p] : NULL;
4249         const PetscScalar *flip = flips ? flips[p] : NULL;
4250         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4251         updatePoint_private(section, point, dof, insert, PETSC_FALSE, perm, flip, clperm, values, off, array);
4252       } break;
4253     case INSERT_ALL_VALUES:
4254       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4255         const PetscInt    point = points[2*p];
4256         const PetscInt    *perm = perms ? perms[p] : NULL;
4257         const PetscScalar *flip = flips ? flips[p] : NULL;
4258         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4259         updatePoint_private(section, point, dof, insert, PETSC_TRUE,  perm, flip, clperm, values, off, array);
4260       } break;
4261     case INSERT_BC_VALUES:
4262       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4263         const PetscInt    point = points[2*p];
4264         const PetscInt    *perm = perms ? perms[p] : NULL;
4265         const PetscScalar *flip = flips ? flips[p] : NULL;
4266         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4267         updatePointBC_private(section, point, dof, insert,  perm, flip, clperm, values, off, array);
4268       } break;
4269     case ADD_VALUES:
4270       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4271         const PetscInt    point = points[2*p];
4272         const PetscInt    *perm = perms ? perms[p] : NULL;
4273         const PetscScalar *flip = flips ? flips[p] : NULL;
4274         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4275         updatePoint_private(section, point, dof, add,    PETSC_FALSE, perm, flip, clperm, values, off, array);
4276       } break;
4277     case ADD_ALL_VALUES:
4278       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4279         const PetscInt    point = points[2*p];
4280         const PetscInt    *perm = perms ? perms[p] : NULL;
4281         const PetscScalar *flip = flips ? flips[p] : NULL;
4282         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4283         updatePoint_private(section, point, dof, add,    PETSC_TRUE,  perm, flip, clperm, values, off, array);
4284       } break;
4285     case ADD_BC_VALUES:
4286       for (p = 0, off = 0; p < numPoints; p++, off += dof) {
4287         const PetscInt    point = points[2*p];
4288         const PetscInt    *perm = perms ? perms[p] : NULL;
4289         const PetscScalar *flip = flips ? flips[p] : NULL;
4290         ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4291         updatePointBC_private(section, point, dof, add,  perm, flip, clperm, values, off, array);
4292       } break;
4293     default:
4294       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
4295     }
4296     ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4297   }
4298   /* Cleanup points */
4299   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4300   /* Cleanup array */
4301   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4302   PetscFunctionReturn(0);
4303 }
4304 
4305 PetscErrorCode DMPlexVecSetFieldClosure_Internal(DM dm, PetscSection section, Vec v, PetscBool fieldActive[], PetscInt point, const PetscScalar values[], InsertMode mode)
4306 {
4307   PetscSection      clSection;
4308   IS                clPoints;
4309   PetscScalar       *array;
4310   PetscInt          *points = NULL;
4311   const PetscInt    *clp, *clperm;
4312   PetscInt          numFields, numPoints, p;
4313   PetscInt          offset = 0, f;
4314   PetscErrorCode    ierr;
4315 
4316   PetscFunctionBeginHot;
4317   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4318   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
4319   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4320   PetscValidHeaderSpecific(v, VEC_CLASSID, 3);
4321   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4322   /* Get points */
4323   ierr = PetscSectionGetClosureInversePermutation_Internal(section, (PetscObject) dm, NULL, &clperm);CHKERRQ(ierr);
4324   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4325   /* Get array */
4326   ierr = VecGetArray(v, &array);CHKERRQ(ierr);
4327   /* Get values */
4328   for (f = 0; f < numFields; ++f) {
4329     const PetscInt    **perms = NULL;
4330     const PetscScalar **flips = NULL;
4331 
4332     if (!fieldActive[f]) {
4333       for (p = 0; p < numPoints*2; p += 2) {
4334         PetscInt fdof;
4335         ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
4336         offset += fdof;
4337       }
4338       continue;
4339     }
4340     ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4341     switch (mode) {
4342     case INSERT_VALUES:
4343       for (p = 0; p < numPoints; p++) {
4344         const PetscInt    point = points[2*p];
4345         const PetscInt    *perm = perms ? perms[p] : NULL;
4346         const PetscScalar *flip = flips ? flips[p] : NULL;
4347         updatePointFields_private(section, point, perm, flip, f, insert, PETSC_FALSE, clperm, values, &offset, array);
4348       } break;
4349     case INSERT_ALL_VALUES:
4350       for (p = 0; p < numPoints; p++) {
4351         const PetscInt    point = points[2*p];
4352         const PetscInt    *perm = perms ? perms[p] : NULL;
4353         const PetscScalar *flip = flips ? flips[p] : NULL;
4354         updatePointFields_private(section, point, perm, flip, f, insert, PETSC_TRUE, clperm, values, &offset, array);
4355         } break;
4356     case INSERT_BC_VALUES:
4357       for (p = 0; p < numPoints; p++) {
4358         const PetscInt    point = points[2*p];
4359         const PetscInt    *perm = perms ? perms[p] : NULL;
4360         const PetscScalar *flip = flips ? flips[p] : NULL;
4361         updatePointFieldsBC_private(section, point, perm, flip, f, insert, clperm, values, &offset, array);
4362       } break;
4363     case ADD_VALUES:
4364       for (p = 0; p < numPoints; p++) {
4365         const PetscInt    point = points[2*p];
4366         const PetscInt    *perm = perms ? perms[p] : NULL;
4367         const PetscScalar *flip = flips ? flips[p] : NULL;
4368         updatePointFields_private(section, point, perm, flip, f, add, PETSC_FALSE, clperm, values, &offset, array);
4369       } break;
4370     case ADD_ALL_VALUES:
4371       for (p = 0; p < numPoints; p++) {
4372         const PetscInt    point = points[2*p];
4373         const PetscInt    *perm = perms ? perms[p] : NULL;
4374         const PetscScalar *flip = flips ? flips[p] : NULL;
4375         updatePointFields_private(section, point, perm, flip, f, add, PETSC_TRUE, clperm, values, &offset, array);
4376       } break;
4377     default:
4378       SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Invalid insert mode %d", mode);
4379     }
4380     ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms,&flips);CHKERRQ(ierr);
4381   }
4382   /* Cleanup points */
4383   ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
4384   /* Cleanup array */
4385   ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
4386   PetscFunctionReturn(0);
4387 }
4388 
4389 PetscErrorCode DMPlexPrintMatSetValues(PetscViewer viewer, Mat A, PetscInt point, PetscInt numRIndices, const PetscInt rindices[], PetscInt numCIndices, const PetscInt cindices[], const PetscScalar values[])
4390 {
4391   PetscMPIInt    rank;
4392   PetscInt       i, j;
4393   PetscErrorCode ierr;
4394 
4395   PetscFunctionBegin;
4396   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr);
4397   ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat for sieve point %D\n", rank, point);CHKERRQ(ierr);
4398   for (i = 0; i < numRIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat row indices[%D] = %D\n", rank, i, rindices[i]);CHKERRQ(ierr);}
4399   for (i = 0; i < numCIndices; i++) {ierr = PetscViewerASCIIPrintf(viewer, "[%d]mat col indices[%D] = %D\n", rank, i, cindices[i]);CHKERRQ(ierr);}
4400   numCIndices = numCIndices ? numCIndices : numRIndices;
4401   for (i = 0; i < numRIndices; i++) {
4402     ierr = PetscViewerASCIIPrintf(viewer, "[%d]", rank);CHKERRQ(ierr);
4403     for (j = 0; j < numCIndices; j++) {
4404 #if defined(PETSC_USE_COMPLEX)
4405       ierr = PetscViewerASCIIPrintf(viewer, " (%g,%g)", (double)PetscRealPart(values[i*numCIndices+j]), (double)PetscImaginaryPart(values[i*numCIndices+j]));CHKERRQ(ierr);
4406 #else
4407       ierr = PetscViewerASCIIPrintf(viewer, " %g", (double)values[i*numCIndices+j]);CHKERRQ(ierr);
4408 #endif
4409     }
4410     ierr = PetscViewerASCIIPrintf(viewer, "\n");CHKERRQ(ierr);
4411   }
4412   PetscFunctionReturn(0);
4413 }
4414 
4415 /* . off - The global offset of this point */
4416 PetscErrorCode DMPlexGetIndicesPoint_Internal(PetscSection section, PetscInt point, PetscInt off, PetscInt *loff, PetscBool setBC, const PetscInt perm[], PetscInt indices[])
4417 {
4418   PetscInt        dof;    /* The number of unknowns on this point */
4419   PetscInt        cdof;   /* The number of constraints on this point */
4420   const PetscInt *cdofs; /* The indices of the constrained dofs on this point */
4421   PetscInt        cind = 0, k;
4422   PetscErrorCode  ierr;
4423 
4424   PetscFunctionBegin;
4425   ierr = PetscSectionGetDof(section, point, &dof);CHKERRQ(ierr);
4426   ierr = PetscSectionGetConstraintDof(section, point, &cdof);CHKERRQ(ierr);
4427   if (!cdof || setBC) {
4428     if (perm) {
4429       for (k = 0; k < dof; k++) indices[*loff+perm[k]] = off + k;
4430     } else {
4431       for (k = 0; k < dof; k++) indices[*loff+k] = off + k;
4432     }
4433   } else {
4434     ierr = PetscSectionGetConstraintIndices(section, point, &cdofs);CHKERRQ(ierr);
4435     if (perm) {
4436       for (k = 0; k < dof; ++k) {
4437         if ((cind < cdof) && (k == cdofs[cind])) {
4438           /* Insert check for returning constrained indices */
4439           indices[*loff+perm[k]] = -(off+k+1);
4440           ++cind;
4441         } else {
4442           indices[*loff+perm[k]] = off+k-cind;
4443         }
4444       }
4445     } else {
4446       for (k = 0; k < dof; ++k) {
4447         if ((cind < cdof) && (k == cdofs[cind])) {
4448           /* Insert check for returning constrained indices */
4449           indices[*loff+k] = -(off+k+1);
4450           ++cind;
4451         } else {
4452           indices[*loff+k] = off+k-cind;
4453         }
4454       }
4455     }
4456   }
4457   *loff += dof;
4458   PetscFunctionReturn(0);
4459 }
4460 
4461 /* . off - The global offset of this point */
4462 PetscErrorCode DMPlexGetIndicesPointFields_Internal(PetscSection section, PetscInt point, PetscInt off, PetscInt foffs[], PetscBool setBC, const PetscInt ***perms, PetscInt permsoff, PetscInt indices[])
4463 {
4464   PetscInt       numFields, foff, f;
4465   PetscErrorCode ierr;
4466 
4467   PetscFunctionBegin;
4468   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4469   for (f = 0, foff = 0; f < numFields; ++f) {
4470     PetscInt        fdof, cfdof;
4471     const PetscInt *fcdofs; /* The indices of the constrained dofs for field f on this point */
4472     PetscInt        cind = 0, b;
4473     const PetscInt  *perm = (perms && perms[f]) ? perms[f][permsoff] : NULL;
4474 
4475     ierr = PetscSectionGetFieldDof(section, point, f, &fdof);CHKERRQ(ierr);
4476     ierr = PetscSectionGetFieldConstraintDof(section, point, f, &cfdof);CHKERRQ(ierr);
4477     if (!cfdof || setBC) {
4478       if (perm) {for (b = 0; b < fdof; b++) {indices[foffs[f]+perm[b]] = off+foff+b;}}
4479       else      {for (b = 0; b < fdof; b++) {indices[foffs[f]+     b ] = off+foff+b;}}
4480     } else {
4481       ierr = PetscSectionGetFieldConstraintIndices(section, point, f, &fcdofs);CHKERRQ(ierr);
4482       if (perm) {
4483         for (b = 0; b < fdof; b++) {
4484           if ((cind < cfdof) && (b == fcdofs[cind])) {
4485             indices[foffs[f]+perm[b]] = -(off+foff+b+1);
4486             ++cind;
4487           } else {
4488             indices[foffs[f]+perm[b]] = off+foff+b-cind;
4489           }
4490         }
4491       } else {
4492         for (b = 0; b < fdof; b++) {
4493           if ((cind < cfdof) && (b == fcdofs[cind])) {
4494             indices[foffs[f]+b] = -(off+foff+b+1);
4495             ++cind;
4496           } else {
4497             indices[foffs[f]+b] = off+foff+b-cind;
4498           }
4499         }
4500       }
4501     }
4502     foff     += (setBC ? fdof : (fdof - cfdof));
4503     foffs[f] += fdof;
4504   }
4505   PetscFunctionReturn(0);
4506 }
4507 
4508 PetscErrorCode DMPlexAnchorsModifyMat(DM dm, PetscSection section, PetscInt numPoints, PetscInt numIndices, const PetscInt points[], const PetscInt ***perms, const PetscScalar values[], PetscInt *outNumPoints, PetscInt *outNumIndices, PetscInt *outPoints[], PetscScalar *outValues[], PetscInt offsets[], PetscBool multiplyLeft)
4509 {
4510   Mat             cMat;
4511   PetscSection    aSec, cSec;
4512   IS              aIS;
4513   PetscInt        aStart = -1, aEnd = -1;
4514   const PetscInt  *anchors;
4515   PetscInt        numFields, f, p, q, newP = 0;
4516   PetscInt        newNumPoints = 0, newNumIndices = 0;
4517   PetscInt        *newPoints, *indices, *newIndices;
4518   PetscInt        maxAnchor, maxDof;
4519   PetscInt        newOffsets[32];
4520   PetscInt        *pointMatOffsets[32];
4521   PetscInt        *newPointOffsets[32];
4522   PetscScalar     *pointMat[32];
4523   PetscScalar     *newValues=NULL,*tmpValues;
4524   PetscBool       anyConstrained = PETSC_FALSE;
4525   PetscErrorCode  ierr;
4526 
4527   PetscFunctionBegin;
4528   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4529   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
4530   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
4531 
4532   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
4533   /* if there are point-to-point constraints */
4534   if (aSec) {
4535     ierr = PetscMemzero(newOffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
4536     ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
4537     ierr = PetscSectionGetChart(aSec,&aStart,&aEnd);CHKERRQ(ierr);
4538     /* figure out how many points are going to be in the new element matrix
4539      * (we allow double counting, because it's all just going to be summed
4540      * into the global matrix anyway) */
4541     for (p = 0; p < 2*numPoints; p+=2) {
4542       PetscInt b    = points[p];
4543       PetscInt bDof = 0, bSecDof;
4544 
4545       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
4546       if (!bSecDof) {
4547         continue;
4548       }
4549       if (b >= aStart && b < aEnd) {
4550         ierr = PetscSectionGetDof(aSec,b,&bDof);CHKERRQ(ierr);
4551       }
4552       if (bDof) {
4553         /* this point is constrained */
4554         /* it is going to be replaced by its anchors */
4555         PetscInt bOff, q;
4556 
4557         anyConstrained = PETSC_TRUE;
4558         newNumPoints  += bDof;
4559         ierr = PetscSectionGetOffset(aSec,b,&bOff);CHKERRQ(ierr);
4560         for (q = 0; q < bDof; q++) {
4561           PetscInt a = anchors[bOff + q];
4562           PetscInt aDof;
4563 
4564           ierr           = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
4565           newNumIndices += aDof;
4566           for (f = 0; f < numFields; ++f) {
4567             PetscInt fDof;
4568 
4569             ierr             = PetscSectionGetFieldDof(section, a, f, &fDof);CHKERRQ(ierr);
4570             newOffsets[f+1] += fDof;
4571           }
4572         }
4573       }
4574       else {
4575         /* this point is not constrained */
4576         newNumPoints++;
4577         newNumIndices += bSecDof;
4578         for (f = 0; f < numFields; ++f) {
4579           PetscInt fDof;
4580 
4581           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4582           newOffsets[f+1] += fDof;
4583         }
4584       }
4585     }
4586   }
4587   if (!anyConstrained) {
4588     if (outNumPoints)  *outNumPoints  = 0;
4589     if (outNumIndices) *outNumIndices = 0;
4590     if (outPoints)     *outPoints     = NULL;
4591     if (outValues)     *outValues     = NULL;
4592     if (aSec) {ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);}
4593     PetscFunctionReturn(0);
4594   }
4595 
4596   if (outNumPoints)  *outNumPoints  = newNumPoints;
4597   if (outNumIndices) *outNumIndices = newNumIndices;
4598 
4599   for (f = 0; f < numFields; ++f) newOffsets[f+1] += newOffsets[f];
4600 
4601   if (!outPoints && !outValues) {
4602     if (offsets) {
4603       for (f = 0; f <= numFields; f++) {
4604         offsets[f] = newOffsets[f];
4605       }
4606     }
4607     if (aSec) {ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);}
4608     PetscFunctionReturn(0);
4609   }
4610 
4611   if (numFields && newOffsets[numFields] != newNumIndices) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", newOffsets[numFields], newNumIndices);
4612 
4613   ierr = DMGetDefaultConstraints(dm, &cSec, &cMat);CHKERRQ(ierr);
4614 
4615   /* workspaces */
4616   if (numFields) {
4617     for (f = 0; f < numFields; f++) {
4618       ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
4619       ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[f]);CHKERRQ(ierr);
4620     }
4621   }
4622   else {
4623     ierr = DMGetWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
4624     ierr = DMGetWorkArray(dm,numPoints,PETSC_INT,&newPointOffsets[0]);CHKERRQ(ierr);
4625   }
4626 
4627   /* get workspaces for the point-to-point matrices */
4628   if (numFields) {
4629     PetscInt totalOffset, totalMatOffset;
4630 
4631     for (p = 0; p < numPoints; p++) {
4632       PetscInt b    = points[2*p];
4633       PetscInt bDof = 0, bSecDof;
4634 
4635       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
4636       if (!bSecDof) {
4637         for (f = 0; f < numFields; f++) {
4638           newPointOffsets[f][p + 1] = 0;
4639           pointMatOffsets[f][p + 1] = 0;
4640         }
4641         continue;
4642       }
4643       if (b >= aStart && b < aEnd) {
4644         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4645       }
4646       if (bDof) {
4647         for (f = 0; f < numFields; f++) {
4648           PetscInt fDof, q, bOff, allFDof = 0;
4649 
4650           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4651           ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
4652           for (q = 0; q < bDof; q++) {
4653             PetscInt a = anchors[bOff + q];
4654             PetscInt aFDof;
4655 
4656             ierr     = PetscSectionGetFieldDof(section, a, f, &aFDof);CHKERRQ(ierr);
4657             allFDof += aFDof;
4658           }
4659           newPointOffsets[f][p+1] = allFDof;
4660           pointMatOffsets[f][p+1] = fDof * allFDof;
4661         }
4662       }
4663       else {
4664         for (f = 0; f < numFields; f++) {
4665           PetscInt fDof;
4666 
4667           ierr = PetscSectionGetFieldDof(section, b, f, &fDof);CHKERRQ(ierr);
4668           newPointOffsets[f][p+1] = fDof;
4669           pointMatOffsets[f][p+1] = 0;
4670         }
4671       }
4672     }
4673     for (f = 0, totalOffset = 0, totalMatOffset = 0; f < numFields; f++) {
4674       newPointOffsets[f][0] = totalOffset;
4675       pointMatOffsets[f][0] = totalMatOffset;
4676       for (p = 0; p < numPoints; p++) {
4677         newPointOffsets[f][p+1] += newPointOffsets[f][p];
4678         pointMatOffsets[f][p+1] += pointMatOffsets[f][p];
4679       }
4680       totalOffset    = newPointOffsets[f][numPoints];
4681       totalMatOffset = pointMatOffsets[f][numPoints];
4682       ierr = DMGetWorkArray(dm,pointMatOffsets[f][numPoints],PETSC_SCALAR,&pointMat[f]);CHKERRQ(ierr);
4683     }
4684   }
4685   else {
4686     for (p = 0; p < numPoints; p++) {
4687       PetscInt b    = points[2*p];
4688       PetscInt bDof = 0, bSecDof;
4689 
4690       ierr = PetscSectionGetDof(section,b,&bSecDof);CHKERRQ(ierr);
4691       if (!bSecDof) {
4692         newPointOffsets[0][p + 1] = 0;
4693         pointMatOffsets[0][p + 1] = 0;
4694         continue;
4695       }
4696       if (b >= aStart && b < aEnd) {
4697         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4698       }
4699       if (bDof) {
4700         PetscInt bOff, q, allDof = 0;
4701 
4702         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
4703         for (q = 0; q < bDof; q++) {
4704           PetscInt a = anchors[bOff + q], aDof;
4705 
4706           ierr    = PetscSectionGetDof(section, a, &aDof);CHKERRQ(ierr);
4707           allDof += aDof;
4708         }
4709         newPointOffsets[0][p+1] = allDof;
4710         pointMatOffsets[0][p+1] = bSecDof * allDof;
4711       }
4712       else {
4713         newPointOffsets[0][p+1] = bSecDof;
4714         pointMatOffsets[0][p+1] = 0;
4715       }
4716     }
4717     newPointOffsets[0][0] = 0;
4718     pointMatOffsets[0][0] = 0;
4719     for (p = 0; p < numPoints; p++) {
4720       newPointOffsets[0][p+1] += newPointOffsets[0][p];
4721       pointMatOffsets[0][p+1] += pointMatOffsets[0][p];
4722     }
4723     ierr = DMGetWorkArray(dm,pointMatOffsets[0][numPoints],PETSC_SCALAR,&pointMat[0]);CHKERRQ(ierr);
4724   }
4725 
4726   /* output arrays */
4727   ierr = DMGetWorkArray(dm,2*newNumPoints,PETSC_INT,&newPoints);CHKERRQ(ierr);
4728 
4729   /* get the point-to-point matrices; construct newPoints */
4730   ierr = PetscSectionGetMaxDof(aSec, &maxAnchor);CHKERRQ(ierr);
4731   ierr = PetscSectionGetMaxDof(section, &maxDof);CHKERRQ(ierr);
4732   ierr = DMGetWorkArray(dm,maxDof,PETSC_INT,&indices);CHKERRQ(ierr);
4733   ierr = DMGetWorkArray(dm,maxAnchor*maxDof,PETSC_INT,&newIndices);CHKERRQ(ierr);
4734   if (numFields) {
4735     for (p = 0, newP = 0; p < numPoints; p++) {
4736       PetscInt b    = points[2*p];
4737       PetscInt o    = points[2*p+1];
4738       PetscInt bDof = 0, bSecDof;
4739 
4740       ierr = PetscSectionGetDof(section, b, &bSecDof);CHKERRQ(ierr);
4741       if (!bSecDof) {
4742         continue;
4743       }
4744       if (b >= aStart && b < aEnd) {
4745         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4746       }
4747       if (bDof) {
4748         PetscInt fStart[32], fEnd[32], fAnchorStart[32], fAnchorEnd[32], bOff, q;
4749 
4750         fStart[0] = 0;
4751         fEnd[0]   = 0;
4752         for (f = 0; f < numFields; f++) {
4753           PetscInt fDof;
4754 
4755           ierr        = PetscSectionGetFieldDof(cSec, b, f, &fDof);CHKERRQ(ierr);
4756           fStart[f+1] = fStart[f] + fDof;
4757           fEnd[f+1]   = fStart[f+1];
4758         }
4759         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
4760         ierr = DMPlexGetIndicesPointFields_Internal(cSec, b, bOff, fEnd, PETSC_TRUE, perms, p, indices);CHKERRQ(ierr);
4761 
4762         fAnchorStart[0] = 0;
4763         fAnchorEnd[0]   = 0;
4764         for (f = 0; f < numFields; f++) {
4765           PetscInt fDof = newPointOffsets[f][p + 1] - newPointOffsets[f][p];
4766 
4767           fAnchorStart[f+1] = fAnchorStart[f] + fDof;
4768           fAnchorEnd[f+1]   = fAnchorStart[f + 1];
4769         }
4770         ierr = PetscSectionGetOffset(aSec, b, &bOff);CHKERRQ(ierr);
4771         for (q = 0; q < bDof; q++) {
4772           PetscInt a = anchors[bOff + q], aOff;
4773 
4774           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
4775           newPoints[2*(newP + q)]     = a;
4776           newPoints[2*(newP + q) + 1] = 0;
4777           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
4778           ierr = DMPlexGetIndicesPointFields_Internal(section, a, aOff, fAnchorEnd, PETSC_TRUE, NULL, -1, newIndices);CHKERRQ(ierr);
4779         }
4780         newP += bDof;
4781 
4782         if (outValues) {
4783           /* get the point-to-point submatrix */
4784           for (f = 0; f < numFields; f++) {
4785             ierr = MatGetValues(cMat,fEnd[f]-fStart[f],indices + fStart[f],fAnchorEnd[f] - fAnchorStart[f],newIndices + fAnchorStart[f],pointMat[f] + pointMatOffsets[f][p]);CHKERRQ(ierr);
4786           }
4787         }
4788       }
4789       else {
4790         newPoints[2 * newP]     = b;
4791         newPoints[2 * newP + 1] = o;
4792         newP++;
4793       }
4794     }
4795   } else {
4796     for (p = 0; p < numPoints; p++) {
4797       PetscInt b    = points[2*p];
4798       PetscInt o    = points[2*p+1];
4799       PetscInt bDof = 0, bSecDof;
4800 
4801       ierr = PetscSectionGetDof(section, b, &bSecDof);CHKERRQ(ierr);
4802       if (!bSecDof) {
4803         continue;
4804       }
4805       if (b >= aStart && b < aEnd) {
4806         ierr = PetscSectionGetDof(aSec, b, &bDof);CHKERRQ(ierr);
4807       }
4808       if (bDof) {
4809         PetscInt bEnd = 0, bAnchorEnd = 0, bOff;
4810 
4811         ierr = PetscSectionGetOffset(cSec, b, &bOff);CHKERRQ(ierr);
4812         ierr = DMPlexGetIndicesPoint_Internal(cSec, b, bOff, &bEnd, PETSC_TRUE, (perms && perms[0]) ? perms[0][p] : NULL, indices);CHKERRQ(ierr);
4813 
4814         ierr = PetscSectionGetOffset (aSec, b, &bOff);CHKERRQ(ierr);
4815         for (q = 0; q < bDof; q++) {
4816           PetscInt a = anchors[bOff + q], aOff;
4817 
4818           /* we take the orientation of ap into account in the order that we constructed the indices above: the newly added points have no orientation */
4819 
4820           newPoints[2*(newP + q)]     = a;
4821           newPoints[2*(newP + q) + 1] = 0;
4822           ierr = PetscSectionGetOffset(section, a, &aOff);CHKERRQ(ierr);
4823           ierr = DMPlexGetIndicesPoint_Internal(section, a, aOff, &bAnchorEnd, PETSC_TRUE, NULL, newIndices);CHKERRQ(ierr);
4824         }
4825         newP += bDof;
4826 
4827         /* get the point-to-point submatrix */
4828         if (outValues) {
4829           ierr = MatGetValues(cMat,bEnd,indices,bAnchorEnd,newIndices,pointMat[0] + pointMatOffsets[0][p]);CHKERRQ(ierr);
4830         }
4831       }
4832       else {
4833         newPoints[2 * newP]     = b;
4834         newPoints[2 * newP + 1] = o;
4835         newP++;
4836       }
4837     }
4838   }
4839 
4840   if (outValues) {
4841     ierr = DMGetWorkArray(dm,newNumIndices*numIndices,PETSC_SCALAR,&tmpValues);CHKERRQ(ierr);
4842     ierr = PetscMemzero(tmpValues,newNumIndices*numIndices*sizeof(*tmpValues));CHKERRQ(ierr);
4843     /* multiply constraints on the right */
4844     if (numFields) {
4845       for (f = 0; f < numFields; f++) {
4846         PetscInt oldOff = offsets[f];
4847 
4848         for (p = 0; p < numPoints; p++) {
4849           PetscInt cStart = newPointOffsets[f][p];
4850           PetscInt b      = points[2 * p];
4851           PetscInt c, r, k;
4852           PetscInt dof;
4853 
4854           ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
4855           if (!dof) {
4856             continue;
4857           }
4858           if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
4859             PetscInt nCols         = newPointOffsets[f][p+1]-cStart;
4860             const PetscScalar *mat = pointMat[f] + pointMatOffsets[f][p];
4861 
4862             for (r = 0; r < numIndices; r++) {
4863               for (c = 0; c < nCols; c++) {
4864                 for (k = 0; k < dof; k++) {
4865                   tmpValues[r * newNumIndices + cStart + c] += values[r * numIndices + oldOff + k] * mat[k * nCols + c];
4866                 }
4867               }
4868             }
4869           }
4870           else {
4871             /* copy this column as is */
4872             for (r = 0; r < numIndices; r++) {
4873               for (c = 0; c < dof; c++) {
4874                 tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
4875               }
4876             }
4877           }
4878           oldOff += dof;
4879         }
4880       }
4881     }
4882     else {
4883       PetscInt oldOff = 0;
4884       for (p = 0; p < numPoints; p++) {
4885         PetscInt cStart = newPointOffsets[0][p];
4886         PetscInt b      = points[2 * p];
4887         PetscInt c, r, k;
4888         PetscInt dof;
4889 
4890         ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
4891         if (!dof) {
4892           continue;
4893         }
4894         if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
4895           PetscInt nCols         = newPointOffsets[0][p+1]-cStart;
4896           const PetscScalar *mat = pointMat[0] + pointMatOffsets[0][p];
4897 
4898           for (r = 0; r < numIndices; r++) {
4899             for (c = 0; c < nCols; c++) {
4900               for (k = 0; k < dof; k++) {
4901                 tmpValues[r * newNumIndices + cStart + c] += mat[k * nCols + c] * values[r * numIndices + oldOff + k];
4902               }
4903             }
4904           }
4905         }
4906         else {
4907           /* copy this column as is */
4908           for (r = 0; r < numIndices; r++) {
4909             for (c = 0; c < dof; c++) {
4910               tmpValues[r * newNumIndices + cStart + c] = values[r * numIndices + oldOff + c];
4911             }
4912           }
4913         }
4914         oldOff += dof;
4915       }
4916     }
4917 
4918     if (multiplyLeft) {
4919       ierr = DMGetWorkArray(dm,newNumIndices*newNumIndices,PETSC_SCALAR,&newValues);CHKERRQ(ierr);
4920       ierr = PetscMemzero(newValues,newNumIndices*newNumIndices*sizeof(*newValues));CHKERRQ(ierr);
4921       /* multiply constraints transpose on the left */
4922       if (numFields) {
4923         for (f = 0; f < numFields; f++) {
4924           PetscInt oldOff = offsets[f];
4925 
4926           for (p = 0; p < numPoints; p++) {
4927             PetscInt rStart = newPointOffsets[f][p];
4928             PetscInt b      = points[2 * p];
4929             PetscInt c, r, k;
4930             PetscInt dof;
4931 
4932             ierr = PetscSectionGetFieldDof(section,b,f,&dof);CHKERRQ(ierr);
4933             if (pointMatOffsets[f][p] < pointMatOffsets[f][p + 1]) {
4934               PetscInt nRows                        = newPointOffsets[f][p+1]-rStart;
4935               const PetscScalar *PETSC_RESTRICT mat = pointMat[f] + pointMatOffsets[f][p];
4936 
4937               for (r = 0; r < nRows; r++) {
4938                 for (c = 0; c < newNumIndices; c++) {
4939                   for (k = 0; k < dof; k++) {
4940                     newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
4941                   }
4942                 }
4943               }
4944             }
4945             else {
4946               /* copy this row as is */
4947               for (r = 0; r < dof; r++) {
4948                 for (c = 0; c < newNumIndices; c++) {
4949                   newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
4950                 }
4951               }
4952             }
4953             oldOff += dof;
4954           }
4955         }
4956       }
4957       else {
4958         PetscInt oldOff = 0;
4959 
4960         for (p = 0; p < numPoints; p++) {
4961           PetscInt rStart = newPointOffsets[0][p];
4962           PetscInt b      = points[2 * p];
4963           PetscInt c, r, k;
4964           PetscInt dof;
4965 
4966           ierr = PetscSectionGetDof(section,b,&dof);CHKERRQ(ierr);
4967           if (pointMatOffsets[0][p] < pointMatOffsets[0][p + 1]) {
4968             PetscInt nRows                        = newPointOffsets[0][p+1]-rStart;
4969             const PetscScalar *PETSC_RESTRICT mat = pointMat[0] + pointMatOffsets[0][p];
4970 
4971             for (r = 0; r < nRows; r++) {
4972               for (c = 0; c < newNumIndices; c++) {
4973                 for (k = 0; k < dof; k++) {
4974                   newValues[(rStart + r) * newNumIndices + c] += mat[k * nRows + r] * tmpValues[(oldOff + k) * newNumIndices + c];
4975                 }
4976               }
4977             }
4978           }
4979           else {
4980             /* copy this row as is */
4981             for (r = 0; r < dof; r++) {
4982               for (c = 0; c < newNumIndices; c++) {
4983                 newValues[(rStart + r) * newNumIndices + c] = tmpValues[(oldOff + r) * newNumIndices + c];
4984               }
4985             }
4986           }
4987           oldOff += dof;
4988         }
4989       }
4990 
4991       ierr = DMRestoreWorkArray(dm,newNumIndices*numIndices,PETSC_SCALAR,&tmpValues);CHKERRQ(ierr);
4992     }
4993     else {
4994       newValues = tmpValues;
4995     }
4996   }
4997 
4998   /* clean up */
4999   ierr = DMRestoreWorkArray(dm,maxDof,PETSC_INT,&indices);CHKERRQ(ierr);
5000   ierr = DMRestoreWorkArray(dm,maxAnchor*maxDof,PETSC_INT,&newIndices);CHKERRQ(ierr);
5001 
5002   if (numFields) {
5003     for (f = 0; f < numFields; f++) {
5004       ierr = DMRestoreWorkArray(dm,pointMatOffsets[f][numPoints],PETSC_SCALAR,&pointMat[f]);CHKERRQ(ierr);
5005       ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[f]);CHKERRQ(ierr);
5006       ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[f]);CHKERRQ(ierr);
5007     }
5008   }
5009   else {
5010     ierr = DMRestoreWorkArray(dm,pointMatOffsets[0][numPoints],PETSC_SCALAR,&pointMat[0]);CHKERRQ(ierr);
5011     ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&pointMatOffsets[0]);CHKERRQ(ierr);
5012     ierr = DMRestoreWorkArray(dm,numPoints+1,PETSC_INT,&newPointOffsets[0]);CHKERRQ(ierr);
5013   }
5014   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
5015 
5016   /* output */
5017   if (outPoints) {
5018     *outPoints = newPoints;
5019   }
5020   else {
5021     ierr = DMRestoreWorkArray(dm,2*newNumPoints,PETSC_INT,&newPoints);CHKERRQ(ierr);
5022   }
5023   if (outValues) {
5024     *outValues = newValues;
5025   }
5026   for (f = 0; f <= numFields; f++) {
5027     offsets[f] = newOffsets[f];
5028   }
5029   PetscFunctionReturn(0);
5030 }
5031 
5032 PetscErrorCode DMPlexGetClosureIndices(DM dm, PetscSection section, PetscSection globalSection, PetscInt point, PetscInt *numIndices, PetscInt **indices, PetscInt *outOffsets)
5033 {
5034   PetscSection    clSection;
5035   IS              clPoints;
5036   const PetscInt *clp;
5037   const PetscInt  **perms[32] = {NULL};
5038   PetscInt       *points = NULL, *pointsNew;
5039   PetscInt        numPoints, numPointsNew;
5040   PetscInt        offsets[32];
5041   PetscInt        Nf, Nind, NindNew, off, globalOff, f, p;
5042   PetscErrorCode  ierr;
5043 
5044   PetscFunctionBegin;
5045   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5046   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5047   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5048   if (numIndices) PetscValidPointer(numIndices, 4);
5049   PetscValidPointer(indices, 5);
5050   ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
5051   if (Nf > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", Nf);
5052   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5053   /* Get points in closure */
5054   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5055   /* Get number of indices and indices per field */
5056   for (p = 0, Nind = 0; p < numPoints*2; p += 2) {
5057     PetscInt dof, fdof;
5058 
5059     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5060     for (f = 0; f < Nf; ++f) {
5061       ierr = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5062       offsets[f+1] += fdof;
5063     }
5064     Nind += dof;
5065   }
5066   for (f = 1; f < Nf; ++f) offsets[f+1] += offsets[f];
5067   if (Nf && offsets[Nf] != Nind) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", offsets[Nf], Nind);
5068   if (!Nf) offsets[1] = Nind;
5069   /* Get dual space symmetries */
5070   for (f = 0; f < PetscMax(1,Nf); f++) {
5071     if (Nf) {ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5072     else    {ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5073   }
5074   /* Correct for hanging node constraints */
5075   {
5076     ierr = DMPlexAnchorsModifyMat(dm, section, numPoints, Nind, points, perms, NULL, &numPointsNew, &NindNew, &pointsNew, NULL, offsets, PETSC_TRUE);CHKERRQ(ierr);
5077     if (numPointsNew) {
5078       for (f = 0; f < PetscMax(1,Nf); f++) {
5079         if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5080         else    {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5081       }
5082       for (f = 0; f < PetscMax(1,Nf); f++) {
5083         if (Nf) {ierr = PetscSectionGetFieldPointSyms(section,f,numPointsNew,pointsNew,&perms[f],NULL);CHKERRQ(ierr);}
5084         else    {ierr = PetscSectionGetPointSyms(section,numPointsNew,pointsNew,&perms[f],NULL);CHKERRQ(ierr);}
5085       }
5086       ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5087       numPoints = numPointsNew;
5088       Nind      = NindNew;
5089       points    = pointsNew;
5090     }
5091   }
5092   /* Calculate indices */
5093   ierr = DMGetWorkArray(dm, Nind, PETSC_INT, indices);CHKERRQ(ierr);
5094   if (Nf) {
5095     if (outOffsets) {
5096       PetscInt f;
5097 
5098       for (f = 0; f <= Nf; f++) {
5099         outOffsets[f] = offsets[f];
5100       }
5101     }
5102     for (p = 0; p < numPoints; p++) {
5103       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5104       DMPlexGetIndicesPointFields_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, perms, p, *indices);
5105     }
5106   } else {
5107     for (p = 0, off = 0; p < numPoints; p++) {
5108       const PetscInt *perm = perms[0] ? perms[0][p] : NULL;
5109 
5110       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5111       DMPlexGetIndicesPoint_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, *indices);
5112     }
5113   }
5114   /* Cleanup points */
5115   for (f = 0; f < PetscMax(1,Nf); f++) {
5116     if (Nf) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5117     else    {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],NULL);CHKERRQ(ierr);}
5118   }
5119   if (numPointsNew) {
5120     ierr = DMRestoreWorkArray(dm, 2*numPointsNew, PETSC_INT, &pointsNew);CHKERRQ(ierr);
5121   } else {
5122     ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5123   }
5124   if (numIndices) *numIndices = Nind;
5125   PetscFunctionReturn(0);
5126 }
5127 
5128 PetscErrorCode DMPlexRestoreClosureIndices(DM dm, PetscSection section, PetscSection globalSection, PetscInt point, PetscInt *numIndices, PetscInt **indices,PetscInt *outOffsets)
5129 {
5130   PetscErrorCode ierr;
5131 
5132   PetscFunctionBegin;
5133   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5134   PetscValidPointer(indices, 5);
5135   ierr = DMRestoreWorkArray(dm, 0, PETSC_INT, indices);CHKERRQ(ierr);
5136   PetscFunctionReturn(0);
5137 }
5138 
5139 /*@C
5140   DMPlexMatSetClosure - Set an array of the values on the closure of 'point'
5141 
5142   Not collective
5143 
5144   Input Parameters:
5145 + dm - The DM
5146 . section - The section describing the layout in v, or NULL to use the default section
5147 . globalSection - The section describing the layout in v, or NULL to use the default global section
5148 . A - The matrix
5149 . point - The sieve point in the DM
5150 . values - The array of values
5151 - mode - The insert mode, where INSERT_ALL_VALUES and ADD_ALL_VALUES also overwrite boundary conditions
5152 
5153   Fortran Notes:
5154   This routine is only available in Fortran 90, and you must include petsc.h90 in your code.
5155 
5156   Level: intermediate
5157 
5158 .seealso DMPlexVecGetClosure(), DMPlexVecSetClosure()
5159 @*/
5160 PetscErrorCode DMPlexMatSetClosure(DM dm, PetscSection section, PetscSection globalSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5161 {
5162   DM_Plex            *mesh   = (DM_Plex*) dm->data;
5163   PetscSection        clSection;
5164   IS                  clPoints;
5165   PetscInt           *points = NULL, *newPoints;
5166   const PetscInt     *clp;
5167   PetscInt           *indices;
5168   PetscInt            offsets[32];
5169   const PetscInt    **perms[32] = {NULL};
5170   const PetscScalar **flips[32] = {NULL};
5171   PetscInt            numFields, numPoints, newNumPoints, numIndices, newNumIndices, dof, off, globalOff, p, f;
5172   PetscScalar        *valCopy = NULL;
5173   PetscScalar        *newValues;
5174   PetscErrorCode      ierr;
5175 
5176   PetscFunctionBegin;
5177   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5178   if (!section) {ierr = DMGetDefaultSection(dm, &section);CHKERRQ(ierr);}
5179   PetscValidHeaderSpecific(section, PETSC_SECTION_CLASSID, 2);
5180   if (!globalSection) {ierr = DMGetDefaultGlobalSection(dm, &globalSection);CHKERRQ(ierr);}
5181   PetscValidHeaderSpecific(globalSection, PETSC_SECTION_CLASSID, 3);
5182   PetscValidHeaderSpecific(A, MAT_CLASSID, 4);
5183   ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
5184   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5185   ierr = PetscMemzero(offsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5186   ierr = DMPlexGetCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5187   for (p = 0, numIndices = 0; p < numPoints*2; p += 2) {
5188     PetscInt fdof;
5189 
5190     ierr = PetscSectionGetDof(section, points[p], &dof);CHKERRQ(ierr);
5191     for (f = 0; f < numFields; ++f) {
5192       ierr          = PetscSectionGetFieldDof(section, points[p], f, &fdof);CHKERRQ(ierr);
5193       offsets[f+1] += fdof;
5194     }
5195     numIndices += dof;
5196   }
5197   for (f = 1; f < numFields; ++f) offsets[f+1] += offsets[f];
5198 
5199   if (numFields && offsets[numFields] != numIndices) SETERRQ2(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", offsets[numFields], numIndices);
5200   /* Get symmetries */
5201   for (f = 0; f < PetscMax(1,numFields); f++) {
5202     if (numFields) {ierr = PetscSectionGetFieldPointSyms(section,f,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5203     else           {ierr = PetscSectionGetPointSyms(section,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5204     if (values && flips[f]) { /* may need to apply sign changes to the element matrix */
5205       PetscInt foffset = offsets[f];
5206 
5207       for (p = 0; p < numPoints; p++) {
5208         PetscInt point          = points[2*p], fdof;
5209         const PetscScalar *flip = flips[f] ? flips[f][p] : NULL;
5210 
5211         if (!numFields) {
5212           ierr = PetscSectionGetDof(section,point,&fdof);CHKERRQ(ierr);
5213         } else {
5214           ierr = PetscSectionGetFieldDof(section,point,f,&fdof);CHKERRQ(ierr);
5215         }
5216         if (flip) {
5217           PetscInt i, j, k;
5218 
5219           if (!valCopy) {
5220             ierr = DMGetWorkArray(dm,numIndices*numIndices,PETSC_SCALAR,&valCopy);CHKERRQ(ierr);
5221             for (j = 0; j < numIndices * numIndices; j++) valCopy[j] = values[j];
5222             values = valCopy;
5223           }
5224           for (i = 0; i < fdof; i++) {
5225             PetscScalar fval = flip[i];
5226 
5227             for (k = 0; k < numIndices; k++) {
5228               valCopy[numIndices * (foffset + i) + k] *= fval;
5229               valCopy[numIndices * k + (foffset + i)] *= fval;
5230             }
5231           }
5232         }
5233         foffset += fdof;
5234       }
5235     }
5236   }
5237   ierr = DMPlexAnchorsModifyMat(dm,section,numPoints,numIndices,points,perms,values,&newNumPoints,&newNumIndices,&newPoints,&newValues,offsets,PETSC_TRUE);CHKERRQ(ierr);
5238   if (newNumPoints) {
5239     if (valCopy) {
5240       ierr = DMRestoreWorkArray(dm,numIndices*numIndices,PETSC_SCALAR,&valCopy);CHKERRQ(ierr);
5241     }
5242     for (f = 0; f < PetscMax(1,numFields); f++) {
5243       if (numFields) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5244       else           {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5245     }
5246     for (f = 0; f < PetscMax(1,numFields); f++) {
5247       if (numFields) {ierr = PetscSectionGetFieldPointSyms(section,f,newNumPoints,newPoints,&perms[f],&flips[f]);CHKERRQ(ierr);}
5248       else           {ierr = PetscSectionGetPointSyms(section,newNumPoints,newPoints,&perms[f],&flips[f]);CHKERRQ(ierr);}
5249     }
5250     ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5251     numPoints  = newNumPoints;
5252     numIndices = newNumIndices;
5253     points     = newPoints;
5254     values     = newValues;
5255   }
5256   ierr = DMGetWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5257   if (numFields) {
5258     for (p = 0; p < numPoints; p++) {
5259       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5260       DMPlexGetIndicesPointFields_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, offsets, PETSC_FALSE, perms, p, indices);
5261     }
5262   } else {
5263     for (p = 0, off = 0; p < numPoints; p++) {
5264       const PetscInt *perm = perms[0] ? perms[0][p] : NULL;
5265       ierr = PetscSectionGetOffset(globalSection, points[2*p], &globalOff);CHKERRQ(ierr);
5266       DMPlexGetIndicesPoint_Internal(section, points[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, indices);
5267     }
5268   }
5269   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr);}
5270   ierr = MatSetValues(A, numIndices, indices, numIndices, indices, values, mode);
5271   if (mesh->printFEM > 1) {
5272     PetscInt i;
5273     ierr = PetscPrintf(PETSC_COMM_SELF, "  Indices:");CHKERRQ(ierr);
5274     for (i = 0; i < numIndices; ++i) {ierr = PetscPrintf(PETSC_COMM_SELF, " %D", indices[i]);CHKERRQ(ierr);}
5275     ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
5276   }
5277   if (ierr) {
5278     PetscMPIInt    rank;
5279     PetscErrorCode ierr2;
5280 
5281     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5282     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5283     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numIndices, indices, 0, NULL, values);CHKERRQ(ierr2);
5284     ierr2 = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr2);
5285     CHKERRQ(ierr);
5286   }
5287   for (f = 0; f < PetscMax(1,numFields); f++) {
5288     if (numFields) {ierr = PetscSectionRestoreFieldPointSyms(section,f,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5289     else           {ierr = PetscSectionRestorePointSyms(section,numPoints,points,&perms[f],&flips[f]);CHKERRQ(ierr);}
5290   }
5291   if (newNumPoints) {
5292     ierr = DMRestoreWorkArray(dm,newNumIndices*newNumIndices,PETSC_SCALAR,&newValues);CHKERRQ(ierr);
5293     ierr = DMRestoreWorkArray(dm,2*newNumPoints,PETSC_INT,&newPoints);CHKERRQ(ierr);
5294   }
5295   else {
5296     if (valCopy) {
5297       ierr = DMRestoreWorkArray(dm,numIndices*numIndices,PETSC_SCALAR,&valCopy);CHKERRQ(ierr);
5298     }
5299     ierr = DMPlexRestoreCompressedClosure(dm,section,point,&numPoints,&points,&clSection,&clPoints,&clp);CHKERRQ(ierr);
5300   }
5301   ierr = DMRestoreWorkArray(dm, numIndices, PETSC_INT, &indices);CHKERRQ(ierr);
5302   PetscFunctionReturn(0);
5303 }
5304 
5305 PetscErrorCode DMPlexMatSetClosureRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, Mat A, PetscInt point, const PetscScalar values[], InsertMode mode)
5306 {
5307   DM_Plex        *mesh   = (DM_Plex*) dmf->data;
5308   PetscInt       *fpoints = NULL, *ftotpoints = NULL;
5309   PetscInt       *cpoints = NULL;
5310   PetscInt       *findices, *cindices;
5311   PetscInt        foffsets[32], coffsets[32];
5312   CellRefiner     cellRefiner;
5313   PetscInt        numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5314   PetscErrorCode  ierr;
5315 
5316   PetscFunctionBegin;
5317   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5318   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5319   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
5320   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5321   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
5322   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5323   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5324   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5325   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5326   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5327   PetscValidHeaderSpecific(A, MAT_CLASSID, 7);
5328   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5329   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5330   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5331   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5332   /* Column indices */
5333   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5334   maxFPoints = numCPoints;
5335   /* Compress out points not in the section */
5336   /*   TODO: Squeeze out points with 0 dof as well */
5337   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5338   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5339     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5340       cpoints[q*2]   = cpoints[p];
5341       cpoints[q*2+1] = cpoints[p+1];
5342       ++q;
5343     }
5344   }
5345   numCPoints = q;
5346   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5347     PetscInt fdof;
5348 
5349     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5350     if (!dof) continue;
5351     for (f = 0; f < numFields; ++f) {
5352       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5353       coffsets[f+1] += fdof;
5354     }
5355     numCIndices += dof;
5356   }
5357   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5358   /* Row indices */
5359   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5360   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5361   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
5362   for (r = 0, q = 0; r < numSubcells; ++r) {
5363     /* TODO Map from coarse to fine cells */
5364     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5365     /* Compress out points not in the section */
5366     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5367     for (p = 0; p < numFPoints*2; p += 2) {
5368       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5369         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5370         if (!dof) continue;
5371         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5372         if (s < q) continue;
5373         ftotpoints[q*2]   = fpoints[p];
5374         ftotpoints[q*2+1] = fpoints[p+1];
5375         ++q;
5376       }
5377     }
5378     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5379   }
5380   numFPoints = q;
5381   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5382     PetscInt fdof;
5383 
5384     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5385     if (!dof) continue;
5386     for (f = 0; f < numFields; ++f) {
5387       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5388       foffsets[f+1] += fdof;
5389     }
5390     numFIndices += dof;
5391   }
5392   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
5393 
5394   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
5395   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
5396   ierr = DMGetWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
5397   ierr = DMGetWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
5398   if (numFields) {
5399     const PetscInt **permsF[32] = {NULL};
5400     const PetscInt **permsC[32] = {NULL};
5401 
5402     for (f = 0; f < numFields; f++) {
5403       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5404       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5405     }
5406     for (p = 0; p < numFPoints; p++) {
5407       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5408       DMPlexGetIndicesPointFields_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, findices);
5409     }
5410     for (p = 0; p < numCPoints; p++) {
5411       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5412       DMPlexGetIndicesPointFields_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cindices);
5413     }
5414     for (f = 0; f < numFields; f++) {
5415       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5416       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5417     }
5418   } else {
5419     const PetscInt **permsF = NULL;
5420     const PetscInt **permsC = NULL;
5421 
5422     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5423     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5424     for (p = 0, off = 0; p < numFPoints; p++) {
5425       const PetscInt *perm = permsF ? permsF[p] : NULL;
5426 
5427       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5428       ierr = DMPlexGetIndicesPoint_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, findices);CHKERRQ(ierr);
5429     }
5430     for (p = 0, off = 0; p < numCPoints; p++) {
5431       const PetscInt *perm = permsC ? permsC[p] : NULL;
5432 
5433       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5434       ierr = DMPlexGetIndicesPoint_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cindices);CHKERRQ(ierr);
5435     }
5436     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5437     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5438   }
5439   if (mesh->printSetValues) {ierr = DMPlexPrintMatSetValues(PETSC_VIEWER_STDOUT_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr);}
5440   /* TODO: flips */
5441   ierr = MatSetValues(A, numFIndices, findices, numCIndices, cindices, values, mode);
5442   if (ierr) {
5443     PetscMPIInt    rank;
5444     PetscErrorCode ierr2;
5445 
5446     ierr2 = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &rank);CHKERRQ(ierr2);
5447     ierr2 = (*PetscErrorPrintf)("[%d]ERROR in DMPlexMatSetClosure\n", rank);CHKERRQ(ierr2);
5448     ierr2 = DMPlexPrintMatSetValues(PETSC_VIEWER_STDERR_SELF, A, point, numFIndices, findices, numCIndices, cindices, values);CHKERRQ(ierr2);
5449     ierr2 = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr2);
5450     ierr2 = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr2);
5451     CHKERRQ(ierr);
5452   }
5453   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
5454   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5455   ierr = DMRestoreWorkArray(dmf, numFIndices, PETSC_INT, &findices);CHKERRQ(ierr);
5456   ierr = DMRestoreWorkArray(dmc, numCIndices, PETSC_INT, &cindices);CHKERRQ(ierr);
5457   PetscFunctionReturn(0);
5458 }
5459 
5460 PetscErrorCode DMPlexMatGetClosureIndicesRefined(DM dmf, PetscSection fsection, PetscSection globalFSection, DM dmc, PetscSection csection, PetscSection globalCSection, PetscInt point, PetscInt cindices[], PetscInt findices[])
5461 {
5462   PetscInt      *fpoints = NULL, *ftotpoints = NULL;
5463   PetscInt      *cpoints = NULL;
5464   PetscInt       foffsets[32], coffsets[32];
5465   CellRefiner    cellRefiner;
5466   PetscInt       numFields, numSubcells, maxFPoints, numFPoints, numCPoints, numFIndices, numCIndices, dof, off, globalOff, pStart, pEnd, p, q, r, s, f;
5467   PetscErrorCode ierr;
5468 
5469   PetscFunctionBegin;
5470   PetscValidHeaderSpecific(dmf, DM_CLASSID, 1);
5471   PetscValidHeaderSpecific(dmc, DM_CLASSID, 4);
5472   if (!fsection) {ierr = DMGetDefaultSection(dmf, &fsection);CHKERRQ(ierr);}
5473   PetscValidHeaderSpecific(fsection, PETSC_SECTION_CLASSID, 2);
5474   if (!csection) {ierr = DMGetDefaultSection(dmc, &csection);CHKERRQ(ierr);}
5475   PetscValidHeaderSpecific(csection, PETSC_SECTION_CLASSID, 5);
5476   if (!globalFSection) {ierr = DMGetDefaultGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);}
5477   PetscValidHeaderSpecific(globalFSection, PETSC_SECTION_CLASSID, 3);
5478   if (!globalCSection) {ierr = DMGetDefaultGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);}
5479   PetscValidHeaderSpecific(globalCSection, PETSC_SECTION_CLASSID, 6);
5480   ierr = PetscSectionGetNumFields(fsection, &numFields);CHKERRQ(ierr);
5481   if (numFields > 31) SETERRQ1(PetscObjectComm((PetscObject)dmf), PETSC_ERR_ARG_OUTOFRANGE, "Number of fields %D limited to 31", numFields);
5482   ierr = PetscMemzero(foffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5483   ierr = PetscMemzero(coffsets, 32 * sizeof(PetscInt));CHKERRQ(ierr);
5484   /* Column indices */
5485   ierr = DMPlexGetTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5486   maxFPoints = numCPoints;
5487   /* Compress out points not in the section */
5488   /*   TODO: Squeeze out points with 0 dof as well */
5489   ierr = PetscSectionGetChart(csection, &pStart, &pEnd);CHKERRQ(ierr);
5490   for (p = 0, q = 0; p < numCPoints*2; p += 2) {
5491     if ((cpoints[p] >= pStart) && (cpoints[p] < pEnd)) {
5492       cpoints[q*2]   = cpoints[p];
5493       cpoints[q*2+1] = cpoints[p+1];
5494       ++q;
5495     }
5496   }
5497   numCPoints = q;
5498   for (p = 0, numCIndices = 0; p < numCPoints*2; p += 2) {
5499     PetscInt fdof;
5500 
5501     ierr = PetscSectionGetDof(csection, cpoints[p], &dof);CHKERRQ(ierr);
5502     if (!dof) continue;
5503     for (f = 0; f < numFields; ++f) {
5504       ierr           = PetscSectionGetFieldDof(csection, cpoints[p], f, &fdof);CHKERRQ(ierr);
5505       coffsets[f+1] += fdof;
5506     }
5507     numCIndices += dof;
5508   }
5509   for (f = 1; f < numFields; ++f) coffsets[f+1] += coffsets[f];
5510   /* Row indices */
5511   ierr = DMPlexGetCellRefiner_Internal(dmc, &cellRefiner);CHKERRQ(ierr);
5512   ierr = CellRefinerGetAffineTransforms_Internal(cellRefiner, &numSubcells, NULL, NULL, NULL);CHKERRQ(ierr);
5513   ierr = DMGetWorkArray(dmf, maxFPoints*2*numSubcells, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
5514   for (r = 0, q = 0; r < numSubcells; ++r) {
5515     /* TODO Map from coarse to fine cells */
5516     ierr = DMPlexGetTransitiveClosure(dmf, point*numSubcells + r, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5517     /* Compress out points not in the section */
5518     ierr = PetscSectionGetChart(fsection, &pStart, &pEnd);CHKERRQ(ierr);
5519     for (p = 0; p < numFPoints*2; p += 2) {
5520       if ((fpoints[p] >= pStart) && (fpoints[p] < pEnd)) {
5521         ierr = PetscSectionGetDof(fsection, fpoints[p], &dof);CHKERRQ(ierr);
5522         if (!dof) continue;
5523         for (s = 0; s < q; ++s) if (fpoints[p] == ftotpoints[s*2]) break;
5524         if (s < q) continue;
5525         ftotpoints[q*2]   = fpoints[p];
5526         ftotpoints[q*2+1] = fpoints[p+1];
5527         ++q;
5528       }
5529     }
5530     ierr = DMPlexRestoreTransitiveClosure(dmf, point, PETSC_TRUE, &numFPoints, &fpoints);CHKERRQ(ierr);
5531   }
5532   numFPoints = q;
5533   for (p = 0, numFIndices = 0; p < numFPoints*2; p += 2) {
5534     PetscInt fdof;
5535 
5536     ierr = PetscSectionGetDof(fsection, ftotpoints[p], &dof);CHKERRQ(ierr);
5537     if (!dof) continue;
5538     for (f = 0; f < numFields; ++f) {
5539       ierr           = PetscSectionGetFieldDof(fsection, ftotpoints[p], f, &fdof);CHKERRQ(ierr);
5540       foffsets[f+1] += fdof;
5541     }
5542     numFIndices += dof;
5543   }
5544   for (f = 1; f < numFields; ++f) foffsets[f+1] += foffsets[f];
5545 
5546   if (numFields && foffsets[numFields] != numFIndices) SETERRQ2(PetscObjectComm((PetscObject)dmf), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", foffsets[numFields], numFIndices);
5547   if (numFields && coffsets[numFields] != numCIndices) SETERRQ2(PetscObjectComm((PetscObject)dmc), PETSC_ERR_PLIB, "Invalid size for closure %D should be %D", coffsets[numFields], numCIndices);
5548   if (numFields) {
5549     const PetscInt **permsF[32] = {NULL};
5550     const PetscInt **permsC[32] = {NULL};
5551 
5552     for (f = 0; f < numFields; f++) {
5553       ierr = PetscSectionGetFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5554       ierr = PetscSectionGetFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5555     }
5556     for (p = 0; p < numFPoints; p++) {
5557       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5558       DMPlexGetIndicesPointFields_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, foffsets, PETSC_FALSE, permsF, p, findices);
5559     }
5560     for (p = 0; p < numCPoints; p++) {
5561       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5562       DMPlexGetIndicesPointFields_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, coffsets, PETSC_FALSE, permsC, p, cindices);
5563     }
5564     for (f = 0; f < numFields; f++) {
5565       ierr = PetscSectionRestoreFieldPointSyms(fsection,f,numFPoints,ftotpoints,&permsF[f],NULL);CHKERRQ(ierr);
5566       ierr = PetscSectionRestoreFieldPointSyms(csection,f,numCPoints,cpoints,&permsC[f],NULL);CHKERRQ(ierr);
5567     }
5568   } else {
5569     const PetscInt **permsF = NULL;
5570     const PetscInt **permsC = NULL;
5571 
5572     ierr = PetscSectionGetPointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5573     ierr = PetscSectionGetPointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5574     for (p = 0, off = 0; p < numFPoints; p++) {
5575       const PetscInt *perm = permsF ? permsF[p] : NULL;
5576 
5577       ierr = PetscSectionGetOffset(globalFSection, ftotpoints[2*p], &globalOff);CHKERRQ(ierr);
5578       DMPlexGetIndicesPoint_Internal(fsection, ftotpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, findices);
5579     }
5580     for (p = 0, off = 0; p < numCPoints; p++) {
5581       const PetscInt *perm = permsC ? permsC[p] : NULL;
5582 
5583       ierr = PetscSectionGetOffset(globalCSection, cpoints[2*p], &globalOff);CHKERRQ(ierr);
5584       DMPlexGetIndicesPoint_Internal(csection, cpoints[2*p], globalOff < 0 ? -(globalOff+1) : globalOff, &off, PETSC_FALSE, perm, cindices);
5585     }
5586     ierr = PetscSectionRestorePointSyms(fsection,numFPoints,ftotpoints,&permsF,NULL);CHKERRQ(ierr);
5587     ierr = PetscSectionRestorePointSyms(csection,numCPoints,cpoints,&permsC,NULL);CHKERRQ(ierr);
5588   }
5589   ierr = DMRestoreWorkArray(dmf, numCPoints*2*4, PETSC_INT, &ftotpoints);CHKERRQ(ierr);
5590   ierr = DMPlexRestoreTransitiveClosure(dmc, point, PETSC_TRUE, &numCPoints, &cpoints);CHKERRQ(ierr);
5591   PetscFunctionReturn(0);
5592 }
5593 
5594 /*@
5595   DMPlexGetHybridBounds - Get the first mesh point of each dimension which is a hybrid
5596 
5597   Input Parameter:
5598 . dm - The DMPlex object
5599 
5600   Output Parameters:
5601 + cMax - The first hybrid cell
5602 . fMax - The first hybrid face
5603 . eMax - The first hybrid edge
5604 - vMax - The first hybrid vertex
5605 
5606   Level: developer
5607 
5608 .seealso DMPlexCreateHybridMesh(), DMPlexSetHybridBounds()
5609 @*/
5610 PetscErrorCode DMPlexGetHybridBounds(DM dm, PetscInt *cMax, PetscInt *fMax, PetscInt *eMax, PetscInt *vMax)
5611 {
5612   DM_Plex       *mesh = (DM_Plex*) dm->data;
5613   PetscInt       dim;
5614   PetscErrorCode ierr;
5615 
5616   PetscFunctionBegin;
5617   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5618   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5619   if (cMax) *cMax = mesh->hybridPointMax[dim];
5620   if (fMax) *fMax = mesh->hybridPointMax[dim-1];
5621   if (eMax) *eMax = mesh->hybridPointMax[1];
5622   if (vMax) *vMax = mesh->hybridPointMax[0];
5623   PetscFunctionReturn(0);
5624 }
5625 
5626 /*@
5627   DMPlexSetHybridBounds - Set the first mesh point of each dimension which is a hybrid
5628 
5629   Input Parameters:
5630 . dm   - The DMPlex object
5631 . cMax - The first hybrid cell
5632 . fMax - The first hybrid face
5633 . eMax - The first hybrid edge
5634 - vMax - The first hybrid vertex
5635 
5636   Level: developer
5637 
5638 .seealso DMPlexCreateHybridMesh(), DMPlexGetHybridBounds()
5639 @*/
5640 PetscErrorCode DMPlexSetHybridBounds(DM dm, PetscInt cMax, PetscInt fMax, PetscInt eMax, PetscInt vMax)
5641 {
5642   DM_Plex       *mesh = (DM_Plex*) dm->data;
5643   PetscInt       dim;
5644   PetscErrorCode ierr;
5645 
5646   PetscFunctionBegin;
5647   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5648   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5649   if (cMax >= 0) mesh->hybridPointMax[dim]   = cMax;
5650   if (fMax >= 0) mesh->hybridPointMax[dim-1] = fMax;
5651   if (eMax >= 0) mesh->hybridPointMax[1]     = eMax;
5652   if (vMax >= 0) mesh->hybridPointMax[0]     = vMax;
5653   PetscFunctionReturn(0);
5654 }
5655 
5656 PetscErrorCode DMPlexGetVTKCellHeight(DM dm, PetscInt *cellHeight)
5657 {
5658   DM_Plex *mesh = (DM_Plex*) dm->data;
5659 
5660   PetscFunctionBegin;
5661   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5662   PetscValidPointer(cellHeight, 2);
5663   *cellHeight = mesh->vtkCellHeight;
5664   PetscFunctionReturn(0);
5665 }
5666 
5667 PetscErrorCode DMPlexSetVTKCellHeight(DM dm, PetscInt cellHeight)
5668 {
5669   DM_Plex *mesh = (DM_Plex*) dm->data;
5670 
5671   PetscFunctionBegin;
5672   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5673   mesh->vtkCellHeight = cellHeight;
5674   PetscFunctionReturn(0);
5675 }
5676 
5677 /* We can easily have a form that takes an IS instead */
5678 static PetscErrorCode DMPlexCreateNumbering_Private(DM dm, PetscInt pStart, PetscInt pEnd, PetscInt shift, PetscInt *globalSize, PetscSF sf, IS *numbering)
5679 {
5680   PetscSection   section, globalSection;
5681   PetscInt      *numbers, p;
5682   PetscErrorCode ierr;
5683 
5684   PetscFunctionBegin;
5685   ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dm), &section);CHKERRQ(ierr);
5686   ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
5687   for (p = pStart; p < pEnd; ++p) {
5688     ierr = PetscSectionSetDof(section, p, 1);CHKERRQ(ierr);
5689   }
5690   ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
5691   ierr = PetscSectionCreateGlobalSection(section, sf, PETSC_FALSE, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
5692   ierr = PetscMalloc1(pEnd - pStart, &numbers);CHKERRQ(ierr);
5693   for (p = pStart; p < pEnd; ++p) {
5694     ierr = PetscSectionGetOffset(globalSection, p, &numbers[p-pStart]);CHKERRQ(ierr);
5695     if (numbers[p-pStart] < 0) numbers[p-pStart] -= shift;
5696     else                       numbers[p-pStart] += shift;
5697   }
5698   ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), pEnd - pStart, numbers, PETSC_OWN_POINTER, numbering);CHKERRQ(ierr);
5699   if (globalSize) {
5700     PetscLayout layout;
5701     ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject) dm), globalSection, &layout);CHKERRQ(ierr);
5702     ierr = PetscLayoutGetSize(layout, globalSize);CHKERRQ(ierr);
5703     ierr = PetscLayoutDestroy(&layout);CHKERRQ(ierr);
5704   }
5705   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
5706   ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
5707   PetscFunctionReturn(0);
5708 }
5709 
5710 PetscErrorCode DMPlexCreateCellNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalCellNumbers)
5711 {
5712   PetscInt       cellHeight, cStart, cEnd, cMax;
5713   PetscErrorCode ierr;
5714 
5715   PetscFunctionBegin;
5716   ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
5717   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
5718   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
5719   if (cMax >= 0 && !includeHybrid) cEnd = PetscMin(cEnd, cMax);
5720   ierr = DMPlexCreateNumbering_Private(dm, cStart, cEnd, 0, NULL, dm->sf, globalCellNumbers);CHKERRQ(ierr);
5721   PetscFunctionReturn(0);
5722 }
5723 
5724 PetscErrorCode DMPlexGetCellNumbering(DM dm, IS *globalCellNumbers)
5725 {
5726   DM_Plex       *mesh = (DM_Plex*) dm->data;
5727   PetscErrorCode ierr;
5728 
5729   PetscFunctionBegin;
5730   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5731   if (!mesh->globalCellNumbers) {ierr = DMPlexCreateCellNumbering_Internal(dm, PETSC_FALSE, &mesh->globalCellNumbers);CHKERRQ(ierr);}
5732   *globalCellNumbers = mesh->globalCellNumbers;
5733   PetscFunctionReturn(0);
5734 }
5735 
5736 PetscErrorCode DMPlexCreateVertexNumbering_Internal(DM dm, PetscBool includeHybrid, IS *globalVertexNumbers)
5737 {
5738   PetscInt       vStart, vEnd, vMax;
5739   PetscErrorCode ierr;
5740 
5741   PetscFunctionBegin;
5742   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5743   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5744   ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
5745   if (vMax >= 0 && !includeHybrid) vEnd = PetscMin(vEnd, vMax);
5746   ierr = DMPlexCreateNumbering_Private(dm, vStart, vEnd, 0, NULL, dm->sf, globalVertexNumbers);CHKERRQ(ierr);
5747   PetscFunctionReturn(0);
5748 }
5749 
5750 PetscErrorCode DMPlexGetVertexNumbering(DM dm, IS *globalVertexNumbers)
5751 {
5752   DM_Plex       *mesh = (DM_Plex*) dm->data;
5753   PetscErrorCode ierr;
5754 
5755   PetscFunctionBegin;
5756   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5757   if (!mesh->globalVertexNumbers) {ierr = DMPlexCreateVertexNumbering_Internal(dm, PETSC_FALSE, &mesh->globalVertexNumbers);CHKERRQ(ierr);}
5758   *globalVertexNumbers = mesh->globalVertexNumbers;
5759   PetscFunctionReturn(0);
5760 }
5761 
5762 PetscErrorCode DMPlexCreatePointNumbering(DM dm, IS *globalPointNumbers)
5763 {
5764   IS             nums[4];
5765   PetscInt       depths[4];
5766   PetscInt       depth, d, shift = 0;
5767   PetscErrorCode ierr;
5768 
5769   PetscFunctionBegin;
5770   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5771   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
5772   /* For unstratified meshes use dim instead of depth */
5773   if (depth < 0) {ierr = DMGetDimension(dm, &depth);CHKERRQ(ierr);}
5774   depths[0] = depth; depths[1] = 0;
5775   for (d = 2; d <= depth; ++d) depths[d] = depth-d+1;
5776   for (d = 0; d <= depth; ++d) {
5777     PetscInt pStart, pEnd, gsize;
5778 
5779     ierr = DMPlexGetDepthStratum(dm, depths[d], &pStart, &pEnd);CHKERRQ(ierr);
5780     ierr = DMPlexCreateNumbering_Private(dm, pStart, pEnd, shift, &gsize, dm->sf, &nums[d]);CHKERRQ(ierr);
5781     shift += gsize;
5782   }
5783   ierr = ISConcatenate(PetscObjectComm((PetscObject) dm), depth+1, nums, globalPointNumbers);CHKERRQ(ierr);
5784   for (d = 0; d <= depth; ++d) {ierr = ISDestroy(&nums[d]);CHKERRQ(ierr);}
5785   PetscFunctionReturn(0);
5786 }
5787 
5788 /*@
5789   DMPlexCheckSymmetry - Check that the adjacency information in the mesh is symmetric.
5790 
5791   Input Parameters:
5792   + dm - The DMPlex object
5793 
5794   Note: This is a useful diagnostic when creating meshes programmatically.
5795 
5796   Level: developer
5797 
5798 .seealso: DMCreate(), DMCheckSkeleton(), DMCheckFaces()
5799 @*/
5800 PetscErrorCode DMPlexCheckSymmetry(DM dm)
5801 {
5802   PetscSection    coneSection, supportSection;
5803   const PetscInt *cone, *support;
5804   PetscInt        coneSize, c, supportSize, s;
5805   PetscInt        pStart, pEnd, p, csize, ssize;
5806   PetscErrorCode  ierr;
5807 
5808   PetscFunctionBegin;
5809   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5810   ierr = DMPlexGetConeSection(dm, &coneSection);CHKERRQ(ierr);
5811   ierr = DMPlexGetSupportSection(dm, &supportSection);CHKERRQ(ierr);
5812   /* Check that point p is found in the support of its cone points, and vice versa */
5813   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
5814   for (p = pStart; p < pEnd; ++p) {
5815     ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
5816     ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
5817     for (c = 0; c < coneSize; ++c) {
5818       PetscBool dup = PETSC_FALSE;
5819       PetscInt  d;
5820       for (d = c-1; d >= 0; --d) {
5821         if (cone[c] == cone[d]) {dup = PETSC_TRUE; break;}
5822       }
5823       ierr = DMPlexGetSupportSize(dm, cone[c], &supportSize);CHKERRQ(ierr);
5824       ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr);
5825       for (s = 0; s < supportSize; ++s) {
5826         if (support[s] == p) break;
5827       }
5828       if ((s >= supportSize) || (dup && (support[s+1] != p))) {
5829         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", p);CHKERRQ(ierr);
5830         for (s = 0; s < coneSize; ++s) {
5831           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[s]);CHKERRQ(ierr);
5832         }
5833         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
5834         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", cone[c]);CHKERRQ(ierr);
5835         for (s = 0; s < supportSize; ++s) {
5836           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[s]);CHKERRQ(ierr);
5837         }
5838         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
5839         if (dup) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not repeatedly found in support of repeated cone point %D", p, cone[c]);
5840         else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in support of cone point %D", p, cone[c]);
5841       }
5842     }
5843     ierr = DMPlexGetSupportSize(dm, p, &supportSize);CHKERRQ(ierr);
5844     ierr = DMPlexGetSupport(dm, p, &support);CHKERRQ(ierr);
5845     for (s = 0; s < supportSize; ++s) {
5846       ierr = DMPlexGetConeSize(dm, support[s], &coneSize);CHKERRQ(ierr);
5847       ierr = DMPlexGetCone(dm, support[s], &cone);CHKERRQ(ierr);
5848       for (c = 0; c < coneSize; ++c) {
5849         if (cone[c] == p) break;
5850       }
5851       if (c >= coneSize) {
5852         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D support: ", p);CHKERRQ(ierr);
5853         for (c = 0; c < supportSize; ++c) {
5854           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", support[c]);CHKERRQ(ierr);
5855         }
5856         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
5857         ierr = PetscPrintf(PETSC_COMM_SELF, "p: %D cone: ", support[s]);CHKERRQ(ierr);
5858         for (c = 0; c < coneSize; ++c) {
5859           ierr = PetscPrintf(PETSC_COMM_SELF, "%D, ", cone[c]);CHKERRQ(ierr);
5860         }
5861         ierr = PetscPrintf(PETSC_COMM_SELF, "\n");CHKERRQ(ierr);
5862         SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Point %D not found in cone of support point %D", p, support[s]);
5863       }
5864     }
5865   }
5866   ierr = PetscSectionGetStorageSize(coneSection, &csize);CHKERRQ(ierr);
5867   ierr = PetscSectionGetStorageSize(supportSection, &ssize);CHKERRQ(ierr);
5868   if (csize != ssize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Total cone size %D != Total support size %D", csize, ssize);
5869   PetscFunctionReturn(0);
5870 }
5871 
5872 /*@
5873   DMPlexCheckSkeleton - Check that each cell has the correct number of vertices
5874 
5875   Input Parameters:
5876 + dm - The DMPlex object
5877 . isSimplex - Are the cells simplices or tensor products
5878 - cellHeight - Normally 0
5879 
5880   Note: This is a useful diagnostic when creating meshes programmatically.
5881 
5882   Level: developer
5883 
5884 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckFaces()
5885 @*/
5886 PetscErrorCode DMPlexCheckSkeleton(DM dm, PetscBool isSimplex, PetscInt cellHeight)
5887 {
5888   PetscInt       dim, numCorners, numHybridCorners, vStart, vEnd, cStart, cEnd, cMax, c;
5889   PetscErrorCode ierr;
5890 
5891   PetscFunctionBegin;
5892   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5893   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5894   switch (dim) {
5895   case 1: numCorners = isSimplex ? 2 : 2; numHybridCorners = isSimplex ? 2 : 2; break;
5896   case 2: numCorners = isSimplex ? 3 : 4; numHybridCorners = isSimplex ? 4 : 4; break;
5897   case 3: numCorners = isSimplex ? 4 : 8; numHybridCorners = isSimplex ? 6 : 8; break;
5898   default:
5899     SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Cannot handle meshes of dimension %D", dim);
5900   }
5901   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5902   ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
5903   ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
5904   cMax = cMax >= 0 ? cMax : cEnd;
5905   for (c = cStart; c < cMax; ++c) {
5906     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
5907 
5908     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5909     for (cl = 0; cl < closureSize*2; cl += 2) {
5910       const PetscInt p = closure[cl];
5911       if ((p >= vStart) && (p < vEnd)) ++coneSize;
5912     }
5913     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5914     if (coneSize != numCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has  %D vertices != %D", c, coneSize, numCorners);
5915   }
5916   for (c = cMax; c < cEnd; ++c) {
5917     PetscInt *closure = NULL, closureSize, cl, coneSize = 0;
5918 
5919     ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5920     for (cl = 0; cl < closureSize*2; cl += 2) {
5921       const PetscInt p = closure[cl];
5922       if ((p >= vStart) && (p < vEnd)) ++coneSize;
5923     }
5924     ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5925     if (coneSize > numHybridCorners) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Hybrid cell %D has  %D vertices > %D", c, coneSize, numHybridCorners);
5926   }
5927   PetscFunctionReturn(0);
5928 }
5929 
5930 /*@
5931   DMPlexCheckFaces - Check that the faces of each cell give a vertex order this is consistent with what we expect from the cell type
5932 
5933   Input Parameters:
5934 + dm - The DMPlex object
5935 . isSimplex - Are the cells simplices or tensor products
5936 - cellHeight - Normally 0
5937 
5938   Note: This is a useful diagnostic when creating meshes programmatically.
5939 
5940   Level: developer
5941 
5942 .seealso: DMCreate(), DMCheckSymmetry(), DMCheckSkeleton()
5943 @*/
5944 PetscErrorCode DMPlexCheckFaces(DM dm, PetscBool isSimplex, PetscInt cellHeight)
5945 {
5946   PetscInt       pMax[4];
5947   PetscInt       dim, vStart, vEnd, cStart, cEnd, c, h;
5948   PetscErrorCode ierr;
5949 
5950   PetscFunctionBegin;
5951   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
5952   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5953   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
5954   ierr = DMPlexGetHybridBounds(dm, &pMax[dim], &pMax[dim-1], &pMax[1], &pMax[0]);CHKERRQ(ierr);
5955   for (h = cellHeight; h < dim; ++h) {
5956     ierr = DMPlexGetHeightStratum(dm, h, &cStart, &cEnd);CHKERRQ(ierr);
5957     for (c = cStart; c < cEnd; ++c) {
5958       const PetscInt *cone, *ornt, *faces;
5959       PetscInt        numFaces, faceSize, coneSize,f;
5960       PetscInt       *closure = NULL, closureSize, cl, numCorners = 0;
5961 
5962       if (pMax[dim-h] >= 0 && c >= pMax[dim-h]) continue;
5963       ierr = DMPlexGetConeSize(dm, c, &coneSize);CHKERRQ(ierr);
5964       ierr = DMPlexGetCone(dm, c, &cone);CHKERRQ(ierr);
5965       ierr = DMPlexGetConeOrientation(dm, c, &ornt);CHKERRQ(ierr);
5966       ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5967       for (cl = 0; cl < closureSize*2; cl += 2) {
5968         const PetscInt p = closure[cl];
5969         if ((p >= vStart) && (p < vEnd)) closure[numCorners++] = p;
5970       }
5971       ierr = DMPlexGetRawFaces_Internal(dm, dim-h, numCorners, closure, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
5972       if (coneSize != numFaces) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cell %D has %D faces but should have %D", c, coneSize, numFaces);
5973       for (f = 0; f < numFaces; ++f) {
5974         PetscInt *fclosure = NULL, fclosureSize, cl, fnumCorners = 0, v;
5975 
5976         ierr = DMPlexGetTransitiveClosure_Internal(dm, cone[f], ornt[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
5977         for (cl = 0; cl < fclosureSize*2; cl += 2) {
5978           const PetscInt p = fclosure[cl];
5979           if ((p >= vStart) && (p < vEnd)) fclosure[fnumCorners++] = p;
5980         }
5981         if (fnumCorners != faceSize) SETERRQ5(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D (%D) of cell %D has %D vertices but should have %D", cone[f], f, c, fnumCorners, faceSize);
5982         for (v = 0; v < fnumCorners; ++v) {
5983           if (fclosure[v] != faces[f*faceSize+v]) SETERRQ6(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D (%d) of cell %D vertex %D, %D != %D", cone[f], f, c, v, fclosure[v], faces[f*faceSize+v]);
5984         }
5985         ierr = DMPlexRestoreTransitiveClosure(dm, cone[f], PETSC_TRUE, &fclosureSize, &fclosure);CHKERRQ(ierr);
5986       }
5987       ierr = DMPlexRestoreFaces_Internal(dm, dim, c, &numFaces, &faceSize, &faces);CHKERRQ(ierr);
5988       ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
5989     }
5990   }
5991   PetscFunctionReturn(0);
5992 }
5993 
5994 /* Pointwise interpolation
5995      Just code FEM for now
5996      u^f = I u^c
5997      sum_k u^f_k phi^f_k = I sum_j u^c_j phi^c_j
5998      u^f_i = sum_j psi^f_i I phi^c_j u^c_j
5999      I_{ij} = psi^f_i phi^c_j
6000 */
6001 PetscErrorCode DMCreateInterpolation_Plex(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
6002 {
6003   PetscSection   gsc, gsf;
6004   PetscInt       m, n;
6005   void          *ctx;
6006   DM             cdm;
6007   PetscBool      regular;
6008   PetscErrorCode ierr;
6009 
6010   PetscFunctionBegin;
6011   ierr = DMGetDefaultGlobalSection(dmFine, &gsf);CHKERRQ(ierr);
6012   ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr);
6013   ierr = DMGetDefaultGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr);
6014   ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr);
6015 
6016   ierr = MatCreate(PetscObjectComm((PetscObject) dmCoarse), interpolation);CHKERRQ(ierr);
6017   ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
6018   ierr = MatSetType(*interpolation, dmCoarse->mattype);CHKERRQ(ierr);
6019   ierr = DMGetApplicationContext(dmFine, &ctx);CHKERRQ(ierr);
6020 
6021   ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr);
6022   ierr = DMPlexGetRegularRefinement(dmFine, &regular);CHKERRQ(ierr);
6023   if (regular && cdm == dmCoarse) {ierr = DMPlexComputeInterpolatorNested(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);}
6024   else                            {ierr = DMPlexComputeInterpolatorGeneral(dmCoarse, dmFine, *interpolation, ctx);CHKERRQ(ierr);}
6025   ierr = MatViewFromOptions(*interpolation, NULL, "-interp_mat_view");CHKERRQ(ierr);
6026   /* Use naive scaling */
6027   ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr);
6028   PetscFunctionReturn(0);
6029 }
6030 
6031 PetscErrorCode DMCreateInjection_Plex(DM dmCoarse, DM dmFine, Mat *mat)
6032 {
6033   PetscErrorCode ierr;
6034   VecScatter     ctx;
6035 
6036   PetscFunctionBegin;
6037   ierr = DMPlexComputeInjectorFEM(dmCoarse, dmFine, &ctx, NULL);CHKERRQ(ierr);
6038   ierr = MatCreateScatter(PetscObjectComm((PetscObject)ctx), ctx, mat);CHKERRQ(ierr);
6039   ierr = VecScatterDestroy(&ctx);CHKERRQ(ierr);
6040   PetscFunctionReturn(0);
6041 }
6042 
6043 PetscErrorCode DMCreateDefaultSection_Plex(DM dm)
6044 {
6045   PetscSection   section;
6046   IS            *bcPoints, *bcComps;
6047   PetscBool     *isFE;
6048   PetscInt      *bcFields, *numComp, *numDof;
6049   PetscInt       depth, dim, numBd, numBC = 0, numFields, bd, bc = 0, f;
6050   PetscInt       cStart, cEnd, cEndInterior;
6051   PetscErrorCode ierr;
6052 
6053   PetscFunctionBegin;
6054   ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
6055   if (!numFields) PetscFunctionReturn(0);
6056   /* FE and FV boundary conditions are handled slightly differently */
6057   ierr = PetscMalloc1(numFields, &isFE);CHKERRQ(ierr);
6058   for (f = 0; f < numFields; ++f) {
6059     PetscObject  obj;
6060     PetscClassId id;
6061 
6062     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
6063     ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
6064     if (id == PETSCFE_CLASSID)      {isFE[f] = PETSC_TRUE;}
6065     else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
6066     else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
6067   }
6068   /* Allocate boundary point storage for FEM boundaries */
6069   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
6070   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
6071   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
6072   ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
6073   ierr = PetscDSGetNumBoundary(dm->prob, &numBd);CHKERRQ(ierr);
6074   for (bd = 0; bd < numBd; ++bd) {
6075     PetscInt                field;
6076     DMBoundaryConditionType type;
6077     const char             *labelName;
6078     DMLabel                 label;
6079 
6080     ierr = PetscDSGetBoundary(dm->prob, bd, &type, NULL, &labelName, &field, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
6081     ierr = DMGetLabel(dm,labelName,&label);CHKERRQ(ierr);
6082     if (label && isFE[field] && (type & DM_BC_ESSENTIAL)) ++numBC;
6083   }
6084   /* Add ghost cell boundaries for FVM */
6085   for (f = 0; f < numFields; ++f) if (!isFE[f] && cEndInterior >= 0) ++numBC;
6086   ierr = PetscCalloc3(numBC,&bcFields,numBC,&bcPoints,numBC,&bcComps);CHKERRQ(ierr);
6087   /* Constrain ghost cells for FV */
6088   for (f = 0; f < numFields; ++f) {
6089     PetscInt *newidx, c;
6090 
6091     if (isFE[f] || cEndInterior < 0) continue;
6092     ierr = PetscMalloc1(cEnd-cEndInterior,&newidx);CHKERRQ(ierr);
6093     for (c = cEndInterior; c < cEnd; ++c) newidx[c-cEndInterior] = c;
6094     bcFields[bc] = f;
6095     ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), cEnd-cEndInterior, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
6096   }
6097   /* Handle FEM Dirichlet boundaries */
6098   for (bd = 0; bd < numBd; ++bd) {
6099     const char             *bdLabel;
6100     DMLabel                 label;
6101     const PetscInt         *comps;
6102     const PetscInt         *values;
6103     PetscInt                bd2, field, numComps, numValues;
6104     DMBoundaryConditionType type;
6105     PetscBool               duplicate = PETSC_FALSE;
6106 
6107     ierr = PetscDSGetBoundary(dm->prob, bd, &type, NULL, &bdLabel, &field, &numComps, &comps, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
6108     ierr = DMGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
6109     if (!isFE[field] || !label) continue;
6110     /* Only want to modify label once */
6111     for (bd2 = 0; bd2 < bd; ++bd2) {
6112       const char *bdname;
6113       ierr = PetscDSGetBoundary(dm->prob, bd2, NULL, NULL, &bdname, NULL, NULL, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
6114       ierr = PetscStrcmp(bdname, bdLabel, &duplicate);CHKERRQ(ierr);
6115       if (duplicate) break;
6116     }
6117     if (!duplicate && (isFE[field])) {
6118       /* don't complete cells, which are just present to give orientation to the boundary */
6119       ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
6120     }
6121     /* Filter out cells, if you actually want to constrain cells you need to do things by hand right now */
6122     if (type & DM_BC_ESSENTIAL) {
6123       PetscInt       *newidx;
6124       PetscInt        n, newn = 0, p, v;
6125 
6126       bcFields[bc] = field;
6127       if (numComps) {ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), numComps, comps, PETSC_COPY_VALUES, &bcComps[bc]);CHKERRQ(ierr);}
6128       for (v = 0; v < numValues; ++v) {
6129         IS              tmp;
6130         const PetscInt *idx;
6131 
6132         ierr = DMGetStratumIS(dm, bdLabel, values[v], &tmp);CHKERRQ(ierr);
6133         if (!tmp) continue;
6134         ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
6135         ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
6136         if (isFE[field]) {
6137           for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) ++newn;
6138         } else {
6139           for (p = 0; p < n; ++p) if ((idx[p] >= cStart) || (idx[p] < cEnd)) ++newn;
6140         }
6141         ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
6142         ierr = ISDestroy(&tmp);CHKERRQ(ierr);
6143       }
6144       ierr = PetscMalloc1(newn,&newidx);CHKERRQ(ierr);
6145       newn = 0;
6146       for (v = 0; v < numValues; ++v) {
6147         IS              tmp;
6148         const PetscInt *idx;
6149 
6150         ierr = DMGetStratumIS(dm, bdLabel, values[v], &tmp);CHKERRQ(ierr);
6151         if (!tmp) continue;
6152         ierr = ISGetLocalSize(tmp, &n);CHKERRQ(ierr);
6153         ierr = ISGetIndices(tmp, &idx);CHKERRQ(ierr);
6154         if (isFE[field]) {
6155           for (p = 0; p < n; ++p) if ((idx[p] < cStart) || (idx[p] >= cEnd)) newidx[newn++] = idx[p];
6156         } else {
6157           for (p = 0; p < n; ++p) if ((idx[p] >= cStart) || (idx[p] < cEnd)) newidx[newn++] = idx[p];
6158         }
6159         ierr = ISRestoreIndices(tmp, &idx);CHKERRQ(ierr);
6160         ierr = ISDestroy(&tmp);CHKERRQ(ierr);
6161       }
6162       ierr = ISCreateGeneral(PetscObjectComm((PetscObject) dm), newn, newidx, PETSC_OWN_POINTER, &bcPoints[bc++]);CHKERRQ(ierr);
6163     }
6164   }
6165   /* Handle discretization */
6166   ierr = PetscCalloc2(numFields,&numComp,numFields*(dim+1),&numDof);CHKERRQ(ierr);
6167   for (f = 0; f < numFields; ++f) {
6168     PetscObject obj;
6169 
6170     ierr = DMGetField(dm, f, &obj);CHKERRQ(ierr);
6171     if (isFE[f]) {
6172       PetscFE         fe = (PetscFE) obj;
6173       const PetscInt *numFieldDof;
6174       PetscInt        d;
6175 
6176       ierr = PetscFEGetNumComponents(fe, &numComp[f]);CHKERRQ(ierr);
6177       ierr = PetscFEGetNumDof(fe, &numFieldDof);CHKERRQ(ierr);
6178       for (d = 0; d < dim+1; ++d) numDof[f*(dim+1)+d] = numFieldDof[d];
6179     } else {
6180       PetscFV fv = (PetscFV) obj;
6181 
6182       ierr = PetscFVGetNumComponents(fv, &numComp[f]);CHKERRQ(ierr);
6183       numDof[f*(dim+1)+dim] = numComp[f];
6184     }
6185   }
6186   for (f = 0; f < numFields; ++f) {
6187     PetscInt d;
6188     for (d = 1; d < dim; ++d) {
6189       if ((numDof[f*(dim+1)+d] > 0) && (depth < dim)) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Mesh must be interpolated when unknowns are specified on edges or faces.");
6190     }
6191   }
6192   ierr = DMPlexCreateSection(dm, dim, numFields, numComp, numDof, numBC, bcFields, bcComps, bcPoints, NULL, &section);CHKERRQ(ierr);
6193   for (f = 0; f < numFields; ++f) {
6194     PetscFE     fe;
6195     const char *name;
6196 
6197     ierr = DMGetField(dm, f, (PetscObject *) &fe);CHKERRQ(ierr);
6198     ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr);
6199     ierr = PetscSectionSetFieldName(section, f, name);CHKERRQ(ierr);
6200   }
6201   ierr = DMSetDefaultSection(dm, section);CHKERRQ(ierr);
6202   ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
6203   for (bc = 0; bc < numBC; ++bc) {ierr = ISDestroy(&bcPoints[bc]);CHKERRQ(ierr);ierr = ISDestroy(&bcComps[bc]);CHKERRQ(ierr);}
6204   ierr = PetscFree3(bcFields,bcPoints,bcComps);CHKERRQ(ierr);
6205   ierr = PetscFree2(numComp,numDof);CHKERRQ(ierr);
6206   ierr = PetscFree(isFE);CHKERRQ(ierr);
6207   PetscFunctionReturn(0);
6208 }
6209 
6210 /*@
6211   DMPlexGetRegularRefinement - Get the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
6212 
6213   Input Parameter:
6214 . dm - The DMPlex object
6215 
6216   Output Parameter:
6217 . regular - The flag
6218 
6219   Level: intermediate
6220 
6221 .seealso: DMPlexSetRegularRefinement()
6222 @*/
6223 PetscErrorCode DMPlexGetRegularRefinement(DM dm, PetscBool *regular)
6224 {
6225   PetscFunctionBegin;
6226   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6227   PetscValidPointer(regular, 2);
6228   *regular = ((DM_Plex *) dm->data)->regularRefinement;
6229   PetscFunctionReturn(0);
6230 }
6231 
6232 /*@
6233   DMPlexSetRegularRefinement - Set the flag indicating that this mesh was obtained by regular refinement from its coarse mesh
6234 
6235   Input Parameters:
6236 + dm - The DMPlex object
6237 - regular - The flag
6238 
6239   Level: intermediate
6240 
6241 .seealso: DMPlexGetRegularRefinement()
6242 @*/
6243 PetscErrorCode DMPlexSetRegularRefinement(DM dm, PetscBool regular)
6244 {
6245   PetscFunctionBegin;
6246   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6247   ((DM_Plex *) dm->data)->regularRefinement = regular;
6248   PetscFunctionReturn(0);
6249 }
6250 
6251 /* anchors */
6252 /*@
6253   DMPlexGetAnchors - Get the layout of the anchor (point-to-point) constraints.  Typically, the user will not have to
6254   call DMPlexGetAnchors() directly: if there are anchors, then DMPlexGetAnchors() is called during DMGetConstraints().
6255 
6256   not collective
6257 
6258   Input Parameters:
6259 . dm - The DMPlex object
6260 
6261   Output Parameters:
6262 + anchorSection - If not NULL, set to the section describing which points anchor the constrained points.
6263 - anchorIS - If not NULL, set to the list of anchors indexed by anchorSection
6264 
6265 
6266   Level: intermediate
6267 
6268 .seealso: DMPlexSetAnchors(), DMGetConstraints(), DMSetConstraints()
6269 @*/
6270 PetscErrorCode DMPlexGetAnchors(DM dm, PetscSection *anchorSection, IS *anchorIS)
6271 {
6272   DM_Plex *plex = (DM_Plex *)dm->data;
6273   PetscErrorCode ierr;
6274 
6275   PetscFunctionBegin;
6276   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6277   if (!plex->anchorSection && !plex->anchorIS && plex->createanchors) {ierr = (*plex->createanchors)(dm);CHKERRQ(ierr);}
6278   if (anchorSection) *anchorSection = plex->anchorSection;
6279   if (anchorIS) *anchorIS = plex->anchorIS;
6280   PetscFunctionReturn(0);
6281 }
6282 
6283 /*@
6284   DMPlexSetAnchors - Set the layout of the local anchor (point-to-point) constraints.  Unlike boundary conditions,
6285   when a point's degrees of freedom in a section are constrained to an outside value, the anchor constraints set a
6286   point's degrees of freedom to be a linear combination of other points' degrees of freedom.
6287 
6288   After specifying the layout of constraints with DMPlexSetAnchors(), one specifies the constraints by calling
6289   DMGetConstraints() and filling in the entries in the constraint matrix.
6290 
6291   collective on dm
6292 
6293   Input Parameters:
6294 + dm - The DMPlex object
6295 . anchorSection - The section that describes the mapping from constrained points to the anchor points listed in anchorIS.  Must have a local communicator (PETSC_COMM_SELF or derivative).
6296 - anchorIS - The list of all anchor points.  Must have a local communicator (PETSC_COMM_SELF or derivative).
6297 
6298   The reference counts of anchorSection and anchorIS are incremented.
6299 
6300   Level: intermediate
6301 
6302 .seealso: DMPlexGetAnchors(), DMGetConstraints(), DMSetConstraints()
6303 @*/
6304 PetscErrorCode DMPlexSetAnchors(DM dm, PetscSection anchorSection, IS anchorIS)
6305 {
6306   DM_Plex        *plex = (DM_Plex *)dm->data;
6307   PetscMPIInt    result;
6308   PetscErrorCode ierr;
6309 
6310   PetscFunctionBegin;
6311   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6312   if (anchorSection) {
6313     PetscValidHeaderSpecific(anchorSection,PETSC_SECTION_CLASSID,2);
6314     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorSection),&result);CHKERRQ(ierr);
6315     if (result != MPI_CONGRUENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor section must have local communicator");
6316   }
6317   if (anchorIS) {
6318     PetscValidHeaderSpecific(anchorIS,IS_CLASSID,3);
6319     ierr = MPI_Comm_compare(PETSC_COMM_SELF,PetscObjectComm((PetscObject)anchorIS),&result);CHKERRQ(ierr);
6320     if (result != MPI_CONGRUENT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_NOTSAMECOMM,"anchor IS must have local communicator");
6321   }
6322 
6323   ierr = PetscObjectReference((PetscObject)anchorSection);CHKERRQ(ierr);
6324   ierr = PetscSectionDestroy(&plex->anchorSection);CHKERRQ(ierr);
6325   plex->anchorSection = anchorSection;
6326 
6327   ierr = PetscObjectReference((PetscObject)anchorIS);CHKERRQ(ierr);
6328   ierr = ISDestroy(&plex->anchorIS);CHKERRQ(ierr);
6329   plex->anchorIS = anchorIS;
6330 
6331 #if defined(PETSC_USE_DEBUG)
6332   if (anchorIS && anchorSection) {
6333     PetscInt size, a, pStart, pEnd;
6334     const PetscInt *anchors;
6335 
6336     ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
6337     ierr = ISGetLocalSize(anchorIS,&size);CHKERRQ(ierr);
6338     ierr = ISGetIndices(anchorIS,&anchors);CHKERRQ(ierr);
6339     for (a = 0; a < size; a++) {
6340       PetscInt p;
6341 
6342       p = anchors[a];
6343       if (p >= pStart && p < pEnd) {
6344         PetscInt dof;
6345 
6346         ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
6347         if (dof) {
6348           PetscErrorCode ierr2;
6349 
6350           ierr2 = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr2);
6351           SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Point %D cannot be constrained and an anchor",p);
6352         }
6353       }
6354     }
6355     ierr = ISRestoreIndices(anchorIS,&anchors);CHKERRQ(ierr);
6356   }
6357 #endif
6358   /* reset the generic constraints */
6359   ierr = DMSetDefaultConstraints(dm,NULL,NULL);CHKERRQ(ierr);
6360   PetscFunctionReturn(0);
6361 }
6362 
6363 static PetscErrorCode DMPlexCreateConstraintSection_Anchors(DM dm, PetscSection section, PetscSection *cSec)
6364 {
6365   PetscSection anchorSection;
6366   PetscInt pStart, pEnd, sStart, sEnd, p, dof, numFields, f;
6367   PetscErrorCode ierr;
6368 
6369   PetscFunctionBegin;
6370   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6371   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
6372   ierr = PetscSectionCreate(PETSC_COMM_SELF,cSec);CHKERRQ(ierr);
6373   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
6374   if (numFields) {
6375     PetscInt f;
6376     ierr = PetscSectionSetNumFields(*cSec,numFields);CHKERRQ(ierr);
6377 
6378     for (f = 0; f < numFields; f++) {
6379       PetscInt numComp;
6380 
6381       ierr = PetscSectionGetFieldComponents(section,f,&numComp);CHKERRQ(ierr);
6382       ierr = PetscSectionSetFieldComponents(*cSec,f,numComp);CHKERRQ(ierr);
6383     }
6384   }
6385   ierr = PetscSectionGetChart(anchorSection,&pStart,&pEnd);CHKERRQ(ierr);
6386   ierr = PetscSectionGetChart(section,&sStart,&sEnd);CHKERRQ(ierr);
6387   pStart = PetscMax(pStart,sStart);
6388   pEnd   = PetscMin(pEnd,sEnd);
6389   pEnd   = PetscMax(pStart,pEnd);
6390   ierr = PetscSectionSetChart(*cSec,pStart,pEnd);CHKERRQ(ierr);
6391   for (p = pStart; p < pEnd; p++) {
6392     ierr = PetscSectionGetDof(anchorSection,p,&dof);CHKERRQ(ierr);
6393     if (dof) {
6394       ierr = PetscSectionGetDof(section,p,&dof);CHKERRQ(ierr);
6395       ierr = PetscSectionSetDof(*cSec,p,dof);CHKERRQ(ierr);
6396       for (f = 0; f < numFields; f++) {
6397         ierr = PetscSectionGetFieldDof(section,p,f,&dof);CHKERRQ(ierr);
6398         ierr = PetscSectionSetFieldDof(*cSec,p,f,dof);CHKERRQ(ierr);
6399       }
6400     }
6401   }
6402   ierr = PetscSectionSetUp(*cSec);CHKERRQ(ierr);
6403   PetscFunctionReturn(0);
6404 }
6405 
6406 static PetscErrorCode DMPlexCreateConstraintMatrix_Anchors(DM dm, PetscSection section, PetscSection cSec, Mat *cMat)
6407 {
6408   PetscSection aSec;
6409   PetscInt pStart, pEnd, p, dof, aDof, aOff, off, nnz, annz, m, n, q, a, offset, *i, *j;
6410   const PetscInt *anchors;
6411   PetscInt numFields, f;
6412   IS aIS;
6413   PetscErrorCode ierr;
6414 
6415   PetscFunctionBegin;
6416   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6417   ierr = PetscSectionGetStorageSize(cSec, &m);CHKERRQ(ierr);
6418   ierr = PetscSectionGetStorageSize(section, &n);CHKERRQ(ierr);
6419   ierr = MatCreate(PETSC_COMM_SELF,cMat);CHKERRQ(ierr);
6420   ierr = MatSetSizes(*cMat,m,n,m,n);CHKERRQ(ierr);
6421   ierr = MatSetType(*cMat,MATSEQAIJ);CHKERRQ(ierr);
6422   ierr = DMPlexGetAnchors(dm,&aSec,&aIS);CHKERRQ(ierr);
6423   ierr = ISGetIndices(aIS,&anchors);CHKERRQ(ierr);
6424   /* cSec will be a subset of aSec and section */
6425   ierr = PetscSectionGetChart(cSec,&pStart,&pEnd);CHKERRQ(ierr);
6426   ierr = PetscMalloc1(m+1,&i);CHKERRQ(ierr);
6427   i[0] = 0;
6428   ierr = PetscSectionGetNumFields(section,&numFields);CHKERRQ(ierr);
6429   for (p = pStart; p < pEnd; p++) {
6430     PetscInt rDof, rOff, r;
6431 
6432     ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
6433     if (!rDof) continue;
6434     ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
6435     if (numFields) {
6436       for (f = 0; f < numFields; f++) {
6437         annz = 0;
6438         for (r = 0; r < rDof; r++) {
6439           a = anchors[rOff + r];
6440           ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
6441           annz += aDof;
6442         }
6443         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
6444         ierr = PetscSectionGetFieldOffset(cSec,p,f,&off);CHKERRQ(ierr);
6445         for (q = 0; q < dof; q++) {
6446           i[off + q + 1] = i[off + q] + annz;
6447         }
6448       }
6449     }
6450     else {
6451       annz = 0;
6452       for (q = 0; q < dof; q++) {
6453         a = anchors[off + q];
6454         ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
6455         annz += aDof;
6456       }
6457       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
6458       ierr = PetscSectionGetOffset(cSec,p,&off);CHKERRQ(ierr);
6459       for (q = 0; q < dof; q++) {
6460         i[off + q + 1] = i[off + q] + annz;
6461       }
6462     }
6463   }
6464   nnz = i[m];
6465   ierr = PetscMalloc1(nnz,&j);CHKERRQ(ierr);
6466   offset = 0;
6467   for (p = pStart; p < pEnd; p++) {
6468     if (numFields) {
6469       for (f = 0; f < numFields; f++) {
6470         ierr = PetscSectionGetFieldDof(cSec,p,f,&dof);CHKERRQ(ierr);
6471         for (q = 0; q < dof; q++) {
6472           PetscInt rDof, rOff, r;
6473           ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
6474           ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
6475           for (r = 0; r < rDof; r++) {
6476             PetscInt s;
6477 
6478             a = anchors[rOff + r];
6479             ierr = PetscSectionGetFieldDof(section,a,f,&aDof);CHKERRQ(ierr);
6480             ierr = PetscSectionGetFieldOffset(section,a,f,&aOff);CHKERRQ(ierr);
6481             for (s = 0; s < aDof; s++) {
6482               j[offset++] = aOff + s;
6483             }
6484           }
6485         }
6486       }
6487     }
6488     else {
6489       ierr = PetscSectionGetDof(cSec,p,&dof);CHKERRQ(ierr);
6490       for (q = 0; q < dof; q++) {
6491         PetscInt rDof, rOff, r;
6492         ierr = PetscSectionGetDof(aSec,p,&rDof);CHKERRQ(ierr);
6493         ierr = PetscSectionGetOffset(aSec,p,&rOff);CHKERRQ(ierr);
6494         for (r = 0; r < rDof; r++) {
6495           PetscInt s;
6496 
6497           a = anchors[rOff + r];
6498           ierr = PetscSectionGetDof(section,a,&aDof);CHKERRQ(ierr);
6499           ierr = PetscSectionGetOffset(section,a,&aOff);CHKERRQ(ierr);
6500           for (s = 0; s < aDof; s++) {
6501             j[offset++] = aOff + s;
6502           }
6503         }
6504       }
6505     }
6506   }
6507   ierr = MatSeqAIJSetPreallocationCSR(*cMat,i,j,NULL);CHKERRQ(ierr);
6508   ierr = PetscFree(i);CHKERRQ(ierr);
6509   ierr = PetscFree(j);CHKERRQ(ierr);
6510   ierr = ISRestoreIndices(aIS,&anchors);CHKERRQ(ierr);
6511   PetscFunctionReturn(0);
6512 }
6513 
6514 PetscErrorCode DMCreateDefaultConstraints_Plex(DM dm)
6515 {
6516   DM_Plex        *plex = (DM_Plex *)dm->data;
6517   PetscSection   anchorSection, section, cSec;
6518   Mat            cMat;
6519   PetscErrorCode ierr;
6520 
6521   PetscFunctionBegin;
6522   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
6523   ierr = DMPlexGetAnchors(dm,&anchorSection,NULL);CHKERRQ(ierr);
6524   if (anchorSection) {
6525     PetscDS  ds;
6526     PetscInt nf;
6527 
6528     ierr = DMGetDefaultSection(dm,&section);CHKERRQ(ierr);
6529     ierr = DMPlexCreateConstraintSection_Anchors(dm,section,&cSec);CHKERRQ(ierr);
6530     ierr = DMPlexCreateConstraintMatrix_Anchors(dm,section,cSec,&cMat);CHKERRQ(ierr);
6531     ierr = DMGetDS(dm,&ds);CHKERRQ(ierr);
6532     ierr = PetscDSGetNumFields(ds,&nf);CHKERRQ(ierr);
6533     if (nf && plex->computeanchormatrix) {ierr = (*plex->computeanchormatrix)(dm,section,cSec,cMat);CHKERRQ(ierr);}
6534     ierr = DMSetDefaultConstraints(dm,cSec,cMat);CHKERRQ(ierr);
6535     ierr = PetscSectionDestroy(&cSec);CHKERRQ(ierr);
6536     ierr = MatDestroy(&cMat);CHKERRQ(ierr);
6537   }
6538   PetscFunctionReturn(0);
6539 }
6540