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