xref: /petsc/src/dm/impls/forest/p4est/pforest.h (revision 3ea99036a5fedea4d39e7e77471d0ab500c249d7)
1 #ifndef PFOREST_H
2 #define PFOREST_H
3 
4 #include <petscds.h>
5 #include <petsc/private/dmimpl.h>
6 #include <petsc/private/dmforestimpl.h>
7 #include <petsc/private/dmpleximpl.h>
8 #include <petsc/private/dmlabelimpl.h>
9 #include <petsc/private/viewerimpl.h>
10 #include <../src/sys/classes/viewer/impls/vtk/vtkvimpl.h>
11 #include "petsc_p4est_package.h"
12 
13 #if defined(PETSC_HAVE_P4EST)
14 
15   #if !defined(P4_TO_P8)
16     #include <p4est.h>
17     #include <p4est_extended.h>
18     #include <p4est_geometry.h>
19     #include <p4est_ghost.h>
20     #include <p4est_lnodes.h>
21     #include <p4est_vtk.h>
22     #include <p4est_plex.h>
23     #include <p4est_bits.h>
24     #include <p4est_algorithms.h>
25   #else
26     #include <p8est.h>
27     #include <p8est_extended.h>
28     #include <p8est_geometry.h>
29     #include <p8est_ghost.h>
30     #include <p8est_lnodes.h>
31     #include <p8est_vtk.h>
32     #include <p8est_plex.h>
33     #include <p8est_bits.h>
34     #include <p8est_algorithms.h>
35   #endif
36 
37 typedef enum {
38   PATTERN_HASH,
39   PATTERN_FRACTAL,
40   PATTERN_CORNER,
41   PATTERN_CENTER,
42   PATTERN_COUNT
43 } DMRefinePattern;
44 static const char *DMRefinePatternName[PATTERN_COUNT] = {"hash", "fractal", "corner", "center"};
45 
46 typedef struct _DMRefinePatternCtx {
47   PetscInt       corner;
48   PetscBool      fractal[P4EST_CHILDREN];
49   PetscReal      hashLikelihood;
50   PetscInt       maxLevel;
51   p4est_refine_t refine_fn;
52 } DMRefinePatternCtx;
53 
54 static int DMRefinePattern_Corner(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
55 {
56   p4est_quadrant_t    root, rootcorner;
57   DMRefinePatternCtx *ctx;
58 
59   ctx = (DMRefinePatternCtx *)p4est->user_pointer;
60   if (quadrant->level >= ctx->maxLevel) return 0;
61 
62   root.x = root.y = 0;
63   #if defined(P4_TO_P8)
64   root.z = 0;
65   #endif
66   root.level = 0;
67   p4est_quadrant_corner_descendant(&root, &rootcorner, ctx->corner, quadrant->level);
68   if (p4est_quadrant_is_equal(quadrant, &rootcorner)) return 1;
69   return 0;
70 }
71 
72 static int DMRefinePattern_Center(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
73 {
74   int                 cid;
75   p4est_quadrant_t    ancestor, ancestorcorner;
76   DMRefinePatternCtx *ctx;
77 
78   ctx = (DMRefinePatternCtx *)p4est->user_pointer;
79   if (quadrant->level >= ctx->maxLevel) return 0;
80   if (quadrant->level <= 1) return 1;
81 
82   p4est_quadrant_ancestor(quadrant, 1, &ancestor);
83   cid = p4est_quadrant_child_id(&ancestor);
84   p4est_quadrant_corner_descendant(&ancestor, &ancestorcorner, P4EST_CHILDREN - 1 - cid, quadrant->level);
85   if (p4est_quadrant_is_equal(quadrant, &ancestorcorner)) return 1;
86   return 0;
87 }
88 
89 static int DMRefinePattern_Fractal(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
90 {
91   int                 cid;
92   DMRefinePatternCtx *ctx;
93 
94   ctx = (DMRefinePatternCtx *)p4est->user_pointer;
95   if (quadrant->level >= ctx->maxLevel) return 0;
96   if (!quadrant->level) return 1;
97   cid = p4est_quadrant_child_id(quadrant);
98   if (ctx->fractal[cid ^ ((int)(quadrant->level % P4EST_CHILDREN))]) return 1;
99   return 0;
100 }
101 
102   /* simplified from MurmurHash3 by Austin Appleby */
103   #define DMPROT32(x, y) ((x << y) | (x >> (32 - y)))
104 static uint32_t DMPforestHash(const uint32_t *blocks, uint32_t nblocks)
105 {
106   uint32_t c1   = 0xcc9e2d51;
107   uint32_t c2   = 0x1b873593;
108   uint32_t r1   = 15;
109   uint32_t r2   = 13;
110   uint32_t m    = 5;
111   uint32_t n    = 0xe6546b64;
112   uint32_t hash = 0;
113   int      len  = nblocks * 4;
114   uint32_t i;
115 
116   for (i = 0; i < nblocks; i++) {
117     uint32_t k;
118 
119     k = blocks[i];
120     k *= c1;
121     k = DMPROT32(k, r1);
122     k *= c2;
123 
124     hash ^= k;
125     hash = DMPROT32(hash, r2) * m + n;
126   }
127 
128   hash ^= len;
129   hash ^= (hash >> 16);
130   hash *= 0x85ebca6b;
131   hash ^= (hash >> 13);
132   hash *= 0xc2b2ae35;
133   hash ^= (hash >> 16);
134 
135   return hash;
136 }
137 
138   #if defined(UINT32_MAX)
139     #define DMP4EST_HASH_MAX UINT32_MAX
140   #else
141     #define DMP4EST_HASH_MAX ((uint32_t)0xffffffff)
142   #endif
143 
144 static int DMRefinePattern_Hash(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
145 {
146   uint32_t            data[5];
147   uint32_t            result;
148   DMRefinePatternCtx *ctx;
149 
150   ctx = (DMRefinePatternCtx *)p4est->user_pointer;
151   if (quadrant->level >= ctx->maxLevel) return 0;
152   data[0] = ((uint32_t)quadrant->level) << 24;
153   data[1] = (uint32_t)which_tree;
154   data[2] = (uint32_t)quadrant->x;
155   data[3] = (uint32_t)quadrant->y;
156   #if defined(P4_TO_P8)
157   data[4] = (uint32_t)quadrant->z;
158   #endif
159 
160   result = DMPforestHash(data, 2 + P4EST_DIM);
161   if (((double)result / (double)DMP4EST_HASH_MAX) < ctx->hashLikelihood) return 1;
162   return 0;
163 }
164 
165   #define DMConvert_pforest_plex _infix_pforest(DMConvert, _plex)
166 static PetscErrorCode DMConvert_pforest_plex(DM, DMType, DM *);
167 
168   #define DMFTopology_pforest _append_pforest(DMFTopology)
169 typedef struct {
170   PetscInt              refct;
171   p4est_connectivity_t *conn;
172   p4est_geometry_t     *geom;
173   PetscInt             *tree_face_to_uniq; /* p4est does not explicitly enumerate facets, but we must to keep track of labels */
174 } DMFTopology_pforest;
175 
176   #define DM_Forest_pforest _append_pforest(DM_Forest)
177 typedef struct {
178   DMFTopology_pforest *topo;
179   p4est_t             *forest;
180   p4est_ghost_t       *ghost;
181   p4est_lnodes_t      *lnodes;
182   PetscBool            partition_for_coarsening;
183   PetscBool            coarsen_hierarchy;
184   PetscBool            labelsFinalized;
185   PetscBool            adaptivitySuccess;
186   PetscInt             cLocalStart;
187   PetscInt             cLocalEnd;
188   DM                   plex;
189   char                *ghostName;
190   PetscSF              pointAdaptToSelfSF;
191   PetscSF              pointSelfToAdaptSF;
192   PetscInt            *pointAdaptToSelfCids;
193   PetscInt            *pointSelfToAdaptCids;
194 } DM_Forest_pforest;
195 
196   #define DM_Forest_geometry_pforest _append_pforest(DM_Forest_geometry)
197 typedef struct {
198   DM base;
199   PetscErrorCode (*map)(DM, PetscInt, PetscInt, const PetscReal[], PetscReal[], void *);
200   void             *mapCtx;
201   PetscInt          coordDim;
202   p4est_geometry_t *inner;
203 } DM_Forest_geometry_pforest;
204 
205   #define GeometryMapping_pforest _append_pforest(GeometryMapping)
206 static void GeometryMapping_pforest(p4est_geometry_t *geom, p4est_topidx_t which_tree, const double abc[3], double xyz[3])
207 {
208   DM_Forest_geometry_pforest *geom_pforest = (DM_Forest_geometry_pforest *)geom->user;
209   PetscReal                   PetscABC[3]  = {0.};
210   PetscReal                   PetscXYZ[3]  = {0.};
211   PetscInt                    i, d = PetscMin(3, geom_pforest->coordDim);
212   double                      ABC[3];
213   PetscErrorCode              ierr;
214 
215   (geom_pforest->inner->X)(geom_pforest->inner, which_tree, abc, ABC);
216 
217   for (i = 0; i < d; i++) PetscABC[i] = ABC[i];
218   ierr = (geom_pforest->map)(geom_pforest->base, (PetscInt)which_tree, geom_pforest->coordDim, PetscABC, PetscXYZ, geom_pforest->mapCtx);
219   PETSC_P4EST_ASSERT(!ierr);
220   for (i = 0; i < d; i++) xyz[i] = PetscXYZ[i];
221 }
222 
223   #define GeometryDestroy_pforest _append_pforest(GeometryDestroy)
224 static void GeometryDestroy_pforest(p4est_geometry_t *geom)
225 {
226   DM_Forest_geometry_pforest *geom_pforest = (DM_Forest_geometry_pforest *)geom->user;
227   PetscErrorCode              ierr;
228 
229   p4est_geometry_destroy(geom_pforest->inner);
230   ierr = PetscFree(geom->user);
231   PETSC_P4EST_ASSERT(!ierr);
232   ierr = PetscFree(geom);
233   PETSC_P4EST_ASSERT(!ierr);
234 }
235 
236   #define DMFTopologyDestroy_pforest _append_pforest(DMFTopologyDestroy)
237 static PetscErrorCode DMFTopologyDestroy_pforest(DMFTopology_pforest **topo)
238 {
239   PetscFunctionBegin;
240   if (!(*topo)) PetscFunctionReturn(PETSC_SUCCESS);
241   if (--((*topo)->refct) > 0) {
242     *topo = NULL;
243     PetscFunctionReturn(PETSC_SUCCESS);
244   }
245   if ((*topo)->geom) PetscCallP4est(p4est_geometry_destroy, ((*topo)->geom));
246   PetscCallP4est(p4est_connectivity_destroy, ((*topo)->conn));
247   PetscCall(PetscFree((*topo)->tree_face_to_uniq));
248   PetscCall(PetscFree(*topo));
249   *topo = NULL;
250   PetscFunctionReturn(PETSC_SUCCESS);
251 }
252 
253 static PetscErrorCode PforestConnectivityEnumerateFacets(p4est_connectivity_t *, PetscInt **);
254 
255   #define DMFTopologyCreateBrick_pforest _append_pforest(DMFTopologyCreateBrick)
256 static PetscErrorCode DMFTopologyCreateBrick_pforest(DM dm, PetscInt N[], PetscInt P[], PetscReal B[], DMFTopology_pforest **topo, PetscBool useMorton)
257 {
258   double  *vertices;
259   PetscInt i, numVerts;
260 
261   PetscFunctionBegin;
262   PetscCheck(useMorton, PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Lexicographic ordering not implemented yet");
263   PetscCall(PetscNew(topo));
264 
265   (*topo)->refct = 1;
266   #if !defined(P4_TO_P8)
267   PetscCallP4estReturn((*topo)->conn, p4est_connectivity_new_brick, ((int)N[0], (int)N[1], (P[0] == DM_BOUNDARY_NONE) ? 0 : 1, (P[1] == DM_BOUNDARY_NONE) ? 0 : 1));
268   #else
269   PetscCallP4estReturn((*topo)->conn, p8est_connectivity_new_brick, ((int)N[0], (int)N[1], (int)N[2], (P[0] == DM_BOUNDARY_NONE) ? 0 : 1, (P[1] == DM_BOUNDARY_NONE) ? 0 : 1, (P[2] == DM_BOUNDARY_NONE) ? 0 : 1));
270   #endif
271   numVerts = (*topo)->conn->num_vertices;
272   vertices = (*topo)->conn->vertices;
273   for (i = 0; i < 3 * numVerts; i++) {
274     PetscInt j = i % 3;
275 
276     vertices[i] = B[2 * j] + (vertices[i] / N[j]) * (B[2 * j + 1] - B[2 * j]);
277   }
278   (*topo)->geom = NULL;
279   PetscCall(PforestConnectivityEnumerateFacets((*topo)->conn, &(*topo)->tree_face_to_uniq));
280   PetscFunctionReturn(PETSC_SUCCESS);
281 }
282 
283   #define DMFTopologyCreate_pforest _append_pforest(DMFTopologyCreate)
284 static PetscErrorCode DMFTopologyCreate_pforest(DM dm, DMForestTopology topologyName, DMFTopology_pforest **topo)
285 {
286   const char *name = (const char *)topologyName;
287   const char *prefix;
288   PetscBool   isBrick, isShell, isSphere, isMoebius;
289 
290   PetscFunctionBegin;
291   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
292   PetscAssertPointer(name, 2);
293   PetscAssertPointer(topo, 3);
294   PetscCall(PetscStrcmp(name, "brick", &isBrick));
295   PetscCall(PetscStrcmp(name, "shell", &isShell));
296   PetscCall(PetscStrcmp(name, "sphere", &isSphere));
297   PetscCall(PetscStrcmp(name, "moebius", &isMoebius));
298   PetscCall(PetscObjectGetOptionsPrefix((PetscObject)dm, &prefix));
299   if (isBrick) {
300     PetscBool flgN, flgP, flgM, flgB, useMorton = PETSC_TRUE, periodic = PETSC_FALSE;
301     PetscInt  N[3] = {2, 2, 2}, P[3] = {0, 0, 0}, nretN = P4EST_DIM, nretP = P4EST_DIM, nretB = 2 * P4EST_DIM, i;
302     PetscReal B[6] = {0.0, 1.0, 0.0, 1.0, 0.0, 1.0}, Lstart[3] = {0., 0., 0.}, L[3] = {-1.0, -1.0, -1.0}, maxCell[3] = {-1.0, -1.0, -1.0};
303 
304     if (dm->setfromoptionscalled) {
305       PetscCall(PetscOptionsGetIntArray(((PetscObject)dm)->options, prefix, "-dm_p4est_brick_size", N, &nretN, &flgN));
306       PetscCall(PetscOptionsGetIntArray(((PetscObject)dm)->options, prefix, "-dm_p4est_brick_periodicity", P, &nretP, &flgP));
307       PetscCall(PetscOptionsGetRealArray(((PetscObject)dm)->options, prefix, "-dm_p4est_brick_bounds", B, &nretB, &flgB));
308       PetscCall(PetscOptionsGetBool(((PetscObject)dm)->options, prefix, "-dm_p4est_brick_use_morton_curve", &useMorton, &flgM));
309       PetscCheck(!flgN || nretN == P4EST_DIM, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_SIZ, "Need to give %d sizes in -dm_p4est_brick_size, gave %" PetscInt_FMT, P4EST_DIM, nretN);
310       PetscCheck(!flgP || nretP == P4EST_DIM, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_SIZ, "Need to give %d periodicities in -dm_p4est_brick_periodicity, gave %" PetscInt_FMT, P4EST_DIM, nretP);
311       PetscCheck(!flgB || nretB == 2 * P4EST_DIM, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_SIZ, "Need to give %d bounds in -dm_p4est_brick_bounds, gave %" PetscInt_FMT, P4EST_DIM, nretP);
312     }
313     for (i = 0; i < P4EST_DIM; i++) {
314       P[i]     = (P[i] ? DM_BOUNDARY_PERIODIC : DM_BOUNDARY_NONE);
315       periodic = (PetscBool)(P[i] || periodic);
316       if (!flgB) B[2 * i + 1] = N[i];
317       if (P[i]) {
318         Lstart[i]  = B[2 * i + 0];
319         L[i]       = B[2 * i + 1] - B[2 * i + 0];
320         maxCell[i] = 1.1 * (L[i] / N[i]);
321       }
322     }
323     PetscCall(DMFTopologyCreateBrick_pforest(dm, N, P, B, topo, useMorton));
324     if (periodic) PetscCall(DMSetPeriodicity(dm, maxCell, Lstart, L));
325   } else {
326     PetscCall(PetscNew(topo));
327 
328     (*topo)->refct = 1;
329     PetscCallP4estReturn((*topo)->conn, p4est_connectivity_new_byname, (name));
330     (*topo)->geom = NULL;
331     if (isMoebius) PetscCall(DMSetCoordinateDim(dm, 3));
332   #if defined(P4_TO_P8)
333     if (isShell) {
334       PetscReal R2 = 1., R1 = .55;
335 
336       if (dm->setfromoptionscalled) {
337         PetscCall(PetscOptionsGetReal(((PetscObject)dm)->options, prefix, "-dm_p4est_shell_outer_radius", &R2, NULL));
338         PetscCall(PetscOptionsGetReal(((PetscObject)dm)->options, prefix, "-dm_p4est_shell_inner_radius", &R1, NULL));
339       }
340       PetscCallP4estReturn((*topo)->geom, p8est_geometry_new_shell, ((*topo)->conn, R2, R1));
341     } else if (isSphere) {
342       PetscReal R2 = 1., R1 = 0.191728, R0 = 0.039856;
343 
344       if (dm->setfromoptionscalled) {
345         PetscCall(PetscOptionsGetReal(((PetscObject)dm)->options, prefix, "-dm_p4est_sphere_outer_radius", &R2, NULL));
346         PetscCall(PetscOptionsGetReal(((PetscObject)dm)->options, prefix, "-dm_p4est_sphere_inner_radius", &R1, NULL));
347         PetscCall(PetscOptionsGetReal(((PetscObject)dm)->options, prefix, "-dm_p4est_sphere_core_radius", &R0, NULL));
348       }
349       PetscCallP4estReturn((*topo)->geom, p8est_geometry_new_sphere, ((*topo)->conn, R2, R1, R0));
350     }
351   #endif
352     PetscCall(PforestConnectivityEnumerateFacets((*topo)->conn, &(*topo)->tree_face_to_uniq));
353   }
354   PetscFunctionReturn(PETSC_SUCCESS);
355 }
356 
357   #define DMConvert_plex_pforest _append_pforest(DMConvert_plex)
358 static PetscErrorCode DMConvert_plex_pforest(DM dm, DMType newtype, DM *pforest)
359 {
360   MPI_Comm  comm;
361   PetscBool isPlex;
362   PetscInt  dim;
363   void     *ctx;
364 
365   PetscFunctionBegin;
366 
367   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
368   comm = PetscObjectComm((PetscObject)dm);
369   PetscCall(PetscObjectTypeCompare((PetscObject)dm, DMPLEX, &isPlex));
370   PetscCheck(isPlex, comm, PETSC_ERR_ARG_WRONG, "Expected DM type %s, got %s", DMPLEX, ((PetscObject)dm)->type_name);
371   PetscCall(DMGetDimension(dm, &dim));
372   PetscCheck(dim == P4EST_DIM, comm, PETSC_ERR_ARG_WRONG, "Expected DM dimension %d, got %" PetscInt_FMT, P4EST_DIM, dim);
373   PetscCall(DMCreate(comm, pforest));
374   PetscCall(DMSetType(*pforest, DMPFOREST));
375   PetscCall(DMForestSetBaseDM(*pforest, dm));
376   PetscCall(DMGetApplicationContext(dm, &ctx));
377   PetscCall(DMSetApplicationContext(*pforest, ctx));
378   PetscCall(DMCopyDisc(dm, *pforest));
379   PetscFunctionReturn(PETSC_SUCCESS);
380 }
381 
382   #define DMForestDestroy_pforest _append_pforest(DMForestDestroy)
383 static PetscErrorCode DMForestDestroy_pforest(DM dm)
384 {
385   DM_Forest         *forest  = (DM_Forest *)dm->data;
386   DM_Forest_pforest *pforest = (DM_Forest_pforest *)forest->data;
387 
388   PetscFunctionBegin;
389   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
390   if (pforest->lnodes) PetscCallP4est(p4est_lnodes_destroy, (pforest->lnodes));
391   pforest->lnodes = NULL;
392   if (pforest->ghost) PetscCallP4est(p4est_ghost_destroy, (pforest->ghost));
393   pforest->ghost = NULL;
394   if (pforest->forest) PetscCallP4est(p4est_destroy, (pforest->forest));
395   pforest->forest = NULL;
396   PetscCall(DMFTopologyDestroy_pforest(&pforest->topo));
397   PetscCall(PetscObjectComposeFunction((PetscObject)dm, PetscStringize(DMConvert_plex_pforest) "_C", NULL));
398   PetscCall(PetscObjectComposeFunction((PetscObject)dm, PetscStringize(DMConvert_pforest_plex) "_C", NULL));
399   PetscCall(PetscObjectComposeFunction((PetscObject)dm, "DMSetUpGLVisViewer_C", NULL));
400   PetscCall(PetscObjectComposeFunction((PetscObject)dm, "DMCreateNeumannOverlap_C", NULL));
401   PetscCall(PetscObjectComposeFunction((PetscObject)dm, "DMPlexGetOverlap_C", NULL));
402   PetscCall(PetscObjectComposeFunction((PetscObject)dm, "MatComputeNeumannOverlap_C", NULL));
403   PetscCall(PetscFree(pforest->ghostName));
404   PetscCall(DMDestroy(&pforest->plex));
405   PetscCall(PetscSFDestroy(&pforest->pointAdaptToSelfSF));
406   PetscCall(PetscSFDestroy(&pforest->pointSelfToAdaptSF));
407   PetscCall(PetscFree(pforest->pointAdaptToSelfCids));
408   PetscCall(PetscFree(pforest->pointSelfToAdaptCids));
409   PetscCall(PetscFree(forest->data));
410   PetscFunctionReturn(PETSC_SUCCESS);
411 }
412 
413   #define DMForestTemplate_pforest _append_pforest(DMForestTemplate)
414 static PetscErrorCode DMForestTemplate_pforest(DM dm, DM tdm)
415 {
416   DM_Forest_pforest *pforest  = (DM_Forest_pforest *)((DM_Forest *)dm->data)->data;
417   DM_Forest_pforest *tpforest = (DM_Forest_pforest *)((DM_Forest *)tdm->data)->data;
418 
419   PetscFunctionBegin;
420   if (pforest->topo) pforest->topo->refct++;
421   PetscCall(DMFTopologyDestroy_pforest(&(tpforest->topo)));
422   tpforest->topo = pforest->topo;
423   PetscFunctionReturn(PETSC_SUCCESS);
424 }
425 
426   #define DMPlexCreateConnectivity_pforest _append_pforest(DMPlexCreateConnectivity)
427 static PetscErrorCode DMPlexCreateConnectivity_pforest(DM, p4est_connectivity_t **, PetscInt **);
428 
429 typedef struct _PforestAdaptCtx {
430   PetscInt  maxLevel;
431   PetscInt  minLevel;
432   PetscInt  currLevel;
433   PetscBool anyChange;
434 } PforestAdaptCtx;
435 
436 static int pforest_coarsen_currlevel(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrants[])
437 {
438   PforestAdaptCtx *ctx       = (PforestAdaptCtx *)p4est->user_pointer;
439   PetscInt         minLevel  = ctx->minLevel;
440   PetscInt         currLevel = ctx->currLevel;
441 
442   if (quadrants[0]->level <= minLevel) return 0;
443   return (int)((PetscInt)quadrants[0]->level == currLevel);
444 }
445 
446 static int pforest_coarsen_uniform(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrants[])
447 {
448   PforestAdaptCtx *ctx      = (PforestAdaptCtx *)p4est->user_pointer;
449   PetscInt         minLevel = ctx->minLevel;
450 
451   return (int)((PetscInt)quadrants[0]->level > minLevel);
452 }
453 
454 static int pforest_coarsen_flag_any(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrants[])
455 {
456   PetscInt         i;
457   PetscBool        any      = PETSC_FALSE;
458   PforestAdaptCtx *ctx      = (PforestAdaptCtx *)p4est->user_pointer;
459   PetscInt         minLevel = ctx->minLevel;
460 
461   if (quadrants[0]->level <= minLevel) return 0;
462   for (i = 0; i < P4EST_CHILDREN; i++) {
463     if (quadrants[i]->p.user_int == DM_ADAPT_KEEP) {
464       any = PETSC_FALSE;
465       break;
466     }
467     if (quadrants[i]->p.user_int == DM_ADAPT_COARSEN) {
468       any = PETSC_TRUE;
469       break;
470     }
471   }
472   return any ? 1 : 0;
473 }
474 
475 static int pforest_coarsen_flag_all(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrants[])
476 {
477   PetscInt         i;
478   PetscBool        all      = PETSC_TRUE;
479   PforestAdaptCtx *ctx      = (PforestAdaptCtx *)p4est->user_pointer;
480   PetscInt         minLevel = ctx->minLevel;
481 
482   if (quadrants[0]->level <= minLevel) return 0;
483   for (i = 0; i < P4EST_CHILDREN; i++) {
484     if (quadrants[i]->p.user_int != DM_ADAPT_COARSEN) {
485       all = PETSC_FALSE;
486       break;
487     }
488   }
489   return all ? 1 : 0;
490 }
491 
492 static void pforest_init_determine(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
493 {
494   quadrant->p.user_int = DM_ADAPT_DETERMINE;
495 }
496 
497 static int pforest_refine_uniform(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
498 {
499   PforestAdaptCtx *ctx      = (PforestAdaptCtx *)p4est->user_pointer;
500   PetscInt         maxLevel = ctx->maxLevel;
501 
502   return ((PetscInt)quadrant->level < maxLevel);
503 }
504 
505 static int pforest_refine_flag(p4est_t *p4est, p4est_topidx_t which_tree, p4est_quadrant_t *quadrant)
506 {
507   PforestAdaptCtx *ctx      = (PforestAdaptCtx *)p4est->user_pointer;
508   PetscInt         maxLevel = ctx->maxLevel;
509 
510   if ((PetscInt)quadrant->level >= maxLevel) return 0;
511 
512   return (quadrant->p.user_int == DM_ADAPT_REFINE);
513 }
514 
515 static PetscErrorCode DMPforestComputeLocalCellTransferSF_loop(p4est_t *p4estFrom, PetscInt FromOffset, p4est_t *p4estTo, PetscInt ToOffset, p4est_topidx_t flt, p4est_topidx_t llt, PetscInt *toFineLeavesCount, PetscInt *toLeaves, PetscSFNode *fromRoots, PetscInt *fromFineLeavesCount, PetscInt *fromLeaves, PetscSFNode *toRoots)
516 {
517   PetscMPIInt    rank = p4estFrom->mpirank;
518   p4est_topidx_t t;
519   PetscInt       toFineLeaves = 0, fromFineLeaves = 0;
520 
521   PetscFunctionBegin;
522   for (t = flt; t <= llt; t++) { /* count roots and leaves */
523     p4est_tree_t     *treeFrom  = &(((p4est_tree_t *)p4estFrom->trees->array)[t]);
524     p4est_tree_t     *treeTo    = &(((p4est_tree_t *)p4estTo->trees->array)[t]);
525     p4est_quadrant_t *firstFrom = &treeFrom->first_desc;
526     p4est_quadrant_t *firstTo   = &treeTo->first_desc;
527     PetscInt          numFrom   = (PetscInt)treeFrom->quadrants.elem_count;
528     PetscInt          numTo     = (PetscInt)treeTo->quadrants.elem_count;
529     p4est_quadrant_t *quadsFrom = (p4est_quadrant_t *)treeFrom->quadrants.array;
530     p4est_quadrant_t *quadsTo   = (p4est_quadrant_t *)treeTo->quadrants.array;
531     PetscInt          currentFrom, currentTo;
532     PetscInt          treeOffsetFrom = (PetscInt)treeFrom->quadrants_offset;
533     PetscInt          treeOffsetTo   = (PetscInt)treeTo->quadrants_offset;
534     int               comp;
535 
536     PetscCallP4estReturn(comp, p4est_quadrant_is_equal, (firstFrom, firstTo));
537     PetscCheck(comp, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "non-matching partitions");
538 
539     for (currentFrom = 0, currentTo = 0; currentFrom < numFrom && currentTo < numTo;) {
540       p4est_quadrant_t *quadFrom = &quadsFrom[currentFrom];
541       p4est_quadrant_t *quadTo   = &quadsTo[currentTo];
542 
543       if (quadFrom->level == quadTo->level) {
544         if (toLeaves) {
545           toLeaves[toFineLeaves]        = currentTo + treeOffsetTo + ToOffset;
546           fromRoots[toFineLeaves].rank  = rank;
547           fromRoots[toFineLeaves].index = currentFrom + treeOffsetFrom + FromOffset;
548         }
549         toFineLeaves++;
550         currentFrom++;
551         currentTo++;
552       } else {
553         int fromIsAncestor;
554 
555         PetscCallP4estReturn(fromIsAncestor, p4est_quadrant_is_ancestor, (quadFrom, quadTo));
556         if (fromIsAncestor) {
557           p4est_quadrant_t lastDesc;
558 
559           if (toLeaves) {
560             toLeaves[toFineLeaves]        = currentTo + treeOffsetTo + ToOffset;
561             fromRoots[toFineLeaves].rank  = rank;
562             fromRoots[toFineLeaves].index = currentFrom + treeOffsetFrom + FromOffset;
563           }
564           toFineLeaves++;
565           currentTo++;
566           PetscCallP4est(p4est_quadrant_last_descendant, (quadFrom, &lastDesc, quadTo->level));
567           PetscCallP4estReturn(comp, p4est_quadrant_is_equal, (quadTo, &lastDesc));
568           if (comp) currentFrom++;
569         } else {
570           p4est_quadrant_t lastDesc;
571 
572           if (fromLeaves) {
573             fromLeaves[fromFineLeaves]    = currentFrom + treeOffsetFrom + FromOffset;
574             toRoots[fromFineLeaves].rank  = rank;
575             toRoots[fromFineLeaves].index = currentTo + treeOffsetTo + ToOffset;
576           }
577           fromFineLeaves++;
578           currentFrom++;
579           PetscCallP4est(p4est_quadrant_last_descendant, (quadTo, &lastDesc, quadFrom->level));
580           PetscCallP4estReturn(comp, p4est_quadrant_is_equal, (quadFrom, &lastDesc));
581           if (comp) currentTo++;
582         }
583       }
584     }
585   }
586   *toFineLeavesCount   = toFineLeaves;
587   *fromFineLeavesCount = fromFineLeaves;
588   PetscFunctionReturn(PETSC_SUCCESS);
589 }
590 
591 /* Compute the maximum level across all the trees */
592 static PetscErrorCode DMPforestGetRefinementLevel(DM dm, PetscInt *lev)
593 {
594   p4est_topidx_t     t, flt, llt;
595   DM_Forest         *forest      = (DM_Forest *)dm->data;
596   DM_Forest_pforest *pforest     = (DM_Forest_pforest *)forest->data;
597   PetscInt           maxlevelloc = 0;
598   p4est_t           *p4est;
599 
600   PetscFunctionBegin;
601   PetscCheck(pforest, PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Missing DM_Forest_pforest");
602   PetscCheck(pforest->forest, PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Missing p4est_t");
603   p4est = pforest->forest;
604   flt   = p4est->first_local_tree;
605   llt   = p4est->last_local_tree;
606   for (t = flt; t <= llt; t++) {
607     p4est_tree_t *tree = &(((p4est_tree_t *)p4est->trees->array)[t]);
608     maxlevelloc        = PetscMax((PetscInt)tree->maxlevel, maxlevelloc);
609   }
610   PetscCall(MPIU_Allreduce(&maxlevelloc, lev, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)dm)));
611   PetscFunctionReturn(PETSC_SUCCESS);
612 }
613 
614 /* Puts identity in coarseToFine */
615 /* assumes a matching partition */
616 static PetscErrorCode DMPforestComputeLocalCellTransferSF(MPI_Comm comm, p4est_t *p4estFrom, PetscInt FromOffset, p4est_t *p4estTo, PetscInt ToOffset, PetscSF *fromCoarseToFine, PetscSF *toCoarseFromFine)
617 {
618   p4est_topidx_t flt, llt;
619   PetscSF        fromCoarse, toCoarse;
620   PetscInt       numRootsFrom, numRootsTo, numLeavesFrom, numLeavesTo;
621   PetscInt      *fromLeaves = NULL, *toLeaves = NULL;
622   PetscSFNode   *fromRoots = NULL, *toRoots = NULL;
623 
624   PetscFunctionBegin;
625   flt = p4estFrom->first_local_tree;
626   llt = p4estFrom->last_local_tree;
627   PetscCall(PetscSFCreate(comm, &fromCoarse));
628   if (toCoarseFromFine) PetscCall(PetscSFCreate(comm, &toCoarse));
629   numRootsFrom = p4estFrom->local_num_quadrants + FromOffset;
630   numRootsTo   = p4estTo->local_num_quadrants + ToOffset;
631   PetscCall(DMPforestComputeLocalCellTransferSF_loop(p4estFrom, FromOffset, p4estTo, ToOffset, flt, llt, &numLeavesTo, NULL, NULL, &numLeavesFrom, NULL, NULL));
632   PetscCall(PetscMalloc1(numLeavesTo, &toLeaves));
633   PetscCall(PetscMalloc1(numLeavesTo, &fromRoots));
634   if (toCoarseFromFine) {
635     PetscCall(PetscMalloc1(numLeavesFrom, &fromLeaves));
636     PetscCall(PetscMalloc1(numLeavesFrom, &fromRoots));
637   }
638   PetscCall(DMPforestComputeLocalCellTransferSF_loop(p4estFrom, FromOffset, p4estTo, ToOffset, flt, llt, &numLeavesTo, toLeaves, fromRoots, &numLeavesFrom, fromLeaves, toRoots));
639   if (!ToOffset && (numLeavesTo == numRootsTo)) { /* compress */
640     PetscCall(PetscFree(toLeaves));
641     PetscCall(PetscSFSetGraph(fromCoarse, numRootsFrom, numLeavesTo, NULL, PETSC_OWN_POINTER, fromRoots, PETSC_OWN_POINTER));
642   } else PetscCall(PetscSFSetGraph(fromCoarse, numRootsFrom, numLeavesTo, toLeaves, PETSC_OWN_POINTER, fromRoots, PETSC_OWN_POINTER));
643   *fromCoarseToFine = fromCoarse;
644   if (toCoarseFromFine) {
645     PetscCall(PetscSFSetGraph(toCoarse, numRootsTo, numLeavesFrom, fromLeaves, PETSC_OWN_POINTER, toRoots, PETSC_OWN_POINTER));
646     *toCoarseFromFine = toCoarse;
647   }
648   PetscFunctionReturn(PETSC_SUCCESS);
649 }
650 
651 /* range of processes whose B sections overlap this ranks A section */
652 static PetscErrorCode DMPforestComputeOverlappingRanks(PetscMPIInt size, PetscMPIInt rank, p4est_t *p4estA, p4est_t *p4estB, PetscInt *startB, PetscInt *endB)
653 {
654   p4est_quadrant_t *myCoarseStart = &(p4estA->global_first_position[rank]);
655   p4est_quadrant_t *myCoarseEnd   = &(p4estA->global_first_position[rank + 1]);
656   p4est_quadrant_t *globalFirstB  = p4estB->global_first_position;
657 
658   PetscFunctionBegin;
659   *startB = -1;
660   *endB   = -1;
661   if (p4estA->local_num_quadrants) {
662     PetscInt lo, hi, guess;
663     /* binary search to find interval containing myCoarseStart */
664     lo    = 0;
665     hi    = size;
666     guess = rank;
667     while (1) {
668       int startCompMy, myCompEnd;
669 
670       PetscCallP4estReturn(startCompMy, p4est_quadrant_compare_piggy, (&globalFirstB[guess], myCoarseStart));
671       PetscCallP4estReturn(myCompEnd, p4est_quadrant_compare_piggy, (myCoarseStart, &globalFirstB[guess + 1]));
672       if (startCompMy <= 0 && myCompEnd < 0) {
673         *startB = guess;
674         break;
675       } else if (startCompMy > 0) { /* guess is to high */
676         hi = guess;
677       } else { /* guess is to low */
678         lo = guess + 1;
679       }
680       guess = lo + (hi - lo) / 2;
681     }
682     /* reset bounds, but not guess */
683     lo = 0;
684     hi = size;
685     while (1) {
686       int startCompMy, myCompEnd;
687 
688       PetscCallP4estReturn(startCompMy, p4est_quadrant_compare_piggy, (&globalFirstB[guess], myCoarseEnd));
689       PetscCallP4estReturn(myCompEnd, p4est_quadrant_compare_piggy, (myCoarseEnd, &globalFirstB[guess + 1]));
690       if (startCompMy < 0 && myCompEnd <= 0) { /* notice that the comparison operators are different from above */
691         *endB = guess + 1;
692         break;
693       } else if (startCompMy >= 0) { /* guess is to high */
694         hi = guess;
695       } else { /* guess is to low */
696         lo = guess + 1;
697       }
698       guess = lo + (hi - lo) / 2;
699     }
700   }
701   PetscFunctionReturn(PETSC_SUCCESS);
702 }
703 
704 static PetscErrorCode DMPforestGetPlex(DM, DM *);
705 
706   #define DMSetUp_pforest _append_pforest(DMSetUp)
707 static PetscErrorCode DMSetUp_pforest(DM dm)
708 {
709   DM_Forest         *forest  = (DM_Forest *)dm->data;
710   DM_Forest_pforest *pforest = (DM_Forest_pforest *)forest->data;
711   DM                 base, adaptFrom;
712   DMForestTopology   topoName;
713   PetscSF            preCoarseToFine = NULL, coarseToPreFine = NULL;
714   PforestAdaptCtx    ctx;
715 
716   PetscFunctionBegin;
717   ctx.minLevel  = PETSC_MAX_INT;
718   ctx.maxLevel  = 0;
719   ctx.currLevel = 0;
720   ctx.anyChange = PETSC_FALSE;
721   /* sanity check */
722   PetscCall(DMForestGetAdaptivityForest(dm, &adaptFrom));
723   PetscCall(DMForestGetBaseDM(dm, &base));
724   PetscCall(DMForestGetTopology(dm, &topoName));
725   PetscCheck(adaptFrom || base || topoName, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "A forest needs a topology, a base DM, or a DM to adapt from");
726 
727   /* === Step 1: DMFTopology === */
728   if (adaptFrom) { /* reference already created topology */
729     PetscBool          ispforest;
730     DM_Forest         *aforest  = (DM_Forest *)adaptFrom->data;
731     DM_Forest_pforest *apforest = (DM_Forest_pforest *)aforest->data;
732 
733     PetscCall(PetscObjectTypeCompare((PetscObject)adaptFrom, DMPFOREST, &ispforest));
734     PetscCheck(ispforest, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_NOTSAMETYPE, "Trying to adapt from %s, which is not %s", ((PetscObject)adaptFrom)->type_name, DMPFOREST);
735     PetscCheck(apforest->topo, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "The pre-adaptation forest must have a topology");
736     PetscCall(DMSetUp(adaptFrom));
737     PetscCall(DMForestGetBaseDM(dm, &base));
738     PetscCall(DMForestGetTopology(dm, &topoName));
739   } else if (base) { /* construct a connectivity from base */
740     PetscBool isPlex, isDA;
741 
742     PetscCall(PetscObjectGetName((PetscObject)base, &topoName));
743     PetscCall(DMForestSetTopology(dm, topoName));
744     PetscCall(PetscObjectTypeCompare((PetscObject)base, DMPLEX, &isPlex));
745     PetscCall(PetscObjectTypeCompare((PetscObject)base, DMDA, &isDA));
746     if (isPlex) {
747       MPI_Comm              comm = PetscObjectComm((PetscObject)dm);
748       PetscInt              depth;
749       PetscMPIInt           size;
750       p4est_connectivity_t *conn = NULL;
751       DMFTopology_pforest  *topo;
752       PetscInt             *tree_face_to_uniq = NULL;
753 
754       PetscCall(DMPlexGetDepth(base, &depth));
755       if (depth == 1) {
756         DM connDM;
757 
758         PetscCall(DMPlexInterpolate(base, &connDM));
759         base = connDM;
760         PetscCall(DMForestSetBaseDM(dm, base));
761         PetscCall(DMDestroy(&connDM));
762       } else PetscCheck(depth == P4EST_DIM, comm, PETSC_ERR_ARG_WRONG, "Base plex is neither interpolated nor uninterpolated? depth %" PetscInt_FMT ", expected 2 or %d", depth, P4EST_DIM + 1);
763       PetscCallMPI(MPI_Comm_size(comm, &size));
764       if (size > 1) {
765         DM      dmRedundant;
766         PetscSF sf;
767 
768         PetscCall(DMPlexGetRedundantDM(base, &sf, &dmRedundant));
769         PetscCheck(dmRedundant, comm, PETSC_ERR_PLIB, "Could not create redundant DM");
770         PetscCall(PetscObjectCompose((PetscObject)dmRedundant, "_base_migration_sf", (PetscObject)sf));
771         PetscCall(PetscSFDestroy(&sf));
772         base = dmRedundant;
773         PetscCall(DMForestSetBaseDM(dm, base));
774         PetscCall(DMDestroy(&dmRedundant));
775       }
776       PetscCall(DMViewFromOptions(base, NULL, "-dm_p4est_base_view"));
777       PetscCall(DMPlexCreateConnectivity_pforest(base, &conn, &tree_face_to_uniq));
778       PetscCall(PetscNew(&topo));
779       topo->refct = 1;
780       topo->conn  = conn;
781       topo->geom  = NULL;
782       {
783         PetscErrorCode (*map)(DM, PetscInt, PetscInt, const PetscReal[], PetscReal[], void *);
784         void *mapCtx;
785 
786         PetscCall(DMForestGetBaseCoordinateMapping(dm, &map, &mapCtx));
787         if (map) {
788           DM_Forest_geometry_pforest *geom_pforest;
789           p4est_geometry_t           *geom;
790 
791           PetscCall(PetscNew(&geom_pforest));
792           PetscCall(DMGetCoordinateDim(dm, &geom_pforest->coordDim));
793           geom_pforest->map    = map;
794           geom_pforest->mapCtx = mapCtx;
795           PetscCallP4estReturn(geom_pforest->inner, p4est_geometry_new_connectivity, (conn));
796           PetscCall(PetscNew(&geom));
797           geom->name    = topoName;
798           geom->user    = geom_pforest;
799           geom->X       = GeometryMapping_pforest;
800           geom->destroy = GeometryDestroy_pforest;
801           topo->geom    = geom;
802         }
803       }
804       topo->tree_face_to_uniq = tree_face_to_uniq;
805       pforest->topo           = topo;
806     } else PetscCheck(!isDA, PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Not implemented yet");
807   #if 0
808       PetscInt N[3], P[3];
809 
810       /* get the sizes, periodicities */
811       /* ... */
812                                                                   /* don't use Morton order */
813       PetscCall(DMFTopologyCreateBrick_pforest(dm,N,P,&pforest->topo,PETSC_FALSE));
814   #endif
815     {
816       PetscInt numLabels, l;
817 
818       PetscCall(DMGetNumLabels(base, &numLabels));
819       for (l = 0; l < numLabels; l++) {
820         PetscBool   isDepth, isGhost, isVTK, isDim, isCellType;
821         DMLabel     label, labelNew;
822         PetscInt    defVal;
823         const char *name;
824 
825         PetscCall(DMGetLabelName(base, l, &name));
826         PetscCall(DMGetLabelByNum(base, l, &label));
827         PetscCall(PetscStrcmp(name, "depth", &isDepth));
828         if (isDepth) continue;
829         PetscCall(PetscStrcmp(name, "dim", &isDim));
830         if (isDim) continue;
831         PetscCall(PetscStrcmp(name, "celltype", &isCellType));
832         if (isCellType) continue;
833         PetscCall(PetscStrcmp(name, "ghost", &isGhost));
834         if (isGhost) continue;
835         PetscCall(PetscStrcmp(name, "vtk", &isVTK));
836         if (isVTK) continue;
837         PetscCall(DMCreateLabel(dm, name));
838         PetscCall(DMGetLabel(dm, name, &labelNew));
839         PetscCall(DMLabelGetDefaultValue(label, &defVal));
840         PetscCall(DMLabelSetDefaultValue(labelNew, defVal));
841       }
842       /* map dm points (internal plex) to base
843          we currently create the subpoint_map for the entire hierarchy, starting from the finest forest
844          and propagating back to the coarsest
845          This is not an optimal approach, since we need the map only on the coarsest level
846          during DMForestTransferVecFromBase */
847       PetscCall(DMForestGetMinimumRefinement(dm, &l));
848       if (!l) PetscCall(DMCreateLabel(dm, "_forest_base_subpoint_map"));
849     }
850   } else { /* construct from topology name */
851     DMFTopology_pforest *topo;
852 
853     PetscCall(DMFTopologyCreate_pforest(dm, topoName, &topo));
854     pforest->topo = topo;
855     /* TODO: construct base? */
856   }
857 
858   /* === Step 2: get the leaves of the forest === */
859   if (adaptFrom) { /* start with the old forest */
860     DMLabel            adaptLabel;
861     PetscInt           defaultValue;
862     PetscInt           numValues, numValuesGlobal, cLocalStart, count;
863     DM_Forest         *aforest  = (DM_Forest *)adaptFrom->data;
864     DM_Forest_pforest *apforest = (DM_Forest_pforest *)aforest->data;
865     PetscBool          computeAdaptSF;
866     p4est_topidx_t     flt, llt, t;
867 
868     flt         = apforest->forest->first_local_tree;
869     llt         = apforest->forest->last_local_tree;
870     cLocalStart = apforest->cLocalStart;
871     PetscCall(DMForestGetComputeAdaptivitySF(dm, &computeAdaptSF));
872     PetscCallP4estReturn(pforest->forest, p4est_copy, (apforest->forest, 0)); /* 0 indicates no data copying */
873     PetscCall(DMForestGetAdaptivityLabel(dm, &adaptLabel));
874     if (adaptLabel) {
875       /* apply the refinement/coarsening by flags, plus minimum/maximum refinement */
876       PetscCall(DMLabelGetNumValues(adaptLabel, &numValues));
877       PetscCall(MPIU_Allreduce(&numValues, &numValuesGlobal, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)adaptFrom)));
878       PetscCall(DMLabelGetDefaultValue(adaptLabel, &defaultValue));
879       if (!numValuesGlobal && defaultValue == DM_ADAPT_COARSEN_LAST) { /* uniform coarsen of the last level only (equivalent to DM_ADAPT_COARSEN for conforming grids)  */
880         PetscCall(DMForestGetMinimumRefinement(dm, &ctx.minLevel));
881         PetscCall(DMPforestGetRefinementLevel(dm, &ctx.currLevel));
882         pforest->forest->user_pointer = (void *)&ctx;
883         PetscCallP4est(p4est_coarsen, (pforest->forest, 0, pforest_coarsen_currlevel, NULL));
884         pforest->forest->user_pointer = (void *)dm;
885         PetscCallP4est(p4est_balance, (pforest->forest, P4EST_CONNECT_FULL, NULL));
886         /* we will have to change the offset after we compute the overlap */
887         if (computeAdaptSF) PetscCall(DMPforestComputeLocalCellTransferSF(PetscObjectComm((PetscObject)dm), pforest->forest, 0, apforest->forest, apforest->cLocalStart, &coarseToPreFine, NULL));
888       } else if (!numValuesGlobal && defaultValue == DM_ADAPT_COARSEN) { /* uniform coarsen */
889         PetscCall(DMForestGetMinimumRefinement(dm, &ctx.minLevel));
890         pforest->forest->user_pointer = (void *)&ctx;
891         PetscCallP4est(p4est_coarsen, (pforest->forest, 0, pforest_coarsen_uniform, NULL));
892         pforest->forest->user_pointer = (void *)dm;
893         PetscCallP4est(p4est_balance, (pforest->forest, P4EST_CONNECT_FULL, NULL));
894         /* we will have to change the offset after we compute the overlap */
895         if (computeAdaptSF) PetscCall(DMPforestComputeLocalCellTransferSF(PetscObjectComm((PetscObject)dm), pforest->forest, 0, apforest->forest, apforest->cLocalStart, &coarseToPreFine, NULL));
896       } else if (!numValuesGlobal && defaultValue == DM_ADAPT_REFINE) { /* uniform refine */
897         PetscCall(DMForestGetMaximumRefinement(dm, &ctx.maxLevel));
898         pforest->forest->user_pointer = (void *)&ctx;
899         PetscCallP4est(p4est_refine, (pforest->forest, 0, pforest_refine_uniform, NULL));
900         pforest->forest->user_pointer = (void *)dm;
901         PetscCallP4est(p4est_balance, (pforest->forest, P4EST_CONNECT_FULL, NULL));
902         /* we will have to change the offset after we compute the overlap */
903         if (computeAdaptSF) PetscCall(DMPforestComputeLocalCellTransferSF(PetscObjectComm((PetscObject)dm), apforest->forest, apforest->cLocalStart, pforest->forest, 0, &preCoarseToFine, NULL));
904       } else if (numValuesGlobal) {
905         p4est_t                   *p4est = pforest->forest;
906         PetscInt                  *cellFlags;
907         DMForestAdaptivityStrategy strategy;
908         PetscSF                    cellSF;
909         PetscInt                   c, cStart, cEnd;
910         PetscBool                  adaptAny;
911 
912         PetscCall(DMForestGetMaximumRefinement(dm, &ctx.maxLevel));
913         PetscCall(DMForestGetMinimumRefinement(dm, &ctx.minLevel));
914         PetscCall(DMForestGetAdaptivityStrategy(dm, &strategy));
915         PetscCall(PetscStrncmp(strategy, "any", 3, &adaptAny));
916         PetscCall(DMForestGetCellChart(adaptFrom, &cStart, &cEnd));
917         PetscCall(DMForestGetCellSF(adaptFrom, &cellSF));
918         PetscCall(PetscMalloc1(cEnd - cStart, &cellFlags));
919         for (c = cStart; c < cEnd; c++) PetscCall(DMLabelGetValue(adaptLabel, c, &cellFlags[c - cStart]));
920         if (cellSF) {
921           if (adaptAny) {
922             PetscCall(PetscSFReduceBegin(cellSF, MPIU_INT, cellFlags, cellFlags, MPI_MAX));
923             PetscCall(PetscSFReduceEnd(cellSF, MPIU_INT, cellFlags, cellFlags, MPI_MAX));
924           } else {
925             PetscCall(PetscSFReduceBegin(cellSF, MPIU_INT, cellFlags, cellFlags, MPI_MIN));
926             PetscCall(PetscSFReduceEnd(cellSF, MPIU_INT, cellFlags, cellFlags, MPI_MIN));
927           }
928         }
929         for (t = flt, count = cLocalStart; t <= llt; t++) {
930           p4est_tree_t     *tree     = &(((p4est_tree_t *)p4est->trees->array)[t]);
931           PetscInt          numQuads = (PetscInt)tree->quadrants.elem_count, i;
932           p4est_quadrant_t *quads    = (p4est_quadrant_t *)tree->quadrants.array;
933 
934           for (i = 0; i < numQuads; i++) {
935             p4est_quadrant_t *q = &quads[i];
936             q->p.user_int       = cellFlags[count++];
937           }
938         }
939         PetscCall(PetscFree(cellFlags));
940 
941         pforest->forest->user_pointer = (void *)&ctx;
942         if (adaptAny) PetscCallP4est(p4est_coarsen, (pforest->forest, 0, pforest_coarsen_flag_any, pforest_init_determine));
943         else PetscCallP4est(p4est_coarsen, (pforest->forest, 0, pforest_coarsen_flag_all, pforest_init_determine));
944         PetscCallP4est(p4est_refine, (pforest->forest, 0, pforest_refine_flag, NULL));
945         pforest->forest->user_pointer = (void *)dm;
946         PetscCallP4est(p4est_balance, (pforest->forest, P4EST_CONNECT_FULL, NULL));
947         if (computeAdaptSF) PetscCall(DMPforestComputeLocalCellTransferSF(PetscObjectComm((PetscObject)dm), apforest->forest, apforest->cLocalStart, pforest->forest, 0, &preCoarseToFine, &coarseToPreFine));
948       }
949       for (t = flt, count = cLocalStart; t <= llt; t++) {
950         p4est_tree_t     *atree     = &(((p4est_tree_t *)apforest->forest->trees->array)[t]);
951         p4est_tree_t     *tree      = &(((p4est_tree_t *)pforest->forest->trees->array)[t]);
952         PetscInt          anumQuads = (PetscInt)atree->quadrants.elem_count, i;
953         PetscInt          numQuads  = (PetscInt)tree->quadrants.elem_count;
954         p4est_quadrant_t *aquads    = (p4est_quadrant_t *)atree->quadrants.array;
955         p4est_quadrant_t *quads     = (p4est_quadrant_t *)tree->quadrants.array;
956 
957         if (anumQuads != numQuads) {
958           ctx.anyChange = PETSC_TRUE;
959         } else {
960           for (i = 0; i < numQuads; i++) {
961             p4est_quadrant_t *aq = &aquads[i];
962             p4est_quadrant_t *q  = &quads[i];
963 
964             if (aq->level != q->level) {
965               ctx.anyChange = PETSC_TRUE;
966               break;
967             }
968           }
969         }
970         if (ctx.anyChange) break;
971       }
972     }
973     {
974       PetscInt numLabels, l;
975 
976       PetscCall(DMGetNumLabels(adaptFrom, &numLabels));
977       for (l = 0; l < numLabels; l++) {
978         PetscBool   isDepth, isCellType, isGhost, isVTK;
979         DMLabel     label, labelNew;
980         PetscInt    defVal;
981         const char *name;
982 
983         PetscCall(DMGetLabelName(adaptFrom, l, &name));
984         PetscCall(DMGetLabelByNum(adaptFrom, l, &label));
985         PetscCall(PetscStrcmp(name, "depth", &isDepth));
986         if (isDepth) continue;
987         PetscCall(PetscStrcmp(name, "celltype", &isCellType));
988         if (isCellType) continue;
989         PetscCall(PetscStrcmp(name, "ghost", &isGhost));
990         if (isGhost) continue;
991         PetscCall(PetscStrcmp(name, "vtk", &isVTK));
992         if (isVTK) continue;
993         PetscCall(DMCreateLabel(dm, name));
994         PetscCall(DMGetLabel(dm, name, &labelNew));
995         PetscCall(DMLabelGetDefaultValue(label, &defVal));
996         PetscCall(DMLabelSetDefaultValue(labelNew, defVal));
997       }
998     }
999   } else { /* initial */
1000     PetscInt initLevel, minLevel;
1001   #if defined(PETSC_HAVE_MPIUNI)
1002     sc_MPI_Comm comm = sc_MPI_COMM_WORLD;
1003   #else
1004     MPI_Comm comm = PetscObjectComm((PetscObject)dm);
1005   #endif
1006 
1007     PetscCall(DMForestGetInitialRefinement(dm, &initLevel));
1008     PetscCall(DMForestGetMinimumRefinement(dm, &minLevel));
1009     PetscCallP4estReturn(pforest->forest, p4est_new_ext,
1010                          (comm, pforest->topo->conn, 0, /* minimum number of quadrants per processor */
1011                           initLevel,                    /* level of refinement */
1012                           1,                            /* uniform refinement */
1013                           0,                            /* we don't allocate any per quadrant data */
1014                           NULL,                         /* there is no special quadrant initialization */
1015                           (void *)dm));                 /* this dm is the user context */
1016 
1017     if (initLevel > minLevel) pforest->coarsen_hierarchy = PETSC_TRUE;
1018     if (dm->setfromoptionscalled) {
1019       PetscBool   flgPattern, flgFractal;
1020       PetscInt    corner = 0;
1021       PetscInt    corners[P4EST_CHILDREN], ncorner = P4EST_CHILDREN;
1022       PetscReal   likelihood = 1. / P4EST_DIM;
1023       PetscInt    pattern;
1024       const char *prefix;
1025 
1026       PetscCall(PetscObjectGetOptionsPrefix((PetscObject)dm, &prefix));
1027       PetscCall(PetscOptionsGetEList(((PetscObject)dm)->options, prefix, "-dm_p4est_refine_pattern", DMRefinePatternName, PATTERN_COUNT, &pattern, &flgPattern));
1028       PetscCall(PetscOptionsGetInt(((PetscObject)dm)->options, prefix, "-dm_p4est_refine_corner", &corner, NULL));
1029       PetscCall(PetscOptionsGetIntArray(((PetscObject)dm)->options, prefix, "-dm_p4est_refine_fractal_corners", corners, &ncorner, &flgFractal));
1030       PetscCall(PetscOptionsGetReal(((PetscObject)dm)->options, prefix, "-dm_p4est_refine_hash_likelihood", &likelihood, NULL));
1031 
1032       if (flgPattern) {
1033         DMRefinePatternCtx *ctx;
1034         PetscInt            maxLevel;
1035 
1036         PetscCall(DMForestGetMaximumRefinement(dm, &maxLevel));
1037         PetscCall(PetscNew(&ctx));
1038         ctx->maxLevel = PetscMin(maxLevel, P4EST_QMAXLEVEL);
1039         if (initLevel + ctx->maxLevel > minLevel) pforest->coarsen_hierarchy = PETSC_TRUE;
1040         switch (pattern) {
1041         case PATTERN_HASH:
1042           ctx->refine_fn      = DMRefinePattern_Hash;
1043           ctx->hashLikelihood = likelihood;
1044           break;
1045         case PATTERN_CORNER:
1046           ctx->corner    = corner;
1047           ctx->refine_fn = DMRefinePattern_Corner;
1048           break;
1049         case PATTERN_CENTER:
1050           ctx->refine_fn = DMRefinePattern_Center;
1051           break;
1052         case PATTERN_FRACTAL:
1053           if (flgFractal) {
1054             PetscInt i;
1055 
1056             for (i = 0; i < ncorner; i++) ctx->fractal[corners[i]] = PETSC_TRUE;
1057           } else {
1058   #if !defined(P4_TO_P8)
1059             ctx->fractal[0] = ctx->fractal[1] = ctx->fractal[2] = PETSC_TRUE;
1060   #else
1061             ctx->fractal[0] = ctx->fractal[3] = ctx->fractal[5] = ctx->fractal[6] = PETSC_TRUE;
1062   #endif
1063           }
1064           ctx->refine_fn = DMRefinePattern_Fractal;
1065           break;
1066         default:
1067           SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Not a valid refinement pattern");
1068         }
1069 
1070         pforest->forest->user_pointer = (void *)ctx;
1071         PetscCallP4est(p4est_refine, (pforest->forest, 1, ctx->refine_fn, NULL));
1072         PetscCallP4est(p4est_balance, (pforest->forest, P4EST_CONNECT_FULL, NULL));
1073         PetscCall(PetscFree(ctx));
1074         pforest->forest->user_pointer = (void *)dm;
1075       }
1076     }
1077   }
1078   if (pforest->coarsen_hierarchy) {
1079     PetscInt initLevel, currLevel, minLevel;
1080 
1081     PetscCall(DMPforestGetRefinementLevel(dm, &currLevel));
1082     PetscCall(DMForestGetInitialRefinement(dm, &initLevel));
1083     PetscCall(DMForestGetMinimumRefinement(dm, &minLevel));
1084     if (currLevel > minLevel) {
1085       DM_Forest_pforest *coarse_pforest;
1086       DMLabel            coarsen;
1087       DM                 coarseDM;
1088 
1089       PetscCall(DMForestTemplate(dm, MPI_COMM_NULL, &coarseDM));
1090       PetscCall(DMForestSetAdaptivityPurpose(coarseDM, DM_ADAPT_COARSEN));
1091       PetscCall(DMLabelCreate(PETSC_COMM_SELF, "coarsen", &coarsen));
1092       PetscCall(DMLabelSetDefaultValue(coarsen, DM_ADAPT_COARSEN));
1093       PetscCall(DMForestSetAdaptivityLabel(coarseDM, coarsen));
1094       PetscCall(DMLabelDestroy(&coarsen));
1095       PetscCall(DMSetCoarseDM(dm, coarseDM));
1096       PetscCall(PetscObjectDereference((PetscObject)coarseDM));
1097       initLevel = currLevel == initLevel ? initLevel - 1 : initLevel;
1098       PetscCall(DMForestSetInitialRefinement(coarseDM, initLevel));
1099       PetscCall(DMForestSetMinimumRefinement(coarseDM, minLevel));
1100       coarse_pforest                    = (DM_Forest_pforest *)((DM_Forest *)coarseDM->data)->data;
1101       coarse_pforest->coarsen_hierarchy = PETSC_TRUE;
1102     }
1103   }
1104 
1105   { /* repartitioning and overlap */
1106     PetscMPIInt size, rank;
1107 
1108     PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)dm), &size));
1109     PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank));
1110     if ((size > 1) && (pforest->partition_for_coarsening || forest->cellWeights || forest->weightCapacity != 1. || forest->weightsFactor != 1.)) {
1111       PetscBool      copyForest  = PETSC_FALSE;
1112       p4est_t       *forest_copy = NULL;
1113       p4est_gloidx_t shipped     = 0;
1114 
1115       if (preCoarseToFine || coarseToPreFine) copyForest = PETSC_TRUE;
1116       if (copyForest) PetscCallP4estReturn(forest_copy, p4est_copy, (pforest->forest, 0));
1117 
1118       if (!forest->cellWeights && forest->weightCapacity == 1. && forest->weightsFactor == 1.) {
1119         PetscCallP4estReturn(shipped, p4est_partition_ext, (pforest->forest, (int)pforest->partition_for_coarsening, NULL));
1120       } else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "Non-uniform partition cases not implemented yet");
1121       if (shipped) ctx.anyChange = PETSC_TRUE;
1122       if (forest_copy) {
1123         if (preCoarseToFine || coarseToPreFine) {
1124           PetscSF        repartSF; /* repartSF has roots in the old partition */
1125           PetscInt       pStart = -1, pEnd = -1, p;
1126           PetscInt       numRoots, numLeaves;
1127           PetscSFNode   *repartRoots;
1128           p4est_gloidx_t postStart  = pforest->forest->global_first_quadrant[rank];
1129           p4est_gloidx_t postEnd    = pforest->forest->global_first_quadrant[rank + 1];
1130           p4est_gloidx_t partOffset = postStart;
1131 
1132           numRoots  = (PetscInt)(forest_copy->global_first_quadrant[rank + 1] - forest_copy->global_first_quadrant[rank]);
1133           numLeaves = (PetscInt)(postEnd - postStart);
1134           PetscCall(DMPforestComputeOverlappingRanks(size, rank, pforest->forest, forest_copy, &pStart, &pEnd));
1135           PetscCall(PetscMalloc1((PetscInt)pforest->forest->local_num_quadrants, &repartRoots));
1136           for (p = pStart; p < pEnd; p++) {
1137             p4est_gloidx_t preStart = forest_copy->global_first_quadrant[p];
1138             p4est_gloidx_t preEnd   = forest_copy->global_first_quadrant[p + 1];
1139             PetscInt       q;
1140 
1141             if (preEnd == preStart) continue;
1142             PetscCheck(preStart <= postStart, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Bad partition overlap computation");
1143             preEnd = preEnd > postEnd ? postEnd : preEnd;
1144             for (q = partOffset; q < preEnd; q++) {
1145               repartRoots[q - postStart].rank  = p;
1146               repartRoots[q - postStart].index = partOffset - preStart;
1147             }
1148             partOffset = preEnd;
1149           }
1150           PetscCall(PetscSFCreate(PetscObjectComm((PetscObject)dm), &repartSF));
1151           PetscCall(PetscSFSetGraph(repartSF, numRoots, numLeaves, NULL, PETSC_OWN_POINTER, repartRoots, PETSC_OWN_POINTER));
1152           PetscCall(PetscSFSetUp(repartSF));
1153           if (preCoarseToFine) {
1154             PetscSF         repartSFembed, preCoarseToFineNew;
1155             PetscInt        nleaves;
1156             const PetscInt *leaves;
1157 
1158             PetscCall(PetscSFSetUp(preCoarseToFine));
1159             PetscCall(PetscSFGetGraph(preCoarseToFine, NULL, &nleaves, &leaves, NULL));
1160             if (leaves) {
1161               PetscCall(PetscSFCreateEmbeddedRootSF(repartSF, nleaves, leaves, &repartSFembed));
1162             } else {
1163               repartSFembed = repartSF;
1164               PetscCall(PetscObjectReference((PetscObject)repartSFembed));
1165             }
1166             PetscCall(PetscSFCompose(preCoarseToFine, repartSFembed, &preCoarseToFineNew));
1167             PetscCall(PetscSFDestroy(&preCoarseToFine));
1168             PetscCall(PetscSFDestroy(&repartSFembed));
1169             preCoarseToFine = preCoarseToFineNew;
1170           }
1171           if (coarseToPreFine) {
1172             PetscSF repartSFinv, coarseToPreFineNew;
1173 
1174             PetscCall(PetscSFCreateInverseSF(repartSF, &repartSFinv));
1175             PetscCall(PetscSFCompose(repartSFinv, coarseToPreFine, &coarseToPreFineNew));
1176             PetscCall(PetscSFDestroy(&coarseToPreFine));
1177             PetscCall(PetscSFDestroy(&repartSFinv));
1178             coarseToPreFine = coarseToPreFineNew;
1179           }
1180           PetscCall(PetscSFDestroy(&repartSF));
1181         }
1182         PetscCallP4est(p4est_destroy, (forest_copy));
1183       }
1184     }
1185     if (size > 1) {
1186       PetscInt overlap;
1187 
1188       PetscCall(DMForestGetPartitionOverlap(dm, &overlap));
1189 
1190       if (adaptFrom) {
1191         PetscInt aoverlap;
1192 
1193         PetscCall(DMForestGetPartitionOverlap(adaptFrom, &aoverlap));
1194         if (aoverlap != overlap) ctx.anyChange = PETSC_TRUE;
1195       }
1196 
1197       if (overlap > 0) {
1198         PetscInt i, cLocalStart;
1199         PetscInt cEnd;
1200         PetscSF  preCellSF = NULL, cellSF = NULL;
1201 
1202         PetscCallP4estReturn(pforest->ghost, p4est_ghost_new, (pforest->forest, P4EST_CONNECT_FULL));
1203         PetscCallP4estReturn(pforest->lnodes, p4est_lnodes_new, (pforest->forest, pforest->ghost, -P4EST_DIM));
1204         PetscCallP4est(p4est_ghost_support_lnodes, (pforest->forest, pforest->lnodes, pforest->ghost));
1205         for (i = 1; i < overlap; i++) PetscCallP4est(p4est_ghost_expand_by_lnodes, (pforest->forest, pforest->lnodes, pforest->ghost));
1206 
1207         cLocalStart = pforest->cLocalStart = pforest->ghost->proc_offsets[rank];
1208         cEnd                               = pforest->forest->local_num_quadrants + pforest->ghost->proc_offsets[size];
1209 
1210         /* shift sfs by cLocalStart, expand by cell SFs */
1211         if (preCoarseToFine || coarseToPreFine) {
1212           if (adaptFrom) PetscCall(DMForestGetCellSF(adaptFrom, &preCellSF));
1213           dm->setupcalled = PETSC_TRUE;
1214           PetscCall(DMForestGetCellSF(dm, &cellSF));
1215         }
1216         if (preCoarseToFine) {
1217           PetscSF            preCoarseToFineNew;
1218           PetscInt           nleaves, nroots, *leavesNew, i, nleavesNew;
1219           const PetscInt    *leaves;
1220           const PetscSFNode *remotes;
1221           PetscSFNode       *remotesAll;
1222 
1223           PetscCall(PetscSFSetUp(preCoarseToFine));
1224           PetscCall(PetscSFGetGraph(preCoarseToFine, &nroots, &nleaves, &leaves, &remotes));
1225           PetscCall(PetscMalloc1(cEnd, &remotesAll));
1226           for (i = 0; i < cEnd; i++) {
1227             remotesAll[i].rank  = -1;
1228             remotesAll[i].index = -1;
1229           }
1230           for (i = 0; i < nleaves; i++) remotesAll[(leaves ? leaves[i] : i) + cLocalStart] = remotes[i];
1231           PetscCall(PetscSFSetUp(cellSF));
1232           PetscCall(PetscSFBcastBegin(cellSF, MPIU_2INT, remotesAll, remotesAll, MPI_REPLACE));
1233           PetscCall(PetscSFBcastEnd(cellSF, MPIU_2INT, remotesAll, remotesAll, MPI_REPLACE));
1234           nleavesNew = 0;
1235           for (i = 0; i < nleaves; i++) {
1236             if (remotesAll[i].rank >= 0) nleavesNew++;
1237           }
1238           PetscCall(PetscMalloc1(nleavesNew, &leavesNew));
1239           nleavesNew = 0;
1240           for (i = 0; i < nleaves; i++) {
1241             if (remotesAll[i].rank >= 0) {
1242               leavesNew[nleavesNew] = i;
1243               if (i > nleavesNew) remotesAll[nleavesNew] = remotesAll[i];
1244               nleavesNew++;
1245             }
1246           }
1247           PetscCall(PetscSFCreate(PetscObjectComm((PetscObject)dm), &preCoarseToFineNew));
1248           if (nleavesNew < cEnd) {
1249             PetscCall(PetscSFSetGraph(preCoarseToFineNew, nroots, nleavesNew, leavesNew, PETSC_OWN_POINTER, remotesAll, PETSC_COPY_VALUES));
1250           } else { /* all cells are leaves */
1251             PetscCall(PetscFree(leavesNew));
1252             PetscCall(PetscSFSetGraph(preCoarseToFineNew, nroots, nleavesNew, NULL, PETSC_OWN_POINTER, remotesAll, PETSC_COPY_VALUES));
1253           }
1254           PetscCall(PetscFree(remotesAll));
1255           PetscCall(PetscSFDestroy(&preCoarseToFine));
1256           preCoarseToFine = preCoarseToFineNew;
1257           preCoarseToFine = preCoarseToFineNew;
1258         }
1259         if (coarseToPreFine) {
1260           PetscSF            coarseToPreFineNew;
1261           PetscInt           nleaves, nroots, i, nleavesCellSF, nleavesExpanded, *leavesNew;
1262           const PetscInt    *leaves;
1263           const PetscSFNode *remotes;
1264           PetscSFNode       *remotesNew, *remotesNewRoot, *remotesExpanded;
1265 
1266           PetscCall(PetscSFSetUp(coarseToPreFine));
1267           PetscCall(PetscSFGetGraph(coarseToPreFine, &nroots, &nleaves, &leaves, &remotes));
1268           PetscCall(PetscSFGetGraph(preCellSF, NULL, &nleavesCellSF, NULL, NULL));
1269           PetscCall(PetscMalloc1(nroots, &remotesNewRoot));
1270           PetscCall(PetscMalloc1(nleaves, &remotesNew));
1271           for (i = 0; i < nroots; i++) {
1272             remotesNewRoot[i].rank  = rank;
1273             remotesNewRoot[i].index = i + cLocalStart;
1274           }
1275           PetscCall(PetscSFBcastBegin(coarseToPreFine, MPIU_2INT, remotesNewRoot, remotesNew, MPI_REPLACE));
1276           PetscCall(PetscSFBcastEnd(coarseToPreFine, MPIU_2INT, remotesNewRoot, remotesNew, MPI_REPLACE));
1277           PetscCall(PetscFree(remotesNewRoot));
1278           PetscCall(PetscMalloc1(nleavesCellSF, &remotesExpanded));
1279           for (i = 0; i < nleavesCellSF; i++) {
1280             remotesExpanded[i].rank  = -1;
1281             remotesExpanded[i].index = -1;
1282           }
1283           for (i = 0; i < nleaves; i++) remotesExpanded[leaves ? leaves[i] : i] = remotesNew[i];
1284           PetscCall(PetscFree(remotesNew));
1285           PetscCall(PetscSFBcastBegin(preCellSF, MPIU_2INT, remotesExpanded, remotesExpanded, MPI_REPLACE));
1286           PetscCall(PetscSFBcastEnd(preCellSF, MPIU_2INT, remotesExpanded, remotesExpanded, MPI_REPLACE));
1287 
1288           nleavesExpanded = 0;
1289           for (i = 0; i < nleavesCellSF; i++) {
1290             if (remotesExpanded[i].rank >= 0) nleavesExpanded++;
1291           }
1292           PetscCall(PetscMalloc1(nleavesExpanded, &leavesNew));
1293           nleavesExpanded = 0;
1294           for (i = 0; i < nleavesCellSF; i++) {
1295             if (remotesExpanded[i].rank >= 0) {
1296               leavesNew[nleavesExpanded] = i;
1297               if (i > nleavesExpanded) remotesExpanded[nleavesExpanded] = remotes[i];
1298               nleavesExpanded++;
1299             }
1300           }
1301           PetscCall(PetscSFCreate(PetscObjectComm((PetscObject)dm), &coarseToPreFineNew));
1302           if (nleavesExpanded < nleavesCellSF) {
1303             PetscCall(PetscSFSetGraph(coarseToPreFineNew, cEnd, nleavesExpanded, leavesNew, PETSC_OWN_POINTER, remotesExpanded, PETSC_COPY_VALUES));
1304           } else {
1305             PetscCall(PetscFree(leavesNew));
1306             PetscCall(PetscSFSetGraph(coarseToPreFineNew, cEnd, nleavesExpanded, NULL, PETSC_OWN_POINTER, remotesExpanded, PETSC_COPY_VALUES));
1307           }
1308           PetscCall(PetscFree(remotesExpanded));
1309           PetscCall(PetscSFDestroy(&coarseToPreFine));
1310           coarseToPreFine = coarseToPreFineNew;
1311         }
1312       }
1313     }
1314   }
1315   forest->preCoarseToFine = preCoarseToFine;
1316   forest->coarseToPreFine = coarseToPreFine;
1317   dm->setupcalled         = PETSC_TRUE;
1318   PetscCall(MPIU_Allreduce(&ctx.anyChange, &(pforest->adaptivitySuccess), 1, MPIU_BOOL, MPI_LOR, PetscObjectComm((PetscObject)dm)));
1319   PetscCall(DMPforestGetPlex(dm, NULL));
1320   PetscFunctionReturn(PETSC_SUCCESS);
1321 }
1322 
1323   #define DMForestGetAdaptivitySuccess_pforest _append_pforest(DMForestGetAdaptivitySuccess)
1324 static PetscErrorCode DMForestGetAdaptivitySuccess_pforest(DM dm, PetscBool *success)
1325 {
1326   DM_Forest         *forest;
1327   DM_Forest_pforest *pforest;
1328 
1329   PetscFunctionBegin;
1330   forest   = (DM_Forest *)dm->data;
1331   pforest  = (DM_Forest_pforest *)forest->data;
1332   *success = pforest->adaptivitySuccess;
1333   PetscFunctionReturn(PETSC_SUCCESS);
1334 }
1335 
1336   #define DMView_ASCII_pforest _append_pforest(DMView_ASCII)
1337 static PetscErrorCode DMView_ASCII_pforest(PetscObject odm, PetscViewer viewer)
1338 {
1339   DM dm = (DM)odm;
1340 
1341   PetscFunctionBegin;
1342   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1343   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
1344   PetscCall(DMSetUp(dm));
1345   switch (viewer->format) {
1346   case PETSC_VIEWER_DEFAULT:
1347   case PETSC_VIEWER_ASCII_INFO: {
1348     PetscInt    dim;
1349     const char *name;
1350 
1351     PetscCall(PetscObjectGetName((PetscObject)dm, &name));
1352     PetscCall(DMGetDimension(dm, &dim));
1353     if (name) PetscCall(PetscViewerASCIIPrintf(viewer, "Forest %s in %" PetscInt_FMT " dimensions:\n", name, dim));
1354     else PetscCall(PetscViewerASCIIPrintf(viewer, "Forest in %" PetscInt_FMT " dimensions:\n", dim));
1355   } /* fall through */
1356   case PETSC_VIEWER_ASCII_INFO_DETAIL:
1357   case PETSC_VIEWER_LOAD_BALANCE: {
1358     DM plex;
1359 
1360     PetscCall(DMPforestGetPlex(dm, &plex));
1361     PetscCall(DMView(plex, viewer));
1362   } break;
1363   default:
1364     SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "No support for format '%s'", PetscViewerFormats[viewer->format]);
1365   }
1366   PetscFunctionReturn(PETSC_SUCCESS);
1367 }
1368 
1369   #define DMView_VTK_pforest _append_pforest(DMView_VTK)
1370 static PetscErrorCode DMView_VTK_pforest(PetscObject odm, PetscViewer viewer)
1371 {
1372   DM                 dm      = (DM)odm;
1373   DM_Forest         *forest  = (DM_Forest *)dm->data;
1374   DM_Forest_pforest *pforest = (DM_Forest_pforest *)forest->data;
1375   PetscBool          isvtk;
1376   PetscReal          vtkScale = 1. - PETSC_MACHINE_EPSILON;
1377   PetscViewer_VTK   *vtk      = (PetscViewer_VTK *)viewer->data;
1378   const char        *name;
1379   char              *filenameStrip = NULL;
1380   PetscBool          hasExt;
1381   size_t             len;
1382   p4est_geometry_t  *geom;
1383 
1384   PetscFunctionBegin;
1385   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1386   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
1387   PetscCall(DMSetUp(dm));
1388   geom = pforest->topo->geom;
1389   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERVTK, &isvtk));
1390   PetscCheck(isvtk, PetscObjectComm((PetscObject)viewer), PETSC_ERR_ARG_INCOMP, "Cannot use viewer type %s", ((PetscObject)viewer)->type_name);
1391   switch (viewer->format) {
1392   case PETSC_VIEWER_VTK_VTU:
1393     PetscCheck(pforest->forest, PetscObjectComm(odm), PETSC_ERR_ARG_WRONG, "DM has not been setup with a valid forest");
1394     name = vtk->filename;
1395     PetscCall(PetscStrlen(name, &len));
1396     PetscCall(PetscStrcasecmp(name + len - 4, ".vtu", &hasExt));
1397     if (hasExt) {
1398       PetscCall(PetscStrallocpy(name, &filenameStrip));
1399       filenameStrip[len - 4] = '\0';
1400       name                   = filenameStrip;
1401     }
1402     if (!pforest->topo->geom) PetscCallP4estReturn(geom, p4est_geometry_new_connectivity, (pforest->topo->conn));
1403     {
1404       p4est_vtk_context_t *pvtk;
1405       int                  footerr;
1406 
1407       PetscCallP4estReturn(pvtk, p4est_vtk_context_new, (pforest->forest, name));
1408       PetscCallP4est(p4est_vtk_context_set_geom, (pvtk, geom));
1409       PetscCallP4est(p4est_vtk_context_set_scale, (pvtk, (double)vtkScale));
1410       PetscCallP4estReturn(pvtk, p4est_vtk_write_header, (pvtk));
1411       PetscCheck(pvtk, PetscObjectComm((PetscObject)odm), PETSC_ERR_LIB, P4EST_STRING "_vtk_write_header() failed");
1412       PetscCallP4estReturn(pvtk, p4est_vtk_write_cell_dataf,
1413                            (pvtk, 1, /* write tree */
1414                             1,       /* write level */
1415                             1,       /* write rank */
1416                             0,       /* do not wrap rank */
1417                             0,       /* no scalar fields */
1418                             0,       /* no vector fields */
1419                             pvtk));
1420       PetscCheck(pvtk, PetscObjectComm((PetscObject)odm), PETSC_ERR_LIB, P4EST_STRING "_vtk_write_cell_dataf() failed");
1421       PetscCallP4estReturn(footerr, p4est_vtk_write_footer, (pvtk));
1422       PetscCheck(!footerr, PetscObjectComm((PetscObject)odm), PETSC_ERR_LIB, P4EST_STRING "_vtk_write_footer() failed");
1423     }
1424     if (!pforest->topo->geom) PetscCallP4est(p4est_geometry_destroy, (geom));
1425     PetscCall(PetscFree(filenameStrip));
1426     break;
1427   default:
1428     SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "No support for format '%s'", PetscViewerFormats[viewer->format]);
1429   }
1430   PetscFunctionReturn(PETSC_SUCCESS);
1431 }
1432 
1433   #define DMView_HDF5_pforest _append_pforest(DMView_HDF5)
1434 static PetscErrorCode DMView_HDF5_pforest(DM dm, PetscViewer viewer)
1435 {
1436   DM plex;
1437 
1438   PetscFunctionBegin;
1439   PetscCall(DMSetUp(dm));
1440   PetscCall(DMPforestGetPlex(dm, &plex));
1441   PetscCall(DMView(plex, viewer));
1442   PetscFunctionReturn(PETSC_SUCCESS);
1443 }
1444 
1445   #define DMView_GLVis_pforest _append_pforest(DMView_GLVis)
1446 static PetscErrorCode DMView_GLVis_pforest(DM dm, PetscViewer viewer)
1447 {
1448   DM plex;
1449 
1450   PetscFunctionBegin;
1451   PetscCall(DMSetUp(dm));
1452   PetscCall(DMPforestGetPlex(dm, &plex));
1453   PetscCall(DMView(plex, viewer));
1454   PetscFunctionReturn(PETSC_SUCCESS);
1455 }
1456 
1457   #define DMView_pforest _append_pforest(DMView)
1458 static PetscErrorCode DMView_pforest(DM dm, PetscViewer viewer)
1459 {
1460   PetscBool isascii, isvtk, ishdf5, isglvis;
1461 
1462   PetscFunctionBegin;
1463   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1464   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
1465   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii));
1466   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERVTK, &isvtk));
1467   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERHDF5, &ishdf5));
1468   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERGLVIS, &isglvis));
1469   if (isascii) {
1470     PetscCall(DMView_ASCII_pforest((PetscObject)dm, viewer));
1471   } else if (isvtk) {
1472     PetscCall(DMView_VTK_pforest((PetscObject)dm, viewer));
1473   } else if (ishdf5) {
1474     PetscCall(DMView_HDF5_pforest(dm, viewer));
1475   } else if (isglvis) {
1476     PetscCall(DMView_GLVis_pforest(dm, viewer));
1477   } else SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Viewer not supported (not VTK, HDF5, or GLVis)");
1478   PetscFunctionReturn(PETSC_SUCCESS);
1479 }
1480 
1481 static PetscErrorCode PforestConnectivityEnumerateFacets(p4est_connectivity_t *conn, PetscInt **tree_face_to_uniq)
1482 {
1483   PetscInt *ttf, f, t, g, count;
1484   PetscInt  numFacets;
1485 
1486   PetscFunctionBegin;
1487   numFacets = conn->num_trees * P4EST_FACES;
1488   PetscCall(PetscMalloc1(numFacets, &ttf));
1489   for (f = 0; f < numFacets; f++) ttf[f] = -1;
1490   for (g = 0, count = 0, t = 0; t < conn->num_trees; t++) {
1491     for (f = 0; f < P4EST_FACES; f++, g++) {
1492       if (ttf[g] == -1) {
1493         PetscInt ng;
1494 
1495         ttf[g]  = count++;
1496         ng      = conn->tree_to_tree[g] * P4EST_FACES + (conn->tree_to_face[g] % P4EST_FACES);
1497         ttf[ng] = ttf[g];
1498       }
1499     }
1500   }
1501   *tree_face_to_uniq = ttf;
1502   PetscFunctionReturn(PETSC_SUCCESS);
1503 }
1504 
1505 static PetscErrorCode DMPlexCreateConnectivity_pforest(DM dm, p4est_connectivity_t **connOut, PetscInt **tree_face_to_uniq)
1506 {
1507   p4est_topidx_t numTrees, numVerts, numCorns, numCtt;
1508   PetscSection   ctt;
1509   #if defined(P4_TO_P8)
1510   p4est_topidx_t numEdges, numEtt;
1511   PetscSection   ett;
1512   PetscInt       eStart, eEnd, e, ettSize;
1513   PetscInt       vertOff = 1 + P4EST_FACES + P8EST_EDGES;
1514   PetscInt       edgeOff = 1 + P4EST_FACES;
1515   #else
1516   PetscInt vertOff = 1 + P4EST_FACES;
1517   #endif
1518   p4est_connectivity_t *conn;
1519   PetscInt              cStart, cEnd, c, vStart, vEnd, v, fStart, fEnd, f;
1520   PetscInt             *star = NULL, *closure = NULL, closureSize, starSize, cttSize;
1521   PetscInt             *ttf;
1522 
1523   PetscFunctionBegin;
1524   /* 1: count objects, allocate */
1525   PetscCall(DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd));
1526   PetscCall(P4estTopidxCast(cEnd - cStart, &numTrees));
1527   numVerts = P4EST_CHILDREN * numTrees;
1528   PetscCall(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd));
1529   PetscCall(P4estTopidxCast(vEnd - vStart, &numCorns));
1530   PetscCall(PetscSectionCreate(PETSC_COMM_SELF, &ctt));
1531   PetscCall(PetscSectionSetChart(ctt, vStart, vEnd));
1532   for (v = vStart; v < vEnd; v++) {
1533     PetscInt s;
1534 
1535     PetscCall(DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1536     for (s = 0; s < starSize; s++) {
1537       PetscInt p = star[2 * s];
1538 
1539       if (p >= cStart && p < cEnd) {
1540         /* we want to count every time cell p references v, so we see how many times it comes up in the closure.  This
1541          * only protects against periodicity problems */
1542         PetscCall(DMPlexGetTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1543         PetscCheck(closureSize == P4EST_INSUL, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cell %" PetscInt_FMT " with wrong closure size %" PetscInt_FMT " != %d", p, closureSize, P4EST_INSUL);
1544         for (c = 0; c < P4EST_CHILDREN; c++) {
1545           PetscInt cellVert = closure[2 * (c + vertOff)];
1546 
1547           PetscCheck(cellVert >= vStart && cellVert < vEnd, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Non-standard closure: vertices");
1548           if (cellVert == v) PetscCall(PetscSectionAddDof(ctt, v, 1));
1549         }
1550         PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1551       }
1552     }
1553     PetscCall(DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1554   }
1555   PetscCall(PetscSectionSetUp(ctt));
1556   PetscCall(PetscSectionGetStorageSize(ctt, &cttSize));
1557   PetscCall(P4estTopidxCast(cttSize, &numCtt));
1558   #if defined(P4_TO_P8)
1559   PetscCall(DMPlexGetSimplexOrBoxCells(dm, P4EST_DIM - 1, &eStart, &eEnd));
1560   PetscCall(P4estTopidxCast(eEnd - eStart, &numEdges));
1561   PetscCall(PetscSectionCreate(PETSC_COMM_SELF, &ett));
1562   PetscCall(PetscSectionSetChart(ett, eStart, eEnd));
1563   for (e = eStart; e < eEnd; e++) {
1564     PetscInt s;
1565 
1566     PetscCall(DMPlexGetTransitiveClosure(dm, e, PETSC_FALSE, &starSize, &star));
1567     for (s = 0; s < starSize; s++) {
1568       PetscInt p = star[2 * s];
1569 
1570       if (p >= cStart && p < cEnd) {
1571         /* we want to count every time cell p references e, so we see how many times it comes up in the closure.  This
1572          * only protects against periodicity problems */
1573         PetscCall(DMPlexGetTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1574         PetscCheck(closureSize == P4EST_INSUL, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cell with wrong closure size");
1575         for (c = 0; c < P8EST_EDGES; c++) {
1576           PetscInt cellEdge = closure[2 * (c + edgeOff)];
1577 
1578           PetscCheck(cellEdge >= eStart && cellEdge < eEnd, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Non-standard closure: edges");
1579           if (cellEdge == e) PetscCall(PetscSectionAddDof(ett, e, 1));
1580         }
1581         PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1582       }
1583     }
1584     PetscCall(DMPlexRestoreTransitiveClosure(dm, e, PETSC_FALSE, &starSize, &star));
1585   }
1586   PetscCall(PetscSectionSetUp(ett));
1587   PetscCall(PetscSectionGetStorageSize(ett, &ettSize));
1588   PetscCall(P4estTopidxCast(ettSize, &numEtt));
1589 
1590   /* This routine allocates space for the arrays, which we fill below */
1591   PetscCallP4estReturn(conn, p8est_connectivity_new, (numVerts, numTrees, numEdges, numEtt, numCorns, numCtt));
1592   #else
1593   PetscCallP4estReturn(conn, p4est_connectivity_new, (numVerts, numTrees, numCorns, numCtt));
1594   #endif
1595 
1596   /* 2: visit every face, determine neighboring cells(trees) */
1597   PetscCall(DMPlexGetSimplexOrBoxCells(dm, 1, &fStart, &fEnd));
1598   PetscCall(PetscMalloc1((cEnd - cStart) * P4EST_FACES, &ttf));
1599   for (f = fStart; f < fEnd; f++) {
1600     PetscInt        numSupp, s;
1601     PetscInt        myFace[2] = {-1, -1};
1602     PetscInt        myOrnt[2] = {PETSC_MIN_INT, PETSC_MIN_INT};
1603     const PetscInt *supp;
1604 
1605     PetscCall(DMPlexGetSupportSize(dm, f, &numSupp));
1606     PetscCheck(numSupp == 1 || numSupp == 2, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "point %" PetscInt_FMT " has facet with %" PetscInt_FMT " sides: must be 1 or 2 (boundary or conformal)", f, numSupp);
1607     PetscCall(DMPlexGetSupport(dm, f, &supp));
1608 
1609     for (s = 0; s < numSupp; s++) {
1610       PetscInt p = supp[s];
1611 
1612       if (p >= cEnd) {
1613         numSupp--;
1614         if (s) supp = &supp[1 - s];
1615         break;
1616       }
1617     }
1618     for (s = 0; s < numSupp; s++) {
1619       PetscInt        p = supp[s], i;
1620       PetscInt        numCone;
1621       DMPolytopeType  ct;
1622       const PetscInt *cone;
1623       const PetscInt *ornt;
1624       PetscInt        orient = PETSC_MIN_INT;
1625 
1626       PetscCall(DMPlexGetConeSize(dm, p, &numCone));
1627       PetscCheck(numCone == P4EST_FACES, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "cell %" PetscInt_FMT " has %" PetscInt_FMT " facets, expect %d", p, numCone, P4EST_FACES);
1628       PetscCall(DMPlexGetCone(dm, p, &cone));
1629       PetscCall(DMPlexGetCellType(dm, cone[0], &ct));
1630       PetscCall(DMPlexGetConeOrientation(dm, p, &ornt));
1631       for (i = 0; i < P4EST_FACES; i++) {
1632         if (cone[i] == f) {
1633           orient = DMPolytopeConvertNewOrientation_Internal(ct, ornt[i]);
1634           break;
1635         }
1636       }
1637       PetscCheck(i < P4EST_FACES, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "cell %" PetscInt_FMT " faced %" PetscInt_FMT " mismatch", p, f);
1638       if (p < cStart || p >= cEnd) {
1639         DMPolytopeType ct;
1640         PetscCall(DMPlexGetCellType(dm, p, &ct));
1641         SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "cell %" PetscInt_FMT " (%s) should be in [%" PetscInt_FMT ", %" PetscInt_FMT ")", p, DMPolytopeTypes[ct], cStart, cEnd);
1642       }
1643       ttf[P4EST_FACES * (p - cStart) + PetscFaceToP4estFace[i]] = f - fStart;
1644       if (numSupp == 1) {
1645         /* boundary faces indicated by self reference */
1646         conn->tree_to_tree[P4EST_FACES * (p - cStart) + PetscFaceToP4estFace[i]] = p - cStart;
1647         conn->tree_to_face[P4EST_FACES * (p - cStart) + PetscFaceToP4estFace[i]] = (int8_t)PetscFaceToP4estFace[i];
1648       } else {
1649         const PetscInt N = P4EST_CHILDREN / 2;
1650 
1651         conn->tree_to_tree[P4EST_FACES * (p - cStart) + PetscFaceToP4estFace[i]] = supp[1 - s] - cStart;
1652         myFace[s]                                                                = PetscFaceToP4estFace[i];
1653         /* get the orientation of cell p in p4est-type closure to facet f, by composing the p4est-closure to
1654          * petsc-closure permutation and the petsc-closure to facet orientation */
1655         myOrnt[s] = DihedralCompose(N, orient, DMPolytopeConvertNewOrientation_Internal(ct, P4estFaceToPetscOrnt[myFace[s]]));
1656       }
1657     }
1658     if (numSupp == 2) {
1659       for (s = 0; s < numSupp; s++) {
1660         PetscInt       p = supp[s];
1661         PetscInt       orntAtoB;
1662         PetscInt       p4estOrient;
1663         const PetscInt N = P4EST_CHILDREN / 2;
1664 
1665         /* composing the forward permutation with the other cell's inverse permutation gives the self-to-neighbor
1666          * permutation of this cell-facet's cone */
1667         orntAtoB = DihedralCompose(N, DihedralInvert(N, myOrnt[1 - s]), myOrnt[s]);
1668 
1669           /* convert cone-description permutation (i.e., edges around facet) to cap-description permutation (i.e.,
1670          * vertices around facet) */
1671   #if !defined(P4_TO_P8)
1672         p4estOrient = orntAtoB < 0 ? -(orntAtoB + 1) : orntAtoB;
1673   #else
1674         {
1675           PetscInt firstVert      = orntAtoB < 0 ? ((-orntAtoB) % N) : orntAtoB;
1676           PetscInt p4estFirstVert = firstVert < 2 ? firstVert : (firstVert ^ 1);
1677 
1678           /* swap bits */
1679           p4estOrient = ((myFace[s] <= myFace[1 - s]) || (orntAtoB < 0)) ? p4estFirstVert : ((p4estFirstVert >> 1) | ((p4estFirstVert & 1) << 1));
1680         }
1681   #endif
1682         /* encode neighbor face and orientation in tree_to_face per p4est_connectivity standard (see
1683          * p4est_connectivity.h, p8est_connectivity.h) */
1684         conn->tree_to_face[P4EST_FACES * (p - cStart) + myFace[s]] = (int8_t)myFace[1 - s] + p4estOrient * P4EST_FACES;
1685       }
1686     }
1687   }
1688 
1689   #if defined(P4_TO_P8)
1690   /* 3: visit every edge */
1691   conn->ett_offset[0] = 0;
1692   for (e = eStart; e < eEnd; e++) {
1693     PetscInt off, s;
1694 
1695     PetscCall(PetscSectionGetOffset(ett, e, &off));
1696     conn->ett_offset[e - eStart] = (p4est_topidx_t)off;
1697     PetscCall(DMPlexGetTransitiveClosure(dm, e, PETSC_FALSE, &starSize, &star));
1698     for (s = 0; s < starSize; s++) {
1699       PetscInt p = star[2 * s];
1700 
1701       if (p >= cStart && p < cEnd) {
1702         PetscCall(DMPlexGetTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1703         PetscCheck(closureSize == P4EST_INSUL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Non-standard closure");
1704         for (c = 0; c < P8EST_EDGES; c++) {
1705           PetscInt       cellEdge = closure[2 * (c + edgeOff)];
1706           PetscInt       cellOrnt = closure[2 * (c + edgeOff) + 1];
1707           DMPolytopeType ct;
1708 
1709           PetscCall(DMPlexGetCellType(dm, cellEdge, &ct));
1710           cellOrnt = DMPolytopeConvertNewOrientation_Internal(ct, cellOrnt);
1711           if (cellEdge == e) {
1712             PetscInt p4estEdge = PetscEdgeToP4estEdge[c];
1713             PetscInt totalOrient;
1714 
1715             /* compose p4est-closure to petsc-closure permutation and petsc-closure to edge orientation */
1716             totalOrient = DihedralCompose(2, cellOrnt, DMPolytopeConvertNewOrientation_Internal(DM_POLYTOPE_SEGMENT, P4estEdgeToPetscOrnt[p4estEdge]));
1717             /* p4est orientations are positive: -2 => 1, -1 => 0 */
1718             totalOrient             = (totalOrient < 0) ? -(totalOrient + 1) : totalOrient;
1719             conn->edge_to_tree[off] = (p4est_locidx_t)(p - cStart);
1720             /* encode cell-edge and orientation in edge_to_edge per p8est_connectivity standard (see
1721              * p8est_connectivity.h) */
1722             conn->edge_to_edge[off++]                                  = (int8_t)p4estEdge + P8EST_EDGES * totalOrient;
1723             conn->tree_to_edge[P8EST_EDGES * (p - cStart) + p4estEdge] = e - eStart;
1724           }
1725         }
1726         PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1727       }
1728     }
1729     PetscCall(DMPlexRestoreTransitiveClosure(dm, e, PETSC_FALSE, &starSize, &star));
1730   }
1731   PetscCall(PetscSectionDestroy(&ett));
1732   #endif
1733 
1734   /* 4: visit every vertex */
1735   conn->ctt_offset[0] = 0;
1736   for (v = vStart; v < vEnd; v++) {
1737     PetscInt off, s;
1738 
1739     PetscCall(PetscSectionGetOffset(ctt, v, &off));
1740     conn->ctt_offset[v - vStart] = (p4est_topidx_t)off;
1741     PetscCall(DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1742     for (s = 0; s < starSize; s++) {
1743       PetscInt p = star[2 * s];
1744 
1745       if (p >= cStart && p < cEnd) {
1746         PetscCall(DMPlexGetTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1747         PetscCheck(closureSize == P4EST_INSUL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Non-standard closure");
1748         for (c = 0; c < P4EST_CHILDREN; c++) {
1749           PetscInt cellVert = closure[2 * (c + vertOff)];
1750 
1751           if (cellVert == v) {
1752             PetscInt p4estVert = PetscVertToP4estVert[c];
1753 
1754             conn->corner_to_tree[off]                                       = (p4est_locidx_t)(p - cStart);
1755             conn->corner_to_corner[off++]                                   = (int8_t)p4estVert;
1756             conn->tree_to_corner[P4EST_CHILDREN * (p - cStart) + p4estVert] = v - vStart;
1757           }
1758         }
1759         PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
1760       }
1761     }
1762     PetscCall(DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star));
1763   }
1764   PetscCall(PetscSectionDestroy(&ctt));
1765 
1766   /* 5: Compute the coordinates */
1767   {
1768     PetscInt coordDim;
1769 
1770     PetscCall(DMGetCoordinateDim(dm, &coordDim));
1771     PetscCall(DMGetCoordinatesLocalSetUp(dm));
1772     for (c = cStart; c < cEnd; c++) {
1773       PetscInt           dof;
1774       PetscBool          isDG;
1775       PetscScalar       *cellCoords = NULL;
1776       const PetscScalar *array;
1777 
1778       PetscCall(DMPlexGetCellCoordinates(dm, c, &isDG, &dof, &array, &cellCoords));
1779       PetscCheck(dof == P4EST_CHILDREN * coordDim, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Need coordinates at the corners: (dof) %" PetscInt_FMT " != %d * %" PetscInt_FMT " (sdim)", dof, P4EST_CHILDREN, coordDim);
1780       for (v = 0; v < P4EST_CHILDREN; v++) {
1781         PetscInt i, lim = PetscMin(3, coordDim);
1782         PetscInt p4estVert = PetscVertToP4estVert[v];
1783 
1784         conn->tree_to_vertex[P4EST_CHILDREN * (c - cStart) + v] = P4EST_CHILDREN * (c - cStart) + v;
1785         /* p4est vertices are always embedded in R^3 */
1786         for (i = 0; i < 3; i++) conn->vertices[3 * (P4EST_CHILDREN * (c - cStart) + p4estVert) + i] = 0.;
1787         for (i = 0; i < lim; i++) conn->vertices[3 * (P4EST_CHILDREN * (c - cStart) + p4estVert) + i] = PetscRealPart(cellCoords[v * coordDim + i]);
1788       }
1789       PetscCall(DMPlexRestoreCellCoordinates(dm, c, &isDG, &dof, &array, &cellCoords));
1790     }
1791   }
1792 
1793   #if defined(P4EST_ENABLE_DEBUG)
1794   PetscCheck(p4est_connectivity_is_valid(conn), PETSC_COMM_SELF, PETSC_ERR_PLIB, "Plex to p4est conversion failed");
1795   #endif
1796 
1797   *connOut = conn;
1798 
1799   *tree_face_to_uniq = ttf;
1800 
1801   PetscFunctionReturn(PETSC_SUCCESS);
1802 }
1803 
1804 static PetscErrorCode locidx_to_PetscInt(sc_array_t *array)
1805 {
1806   sc_array_t *newarray;
1807   size_t      zz, count = array->elem_count;
1808 
1809   PetscFunctionBegin;
1810   PetscCheck(array->elem_size == sizeof(p4est_locidx_t), PETSC_COMM_SELF, PETSC_ERR_PLIB, "Wrong locidx size");
1811 
1812   if (sizeof(p4est_locidx_t) == sizeof(PetscInt)) PetscFunctionReturn(PETSC_SUCCESS);
1813 
1814   newarray = sc_array_new_size(sizeof(PetscInt), array->elem_count);
1815   for (zz = 0; zz < count; zz++) {
1816     p4est_locidx_t il = *((p4est_locidx_t *)sc_array_index(array, zz));
1817     PetscInt      *ip = (PetscInt *)sc_array_index(newarray, zz);
1818 
1819     *ip = (PetscInt)il;
1820   }
1821 
1822   sc_array_reset(array);
1823   sc_array_init_size(array, sizeof(PetscInt), count);
1824   sc_array_copy(array, newarray);
1825   sc_array_destroy(newarray);
1826   PetscFunctionReturn(PETSC_SUCCESS);
1827 }
1828 
1829 static PetscErrorCode coords_double_to_PetscScalar(sc_array_t *array, PetscInt dim)
1830 {
1831   sc_array_t *newarray;
1832   size_t      zz, count = array->elem_count;
1833 
1834   PetscFunctionBegin;
1835   PetscCheck(array->elem_size == 3 * sizeof(double), PETSC_COMM_SELF, PETSC_ERR_PLIB, "Wrong coordinate size");
1836   #if !defined(PETSC_USE_COMPLEX)
1837   if (sizeof(double) == sizeof(PetscScalar) && dim == 3) PetscFunctionReturn(PETSC_SUCCESS);
1838   #endif
1839 
1840   newarray = sc_array_new_size(dim * sizeof(PetscScalar), array->elem_count);
1841   for (zz = 0; zz < count; zz++) {
1842     int          i;
1843     double      *id = (double *)sc_array_index(array, zz);
1844     PetscScalar *ip = (PetscScalar *)sc_array_index(newarray, zz);
1845 
1846     for (i = 0; i < dim; i++) ip[i] = 0.;
1847     for (i = 0; i < PetscMin(dim, 3); i++) ip[i] = (PetscScalar)id[i];
1848   }
1849 
1850   sc_array_reset(array);
1851   sc_array_init_size(array, dim * sizeof(PetscScalar), count);
1852   sc_array_copy(array, newarray);
1853   sc_array_destroy(newarray);
1854   PetscFunctionReturn(PETSC_SUCCESS);
1855 }
1856 
1857 static PetscErrorCode locidx_pair_to_PetscSFNode(sc_array_t *array)
1858 {
1859   sc_array_t *newarray;
1860   size_t      zz, count = array->elem_count;
1861 
1862   PetscFunctionBegin;
1863   PetscCheck(array->elem_size == 2 * sizeof(p4est_locidx_t), PETSC_COMM_SELF, PETSC_ERR_PLIB, "Wrong locidx size");
1864 
1865   newarray = sc_array_new_size(sizeof(PetscSFNode), array->elem_count);
1866   for (zz = 0; zz < count; zz++) {
1867     p4est_locidx_t *il = (p4est_locidx_t *)sc_array_index(array, zz);
1868     PetscSFNode    *ip = (PetscSFNode *)sc_array_index(newarray, zz);
1869 
1870     ip->rank  = (PetscInt)il[0];
1871     ip->index = (PetscInt)il[1];
1872   }
1873 
1874   sc_array_reset(array);
1875   sc_array_init_size(array, sizeof(PetscSFNode), count);
1876   sc_array_copy(array, newarray);
1877   sc_array_destroy(newarray);
1878   PetscFunctionReturn(PETSC_SUCCESS);
1879 }
1880 
1881 static PetscErrorCode P4estToPlex_Local(p4est_t *p4est, DM *plex)
1882 {
1883   PetscFunctionBegin;
1884   {
1885     sc_array_t    *points_per_dim    = sc_array_new(sizeof(p4est_locidx_t));
1886     sc_array_t    *cone_sizes        = sc_array_new(sizeof(p4est_locidx_t));
1887     sc_array_t    *cones             = sc_array_new(sizeof(p4est_locidx_t));
1888     sc_array_t    *cone_orientations = sc_array_new(sizeof(p4est_locidx_t));
1889     sc_array_t    *coords            = sc_array_new(3 * sizeof(double));
1890     sc_array_t    *children          = sc_array_new(sizeof(p4est_locidx_t));
1891     sc_array_t    *parents           = sc_array_new(sizeof(p4est_locidx_t));
1892     sc_array_t    *childids          = sc_array_new(sizeof(p4est_locidx_t));
1893     sc_array_t    *leaves            = sc_array_new(sizeof(p4est_locidx_t));
1894     sc_array_t    *remotes           = sc_array_new(2 * sizeof(p4est_locidx_t));
1895     p4est_locidx_t first_local_quad;
1896 
1897     PetscCallP4est(p4est_get_plex_data, (p4est, P4EST_CONNECT_FULL, 0, &first_local_quad, points_per_dim, cone_sizes, cones, cone_orientations, coords, children, parents, childids, leaves, remotes));
1898 
1899     PetscCall(locidx_to_PetscInt(points_per_dim));
1900     PetscCall(locidx_to_PetscInt(cone_sizes));
1901     PetscCall(locidx_to_PetscInt(cones));
1902     PetscCall(locidx_to_PetscInt(cone_orientations));
1903     PetscCall(coords_double_to_PetscScalar(coords, P4EST_DIM));
1904 
1905     PetscCall(DMPlexCreate(PETSC_COMM_SELF, plex));
1906     PetscCall(DMSetDimension(*plex, P4EST_DIM));
1907     PetscCall(DMPlexCreateFromDAG(*plex, P4EST_DIM, (PetscInt *)points_per_dim->array, (PetscInt *)cone_sizes->array, (PetscInt *)cones->array, (PetscInt *)cone_orientations->array, (PetscScalar *)coords->array));
1908     PetscCall(DMPlexConvertOldOrientations_Internal(*plex));
1909     sc_array_destroy(points_per_dim);
1910     sc_array_destroy(cone_sizes);
1911     sc_array_destroy(cones);
1912     sc_array_destroy(cone_orientations);
1913     sc_array_destroy(coords);
1914     sc_array_destroy(children);
1915     sc_array_destroy(parents);
1916     sc_array_destroy(childids);
1917     sc_array_destroy(leaves);
1918     sc_array_destroy(remotes);
1919   }
1920   PetscFunctionReturn(PETSC_SUCCESS);
1921 }
1922 
1923   #define DMReferenceTreeGetChildSymmetry_pforest _append_pforest(DMReferenceTreeGetChildSymmetry)
1924 static PetscErrorCode DMReferenceTreeGetChildSymmetry_pforest(DM dm, PetscInt parent, PetscInt parentOrientA, PetscInt childOrientA, PetscInt childA, PetscInt parentOrientB, PetscInt *childOrientB, PetscInt *childB)
1925 {
1926   PetscInt coneSize, dStart, dEnd, vStart, vEnd, dim, ABswap, oAvert, oBvert, ABswapVert;
1927 
1928   PetscFunctionBegin;
1929   if (parentOrientA == parentOrientB) {
1930     if (childOrientB) *childOrientB = childOrientA;
1931     if (childB) *childB = childA;
1932     PetscFunctionReturn(PETSC_SUCCESS);
1933   }
1934   PetscCall(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd));
1935   if (childA >= vStart && childA < vEnd) { /* vertices (always in the middle) are invariant under rotation */
1936     if (childOrientB) *childOrientB = 0;
1937     if (childB) *childB = childA;
1938     PetscFunctionReturn(PETSC_SUCCESS);
1939   }
1940   for (dim = 0; dim < 3; dim++) {
1941     PetscCall(DMPlexGetDepthStratum(dm, dim, &dStart, &dEnd));
1942     if (parent >= dStart && parent <= dEnd) break;
1943   }
1944   PetscCheck(dim <= 2, PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot perform child symmetry for %" PetscInt_FMT "-cells", dim);
1945   PetscCheck(dim, PETSC_COMM_SELF, PETSC_ERR_PLIB, "A vertex has no children");
1946   if (childA < dStart || childA >= dEnd) { /* a 1-cell in a 2-cell */
1947     /* this is a lower-dimensional child: bootstrap */
1948     PetscInt        size, i, sA = -1, sB, sOrientB, sConeSize;
1949     const PetscInt *supp, *coneA, *coneB, *oA, *oB;
1950 
1951     PetscCall(DMPlexGetSupportSize(dm, childA, &size));
1952     PetscCall(DMPlexGetSupport(dm, childA, &supp));
1953 
1954     /* find a point sA in supp(childA) that has the same parent */
1955     for (i = 0; i < size; i++) {
1956       PetscInt sParent;
1957 
1958       sA = supp[i];
1959       if (sA == parent) continue;
1960       PetscCall(DMPlexGetTreeParent(dm, sA, &sParent, NULL));
1961       if (sParent == parent) break;
1962     }
1963     PetscCheck(i != size, PETSC_COMM_SELF, PETSC_ERR_PLIB, "could not find support in children");
1964     /* find out which point sB is in an equivalent position to sA under
1965      * parentOrientB */
1966     PetscCall(DMReferenceTreeGetChildSymmetry_pforest(dm, parent, parentOrientA, 0, sA, parentOrientB, &sOrientB, &sB));
1967     PetscCall(DMPlexGetConeSize(dm, sA, &sConeSize));
1968     PetscCall(DMPlexGetCone(dm, sA, &coneA));
1969     PetscCall(DMPlexGetCone(dm, sB, &coneB));
1970     PetscCall(DMPlexGetConeOrientation(dm, sA, &oA));
1971     PetscCall(DMPlexGetConeOrientation(dm, sB, &oB));
1972     /* step through the cone of sA in natural order */
1973     for (i = 0; i < sConeSize; i++) {
1974       if (coneA[i] == childA) {
1975         /* if childA is at position i in coneA,
1976          * then we want the point that is at sOrientB*i in coneB */
1977         PetscInt j = (sOrientB >= 0) ? ((sOrientB + i) % sConeSize) : ((sConeSize - (sOrientB + 1) - i) % sConeSize);
1978         if (childB) *childB = coneB[j];
1979         if (childOrientB) {
1980           DMPolytopeType ct;
1981           PetscInt       oBtrue;
1982 
1983           PetscCall(DMPlexGetConeSize(dm, childA, &coneSize));
1984           /* compose sOrientB and oB[j] */
1985           PetscCheck(coneSize == 0 || coneSize == 2, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Expected a vertex or an edge");
1986           ct = coneSize ? DM_POLYTOPE_SEGMENT : DM_POLYTOPE_POINT;
1987           /* we may have to flip an edge */
1988           oBtrue        = (sOrientB >= 0) ? oB[j] : DMPolytopeTypeComposeOrientationInv(ct, -1, oB[j]);
1989           oBtrue        = DMPolytopeConvertNewOrientation_Internal(ct, oBtrue);
1990           ABswap        = DihedralSwap(coneSize, DMPolytopeConvertNewOrientation_Internal(ct, oA[i]), oBtrue);
1991           *childOrientB = DihedralCompose(coneSize, childOrientA, ABswap);
1992         }
1993         break;
1994       }
1995     }
1996     PetscCheck(i != sConeSize, PETSC_COMM_SELF, PETSC_ERR_PLIB, "support cone mismatch");
1997     PetscFunctionReturn(PETSC_SUCCESS);
1998   }
1999   /* get the cone size and symmetry swap */
2000   PetscCall(DMPlexGetConeSize(dm, parent, &coneSize));
2001   ABswap = DihedralSwap(coneSize, parentOrientA, parentOrientB);
2002   if (dim == 2) {
2003     /* orientations refer to cones: we want them to refer to vertices:
2004      * if it's a rotation, they are the same, but if the order is reversed, a
2005      * permutation that puts side i first does *not* put vertex i first */
2006     oAvert     = (parentOrientA >= 0) ? parentOrientA : -((-parentOrientA % coneSize) + 1);
2007     oBvert     = (parentOrientB >= 0) ? parentOrientB : -((-parentOrientB % coneSize) + 1);
2008     ABswapVert = DihedralSwap(coneSize, oAvert, oBvert);
2009   } else {
2010     oAvert     = parentOrientA;
2011     oBvert     = parentOrientB;
2012     ABswapVert = ABswap;
2013   }
2014   if (childB) {
2015     /* assume that each child corresponds to a vertex, in the same order */
2016     PetscInt        p, posA = -1, numChildren, i;
2017     const PetscInt *children;
2018 
2019     /* count which position the child is in */
2020     PetscCall(DMPlexGetTreeChildren(dm, parent, &numChildren, &children));
2021     for (i = 0; i < numChildren; i++) {
2022       p = children[i];
2023       if (p == childA) {
2024         if (dim == 1) {
2025           posA = i;
2026         } else { /* 2D Morton to rotation */
2027           posA = (i & 2) ? (i ^ 1) : i;
2028         }
2029         break;
2030       }
2031     }
2032     if (posA >= coneSize) {
2033       SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Could not find childA in children of parent");
2034     } else {
2035       /* figure out position B by applying ABswapVert */
2036       PetscInt posB, childIdB;
2037 
2038       posB = (ABswapVert >= 0) ? ((ABswapVert + posA) % coneSize) : ((coneSize - (ABswapVert + 1) - posA) % coneSize);
2039       if (dim == 1) {
2040         childIdB = posB;
2041       } else { /* 2D rotation to Morton */
2042         childIdB = (posB & 2) ? (posB ^ 1) : posB;
2043       }
2044       if (childB) *childB = children[childIdB];
2045     }
2046   }
2047   if (childOrientB) *childOrientB = DihedralCompose(coneSize, childOrientA, ABswap);
2048   PetscFunctionReturn(PETSC_SUCCESS);
2049 }
2050 
2051   #define DMCreateReferenceTree_pforest _append_pforest(DMCreateReferenceTree)
2052 static PetscErrorCode DMCreateReferenceTree_pforest(MPI_Comm comm, DM *dm)
2053 {
2054   p4est_connectivity_t *refcube;
2055   p4est_t              *root, *refined;
2056   DM                    dmRoot, dmRefined;
2057   DM_Plex              *mesh;
2058   PetscMPIInt           rank;
2059   #if defined(PETSC_HAVE_MPIUNI)
2060   sc_MPI_Comm comm_self = sc_MPI_COMM_SELF;
2061   #else
2062   MPI_Comm comm_self = PETSC_COMM_SELF;
2063   #endif
2064 
2065   PetscFunctionBegin;
2066   PetscCallP4estReturn(refcube, p4est_connectivity_new_byname, ("unit"));
2067   { /* [-1,1]^d geometry */
2068     PetscInt i, j;
2069 
2070     for (i = 0; i < P4EST_CHILDREN; i++) {
2071       for (j = 0; j < 3; j++) {
2072         refcube->vertices[3 * i + j] *= 2.;
2073         refcube->vertices[3 * i + j] -= 1.;
2074       }
2075     }
2076   }
2077   PetscCallP4estReturn(root, p4est_new, (comm_self, refcube, 0, NULL, NULL));
2078   PetscCallP4estReturn(refined, p4est_new_ext, (comm_self, refcube, 0, 1, 1, 0, NULL, NULL));
2079   PetscCall(P4estToPlex_Local(root, &dmRoot));
2080   PetscCall(P4estToPlex_Local(refined, &dmRefined));
2081   {
2082   #if !defined(P4_TO_P8)
2083     PetscInt nPoints   = 25;
2084     PetscInt perm[25]  = {0, 1, 2, 3, 4, 12, 8, 14, 6, 9, 15, 5, 13, 10, 7, 11, 16, 22, 20, 24, 17, 21, 18, 23, 19};
2085     PetscInt ident[25] = {0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 0, 0, 0, 0, 5, 6, 7, 8, 1, 2, 3, 4, 0};
2086   #else
2087     PetscInt nPoints    = 125;
2088     PetscInt perm[125]  = {0,  1,  2,  3,  4,  5,  6,  7,  8,  32, 16, 36, 24, 40, 12, 17,  37,  25,  41,  9,   33,  20,  26, 42,  13,  21,  27,  43,  10,  34,  18,  38,  28,  14,  19,  39,  29,  11,  35,  22,  30, 15,
2089                            23, 31, 44, 84, 76, 92, 52, 86, 68, 94, 60, 78, 70, 96, 45, 85,  77,  93,  54,  72,  62,  74,  46, 80,  53,  87,  69,  95,  64,  82,  47,  81,  55,  73,  66,  48,  88,  56,  90,  61,  79, 71,
2090                            97, 49, 89, 58, 63, 75, 50, 57, 91, 65, 83, 51, 59, 67, 98, 106, 110, 122, 114, 120, 118, 124, 99, 111, 115, 119, 100, 107, 116, 121, 101, 117, 102, 108, 112, 123, 103, 113, 104, 109, 105};
2091     PetscInt ident[125] = {0,  0,  0,  0,  0,  0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 0, 0, 0, 0,  0,  0,  0,  0,  0,  0,  0,  0, 7, 7, 8,  8,  9,  9,  10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16,
2092                            16, 17, 17, 18, 18, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, 0, 0, 0, 0, 0, 0, 19, 20, 21, 22, 23, 24, 25, 26, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 1,  2,  3,  4,  5,  6,  0};
2093 
2094   #endif
2095     IS permIS;
2096     DM dmPerm;
2097 
2098     PetscCall(ISCreateGeneral(PETSC_COMM_SELF, nPoints, perm, PETSC_USE_POINTER, &permIS));
2099     PetscCall(DMPlexPermute(dmRefined, permIS, &dmPerm));
2100     if (dmPerm) {
2101       PetscCall(DMDestroy(&dmRefined));
2102       dmRefined = dmPerm;
2103     }
2104     PetscCall(ISDestroy(&permIS));
2105     {
2106       PetscInt p;
2107       PetscCall(DMCreateLabel(dmRoot, "identity"));
2108       PetscCall(DMCreateLabel(dmRefined, "identity"));
2109       for (p = 0; p < P4EST_INSUL; p++) PetscCall(DMSetLabelValue(dmRoot, "identity", p, p));
2110       for (p = 0; p < nPoints; p++) PetscCall(DMSetLabelValue(dmRefined, "identity", p, ident[p]));
2111     }
2112   }
2113   PetscCall(DMPlexCreateReferenceTree_Union(dmRoot, dmRefined, "identity", dm));
2114   mesh                   = (DM_Plex *)(*dm)->data;
2115   mesh->getchildsymmetry = DMReferenceTreeGetChildSymmetry_pforest;
2116   PetscCallMPI(MPI_Comm_rank(comm, &rank));
2117   if (rank == 0) {
2118     PetscCall(DMViewFromOptions(dmRoot, NULL, "-dm_p4est_ref_root_view"));
2119     PetscCall(DMViewFromOptions(dmRefined, NULL, "-dm_p4est_ref_refined_view"));
2120     PetscCall(DMViewFromOptions(dmRefined, NULL, "-dm_p4est_ref_tree_view"));
2121   }
2122   PetscCall(DMDestroy(&dmRefined));
2123   PetscCall(DMDestroy(&dmRoot));
2124   PetscCallP4est(p4est_destroy, (refined));
2125   PetscCallP4est(p4est_destroy, (root));
2126   PetscCallP4est(p4est_connectivity_destroy, (refcube));
2127   PetscFunctionReturn(PETSC_SUCCESS);
2128 }
2129 
2130 static PetscErrorCode DMShareDiscretization(DM dmA, DM dmB)
2131 {
2132   void     *ctx;
2133   PetscInt  num;
2134   PetscReal val;
2135 
2136   PetscFunctionBegin;
2137   PetscCall(DMGetApplicationContext(dmA, &ctx));
2138   PetscCall(DMSetApplicationContext(dmB, ctx));
2139   PetscCall(DMCopyDisc(dmA, dmB));
2140   PetscCall(DMGetOutputSequenceNumber(dmA, &num, &val));
2141   PetscCall(DMSetOutputSequenceNumber(dmB, num, val));
2142   if (dmB->localSection != dmA->localSection || dmB->globalSection != dmA->globalSection) {
2143     PetscCall(DMClearLocalVectors(dmB));
2144     PetscCall(PetscObjectReference((PetscObject)dmA->localSection));
2145     PetscCall(PetscSectionDestroy(&(dmB->localSection)));
2146     dmB->localSection = dmA->localSection;
2147     PetscCall(DMClearGlobalVectors(dmB));
2148     PetscCall(PetscObjectReference((PetscObject)dmA->globalSection));
2149     PetscCall(PetscSectionDestroy(&(dmB->globalSection)));
2150     dmB->globalSection = dmA->globalSection;
2151     PetscCall(PetscObjectReference((PetscObject)dmA->defaultConstraint.section));
2152     PetscCall(PetscSectionDestroy(&(dmB->defaultConstraint.section)));
2153     dmB->defaultConstraint.section = dmA->defaultConstraint.section;
2154     PetscCall(PetscObjectReference((PetscObject)dmA->defaultConstraint.mat));
2155     PetscCall(MatDestroy(&(dmB->defaultConstraint.mat)));
2156     dmB->defaultConstraint.mat = dmA->defaultConstraint.mat;
2157     if (dmA->map) PetscCall(PetscLayoutReference(dmA->map, &dmB->map));
2158   }
2159   if (dmB->sectionSF != dmA->sectionSF) {
2160     PetscCall(PetscObjectReference((PetscObject)dmA->sectionSF));
2161     PetscCall(PetscSFDestroy(&dmB->sectionSF));
2162     dmB->sectionSF = dmA->sectionSF;
2163   }
2164   PetscFunctionReturn(PETSC_SUCCESS);
2165 }
2166 
2167 /* Get an SF that broadcasts a coarse-cell covering of the local fine cells */
2168 static PetscErrorCode DMPforestGetCellCoveringSF(MPI_Comm comm, p4est_t *p4estC, p4est_t *p4estF, PetscInt cStart, PetscInt cEnd, PetscSF *coveringSF)
2169 {
2170   PetscInt     startF, endF, startC, endC, p, nLeaves;
2171   PetscSFNode *leaves;
2172   PetscSF      sf;
2173   PetscInt    *recv, *send;
2174   PetscMPIInt  tag;
2175   MPI_Request *recvReqs, *sendReqs;
2176   PetscSection section;
2177 
2178   PetscFunctionBegin;
2179   PetscCall(DMPforestComputeOverlappingRanks(p4estC->mpisize, p4estC->mpirank, p4estF, p4estC, &startC, &endC));
2180   PetscCall(PetscMalloc2(2 * (endC - startC), &recv, endC - startC, &recvReqs));
2181   PetscCall(PetscCommGetNewTag(comm, &tag));
2182   for (p = startC; p < endC; p++) {
2183     recvReqs[p - startC] = MPI_REQUEST_NULL;                                        /* just in case we don't initiate a receive */
2184     if (p4estC->global_first_quadrant[p] == p4estC->global_first_quadrant[p + 1]) { /* empty coarse partition */
2185       recv[2 * (p - startC)]     = 0;
2186       recv[2 * (p - startC) + 1] = 0;
2187       continue;
2188     }
2189 
2190     PetscCallMPI(MPI_Irecv(&recv[2 * (p - startC)], 2, MPIU_INT, p, tag, comm, &recvReqs[p - startC]));
2191   }
2192   PetscCall(DMPforestComputeOverlappingRanks(p4estC->mpisize, p4estC->mpirank, p4estC, p4estF, &startF, &endF));
2193   PetscCall(PetscMalloc2(2 * (endF - startF), &send, endF - startF, &sendReqs));
2194   /* count the quadrants rank will send to each of [startF,endF) */
2195   for (p = startF; p < endF; p++) {
2196     p4est_quadrant_t *myFineStart = &p4estF->global_first_position[p];
2197     p4est_quadrant_t *myFineEnd   = &p4estF->global_first_position[p + 1];
2198     PetscInt          tStart      = (PetscInt)myFineStart->p.which_tree;
2199     PetscInt          tEnd        = (PetscInt)myFineEnd->p.which_tree;
2200     PetscInt          firstCell = -1, lastCell = -1;
2201     p4est_tree_t     *treeStart = &(((p4est_tree_t *)p4estC->trees->array)[tStart]);
2202     p4est_tree_t     *treeEnd   = (size_t)tEnd < p4estC->trees->elem_count ? &(((p4est_tree_t *)p4estC->trees->array)[tEnd]) : NULL;
2203     ssize_t           overlapIndex;
2204 
2205     sendReqs[p - startF] = MPI_REQUEST_NULL; /* just in case we don't initiate a send */
2206     if (p4estF->global_first_quadrant[p] == p4estF->global_first_quadrant[p + 1]) continue;
2207 
2208     /* locate myFineStart in (or before) a cell */
2209     if (treeStart->quadrants.elem_count) {
2210       PetscCallP4estReturn(overlapIndex, sc_array_bsearch, (&(treeStart->quadrants), myFineStart, p4est_quadrant_disjoint));
2211       if (overlapIndex < 0) {
2212         firstCell = 0;
2213       } else {
2214         firstCell = treeStart->quadrants_offset + overlapIndex;
2215       }
2216     } else {
2217       firstCell = 0;
2218     }
2219     if (treeEnd && treeEnd->quadrants.elem_count) {
2220       PetscCallP4estReturn(overlapIndex, sc_array_bsearch, (&(treeEnd->quadrants), myFineEnd, p4est_quadrant_disjoint));
2221       if (overlapIndex < 0) { /* all of this local section is overlapped */
2222         lastCell = p4estC->local_num_quadrants;
2223       } else {
2224         p4est_quadrant_t *container = &(((p4est_quadrant_t *)treeEnd->quadrants.array)[overlapIndex]);
2225         p4est_quadrant_t  first_desc;
2226         int               equal;
2227 
2228         PetscCallP4est(p4est_quadrant_first_descendant, (container, &first_desc, P4EST_QMAXLEVEL));
2229         PetscCallP4estReturn(equal, p4est_quadrant_is_equal, (myFineEnd, &first_desc));
2230         if (equal) {
2231           lastCell = treeEnd->quadrants_offset + overlapIndex;
2232         } else {
2233           lastCell = treeEnd->quadrants_offset + overlapIndex + 1;
2234         }
2235       }
2236     } else {
2237       lastCell = p4estC->local_num_quadrants;
2238     }
2239     send[2 * (p - startF)]     = firstCell;
2240     send[2 * (p - startF) + 1] = lastCell - firstCell;
2241     PetscCallMPI(MPI_Isend(&send[2 * (p - startF)], 2, MPIU_INT, p, tag, comm, &sendReqs[p - startF]));
2242   }
2243   PetscCallMPI(MPI_Waitall((PetscMPIInt)(endC - startC), recvReqs, MPI_STATUSES_IGNORE));
2244   PetscCall(PetscSectionCreate(PETSC_COMM_SELF, &section));
2245   PetscCall(PetscSectionSetChart(section, startC, endC));
2246   for (p = startC; p < endC; p++) {
2247     PetscInt numCells = recv[2 * (p - startC) + 1];
2248     PetscCall(PetscSectionSetDof(section, p, numCells));
2249   }
2250   PetscCall(PetscSectionSetUp(section));
2251   PetscCall(PetscSectionGetStorageSize(section, &nLeaves));
2252   PetscCall(PetscMalloc1(nLeaves, &leaves));
2253   for (p = startC; p < endC; p++) {
2254     PetscInt firstCell = recv[2 * (p - startC)];
2255     PetscInt numCells  = recv[2 * (p - startC) + 1];
2256     PetscInt off, i;
2257 
2258     PetscCall(PetscSectionGetOffset(section, p, &off));
2259     for (i = 0; i < numCells; i++) {
2260       leaves[off + i].rank  = p;
2261       leaves[off + i].index = firstCell + i;
2262     }
2263   }
2264   PetscCall(PetscSFCreate(comm, &sf));
2265   PetscCall(PetscSFSetGraph(sf, cEnd - cStart, nLeaves, NULL, PETSC_OWN_POINTER, leaves, PETSC_OWN_POINTER));
2266   PetscCall(PetscSectionDestroy(&section));
2267   PetscCallMPI(MPI_Waitall((PetscMPIInt)(endF - startF), sendReqs, MPI_STATUSES_IGNORE));
2268   PetscCall(PetscFree2(send, sendReqs));
2269   PetscCall(PetscFree2(recv, recvReqs));
2270   *coveringSF = sf;
2271   PetscFunctionReturn(PETSC_SUCCESS);
2272 }
2273 
2274 /* closure points for locally-owned cells */
2275 static PetscErrorCode DMPforestGetCellSFNodes(DM dm, PetscInt numClosureIndices, PetscInt *numClosurePoints, PetscSFNode **closurePoints, PetscBool redirect)
2276 {
2277   PetscInt           cStart, cEnd;
2278   PetscInt           count, c;
2279   PetscMPIInt        rank;
2280   PetscInt           closureSize = -1;
2281   PetscInt          *closure     = NULL;
2282   PetscSF            pointSF;
2283   PetscInt           nleaves, nroots;
2284   const PetscInt    *ilocal;
2285   const PetscSFNode *iremote;
2286   DM                 plex;
2287   DM_Forest         *forest;
2288   DM_Forest_pforest *pforest;
2289 
2290   PetscFunctionBegin;
2291   forest  = (DM_Forest *)dm->data;
2292   pforest = (DM_Forest_pforest *)forest->data;
2293   cStart  = pforest->cLocalStart;
2294   cEnd    = pforest->cLocalEnd;
2295   PetscCall(DMPforestGetPlex(dm, &plex));
2296   PetscCall(DMGetPointSF(dm, &pointSF));
2297   PetscCall(PetscSFGetGraph(pointSF, &nroots, &nleaves, &ilocal, &iremote));
2298   nleaves           = PetscMax(0, nleaves);
2299   nroots            = PetscMax(0, nroots);
2300   *numClosurePoints = numClosureIndices * (cEnd - cStart);
2301   PetscCall(PetscMalloc1(*numClosurePoints, closurePoints));
2302   PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank));
2303   for (c = cStart, count = 0; c < cEnd; c++) {
2304     PetscInt i;
2305     PetscCall(DMPlexGetTransitiveClosure(plex, c, PETSC_TRUE, &closureSize, &closure));
2306 
2307     for (i = 0; i < numClosureIndices; i++, count++) {
2308       PetscInt p   = closure[2 * i];
2309       PetscInt loc = -1;
2310 
2311       PetscCall(PetscFindInt(p, nleaves, ilocal, &loc));
2312       if (redirect && loc >= 0) {
2313         (*closurePoints)[count].rank  = iremote[loc].rank;
2314         (*closurePoints)[count].index = iremote[loc].index;
2315       } else {
2316         (*closurePoints)[count].rank  = rank;
2317         (*closurePoints)[count].index = p;
2318       }
2319     }
2320     PetscCall(DMPlexRestoreTransitiveClosure(plex, c, PETSC_TRUE, &closureSize, &closure));
2321   }
2322   PetscFunctionReturn(PETSC_SUCCESS);
2323 }
2324 
2325 static void MPIAPI DMPforestMaxSFNode(void *a, void *b, PetscMPIInt *len, MPI_Datatype *type)
2326 {
2327   PetscMPIInt i;
2328 
2329   for (i = 0; i < *len; i++) {
2330     PetscSFNode *A = (PetscSFNode *)a;
2331     PetscSFNode *B = (PetscSFNode *)b;
2332 
2333     if (B->rank < 0) *B = *A;
2334   }
2335 }
2336 
2337 static PetscErrorCode DMPforestGetTransferSF_Point(DM coarse, DM fine, PetscSF *sf, PetscBool transferIdent, PetscInt *childIds[])
2338 {
2339   MPI_Comm           comm;
2340   PetscMPIInt        rank, size;
2341   DM_Forest_pforest *pforestC, *pforestF;
2342   p4est_t           *p4estC, *p4estF;
2343   PetscInt           numClosureIndices;
2344   PetscInt           numClosurePointsC, numClosurePointsF;
2345   PetscSFNode       *closurePointsC, *closurePointsF;
2346   p4est_quadrant_t  *coverQuads = NULL;
2347   p4est_quadrant_t **treeQuads;
2348   PetscInt          *treeQuadCounts;
2349   MPI_Datatype       nodeType;
2350   MPI_Datatype       nodeClosureType;
2351   MPI_Op             sfNodeReduce;
2352   p4est_topidx_t     fltF, lltF, t;
2353   DM                 plexC, plexF;
2354   PetscInt           pStartF, pEndF, pStartC, pEndC;
2355   PetscBool          saveInCoarse = PETSC_FALSE;
2356   PetscBool          saveInFine   = PETSC_FALSE;
2357   PetscBool          formCids     = (childIds != NULL) ? PETSC_TRUE : PETSC_FALSE;
2358   PetscInt          *cids         = NULL;
2359 
2360   PetscFunctionBegin;
2361   pforestC = (DM_Forest_pforest *)((DM_Forest *)coarse->data)->data;
2362   pforestF = (DM_Forest_pforest *)((DM_Forest *)fine->data)->data;
2363   p4estC   = pforestC->forest;
2364   p4estF   = pforestF->forest;
2365   PetscCheck(pforestC->topo == pforestF->topo, PetscObjectComm((PetscObject)coarse), PETSC_ERR_ARG_INCOMP, "DM's must have the same base DM");
2366   comm = PetscObjectComm((PetscObject)coarse);
2367   PetscCallMPI(MPI_Comm_rank(comm, &rank));
2368   PetscCallMPI(MPI_Comm_size(comm, &size));
2369   PetscCall(DMPforestGetPlex(fine, &plexF));
2370   PetscCall(DMPlexGetChart(plexF, &pStartF, &pEndF));
2371   PetscCall(DMPforestGetPlex(coarse, &plexC));
2372   PetscCall(DMPlexGetChart(plexC, &pStartC, &pEndC));
2373   { /* check if the results have been cached */
2374     DM adaptCoarse, adaptFine;
2375 
2376     PetscCall(DMForestGetAdaptivityForest(coarse, &adaptCoarse));
2377     PetscCall(DMForestGetAdaptivityForest(fine, &adaptFine));
2378     if (adaptCoarse && adaptCoarse->data == fine->data) { /* coarse is adapted from fine */
2379       if (pforestC->pointSelfToAdaptSF) {
2380         PetscCall(PetscObjectReference((PetscObject)(pforestC->pointSelfToAdaptSF)));
2381         *sf = pforestC->pointSelfToAdaptSF;
2382         if (childIds) {
2383           PetscCall(PetscMalloc1(pEndF - pStartF, &cids));
2384           PetscCall(PetscArraycpy(cids, pforestC->pointSelfToAdaptCids, pEndF - pStartF));
2385           *childIds = cids;
2386         }
2387         PetscFunctionReturn(PETSC_SUCCESS);
2388       } else {
2389         saveInCoarse = PETSC_TRUE;
2390         formCids     = PETSC_TRUE;
2391       }
2392     } else if (adaptFine && adaptFine->data == coarse->data) { /* fine is adapted from coarse */
2393       if (pforestF->pointAdaptToSelfSF) {
2394         PetscCall(PetscObjectReference((PetscObject)(pforestF->pointAdaptToSelfSF)));
2395         *sf = pforestF->pointAdaptToSelfSF;
2396         if (childIds) {
2397           PetscCall(PetscMalloc1(pEndF - pStartF, &cids));
2398           PetscCall(PetscArraycpy(cids, pforestF->pointAdaptToSelfCids, pEndF - pStartF));
2399           *childIds = cids;
2400         }
2401         PetscFunctionReturn(PETSC_SUCCESS);
2402       } else {
2403         saveInFine = PETSC_TRUE;
2404         formCids   = PETSC_TRUE;
2405       }
2406     }
2407   }
2408 
2409   /* count the number of closure points that have dofs and create a list */
2410   numClosureIndices = P4EST_INSUL;
2411   /* create the datatype */
2412   PetscCallMPI(MPI_Type_contiguous(2, MPIU_INT, &nodeType));
2413   PetscCallMPI(MPI_Type_commit(&nodeType));
2414   PetscCallMPI(MPI_Op_create(DMPforestMaxSFNode, PETSC_FALSE, &sfNodeReduce));
2415   PetscCallMPI(MPI_Type_contiguous(numClosureIndices * 2, MPIU_INT, &nodeClosureType));
2416   PetscCallMPI(MPI_Type_commit(&nodeClosureType));
2417   /* everything has to go through cells: for each cell, create a list of the sfnodes in its closure */
2418   /* get lists of closure point SF nodes for every cell */
2419   PetscCall(DMPforestGetCellSFNodes(coarse, numClosureIndices, &numClosurePointsC, &closurePointsC, PETSC_TRUE));
2420   PetscCall(DMPforestGetCellSFNodes(fine, numClosureIndices, &numClosurePointsF, &closurePointsF, PETSC_FALSE));
2421   /* create pointers for tree lists */
2422   fltF = p4estF->first_local_tree;
2423   lltF = p4estF->last_local_tree;
2424   PetscCall(PetscCalloc2(lltF + 1 - fltF, &treeQuads, lltF + 1 - fltF, &treeQuadCounts));
2425   /* if the partitions don't match, ship the coarse to cover the fine */
2426   if (size > 1) {
2427     PetscInt p;
2428 
2429     for (p = 0; p < size; p++) {
2430       int equal;
2431 
2432       PetscCallP4estReturn(equal, p4est_quadrant_is_equal_piggy, (&p4estC->global_first_position[p], &p4estF->global_first_position[p]));
2433       if (!equal) break;
2434     }
2435     if (p < size) { /* non-matching distribution: send the coarse to cover the fine */
2436       PetscInt          cStartC, cEndC;
2437       PetscSF           coveringSF;
2438       PetscInt          nleaves;
2439       PetscInt          count;
2440       PetscSFNode      *newClosurePointsC;
2441       p4est_quadrant_t *coverQuadsSend;
2442       p4est_topidx_t    fltC = p4estC->first_local_tree;
2443       p4est_topidx_t    lltC = p4estC->last_local_tree;
2444       p4est_topidx_t    t;
2445       PetscMPIInt       blockSizes[4]   = {P4EST_DIM, 2, 1, 1};
2446       MPI_Aint          blockOffsets[4] = {offsetof(p4est_quadrant_t, x), offsetof(p4est_quadrant_t, level), offsetof(p4est_quadrant_t, pad16), offsetof(p4est_quadrant_t, p)};
2447       MPI_Datatype      blockTypes[4]   = {MPI_INT32_T, MPI_INT8_T, MPI_INT16_T, MPI_INT32_T /* p.which_tree */};
2448       MPI_Datatype      quadStruct, quadType;
2449 
2450       PetscCall(DMPlexGetSimplexOrBoxCells(plexC, 0, &cStartC, &cEndC));
2451       PetscCall(DMPforestGetCellCoveringSF(comm, p4estC, p4estF, pforestC->cLocalStart, pforestC->cLocalEnd, &coveringSF));
2452       PetscCall(PetscSFGetGraph(coveringSF, NULL, &nleaves, NULL, NULL));
2453       PetscCall(PetscMalloc1(numClosureIndices * nleaves, &newClosurePointsC));
2454       PetscCall(PetscMalloc1(nleaves, &coverQuads));
2455       PetscCall(PetscMalloc1(cEndC - cStartC, &coverQuadsSend));
2456       count = 0;
2457       for (t = fltC; t <= lltC; t++) { /* unfortunately, we need to pack a send array, since quads are not stored packed in p4est */
2458         p4est_tree_t *tree = &(((p4est_tree_t *)p4estC->trees->array)[t]);
2459         PetscInt      q;
2460 
2461         PetscCall(PetscMemcpy(&coverQuadsSend[count], tree->quadrants.array, tree->quadrants.elem_count * sizeof(p4est_quadrant_t)));
2462         for (q = 0; (size_t)q < tree->quadrants.elem_count; q++) coverQuadsSend[count + q].p.which_tree = t;
2463         count += tree->quadrants.elem_count;
2464       }
2465       /* p is of a union type p4est_quadrant_data, but only the p.which_tree field is active at this time. So, we
2466          have a simple blockTypes[] to use. Note that quadStruct does not count potential padding in array of
2467          p4est_quadrant_t. We have to call MPI_Type_create_resized() to change upper-bound of quadStruct.
2468        */
2469       PetscCallMPI(MPI_Type_create_struct(4, blockSizes, blockOffsets, blockTypes, &quadStruct));
2470       PetscCallMPI(MPI_Type_create_resized(quadStruct, 0, sizeof(p4est_quadrant_t), &quadType));
2471       PetscCallMPI(MPI_Type_commit(&quadType));
2472       PetscCall(PetscSFBcastBegin(coveringSF, nodeClosureType, closurePointsC, newClosurePointsC, MPI_REPLACE));
2473       PetscCall(PetscSFBcastBegin(coveringSF, quadType, coverQuadsSend, coverQuads, MPI_REPLACE));
2474       PetscCall(PetscSFBcastEnd(coveringSF, nodeClosureType, closurePointsC, newClosurePointsC, MPI_REPLACE));
2475       PetscCall(PetscSFBcastEnd(coveringSF, quadType, coverQuadsSend, coverQuads, MPI_REPLACE));
2476       PetscCallMPI(MPI_Type_free(&quadStruct));
2477       PetscCallMPI(MPI_Type_free(&quadType));
2478       PetscCall(PetscFree(coverQuadsSend));
2479       PetscCall(PetscFree(closurePointsC));
2480       PetscCall(PetscSFDestroy(&coveringSF));
2481       closurePointsC = newClosurePointsC;
2482 
2483       /* assign tree quads based on locations in coverQuads */
2484       {
2485         PetscInt q;
2486         for (q = 0; q < nleaves; q++) {
2487           p4est_locidx_t t = coverQuads[q].p.which_tree;
2488           if (!treeQuadCounts[t - fltF]++) treeQuads[t - fltF] = &coverQuads[q];
2489         }
2490       }
2491     }
2492   }
2493   if (!coverQuads) { /* matching partitions: assign tree quads based on locations in p4est native arrays */
2494     for (t = fltF; t <= lltF; t++) {
2495       p4est_tree_t *tree = &(((p4est_tree_t *)p4estC->trees->array)[t]);
2496 
2497       treeQuadCounts[t - fltF] = tree->quadrants.elem_count;
2498       treeQuads[t - fltF]      = (p4est_quadrant_t *)tree->quadrants.array;
2499     }
2500   }
2501 
2502   {
2503     PetscInt     p;
2504     PetscInt     cLocalStartF;
2505     PetscSF      pointSF;
2506     PetscSFNode *roots;
2507     PetscInt    *rootType;
2508     DM           refTree = NULL;
2509     DMLabel      canonical;
2510     PetscInt    *childClosures[P4EST_CHILDREN] = {NULL};
2511     PetscInt    *rootClosure                   = NULL;
2512     PetscInt     coarseOffset;
2513     PetscInt     numCoarseQuads;
2514 
2515     PetscCall(PetscMalloc1(pEndF - pStartF, &roots));
2516     PetscCall(PetscMalloc1(pEndF - pStartF, &rootType));
2517     PetscCall(DMGetPointSF(fine, &pointSF));
2518     for (p = pStartF; p < pEndF; p++) {
2519       roots[p - pStartF].rank  = -1;
2520       roots[p - pStartF].index = -1;
2521       rootType[p - pStartF]    = -1;
2522     }
2523     if (formCids) {
2524       PetscInt child;
2525 
2526       PetscCall(PetscMalloc1(pEndF - pStartF, &cids));
2527       for (p = pStartF; p < pEndF; p++) cids[p - pStartF] = -2;
2528       PetscCall(DMPlexGetReferenceTree(plexF, &refTree));
2529       PetscCall(DMPlexGetTransitiveClosure(refTree, 0, PETSC_TRUE, NULL, &rootClosure));
2530       for (child = 0; child < P4EST_CHILDREN; child++) { /* get the closures of the child cells in the reference tree */
2531         PetscCall(DMPlexGetTransitiveClosure(refTree, child + 1, PETSC_TRUE, NULL, &childClosures[child]));
2532       }
2533       PetscCall(DMGetLabel(refTree, "canonical", &canonical));
2534     }
2535     cLocalStartF = pforestF->cLocalStart;
2536     for (t = fltF, coarseOffset = 0, numCoarseQuads = 0; t <= lltF; t++, coarseOffset += numCoarseQuads) {
2537       p4est_tree_t     *tree         = &(((p4est_tree_t *)p4estF->trees->array)[t]);
2538       PetscInt          numFineQuads = tree->quadrants.elem_count;
2539       p4est_quadrant_t *coarseQuads  = treeQuads[t - fltF];
2540       p4est_quadrant_t *fineQuads    = (p4est_quadrant_t *)tree->quadrants.array;
2541       PetscInt          i, coarseCount = 0;
2542       PetscInt          offset = tree->quadrants_offset;
2543       sc_array_t        coarseQuadsArray;
2544 
2545       numCoarseQuads = treeQuadCounts[t - fltF];
2546       PetscCallP4est(sc_array_init_data, (&coarseQuadsArray, coarseQuads, sizeof(p4est_quadrant_t), (size_t)numCoarseQuads));
2547       for (i = 0; i < numFineQuads; i++) {
2548         PetscInt          c          = i + offset;
2549         p4est_quadrant_t *quad       = &fineQuads[i];
2550         p4est_quadrant_t *quadCoarse = NULL;
2551         ssize_t           disjoint   = -1;
2552 
2553         while (disjoint < 0 && coarseCount < numCoarseQuads) {
2554           quadCoarse = &coarseQuads[coarseCount];
2555           PetscCallP4estReturn(disjoint, p4est_quadrant_disjoint, (quadCoarse, quad));
2556           if (disjoint < 0) coarseCount++;
2557         }
2558         PetscCheck(disjoint == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "did not find overlapping coarse quad");
2559         if (quadCoarse->level > quad->level || (quadCoarse->level == quad->level && !transferIdent)) { /* the "coarse" mesh is finer than the fine mesh at the point: continue */
2560           if (transferIdent) {                                                                         /* find corners */
2561             PetscInt j = 0;
2562 
2563             do {
2564               if (j < P4EST_CHILDREN) {
2565                 p4est_quadrant_t cornerQuad;
2566                 int              equal;
2567 
2568                 PetscCallP4est(p4est_quadrant_corner_descendant, (quad, &cornerQuad, j, quadCoarse->level));
2569                 PetscCallP4estReturn(equal, p4est_quadrant_is_equal, (&cornerQuad, quadCoarse));
2570                 if (equal) {
2571                   PetscInt    petscJ = P4estVertToPetscVert[j];
2572                   PetscInt    p      = closurePointsF[numClosureIndices * c + (P4EST_INSUL - P4EST_CHILDREN) + petscJ].index;
2573                   PetscSFNode q      = closurePointsC[numClosureIndices * (coarseCount + coarseOffset) + (P4EST_INSUL - P4EST_CHILDREN) + petscJ];
2574 
2575                   roots[p - pStartF]    = q;
2576                   rootType[p - pStartF] = PETSC_MAX_INT;
2577                   cids[p - pStartF]     = -1;
2578                   j++;
2579                 }
2580               }
2581               coarseCount++;
2582               disjoint = 1;
2583               if (coarseCount < numCoarseQuads) {
2584                 quadCoarse = &coarseQuads[coarseCount];
2585                 PetscCallP4estReturn(disjoint, p4est_quadrant_disjoint, (quadCoarse, quad));
2586               }
2587             } while (!disjoint);
2588           }
2589           continue;
2590         }
2591         if (quadCoarse->level == quad->level) { /* same quad present in coarse and fine mesh */
2592           PetscInt j;
2593           for (j = 0; j < numClosureIndices; j++) {
2594             PetscInt p = closurePointsF[numClosureIndices * c + j].index;
2595 
2596             roots[p - pStartF]    = closurePointsC[numClosureIndices * (coarseCount + coarseOffset) + j];
2597             rootType[p - pStartF] = PETSC_MAX_INT; /* unconditionally accept */
2598             cids[p - pStartF]     = -1;
2599           }
2600         } else {
2601           PetscInt levelDiff                 = quad->level - quadCoarse->level;
2602           PetscInt proposedCids[P4EST_INSUL] = {0};
2603 
2604           if (formCids) {
2605             PetscInt  cl;
2606             PetscInt *pointClosure = NULL;
2607             int       cid;
2608 
2609             PetscCheck(levelDiff <= 1, PETSC_COMM_SELF, PETSC_ERR_USER, "Recursive child ids not implemented");
2610             PetscCallP4estReturn(cid, p4est_quadrant_child_id, (quad));
2611             PetscCall(DMPlexGetTransitiveClosure(plexF, c + cLocalStartF, PETSC_TRUE, NULL, &pointClosure));
2612             for (cl = 0; cl < P4EST_INSUL; cl++) {
2613               PetscInt       p      = pointClosure[2 * cl];
2614               PetscInt       point  = childClosures[cid][2 * cl];
2615               PetscInt       ornt   = childClosures[cid][2 * cl + 1];
2616               PetscInt       newcid = -1;
2617               DMPolytopeType ct;
2618 
2619               if (rootType[p - pStartF] == PETSC_MAX_INT) continue;
2620               PetscCall(DMPlexGetCellType(refTree, point, &ct));
2621               ornt = DMPolytopeConvertNewOrientation_Internal(ct, ornt);
2622               if (!cl) {
2623                 newcid = cid + 1;
2624               } else {
2625                 PetscInt rcl, parent, parentOrnt = 0;
2626 
2627                 PetscCall(DMPlexGetTreeParent(refTree, point, &parent, NULL));
2628                 if (parent == point) {
2629                   newcid = -1;
2630                 } else if (!parent) { /* in the root */
2631                   newcid = point;
2632                 } else {
2633                   DMPolytopeType rct = DM_POLYTOPE_UNKNOWN;
2634 
2635                   for (rcl = 1; rcl < P4EST_INSUL; rcl++) {
2636                     if (rootClosure[2 * rcl] == parent) {
2637                       PetscCall(DMPlexGetCellType(refTree, parent, &rct));
2638                       parentOrnt = DMPolytopeConvertNewOrientation_Internal(rct, rootClosure[2 * rcl + 1]);
2639                       break;
2640                     }
2641                   }
2642                   PetscCheck(rcl < P4EST_INSUL, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Couldn't find parent in root closure");
2643                   PetscCall(DMPlexReferenceTreeGetChildSymmetry(refTree, parent, parentOrnt, ornt, point, DMPolytopeConvertNewOrientation_Internal(rct, pointClosure[2 * rcl + 1]), NULL, &newcid));
2644                 }
2645               }
2646               if (newcid >= 0) {
2647                 if (canonical) PetscCall(DMLabelGetValue(canonical, newcid, &newcid));
2648                 proposedCids[cl] = newcid;
2649               }
2650             }
2651             PetscCall(DMPlexRestoreTransitiveClosure(plexF, c + cLocalStartF, PETSC_TRUE, NULL, &pointClosure));
2652           }
2653           p4est_qcoord_t coarseBound[2][P4EST_DIM] = {
2654             {quadCoarse->x, quadCoarse->y,
2655   #if defined(P4_TO_P8)
2656              quadCoarse->z
2657   #endif
2658             },
2659             {0}
2660           };
2661           p4est_qcoord_t fineBound[2][P4EST_DIM] = {
2662             {quad->x, quad->y,
2663   #if defined(P4_TO_P8)
2664              quad->z
2665   #endif
2666             },
2667             {0}
2668           };
2669           PetscInt j;
2670           for (j = 0; j < P4EST_DIM; j++) { /* get the coordinates of cell boundaries in each direction */
2671             coarseBound[1][j] = coarseBound[0][j] + P4EST_QUADRANT_LEN(quadCoarse->level);
2672             fineBound[1][j]   = fineBound[0][j] + P4EST_QUADRANT_LEN(quad->level);
2673           }
2674           for (j = 0; j < numClosureIndices; j++) {
2675             PetscInt    l, p;
2676             PetscSFNode q;
2677 
2678             p = closurePointsF[numClosureIndices * c + j].index;
2679             if (rootType[p - pStartF] == PETSC_MAX_INT) continue;
2680             if (j == 0) { /* volume: ancestor is volume */
2681               l = 0;
2682             } else if (j < 1 + P4EST_FACES) { /* facet */
2683               PetscInt face       = PetscFaceToP4estFace[j - 1];
2684               PetscInt direction  = face / 2;
2685               PetscInt coarseFace = -1;
2686 
2687               if (coarseBound[face % 2][direction] == fineBound[face % 2][direction]) {
2688                 coarseFace = face;
2689                 l          = 1 + P4estFaceToPetscFace[coarseFace];
2690               } else {
2691                 l = 0;
2692               }
2693   #if defined(P4_TO_P8)
2694             } else if (j < 1 + P4EST_FACES + P8EST_EDGES) {
2695               PetscInt  edge       = PetscEdgeToP4estEdge[j - (1 + P4EST_FACES)];
2696               PetscInt  direction  = edge / 4;
2697               PetscInt  mod        = edge % 4;
2698               PetscInt  coarseEdge = -1, coarseFace = -1;
2699               PetscInt  minDir = PetscMin((direction + 1) % 3, (direction + 2) % 3);
2700               PetscInt  maxDir = PetscMax((direction + 1) % 3, (direction + 2) % 3);
2701               PetscBool dirTest[2];
2702 
2703               dirTest[0] = (PetscBool)(coarseBound[mod % 2][minDir] == fineBound[mod % 2][minDir]);
2704               dirTest[1] = (PetscBool)(coarseBound[mod / 2][maxDir] == fineBound[mod / 2][maxDir]);
2705 
2706               if (dirTest[0] && dirTest[1]) { /* fine edge falls on coarse edge */
2707                 coarseEdge = edge;
2708                 l          = 1 + P4EST_FACES + P4estEdgeToPetscEdge[coarseEdge];
2709               } else if (dirTest[0]) { /* fine edge falls on a coarse face in the minDir direction */
2710                 coarseFace = 2 * minDir + (mod % 2);
2711                 l          = 1 + P4estFaceToPetscFace[coarseFace];
2712               } else if (dirTest[1]) { /* fine edge falls on a coarse face in the maxDir direction */
2713                 coarseFace = 2 * maxDir + (mod / 2);
2714                 l          = 1 + P4estFaceToPetscFace[coarseFace];
2715               } else {
2716                 l = 0;
2717               }
2718   #endif
2719             } else {
2720               PetscInt  vertex = PetscVertToP4estVert[P4EST_CHILDREN - (P4EST_INSUL - j)];
2721               PetscBool dirTest[P4EST_DIM];
2722               PetscInt  m;
2723               PetscInt  numMatch     = 0;
2724               PetscInt  coarseVertex = -1, coarseFace = -1;
2725   #if defined(P4_TO_P8)
2726               PetscInt coarseEdge = -1;
2727   #endif
2728 
2729               for (m = 0; m < P4EST_DIM; m++) {
2730                 dirTest[m] = (PetscBool)(coarseBound[(vertex >> m) & 1][m] == fineBound[(vertex >> m) & 1][m]);
2731                 if (dirTest[m]) numMatch++;
2732               }
2733               if (numMatch == P4EST_DIM) { /* vertex on vertex */
2734                 coarseVertex = vertex;
2735                 l            = P4EST_INSUL - (P4EST_CHILDREN - P4estVertToPetscVert[coarseVertex]);
2736               } else if (numMatch == 1) { /* vertex on face */
2737                 for (m = 0; m < P4EST_DIM; m++) {
2738                   if (dirTest[m]) {
2739                     coarseFace = 2 * m + ((vertex >> m) & 1);
2740                     break;
2741                   }
2742                 }
2743                 l = 1 + P4estFaceToPetscFace[coarseFace];
2744   #if defined(P4_TO_P8)
2745               } else if (numMatch == 2) { /* vertex on edge */
2746                 for (m = 0; m < P4EST_DIM; m++) {
2747                   if (!dirTest[m]) {
2748                     PetscInt otherDir1 = (m + 1) % 3;
2749                     PetscInt otherDir2 = (m + 2) % 3;
2750                     PetscInt minDir    = PetscMin(otherDir1, otherDir2);
2751                     PetscInt maxDir    = PetscMax(otherDir1, otherDir2);
2752 
2753                     coarseEdge = m * 4 + 2 * ((vertex >> maxDir) & 1) + ((vertex >> minDir) & 1);
2754                     break;
2755                   }
2756                 }
2757                 l = 1 + P4EST_FACES + P4estEdgeToPetscEdge[coarseEdge];
2758   #endif
2759               } else { /* volume */
2760                 l = 0;
2761               }
2762             }
2763             q = closurePointsC[numClosureIndices * (coarseCount + coarseOffset) + l];
2764             if (l > rootType[p - pStartF]) {
2765               if (l >= P4EST_INSUL - P4EST_CHILDREN) { /* vertex on vertex: unconditional acceptance */
2766                 if (transferIdent) {
2767                   roots[p - pStartF]    = q;
2768                   rootType[p - pStartF] = PETSC_MAX_INT;
2769                   if (formCids) cids[p - pStartF] = -1;
2770                 }
2771               } else {
2772                 PetscInt k, thisp = p, limit;
2773 
2774                 roots[p - pStartF]    = q;
2775                 rootType[p - pStartF] = l;
2776                 if (formCids) cids[p - pStartF] = proposedCids[j];
2777                 limit = transferIdent ? levelDiff : (levelDiff - 1);
2778                 for (k = 0; k < limit; k++) {
2779                   PetscInt parent;
2780 
2781                   PetscCall(DMPlexGetTreeParent(plexF, thisp, &parent, NULL));
2782                   if (parent == thisp) break;
2783 
2784                   roots[parent - pStartF]    = q;
2785                   rootType[parent - pStartF] = PETSC_MAX_INT;
2786                   if (formCids) cids[parent - pStartF] = -1;
2787                   thisp = parent;
2788                 }
2789               }
2790             }
2791           }
2792         }
2793       }
2794     }
2795 
2796     /* now every cell has labeled the points in its closure, so we first make sure everyone agrees by reducing to roots, and the broadcast the agreements */
2797     if (size > 1) {
2798       PetscInt *rootTypeCopy, p;
2799 
2800       PetscCall(PetscMalloc1(pEndF - pStartF, &rootTypeCopy));
2801       PetscCall(PetscArraycpy(rootTypeCopy, rootType, pEndF - pStartF));
2802       PetscCall(PetscSFReduceBegin(pointSF, MPIU_INT, rootTypeCopy, rootTypeCopy, MPI_MAX));
2803       PetscCall(PetscSFReduceEnd(pointSF, MPIU_INT, rootTypeCopy, rootTypeCopy, MPI_MAX));
2804       PetscCall(PetscSFBcastBegin(pointSF, MPIU_INT, rootTypeCopy, rootTypeCopy, MPI_REPLACE));
2805       PetscCall(PetscSFBcastEnd(pointSF, MPIU_INT, rootTypeCopy, rootTypeCopy, MPI_REPLACE));
2806       for (p = pStartF; p < pEndF; p++) {
2807         if (rootTypeCopy[p - pStartF] > rootType[p - pStartF]) { /* another process found a root of higher type (e.g. vertex instead of edge), which we want to accept, so nullify this */
2808           roots[p - pStartF].rank  = -1;
2809           roots[p - pStartF].index = -1;
2810         }
2811         if (formCids && rootTypeCopy[p - pStartF] == PETSC_MAX_INT) { cids[p - pStartF] = -1; /* we have found an antecedent that is the same: no child id */ }
2812       }
2813       PetscCall(PetscFree(rootTypeCopy));
2814       PetscCall(PetscSFReduceBegin(pointSF, nodeType, roots, roots, sfNodeReduce));
2815       PetscCall(PetscSFReduceEnd(pointSF, nodeType, roots, roots, sfNodeReduce));
2816       PetscCall(PetscSFBcastBegin(pointSF, nodeType, roots, roots, MPI_REPLACE));
2817       PetscCall(PetscSFBcastEnd(pointSF, nodeType, roots, roots, MPI_REPLACE));
2818     }
2819     PetscCall(PetscFree(rootType));
2820 
2821     {
2822       PetscInt     numRoots;
2823       PetscInt     numLeaves;
2824       PetscInt    *leaves;
2825       PetscSFNode *iremote;
2826       /* count leaves */
2827 
2828       numRoots = pEndC - pStartC;
2829 
2830       numLeaves = 0;
2831       for (p = pStartF; p < pEndF; p++) {
2832         if (roots[p - pStartF].index >= 0) numLeaves++;
2833       }
2834       PetscCall(PetscMalloc1(numLeaves, &leaves));
2835       PetscCall(PetscMalloc1(numLeaves, &iremote));
2836       numLeaves = 0;
2837       for (p = pStartF; p < pEndF; p++) {
2838         if (roots[p - pStartF].index >= 0) {
2839           leaves[numLeaves]  = p - pStartF;
2840           iremote[numLeaves] = roots[p - pStartF];
2841           numLeaves++;
2842         }
2843       }
2844       PetscCall(PetscFree(roots));
2845       PetscCall(PetscSFCreate(comm, sf));
2846       if (numLeaves == (pEndF - pStartF)) {
2847         PetscCall(PetscFree(leaves));
2848         PetscCall(PetscSFSetGraph(*sf, numRoots, numLeaves, NULL, PETSC_OWN_POINTER, iremote, PETSC_OWN_POINTER));
2849       } else {
2850         PetscCall(PetscSFSetGraph(*sf, numRoots, numLeaves, leaves, PETSC_OWN_POINTER, iremote, PETSC_OWN_POINTER));
2851       }
2852     }
2853     if (formCids) {
2854       PetscSF  pointSF;
2855       PetscInt child;
2856 
2857       PetscCall(DMPlexGetReferenceTree(plexF, &refTree));
2858       PetscCall(DMGetPointSF(plexF, &pointSF));
2859       PetscCall(PetscSFReduceBegin(pointSF, MPIU_INT, cids, cids, MPI_MAX));
2860       PetscCall(PetscSFReduceEnd(pointSF, MPIU_INT, cids, cids, MPI_MAX));
2861       if (childIds) *childIds = cids;
2862       for (child = 0; child < P4EST_CHILDREN; child++) PetscCall(DMPlexRestoreTransitiveClosure(refTree, child + 1, PETSC_TRUE, NULL, &childClosures[child]));
2863       PetscCall(DMPlexRestoreTransitiveClosure(refTree, 0, PETSC_TRUE, NULL, &rootClosure));
2864     }
2865   }
2866   if (saveInCoarse) { /* cache results */
2867     PetscCall(PetscObjectReference((PetscObject)*sf));
2868     pforestC->pointSelfToAdaptSF = *sf;
2869     if (!childIds) {
2870       pforestC->pointSelfToAdaptCids = cids;
2871     } else {
2872       PetscCall(PetscMalloc1(pEndF - pStartF, &pforestC->pointSelfToAdaptCids));
2873       PetscCall(PetscArraycpy(pforestC->pointSelfToAdaptCids, cids, pEndF - pStartF));
2874     }
2875   } else if (saveInFine) {
2876     PetscCall(PetscObjectReference((PetscObject)*sf));
2877     pforestF->pointAdaptToSelfSF = *sf;
2878     if (!childIds) {
2879       pforestF->pointAdaptToSelfCids = cids;
2880     } else {
2881       PetscCall(PetscMalloc1(pEndF - pStartF, &pforestF->pointAdaptToSelfCids));
2882       PetscCall(PetscArraycpy(pforestF->pointAdaptToSelfCids, cids, pEndF - pStartF));
2883     }
2884   }
2885   PetscCall(PetscFree2(treeQuads, treeQuadCounts));
2886   PetscCall(PetscFree(coverQuads));
2887   PetscCall(PetscFree(closurePointsC));
2888   PetscCall(PetscFree(closurePointsF));
2889   PetscCallMPI(MPI_Type_free(&nodeClosureType));
2890   PetscCallMPI(MPI_Op_free(&sfNodeReduce));
2891   PetscCallMPI(MPI_Type_free(&nodeType));
2892   PetscFunctionReturn(PETSC_SUCCESS);
2893 }
2894 
2895 /* children are sf leaves of parents */
2896 static PetscErrorCode DMPforestGetTransferSF_Internal(DM coarse, DM fine, const PetscInt dofPerDim[], PetscSF *sf, PetscBool transferIdent, PetscInt *childIds[])
2897 {
2898   MPI_Comm           comm;
2899   PetscMPIInt        rank;
2900   DM_Forest_pforest *pforestC, *pforestF;
2901   DM                 plexC, plexF;
2902   PetscInt           pStartC, pEndC, pStartF, pEndF;
2903   PetscSF            pointTransferSF;
2904   PetscBool          allOnes = PETSC_TRUE;
2905 
2906   PetscFunctionBegin;
2907   pforestC = (DM_Forest_pforest *)((DM_Forest *)coarse->data)->data;
2908   pforestF = (DM_Forest_pforest *)((DM_Forest *)fine->data)->data;
2909   PetscCheck(pforestC->topo == pforestF->topo, PetscObjectComm((PetscObject)coarse), PETSC_ERR_ARG_INCOMP, "DM's must have the same base DM");
2910   comm = PetscObjectComm((PetscObject)coarse);
2911   PetscCallMPI(MPI_Comm_rank(comm, &rank));
2912 
2913   {
2914     PetscInt i;
2915     for (i = 0; i <= P4EST_DIM; i++) {
2916       if (dofPerDim[i] != 1) {
2917         allOnes = PETSC_FALSE;
2918         break;
2919       }
2920     }
2921   }
2922   PetscCall(DMPforestGetTransferSF_Point(coarse, fine, &pointTransferSF, transferIdent, childIds));
2923   if (allOnes) {
2924     *sf = pointTransferSF;
2925     PetscFunctionReturn(PETSC_SUCCESS);
2926   }
2927 
2928   PetscCall(DMPforestGetPlex(fine, &plexF));
2929   PetscCall(DMPlexGetChart(plexF, &pStartF, &pEndF));
2930   PetscCall(DMPforestGetPlex(coarse, &plexC));
2931   PetscCall(DMPlexGetChart(plexC, &pStartC, &pEndC));
2932   {
2933     PetscInt           numRoots;
2934     PetscInt           numLeaves;
2935     const PetscInt    *leaves;
2936     const PetscSFNode *iremote;
2937     PetscInt           d;
2938     PetscSection       leafSection, rootSection;
2939     /* count leaves */
2940 
2941     PetscCall(PetscSFGetGraph(pointTransferSF, &numRoots, &numLeaves, &leaves, &iremote));
2942     PetscCall(PetscSectionCreate(PETSC_COMM_SELF, &rootSection));
2943     PetscCall(PetscSectionCreate(PETSC_COMM_SELF, &leafSection));
2944     PetscCall(PetscSectionSetChart(rootSection, pStartC, pEndC));
2945     PetscCall(PetscSectionSetChart(leafSection, pStartF, pEndF));
2946 
2947     for (d = 0; d <= P4EST_DIM; d++) {
2948       PetscInt startC, endC, e;
2949 
2950       PetscCall(DMPlexGetSimplexOrBoxCells(plexC, P4EST_DIM - d, &startC, &endC));
2951       for (e = startC; e < endC; e++) PetscCall(PetscSectionSetDof(rootSection, e, dofPerDim[d]));
2952     }
2953 
2954     for (d = 0; d <= P4EST_DIM; d++) {
2955       PetscInt startF, endF, e;
2956 
2957       PetscCall(DMPlexGetSimplexOrBoxCells(plexF, P4EST_DIM - d, &startF, &endF));
2958       for (e = startF; e < endF; e++) PetscCall(PetscSectionSetDof(leafSection, e, dofPerDim[d]));
2959     }
2960 
2961     PetscCall(PetscSectionSetUp(rootSection));
2962     PetscCall(PetscSectionSetUp(leafSection));
2963     {
2964       PetscInt     nroots, nleaves;
2965       PetscInt    *mine, i, p;
2966       PetscInt    *offsets, *offsetsRoot;
2967       PetscSFNode *remote;
2968 
2969       PetscCall(PetscMalloc1(pEndF - pStartF, &offsets));
2970       PetscCall(PetscMalloc1(pEndC - pStartC, &offsetsRoot));
2971       for (p = pStartC; p < pEndC; p++) PetscCall(PetscSectionGetOffset(rootSection, p, &offsetsRoot[p - pStartC]));
2972       PetscCall(PetscSFBcastBegin(pointTransferSF, MPIU_INT, offsetsRoot, offsets, MPI_REPLACE));
2973       PetscCall(PetscSFBcastEnd(pointTransferSF, MPIU_INT, offsetsRoot, offsets, MPI_REPLACE));
2974       PetscCall(PetscSectionGetStorageSize(rootSection, &nroots));
2975       nleaves = 0;
2976       for (i = 0; i < numLeaves; i++) {
2977         PetscInt leaf = leaves ? leaves[i] : i;
2978         PetscInt dof;
2979 
2980         PetscCall(PetscSectionGetDof(leafSection, leaf, &dof));
2981         nleaves += dof;
2982       }
2983       PetscCall(PetscMalloc1(nleaves, &mine));
2984       PetscCall(PetscMalloc1(nleaves, &remote));
2985       nleaves = 0;
2986       for (i = 0; i < numLeaves; i++) {
2987         PetscInt leaf = leaves ? leaves[i] : i;
2988         PetscInt dof;
2989         PetscInt off, j;
2990 
2991         PetscCall(PetscSectionGetDof(leafSection, leaf, &dof));
2992         PetscCall(PetscSectionGetOffset(leafSection, leaf, &off));
2993         for (j = 0; j < dof; j++) {
2994           remote[nleaves].rank  = iremote[i].rank;
2995           remote[nleaves].index = offsets[leaf] + j;
2996           mine[nleaves++]       = off + j;
2997         }
2998       }
2999       PetscCall(PetscFree(offsetsRoot));
3000       PetscCall(PetscFree(offsets));
3001       PetscCall(PetscSFCreate(comm, sf));
3002       PetscCall(PetscSFSetGraph(*sf, nroots, nleaves, mine, PETSC_OWN_POINTER, remote, PETSC_OWN_POINTER));
3003     }
3004     PetscCall(PetscSectionDestroy(&leafSection));
3005     PetscCall(PetscSectionDestroy(&rootSection));
3006     PetscCall(PetscSFDestroy(&pointTransferSF));
3007   }
3008   PetscFunctionReturn(PETSC_SUCCESS);
3009 }
3010 
3011 static PetscErrorCode DMPforestGetTransferSF(DM dmA, DM dmB, const PetscInt dofPerDim[], PetscSF *sfAtoB, PetscSF *sfBtoA)
3012 {
3013   DM          adaptA, adaptB;
3014   DMAdaptFlag purpose;
3015 
3016   PetscFunctionBegin;
3017   PetscCall(DMForestGetAdaptivityForest(dmA, &adaptA));
3018   PetscCall(DMForestGetAdaptivityForest(dmB, &adaptB));
3019   /* it is more efficient when the coarser mesh is the first argument: reorder if we know one is coarser than the other */
3020   if (adaptA && adaptA->data == dmB->data) { /* dmA was adapted from dmB */
3021     PetscCall(DMForestGetAdaptivityPurpose(dmA, &purpose));
3022     if (purpose == DM_ADAPT_REFINE) {
3023       PetscCall(DMPforestGetTransferSF(dmB, dmA, dofPerDim, sfBtoA, sfAtoB));
3024       PetscFunctionReturn(PETSC_SUCCESS);
3025     }
3026   } else if (adaptB && adaptB->data == dmA->data) { /* dmB was adapted from dmA */
3027     PetscCall(DMForestGetAdaptivityPurpose(dmB, &purpose));
3028     if (purpose == DM_ADAPT_COARSEN) {
3029       PetscCall(DMPforestGetTransferSF(dmB, dmA, dofPerDim, sfBtoA, sfAtoB));
3030       PetscFunctionReturn(PETSC_SUCCESS);
3031     }
3032   }
3033   if (sfAtoB) PetscCall(DMPforestGetTransferSF_Internal(dmA, dmB, dofPerDim, sfAtoB, PETSC_TRUE, NULL));
3034   if (sfBtoA) PetscCall(DMPforestGetTransferSF_Internal(dmB, dmA, dofPerDim, sfBtoA, (PetscBool)(sfAtoB == NULL), NULL));
3035   PetscFunctionReturn(PETSC_SUCCESS);
3036 }
3037 
3038 static PetscErrorCode DMPforestLabelsInitialize(DM dm, DM plex)
3039 {
3040   DM_Forest         *forest  = (DM_Forest *)dm->data;
3041   DM_Forest_pforest *pforest = (DM_Forest_pforest *)forest->data;
3042   PetscInt           cLocalStart, cLocalEnd, cStart, cEnd, fStart, fEnd, eStart, eEnd, vStart, vEnd;
3043   PetscInt           cStartBase, cEndBase, fStartBase, fEndBase, vStartBase, vEndBase, eStartBase, eEndBase;
3044   PetscInt           pStart, pEnd, pStartBase, pEndBase, p;
3045   DM                 base;
3046   PetscInt          *star      = NULL, starSize;
3047   DMLabelLink        next      = dm->labels;
3048   PetscInt           guess     = 0;
3049   p4est_topidx_t     num_trees = pforest->topo->conn->num_trees;
3050 
3051   PetscFunctionBegin;
3052   pforest->labelsFinalized = PETSC_TRUE;
3053   cLocalStart              = pforest->cLocalStart;
3054   cLocalEnd                = pforest->cLocalEnd;
3055   PetscCall(DMForestGetBaseDM(dm, &base));
3056   if (!base) {
3057     if (pforest->ghostName) { /* insert a label to make the boundaries, with stratum values denoting which face of the element touches the boundary */
3058       p4est_connectivity_t *conn  = pforest->topo->conn;
3059       p4est_t              *p4est = pforest->forest;
3060       p4est_tree_t         *trees = (p4est_tree_t *)p4est->trees->array;
3061       p4est_topidx_t        t, flt = p4est->first_local_tree;
3062       p4est_topidx_t        llt = pforest->forest->last_local_tree;
3063       DMLabel               ghostLabel;
3064       PetscInt              c;
3065 
3066       PetscCall(DMCreateLabel(plex, pforest->ghostName));
3067       PetscCall(DMGetLabel(plex, pforest->ghostName, &ghostLabel));
3068       for (c = cLocalStart, t = flt; t <= llt; t++) {
3069         p4est_tree_t     *tree     = &trees[t];
3070         p4est_quadrant_t *quads    = (p4est_quadrant_t *)tree->quadrants.array;
3071         PetscInt          numQuads = (PetscInt)tree->quadrants.elem_count;
3072         PetscInt          q;
3073 
3074         for (q = 0; q < numQuads; q++, c++) {
3075           p4est_quadrant_t *quad = &quads[q];
3076           PetscInt          f;
3077 
3078           for (f = 0; f < P4EST_FACES; f++) {
3079             p4est_quadrant_t neigh;
3080             int              isOutside;
3081 
3082             PetscCallP4est(p4est_quadrant_face_neighbor, (quad, f, &neigh));
3083             PetscCallP4estReturn(isOutside, p4est_quadrant_is_outside_face, (&neigh));
3084             if (isOutside) {
3085               p4est_topidx_t nt;
3086               PetscInt       nf;
3087 
3088               nt = conn->tree_to_tree[t * P4EST_FACES + f];
3089               nf = (PetscInt)conn->tree_to_face[t * P4EST_FACES + f];
3090               nf = nf % P4EST_FACES;
3091               if (nt == t && nf == f) {
3092                 PetscInt        plexF = P4estFaceToPetscFace[f];
3093                 const PetscInt *cone;
3094 
3095                 PetscCall(DMPlexGetCone(plex, c, &cone));
3096                 PetscCall(DMLabelSetValue(ghostLabel, cone[plexF], plexF + 1));
3097               }
3098             }
3099           }
3100         }
3101       }
3102     }
3103     PetscFunctionReturn(PETSC_SUCCESS);
3104   }
3105   PetscCall(DMPlexGetSimplexOrBoxCells(base, 0, &cStartBase, &cEndBase));
3106   PetscCall(DMPlexGetSimplexOrBoxCells(base, 1, &fStartBase, &fEndBase));
3107   PetscCall(DMPlexGetSimplexOrBoxCells(base, P4EST_DIM - 1, &eStartBase, &eEndBase));
3108   PetscCall(DMPlexGetDepthStratum(base, 0, &vStartBase, &vEndBase));
3109 
3110   PetscCall(DMPlexGetSimplexOrBoxCells(plex, 0, &cStart, &cEnd));
3111   PetscCall(DMPlexGetSimplexOrBoxCells(plex, 1, &fStart, &fEnd));
3112   PetscCall(DMPlexGetSimplexOrBoxCells(plex, P4EST_DIM - 1, &eStart, &eEnd));
3113   PetscCall(DMPlexGetDepthStratum(plex, 0, &vStart, &vEnd));
3114 
3115   PetscCall(DMPlexGetChart(plex, &pStart, &pEnd));
3116   PetscCall(DMPlexGetChart(base, &pStartBase, &pEndBase));
3117   /* go through the mesh: use star to find a quadrant that borders a point.  Use the closure to determine the
3118    * orientation of the quadrant relative to that point.  Use that to relate the point to the numbering in the base
3119    * mesh, and extract a label value (since the base mesh is redundantly distributed, can be found locally). */
3120   while (next) {
3121     DMLabel     baseLabel;
3122     DMLabel     label = next->label;
3123     PetscBool   isDepth, isCellType, isGhost, isVTK, isSpmap;
3124     const char *name;
3125 
3126     PetscCall(PetscObjectGetName((PetscObject)label, &name));
3127     PetscCall(PetscStrcmp(name, "depth", &isDepth));
3128     if (isDepth) {
3129       next = next->next;
3130       continue;
3131     }
3132     PetscCall(PetscStrcmp(name, "celltype", &isCellType));
3133     if (isCellType) {
3134       next = next->next;
3135       continue;
3136     }
3137     PetscCall(PetscStrcmp(name, "ghost", &isGhost));
3138     if (isGhost) {
3139       next = next->next;
3140       continue;
3141     }
3142     PetscCall(PetscStrcmp(name, "vtk", &isVTK));
3143     if (isVTK) {
3144       next = next->next;
3145       continue;
3146     }
3147     PetscCall(PetscStrcmp(name, "_forest_base_subpoint_map", &isSpmap));
3148     if (!isSpmap) {
3149       PetscCall(DMGetLabel(base, name, &baseLabel));
3150       if (!baseLabel) {
3151         next = next->next;
3152         continue;
3153       }
3154       PetscCall(DMLabelCreateIndex(baseLabel, pStartBase, pEndBase));
3155     } else baseLabel = NULL;
3156 
3157     for (p = pStart; p < pEnd; p++) {
3158       PetscInt          s, c = -1, l;
3159       PetscInt         *closure = NULL, closureSize;
3160       p4est_quadrant_t *ghosts  = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
3161       p4est_tree_t     *trees   = (p4est_tree_t *)pforest->forest->trees->array;
3162       p4est_quadrant_t *q;
3163       PetscInt          t, val;
3164       PetscBool         zerosupportpoint = PETSC_FALSE;
3165 
3166       PetscCall(DMPlexGetTransitiveClosure(plex, p, PETSC_FALSE, &starSize, &star));
3167       for (s = 0; s < starSize; s++) {
3168         PetscInt point = star[2 * s];
3169 
3170         if (cStart <= point && point < cEnd) {
3171           PetscCall(DMPlexGetTransitiveClosure(plex, point, PETSC_TRUE, &closureSize, &closure));
3172           for (l = 0; l < closureSize; l++) {
3173             PetscInt qParent = closure[2 * l], q, pp = p, pParent = p;
3174             do { /* check parents of q */
3175               q = qParent;
3176               if (q == p) {
3177                 c = point;
3178                 break;
3179               }
3180               PetscCall(DMPlexGetTreeParent(plex, q, &qParent, NULL));
3181             } while (qParent != q);
3182             if (c != -1) break;
3183             PetscCall(DMPlexGetTreeParent(plex, pp, &pParent, NULL));
3184             q = closure[2 * l];
3185             while (pParent != pp) { /* check parents of p */
3186               pp = pParent;
3187               if (pp == q) {
3188                 c = point;
3189                 break;
3190               }
3191               PetscCall(DMPlexGetTreeParent(plex, pp, &pParent, NULL));
3192             }
3193             if (c != -1) break;
3194           }
3195           PetscCall(DMPlexRestoreTransitiveClosure(plex, point, PETSC_TRUE, NULL, &closure));
3196           if (l < closureSize) break;
3197         } else {
3198           PetscInt supportSize;
3199 
3200           PetscCall(DMPlexGetSupportSize(plex, point, &supportSize));
3201           zerosupportpoint = (PetscBool)(zerosupportpoint || !supportSize);
3202         }
3203       }
3204       if (c < 0) {
3205         const char *prefix;
3206         PetscBool   print = PETSC_FALSE;
3207 
3208         PetscCall(PetscObjectGetOptionsPrefix((PetscObject)dm, &prefix));
3209         PetscCall(PetscOptionsGetBool(((PetscObject)dm)->options, prefix, "-dm_forest_print_label_error", &print, NULL));
3210         if (print) {
3211           PetscInt i;
3212 
3213           PetscCall(PetscPrintf(PETSC_COMM_SELF, "[%d] Failed to find cell with point %" PetscInt_FMT " in its closure for label %s (starSize %" PetscInt_FMT ")\n", PetscGlobalRank, p, baseLabel ? ((PetscObject)baseLabel)->name : "_forest_base_subpoint_map", starSize));
3214           for (i = 0; i < starSize; i++) PetscCall(PetscPrintf(PETSC_COMM_SELF, "  star[%" PetscInt_FMT "] = %" PetscInt_FMT ",%" PetscInt_FMT "\n", i, star[2 * i], star[2 * i + 1]));
3215         }
3216         PetscCall(DMPlexRestoreTransitiveClosure(plex, p, PETSC_FALSE, NULL, &star));
3217         if (zerosupportpoint) continue;
3218         else
3219           SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Failed to find cell with point %" PetscInt_FMT " in its closure for label %s. Rerun with -dm_forest_print_label_error for more information", p, baseLabel ? ((PetscObject)baseLabel)->name : "_forest_base_subpoint_map");
3220       }
3221       PetscCall(DMPlexRestoreTransitiveClosure(plex, p, PETSC_FALSE, NULL, &star));
3222 
3223       if (c < cLocalStart) {
3224         /* get from the beginning of the ghost layer */
3225         q = &(ghosts[c]);
3226         t = (PetscInt)q->p.which_tree;
3227       } else if (c < cLocalEnd) {
3228         PetscInt lo = 0, hi = num_trees;
3229         /* get from local quadrants: have to find the right tree */
3230 
3231         c -= cLocalStart;
3232 
3233         do {
3234           p4est_tree_t *tree;
3235 
3236           PetscCheck(guess >= lo && guess < num_trees && lo < hi, PETSC_COMM_SELF, PETSC_ERR_PLIB, "failed binary search");
3237           tree = &trees[guess];
3238           if (c < tree->quadrants_offset) {
3239             hi = guess;
3240           } else if (c < tree->quadrants_offset + (PetscInt)tree->quadrants.elem_count) {
3241             q = &((p4est_quadrant_t *)tree->quadrants.array)[c - (PetscInt)tree->quadrants_offset];
3242             t = guess;
3243             break;
3244           } else {
3245             lo = guess + 1;
3246           }
3247           guess = lo + (hi - lo) / 2;
3248         } while (1);
3249       } else {
3250         /* get from the end of the ghost layer */
3251         c -= (cLocalEnd - cLocalStart);
3252 
3253         q = &(ghosts[c]);
3254         t = (PetscInt)q->p.which_tree;
3255       }
3256 
3257       if (l == 0) { /* cell */
3258         if (baseLabel) {
3259           PetscCall(DMLabelGetValue(baseLabel, t + cStartBase, &val));
3260         } else {
3261           val = t + cStartBase;
3262         }
3263         PetscCall(DMLabelSetValue(label, p, val));
3264       } else if (l >= 1 && l < 1 + P4EST_FACES) { /* facet */
3265         p4est_quadrant_t nq;
3266         int              isInside;
3267 
3268         l = PetscFaceToP4estFace[l - 1];
3269         PetscCallP4est(p4est_quadrant_face_neighbor, (q, l, &nq));
3270         PetscCallP4estReturn(isInside, p4est_quadrant_is_inside_root, (&nq));
3271         if (isInside) {
3272           /* this facet is in the interior of a tree, so it inherits the label of the tree */
3273           if (baseLabel) {
3274             PetscCall(DMLabelGetValue(baseLabel, t + cStartBase, &val));
3275           } else {
3276             val = t + cStartBase;
3277           }
3278           PetscCall(DMLabelSetValue(label, p, val));
3279         } else {
3280           PetscInt f = pforest->topo->tree_face_to_uniq[P4EST_FACES * t + l];
3281 
3282           if (baseLabel) {
3283             PetscCall(DMLabelGetValue(baseLabel, f + fStartBase, &val));
3284           } else {
3285             val = f + fStartBase;
3286           }
3287           PetscCall(DMLabelSetValue(label, p, val));
3288         }
3289   #if defined(P4_TO_P8)
3290       } else if (l >= 1 + P4EST_FACES && l < 1 + P4EST_FACES + P8EST_EDGES) { /* edge */
3291         p4est_quadrant_t nq;
3292         int              isInside;
3293 
3294         l = PetscEdgeToP4estEdge[l - (1 + P4EST_FACES)];
3295         PetscCallP4est(p8est_quadrant_edge_neighbor, (q, l, &nq));
3296         PetscCallP4estReturn(isInside, p4est_quadrant_is_inside_root, (&nq));
3297         if (isInside) {
3298           /* this edge is in the interior of a tree, so it inherits the label of the tree */
3299           if (baseLabel) {
3300             PetscCall(DMLabelGetValue(baseLabel, t + cStartBase, &val));
3301           } else {
3302             val = t + cStartBase;
3303           }
3304           PetscCall(DMLabelSetValue(label, p, val));
3305         } else {
3306           int isOutsideFace;
3307 
3308           PetscCallP4estReturn(isOutsideFace, p4est_quadrant_is_outside_face, (&nq));
3309           if (isOutsideFace) {
3310             PetscInt f;
3311 
3312             if (nq.x < 0) {
3313               f = 0;
3314             } else if (nq.x >= P4EST_ROOT_LEN) {
3315               f = 1;
3316             } else if (nq.y < 0) {
3317               f = 2;
3318             } else if (nq.y >= P4EST_ROOT_LEN) {
3319               f = 3;
3320             } else if (nq.z < 0) {
3321               f = 4;
3322             } else {
3323               f = 5;
3324             }
3325             f = pforest->topo->tree_face_to_uniq[P4EST_FACES * t + f];
3326             if (baseLabel) {
3327               PetscCall(DMLabelGetValue(baseLabel, f + fStartBase, &val));
3328             } else {
3329               val = f + fStartBase;
3330             }
3331             PetscCall(DMLabelSetValue(label, p, val));
3332           } else { /* the quadrant edge corresponds to the tree edge */
3333             PetscInt e = pforest->topo->conn->tree_to_edge[P8EST_EDGES * t + l];
3334 
3335             if (baseLabel) {
3336               PetscCall(DMLabelGetValue(baseLabel, e + eStartBase, &val));
3337             } else {
3338               val = e + eStartBase;
3339             }
3340             PetscCall(DMLabelSetValue(label, p, val));
3341           }
3342         }
3343   #endif
3344       } else { /* vertex */
3345         p4est_quadrant_t nq;
3346         int              isInside;
3347 
3348   #if defined(P4_TO_P8)
3349         l = PetscVertToP4estVert[l - (1 + P4EST_FACES + P8EST_EDGES)];
3350   #else
3351         l = PetscVertToP4estVert[l - (1 + P4EST_FACES)];
3352   #endif
3353         PetscCallP4est(p4est_quadrant_corner_neighbor, (q, l, &nq));
3354         PetscCallP4estReturn(isInside, p4est_quadrant_is_inside_root, (&nq));
3355         if (isInside) {
3356           if (baseLabel) {
3357             PetscCall(DMLabelGetValue(baseLabel, t + cStartBase, &val));
3358           } else {
3359             val = t + cStartBase;
3360           }
3361           PetscCall(DMLabelSetValue(label, p, val));
3362         } else {
3363           int isOutside;
3364 
3365           PetscCallP4estReturn(isOutside, p4est_quadrant_is_outside_face, (&nq));
3366           if (isOutside) {
3367             PetscInt f = -1;
3368 
3369             if (nq.x < 0) {
3370               f = 0;
3371             } else if (nq.x >= P4EST_ROOT_LEN) {
3372               f = 1;
3373             } else if (nq.y < 0) {
3374               f = 2;
3375             } else if (nq.y >= P4EST_ROOT_LEN) {
3376               f = 3;
3377   #if defined(P4_TO_P8)
3378             } else if (nq.z < 0) {
3379               f = 4;
3380             } else {
3381               f = 5;
3382   #endif
3383             }
3384             f = pforest->topo->tree_face_to_uniq[P4EST_FACES * t + f];
3385             if (baseLabel) {
3386               PetscCall(DMLabelGetValue(baseLabel, f + fStartBase, &val));
3387             } else {
3388               val = f + fStartBase;
3389             }
3390             PetscCall(DMLabelSetValue(label, p, val));
3391             continue;
3392           }
3393   #if defined(P4_TO_P8)
3394           PetscCallP4estReturn(isOutside, p8est_quadrant_is_outside_edge, (&nq));
3395           if (isOutside) {
3396             /* outside edge */
3397             PetscInt e = -1;
3398 
3399             if (nq.x >= 0 && nq.x < P4EST_ROOT_LEN) {
3400               if (nq.z < 0) {
3401                 if (nq.y < 0) {
3402                   e = 0;
3403                 } else {
3404                   e = 1;
3405                 }
3406               } else {
3407                 if (nq.y < 0) {
3408                   e = 2;
3409                 } else {
3410                   e = 3;
3411                 }
3412               }
3413             } else if (nq.y >= 0 && nq.y < P4EST_ROOT_LEN) {
3414               if (nq.z < 0) {
3415                 if (nq.x < 0) {
3416                   e = 4;
3417                 } else {
3418                   e = 5;
3419                 }
3420               } else {
3421                 if (nq.x < 0) {
3422                   e = 6;
3423                 } else {
3424                   e = 7;
3425                 }
3426               }
3427             } else {
3428               if (nq.y < 0) {
3429                 if (nq.x < 0) {
3430                   e = 8;
3431                 } else {
3432                   e = 9;
3433                 }
3434               } else {
3435                 if (nq.x < 0) {
3436                   e = 10;
3437                 } else {
3438                   e = 11;
3439                 }
3440               }
3441             }
3442 
3443             e = pforest->topo->conn->tree_to_edge[P8EST_EDGES * t + e];
3444             if (baseLabel) {
3445               PetscCall(DMLabelGetValue(baseLabel, e + eStartBase, &val));
3446             } else {
3447               val = e + eStartBase;
3448             }
3449             PetscCall(DMLabelSetValue(label, p, val));
3450             continue;
3451           }
3452   #endif
3453           {
3454             /* outside vertex: same corner as quadrant corner */
3455             PetscInt v = pforest->topo->conn->tree_to_corner[P4EST_CHILDREN * t + l];
3456 
3457             if (baseLabel) {
3458               PetscCall(DMLabelGetValue(baseLabel, v + vStartBase, &val));
3459             } else {
3460               val = v + vStartBase;
3461             }
3462             PetscCall(DMLabelSetValue(label, p, val));
3463           }
3464         }
3465       }
3466     }
3467     next = next->next;
3468   }
3469   PetscFunctionReturn(PETSC_SUCCESS);
3470 }
3471 
3472 static PetscErrorCode DMPforestLabelsFinalize(DM dm, DM plex)
3473 {
3474   DM_Forest_pforest *pforest = (DM_Forest_pforest *)((DM_Forest *)dm->data)->data;
3475   DM                 adapt;
3476 
3477   PetscFunctionBegin;
3478   if (pforest->labelsFinalized) PetscFunctionReturn(PETSC_SUCCESS);
3479   pforest->labelsFinalized = PETSC_TRUE;
3480   PetscCall(DMForestGetAdaptivityForest(dm, &adapt));
3481   if (!adapt) {
3482     /* Initialize labels from the base dm */
3483     PetscCall(DMPforestLabelsInitialize(dm, plex));
3484   } else {
3485     PetscInt    dofPerDim[4] = {1, 1, 1, 1};
3486     PetscSF     transferForward, transferBackward, pointSF;
3487     PetscInt    pStart, pEnd, pStartA, pEndA;
3488     PetscInt   *values, *adaptValues;
3489     DMLabelLink next = adapt->labels;
3490     DMLabel     adaptLabel;
3491     DM          adaptPlex;
3492 
3493     PetscCall(DMForestGetAdaptivityLabel(dm, &adaptLabel));
3494     PetscCall(DMPforestGetPlex(adapt, &adaptPlex));
3495     PetscCall(DMPforestGetTransferSF(adapt, dm, dofPerDim, &transferForward, &transferBackward));
3496     PetscCall(DMPlexGetChart(plex, &pStart, &pEnd));
3497     PetscCall(DMPlexGetChart(adaptPlex, &pStartA, &pEndA));
3498     PetscCall(PetscMalloc2(pEnd - pStart, &values, pEndA - pStartA, &adaptValues));
3499     PetscCall(DMGetPointSF(plex, &pointSF));
3500     if (PetscDefined(USE_DEBUG)) {
3501       PetscInt p;
3502       for (p = pStartA; p < pEndA; p++) adaptValues[p - pStartA] = -1;
3503       for (p = pStart; p < pEnd; p++) values[p - pStart] = -2;
3504       if (transferForward) {
3505         PetscCall(PetscSFBcastBegin(transferForward, MPIU_INT, adaptValues, values, MPI_REPLACE));
3506         PetscCall(PetscSFBcastEnd(transferForward, MPIU_INT, adaptValues, values, MPI_REPLACE));
3507       }
3508       if (transferBackward) {
3509         PetscCall(PetscSFReduceBegin(transferBackward, MPIU_INT, adaptValues, values, MPI_MAX));
3510         PetscCall(PetscSFReduceEnd(transferBackward, MPIU_INT, adaptValues, values, MPI_MAX));
3511       }
3512       for (p = pStart; p < pEnd; p++) {
3513         PetscInt q = p, parent;
3514 
3515         PetscCall(DMPlexGetTreeParent(plex, q, &parent, NULL));
3516         while (parent != q) {
3517           if (values[parent] == -2) values[parent] = values[q];
3518           q = parent;
3519           PetscCall(DMPlexGetTreeParent(plex, q, &parent, NULL));
3520         }
3521       }
3522       PetscCall(PetscSFReduceBegin(pointSF, MPIU_INT, values, values, MPI_MAX));
3523       PetscCall(PetscSFReduceEnd(pointSF, MPIU_INT, values, values, MPI_MAX));
3524       PetscCall(PetscSFBcastBegin(pointSF, MPIU_INT, values, values, MPI_REPLACE));
3525       PetscCall(PetscSFBcastEnd(pointSF, MPIU_INT, values, values, MPI_REPLACE));
3526       for (p = pStart; p < pEnd; p++) PetscCheck(values[p - pStart] != -2, PETSC_COMM_SELF, PETSC_ERR_PLIB, "uncovered point %" PetscInt_FMT, p);
3527     }
3528     while (next) {
3529       DMLabel     nextLabel = next->label;
3530       const char *name;
3531       PetscBool   isDepth, isCellType, isGhost, isVTK;
3532       DMLabel     label;
3533       PetscInt    p;
3534 
3535       PetscCall(PetscObjectGetName((PetscObject)nextLabel, &name));
3536       PetscCall(PetscStrcmp(name, "depth", &isDepth));
3537       if (isDepth) {
3538         next = next->next;
3539         continue;
3540       }
3541       PetscCall(PetscStrcmp(name, "celltype", &isCellType));
3542       if (isCellType) {
3543         next = next->next;
3544         continue;
3545       }
3546       PetscCall(PetscStrcmp(name, "ghost", &isGhost));
3547       if (isGhost) {
3548         next = next->next;
3549         continue;
3550       }
3551       PetscCall(PetscStrcmp(name, "vtk", &isVTK));
3552       if (isVTK) {
3553         next = next->next;
3554         continue;
3555       }
3556       if (nextLabel == adaptLabel) {
3557         next = next->next;
3558         continue;
3559       }
3560       /* label was created earlier */
3561       PetscCall(DMGetLabel(dm, name, &label));
3562       for (p = pStartA; p < pEndA; p++) PetscCall(DMLabelGetValue(nextLabel, p, &adaptValues[p]));
3563       for (p = pStart; p < pEnd; p++) values[p] = PETSC_MIN_INT;
3564 
3565       if (transferForward) PetscCall(PetscSFBcastBegin(transferForward, MPIU_INT, adaptValues, values, MPI_REPLACE));
3566       if (transferBackward) PetscCall(PetscSFReduceBegin(transferBackward, MPIU_INT, adaptValues, values, MPI_MAX));
3567       if (transferForward) PetscCall(PetscSFBcastEnd(transferForward, MPIU_INT, adaptValues, values, MPI_REPLACE));
3568       if (transferBackward) PetscCall(PetscSFReduceEnd(transferBackward, MPIU_INT, adaptValues, values, MPI_MAX));
3569       for (p = pStart; p < pEnd; p++) {
3570         PetscInt q = p, parent;
3571 
3572         PetscCall(DMPlexGetTreeParent(plex, q, &parent, NULL));
3573         while (parent != q) {
3574           if (values[parent] == PETSC_MIN_INT) values[parent] = values[q];
3575           q = parent;
3576           PetscCall(DMPlexGetTreeParent(plex, q, &parent, NULL));
3577         }
3578       }
3579       PetscCall(PetscSFReduceBegin(pointSF, MPIU_INT, values, values, MPI_MAX));
3580       PetscCall(PetscSFReduceEnd(pointSF, MPIU_INT, values, values, MPI_MAX));
3581       PetscCall(PetscSFBcastBegin(pointSF, MPIU_INT, values, values, MPI_REPLACE));
3582       PetscCall(PetscSFBcastEnd(pointSF, MPIU_INT, values, values, MPI_REPLACE));
3583 
3584       for (p = pStart; p < pEnd; p++) PetscCall(DMLabelSetValue(label, p, values[p]));
3585       next = next->next;
3586     }
3587     PetscCall(PetscFree2(values, adaptValues));
3588     PetscCall(PetscSFDestroy(&transferForward));
3589     PetscCall(PetscSFDestroy(&transferBackward));
3590     pforest->labelsFinalized = PETSC_TRUE;
3591   }
3592   PetscFunctionReturn(PETSC_SUCCESS);
3593 }
3594 
3595 static PetscErrorCode DMPforestMapCoordinates_Cell(DM plex, p4est_geometry_t *geom, PetscInt cell, p4est_quadrant_t *q, p4est_topidx_t t, p4est_connectivity_t *conn, PetscScalar *coords)
3596 {
3597   PetscInt     closureSize, c, coordStart, coordEnd, coordDim;
3598   PetscInt    *closure = NULL;
3599   PetscSection coordSec;
3600 
3601   PetscFunctionBegin;
3602   PetscCall(DMGetCoordinateSection(plex, &coordSec));
3603   PetscCall(PetscSectionGetChart(coordSec, &coordStart, &coordEnd));
3604   PetscCall(DMGetCoordinateDim(plex, &coordDim));
3605   PetscCall(DMPlexGetTransitiveClosure(plex, cell, PETSC_TRUE, &closureSize, &closure));
3606   for (c = 0; c < closureSize; c++) {
3607     PetscInt point = closure[2 * c];
3608 
3609     if (point >= coordStart && point < coordEnd) {
3610       PetscInt dof, off;
3611       PetscInt nCoords, i;
3612       PetscCall(PetscSectionGetDof(coordSec, point, &dof));
3613       PetscCheck(dof % coordDim == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Did not understand coordinate layout");
3614       nCoords = dof / coordDim;
3615       PetscCall(PetscSectionGetOffset(coordSec, point, &off));
3616       for (i = 0; i < nCoords; i++) {
3617         PetscScalar *coord               = &coords[off + i * coordDim];
3618         double       coordP4est[3]       = {0.};
3619         double       coordP4estMapped[3] = {0.};
3620         PetscInt     j;
3621         PetscReal    treeCoords[P4EST_CHILDREN][3] = {{0.}};
3622         PetscReal    eta[3]                        = {0.};
3623         PetscInt     numRounds                     = 10;
3624         PetscReal    coordGuess[3]                 = {0.};
3625 
3626         eta[0] = (PetscReal)q->x / (PetscReal)P4EST_ROOT_LEN;
3627         eta[1] = (PetscReal)q->y / (PetscReal)P4EST_ROOT_LEN;
3628   #if defined(P4_TO_P8)
3629         eta[2] = (PetscReal)q->z / (PetscReal)P4EST_ROOT_LEN;
3630   #endif
3631 
3632         for (j = 0; j < P4EST_CHILDREN; j++) {
3633           PetscInt k;
3634 
3635           for (k = 0; k < 3; k++) treeCoords[j][k] = conn->vertices[3 * conn->tree_to_vertex[P4EST_CHILDREN * t + j] + k];
3636         }
3637 
3638         for (j = 0; j < P4EST_CHILDREN; j++) {
3639           PetscInt  k;
3640           PetscReal prod = 1.;
3641 
3642           for (k = 0; k < P4EST_DIM; k++) prod *= (j & (1 << k)) ? eta[k] : (1. - eta[k]);
3643           for (k = 0; k < 3; k++) coordGuess[k] += prod * treeCoords[j][k];
3644         }
3645 
3646         for (j = 0; j < numRounds; j++) {
3647           PetscInt dir;
3648 
3649           for (dir = 0; dir < P4EST_DIM; dir++) {
3650             PetscInt  k;
3651             PetscReal diff[3];
3652             PetscReal dXdeta[3] = {0.};
3653             PetscReal rhs, scale, update;
3654 
3655             for (k = 0; k < 3; k++) diff[k] = coordP4est[k] - coordGuess[k];
3656             for (k = 0; k < P4EST_CHILDREN; k++) {
3657               PetscInt  l;
3658               PetscReal prod = 1.;
3659 
3660               for (l = 0; l < P4EST_DIM; l++) {
3661                 if (l == dir) {
3662                   prod *= (k & (1 << l)) ? 1. : -1.;
3663                 } else {
3664                   prod *= (k & (1 << l)) ? eta[l] : (1. - eta[l]);
3665                 }
3666               }
3667               for (l = 0; l < 3; l++) dXdeta[l] += prod * treeCoords[k][l];
3668             }
3669             rhs   = 0.;
3670             scale = 0;
3671             for (k = 0; k < 3; k++) {
3672               rhs += diff[k] * dXdeta[k];
3673               scale += dXdeta[k] * dXdeta[k];
3674             }
3675             update = rhs / scale;
3676             eta[dir] += update;
3677             eta[dir] = PetscMin(eta[dir], 1.);
3678             eta[dir] = PetscMax(eta[dir], 0.);
3679 
3680             coordGuess[0] = coordGuess[1] = coordGuess[2] = 0.;
3681             for (k = 0; k < P4EST_CHILDREN; k++) {
3682               PetscInt  l;
3683               PetscReal prod = 1.;
3684 
3685               for (l = 0; l < P4EST_DIM; l++) prod *= (k & (1 << l)) ? eta[l] : (1. - eta[l]);
3686               for (l = 0; l < 3; l++) coordGuess[l] += prod * treeCoords[k][l];
3687             }
3688           }
3689         }
3690         for (j = 0; j < 3; j++) coordP4est[j] = (double)eta[j];
3691 
3692         if (geom) {
3693           (geom->X)(geom, t, coordP4est, coordP4estMapped);
3694           for (j = 0; j < coordDim; j++) coord[j] = (PetscScalar)coordP4estMapped[j];
3695         } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Not coded");
3696       }
3697     }
3698   }
3699   PetscCall(DMPlexRestoreTransitiveClosure(plex, cell, PETSC_TRUE, &closureSize, &closure));
3700   PetscFunctionReturn(PETSC_SUCCESS);
3701 }
3702 
3703 static PetscErrorCode DMPforestMapCoordinates(DM dm, DM plex)
3704 {
3705   DM_Forest         *forest;
3706   DM_Forest_pforest *pforest;
3707   p4est_geometry_t  *geom;
3708   PetscInt           cLocalStart, cLocalEnd;
3709   Vec                coordLocalVec;
3710   PetscScalar       *coords;
3711   p4est_topidx_t     flt, llt, t;
3712   p4est_tree_t      *trees;
3713   PetscErrorCode (*map)(DM, PetscInt, PetscInt, const PetscReal[], PetscReal[], void *);
3714   void *mapCtx;
3715 
3716   PetscFunctionBegin;
3717   forest  = (DM_Forest *)dm->data;
3718   pforest = (DM_Forest_pforest *)forest->data;
3719   geom    = pforest->topo->geom;
3720   PetscCall(DMForestGetBaseCoordinateMapping(dm, &map, &mapCtx));
3721   if (!geom && !map) PetscFunctionReturn(PETSC_SUCCESS);
3722   PetscCall(DMGetCoordinatesLocal(plex, &coordLocalVec));
3723   PetscCall(VecGetArray(coordLocalVec, &coords));
3724   cLocalStart = pforest->cLocalStart;
3725   cLocalEnd   = pforest->cLocalEnd;
3726   flt         = pforest->forest->first_local_tree;
3727   llt         = pforest->forest->last_local_tree;
3728   trees       = (p4est_tree_t *)pforest->forest->trees->array;
3729   if (map) { /* apply the map directly to the existing coordinates */
3730     PetscSection coordSec;
3731     PetscInt     coordStart, coordEnd, p, coordDim, p4estCoordDim, cStart, cEnd, cEndInterior;
3732     DM           base;
3733 
3734     PetscCall(DMPlexGetHeightStratum(plex, 0, &cStart, &cEnd));
3735     PetscCall(DMPlexGetCellTypeStratum(plex, DM_POLYTOPE_FV_GHOST, &cEndInterior, NULL));
3736     cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
3737     PetscCall(DMForestGetBaseDM(dm, &base));
3738     PetscCall(DMGetCoordinateSection(plex, &coordSec));
3739     PetscCall(PetscSectionGetChart(coordSec, &coordStart, &coordEnd));
3740     PetscCall(DMGetCoordinateDim(plex, &coordDim));
3741     p4estCoordDim = PetscMin(coordDim, 3);
3742     for (p = coordStart; p < coordEnd; p++) {
3743       PetscInt *star = NULL, starSize;
3744       PetscInt  dof, off, cell = -1, coarsePoint = -1;
3745       PetscInt  nCoords, i;
3746       PetscCall(PetscSectionGetDof(coordSec, p, &dof));
3747       PetscCheck(dof % coordDim == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Did not understand coordinate layout");
3748       nCoords = dof / coordDim;
3749       PetscCall(PetscSectionGetOffset(coordSec, p, &off));
3750       PetscCall(DMPlexGetTransitiveClosure(plex, p, PETSC_FALSE, &starSize, &star));
3751       for (i = 0; i < starSize; i++) {
3752         PetscInt point = star[2 * i];
3753 
3754         if (cStart <= point && point < cEnd) {
3755           cell = point;
3756           break;
3757         }
3758       }
3759       PetscCall(DMPlexRestoreTransitiveClosure(plex, p, PETSC_FALSE, &starSize, &star));
3760       if (cell >= 0) {
3761         if (cell < cLocalStart) {
3762           p4est_quadrant_t *ghosts = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
3763 
3764           coarsePoint = ghosts[cell].p.which_tree;
3765         } else if (cell < cLocalEnd) {
3766           cell -= cLocalStart;
3767           for (t = flt; t <= llt; t++) {
3768             p4est_tree_t *tree = &(trees[t]);
3769 
3770             if (cell >= tree->quadrants_offset && (size_t)cell < tree->quadrants_offset + tree->quadrants.elem_count) {
3771               coarsePoint = t;
3772               break;
3773             }
3774           }
3775         } else {
3776           p4est_quadrant_t *ghosts = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
3777 
3778           coarsePoint = ghosts[cell - cLocalEnd].p.which_tree;
3779         }
3780       }
3781       for (i = 0; i < nCoords; i++) {
3782         PetscScalar *coord               = &coords[off + i * coordDim];
3783         PetscReal    coordP4est[3]       = {0.};
3784         PetscReal    coordP4estMapped[3] = {0.};
3785         PetscInt     j;
3786 
3787         for (j = 0; j < p4estCoordDim; j++) coordP4est[j] = PetscRealPart(coord[j]);
3788         PetscCall((map)(base, coarsePoint, p4estCoordDim, coordP4est, coordP4estMapped, mapCtx));
3789         for (j = 0; j < p4estCoordDim; j++) coord[j] = (PetscScalar)coordP4estMapped[j];
3790       }
3791     }
3792   } else { /* we have to transform coordinates back to the unit cube (where geom is defined), and then apply geom */
3793     PetscInt cStart, cEnd, cEndInterior;
3794 
3795     PetscCall(DMPlexGetHeightStratum(plex, 0, &cStart, &cEnd));
3796     PetscCall(DMPlexGetCellTypeStratum(plex, DM_POLYTOPE_FV_GHOST, &cEndInterior, NULL));
3797     cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
3798     if (cLocalStart > 0) {
3799       p4est_quadrant_t *ghosts = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
3800       PetscInt          count;
3801 
3802       for (count = 0; count < cLocalStart; count++) {
3803         p4est_quadrant_t *quad = &ghosts[count];
3804         p4est_topidx_t    t    = quad->p.which_tree;
3805 
3806         PetscCall(DMPforestMapCoordinates_Cell(plex, geom, count, quad, t, pforest->topo->conn, coords));
3807       }
3808     }
3809     for (t = flt; t <= llt; t++) {
3810       p4est_tree_t     *tree     = &(trees[t]);
3811       PetscInt          offset   = cLocalStart + tree->quadrants_offset, i;
3812       PetscInt          numQuads = (PetscInt)tree->quadrants.elem_count;
3813       p4est_quadrant_t *quads    = (p4est_quadrant_t *)tree->quadrants.array;
3814 
3815       for (i = 0; i < numQuads; i++) {
3816         PetscInt count = i + offset;
3817 
3818         PetscCall(DMPforestMapCoordinates_Cell(plex, geom, count, &quads[i], t, pforest->topo->conn, coords));
3819       }
3820     }
3821     if (cLocalEnd - cLocalStart < cEnd - cStart) {
3822       p4est_quadrant_t *ghosts    = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
3823       PetscInt          numGhosts = (PetscInt)pforest->ghost->ghosts.elem_count;
3824       PetscInt          count;
3825 
3826       for (count = 0; count < numGhosts - cLocalStart; count++) {
3827         p4est_quadrant_t *quad = &ghosts[count + cLocalStart];
3828         p4est_topidx_t    t    = quad->p.which_tree;
3829 
3830         PetscCall(DMPforestMapCoordinates_Cell(plex, geom, count + cLocalEnd, quad, t, pforest->topo->conn, coords));
3831       }
3832     }
3833   }
3834   PetscCall(VecRestoreArray(coordLocalVec, &coords));
3835   PetscFunctionReturn(PETSC_SUCCESS);
3836 }
3837 
3838 static PetscErrorCode PforestQuadrantIsInterior(p4est_quadrant_t *quad, PetscBool *is_interior)
3839 {
3840   PetscFunctionBegin;
3841   p4est_qcoord_t h = P4EST_QUADRANT_LEN(quad->level);
3842   if ((quad->x > 0) && (quad->x + h < P4EST_ROOT_LEN)
3843   #ifdef P4_TO_P8
3844       && (quad->z > 0) && (quad->z + h < P4EST_ROOT_LEN)
3845   #endif
3846       && (quad->y > 0) && (quad->y + h < P4EST_ROOT_LEN)) {
3847     *is_interior = PETSC_TRUE;
3848   } else {
3849     *is_interior = PETSC_FALSE;
3850   }
3851   PetscFunctionReturn(PETSC_SUCCESS);
3852 }
3853 
3854 /* We always use DG coordinates with p4est: if they do not match the vertex
3855    coordinates, add space for them in the section */
3856 static PetscErrorCode PforestCheckLocalizeCell(DM plex, PetscInt cDim, Vec cVecOld, DM_Forest_pforest *pforest, PetscSection oldSection, PetscSection newSection, PetscInt cell, PetscInt coarsePoint, p4est_quadrant_t *quad)
3857 {
3858   PetscBool is_interior;
3859 
3860   PetscFunctionBegin;
3861   PetscCall(PforestQuadrantIsInterior(quad, &is_interior));
3862   if (is_interior) { // quads in the interior of a coarse cell can't touch periodic interfaces
3863     PetscCall(PetscSectionSetDof(newSection, cell, 0));
3864     PetscCall(PetscSectionSetFieldDof(newSection, cell, 0, 0));
3865   } else {
3866     PetscInt     cSize;
3867     PetscScalar *values      = NULL;
3868     PetscBool    same_coords = PETSC_TRUE;
3869 
3870     PetscCall(DMPlexVecGetClosure(plex, oldSection, cVecOld, cell, &cSize, &values));
3871     PetscAssert(cSize == cDim * P4EST_CHILDREN, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unexpected closure size");
3872     for (int c = 0; c < P4EST_CHILDREN; c++) {
3873       p4est_qcoord_t quad_coords[3];
3874       p4est_qcoord_t h = P4EST_QUADRANT_LEN(quad->level);
3875       double         corner_coords[3];
3876       double         vert_coords[3];
3877       PetscInt       corner = PetscVertToP4estVert[c];
3878 
3879       for (PetscInt d = 0; d < PetscMin(cDim, 3); d++) vert_coords[d] = PetscRealPart(values[c * cDim + d]);
3880 
3881       quad_coords[0] = quad->x;
3882       quad_coords[1] = quad->y;
3883   #ifdef P4_TO_P8
3884       quad_coords[2] = quad->z;
3885   #endif
3886       for (int d = 0; d < 3; d++) quad_coords[d] += (corner & (1 << d)) ? h : 0;
3887   #ifndef P4_TO_P8
3888       PetscCallP4est(p4est_qcoord_to_vertex, (pforest->forest->connectivity, coarsePoint, quad_coords[0], quad_coords[1], corner_coords));
3889   #else
3890       PetscCallP4est(p4est_qcoord_to_vertex, (pforest->forest->connectivity, coarsePoint, quad_coords[0], quad_coords[1], quad_coords[2], corner_coords));
3891   #endif
3892       for (PetscInt d = 0; d < PetscMin(cDim, 3); d++) {
3893         if (fabs(vert_coords[d] - corner_coords[d]) > PETSC_SMALL) {
3894           same_coords = PETSC_FALSE;
3895           break;
3896         }
3897       }
3898     }
3899     if (same_coords) {
3900       PetscCall(PetscSectionSetDof(newSection, cell, 0));
3901       PetscCall(PetscSectionSetFieldDof(newSection, cell, 0, 0));
3902     } else {
3903       PetscCall(PetscSectionSetDof(newSection, cell, cSize));
3904       PetscCall(PetscSectionSetFieldDof(newSection, cell, 0, cSize));
3905     }
3906     PetscCall(DMPlexVecRestoreClosure(plex, oldSection, cVecOld, cell, &cSize, &values));
3907   }
3908   PetscFunctionReturn(PETSC_SUCCESS);
3909 }
3910 
3911 static PetscErrorCode PforestLocalizeCell(DM plex, PetscInt cDim, DM_Forest_pforest *pforest, PetscSection newSection, PetscInt cell, PetscInt coarsePoint, p4est_quadrant_t *quad, PetscScalar coords[])
3912 {
3913   PetscInt cdof, off;
3914 
3915   PetscFunctionBegin;
3916   PetscCall(PetscSectionGetDof(newSection, cell, &cdof));
3917   if (!cdof) PetscFunctionReturn(PETSC_SUCCESS);
3918 
3919   PetscCall(PetscSectionGetOffset(newSection, cell, &off));
3920   for (PetscInt c = 0, pos = off; c < P4EST_CHILDREN; c++) {
3921     p4est_qcoord_t quad_coords[3];
3922     p4est_qcoord_t h = P4EST_QUADRANT_LEN(quad->level);
3923     double         corner_coords[3];
3924     PetscInt       corner = PetscVertToP4estVert[c];
3925 
3926     quad_coords[0] = quad->x;
3927     quad_coords[1] = quad->y;
3928   #ifdef P4_TO_P8
3929     quad_coords[2] = quad->z;
3930   #endif
3931     for (int d = 0; d < 3; d++) quad_coords[d] += (corner & (1 << d)) ? h : 0;
3932   #ifndef P4_TO_P8
3933     PetscCallP4est(p4est_qcoord_to_vertex, (pforest->forest->connectivity, coarsePoint, quad_coords[0], quad_coords[1], corner_coords));
3934   #else
3935     PetscCallP4est(p4est_qcoord_to_vertex, (pforest->forest->connectivity, coarsePoint, quad_coords[0], quad_coords[1], quad_coords[2], corner_coords));
3936   #endif
3937     for (PetscInt d = 0; d < PetscMin(cDim, 3); d++) coords[pos++] = corner_coords[d];
3938     for (PetscInt d = PetscMin(cDim, 3); d < cDim; d++) coords[pos++] = 0.;
3939   }
3940   PetscFunctionReturn(PETSC_SUCCESS);
3941 }
3942 
3943 static PetscErrorCode DMPforestLocalizeCoordinates(DM dm, DM plex)
3944 {
3945   DM_Forest         *forest;
3946   DM_Forest_pforest *pforest;
3947   DM                 base, cdm, cdmCell;
3948   Vec                cVec, cVecOld;
3949   PetscSection       oldSection, newSection;
3950   PetscScalar       *coords2;
3951   const PetscReal   *L;
3952   PetscInt           cLocalStart, cLocalEnd, coarsePoint;
3953   PetscInt           cDim, newStart, newEnd;
3954   PetscInt           v, vStart, vEnd, cp, cStart, cEnd, cEndInterior;
3955   p4est_topidx_t     flt, llt, t;
3956   p4est_tree_t      *trees;
3957   PetscBool          baseLocalized = PETSC_FALSE;
3958 
3959   PetscFunctionBegin;
3960   PetscCall(DMGetPeriodicity(dm, NULL, NULL, &L));
3961   /* we localize on all cells if we don't have a base DM or the base DM coordinates have not been localized */
3962   PetscCall(DMGetCoordinateDim(dm, &cDim));
3963   PetscCall(DMForestGetBaseDM(dm, &base));
3964   if (base) PetscCall(DMGetCoordinatesLocalized(base, &baseLocalized));
3965   if (!baseLocalized) base = NULL;
3966   if (!baseLocalized && !L) PetscFunctionReturn(PETSC_SUCCESS);
3967   PetscCall(DMPlexGetChart(plex, &newStart, &newEnd));
3968 
3969   PetscCall(PetscSectionCreate(PetscObjectComm((PetscObject)dm), &newSection));
3970   PetscCall(PetscSectionSetNumFields(newSection, 1));
3971   PetscCall(PetscSectionSetFieldComponents(newSection, 0, cDim));
3972   PetscCall(PetscSectionSetChart(newSection, newStart, newEnd));
3973 
3974   PetscCall(DMGetCoordinateSection(plex, &oldSection));
3975   PetscCall(DMPlexGetDepthStratum(plex, 0, &vStart, &vEnd));
3976   PetscCall(DMGetCoordinatesLocal(plex, &cVecOld));
3977 
3978   forest      = (DM_Forest *)dm->data;
3979   pforest     = (DM_Forest_pforest *)forest->data;
3980   cLocalStart = pforest->cLocalStart;
3981   cLocalEnd   = pforest->cLocalEnd;
3982   flt         = pforest->forest->first_local_tree;
3983   llt         = pforest->forest->last_local_tree;
3984   trees       = (p4est_tree_t *)pforest->forest->trees->array;
3985 
3986   PetscCall(DMPlexGetHeightStratum(plex, 0, &cStart, &cEnd));
3987   PetscCall(DMPlexGetCellTypeStratum(plex, DM_POLYTOPE_FV_GHOST, &cEndInterior, NULL));
3988   cEnd = cEndInterior < 0 ? cEnd : cEndInterior;
3989   cp   = 0;
3990   if (cLocalStart > 0) {
3991     p4est_quadrant_t *ghosts = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
3992     PetscInt          cell;
3993 
3994     for (cell = 0; cell < cLocalStart; ++cell, cp++) {
3995       p4est_quadrant_t *quad = &ghosts[cell];
3996 
3997       coarsePoint = quad->p.which_tree;
3998       PetscCall(PforestCheckLocalizeCell(plex, cDim, cVecOld, pforest, oldSection, newSection, cell, coarsePoint, quad));
3999     }
4000   }
4001   for (t = flt; t <= llt; t++) {
4002     p4est_tree_t     *tree     = &(trees[t]);
4003     PetscInt          offset   = cLocalStart + tree->quadrants_offset;
4004     PetscInt          numQuads = (PetscInt)tree->quadrants.elem_count;
4005     p4est_quadrant_t *quads    = (p4est_quadrant_t *)tree->quadrants.array;
4006     PetscInt          i;
4007 
4008     if (!numQuads) continue;
4009     coarsePoint = t;
4010     for (i = 0; i < numQuads; i++, cp++) {
4011       PetscInt          cell = i + offset;
4012       p4est_quadrant_t *quad = &quads[i];
4013 
4014       PetscCall(PforestCheckLocalizeCell(plex, cDim, cVecOld, pforest, oldSection, newSection, cell, coarsePoint, quad));
4015     }
4016   }
4017   if (cLocalEnd - cLocalStart < cEnd - cStart) {
4018     p4est_quadrant_t *ghosts    = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
4019     PetscInt          numGhosts = (PetscInt)pforest->ghost->ghosts.elem_count;
4020     PetscInt          count;
4021 
4022     for (count = 0; count < numGhosts - cLocalStart; count++, cp++) {
4023       p4est_quadrant_t *quad = &ghosts[count + cLocalStart];
4024       coarsePoint            = quad->p.which_tree;
4025       PetscInt cell          = count + cLocalEnd;
4026 
4027       PetscCall(PforestCheckLocalizeCell(plex, cDim, cVecOld, pforest, oldSection, newSection, cell, coarsePoint, quad));
4028     }
4029   }
4030   PetscAssert(cp == cEnd - cStart, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unexpected number of fine cells %" PetscInt_FMT " != %" PetscInt_FMT, cp, cEnd - cStart);
4031 
4032   PetscCall(PetscSectionSetUp(newSection));
4033   PetscCall(DMGetCoordinateDM(plex, &cdm));
4034   PetscCall(DMClone(cdm, &cdmCell));
4035   PetscCall(DMSetCellCoordinateDM(plex, cdmCell));
4036   PetscCall(DMDestroy(&cdmCell));
4037   PetscCall(DMSetCellCoordinateSection(plex, cDim, newSection));
4038   PetscCall(PetscSectionGetStorageSize(newSection, &v));
4039   PetscCall(VecCreate(PETSC_COMM_SELF, &cVec));
4040   PetscCall(PetscObjectSetName((PetscObject)cVec, "coordinates"));
4041   PetscCall(VecSetBlockSize(cVec, cDim));
4042   PetscCall(VecSetSizes(cVec, v, PETSC_DETERMINE));
4043   PetscCall(VecSetType(cVec, VECSTANDARD));
4044   PetscCall(VecSet(cVec, PETSC_MIN_REAL));
4045 
4046   /* Localize coordinates on cells if needed */
4047   PetscCall(VecGetArray(cVec, &coords2));
4048   cp = 0;
4049   if (cLocalStart > 0) {
4050     p4est_quadrant_t *ghosts = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
4051     PetscInt          cell;
4052 
4053     for (cell = 0; cell < cLocalStart; ++cell, cp++) {
4054       p4est_quadrant_t *quad = &ghosts[cell];
4055 
4056       coarsePoint = quad->p.which_tree;
4057       PetscCall(PforestLocalizeCell(plex, cDim, pforest, newSection, cell, coarsePoint, quad, coords2));
4058     }
4059   }
4060   for (t = flt; t <= llt; t++) {
4061     p4est_tree_t     *tree     = &(trees[t]);
4062     PetscInt          offset   = cLocalStart + tree->quadrants_offset;
4063     PetscInt          numQuads = (PetscInt)tree->quadrants.elem_count;
4064     p4est_quadrant_t *quads    = (p4est_quadrant_t *)tree->quadrants.array;
4065     PetscInt          i;
4066 
4067     if (!numQuads) continue;
4068     coarsePoint = t;
4069     for (i = 0; i < numQuads; i++, cp++) {
4070       PetscInt          cell = i + offset;
4071       p4est_quadrant_t *quad = &quads[i];
4072 
4073       PetscCall(PforestLocalizeCell(plex, cDim, pforest, newSection, cell, coarsePoint, quad, coords2));
4074     }
4075   }
4076   if (cLocalEnd - cLocalStart < cEnd - cStart) {
4077     p4est_quadrant_t *ghosts    = (p4est_quadrant_t *)pforest->ghost->ghosts.array;
4078     PetscInt          numGhosts = (PetscInt)pforest->ghost->ghosts.elem_count;
4079     PetscInt          count;
4080 
4081     for (count = 0; count < numGhosts - cLocalStart; count++, cp++) {
4082       p4est_quadrant_t *quad = &ghosts[count + cLocalStart];
4083       coarsePoint            = quad->p.which_tree;
4084       PetscInt cell          = count + cLocalEnd;
4085 
4086       PetscCall(PforestLocalizeCell(plex, cDim, pforest, newSection, cell, coarsePoint, quad, coords2));
4087     }
4088   }
4089   PetscCall(VecRestoreArray(cVec, &coords2));
4090   PetscCall(DMSetCellCoordinatesLocal(plex, cVec));
4091   PetscCall(VecDestroy(&cVec));
4092   PetscCall(PetscSectionDestroy(&newSection));
4093   PetscFunctionReturn(PETSC_SUCCESS);
4094 }
4095 
4096   #define DMForestClearAdaptivityForest_pforest _append_pforest(DMForestClearAdaptivityForest)
4097 static PetscErrorCode DMForestClearAdaptivityForest_pforest(DM dm)
4098 {
4099   DM_Forest         *forest;
4100   DM_Forest_pforest *pforest;
4101 
4102   PetscFunctionBegin;
4103   forest  = (DM_Forest *)dm->data;
4104   pforest = (DM_Forest_pforest *)forest->data;
4105   PetscCall(PetscSFDestroy(&(pforest->pointAdaptToSelfSF)));
4106   PetscCall(PetscSFDestroy(&(pforest->pointSelfToAdaptSF)));
4107   PetscCall(PetscFree(pforest->pointAdaptToSelfCids));
4108   PetscCall(PetscFree(pforest->pointSelfToAdaptCids));
4109   PetscFunctionReturn(PETSC_SUCCESS);
4110 }
4111 
4112 static PetscErrorCode DMConvert_pforest_plex(DM dm, DMType newtype, DM *plex)
4113 {
4114   DM_Forest           *forest;
4115   DM_Forest_pforest   *pforest;
4116   DM                   refTree, newPlex, base;
4117   PetscInt             adjDim, adjCodim, coordDim;
4118   MPI_Comm             comm;
4119   PetscBool            isPforest;
4120   PetscInt             dim;
4121   PetscInt             overlap;
4122   p4est_connect_type_t ctype;
4123   p4est_locidx_t       first_local_quad = -1;
4124   sc_array_t          *points_per_dim, *cone_sizes, *cones, *cone_orientations, *coords, *children, *parents, *childids, *leaves, *remotes;
4125   PetscSection         parentSection;
4126   PetscSF              pointSF;
4127   size_t               zz, count;
4128   PetscInt             pStart, pEnd;
4129   DMLabel              ghostLabelBase = NULL;
4130 
4131   PetscFunctionBegin;
4132 
4133   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4134   comm = PetscObjectComm((PetscObject)dm);
4135   PetscCall(PetscObjectTypeCompare((PetscObject)dm, DMPFOREST, &isPforest));
4136   PetscCheck(isPforest, comm, PETSC_ERR_ARG_WRONG, "Expected DM type %s, got %s", DMPFOREST, ((PetscObject)dm)->type_name);
4137   PetscCall(DMGetDimension(dm, &dim));
4138   PetscCheck(dim == P4EST_DIM, comm, PETSC_ERR_ARG_WRONG, "Expected DM dimension %d, got %" PetscInt_FMT, P4EST_DIM, dim);
4139   forest  = (DM_Forest *)dm->data;
4140   pforest = (DM_Forest_pforest *)forest->data;
4141   PetscCall(DMForestGetBaseDM(dm, &base));
4142   if (base) PetscCall(DMGetLabel(base, "ghost", &ghostLabelBase));
4143   if (!pforest->plex) {
4144     PetscMPIInt size;
4145 
4146     PetscCallMPI(MPI_Comm_size(comm, &size));
4147     PetscCall(DMCreate(comm, &newPlex));
4148     PetscCall(DMSetType(newPlex, DMPLEX));
4149     PetscCall(DMSetMatType(newPlex, dm->mattype));
4150     /* share labels */
4151     PetscCall(DMCopyLabels(dm, newPlex, PETSC_OWN_POINTER, PETSC_TRUE, DM_COPY_LABELS_FAIL));
4152     PetscCall(DMForestGetAdjacencyDimension(dm, &adjDim));
4153     PetscCall(DMForestGetAdjacencyCodimension(dm, &adjCodim));
4154     PetscCall(DMGetCoordinateDim(dm, &coordDim));
4155     if (adjDim == 0) {
4156       ctype = P4EST_CONNECT_FULL;
4157     } else if (adjCodim == 1) {
4158       ctype = P4EST_CONNECT_FACE;
4159   #if defined(P4_TO_P8)
4160     } else if (adjDim == 1) {
4161       ctype = P8EST_CONNECT_EDGE;
4162   #endif
4163     } else {
4164       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Invalid adjacency dimension %" PetscInt_FMT, adjDim);
4165     }
4166     PetscCheck(ctype == P4EST_CONNECT_FULL, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Adjacency dimension %" PetscInt_FMT " / codimension %" PetscInt_FMT " not supported yet", adjDim, adjCodim);
4167     PetscCall(DMForestGetPartitionOverlap(dm, &overlap));
4168     PetscCall(DMPlexSetOverlap_Plex(newPlex, NULL, overlap));
4169 
4170     points_per_dim    = sc_array_new(sizeof(p4est_locidx_t));
4171     cone_sizes        = sc_array_new(sizeof(p4est_locidx_t));
4172     cones             = sc_array_new(sizeof(p4est_locidx_t));
4173     cone_orientations = sc_array_new(sizeof(p4est_locidx_t));
4174     coords            = sc_array_new(3 * sizeof(double));
4175     children          = sc_array_new(sizeof(p4est_locidx_t));
4176     parents           = sc_array_new(sizeof(p4est_locidx_t));
4177     childids          = sc_array_new(sizeof(p4est_locidx_t));
4178     leaves            = sc_array_new(sizeof(p4est_locidx_t));
4179     remotes           = sc_array_new(2 * sizeof(p4est_locidx_t));
4180 
4181     PetscCallP4est(p4est_get_plex_data_ext, (pforest->forest, &pforest->ghost, &pforest->lnodes, ctype, (int)((size > 1) ? overlap : 0), &first_local_quad, points_per_dim, cone_sizes, cones, cone_orientations, coords, children, parents, childids, leaves, remotes, 1));
4182 
4183     pforest->cLocalStart = (PetscInt)first_local_quad;
4184     pforest->cLocalEnd   = pforest->cLocalStart + (PetscInt)pforest->forest->local_num_quadrants;
4185     PetscCall(locidx_to_PetscInt(points_per_dim));
4186     PetscCall(locidx_to_PetscInt(cone_sizes));
4187     PetscCall(locidx_to_PetscInt(cones));
4188     PetscCall(locidx_to_PetscInt(cone_orientations));
4189     PetscCall(coords_double_to_PetscScalar(coords, coordDim));
4190     PetscCall(locidx_to_PetscInt(children));
4191     PetscCall(locidx_to_PetscInt(parents));
4192     PetscCall(locidx_to_PetscInt(childids));
4193     PetscCall(locidx_to_PetscInt(leaves));
4194     PetscCall(locidx_pair_to_PetscSFNode(remotes));
4195 
4196     PetscCall(DMSetDimension(newPlex, P4EST_DIM));
4197     PetscCall(DMSetCoordinateDim(newPlex, coordDim));
4198     PetscCall(DMPlexSetMaxProjectionHeight(newPlex, P4EST_DIM - 1));
4199     PetscCall(DMPlexCreateFromDAG(newPlex, P4EST_DIM, (PetscInt *)points_per_dim->array, (PetscInt *)cone_sizes->array, (PetscInt *)cones->array, (PetscInt *)cone_orientations->array, (PetscScalar *)coords->array));
4200     PetscCall(DMPlexConvertOldOrientations_Internal(newPlex));
4201     PetscCall(DMCreateReferenceTree_pforest(comm, &refTree));
4202     PetscCall(DMPlexSetReferenceTree(newPlex, refTree));
4203     PetscCall(PetscSectionCreate(comm, &parentSection));
4204     PetscCall(DMPlexGetChart(newPlex, &pStart, &pEnd));
4205     PetscCall(PetscSectionSetChart(parentSection, pStart, pEnd));
4206     count = children->elem_count;
4207     for (zz = 0; zz < count; zz++) {
4208       PetscInt child = *((PetscInt *)sc_array_index(children, zz));
4209 
4210       PetscCall(PetscSectionSetDof(parentSection, child, 1));
4211     }
4212     PetscCall(PetscSectionSetUp(parentSection));
4213     PetscCall(DMPlexSetTree(newPlex, parentSection, (PetscInt *)parents->array, (PetscInt *)childids->array));
4214     PetscCall(PetscSectionDestroy(&parentSection));
4215     PetscCall(PetscSFCreate(comm, &pointSF));
4216     /*
4217        These arrays defining the sf are from the p4est library, but the code there shows the leaves being populated in increasing order.
4218        https://gitlab.com/petsc/petsc/merge_requests/2248#note_240186391
4219     */
4220     PetscCall(PetscSFSetGraph(pointSF, pEnd - pStart, (PetscInt)leaves->elem_count, (PetscInt *)leaves->array, PETSC_COPY_VALUES, (PetscSFNode *)remotes->array, PETSC_COPY_VALUES));
4221     PetscCall(DMSetPointSF(newPlex, pointSF));
4222     PetscCall(DMSetPointSF(dm, pointSF));
4223     {
4224       DM coordDM;
4225 
4226       PetscCall(DMGetCoordinateDM(newPlex, &coordDM));
4227       PetscCall(DMSetPointSF(coordDM, pointSF));
4228     }
4229     PetscCall(PetscSFDestroy(&pointSF));
4230     sc_array_destroy(points_per_dim);
4231     sc_array_destroy(cone_sizes);
4232     sc_array_destroy(cones);
4233     sc_array_destroy(cone_orientations);
4234     sc_array_destroy(coords);
4235     sc_array_destroy(children);
4236     sc_array_destroy(parents);
4237     sc_array_destroy(childids);
4238     sc_array_destroy(leaves);
4239     sc_array_destroy(remotes);
4240 
4241     {
4242       const PetscReal *maxCell, *Lstart, *L;
4243 
4244       PetscCall(DMGetPeriodicity(dm, &maxCell, &Lstart, &L));
4245       PetscCall(DMSetPeriodicity(newPlex, maxCell, Lstart, L));
4246       PetscCall(DMPforestLocalizeCoordinates(dm, newPlex));
4247     }
4248 
4249     if (overlap > 0) { /* the p4est routine can't set all of the coordinates in its routine if there is overlap */
4250       Vec                coordsGlobal, coordsLocal;
4251       const PetscScalar *globalArray;
4252       PetscScalar       *localArray;
4253       PetscSF            coordSF;
4254       DM                 coordDM;
4255 
4256       PetscCall(DMGetCoordinateDM(newPlex, &coordDM));
4257       PetscCall(DMGetSectionSF(coordDM, &coordSF));
4258       PetscCall(DMGetCoordinates(newPlex, &coordsGlobal));
4259       PetscCall(DMGetCoordinatesLocal(newPlex, &coordsLocal));
4260       PetscCall(VecGetArrayRead(coordsGlobal, &globalArray));
4261       PetscCall(VecGetArray(coordsLocal, &localArray));
4262       PetscCall(PetscSFBcastBegin(coordSF, MPIU_SCALAR, globalArray, localArray, MPI_REPLACE));
4263       PetscCall(PetscSFBcastEnd(coordSF, MPIU_SCALAR, globalArray, localArray, MPI_REPLACE));
4264       PetscCall(VecRestoreArray(coordsLocal, &localArray));
4265       PetscCall(VecRestoreArrayRead(coordsGlobal, &globalArray));
4266       PetscCall(DMSetCoordinatesLocal(newPlex, coordsLocal));
4267     }
4268     PetscCall(DMPforestMapCoordinates(dm, newPlex));
4269 
4270     pforest->plex = newPlex;
4271 
4272     /* copy labels */
4273     PetscCall(DMPforestLabelsFinalize(dm, newPlex));
4274 
4275     if (ghostLabelBase || pforest->ghostName) { /* we have to do this after copying labels because the labels drive the construction of ghost cells */
4276       PetscInt numAdded;
4277       DM       newPlexGhosted;
4278       void    *ctx;
4279 
4280       PetscCall(DMPlexConstructGhostCells(newPlex, pforest->ghostName, &numAdded, &newPlexGhosted));
4281       PetscCall(DMGetApplicationContext(newPlex, &ctx));
4282       PetscCall(DMSetApplicationContext(newPlexGhosted, ctx));
4283       /* we want the sf for the ghost dm to be the one for the p4est dm as well */
4284       PetscCall(DMGetPointSF(newPlexGhosted, &pointSF));
4285       PetscCall(DMSetPointSF(dm, pointSF));
4286       PetscCall(DMDestroy(&newPlex));
4287       PetscCall(DMPlexSetReferenceTree(newPlexGhosted, refTree));
4288       PetscCall(DMForestClearAdaptivityForest_pforest(dm));
4289       newPlex = newPlexGhosted;
4290 
4291       /* share the labels back */
4292       PetscCall(DMDestroyLabelLinkList_Internal(dm));
4293       PetscCall(DMCopyLabels(newPlex, dm, PETSC_OWN_POINTER, PETSC_TRUE, DM_COPY_LABELS_FAIL));
4294       pforest->plex = newPlex;
4295     }
4296     PetscCall(DMDestroy(&refTree));
4297     if (dm->setfromoptionscalled) {
4298       PetscObjectOptionsBegin((PetscObject)newPlex);
4299       PetscCall(DMSetFromOptions_NonRefinement_Plex(newPlex, PetscOptionsObject));
4300       PetscCall(PetscObjectProcessOptionsHandlers((PetscObject)newPlex, PetscOptionsObject));
4301       PetscOptionsEnd();
4302     }
4303     PetscCall(DMViewFromOptions(newPlex, NULL, "-dm_p4est_plex_view"));
4304     {
4305       DM           cdm;
4306       PetscSection coordsSec;
4307       Vec          coords;
4308       PetscInt     cDim;
4309 
4310       PetscCall(DMGetCoordinateDim(newPlex, &cDim));
4311       PetscCall(DMGetCoordinateSection(newPlex, &coordsSec));
4312       PetscCall(DMSetCoordinateSection(dm, cDim, coordsSec));
4313       PetscCall(DMGetCoordinatesLocal(newPlex, &coords));
4314       PetscCall(DMSetCoordinatesLocal(dm, coords));
4315       PetscCall(DMGetCellCoordinateDM(newPlex, &cdm));
4316       if (cdm) PetscCall(DMSetCellCoordinateDM(dm, cdm));
4317       PetscCall(DMGetCellCoordinateSection(newPlex, &coordsSec));
4318       if (coordsSec) PetscCall(DMSetCellCoordinateSection(dm, cDim, coordsSec));
4319       PetscCall(DMGetCellCoordinatesLocal(newPlex, &coords));
4320       if (coords) PetscCall(DMSetCellCoordinatesLocal(dm, coords));
4321     }
4322   }
4323   newPlex = pforest->plex;
4324   if (plex) {
4325     PetscCall(DMClone(newPlex, plex));
4326   #if 0
4327     PetscCall(DMGetCoordinateDM(newPlex,&coordDM));
4328     PetscCall(DMSetCoordinateDM(*plex,coordDM));
4329     PetscCall(DMGetCellCoordinateDM(newPlex,&coordDM));
4330     PetscCall(DMSetCellCoordinateDM(*plex,coordDM));
4331   #endif
4332     PetscCall(DMShareDiscretization(dm, *plex));
4333   }
4334   PetscFunctionReturn(PETSC_SUCCESS);
4335 }
4336 
4337 static PetscErrorCode DMSetFromOptions_pforest(DM dm, PetscOptionItems *PetscOptionsObject)
4338 {
4339   DM_Forest_pforest *pforest = (DM_Forest_pforest *)((DM_Forest *)dm->data)->data;
4340   char               stringBuffer[256];
4341   PetscBool          flg;
4342 
4343   PetscFunctionBegin;
4344   PetscCall(DMSetFromOptions_Forest(dm, PetscOptionsObject));
4345   PetscOptionsHeadBegin(PetscOptionsObject, "DM" P4EST_STRING " options");
4346   PetscCall(PetscOptionsBool("-dm_p4est_partition_for_coarsening", "partition forest to allow for coarsening", "DMP4estSetPartitionForCoarsening", pforest->partition_for_coarsening, &(pforest->partition_for_coarsening), NULL));
4347   PetscCall(PetscOptionsString("-dm_p4est_ghost_label_name", "the name of the ghost label when converting from a DMPlex", NULL, NULL, stringBuffer, sizeof(stringBuffer), &flg));
4348   PetscOptionsHeadEnd();
4349   if (flg) {
4350     PetscCall(PetscFree(pforest->ghostName));
4351     PetscCall(PetscStrallocpy(stringBuffer, &pforest->ghostName));
4352   }
4353   PetscFunctionReturn(PETSC_SUCCESS);
4354 }
4355 
4356   #if !defined(P4_TO_P8)
4357     #define DMPforestGetPartitionForCoarsening DMP4estGetPartitionForCoarsening
4358     #define DMPforestSetPartitionForCoarsening DMP4estSetPartitionForCoarsening
4359   #else
4360     #define DMPforestGetPartitionForCoarsening DMP8estGetPartitionForCoarsening
4361     #define DMPforestSetPartitionForCoarsening DMP8estSetPartitionForCoarsening
4362   #endif
4363 
4364 PETSC_EXTERN PetscErrorCode DMPforestGetPartitionForCoarsening(DM dm, PetscBool *flg)
4365 {
4366   DM_Forest_pforest *pforest;
4367 
4368   PetscFunctionBegin;
4369   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4370   pforest = (DM_Forest_pforest *)((DM_Forest *)dm->data)->data;
4371   *flg    = pforest->partition_for_coarsening;
4372   PetscFunctionReturn(PETSC_SUCCESS);
4373 }
4374 
4375 PETSC_EXTERN PetscErrorCode DMPforestSetPartitionForCoarsening(DM dm, PetscBool flg)
4376 {
4377   DM_Forest_pforest *pforest;
4378 
4379   PetscFunctionBegin;
4380   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4381   pforest                           = (DM_Forest_pforest *)((DM_Forest *)dm->data)->data;
4382   pforest->partition_for_coarsening = flg;
4383   PetscFunctionReturn(PETSC_SUCCESS);
4384 }
4385 
4386 static PetscErrorCode DMPforestGetPlex(DM dm, DM *plex)
4387 {
4388   DM_Forest_pforest *pforest;
4389 
4390   PetscFunctionBegin;
4391   if (plex) *plex = NULL;
4392   PetscCall(DMSetUp(dm));
4393   pforest = (DM_Forest_pforest *)((DM_Forest *)dm->data)->data;
4394   if (!pforest->plex) PetscCall(DMConvert_pforest_plex(dm, DMPLEX, NULL));
4395   PetscCall(DMShareDiscretization(dm, pforest->plex));
4396   if (plex) *plex = pforest->plex;
4397   PetscFunctionReturn(PETSC_SUCCESS);
4398 }
4399 
4400   #define DMCreateInterpolation_pforest _append_pforest(DMCreateInterpolation)
4401 static PetscErrorCode DMCreateInterpolation_pforest(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling)
4402 {
4403   PetscSection gsc, gsf;
4404   PetscInt     m, n;
4405   DM           cdm;
4406 
4407   PetscFunctionBegin;
4408   PetscCall(DMGetGlobalSection(dmFine, &gsf));
4409   PetscCall(PetscSectionGetConstrainedStorageSize(gsf, &m));
4410   PetscCall(DMGetGlobalSection(dmCoarse, &gsc));
4411   PetscCall(PetscSectionGetConstrainedStorageSize(gsc, &n));
4412 
4413   PetscCall(MatCreate(PetscObjectComm((PetscObject)dmFine), interpolation));
4414   PetscCall(MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE));
4415   PetscCall(MatSetType(*interpolation, MATAIJ));
4416 
4417   PetscCall(DMGetCoarseDM(dmFine, &cdm));
4418   PetscCheck(cdm == dmCoarse, PetscObjectComm((PetscObject)dmFine), PETSC_ERR_SUP, "Only interpolation from coarse DM for now");
4419 
4420   {
4421     DM        plexF, plexC;
4422     PetscSF   sf;
4423     PetscInt *cids;
4424     PetscInt  dofPerDim[4] = {1, 1, 1, 1};
4425 
4426     PetscCall(DMPforestGetPlex(dmCoarse, &plexC));
4427     PetscCall(DMPforestGetPlex(dmFine, &plexF));
4428     PetscCall(DMPforestGetTransferSF_Internal(dmCoarse, dmFine, dofPerDim, &sf, PETSC_TRUE, &cids));
4429     PetscCall(PetscSFSetUp(sf));
4430     PetscCall(DMPlexComputeInterpolatorTree(plexC, plexF, sf, cids, *interpolation));
4431     PetscCall(PetscSFDestroy(&sf));
4432     PetscCall(PetscFree(cids));
4433   }
4434   PetscCall(MatViewFromOptions(*interpolation, NULL, "-interp_mat_view"));
4435   /* Use naive scaling */
4436   PetscCall(DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling));
4437   PetscFunctionReturn(PETSC_SUCCESS);
4438 }
4439 
4440   #define DMCreateInjection_pforest _append_pforest(DMCreateInjection)
4441 static PetscErrorCode DMCreateInjection_pforest(DM dmCoarse, DM dmFine, Mat *injection)
4442 {
4443   PetscSection gsc, gsf;
4444   PetscInt     m, n;
4445   DM           cdm;
4446 
4447   PetscFunctionBegin;
4448   PetscCall(DMGetGlobalSection(dmFine, &gsf));
4449   PetscCall(PetscSectionGetConstrainedStorageSize(gsf, &n));
4450   PetscCall(DMGetGlobalSection(dmCoarse, &gsc));
4451   PetscCall(PetscSectionGetConstrainedStorageSize(gsc, &m));
4452 
4453   PetscCall(MatCreate(PetscObjectComm((PetscObject)dmFine), injection));
4454   PetscCall(MatSetSizes(*injection, m, n, PETSC_DETERMINE, PETSC_DETERMINE));
4455   PetscCall(MatSetType(*injection, MATAIJ));
4456 
4457   PetscCall(DMGetCoarseDM(dmFine, &cdm));
4458   PetscCheck(cdm == dmCoarse, PetscObjectComm((PetscObject)dmFine), PETSC_ERR_SUP, "Only injection to coarse DM for now");
4459 
4460   {
4461     DM        plexF, plexC;
4462     PetscSF   sf;
4463     PetscInt *cids;
4464     PetscInt  dofPerDim[4] = {1, 1, 1, 1};
4465 
4466     PetscCall(DMPforestGetPlex(dmCoarse, &plexC));
4467     PetscCall(DMPforestGetPlex(dmFine, &plexF));
4468     PetscCall(DMPforestGetTransferSF_Internal(dmCoarse, dmFine, dofPerDim, &sf, PETSC_TRUE, &cids));
4469     PetscCall(PetscSFSetUp(sf));
4470     PetscCall(DMPlexComputeInjectorTree(plexC, plexF, sf, cids, *injection));
4471     PetscCall(PetscSFDestroy(&sf));
4472     PetscCall(PetscFree(cids));
4473   }
4474   PetscCall(MatViewFromOptions(*injection, NULL, "-inject_mat_view"));
4475   /* Use naive scaling */
4476   PetscFunctionReturn(PETSC_SUCCESS);
4477 }
4478 
4479   #define DMForestTransferVecFromBase_pforest _append_pforest(DMForestTransferVecFromBase)
4480 static PetscErrorCode DMForestTransferVecFromBase_pforest(DM dm, Vec vecIn, Vec vecOut)
4481 {
4482   DM        dmIn, dmVecIn, base, basec, plex, coarseDM;
4483   DM       *hierarchy;
4484   PetscSF   sfRed = NULL;
4485   PetscDS   ds;
4486   Vec       vecInLocal, vecOutLocal;
4487   DMLabel   subpointMap;
4488   PetscInt  minLevel, mh, n_hi, i;
4489   PetscBool hiforest, *hierarchy_forest;
4490 
4491   PetscFunctionBegin;
4492   PetscCall(VecGetDM(vecIn, &dmVecIn));
4493   PetscCall(DMGetDS(dmVecIn, &ds));
4494   PetscCheck(ds, PetscObjectComm((PetscObject)dmVecIn), PETSC_ERR_SUP, "Cannot transfer without a PetscDS object");
4495   { /* we cannot stick user contexts into function callbacks for DMProjectFieldLocal! */
4496     PetscSection section;
4497     PetscInt     Nf;
4498 
4499     PetscCall(DMGetLocalSection(dmVecIn, &section));
4500     PetscCall(PetscSectionGetNumFields(section, &Nf));
4501     PetscCheck(Nf <= 3, PetscObjectComm((PetscObject)dmVecIn), PETSC_ERR_SUP, "Number of fields %" PetscInt_FMT " are currently not supported! Send an email at petsc-dev@mcs.anl.gov", Nf);
4502   }
4503   PetscCall(DMForestGetMinimumRefinement(dm, &minLevel));
4504   PetscCheck(!minLevel, PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Cannot transfer with minimum refinement set to %" PetscInt_FMT ". Rerun with DMForestSetMinimumRefinement(dm,0)", minLevel);
4505   PetscCall(DMForestGetBaseDM(dm, &base));
4506   PetscCheck(base, PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Missing base DM");
4507 
4508   PetscCall(VecSet(vecOut, 0.0));
4509   if (dmVecIn == base) { /* sequential runs */
4510     PetscCall(PetscObjectReference((PetscObject)vecIn));
4511   } else {
4512     PetscSection secIn, secInRed;
4513     Vec          vecInRed, vecInLocal;
4514 
4515     PetscCall(PetscObjectQuery((PetscObject)base, "_base_migration_sf", (PetscObject *)&sfRed));
4516     PetscCheck(sfRed, PETSC_COMM_SELF, PETSC_ERR_SUP, "Not the DM set with DMForestSetBaseDM()");
4517     PetscCall(PetscSectionCreate(PetscObjectComm((PetscObject)dmVecIn), &secInRed));
4518     PetscCall(VecCreate(PETSC_COMM_SELF, &vecInRed));
4519     PetscCall(DMGetLocalSection(dmVecIn, &secIn));
4520     PetscCall(DMGetLocalVector(dmVecIn, &vecInLocal));
4521     PetscCall(DMGlobalToLocalBegin(dmVecIn, vecIn, INSERT_VALUES, vecInLocal));
4522     PetscCall(DMGlobalToLocalEnd(dmVecIn, vecIn, INSERT_VALUES, vecInLocal));
4523     PetscCall(DMPlexDistributeField(dmVecIn, sfRed, secIn, vecInLocal, secInRed, vecInRed));
4524     PetscCall(DMRestoreLocalVector(dmVecIn, &vecInLocal));
4525     PetscCall(PetscSectionDestroy(&secInRed));
4526     vecIn = vecInRed;
4527   }
4528 
4529   /* we first search through the AdaptivityForest hierarchy
4530      once we found the first disconnected forest, we upsweep the DM hierarchy */
4531   hiforest = PETSC_TRUE;
4532 
4533   /* upsweep to the coarsest DM */
4534   n_hi     = 0;
4535   coarseDM = dm;
4536   do {
4537     PetscBool isforest;
4538 
4539     dmIn = coarseDM;
4540     /* need to call DMSetUp to have the hierarchy recursively setup */
4541     PetscCall(DMSetUp(dmIn));
4542     PetscCall(DMIsForest(dmIn, &isforest));
4543     PetscCheck(isforest, PetscObjectComm((PetscObject)dmIn), PETSC_ERR_SUP, "Cannot currently transfer through a mixed hierarchy! Found DM type %s", ((PetscObject)dmIn)->type_name);
4544     coarseDM = NULL;
4545     if (hiforest) PetscCall(DMForestGetAdaptivityForest(dmIn, &coarseDM));
4546     if (!coarseDM) { /* DMForest hierarchy ended, we keep upsweeping through the DM hierarchy */
4547       hiforest = PETSC_FALSE;
4548       PetscCall(DMGetCoarseDM(dmIn, &coarseDM));
4549     }
4550     n_hi++;
4551   } while (coarseDM);
4552 
4553   PetscCall(PetscMalloc2(n_hi, &hierarchy, n_hi, &hierarchy_forest));
4554 
4555   i        = 0;
4556   hiforest = PETSC_TRUE;
4557   coarseDM = dm;
4558   do {
4559     dmIn     = coarseDM;
4560     coarseDM = NULL;
4561     if (hiforest) PetscCall(DMForestGetAdaptivityForest(dmIn, &coarseDM));
4562     if (!coarseDM) { /* DMForest hierarchy ended, we keep upsweeping through the DM hierarchy */
4563       hiforest = PETSC_FALSE;
4564       PetscCall(DMGetCoarseDM(dmIn, &coarseDM));
4565     }
4566     i++;
4567     hierarchy[n_hi - i] = dmIn;
4568   } while (coarseDM);
4569 
4570   /* project base vector on the coarsest forest (minimum refinement = 0) */
4571   PetscCall(DMPforestGetPlex(dmIn, &plex));
4572 
4573   /* Check this plex is compatible with the base */
4574   {
4575     IS       gnum[2];
4576     PetscInt ncells[2], gncells[2];
4577 
4578     PetscCall(DMPlexGetCellNumbering(base, &gnum[0]));
4579     PetscCall(DMPlexGetCellNumbering(plex, &gnum[1]));
4580     PetscCall(ISGetMinMax(gnum[0], NULL, &ncells[0]));
4581     PetscCall(ISGetMinMax(gnum[1], NULL, &ncells[1]));
4582     PetscCall(MPIU_Allreduce(ncells, gncells, 2, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)dm)));
4583     PetscCheck(gncells[0] == gncells[1], PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Invalid number of base cells! Expected %" PetscInt_FMT ", found %" PetscInt_FMT, gncells[0] + 1, gncells[1] + 1);
4584   }
4585 
4586   PetscCall(DMGetLabel(dmIn, "_forest_base_subpoint_map", &subpointMap));
4587   PetscCheck(subpointMap, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Missing _forest_base_subpoint_map label");
4588 
4589   PetscCall(DMPlexGetMaxProjectionHeight(base, &mh));
4590   PetscCall(DMPlexSetMaxProjectionHeight(plex, mh));
4591 
4592   PetscCall(DMClone(base, &basec));
4593   PetscCall(DMCopyDisc(dmVecIn, basec));
4594   if (sfRed) {
4595     PetscCall(PetscObjectReference((PetscObject)vecIn));
4596     vecInLocal = vecIn;
4597   } else {
4598     PetscCall(DMCreateLocalVector(basec, &vecInLocal));
4599     PetscCall(DMGlobalToLocalBegin(basec, vecIn, INSERT_VALUES, vecInLocal));
4600     PetscCall(DMGlobalToLocalEnd(basec, vecIn, INSERT_VALUES, vecInLocal));
4601   }
4602 
4603   PetscCall(DMGetLocalVector(dmIn, &vecOutLocal));
4604   { /* get degrees of freedom ordered onto dmIn */
4605     PetscSF            basetocoarse;
4606     PetscInt           bStart, bEnd, nroots;
4607     PetscInt           iStart, iEnd, nleaves, leaf;
4608     PetscMPIInt        rank;
4609     PetscSFNode       *remotes;
4610     PetscSection       secIn, secOut;
4611     PetscInt          *remoteOffsets;
4612     PetscSF            transferSF;
4613     const PetscScalar *inArray;
4614     PetscScalar       *outArray;
4615 
4616     PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)basec), &rank));
4617     PetscCall(DMPlexGetChart(basec, &bStart, &bEnd));
4618     nroots = PetscMax(bEnd - bStart, 0);
4619     PetscCall(DMPlexGetChart(plex, &iStart, &iEnd));
4620     nleaves = PetscMax(iEnd - iStart, 0);
4621 
4622     PetscCall(PetscMalloc1(nleaves, &remotes));
4623     for (leaf = iStart; leaf < iEnd; leaf++) {
4624       PetscInt index;
4625 
4626       remotes[leaf - iStart].rank = rank;
4627       PetscCall(DMLabelGetValue(subpointMap, leaf, &index));
4628       remotes[leaf - iStart].index = index;
4629     }
4630 
4631     PetscCall(PetscSFCreate(PetscObjectComm((PetscObject)basec), &basetocoarse));
4632     PetscCall(PetscSFSetGraph(basetocoarse, nroots, nleaves, NULL, PETSC_OWN_POINTER, remotes, PETSC_OWN_POINTER));
4633     PetscCall(PetscSFSetUp(basetocoarse));
4634     PetscCall(DMGetLocalSection(basec, &secIn));
4635     PetscCall(PetscSectionCreate(PetscObjectComm((PetscObject)dmIn), &secOut));
4636     PetscCall(PetscSFDistributeSection(basetocoarse, secIn, &remoteOffsets, secOut));
4637     PetscCall(PetscSFCreateSectionSF(basetocoarse, secIn, remoteOffsets, secOut, &transferSF));
4638     PetscCall(PetscFree(remoteOffsets));
4639     PetscCall(VecGetArrayWrite(vecOutLocal, &outArray));
4640     PetscCall(VecGetArrayRead(vecInLocal, &inArray));
4641     PetscCall(PetscSFBcastBegin(transferSF, MPIU_SCALAR, inArray, outArray, MPI_REPLACE));
4642     PetscCall(PetscSFBcastEnd(transferSF, MPIU_SCALAR, inArray, outArray, MPI_REPLACE));
4643     PetscCall(VecRestoreArrayRead(vecInLocal, &inArray));
4644     PetscCall(VecRestoreArrayWrite(vecOutLocal, &outArray));
4645     PetscCall(PetscSFDestroy(&transferSF));
4646     PetscCall(PetscSectionDestroy(&secOut));
4647     PetscCall(PetscSFDestroy(&basetocoarse));
4648   }
4649   PetscCall(VecDestroy(&vecInLocal));
4650   PetscCall(DMDestroy(&basec));
4651   PetscCall(VecDestroy(&vecIn));
4652 
4653   /* output */
4654   if (n_hi > 1) { /* downsweep the stored hierarchy */
4655     Vec vecOut1, vecOut2;
4656     DM  fineDM;
4657 
4658     PetscCall(DMGetGlobalVector(dmIn, &vecOut1));
4659     PetscCall(DMLocalToGlobal(dmIn, vecOutLocal, INSERT_VALUES, vecOut1));
4660     PetscCall(DMRestoreLocalVector(dmIn, &vecOutLocal));
4661     for (i = 1; i < n_hi - 1; i++) {
4662       fineDM = hierarchy[i];
4663       PetscCall(DMGetGlobalVector(fineDM, &vecOut2));
4664       PetscCall(DMForestTransferVec(dmIn, vecOut1, fineDM, vecOut2, PETSC_TRUE, 0.0));
4665       PetscCall(DMRestoreGlobalVector(dmIn, &vecOut1));
4666       vecOut1 = vecOut2;
4667       dmIn    = fineDM;
4668     }
4669     PetscCall(DMForestTransferVec(dmIn, vecOut1, dm, vecOut, PETSC_TRUE, 0.0));
4670     PetscCall(DMRestoreGlobalVector(dmIn, &vecOut1));
4671   } else {
4672     PetscCall(DMLocalToGlobal(dmIn, vecOutLocal, INSERT_VALUES, vecOut));
4673     PetscCall(DMRestoreLocalVector(dmIn, &vecOutLocal));
4674   }
4675   PetscCall(PetscFree2(hierarchy, hierarchy_forest));
4676   PetscFunctionReturn(PETSC_SUCCESS);
4677 }
4678 
4679   #define DMForestTransferVec_pforest _append_pforest(DMForestTransferVec)
4680 static PetscErrorCode DMForestTransferVec_pforest(DM dmIn, Vec vecIn, DM dmOut, Vec vecOut, PetscBool useBCs, PetscReal time)
4681 {
4682   DM          adaptIn, adaptOut, plexIn, plexOut;
4683   DM_Forest  *forestIn, *forestOut, *forestAdaptIn, *forestAdaptOut;
4684   PetscInt    dofPerDim[] = {1, 1, 1, 1};
4685   PetscSF     inSF = NULL, outSF = NULL;
4686   PetscInt   *inCids = NULL, *outCids = NULL;
4687   DMAdaptFlag purposeIn, purposeOut;
4688 
4689   PetscFunctionBegin;
4690   forestOut = (DM_Forest *)dmOut->data;
4691   forestIn  = (DM_Forest *)dmIn->data;
4692 
4693   PetscCall(DMForestGetAdaptivityForest(dmOut, &adaptOut));
4694   PetscCall(DMForestGetAdaptivityPurpose(dmOut, &purposeOut));
4695   forestAdaptOut = adaptOut ? (DM_Forest *)adaptOut->data : NULL;
4696 
4697   PetscCall(DMForestGetAdaptivityForest(dmIn, &adaptIn));
4698   PetscCall(DMForestGetAdaptivityPurpose(dmIn, &purposeIn));
4699   forestAdaptIn = adaptIn ? (DM_Forest *)adaptIn->data : NULL;
4700 
4701   if (forestAdaptOut == forestIn) {
4702     switch (purposeOut) {
4703     case DM_ADAPT_REFINE:
4704       PetscCall(DMPforestGetTransferSF_Internal(dmIn, dmOut, dofPerDim, &inSF, PETSC_TRUE, &inCids));
4705       PetscCall(PetscSFSetUp(inSF));
4706       break;
4707     case DM_ADAPT_COARSEN:
4708     case DM_ADAPT_COARSEN_LAST:
4709       PetscCall(DMPforestGetTransferSF_Internal(dmOut, dmIn, dofPerDim, &outSF, PETSC_TRUE, &outCids));
4710       PetscCall(PetscSFSetUp(outSF));
4711       break;
4712     default:
4713       PetscCall(DMPforestGetTransferSF_Internal(dmIn, dmOut, dofPerDim, &inSF, PETSC_TRUE, &inCids));
4714       PetscCall(DMPforestGetTransferSF_Internal(dmOut, dmIn, dofPerDim, &outSF, PETSC_FALSE, &outCids));
4715       PetscCall(PetscSFSetUp(inSF));
4716       PetscCall(PetscSFSetUp(outSF));
4717     }
4718   } else if (forestAdaptIn == forestOut) {
4719     switch (purposeIn) {
4720     case DM_ADAPT_REFINE:
4721       PetscCall(DMPforestGetTransferSF_Internal(dmOut, dmIn, dofPerDim, &outSF, PETSC_TRUE, &inCids));
4722       PetscCall(PetscSFSetUp(outSF));
4723       break;
4724     case DM_ADAPT_COARSEN:
4725     case DM_ADAPT_COARSEN_LAST:
4726       PetscCall(DMPforestGetTransferSF_Internal(dmIn, dmOut, dofPerDim, &inSF, PETSC_TRUE, &inCids));
4727       PetscCall(PetscSFSetUp(inSF));
4728       break;
4729     default:
4730       PetscCall(DMPforestGetTransferSF_Internal(dmIn, dmOut, dofPerDim, &inSF, PETSC_TRUE, &inCids));
4731       PetscCall(DMPforestGetTransferSF_Internal(dmOut, dmIn, dofPerDim, &outSF, PETSC_FALSE, &outCids));
4732       PetscCall(PetscSFSetUp(inSF));
4733       PetscCall(PetscSFSetUp(outSF));
4734     }
4735   } else SETERRQ(PetscObjectComm((PetscObject)dmIn), PETSC_ERR_SUP, "Only support transfer from pre-adaptivity to post-adaptivity right now");
4736   PetscCall(DMPforestGetPlex(dmIn, &plexIn));
4737   PetscCall(DMPforestGetPlex(dmOut, &plexOut));
4738 
4739   PetscCall(DMPlexTransferVecTree(plexIn, vecIn, plexOut, vecOut, inSF, outSF, inCids, outCids, useBCs, time));
4740   PetscCall(PetscFree(inCids));
4741   PetscCall(PetscFree(outCids));
4742   PetscCall(PetscSFDestroy(&inSF));
4743   PetscCall(PetscSFDestroy(&outSF));
4744   PetscCall(PetscFree(inCids));
4745   PetscCall(PetscFree(outCids));
4746   PetscFunctionReturn(PETSC_SUCCESS);
4747 }
4748 
4749   #define DMCreateCoordinateDM_pforest _append_pforest(DMCreateCoordinateDM)
4750 static PetscErrorCode DMCreateCoordinateDM_pforest(DM dm, DM *cdm)
4751 {
4752   DM plex;
4753 
4754   PetscFunctionBegin;
4755   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4756   PetscCall(DMPforestGetPlex(dm, &plex));
4757   PetscCall(DMGetCoordinateDM(plex, cdm));
4758   PetscCall(PetscObjectReference((PetscObject)*cdm));
4759   PetscFunctionReturn(PETSC_SUCCESS);
4760 }
4761 
4762   #define VecViewLocal_pforest _append_pforest(VecViewLocal)
4763 static PetscErrorCode VecViewLocal_pforest(Vec vec, PetscViewer viewer)
4764 {
4765   DM dm, plex;
4766 
4767   PetscFunctionBegin;
4768   PetscCall(VecGetDM(vec, &dm));
4769   PetscCall(DMPforestGetPlex(dm, &plex));
4770   PetscCall(VecSetDM(vec, plex));
4771   PetscCall(VecView_Plex_Local(vec, viewer));
4772   PetscCall(VecSetDM(vec, dm));
4773   PetscFunctionReturn(PETSC_SUCCESS);
4774 }
4775 
4776   #define VecView_pforest _append_pforest(VecView)
4777 static PetscErrorCode VecView_pforest(Vec vec, PetscViewer viewer)
4778 {
4779   DM dm, plex;
4780 
4781   PetscFunctionBegin;
4782   PetscCall(VecGetDM(vec, &dm));
4783   PetscCall(DMPforestGetPlex(dm, &plex));
4784   PetscCall(VecSetDM(vec, plex));
4785   PetscCall(VecView_Plex(vec, viewer));
4786   PetscCall(VecSetDM(vec, dm));
4787   PetscFunctionReturn(PETSC_SUCCESS);
4788 }
4789 
4790   #define VecView_pforest_Native _infix_pforest(VecView, _Native)
4791 static PetscErrorCode VecView_pforest_Native(Vec vec, PetscViewer viewer)
4792 {
4793   DM dm, plex;
4794 
4795   PetscFunctionBegin;
4796   PetscCall(VecGetDM(vec, &dm));
4797   PetscCall(DMPforestGetPlex(dm, &plex));
4798   PetscCall(VecSetDM(vec, plex));
4799   PetscCall(VecView_Plex_Native(vec, viewer));
4800   PetscCall(VecSetDM(vec, dm));
4801   PetscFunctionReturn(PETSC_SUCCESS);
4802 }
4803 
4804   #define VecLoad_pforest _append_pforest(VecLoad)
4805 static PetscErrorCode VecLoad_pforest(Vec vec, PetscViewer viewer)
4806 {
4807   DM dm, plex;
4808 
4809   PetscFunctionBegin;
4810   PetscCall(VecGetDM(vec, &dm));
4811   PetscCall(DMPforestGetPlex(dm, &plex));
4812   PetscCall(VecSetDM(vec, plex));
4813   PetscCall(VecLoad_Plex(vec, viewer));
4814   PetscCall(VecSetDM(vec, dm));
4815   PetscFunctionReturn(PETSC_SUCCESS);
4816 }
4817 
4818   #define VecLoad_pforest_Native _infix_pforest(VecLoad, _Native)
4819 static PetscErrorCode VecLoad_pforest_Native(Vec vec, PetscViewer viewer)
4820 {
4821   DM dm, plex;
4822 
4823   PetscFunctionBegin;
4824   PetscCall(VecGetDM(vec, &dm));
4825   PetscCall(DMPforestGetPlex(dm, &plex));
4826   PetscCall(VecSetDM(vec, plex));
4827   PetscCall(VecLoad_Plex_Native(vec, viewer));
4828   PetscCall(VecSetDM(vec, dm));
4829   PetscFunctionReturn(PETSC_SUCCESS);
4830 }
4831 
4832   #define DMCreateGlobalVector_pforest _append_pforest(DMCreateGlobalVector)
4833 static PetscErrorCode DMCreateGlobalVector_pforest(DM dm, Vec *vec)
4834 {
4835   PetscFunctionBegin;
4836   PetscCall(DMCreateGlobalVector_Section_Private(dm, vec));
4837   /* PetscCall(VecSetOperation(*vec, VECOP_DUPLICATE, (void(*)(void)) VecDuplicate_MPI_DM)); */
4838   PetscCall(VecSetOperation(*vec, VECOP_VIEW, (void (*)(void))VecView_pforest));
4839   PetscCall(VecSetOperation(*vec, VECOP_VIEWNATIVE, (void (*)(void))VecView_pforest_Native));
4840   PetscCall(VecSetOperation(*vec, VECOP_LOAD, (void (*)(void))VecLoad_pforest));
4841   PetscCall(VecSetOperation(*vec, VECOP_LOADNATIVE, (void (*)(void))VecLoad_pforest_Native));
4842   PetscFunctionReturn(PETSC_SUCCESS);
4843 }
4844 
4845   #define DMCreateLocalVector_pforest _append_pforest(DMCreateLocalVector)
4846 static PetscErrorCode DMCreateLocalVector_pforest(DM dm, Vec *vec)
4847 {
4848   PetscFunctionBegin;
4849   PetscCall(DMCreateLocalVector_Section_Private(dm, vec));
4850   PetscCall(VecSetOperation(*vec, VECOP_VIEW, (void (*)(void))VecViewLocal_pforest));
4851   PetscFunctionReturn(PETSC_SUCCESS);
4852 }
4853 
4854   #define DMCreateMatrix_pforest _append_pforest(DMCreateMatrix)
4855 static PetscErrorCode DMCreateMatrix_pforest(DM dm, Mat *mat)
4856 {
4857   DM plex;
4858 
4859   PetscFunctionBegin;
4860   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4861   PetscCall(DMPforestGetPlex(dm, &plex));
4862   if (plex->prealloc_only != dm->prealloc_only) plex->prealloc_only = dm->prealloc_only; /* maybe this should go into forest->plex */
4863   PetscCall(DMCreateMatrix(plex, mat));
4864   PetscCall(MatSetDM(*mat, dm));
4865   PetscFunctionReturn(PETSC_SUCCESS);
4866 }
4867 
4868   #define DMProjectFunctionLocal_pforest _append_pforest(DMProjectFunctionLocal)
4869 static PetscErrorCode DMProjectFunctionLocal_pforest(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *), void **ctxs, InsertMode mode, Vec localX)
4870 {
4871   DM plex;
4872 
4873   PetscFunctionBegin;
4874   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4875   PetscCall(DMPforestGetPlex(dm, &plex));
4876   PetscCall(DMProjectFunctionLocal(plex, time, funcs, ctxs, mode, localX));
4877   PetscFunctionReturn(PETSC_SUCCESS);
4878 }
4879 
4880   #define DMProjectFunctionLabelLocal_pforest _append_pforest(DMProjectFunctionLabelLocal)
4881 static PetscErrorCode DMProjectFunctionLabelLocal_pforest(DM dm, PetscReal time, DMLabel label, PetscInt numIds, const PetscInt ids[], PetscInt Ncc, const PetscInt comps[], PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *), void **ctxs, InsertMode mode, Vec localX)
4882 {
4883   DM plex;
4884 
4885   PetscFunctionBegin;
4886   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4887   PetscCall(DMPforestGetPlex(dm, &plex));
4888   PetscCall(DMProjectFunctionLabelLocal(plex, time, label, numIds, ids, Ncc, comps, funcs, ctxs, mode, localX));
4889   PetscFunctionReturn(PETSC_SUCCESS);
4890 }
4891 
4892   #define DMProjectFieldLocal_pforest _append_pforest(DMProjectFieldLocal)
4893 PetscErrorCode DMProjectFieldLocal_pforest(DM dm, PetscReal time, Vec localU, void (**funcs)(PetscInt, PetscInt, PetscInt, const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]), InsertMode mode, Vec localX)
4894 {
4895   DM plex;
4896 
4897   PetscFunctionBegin;
4898   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4899   PetscCall(DMPforestGetPlex(dm, &plex));
4900   PetscCall(DMProjectFieldLocal(plex, time, localU, funcs, mode, localX));
4901   PetscFunctionReturn(PETSC_SUCCESS);
4902 }
4903 
4904   #define DMComputeL2Diff_pforest _append_pforest(DMComputeL2Diff)
4905 PetscErrorCode DMComputeL2Diff_pforest(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff)
4906 {
4907   DM plex;
4908 
4909   PetscFunctionBegin;
4910   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4911   PetscCall(DMPforestGetPlex(dm, &plex));
4912   PetscCall(DMComputeL2Diff(plex, time, funcs, ctxs, X, diff));
4913   PetscFunctionReturn(PETSC_SUCCESS);
4914 }
4915 
4916   #define DMComputeL2FieldDiff_pforest _append_pforest(DMComputeL2FieldDiff)
4917 PetscErrorCode DMComputeL2FieldDiff_pforest(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal diff[])
4918 {
4919   DM plex;
4920 
4921   PetscFunctionBegin;
4922   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4923   PetscCall(DMPforestGetPlex(dm, &plex));
4924   PetscCall(DMComputeL2FieldDiff(plex, time, funcs, ctxs, X, diff));
4925   PetscFunctionReturn(PETSC_SUCCESS);
4926 }
4927 
4928   #define DMCreatelocalsection_pforest _append_pforest(DMCreatelocalsection)
4929 static PetscErrorCode DMCreatelocalsection_pforest(DM dm)
4930 {
4931   DM           plex;
4932   PetscSection section;
4933 
4934   PetscFunctionBegin;
4935   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4936   PetscCall(DMPforestGetPlex(dm, &plex));
4937   PetscCall(DMGetLocalSection(plex, &section));
4938   PetscCall(DMSetLocalSection(dm, section));
4939   PetscFunctionReturn(PETSC_SUCCESS);
4940 }
4941 
4942   #define DMCreateDefaultConstraints_pforest _append_pforest(DMCreateDefaultConstraints)
4943 static PetscErrorCode DMCreateDefaultConstraints_pforest(DM dm)
4944 {
4945   DM           plex;
4946   Mat          mat;
4947   Vec          bias;
4948   PetscSection section;
4949 
4950   PetscFunctionBegin;
4951   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4952   PetscCall(DMPforestGetPlex(dm, &plex));
4953   PetscCall(DMGetDefaultConstraints(plex, &section, &mat, &bias));
4954   PetscCall(DMSetDefaultConstraints(dm, section, mat, bias));
4955   PetscFunctionReturn(PETSC_SUCCESS);
4956 }
4957 
4958   #define DMGetDimPoints_pforest _append_pforest(DMGetDimPoints)
4959 static PetscErrorCode DMGetDimPoints_pforest(DM dm, PetscInt dim, PetscInt *cStart, PetscInt *cEnd)
4960 {
4961   DM plex;
4962 
4963   PetscFunctionBegin;
4964   PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
4965   PetscCall(DMPforestGetPlex(dm, &plex));
4966   PetscCall(DMGetDimPoints(plex, dim, cStart, cEnd));
4967   PetscFunctionReturn(PETSC_SUCCESS);
4968 }
4969 
4970   /* Need to forward declare */
4971   #define DMInitialize_pforest _append_pforest(DMInitialize)
4972 static PetscErrorCode DMInitialize_pforest(DM dm);
4973 
4974   #define DMClone_pforest _append_pforest(DMClone)
4975 static PetscErrorCode DMClone_pforest(DM dm, DM *newdm)
4976 {
4977   PetscFunctionBegin;
4978   PetscCall(DMClone_Forest(dm, newdm));
4979   PetscCall(DMInitialize_pforest(*newdm));
4980   PetscFunctionReturn(PETSC_SUCCESS);
4981 }
4982 
4983   #define DMForestCreateCellChart_pforest _append_pforest(DMForestCreateCellChart)
4984 static PetscErrorCode DMForestCreateCellChart_pforest(DM dm, PetscInt *cStart, PetscInt *cEnd)
4985 {
4986   DM_Forest         *forest;
4987   DM_Forest_pforest *pforest;
4988   PetscInt           overlap;
4989 
4990   PetscFunctionBegin;
4991   PetscCall(DMSetUp(dm));
4992   forest  = (DM_Forest *)dm->data;
4993   pforest = (DM_Forest_pforest *)forest->data;
4994   *cStart = 0;
4995   PetscCall(DMForestGetPartitionOverlap(dm, &overlap));
4996   if (overlap && pforest->ghost) {
4997     *cEnd = pforest->forest->local_num_quadrants + pforest->ghost->proc_offsets[pforest->forest->mpisize];
4998   } else {
4999     *cEnd = pforest->forest->local_num_quadrants;
5000   }
5001   PetscFunctionReturn(PETSC_SUCCESS);
5002 }
5003 
5004   #define DMForestCreateCellSF_pforest _append_pforest(DMForestCreateCellSF)
5005 static PetscErrorCode DMForestCreateCellSF_pforest(DM dm, PetscSF *cellSF)
5006 {
5007   DM_Forest         *forest;
5008   DM_Forest_pforest *pforest;
5009   PetscMPIInt        rank;
5010   PetscInt           overlap;
5011   PetscInt           cStart, cEnd, cLocalStart, cLocalEnd;
5012   PetscInt           nRoots, nLeaves, *mine = NULL;
5013   PetscSFNode       *remote = NULL;
5014   PetscSF            sf;
5015 
5016   PetscFunctionBegin;
5017   PetscCall(DMForestGetCellChart(dm, &cStart, &cEnd));
5018   forest      = (DM_Forest *)dm->data;
5019   pforest     = (DM_Forest_pforest *)forest->data;
5020   nRoots      = cEnd - cStart;
5021   cLocalStart = pforest->cLocalStart;
5022   cLocalEnd   = pforest->cLocalEnd;
5023   nLeaves     = 0;
5024   PetscCall(DMForestGetPartitionOverlap(dm, &overlap));
5025   PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)dm), &rank));
5026   if (overlap && pforest->ghost) {
5027     PetscSFNode      *mirror;
5028     p4est_quadrant_t *mirror_array;
5029     PetscInt          nMirror, nGhostPre, nSelf, q;
5030     void            **mirrorPtrs;
5031 
5032     nMirror   = (PetscInt)pforest->ghost->mirrors.elem_count;
5033     nSelf     = cLocalEnd - cLocalStart;
5034     nLeaves   = nRoots - nSelf;
5035     nGhostPre = (PetscInt)pforest->ghost->proc_offsets[rank];
5036     PetscCall(PetscMalloc1(nLeaves, &mine));
5037     PetscCall(PetscMalloc1(nLeaves, &remote));
5038     PetscCall(PetscMalloc2(nMirror, &mirror, nMirror, &mirrorPtrs));
5039     mirror_array = (p4est_quadrant_t *)pforest->ghost->mirrors.array;
5040     for (q = 0; q < nMirror; q++) {
5041       p4est_quadrant_t *mir = &(mirror_array[q]);
5042 
5043       mirror[q].rank  = rank;
5044       mirror[q].index = (PetscInt)mir->p.piggy3.local_num + cLocalStart;
5045       mirrorPtrs[q]   = (void *)&(mirror[q]);
5046     }
5047     PetscCallP4est(p4est_ghost_exchange_custom, (pforest->forest, pforest->ghost, sizeof(PetscSFNode), mirrorPtrs, remote));
5048     PetscCall(PetscFree2(mirror, mirrorPtrs));
5049     for (q = 0; q < nGhostPre; q++) mine[q] = q;
5050     for (; q < nLeaves; q++) mine[q] = (q - nGhostPre) + cLocalEnd;
5051   }
5052   PetscCall(PetscSFCreate(PetscObjectComm((PetscObject)dm), &sf));
5053   PetscCall(PetscSFSetGraph(sf, nRoots, nLeaves, mine, PETSC_OWN_POINTER, remote, PETSC_OWN_POINTER));
5054   *cellSF = sf;
5055   PetscFunctionReturn(PETSC_SUCCESS);
5056 }
5057 
5058 static PetscErrorCode DMCreateNeumannOverlap_pforest(DM dm, IS *ovl, Mat *J, PetscErrorCode (**setup)(Mat, PetscReal, Vec, Vec, PetscReal, IS, void *), void **setup_ctx)
5059 {
5060   DM plex;
5061 
5062   PetscFunctionBegin;
5063   PetscCall(DMPforestGetPlex(dm, &plex));
5064   PetscCall(DMCreateNeumannOverlap_Plex(plex, ovl, J, setup, setup_ctx));
5065   if (!*setup) {
5066     PetscCall(PetscObjectQueryFunction((PetscObject)dm, "MatComputeNeumannOverlap_C", setup));
5067     if (*setup) PetscCall(PetscObjectCompose((PetscObject)*ovl, "_DM_Original_HPDDM", (PetscObject)dm));
5068   }
5069   PetscFunctionReturn(PETSC_SUCCESS);
5070 }
5071 
5072 static PetscErrorCode DMInitialize_pforest(DM dm)
5073 {
5074   PetscFunctionBegin;
5075   dm->ops->setup                     = DMSetUp_pforest;
5076   dm->ops->view                      = DMView_pforest;
5077   dm->ops->clone                     = DMClone_pforest;
5078   dm->ops->createinterpolation       = DMCreateInterpolation_pforest;
5079   dm->ops->createinjection           = DMCreateInjection_pforest;
5080   dm->ops->setfromoptions            = DMSetFromOptions_pforest;
5081   dm->ops->createcoordinatedm        = DMCreateCoordinateDM_pforest;
5082   dm->ops->createglobalvector        = DMCreateGlobalVector_pforest;
5083   dm->ops->createlocalvector         = DMCreateLocalVector_pforest;
5084   dm->ops->creatematrix              = DMCreateMatrix_pforest;
5085   dm->ops->projectfunctionlocal      = DMProjectFunctionLocal_pforest;
5086   dm->ops->projectfunctionlabellocal = DMProjectFunctionLabelLocal_pforest;
5087   dm->ops->projectfieldlocal         = DMProjectFieldLocal_pforest;
5088   dm->ops->createlocalsection        = DMCreatelocalsection_pforest;
5089   dm->ops->createdefaultconstraints  = DMCreateDefaultConstraints_pforest;
5090   dm->ops->computel2diff             = DMComputeL2Diff_pforest;
5091   dm->ops->computel2fielddiff        = DMComputeL2FieldDiff_pforest;
5092   dm->ops->getdimpoints              = DMGetDimPoints_pforest;
5093 
5094   PetscCall(PetscObjectComposeFunction((PetscObject)dm, PetscStringize(DMConvert_plex_pforest) "_C", DMConvert_plex_pforest));
5095   PetscCall(PetscObjectComposeFunction((PetscObject)dm, PetscStringize(DMConvert_pforest_plex) "_C", DMConvert_pforest_plex));
5096   PetscCall(PetscObjectComposeFunction((PetscObject)dm, "DMCreateNeumannOverlap_C", DMCreateNeumannOverlap_pforest));
5097   PetscCall(PetscObjectComposeFunction((PetscObject)dm, "DMPlexGetOverlap_C", DMForestGetPartitionOverlap));
5098   PetscFunctionReturn(PETSC_SUCCESS);
5099 }
5100 
5101   #define DMCreate_pforest _append_pforest(DMCreate)
5102 PETSC_EXTERN PetscErrorCode DMCreate_pforest(DM dm)
5103 {
5104   DM_Forest         *forest;
5105   DM_Forest_pforest *pforest;
5106 
5107   PetscFunctionBegin;
5108   PetscCall(PetscP4estInitialize());
5109   PetscCall(DMCreate_Forest(dm));
5110   PetscCall(DMInitialize_pforest(dm));
5111   PetscCall(DMSetDimension(dm, P4EST_DIM));
5112 
5113   /* set forest defaults */
5114   PetscCall(DMForestSetTopology(dm, "unit"));
5115   PetscCall(DMForestSetMinimumRefinement(dm, 0));
5116   PetscCall(DMForestSetInitialRefinement(dm, 0));
5117   PetscCall(DMForestSetMaximumRefinement(dm, P4EST_QMAXLEVEL));
5118   PetscCall(DMForestSetGradeFactor(dm, 2));
5119   PetscCall(DMForestSetAdjacencyDimension(dm, 0));
5120   PetscCall(DMForestSetPartitionOverlap(dm, 0));
5121 
5122   /* create p4est data */
5123   PetscCall(PetscNew(&pforest));
5124 
5125   forest                            = (DM_Forest *)dm->data;
5126   forest->data                      = pforest;
5127   forest->destroy                   = DMForestDestroy_pforest;
5128   forest->ftemplate                 = DMForestTemplate_pforest;
5129   forest->transfervec               = DMForestTransferVec_pforest;
5130   forest->transfervecfrombase       = DMForestTransferVecFromBase_pforest;
5131   forest->createcellchart           = DMForestCreateCellChart_pforest;
5132   forest->createcellsf              = DMForestCreateCellSF_pforest;
5133   forest->clearadaptivityforest     = DMForestClearAdaptivityForest_pforest;
5134   forest->getadaptivitysuccess      = DMForestGetAdaptivitySuccess_pforest;
5135   pforest->topo                     = NULL;
5136   pforest->forest                   = NULL;
5137   pforest->ghost                    = NULL;
5138   pforest->lnodes                   = NULL;
5139   pforest->partition_for_coarsening = PETSC_TRUE;
5140   pforest->coarsen_hierarchy        = PETSC_FALSE;
5141   pforest->cLocalStart              = -1;
5142   pforest->cLocalEnd                = -1;
5143   pforest->labelsFinalized          = PETSC_FALSE;
5144   pforest->ghostName                = NULL;
5145   PetscFunctionReturn(PETSC_SUCCESS);
5146 }
5147 
5148 #endif /* defined(PETSC_HAVE_P4EST) */
5149 #endif
5150