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->defaultConstraint.section);CHKERRQ(ierr); 2226 ierr = PetscSectionDestroy(&(dmB->defaultConstraint.section));CHKERRQ(ierr); 2227 dmB->defaultConstraint.section = dmA->defaultConstraint.section; 2228 ierr = PetscObjectReference((PetscObject)dmA->defaultConstraint.mat);CHKERRQ(ierr); 2229 ierr = MatDestroy(&(dmB->defaultConstraint.mat));CHKERRQ(ierr); 2230 dmB->defaultConstraint.mat = dmA->defaultConstraint.mat; 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,§ion);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(§ion);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; 2981 DM_Forest_pforest *pforestC, *pforestF; 2982 DM plexC, plexF; 2983 PetscInt pStartC, pEndC, pStartF, pEndF; 2984 PetscSF pointTransferSF; 2985 PetscBool allOnes = PETSC_TRUE; 2986 PetscErrorCode ierr; 2987 2988 PetscFunctionBegin; 2989 pforestC = (DM_Forest_pforest*) ((DM_Forest*) coarse->data)->data; 2990 pforestF = (DM_Forest_pforest*) ((DM_Forest*) fine->data)->data; 2991 PetscCheckFalse(pforestC->topo != pforestF->topo,PetscObjectComm((PetscObject)coarse),PETSC_ERR_ARG_INCOMP,"DM's must have the same base DM"); 2992 comm = PetscObjectComm((PetscObject)coarse); 2993 ierr = MPI_Comm_rank(comm,&rank);CHKERRMPI(ierr); 2994 2995 { 2996 PetscInt i; 2997 for (i = 0; i <= P4EST_DIM; i++) { 2998 if (dofPerDim[i] != 1) { 2999 allOnes = PETSC_FALSE; 3000 break; 3001 } 3002 } 3003 } 3004 ierr = DMPforestGetTransferSF_Point(coarse,fine,&pointTransferSF,transferIdent,childIds);CHKERRQ(ierr); 3005 if (allOnes) { 3006 *sf = pointTransferSF; 3007 PetscFunctionReturn(0); 3008 } 3009 3010 ierr = DMPforestGetPlex(fine,&plexF);CHKERRQ(ierr); 3011 ierr = DMPlexGetChart(plexF,&pStartF,&pEndF);CHKERRQ(ierr); 3012 ierr = DMPforestGetPlex(coarse,&plexC);CHKERRQ(ierr); 3013 ierr = DMPlexGetChart(plexC,&pStartC,&pEndC);CHKERRQ(ierr); 3014 { 3015 PetscInt numRoots; 3016 PetscInt numLeaves; 3017 const PetscInt *leaves; 3018 const PetscSFNode *iremote; 3019 PetscInt d; 3020 PetscSection leafSection, rootSection; 3021 /* count leaves */ 3022 3023 ierr = PetscSFGetGraph(pointTransferSF,&numRoots,&numLeaves,&leaves,&iremote);CHKERRQ(ierr); 3024 ierr = PetscSectionCreate(PETSC_COMM_SELF,&rootSection);CHKERRQ(ierr); 3025 ierr = PetscSectionCreate(PETSC_COMM_SELF,&leafSection);CHKERRQ(ierr); 3026 ierr = PetscSectionSetChart(rootSection,pStartC,pEndC);CHKERRQ(ierr); 3027 ierr = PetscSectionSetChart(leafSection,pStartF,pEndF);CHKERRQ(ierr); 3028 3029 for (d = 0; d <= P4EST_DIM; d++) { 3030 PetscInt startC, endC, e; 3031 3032 ierr = DMPlexGetSimplexOrBoxCells(plexC,P4EST_DIM-d,&startC,&endC);CHKERRQ(ierr); 3033 for (e = startC; e < endC; e++) { 3034 ierr = PetscSectionSetDof(rootSection,e,dofPerDim[d]);CHKERRQ(ierr); 3035 } 3036 } 3037 3038 for (d = 0; d <= P4EST_DIM; d++) { 3039 PetscInt startF, endF, e; 3040 3041 ierr = DMPlexGetSimplexOrBoxCells(plexF,P4EST_DIM-d,&startF,&endF);CHKERRQ(ierr); 3042 for (e = startF; e < endF; e++) { 3043 ierr = PetscSectionSetDof(leafSection,e,dofPerDim[d]);CHKERRQ(ierr); 3044 } 3045 } 3046 3047 ierr = PetscSectionSetUp(rootSection);CHKERRQ(ierr); 3048 ierr = PetscSectionSetUp(leafSection);CHKERRQ(ierr); 3049 { 3050 PetscInt nroots, nleaves; 3051 PetscInt *mine, i, p; 3052 PetscInt *offsets, *offsetsRoot; 3053 PetscSFNode *remote; 3054 3055 ierr = PetscMalloc1(pEndF-pStartF,&offsets);CHKERRQ(ierr); 3056 ierr = PetscMalloc1(pEndC-pStartC,&offsetsRoot);CHKERRQ(ierr); 3057 for (p = pStartC; p < pEndC; p++) { 3058 ierr = PetscSectionGetOffset(rootSection,p,&offsetsRoot[p-pStartC]);CHKERRQ(ierr); 3059 } 3060 ierr = PetscSFBcastBegin(pointTransferSF,MPIU_INT,offsetsRoot,offsets,MPI_REPLACE);CHKERRQ(ierr); 3061 ierr = PetscSFBcastEnd(pointTransferSF,MPIU_INT,offsetsRoot,offsets,MPI_REPLACE);CHKERRQ(ierr); 3062 ierr = PetscSectionGetStorageSize(rootSection,&nroots);CHKERRQ(ierr); 3063 nleaves = 0; 3064 for (i = 0; i < numLeaves; i++) { 3065 PetscInt leaf = leaves ? leaves[i] : i; 3066 PetscInt dof; 3067 3068 ierr = PetscSectionGetDof(leafSection,leaf,&dof);CHKERRQ(ierr); 3069 nleaves += dof; 3070 } 3071 ierr = PetscMalloc1(nleaves,&mine);CHKERRQ(ierr); 3072 ierr = PetscMalloc1(nleaves,&remote);CHKERRQ(ierr); 3073 nleaves = 0; 3074 for (i = 0; i < numLeaves; i++) { 3075 PetscInt leaf = leaves ? leaves[i] : i; 3076 PetscInt dof; 3077 PetscInt off, j; 3078 3079 ierr = PetscSectionGetDof(leafSection,leaf,&dof);CHKERRQ(ierr); 3080 ierr = PetscSectionGetOffset(leafSection,leaf,&off);CHKERRQ(ierr); 3081 for (j = 0; j < dof; j++) { 3082 remote[nleaves].rank = iremote[i].rank; 3083 remote[nleaves].index = offsets[leaf] + j; 3084 mine[nleaves++] = off + j; 3085 } 3086 } 3087 ierr = PetscFree(offsetsRoot);CHKERRQ(ierr); 3088 ierr = PetscFree(offsets);CHKERRQ(ierr); 3089 ierr = PetscSFCreate(comm,sf);CHKERRQ(ierr); 3090 ierr = PetscSFSetGraph(*sf,nroots,nleaves,mine,PETSC_OWN_POINTER,remote,PETSC_OWN_POINTER);CHKERRQ(ierr); 3091 } 3092 ierr = PetscSectionDestroy(&leafSection);CHKERRQ(ierr); 3093 ierr = PetscSectionDestroy(&rootSection);CHKERRQ(ierr); 3094 ierr = PetscSFDestroy(&pointTransferSF);CHKERRQ(ierr); 3095 } 3096 PetscFunctionReturn(0); 3097 } 3098 3099 static PetscErrorCode DMPforestGetTransferSF(DM dmA, DM dmB, const PetscInt dofPerDim[], PetscSF *sfAtoB, PetscSF *sfBtoA) 3100 { 3101 DM adaptA, adaptB; 3102 DMAdaptFlag purpose; 3103 PetscErrorCode ierr; 3104 3105 PetscFunctionBegin; 3106 ierr = DMForestGetAdaptivityForest(dmA,&adaptA);CHKERRQ(ierr); 3107 ierr = DMForestGetAdaptivityForest(dmB,&adaptB);CHKERRQ(ierr); 3108 /* it is more efficient when the coarser mesh is the first argument: reorder if we know one is coarser than the other */ 3109 if (adaptA && adaptA->data == dmB->data) { /* dmA was adapted from dmB */ 3110 ierr = DMForestGetAdaptivityPurpose(dmA,&purpose);CHKERRQ(ierr); 3111 if (purpose == DM_ADAPT_REFINE) { 3112 ierr = DMPforestGetTransferSF(dmB, dmA, dofPerDim, sfBtoA, sfAtoB);CHKERRQ(ierr); 3113 PetscFunctionReturn(0); 3114 } 3115 } else if (adaptB && adaptB->data == dmA->data) { /* dmB was adapted from dmA */ 3116 ierr = DMForestGetAdaptivityPurpose(dmB,&purpose);CHKERRQ(ierr); 3117 if (purpose == DM_ADAPT_COARSEN) { 3118 ierr = DMPforestGetTransferSF(dmB, dmA, dofPerDim, sfBtoA, sfAtoB);CHKERRQ(ierr); 3119 PetscFunctionReturn(0); 3120 } 3121 } 3122 if (sfAtoB) { 3123 ierr = DMPforestGetTransferSF_Internal(dmA,dmB,dofPerDim,sfAtoB,PETSC_TRUE,NULL);CHKERRQ(ierr); 3124 } 3125 if (sfBtoA) { 3126 ierr = DMPforestGetTransferSF_Internal(dmB,dmA,dofPerDim,sfBtoA,(PetscBool) (sfAtoB == NULL),NULL);CHKERRQ(ierr); 3127 } 3128 PetscFunctionReturn(0); 3129 } 3130 3131 static PetscErrorCode DMPforestLabelsInitialize(DM dm, DM plex) 3132 { 3133 DM_Forest *forest = (DM_Forest*) dm->data; 3134 DM_Forest_pforest *pforest = (DM_Forest_pforest*) forest->data; 3135 PetscInt cLocalStart, cLocalEnd, cStart, cEnd, fStart, fEnd, eStart, eEnd, vStart, vEnd; 3136 PetscInt cStartBase, cEndBase, fStartBase, fEndBase, vStartBase, vEndBase, eStartBase, eEndBase; 3137 PetscInt pStart, pEnd, pStartBase, pEndBase, p; 3138 DM base; 3139 PetscInt *star = NULL, starSize; 3140 DMLabelLink next = dm->labels; 3141 PetscInt guess = 0; 3142 p4est_topidx_t num_trees = pforest->topo->conn->num_trees; 3143 PetscErrorCode ierr; 3144 3145 PetscFunctionBegin; 3146 pforest->labelsFinalized = PETSC_TRUE; 3147 cLocalStart = pforest->cLocalStart; 3148 cLocalEnd = pforest->cLocalEnd; 3149 ierr = DMForestGetBaseDM(dm,&base);CHKERRQ(ierr); 3150 if (!base) { 3151 if (pforest->ghostName) { /* insert a label to make the boundaries, with stratum values denoting which face of the element touches the boundary */ 3152 p4est_connectivity_t *conn = pforest->topo->conn; 3153 p4est_t *p4est = pforest->forest; 3154 p4est_tree_t *trees = (p4est_tree_t*) p4est->trees->array; 3155 p4est_topidx_t t, flt = p4est->first_local_tree; 3156 p4est_topidx_t llt = pforest->forest->last_local_tree; 3157 DMLabel ghostLabel; 3158 PetscInt c; 3159 3160 ierr = DMCreateLabel(plex,pforest->ghostName);CHKERRQ(ierr); 3161 ierr = DMGetLabel(plex,pforest->ghostName,&ghostLabel);CHKERRQ(ierr); 3162 for (c = cLocalStart, t = flt; t <= llt; t++) { 3163 p4est_tree_t *tree = &trees[t]; 3164 p4est_quadrant_t *quads = (p4est_quadrant_t*) tree->quadrants.array; 3165 PetscInt numQuads = (PetscInt) tree->quadrants.elem_count; 3166 PetscInt q; 3167 3168 for (q = 0; q < numQuads; q++, c++) { 3169 p4est_quadrant_t *quad = &quads[q]; 3170 PetscInt f; 3171 3172 for (f = 0; f < P4EST_FACES; f++) { 3173 p4est_quadrant_t neigh; 3174 int isOutside; 3175 3176 PetscStackCallP4est(p4est_quadrant_face_neighbor,(quad,f,&neigh)); 3177 PetscStackCallP4estReturn(isOutside,p4est_quadrant_is_outside_face,(&neigh)); 3178 if (isOutside) { 3179 p4est_topidx_t nt; 3180 PetscInt nf; 3181 3182 nt = conn->tree_to_tree[t * P4EST_FACES + f]; 3183 nf = (PetscInt) conn->tree_to_face[t * P4EST_FACES + f]; 3184 nf = nf % P4EST_FACES; 3185 if (nt == t && nf == f) { 3186 PetscInt plexF = P4estFaceToPetscFace[f]; 3187 const PetscInt *cone; 3188 3189 ierr = DMPlexGetCone(plex,c,&cone);CHKERRQ(ierr); 3190 ierr = DMLabelSetValue(ghostLabel,cone[plexF],plexF+1);CHKERRQ(ierr); 3191 } 3192 } 3193 } 3194 } 3195 } 3196 } 3197 PetscFunctionReturn(0); 3198 } 3199 ierr = DMPlexGetSimplexOrBoxCells(base,0,&cStartBase,&cEndBase);CHKERRQ(ierr); 3200 ierr = DMPlexGetSimplexOrBoxCells(base,1,&fStartBase,&fEndBase);CHKERRQ(ierr); 3201 ierr = DMPlexGetSimplexOrBoxCells(base,P4EST_DIM-1,&eStartBase,&eEndBase);CHKERRQ(ierr); 3202 ierr = DMPlexGetDepthStratum(base,0,&vStartBase,&vEndBase);CHKERRQ(ierr); 3203 3204 ierr = DMPlexGetSimplexOrBoxCells(plex,0,&cStart,&cEnd);CHKERRQ(ierr); 3205 ierr = DMPlexGetSimplexOrBoxCells(plex,1,&fStart,&fEnd);CHKERRQ(ierr); 3206 ierr = DMPlexGetSimplexOrBoxCells(plex,P4EST_DIM-1,&eStart,&eEnd);CHKERRQ(ierr); 3207 ierr = DMPlexGetDepthStratum(plex,0,&vStart,&vEnd);CHKERRQ(ierr); 3208 3209 ierr = DMPlexGetChart(plex,&pStart,&pEnd);CHKERRQ(ierr); 3210 ierr = DMPlexGetChart(base,&pStartBase,&pEndBase);CHKERRQ(ierr); 3211 /* go through the mesh: use star to find a quadrant that borders a point. Use the closure to determine the 3212 * orientation of the quadrant relative to that point. Use that to relate the point to the numbering in the base 3213 * mesh, and extract a label value (since the base mesh is redundantly distributed, can be found locally). */ 3214 while (next) { 3215 DMLabel baseLabel; 3216 DMLabel label = next->label; 3217 PetscBool isDepth, isCellType, isGhost, isVTK, isSpmap; 3218 const char *name; 3219 3220 ierr = PetscObjectGetName((PetscObject) label, &name);CHKERRQ(ierr); 3221 ierr = PetscStrcmp(name,"depth",&isDepth);CHKERRQ(ierr); 3222 if (isDepth) { 3223 next = next->next; 3224 continue; 3225 } 3226 ierr = PetscStrcmp(name,"celltype",&isCellType);CHKERRQ(ierr); 3227 if (isCellType) { 3228 next = next->next; 3229 continue; 3230 } 3231 ierr = PetscStrcmp(name,"ghost",&isGhost);CHKERRQ(ierr); 3232 if (isGhost) { 3233 next = next->next; 3234 continue; 3235 } 3236 ierr = PetscStrcmp(name,"vtk",&isVTK);CHKERRQ(ierr); 3237 if (isVTK) { 3238 next = next->next; 3239 continue; 3240 } 3241 ierr = PetscStrcmp(name,"_forest_base_subpoint_map",&isSpmap);CHKERRQ(ierr); 3242 if (!isSpmap) { 3243 ierr = DMGetLabel(base,name,&baseLabel);CHKERRQ(ierr); 3244 if (!baseLabel) { 3245 next = next->next; 3246 continue; 3247 } 3248 ierr = DMLabelCreateIndex(baseLabel,pStartBase,pEndBase);CHKERRQ(ierr); 3249 } else baseLabel = NULL; 3250 3251 for (p = pStart; p < pEnd; p++) { 3252 PetscInt s, c = -1, l; 3253 PetscInt *closure = NULL, closureSize; 3254 p4est_quadrant_t * ghosts = (p4est_quadrant_t*) pforest->ghost->ghosts.array; 3255 p4est_tree_t *trees = (p4est_tree_t*) pforest->forest->trees->array; 3256 p4est_quadrant_t * q; 3257 PetscInt t, val; 3258 PetscBool zerosupportpoint = PETSC_FALSE; 3259 3260 ierr = DMPlexGetTransitiveClosure(plex,p,PETSC_FALSE,&starSize,&star);CHKERRQ(ierr); 3261 for (s = 0; s < starSize; s++) { 3262 PetscInt point = star[2*s]; 3263 3264 if (cStart <= point && point < cEnd) { 3265 ierr = DMPlexGetTransitiveClosure(plex,point,PETSC_TRUE,&closureSize,&closure);CHKERRQ(ierr); 3266 for (l = 0; l < closureSize; l++) { 3267 PetscInt qParent = closure[2 * l], q, pp = p, pParent = p; 3268 do { /* check parents of q */ 3269 q = qParent; 3270 if (q == p) { 3271 c = point; 3272 break; 3273 } 3274 ierr = DMPlexGetTreeParent(plex,q,&qParent,NULL);CHKERRQ(ierr); 3275 } while (qParent != q); 3276 if (c != -1) break; 3277 ierr = DMPlexGetTreeParent(plex,pp,&pParent,NULL);CHKERRQ(ierr); 3278 q = closure[2 * l]; 3279 while (pParent != pp) { /* check parents of p */ 3280 pp = pParent; 3281 if (pp == q) { 3282 c = point; 3283 break; 3284 } 3285 ierr = DMPlexGetTreeParent(plex,pp,&pParent,NULL);CHKERRQ(ierr); 3286 } 3287 if (c != -1) break; 3288 } 3289 ierr = DMPlexRestoreTransitiveClosure(plex,point,PETSC_TRUE,NULL,&closure);CHKERRQ(ierr); 3290 if (l < closureSize) break; 3291 } else { 3292 PetscInt supportSize; 3293 3294 ierr = DMPlexGetSupportSize(plex,point,&supportSize);CHKERRQ(ierr); 3295 zerosupportpoint = (PetscBool) (zerosupportpoint || !supportSize); 3296 } 3297 } 3298 if (c < 0) { 3299 const char* prefix; 3300 PetscBool print = PETSC_FALSE; 3301 3302 ierr = PetscObjectGetOptionsPrefix((PetscObject)dm,&prefix);CHKERRQ(ierr); 3303 ierr = PetscOptionsGetBool(((PetscObject)dm)->options,prefix,"-dm_forest_print_label_error",&print,NULL);CHKERRQ(ierr); 3304 if (print) { 3305 PetscInt i; 3306 3307 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); 3308 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); } 3309 } 3310 ierr = DMPlexRestoreTransitiveClosure(plex,p,PETSC_FALSE,NULL,&star);CHKERRQ(ierr); 3311 if (zerosupportpoint) continue; 3312 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"); 3313 } 3314 ierr = DMPlexRestoreTransitiveClosure(plex,p,PETSC_FALSE,NULL,&star);CHKERRQ(ierr); 3315 3316 if (c < cLocalStart) { 3317 /* get from the beginning of the ghost layer */ 3318 q = &(ghosts[c]); 3319 t = (PetscInt) q->p.which_tree; 3320 } else if (c < cLocalEnd) { 3321 PetscInt lo = 0, hi = num_trees; 3322 /* get from local quadrants: have to find the right tree */ 3323 3324 c -= cLocalStart; 3325 3326 do { 3327 p4est_tree_t *tree; 3328 3329 PetscCheckFalse(guess < lo || guess >= num_trees || lo >= hi,PETSC_COMM_SELF,PETSC_ERR_PLIB,"failed binary search"); 3330 tree = &trees[guess]; 3331 if (c < tree->quadrants_offset) { 3332 hi = guess; 3333 } else if (c < tree->quadrants_offset + (PetscInt) tree->quadrants.elem_count) { 3334 q = &((p4est_quadrant_t *)tree->quadrants.array)[c - (PetscInt) tree->quadrants_offset]; 3335 t = guess; 3336 break; 3337 } else { 3338 lo = guess + 1; 3339 } 3340 guess = lo + (hi - lo) / 2; 3341 } while (1); 3342 } else { 3343 /* get from the end of the ghost layer */ 3344 c -= (cLocalEnd - cLocalStart); 3345 3346 q = &(ghosts[c]); 3347 t = (PetscInt) q->p.which_tree; 3348 } 3349 3350 if (l == 0) { /* cell */ 3351 if (baseLabel) { 3352 ierr = DMLabelGetValue(baseLabel,t+cStartBase,&val);CHKERRQ(ierr); 3353 } else { 3354 val = t+cStartBase; 3355 } 3356 ierr = DMLabelSetValue(label,p,val);CHKERRQ(ierr); 3357 } else if (l >= 1 && l < 1 + P4EST_FACES) { /* facet */ 3358 p4est_quadrant_t nq; 3359 int isInside; 3360 3361 l = PetscFaceToP4estFace[l - 1]; 3362 PetscStackCallP4est(p4est_quadrant_face_neighbor,(q,l,&nq)); 3363 PetscStackCallP4estReturn(isInside,p4est_quadrant_is_inside_root,(&nq)); 3364 if (isInside) { 3365 /* this facet is in the interior of a tree, so it inherits the label of the tree */ 3366 if (baseLabel) { 3367 ierr = DMLabelGetValue(baseLabel,t+cStartBase,&val);CHKERRQ(ierr); 3368 } else { 3369 val = t+cStartBase; 3370 } 3371 ierr = DMLabelSetValue(label,p,val);CHKERRQ(ierr); 3372 } else { 3373 PetscInt f = pforest->topo->tree_face_to_uniq[P4EST_FACES * t + l]; 3374 3375 if (baseLabel) { 3376 ierr = DMLabelGetValue(baseLabel,f+fStartBase,&val);CHKERRQ(ierr); 3377 } else { 3378 val = f+fStartBase; 3379 } 3380 ierr = DMLabelSetValue(label,p,val);CHKERRQ(ierr); 3381 } 3382 #if defined(P4_TO_P8) 3383 } else if (l >= 1 + P4EST_FACES && l < 1 + P4EST_FACES + P8EST_EDGES) { /* edge */ 3384 p4est_quadrant_t nq; 3385 int isInside; 3386 3387 l = PetscEdgeToP4estEdge[l - (1 + P4EST_FACES)]; 3388 PetscStackCallP4est(p8est_quadrant_edge_neighbor,(q,l,&nq)); 3389 PetscStackCallP4estReturn(isInside,p4est_quadrant_is_inside_root,(&nq)); 3390 if (isInside) { 3391 /* this edge is in the interior of a tree, so it inherits the label of the tree */ 3392 if (baseLabel) { 3393 ierr = DMLabelGetValue(baseLabel,t+cStartBase,&val);CHKERRQ(ierr); 3394 } else { 3395 val = t+cStartBase; 3396 } 3397 ierr = DMLabelSetValue(label,p,val);CHKERRQ(ierr); 3398 } else { 3399 int isOutsideFace; 3400 3401 PetscStackCallP4estReturn(isOutsideFace,p4est_quadrant_is_outside_face,(&nq)); 3402 if (isOutsideFace) { 3403 PetscInt f; 3404 3405 if (nq.x < 0) { 3406 f = 0; 3407 } else if (nq.x >= P4EST_ROOT_LEN) { 3408 f = 1; 3409 } else if (nq.y < 0) { 3410 f = 2; 3411 } else if (nq.y >= P4EST_ROOT_LEN) { 3412 f = 3; 3413 } else if (nq.z < 0) { 3414 f = 4; 3415 } else { 3416 f = 5; 3417 } 3418 f = pforest->topo->tree_face_to_uniq[P4EST_FACES * t + f]; 3419 if (baseLabel) { 3420 ierr = DMLabelGetValue(baseLabel,f+fStartBase,&val);CHKERRQ(ierr); 3421 } else { 3422 val = f+fStartBase; 3423 } 3424 ierr = DMLabelSetValue(label,p,val);CHKERRQ(ierr); 3425 } else { /* the quadrant edge corresponds to the tree edge */ 3426 PetscInt e = pforest->topo->conn->tree_to_edge[P8EST_EDGES * t + l]; 3427 3428 if (baseLabel) { 3429 ierr = DMLabelGetValue(baseLabel,e+eStartBase,&val);CHKERRQ(ierr); 3430 } else { 3431 val = e+eStartBase; 3432 } 3433 ierr = DMLabelSetValue(label,p,val);CHKERRQ(ierr); 3434 } 3435 } 3436 #endif 3437 } else { /* vertex */ 3438 p4est_quadrant_t nq; 3439 int isInside; 3440 3441 #if defined(P4_TO_P8) 3442 l = PetscVertToP4estVert[l - (1 + P4EST_FACES + P8EST_EDGES)]; 3443 #else 3444 l = PetscVertToP4estVert[l - (1 + P4EST_FACES)]; 3445 #endif 3446 PetscStackCallP4est(p4est_quadrant_corner_neighbor,(q,l,&nq)); 3447 PetscStackCallP4estReturn(isInside,p4est_quadrant_is_inside_root,(&nq)); 3448 if (isInside) { 3449 if (baseLabel) { 3450 ierr = DMLabelGetValue(baseLabel,t+cStartBase,&val);CHKERRQ(ierr); 3451 } else { 3452 val = t+cStartBase; 3453 } 3454 ierr = DMLabelSetValue(label,p,val);CHKERRQ(ierr); 3455 } else { 3456 int isOutside; 3457 3458 PetscStackCallP4estReturn(isOutside,p4est_quadrant_is_outside_face,(&nq)); 3459 if (isOutside) { 3460 PetscInt f = -1; 3461 3462 if (nq.x < 0) { 3463 f = 0; 3464 } else if (nq.x >= P4EST_ROOT_LEN) { 3465 f = 1; 3466 } else if (nq.y < 0) { 3467 f = 2; 3468 } else if (nq.y >= P4EST_ROOT_LEN) { 3469 f = 3; 3470 #if defined(P4_TO_P8) 3471 } else if (nq.z < 0) { 3472 f = 4; 3473 } else { 3474 f = 5; 3475 #endif 3476 } 3477 f = pforest->topo->tree_face_to_uniq[P4EST_FACES * t + f]; 3478 if (baseLabel) { 3479 ierr = DMLabelGetValue(baseLabel,f+fStartBase,&val);CHKERRQ(ierr); 3480 } else { 3481 val = f+fStartBase; 3482 } 3483 ierr = DMLabelSetValue(label,p,val);CHKERRQ(ierr); 3484 continue; 3485 } 3486 #if defined(P4_TO_P8) 3487 PetscStackCallP4estReturn(isOutside,p8est_quadrant_is_outside_edge,(&nq)); 3488 if (isOutside) { 3489 /* outside edge */ 3490 PetscInt e = -1; 3491 3492 if (nq.x >= 0 && nq.x < P4EST_ROOT_LEN) { 3493 if (nq.z < 0) { 3494 if (nq.y < 0) { 3495 e = 0; 3496 } else { 3497 e = 1; 3498 } 3499 } else { 3500 if (nq.y < 0) { 3501 e = 2; 3502 } else { 3503 e = 3; 3504 } 3505 } 3506 } else if (nq.y >= 0 && nq.y < P4EST_ROOT_LEN) { 3507 if (nq.z < 0) { 3508 if (nq.x < 0) { 3509 e = 4; 3510 } else { 3511 e = 5; 3512 } 3513 } else { 3514 if (nq.x < 0) { 3515 e = 6; 3516 } else { 3517 e = 7; 3518 } 3519 } 3520 } else { 3521 if (nq.y < 0) { 3522 if (nq.x < 0) { 3523 e = 8; 3524 } else { 3525 e = 9; 3526 } 3527 } else { 3528 if (nq.x < 0) { 3529 e = 10; 3530 } else { 3531 e = 11; 3532 } 3533 } 3534 } 3535 3536 e = pforest->topo->conn->tree_to_edge[P8EST_EDGES * t + e]; 3537 if (baseLabel) { 3538 ierr = DMLabelGetValue(baseLabel,e+eStartBase,&val);CHKERRQ(ierr); 3539 } else { 3540 val = e+eStartBase; 3541 } 3542 ierr = DMLabelSetValue(label,p,val);CHKERRQ(ierr); 3543 continue; 3544 } 3545 #endif 3546 { 3547 /* outside vertex: same corner as quadrant corner */ 3548 PetscInt v = pforest->topo->conn->tree_to_corner[P4EST_CHILDREN * t + l]; 3549 3550 if (baseLabel) { 3551 ierr = DMLabelGetValue(baseLabel,v+vStartBase,&val);CHKERRQ(ierr); 3552 } else { 3553 val = v+vStartBase; 3554 } 3555 ierr = DMLabelSetValue(label,p,val);CHKERRQ(ierr); 3556 } 3557 } 3558 } 3559 } 3560 next = next->next; 3561 } 3562 PetscFunctionReturn(0); 3563 } 3564 3565 static PetscErrorCode DMPforestLabelsFinalize(DM dm, DM plex) 3566 { 3567 DM_Forest_pforest *pforest = (DM_Forest_pforest*) ((DM_Forest*) dm->data)->data; 3568 DM adapt; 3569 PetscErrorCode ierr; 3570 3571 PetscFunctionBegin; 3572 if (pforest->labelsFinalized) PetscFunctionReturn(0); 3573 pforest->labelsFinalized = PETSC_TRUE; 3574 ierr = DMForestGetAdaptivityForest(dm,&adapt);CHKERRQ(ierr); 3575 if (!adapt) { 3576 /* Initialize labels from the base dm */ 3577 ierr = DMPforestLabelsInitialize(dm,plex);CHKERRQ(ierr); 3578 } else { 3579 PetscInt dofPerDim[4]={1, 1, 1, 1}; 3580 PetscSF transferForward, transferBackward, pointSF; 3581 PetscInt pStart, pEnd, pStartA, pEndA; 3582 PetscInt *values, *adaptValues; 3583 DMLabelLink next = adapt->labels; 3584 DMLabel adaptLabel; 3585 DM adaptPlex; 3586 3587 ierr = DMForestGetAdaptivityLabel(dm,&adaptLabel);CHKERRQ(ierr); 3588 ierr = DMPforestGetPlex(adapt,&adaptPlex);CHKERRQ(ierr); 3589 ierr = DMPforestGetTransferSF(adapt,dm,dofPerDim,&transferForward,&transferBackward);CHKERRQ(ierr); 3590 ierr = DMPlexGetChart(plex,&pStart,&pEnd);CHKERRQ(ierr); 3591 ierr = DMPlexGetChart(adaptPlex,&pStartA,&pEndA);CHKERRQ(ierr); 3592 ierr = PetscMalloc2(pEnd-pStart,&values,pEndA-pStartA,&adaptValues);CHKERRQ(ierr); 3593 ierr = DMGetPointSF(plex,&pointSF);CHKERRQ(ierr); 3594 if (PetscDefined(USE_DEBUG)) { 3595 PetscInt p; 3596 for (p = pStartA; p < pEndA; p++) adaptValues[p-pStartA] = -1; 3597 for (p = pStart; p < pEnd; p++) values[p-pStart] = -2; 3598 if (transferForward) { 3599 ierr = PetscSFBcastBegin(transferForward,MPIU_INT,adaptValues,values,MPI_REPLACE);CHKERRQ(ierr); 3600 ierr = PetscSFBcastEnd(transferForward,MPIU_INT,adaptValues,values,MPI_REPLACE);CHKERRQ(ierr); 3601 } 3602 if (transferBackward) { 3603 ierr = PetscSFReduceBegin(transferBackward,MPIU_INT,adaptValues,values,MPIU_MAX);CHKERRQ(ierr); 3604 ierr = PetscSFReduceEnd(transferBackward,MPIU_INT,adaptValues,values,MPIU_MAX);CHKERRQ(ierr); 3605 } 3606 for (p = pStart; p < pEnd; p++) { 3607 PetscInt q = p, parent; 3608 3609 ierr = DMPlexGetTreeParent(plex,q,&parent,NULL);CHKERRQ(ierr); 3610 while (parent != q) { 3611 if (values[parent] == -2) values[parent] = values[q]; 3612 q = parent; 3613 ierr = DMPlexGetTreeParent(plex,q,&parent,NULL);CHKERRQ(ierr); 3614 } 3615 } 3616 ierr = PetscSFReduceBegin(pointSF,MPIU_INT,values,values,MPIU_MAX);CHKERRQ(ierr); 3617 ierr = PetscSFReduceEnd(pointSF,MPIU_INT,values,values,MPIU_MAX);CHKERRQ(ierr); 3618 ierr = PetscSFBcastBegin(pointSF,MPIU_INT,values,values,MPI_REPLACE);CHKERRQ(ierr); 3619 ierr = PetscSFBcastEnd(pointSF,MPIU_INT,values,values,MPI_REPLACE);CHKERRQ(ierr); 3620 for (p = pStart; p < pEnd; p++) { 3621 PetscCheckFalse(values[p-pStart] == -2,PETSC_COMM_SELF,PETSC_ERR_PLIB,"uncovered point %D",p); 3622 } 3623 } 3624 while (next) { 3625 DMLabel nextLabel = next->label; 3626 const char *name; 3627 PetscBool isDepth, isCellType, isGhost, isVTK; 3628 DMLabel label; 3629 PetscInt p; 3630 3631 ierr = PetscObjectGetName((PetscObject) nextLabel, &name);CHKERRQ(ierr); 3632 ierr = PetscStrcmp(name,"depth",&isDepth);CHKERRQ(ierr); 3633 if (isDepth) { 3634 next = next->next; 3635 continue; 3636 } 3637 ierr = PetscStrcmp(name,"celltype",&isCellType);CHKERRQ(ierr); 3638 if (isCellType) { 3639 next = next->next; 3640 continue; 3641 } 3642 ierr = PetscStrcmp(name,"ghost",&isGhost);CHKERRQ(ierr); 3643 if (isGhost) { 3644 next = next->next; 3645 continue; 3646 } 3647 ierr = PetscStrcmp(name,"vtk",&isVTK);CHKERRQ(ierr); 3648 if (isVTK) { 3649 next = next->next; 3650 continue; 3651 } 3652 if (nextLabel == adaptLabel) { 3653 next = next->next; 3654 continue; 3655 } 3656 /* label was created earlier */ 3657 ierr = DMGetLabel(dm,name,&label);CHKERRQ(ierr); 3658 for (p = pStartA; p < pEndA; p++) { 3659 ierr = DMLabelGetValue(nextLabel,p,&adaptValues[p]);CHKERRQ(ierr); 3660 } 3661 for (p = pStart; p < pEnd; p++) values[p] = PETSC_MIN_INT; 3662 3663 if (transferForward) { 3664 ierr = PetscSFBcastBegin(transferForward,MPIU_INT,adaptValues,values,MPI_REPLACE);CHKERRQ(ierr); 3665 } 3666 if (transferBackward) { 3667 ierr = PetscSFReduceBegin(transferBackward,MPIU_INT,adaptValues,values,MPIU_MAX);CHKERRQ(ierr); 3668 } 3669 if (transferForward) { 3670 ierr = PetscSFBcastEnd(transferForward,MPIU_INT,adaptValues,values,MPI_REPLACE);CHKERRQ(ierr); 3671 } 3672 if (transferBackward) { 3673 ierr = PetscSFReduceEnd(transferBackward,MPIU_INT,adaptValues,values,MPIU_MAX);CHKERRQ(ierr); 3674 } 3675 for (p = pStart; p < pEnd; p++) { 3676 PetscInt q = p, parent; 3677 3678 ierr = DMPlexGetTreeParent(plex,q,&parent,NULL);CHKERRQ(ierr); 3679 while (parent != q) { 3680 if (values[parent] == PETSC_MIN_INT) values[parent] = values[q]; 3681 q = parent; 3682 ierr = DMPlexGetTreeParent(plex,q,&parent,NULL);CHKERRQ(ierr); 3683 } 3684 } 3685 ierr = PetscSFReduceBegin(pointSF,MPIU_INT,values,values,MPIU_MAX);CHKERRQ(ierr); 3686 ierr = PetscSFReduceEnd(pointSF,MPIU_INT,values,values,MPIU_MAX);CHKERRQ(ierr); 3687 ierr = PetscSFBcastBegin(pointSF,MPIU_INT,values,values,MPI_REPLACE);CHKERRQ(ierr); 3688 ierr = PetscSFBcastEnd(pointSF,MPIU_INT,values,values,MPI_REPLACE);CHKERRQ(ierr); 3689 3690 for (p = pStart; p < pEnd; p++) { 3691 ierr = DMLabelSetValue(label,p,values[p]);CHKERRQ(ierr); 3692 } 3693 next = next->next; 3694 } 3695 ierr = PetscFree2(values,adaptValues);CHKERRQ(ierr); 3696 ierr = PetscSFDestroy(&transferForward);CHKERRQ(ierr); 3697 ierr = PetscSFDestroy(&transferBackward);CHKERRQ(ierr); 3698 pforest->labelsFinalized = PETSC_TRUE; 3699 } 3700 PetscFunctionReturn(0); 3701 } 3702 3703 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) 3704 { 3705 PetscInt closureSize, c, coordStart, coordEnd, coordDim; 3706 PetscInt *closure = NULL; 3707 PetscSection coordSec; 3708 PetscErrorCode ierr; 3709 3710 PetscFunctionBegin; 3711 ierr = DMGetCoordinateSection(plex,&coordSec);CHKERRQ(ierr); 3712 ierr = PetscSectionGetChart(coordSec,&coordStart,&coordEnd);CHKERRQ(ierr); 3713 ierr = DMGetCoordinateDim(plex,&coordDim);CHKERRQ(ierr); 3714 ierr = DMPlexGetTransitiveClosure(plex,cell,PETSC_TRUE,&closureSize,&closure);CHKERRQ(ierr); 3715 for (c = 0; c < closureSize; c++) { 3716 PetscInt point = closure[2 * c]; 3717 3718 if (point >= coordStart && point < coordEnd) { 3719 PetscInt dof, off; 3720 PetscInt nCoords, i; 3721 ierr = PetscSectionGetDof(coordSec,point,&dof);CHKERRQ(ierr); 3722 PetscCheckFalse(dof % coordDim,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Did not understand coordinate layout"); 3723 nCoords = dof / coordDim; 3724 ierr = PetscSectionGetOffset(coordSec,point,&off);CHKERRQ(ierr); 3725 for (i = 0; i < nCoords; i++) { 3726 PetscScalar *coord = &coords[off + i * coordDim]; 3727 double coordP4est[3] = {0.}; 3728 double coordP4estMapped[3] = {0.}; 3729 PetscInt j; 3730 PetscReal treeCoords[P4EST_CHILDREN][3] = {{0.}}; 3731 PetscReal eta[3] = {0.}; 3732 PetscInt numRounds = 10; 3733 PetscReal coordGuess[3] = {0.}; 3734 3735 eta[0] = (PetscReal) q->x / (PetscReal) P4EST_ROOT_LEN; 3736 eta[1] = (PetscReal) q->y / (PetscReal) P4EST_ROOT_LEN; 3737 #if defined(P4_TO_P8) 3738 eta[2] = (PetscReal) q->z / (PetscReal) P4EST_ROOT_LEN; 3739 #endif 3740 3741 for (j = 0; j < P4EST_CHILDREN; j++) { 3742 PetscInt k; 3743 3744 for (k = 0; k < 3; k++) treeCoords[j][k] = conn->vertices[3 * conn->tree_to_vertex[P4EST_CHILDREN * t + j] + k]; 3745 } 3746 3747 for (j = 0; j < P4EST_CHILDREN; j++) { 3748 PetscInt k; 3749 PetscReal prod = 1.; 3750 3751 for (k = 0; k < P4EST_DIM; k++) prod *= (j & (1 << k)) ? eta[k] : (1. - eta[k]); 3752 for (k = 0; k < 3; k++) coordGuess[k] += prod * treeCoords[j][k]; 3753 } 3754 3755 for (j = 0; j < numRounds; j++) { 3756 PetscInt dir; 3757 3758 for (dir = 0; dir < P4EST_DIM; dir++) { 3759 PetscInt k; 3760 PetscReal diff[3]; 3761 PetscReal dXdeta[3] = {0.}; 3762 PetscReal rhs, scale, update; 3763 3764 for (k = 0; k < 3; k++) diff[k] = coordP4est[k] - coordGuess[k]; 3765 for (k = 0; k < P4EST_CHILDREN; k++) { 3766 PetscInt l; 3767 PetscReal prod = 1.; 3768 3769 for (l = 0; l < P4EST_DIM; l++) { 3770 if (l == dir) { 3771 prod *= (k & (1 << l)) ? 1. : -1.; 3772 } else { 3773 prod *= (k & (1 << l)) ? eta[l] : (1. - eta[l]); 3774 } 3775 } 3776 for (l = 0; l < 3; l++) dXdeta[l] += prod * treeCoords[k][l]; 3777 } 3778 rhs = 0.; 3779 scale = 0; 3780 for (k = 0; k < 3; k++) { 3781 rhs += diff[k] * dXdeta[k]; 3782 scale += dXdeta[k] * dXdeta[k]; 3783 } 3784 update = rhs / scale; 3785 eta[dir] += update; 3786 eta[dir] = PetscMin(eta[dir],1.); 3787 eta[dir] = PetscMax(eta[dir],0.); 3788 3789 coordGuess[0] = coordGuess[1] = coordGuess[2] = 0.; 3790 for (k = 0; k < P4EST_CHILDREN; k++) { 3791 PetscInt l; 3792 PetscReal prod = 1.; 3793 3794 for (l = 0; l < P4EST_DIM; l++) prod *= (k & (1 << l)) ? eta[l] : (1. - eta[l]); 3795 for (l = 0; l < 3; l++) coordGuess[l] += prod * treeCoords[k][l]; 3796 } 3797 } 3798 } 3799 for (j = 0; j < 3; j++) coordP4est[j] = (double) eta[j]; 3800 3801 if (geom) { 3802 (geom->X)(geom,t,coordP4est,coordP4estMapped); 3803 for (j = 0; j < coordDim; j++) coord[j] = (PetscScalar) coordP4estMapped[j]; 3804 } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not coded"); 3805 } 3806 } 3807 } 3808 ierr = DMPlexRestoreTransitiveClosure(plex,cell,PETSC_TRUE,&closureSize,&closure);CHKERRQ(ierr); 3809 PetscFunctionReturn(0); 3810 } 3811 3812 static PetscErrorCode DMPforestMapCoordinates(DM dm, DM plex) 3813 { 3814 DM_Forest *forest; 3815 DM_Forest_pforest *pforest; 3816 p4est_geometry_t *geom; 3817 PetscInt cLocalStart, cLocalEnd; 3818 Vec coordLocalVec; 3819 PetscScalar *coords; 3820 p4est_topidx_t flt, llt, t; 3821 p4est_tree_t *trees; 3822 PetscErrorCode (*map)(DM,PetscInt, PetscInt, const PetscReal [], PetscReal [], void*); 3823 void *mapCtx; 3824 PetscErrorCode ierr; 3825 3826 PetscFunctionBegin; 3827 forest = (DM_Forest*) dm->data; 3828 pforest = (DM_Forest_pforest*) forest->data; 3829 geom = pforest->topo->geom; 3830 ierr = DMForestGetBaseCoordinateMapping(dm,&map,&mapCtx);CHKERRQ(ierr); 3831 if (!geom && !map) PetscFunctionReturn(0); 3832 ierr = DMGetCoordinatesLocal(plex,&coordLocalVec);CHKERRQ(ierr); 3833 ierr = VecGetArray(coordLocalVec,&coords);CHKERRQ(ierr); 3834 cLocalStart = pforest->cLocalStart; 3835 cLocalEnd = pforest->cLocalEnd; 3836 flt = pforest->forest->first_local_tree; 3837 llt = pforest->forest->last_local_tree; 3838 trees = (p4est_tree_t*) pforest->forest->trees->array; 3839 if (map) { /* apply the map directly to the existing coordinates */ 3840 PetscSection coordSec; 3841 PetscInt coordStart, coordEnd, p, coordDim, p4estCoordDim, cStart, cEnd, cEndInterior; 3842 DM base; 3843 3844 ierr = DMPlexGetHeightStratum(plex,0,&cStart,&cEnd);CHKERRQ(ierr); 3845 ierr = DMPlexGetGhostCellStratum(plex,&cEndInterior,NULL);CHKERRQ(ierr); 3846 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 3847 ierr = DMForestGetBaseDM(dm,&base);CHKERRQ(ierr); 3848 ierr = DMGetCoordinateSection(plex,&coordSec);CHKERRQ(ierr); 3849 ierr = PetscSectionGetChart(coordSec,&coordStart,&coordEnd);CHKERRQ(ierr); 3850 ierr = DMGetCoordinateDim(plex,&coordDim);CHKERRQ(ierr); 3851 p4estCoordDim = PetscMin(coordDim,3); 3852 for (p = coordStart; p < coordEnd; p++) { 3853 PetscInt *star = NULL, starSize; 3854 PetscInt dof, off, cell = -1, coarsePoint = -1; 3855 PetscInt nCoords, i; 3856 ierr = PetscSectionGetDof(coordSec,p,&dof);CHKERRQ(ierr); 3857 PetscCheckFalse(dof % coordDim,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Did not understand coordinate layout"); 3858 nCoords = dof / coordDim; 3859 ierr = PetscSectionGetOffset(coordSec,p,&off);CHKERRQ(ierr); 3860 ierr = DMPlexGetTransitiveClosure(plex,p,PETSC_FALSE,&starSize,&star);CHKERRQ(ierr); 3861 for (i = 0; i < starSize; i++) { 3862 PetscInt point = star[2 * i]; 3863 3864 if (cStart <= point && point < cEnd) { 3865 cell = point; 3866 break; 3867 } 3868 } 3869 ierr = DMPlexRestoreTransitiveClosure(plex,p,PETSC_FALSE,&starSize,&star);CHKERRQ(ierr); 3870 if (cell >= 0) { 3871 if (cell < cLocalStart) { 3872 p4est_quadrant_t *ghosts = (p4est_quadrant_t*) pforest->ghost->ghosts.array; 3873 3874 coarsePoint = ghosts[cell].p.which_tree; 3875 } else if (cell < cLocalEnd) { 3876 cell -= cLocalStart; 3877 for (t = flt; t <= llt; t++) { 3878 p4est_tree_t *tree = &(trees[t]); 3879 3880 if (cell >= tree->quadrants_offset && (size_t) cell < tree->quadrants_offset + tree->quadrants.elem_count) { 3881 coarsePoint = t; 3882 break; 3883 } 3884 } 3885 } else { 3886 p4est_quadrant_t *ghosts = (p4est_quadrant_t*) pforest->ghost->ghosts.array; 3887 3888 coarsePoint = ghosts[cell - cLocalEnd].p.which_tree; 3889 } 3890 } 3891 for (i = 0; i < nCoords; i++) { 3892 PetscScalar *coord = &coords[off + i * coordDim]; 3893 PetscReal coordP4est[3] = {0.}; 3894 PetscReal coordP4estMapped[3] = {0.}; 3895 PetscInt j; 3896 3897 for (j = 0; j < p4estCoordDim; j++) coordP4est[j] = PetscRealPart(coord[j]); 3898 ierr = (map)(base,coarsePoint,p4estCoordDim,coordP4est,coordP4estMapped,mapCtx);CHKERRQ(ierr); 3899 for (j = 0; j < p4estCoordDim; j++) coord[j] = (PetscScalar) coordP4estMapped[j]; 3900 } 3901 } 3902 } else { /* we have to transform coordinates back to the unit cube (where geom is defined), and then apply geom */ 3903 PetscInt cStart, cEnd, cEndInterior; 3904 3905 ierr = DMPlexGetHeightStratum(plex,0,&cStart,&cEnd);CHKERRQ(ierr); 3906 ierr = DMPlexGetGhostCellStratum(plex,&cEndInterior,NULL);CHKERRQ(ierr); 3907 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 3908 if (cLocalStart > 0) { 3909 p4est_quadrant_t *ghosts = (p4est_quadrant_t*) pforest->ghost->ghosts.array; 3910 PetscInt count; 3911 3912 for (count = 0; count < cLocalStart; count++) { 3913 p4est_quadrant_t *quad = &ghosts[count]; 3914 p4est_topidx_t t = quad->p.which_tree; 3915 3916 ierr = DMPforestMapCoordinates_Cell(plex,geom,count,quad,t,pforest->topo->conn,coords);CHKERRQ(ierr); 3917 } 3918 } 3919 for (t = flt; t <= llt; t++) { 3920 p4est_tree_t *tree = &(trees[t]); 3921 PetscInt offset = cLocalStart + tree->quadrants_offset, i; 3922 PetscInt numQuads = (PetscInt) tree->quadrants.elem_count; 3923 p4est_quadrant_t *quads = (p4est_quadrant_t*) tree->quadrants.array; 3924 3925 for (i = 0; i < numQuads; i++) { 3926 PetscInt count = i + offset; 3927 3928 ierr = DMPforestMapCoordinates_Cell(plex,geom,count,&quads[i],t,pforest->topo->conn,coords);CHKERRQ(ierr); 3929 } 3930 } 3931 if (cLocalEnd - cLocalStart < cEnd - cStart) { 3932 p4est_quadrant_t *ghosts = (p4est_quadrant_t*) pforest->ghost->ghosts.array; 3933 PetscInt numGhosts = (PetscInt) pforest->ghost->ghosts.elem_count; 3934 PetscInt count; 3935 3936 for (count = 0; count < numGhosts - cLocalStart; count++) { 3937 p4est_quadrant_t *quad = &ghosts[count + cLocalStart]; 3938 p4est_topidx_t t = quad->p.which_tree; 3939 3940 ierr = DMPforestMapCoordinates_Cell(plex,geom,count + cLocalEnd,quad,t,pforest->topo->conn,coords);CHKERRQ(ierr); 3941 } 3942 } 3943 } 3944 ierr = VecRestoreArray(coordLocalVec,&coords);CHKERRQ(ierr); 3945 PetscFunctionReturn(0); 3946 } 3947 3948 static PetscErrorCode DMPforestLocalizeCoordinates(DM dm, DM plex) 3949 { 3950 DM_Forest *forest; 3951 DM_Forest_pforest *pforest; 3952 DM base; 3953 Vec coordinates, cVec; 3954 PetscSection oldSection, baseSection = NULL, newSection; 3955 const PetscScalar *coords; 3956 PetscScalar *coords2; 3957 PetscInt cLocalStart, cLocalEnd, coarsePoint; 3958 PetscInt cDim, newStart, newEnd, dof, cdof = -1; 3959 PetscInt v, vStart, vEnd, cp, cStart, cEnd, cEndInterior, *coarsePoints; 3960 PetscInt *localize, overlap; 3961 p4est_topidx_t flt, llt, t; 3962 p4est_tree_t *trees; 3963 PetscBool isper, baseLocalized = PETSC_FALSE; 3964 PetscErrorCode ierr; 3965 3966 PetscFunctionBegin; 3967 ierr = DMGetPeriodicity(dm,&isper,NULL,NULL,NULL);CHKERRQ(ierr); 3968 if (!isper) PetscFunctionReturn(0); 3969 /* we localize on all cells if we don't have a base DM or the base DM coordinates have not been localized */ 3970 ierr = DMGetCoordinateDim(dm, &cDim);CHKERRQ(ierr); 3971 cdof = P4EST_CHILDREN*cDim; 3972 ierr = DMForestGetBaseDM(dm,&base);CHKERRQ(ierr); 3973 if (base) { 3974 ierr = DMGetCoordinatesLocalized(base,&baseLocalized);CHKERRQ(ierr); 3975 } 3976 if (!baseLocalized) base = NULL; 3977 ierr = DMPlexGetChart(plex, &newStart, &newEnd);CHKERRQ(ierr); 3978 3979 ierr = DMForestGetPartitionOverlap(dm,&overlap);CHKERRQ(ierr); 3980 ierr = PetscCalloc1(overlap ? newEnd - newStart : 0,&localize);CHKERRQ(ierr); 3981 3982 ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &newSection);CHKERRQ(ierr); 3983 ierr = PetscSectionSetNumFields(newSection, 1);CHKERRQ(ierr); 3984 ierr = PetscSectionSetFieldComponents(newSection, 0, cDim);CHKERRQ(ierr); 3985 ierr = PetscSectionSetChart(newSection, newStart, newEnd);CHKERRQ(ierr); 3986 3987 ierr = DMGetCoordinateSection(plex, &oldSection);CHKERRQ(ierr); 3988 if (base) { ierr = DMGetCoordinateSection(base, &baseSection);CHKERRQ(ierr); } 3989 ierr = DMPlexGetDepthStratum(plex,0,&vStart,&vEnd);CHKERRQ(ierr); 3990 for (v = vStart; v < vEnd; ++v) { 3991 ierr = PetscSectionGetDof(oldSection, v, &dof);CHKERRQ(ierr); 3992 ierr = PetscSectionSetDof(newSection, v, dof);CHKERRQ(ierr); 3993 ierr = PetscSectionSetFieldDof(newSection, v, 0, dof);CHKERRQ(ierr); 3994 if (overlap) localize[v] = dof; 3995 } 3996 3997 forest = (DM_Forest*) dm->data; 3998 pforest = (DM_Forest_pforest*) forest->data; 3999 cLocalStart = pforest->cLocalStart; 4000 cLocalEnd = pforest->cLocalEnd; 4001 flt = pforest->forest->first_local_tree; 4002 llt = pforest->forest->last_local_tree; 4003 trees = (p4est_tree_t*) pforest->forest->trees->array; 4004 4005 cp = 0; 4006 ierr = DMPlexGetHeightStratum(plex,0,&cStart,&cEnd);CHKERRQ(ierr); 4007 ierr = DMPlexGetGhostCellStratum(plex,&cEndInterior,NULL);CHKERRQ(ierr); 4008 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 4009 ierr = PetscMalloc1(cEnd-cStart,&coarsePoints);CHKERRQ(ierr); 4010 if (cLocalStart > 0) { 4011 p4est_quadrant_t *ghosts = (p4est_quadrant_t*) pforest->ghost->ghosts.array; 4012 PetscInt count; 4013 4014 for (count = 0; count < cLocalStart; count++) { 4015 p4est_quadrant_t *quad = &ghosts[count]; 4016 coarsePoint = quad->p.which_tree; 4017 4018 if (baseSection) { ierr = PetscSectionGetFieldDof(baseSection, coarsePoint, 0, &cdof);CHKERRQ(ierr); } 4019 ierr = PetscSectionSetDof(newSection, count, cdof);CHKERRQ(ierr); 4020 ierr = PetscSectionSetFieldDof(newSection, count, 0, cdof);CHKERRQ(ierr); 4021 coarsePoints[cp++] = cdof ? coarsePoint : -1; 4022 if (overlap) localize[count] = cdof; 4023 } 4024 } 4025 for (t = flt; t <= llt; t++) { 4026 p4est_tree_t *tree = &(trees[t]); 4027 PetscInt offset = cLocalStart + tree->quadrants_offset; 4028 PetscInt numQuads = (PetscInt) tree->quadrants.elem_count; 4029 PetscInt i; 4030 4031 if (!numQuads) continue; 4032 coarsePoint = t; 4033 if (baseSection) { ierr = PetscSectionGetFieldDof(baseSection, coarsePoint, 0, &cdof);CHKERRQ(ierr); } 4034 for (i = 0; i < numQuads; i++) { 4035 PetscInt newCell = i + offset; 4036 4037 ierr = PetscSectionSetDof(newSection, newCell, cdof);CHKERRQ(ierr); 4038 ierr = PetscSectionSetFieldDof(newSection, newCell, 0, cdof);CHKERRQ(ierr); 4039 coarsePoints[cp++] = cdof ? coarsePoint : -1; 4040 if (overlap) localize[newCell] = cdof; 4041 } 4042 } 4043 if (cLocalEnd - cLocalStart < cEnd - cStart) { 4044 p4est_quadrant_t *ghosts = (p4est_quadrant_t*) pforest->ghost->ghosts.array; 4045 PetscInt numGhosts = (PetscInt) pforest->ghost->ghosts.elem_count; 4046 PetscInt count; 4047 4048 for (count = 0; count < numGhosts - cLocalStart; count++) { 4049 p4est_quadrant_t *quad = &ghosts[count + cLocalStart]; 4050 coarsePoint = quad->p.which_tree; 4051 PetscInt newCell = count + cLocalEnd; 4052 4053 if (baseSection) { ierr = PetscSectionGetFieldDof(baseSection, coarsePoint, 0, &cdof);CHKERRQ(ierr); } 4054 ierr = PetscSectionSetDof(newSection, newCell, cdof);CHKERRQ(ierr); 4055 ierr = PetscSectionSetFieldDof(newSection, newCell, 0, cdof);CHKERRQ(ierr); 4056 coarsePoints[cp++] = cdof ? coarsePoint : -1; 4057 if (overlap) localize[newCell] = cdof; 4058 } 4059 } 4060 PetscCheckFalse(cp != cEnd - cStart,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of fine cells %D != %D",cp,cEnd-cStart); 4061 4062 if (base) { /* we need to localize on all the cells in the star of the coarse cell vertices */ 4063 PetscInt *closure = NULL, closureSize; 4064 PetscInt p, i, c, vStartBase, vEndBase, cStartBase, cEndBase; 4065 4066 ierr = DMPlexGetHeightStratum(base,0,&cStartBase,&cEndBase);CHKERRQ(ierr); 4067 ierr = DMPlexGetDepthStratum(base,0,&vStartBase,&vEndBase);CHKERRQ(ierr); 4068 for (p = cStart; p < cEnd; p++) { 4069 coarsePoint = coarsePoints[p-cStart]; 4070 if (coarsePoint < 0) continue; 4071 if (baseSection) { ierr = PetscSectionGetFieldDof(baseSection, coarsePoint, 0, &cdof);CHKERRQ(ierr); } 4072 ierr = DMPlexGetTransitiveClosure(base,coarsePoint,PETSC_TRUE,&closureSize,&closure);CHKERRQ(ierr); 4073 for (c = 0; c < closureSize; c++) { 4074 PetscInt *star = NULL, starSize; 4075 PetscInt j, v = closure[2 * c]; 4076 4077 if (v < vStartBase || v > vEndBase) continue; 4078 ierr = DMPlexGetTransitiveClosure(base,v,PETSC_FALSE,&starSize,&star);CHKERRQ(ierr); 4079 for (j = 0; j < starSize; j++) { 4080 PetscInt cell = star[2 * j]; 4081 4082 if (cStartBase <= cell && cell < cEndBase) { 4083 p4est_tree_t *tree; 4084 PetscInt offset,numQuads; 4085 4086 if (cell < flt || cell > llt) continue; 4087 tree = &(trees[cell]); 4088 offset = cLocalStart + tree->quadrants_offset; 4089 numQuads = (PetscInt) tree->quadrants.elem_count; 4090 for (i = 0; i < numQuads; i++) { 4091 PetscInt newCell = i + offset; 4092 4093 ierr = PetscSectionSetDof(newSection, newCell, cdof);CHKERRQ(ierr); 4094 ierr = PetscSectionSetFieldDof(newSection, newCell, 0, cdof);CHKERRQ(ierr); 4095 if (overlap) localize[newCell] = cdof; 4096 } 4097 } 4098 } 4099 ierr = DMPlexRestoreTransitiveClosure(base,v,PETSC_FALSE,&starSize,&star);CHKERRQ(ierr); 4100 } 4101 ierr = DMPlexRestoreTransitiveClosure(base,coarsePoint,PETSC_TRUE,&closureSize,&closure);CHKERRQ(ierr); 4102 } 4103 } 4104 ierr = PetscFree(coarsePoints);CHKERRQ(ierr); 4105 4106 /* final consensus with overlap */ 4107 if (overlap) { 4108 PetscSF sf; 4109 PetscInt *localizeGlobal; 4110 4111 ierr = DMGetPointSF(plex,&sf);CHKERRQ(ierr); 4112 ierr = PetscMalloc1(newEnd-newStart,&localizeGlobal);CHKERRQ(ierr); 4113 for (v = newStart; v < newEnd; v++) localizeGlobal[v - newStart] = localize[v - newStart]; 4114 ierr = PetscSFBcastBegin(sf,MPIU_INT,localize,localizeGlobal,MPI_REPLACE);CHKERRQ(ierr); 4115 ierr = PetscSFBcastEnd(sf,MPIU_INT,localize,localizeGlobal,MPI_REPLACE);CHKERRQ(ierr); 4116 for (v = newStart; v < newEnd; v++) { 4117 ierr = PetscSectionSetDof(newSection, v, localizeGlobal[v-newStart]);CHKERRQ(ierr); 4118 ierr = PetscSectionSetFieldDof(newSection, v, 0, localizeGlobal[v-newStart]);CHKERRQ(ierr); 4119 } 4120 ierr = PetscFree(localizeGlobal);CHKERRQ(ierr); 4121 } 4122 ierr = PetscFree(localize);CHKERRQ(ierr); 4123 ierr = PetscSectionSetUp(newSection);CHKERRQ(ierr); 4124 ierr = PetscObjectReference((PetscObject)oldSection);CHKERRQ(ierr); 4125 ierr = DMSetCoordinateSection(plex, cDim, newSection);CHKERRQ(ierr); 4126 ierr = PetscSectionGetStorageSize(newSection, &v);CHKERRQ(ierr); 4127 ierr = VecCreate(PETSC_COMM_SELF, &cVec);CHKERRQ(ierr); 4128 ierr = PetscObjectSetName((PetscObject)cVec,"coordinates");CHKERRQ(ierr); 4129 ierr = VecSetBlockSize(cVec, cDim);CHKERRQ(ierr); 4130 ierr = VecSetSizes(cVec, v, PETSC_DETERMINE);CHKERRQ(ierr); 4131 ierr = VecSetType(cVec, VECSTANDARD);CHKERRQ(ierr); 4132 ierr = VecSet(cVec, PETSC_MIN_REAL);CHKERRQ(ierr); 4133 4134 /* Copy over vertex coordinates */ 4135 ierr = DMGetCoordinatesLocal(plex, &coordinates);CHKERRQ(ierr); 4136 PetscCheckFalse(!coordinates,PetscObjectComm((PetscObject)plex),PETSC_ERR_SUP,"Missing local coordinates vector"); 4137 ierr = VecGetArray(cVec, &coords2);CHKERRQ(ierr); 4138 ierr = VecGetArrayRead(coordinates, &coords);CHKERRQ(ierr); 4139 for (v = vStart; v < vEnd; ++v) { 4140 PetscInt d, off,off2; 4141 4142 ierr = PetscSectionGetDof(oldSection, v, &dof);CHKERRQ(ierr); 4143 ierr = PetscSectionGetOffset(oldSection, v, &off);CHKERRQ(ierr); 4144 ierr = PetscSectionGetOffset(newSection, v, &off2);CHKERRQ(ierr); 4145 for (d = 0; d < dof; ++d) coords2[off2+d] = coords[off+d]; 4146 } 4147 ierr = VecRestoreArrayRead(coordinates, &coords);CHKERRQ(ierr); 4148 4149 /* Localize coordinates on cells if needed */ 4150 for (t = flt; t <= llt; t++) { 4151 p4est_tree_t *tree = &(trees[t]); 4152 const double *v = pforest->topo->conn->vertices; 4153 p4est_quadrant_t *quads = (p4est_quadrant_t*) tree->quadrants.array; 4154 PetscInt offset = cLocalStart + tree->quadrants_offset; 4155 PetscInt numQuads = (PetscInt) tree->quadrants.elem_count; 4156 p4est_topidx_t vt[8] = {0,0,0,0,0,0,0,0}; 4157 PetscInt i,k; 4158 4159 if (!numQuads) continue; 4160 for (k = 0; k < P4EST_CHILDREN; ++k) { 4161 vt[k] = pforest->topo->conn->tree_to_vertex[t * P4EST_CHILDREN + k]; 4162 } 4163 4164 for (i = 0; i < numQuads; i++) { 4165 p4est_quadrant_t *quad = &quads[i]; 4166 const PetscReal intsize = 1.0 / P4EST_ROOT_LEN; 4167 PetscReal h2; 4168 PetscScalar xyz[3]; 4169 #ifdef P4_TO_P8 4170 PetscInt zi; 4171 #endif 4172 PetscInt yi,xi; 4173 PetscInt off2; 4174 PetscInt newCell = i + offset; 4175 4176 ierr = PetscSectionGetFieldDof(newSection, newCell, 0, &cdof);CHKERRQ(ierr); 4177 if (!cdof) continue; 4178 4179 h2 = .5 * intsize * P4EST_QUADRANT_LEN (quad->level); 4180 k = 0; 4181 ierr = PetscSectionGetOffset(newSection, newCell, &off2);CHKERRQ(ierr); 4182 #ifdef P4_TO_P8 4183 for (zi = 0; zi < 2; ++zi) { 4184 const PetscReal eta_z = intsize * quad->z + h2 * (1. + (zi * 2 - 1)); 4185 #else 4186 { 4187 const PetscReal eta_z = 0.0; 4188 #endif 4189 for (yi = 0; yi < 2; ++yi) { 4190 const PetscReal eta_y = intsize * quad->y + h2 * (1. + (yi * 2 - 1)); 4191 for (xi = 0; xi < 2; ++xi) { 4192 const PetscReal eta_x = intsize * quad->x + h2 * (1. + (xi * 2 - 1)); 4193 PetscInt j; 4194 4195 for (j = 0; j < 3; ++j) { 4196 xyz[j] = ((1. - eta_z) * ((1. - eta_y) * ((1. - eta_x) * v[3 * vt[0] + j] + 4197 eta_x * v[3 * vt[1] + j]) + 4198 eta_y * ((1. - eta_x) * v[3 * vt[2] + j] + 4199 eta_x * v[3 * vt[3] + j])) 4200 + eta_z * ((1. - eta_y) * ((1. - eta_x) * v[3 * vt[4] + j] + 4201 eta_x * v[3 * vt[5] + j]) + 4202 eta_y * ((1. - eta_x) * v[3 * vt[6] + j] + 4203 eta_x * v[3 * vt[7] + j]))); 4204 } 4205 for (j = 0; j < cDim; ++j) coords2[off2 + cDim*P4estVertToPetscVert[k] + j] = xyz[j]; 4206 ++k; 4207 } 4208 } 4209 } 4210 } 4211 } 4212 ierr = VecRestoreArray(cVec, &coords2);CHKERRQ(ierr); 4213 ierr = DMSetCoordinatesLocal(plex, cVec);CHKERRQ(ierr); 4214 ierr = VecDestroy(&cVec);CHKERRQ(ierr); 4215 ierr = PetscSectionDestroy(&newSection);CHKERRQ(ierr); 4216 ierr = PetscSectionDestroy(&oldSection);CHKERRQ(ierr); 4217 PetscFunctionReturn(0); 4218 } 4219 4220 #define DMForestClearAdaptivityForest_pforest _append_pforest(DMForestClearAdaptivityForest) 4221 static PetscErrorCode DMForestClearAdaptivityForest_pforest(DM dm) 4222 { 4223 DM_Forest *forest; 4224 DM_Forest_pforest *pforest; 4225 PetscErrorCode ierr; 4226 4227 PetscFunctionBegin; 4228 forest = (DM_Forest*) dm->data; 4229 pforest = (DM_Forest_pforest *) forest->data; 4230 ierr = PetscSFDestroy(&(pforest->pointAdaptToSelfSF));CHKERRQ(ierr); 4231 ierr = PetscSFDestroy(&(pforest->pointSelfToAdaptSF));CHKERRQ(ierr); 4232 ierr = PetscFree(pforest->pointAdaptToSelfCids);CHKERRQ(ierr); 4233 ierr = PetscFree(pforest->pointSelfToAdaptCids);CHKERRQ(ierr); 4234 PetscFunctionReturn(0); 4235 } 4236 4237 static PetscErrorCode DMConvert_pforest_plex(DM dm, DMType newtype, DM *plex) 4238 { 4239 DM_Forest *forest; 4240 DM_Forest_pforest *pforest; 4241 DM refTree, newPlex, base; 4242 PetscInt adjDim, adjCodim, coordDim; 4243 MPI_Comm comm; 4244 PetscBool isPforest; 4245 PetscInt dim; 4246 PetscInt overlap; 4247 p4est_connect_type_t ctype; 4248 p4est_locidx_t first_local_quad = -1; 4249 sc_array_t *points_per_dim, *cone_sizes, *cones, *cone_orientations, *coords, *children, *parents, *childids, *leaves, *remotes; 4250 PetscSection parentSection; 4251 PetscSF pointSF; 4252 size_t zz, count; 4253 PetscInt pStart, pEnd; 4254 DMLabel ghostLabelBase = NULL; 4255 PetscErrorCode ierr; 4256 4257 PetscFunctionBegin; 4258 4259 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 4260 comm = PetscObjectComm((PetscObject)dm); 4261 ierr = PetscObjectTypeCompare((PetscObject)dm,DMPFOREST,&isPforest);CHKERRQ(ierr); 4262 PetscCheckFalse(!isPforest,comm,PETSC_ERR_ARG_WRONG,"Expected DM type %s, got %s",DMPFOREST,((PetscObject)dm)->type_name); 4263 ierr = DMGetDimension(dm,&dim);CHKERRQ(ierr); 4264 PetscCheckFalse(dim != P4EST_DIM,comm,PETSC_ERR_ARG_WRONG,"Expected DM dimension %d, got %d",P4EST_DIM,dim); 4265 forest = (DM_Forest*) dm->data; 4266 pforest = (DM_Forest_pforest*) forest->data; 4267 ierr = DMForestGetBaseDM(dm,&base);CHKERRQ(ierr); 4268 if (base) { 4269 ierr = DMGetLabel(base,"ghost",&ghostLabelBase);CHKERRQ(ierr); 4270 } 4271 if (!pforest->plex) { 4272 PetscMPIInt size; 4273 4274 ierr = MPI_Comm_size(comm,&size);CHKERRMPI(ierr); 4275 ierr = DMCreate(comm,&newPlex);CHKERRQ(ierr); 4276 ierr = DMSetType(newPlex,DMPLEX);CHKERRQ(ierr); 4277 ierr = DMSetMatType(newPlex,dm->mattype);CHKERRQ(ierr); 4278 /* share labels */ 4279 ierr = DMCopyLabels(dm, newPlex, PETSC_OWN_POINTER, PETSC_TRUE, DM_COPY_LABELS_FAIL);CHKERRQ(ierr); 4280 ierr = DMForestGetAdjacencyDimension(dm,&adjDim);CHKERRQ(ierr); 4281 ierr = DMForestGetAdjacencyCodimension(dm,&adjCodim);CHKERRQ(ierr); 4282 ierr = DMGetCoordinateDim(dm,&coordDim);CHKERRQ(ierr); 4283 if (adjDim == 0) { 4284 ctype = P4EST_CONNECT_FULL; 4285 } else if (adjCodim == 1) { 4286 ctype = P4EST_CONNECT_FACE; 4287 #if defined(P4_TO_P8) 4288 } else if (adjDim == 1) { 4289 ctype = P8EST_CONNECT_EDGE; 4290 #endif 4291 } else { 4292 SETERRQ(PetscObjectComm((PetscObject)dm),PETSC_ERR_ARG_WRONG,"Invalid adjacency dimension %d",adjDim); 4293 } 4294 PetscCheckFalse(ctype != P4EST_CONNECT_FULL,PetscObjectComm((PetscObject)dm),PETSC_ERR_ARG_WRONG,"Adjacency dimension %D / codimension %D not supported yet",adjDim,adjCodim); 4295 ierr = DMForestGetPartitionOverlap(dm,&overlap);CHKERRQ(ierr); 4296 ((DM_Plex *) newPlex->data)->overlap = overlap; 4297 4298 points_per_dim = sc_array_new(sizeof(p4est_locidx_t)); 4299 cone_sizes = sc_array_new(sizeof(p4est_locidx_t)); 4300 cones = sc_array_new(sizeof(p4est_locidx_t)); 4301 cone_orientations = sc_array_new(sizeof(p4est_locidx_t)); 4302 coords = sc_array_new(3 * sizeof(double)); 4303 children = sc_array_new(sizeof(p4est_locidx_t)); 4304 parents = sc_array_new(sizeof(p4est_locidx_t)); 4305 childids = sc_array_new(sizeof(p4est_locidx_t)); 4306 leaves = sc_array_new(sizeof(p4est_locidx_t)); 4307 remotes = sc_array_new(2 * sizeof(p4est_locidx_t)); 4308 4309 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)); 4310 4311 pforest->cLocalStart = (PetscInt) first_local_quad; 4312 pforest->cLocalEnd = pforest->cLocalStart + (PetscInt) pforest->forest->local_num_quadrants; 4313 ierr = locidx_to_PetscInt(points_per_dim);CHKERRQ(ierr); 4314 ierr = locidx_to_PetscInt(cone_sizes);CHKERRQ(ierr); 4315 ierr = locidx_to_PetscInt(cones);CHKERRQ(ierr); 4316 ierr = locidx_to_PetscInt(cone_orientations);CHKERRQ(ierr); 4317 ierr = coords_double_to_PetscScalar(coords, coordDim);CHKERRQ(ierr); 4318 ierr = locidx_to_PetscInt(children);CHKERRQ(ierr); 4319 ierr = locidx_to_PetscInt(parents);CHKERRQ(ierr); 4320 ierr = locidx_to_PetscInt(childids);CHKERRQ(ierr); 4321 ierr = locidx_to_PetscInt(leaves);CHKERRQ(ierr); 4322 ierr = locidx_pair_to_PetscSFNode(remotes);CHKERRQ(ierr); 4323 4324 ierr = DMSetDimension(newPlex,P4EST_DIM);CHKERRQ(ierr); 4325 ierr = DMSetCoordinateDim(newPlex,coordDim);CHKERRQ(ierr); 4326 ierr = DMPlexSetMaxProjectionHeight(newPlex,P4EST_DIM - 1);CHKERRQ(ierr); 4327 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); 4328 ierr = DMPlexConvertOldOrientations_Internal(newPlex);CHKERRQ(ierr); 4329 ierr = DMCreateReferenceTree_pforest(comm,&refTree);CHKERRQ(ierr); 4330 ierr = DMPlexSetReferenceTree(newPlex,refTree);CHKERRQ(ierr); 4331 ierr = PetscSectionCreate(comm,&parentSection);CHKERRQ(ierr); 4332 ierr = DMPlexGetChart(newPlex,&pStart,&pEnd);CHKERRQ(ierr); 4333 ierr = PetscSectionSetChart(parentSection,pStart,pEnd);CHKERRQ(ierr); 4334 count = children->elem_count; 4335 for (zz = 0; zz < count; zz++) { 4336 PetscInt child = *((PetscInt*) sc_array_index(children,zz)); 4337 4338 ierr = PetscSectionSetDof(parentSection,child,1);CHKERRQ(ierr); 4339 } 4340 ierr = PetscSectionSetUp(parentSection);CHKERRQ(ierr); 4341 ierr = DMPlexSetTree(newPlex,parentSection,(PetscInt*)parents->array,(PetscInt*)childids->array);CHKERRQ(ierr); 4342 ierr = PetscSectionDestroy(&parentSection);CHKERRQ(ierr); 4343 ierr = PetscSFCreate(comm,&pointSF);CHKERRQ(ierr); 4344 /* 4345 These arrays defining the sf are from the p4est library, but the code there shows the leaves being populated in increasing order. 4346 https://gitlab.com/petsc/petsc/merge_requests/2248#note_240186391 4347 */ 4348 ierr = PetscSFSetGraph(pointSF,pEnd - pStart,(PetscInt)leaves->elem_count,(PetscInt*)leaves->array,PETSC_COPY_VALUES,(PetscSFNode*)remotes->array,PETSC_COPY_VALUES);CHKERRQ(ierr); 4349 ierr = DMSetPointSF(newPlex,pointSF);CHKERRQ(ierr); 4350 ierr = DMSetPointSF(dm,pointSF);CHKERRQ(ierr); 4351 { 4352 DM coordDM; 4353 4354 ierr = DMGetCoordinateDM(newPlex,&coordDM);CHKERRQ(ierr); 4355 ierr = DMSetPointSF(coordDM,pointSF);CHKERRQ(ierr); 4356 } 4357 ierr = PetscSFDestroy(&pointSF);CHKERRQ(ierr); 4358 sc_array_destroy (points_per_dim); 4359 sc_array_destroy (cone_sizes); 4360 sc_array_destroy (cones); 4361 sc_array_destroy (cone_orientations); 4362 sc_array_destroy (coords); 4363 sc_array_destroy (children); 4364 sc_array_destroy (parents); 4365 sc_array_destroy (childids); 4366 sc_array_destroy (leaves); 4367 sc_array_destroy (remotes); 4368 4369 { 4370 PetscBool isper; 4371 const PetscReal *maxCell, *L; 4372 const DMBoundaryType *bd; 4373 4374 ierr = DMGetPeriodicity(dm,&isper,&maxCell,&L,&bd);CHKERRQ(ierr); 4375 ierr = DMSetPeriodicity(newPlex,isper,maxCell,L,bd);CHKERRQ(ierr); 4376 ierr = DMPforestLocalizeCoordinates(dm,newPlex);CHKERRQ(ierr); 4377 } 4378 4379 if (overlap > 0) { /* the p4est routine can't set all of the coordinates in its routine if there is overlap */ 4380 Vec coordsGlobal, coordsLocal; 4381 const PetscScalar *globalArray; 4382 PetscScalar *localArray; 4383 PetscSF coordSF; 4384 DM coordDM; 4385 4386 ierr = DMGetCoordinateDM(newPlex,&coordDM);CHKERRQ(ierr); 4387 ierr = DMGetSectionSF(coordDM,&coordSF);CHKERRQ(ierr); 4388 ierr = DMGetCoordinates(newPlex, &coordsGlobal);CHKERRQ(ierr); 4389 ierr = DMGetCoordinatesLocal(newPlex, &coordsLocal);CHKERRQ(ierr); 4390 ierr = VecGetArrayRead(coordsGlobal, &globalArray);CHKERRQ(ierr); 4391 ierr = VecGetArray(coordsLocal, &localArray);CHKERRQ(ierr); 4392 ierr = PetscSFBcastBegin(coordSF,MPIU_SCALAR,globalArray,localArray,MPI_REPLACE);CHKERRQ(ierr); 4393 ierr = PetscSFBcastEnd(coordSF,MPIU_SCALAR,globalArray,localArray,MPI_REPLACE);CHKERRQ(ierr); 4394 ierr = VecRestoreArray(coordsLocal, &localArray);CHKERRQ(ierr); 4395 ierr = VecRestoreArrayRead(coordsGlobal, &globalArray);CHKERRQ(ierr); 4396 ierr = DMSetCoordinatesLocal(newPlex, coordsLocal);CHKERRQ(ierr); 4397 } 4398 ierr = DMPforestMapCoordinates(dm,newPlex);CHKERRQ(ierr); 4399 4400 pforest->plex = newPlex; 4401 4402 /* copy labels */ 4403 ierr = DMPforestLabelsFinalize(dm,newPlex);CHKERRQ(ierr); 4404 4405 if (ghostLabelBase || pforest->ghostName) { /* we have to do this after copying labels because the labels drive the construction of ghost cells */ 4406 PetscInt numAdded; 4407 DM newPlexGhosted; 4408 void *ctx; 4409 4410 ierr = DMPlexConstructGhostCells(newPlex,pforest->ghostName,&numAdded,&newPlexGhosted);CHKERRQ(ierr); 4411 ierr = DMGetApplicationContext(newPlex,&ctx);CHKERRQ(ierr); 4412 ierr = DMSetApplicationContext(newPlexGhosted,ctx);CHKERRQ(ierr); 4413 /* we want the sf for the ghost dm to be the one for the p4est dm as well */ 4414 ierr = DMGetPointSF(newPlexGhosted,&pointSF);CHKERRQ(ierr); 4415 ierr = DMSetPointSF(dm,pointSF);CHKERRQ(ierr); 4416 ierr = DMDestroy(&newPlex);CHKERRQ(ierr); 4417 ierr = DMPlexSetReferenceTree(newPlexGhosted,refTree);CHKERRQ(ierr); 4418 ierr = DMForestClearAdaptivityForest_pforest(dm);CHKERRQ(ierr); 4419 newPlex = newPlexGhosted; 4420 4421 /* share the labels back */ 4422 ierr = DMDestroyLabelLinkList_Internal(dm);CHKERRQ(ierr); 4423 ierr = DMCopyLabels(newPlex, dm, PETSC_OWN_POINTER, PETSC_TRUE, DM_COPY_LABELS_FAIL);CHKERRQ(ierr); 4424 pforest->plex = newPlex; 4425 } 4426 ierr = DMDestroy(&refTree);CHKERRQ(ierr); 4427 if (dm->setfromoptionscalled) { 4428 ierr = PetscObjectOptionsBegin((PetscObject)newPlex);CHKERRQ(ierr); 4429 ierr = DMSetFromOptions_NonRefinement_Plex(PetscOptionsObject,newPlex);CHKERRQ(ierr); 4430 ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) newPlex);CHKERRQ(ierr); 4431 ierr = PetscOptionsEnd();CHKERRQ(ierr); 4432 } 4433 ierr = DMViewFromOptions(newPlex,NULL,"-dm_p4est_plex_view");CHKERRQ(ierr); 4434 { 4435 PetscSection coordsSec; 4436 Vec coords; 4437 PetscInt cDim; 4438 4439 ierr = DMGetCoordinateDim(newPlex,&cDim);CHKERRQ(ierr); 4440 ierr = DMGetCoordinateSection(newPlex,&coordsSec);CHKERRQ(ierr); 4441 ierr = DMSetCoordinateSection(dm,cDim,coordsSec);CHKERRQ(ierr); 4442 ierr = DMGetCoordinatesLocal(newPlex,&coords);CHKERRQ(ierr); 4443 ierr = DMSetCoordinatesLocal(dm,coords);CHKERRQ(ierr); 4444 } 4445 } 4446 newPlex = pforest->plex; 4447 if (plex) { 4448 DM coordDM; 4449 4450 ierr = DMClone(newPlex,plex);CHKERRQ(ierr); 4451 ierr = DMGetCoordinateDM(newPlex,&coordDM);CHKERRQ(ierr); 4452 ierr = DMSetCoordinateDM(*plex,coordDM);CHKERRQ(ierr); 4453 ierr = DMShareDiscretization(dm,*plex);CHKERRQ(ierr); 4454 } 4455 PetscFunctionReturn(0); 4456 } 4457 4458 static PetscErrorCode DMSetFromOptions_pforest(PetscOptionItems *PetscOptionsObject,DM dm) 4459 { 4460 DM_Forest_pforest *pforest = (DM_Forest_pforest*) ((DM_Forest*) dm->data)->data; 4461 char stringBuffer[256]; 4462 PetscBool flg; 4463 PetscErrorCode ierr; 4464 4465 PetscFunctionBegin; 4466 ierr = DMSetFromOptions_Forest(PetscOptionsObject,dm);CHKERRQ(ierr); 4467 ierr = PetscOptionsHead(PetscOptionsObject,"DM" P4EST_STRING " options");CHKERRQ(ierr); 4468 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); 4469 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); 4470 ierr = PetscOptionsTail();CHKERRQ(ierr); 4471 if (flg) { 4472 ierr = PetscFree(pforest->ghostName);CHKERRQ(ierr); 4473 ierr = PetscStrallocpy(stringBuffer,&pforest->ghostName);CHKERRQ(ierr); 4474 } 4475 PetscFunctionReturn(0); 4476 } 4477 4478 #if !defined(P4_TO_P8) 4479 #define DMPforestGetPartitionForCoarsening DMP4estGetPartitionForCoarsening 4480 #define DMPforestSetPartitionForCoarsening DMP4estSetPartitionForCoarsening 4481 #else 4482 #define DMPforestGetPartitionForCoarsening DMP8estGetPartitionForCoarsening 4483 #define DMPforestSetPartitionForCoarsening DMP8estSetPartitionForCoarsening 4484 #endif 4485 4486 PETSC_EXTERN PetscErrorCode DMPforestGetPartitionForCoarsening(DM dm, PetscBool *flg) 4487 { 4488 DM_Forest_pforest *pforest; 4489 4490 PetscFunctionBegin; 4491 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 4492 pforest = (DM_Forest_pforest*) ((DM_Forest*) dm->data)->data; 4493 *flg = pforest->partition_for_coarsening; 4494 PetscFunctionReturn(0); 4495 } 4496 4497 PETSC_EXTERN PetscErrorCode DMPforestSetPartitionForCoarsening(DM dm, PetscBool flg) 4498 { 4499 DM_Forest_pforest *pforest; 4500 4501 PetscFunctionBegin; 4502 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 4503 pforest = (DM_Forest_pforest*) ((DM_Forest*) dm->data)->data; 4504 pforest->partition_for_coarsening = flg; 4505 PetscFunctionReturn(0); 4506 } 4507 4508 static PetscErrorCode DMPforestGetPlex(DM dm,DM *plex) 4509 { 4510 DM_Forest_pforest *pforest; 4511 PetscErrorCode ierr; 4512 4513 PetscFunctionBegin; 4514 if (plex) *plex = NULL; 4515 ierr = DMSetUp(dm);CHKERRQ(ierr); 4516 pforest = (DM_Forest_pforest*) ((DM_Forest*) dm->data)->data; 4517 if (!pforest->plex) { 4518 ierr = DMConvert_pforest_plex(dm,DMPLEX,NULL);CHKERRQ(ierr); 4519 } 4520 ierr = DMShareDiscretization(dm,pforest->plex);CHKERRQ(ierr); 4521 if (plex) *plex = pforest->plex; 4522 PetscFunctionReturn(0); 4523 } 4524 4525 #define DMCreateInterpolation_pforest _append_pforest(DMCreateInterpolation) 4526 static PetscErrorCode DMCreateInterpolation_pforest(DM dmCoarse, DM dmFine, Mat *interpolation, Vec *scaling) 4527 { 4528 PetscSection gsc, gsf; 4529 PetscInt m, n; 4530 DM cdm; 4531 PetscErrorCode ierr; 4532 4533 PetscFunctionBegin; 4534 ierr = DMGetGlobalSection(dmFine, &gsf);CHKERRQ(ierr); 4535 ierr = PetscSectionGetConstrainedStorageSize(gsf, &m);CHKERRQ(ierr); 4536 ierr = DMGetGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr); 4537 ierr = PetscSectionGetConstrainedStorageSize(gsc, &n);CHKERRQ(ierr); 4538 4539 ierr = MatCreate(PetscObjectComm((PetscObject) dmFine), interpolation);CHKERRQ(ierr); 4540 ierr = MatSetSizes(*interpolation, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr); 4541 ierr = MatSetType(*interpolation, MATAIJ);CHKERRQ(ierr); 4542 4543 ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr); 4544 PetscCheckFalse(cdm != dmCoarse,PetscObjectComm((PetscObject)dmFine),PETSC_ERR_SUP,"Only interpolation from coarse DM for now"); 4545 4546 { 4547 DM plexF, plexC; 4548 PetscSF sf; 4549 PetscInt *cids; 4550 PetscInt dofPerDim[4] = {1,1,1,1}; 4551 4552 ierr = DMPforestGetPlex(dmCoarse,&plexC);CHKERRQ(ierr); 4553 ierr = DMPforestGetPlex(dmFine,&plexF);CHKERRQ(ierr); 4554 ierr = DMPforestGetTransferSF_Internal(dmCoarse, dmFine, dofPerDim, &sf, PETSC_TRUE, &cids);CHKERRQ(ierr); 4555 ierr = PetscSFSetUp(sf);CHKERRQ(ierr); 4556 ierr = DMPlexComputeInterpolatorTree(plexC, plexF, sf, cids, *interpolation);CHKERRQ(ierr); 4557 ierr = PetscSFDestroy(&sf);CHKERRQ(ierr); 4558 ierr = PetscFree(cids);CHKERRQ(ierr); 4559 } 4560 ierr = MatViewFromOptions(*interpolation, NULL, "-interp_mat_view");CHKERRQ(ierr); 4561 /* Use naive scaling */ 4562 ierr = DMCreateInterpolationScale(dmCoarse, dmFine, *interpolation, scaling);CHKERRQ(ierr); 4563 PetscFunctionReturn(0); 4564 } 4565 4566 #define DMCreateInjection_pforest _append_pforest(DMCreateInjection) 4567 static PetscErrorCode DMCreateInjection_pforest(DM dmCoarse, DM dmFine, Mat *injection) 4568 { 4569 PetscSection gsc, gsf; 4570 PetscInt m, n; 4571 DM cdm; 4572 PetscErrorCode ierr; 4573 4574 PetscFunctionBegin; 4575 ierr = DMGetGlobalSection(dmFine, &gsf);CHKERRQ(ierr); 4576 ierr = PetscSectionGetConstrainedStorageSize(gsf, &n);CHKERRQ(ierr); 4577 ierr = DMGetGlobalSection(dmCoarse, &gsc);CHKERRQ(ierr); 4578 ierr = PetscSectionGetConstrainedStorageSize(gsc, &m);CHKERRQ(ierr); 4579 4580 ierr = MatCreate(PetscObjectComm((PetscObject) dmFine), injection);CHKERRQ(ierr); 4581 ierr = MatSetSizes(*injection, m, n, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr); 4582 ierr = MatSetType(*injection, MATAIJ);CHKERRQ(ierr); 4583 4584 ierr = DMGetCoarseDM(dmFine, &cdm);CHKERRQ(ierr); 4585 PetscCheckFalse(cdm != dmCoarse,PetscObjectComm((PetscObject)dmFine),PETSC_ERR_SUP,"Only injection to coarse DM for now"); 4586 4587 { 4588 DM plexF, plexC; 4589 PetscSF sf; 4590 PetscInt *cids; 4591 PetscInt dofPerDim[4] = {1,1,1,1}; 4592 4593 ierr = DMPforestGetPlex(dmCoarse,&plexC);CHKERRQ(ierr); 4594 ierr = DMPforestGetPlex(dmFine,&plexF);CHKERRQ(ierr); 4595 ierr = DMPforestGetTransferSF_Internal(dmCoarse, dmFine, dofPerDim, &sf, PETSC_TRUE, &cids);CHKERRQ(ierr); 4596 ierr = PetscSFSetUp(sf);CHKERRQ(ierr); 4597 ierr = DMPlexComputeInjectorTree(plexC, plexF, sf, cids, *injection);CHKERRQ(ierr); 4598 ierr = PetscSFDestroy(&sf);CHKERRQ(ierr); 4599 ierr = PetscFree(cids);CHKERRQ(ierr); 4600 } 4601 ierr = MatViewFromOptions(*injection, NULL, "-inject_mat_view");CHKERRQ(ierr); 4602 /* Use naive scaling */ 4603 PetscFunctionReturn(0); 4604 } 4605 4606 #define DMForestTransferVecFromBase_pforest _append_pforest(DMForestTransferVecFromBase) 4607 static PetscErrorCode DMForestTransferVecFromBase_pforest(DM dm, Vec vecIn, Vec vecOut) 4608 { 4609 DM dmIn, dmVecIn, base, basec, plex, coarseDM; 4610 DM *hierarchy; 4611 PetscSF sfRed = NULL; 4612 PetscDS ds; 4613 Vec vecInLocal, vecOutLocal; 4614 DMLabel subpointMap; 4615 PetscInt minLevel, mh, n_hi, i; 4616 PetscBool hiforest, *hierarchy_forest; 4617 PetscErrorCode ierr; 4618 4619 PetscFunctionBegin; 4620 ierr = VecGetDM(vecIn,&dmVecIn);CHKERRQ(ierr); 4621 ierr = DMGetDS(dmVecIn,&ds);CHKERRQ(ierr); 4622 PetscCheckFalse(!ds,PetscObjectComm((PetscObject)dmVecIn),PETSC_ERR_SUP,"Cannot transfer without a PetscDS object"); 4623 { /* we cannot stick user contexts into function callbacks for DMProjectFieldLocal! */ 4624 PetscSection section; 4625 PetscInt Nf; 4626 4627 ierr = DMGetLocalSection(dmVecIn,§ion);CHKERRQ(ierr); 4628 ierr = PetscSectionGetNumFields(section,&Nf);CHKERRQ(ierr); 4629 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); 4630 } 4631 ierr = DMForestGetMinimumRefinement(dm,&minLevel);CHKERRQ(ierr); 4632 PetscCheckFalse(minLevel,PetscObjectComm((PetscObject)dm),PETSC_ERR_SUP,"Cannot transfer with minimum refinement set to %D. Rerun with DMForestSetMinimumRefinement(dm,0)",minLevel); 4633 ierr = DMForestGetBaseDM(dm,&base);CHKERRQ(ierr); 4634 PetscCheckFalse(!base,PetscObjectComm((PetscObject)dm),PETSC_ERR_SUP,"Missing base DM"); 4635 4636 ierr = VecSet(vecOut,0.0);CHKERRQ(ierr); 4637 if (dmVecIn == base) { /* sequential runs */ 4638 ierr = PetscObjectReference((PetscObject)vecIn);CHKERRQ(ierr); 4639 } else { 4640 PetscSection secIn, secInRed; 4641 Vec vecInRed, vecInLocal; 4642 4643 ierr = PetscObjectQuery((PetscObject)base,"_base_migration_sf",(PetscObject*)&sfRed);CHKERRQ(ierr); 4644 PetscCheckFalse(!sfRed,PETSC_COMM_SELF,PETSC_ERR_SUP,"Not the DM set with DMForestSetBaseDM()"); 4645 ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dmVecIn),&secInRed);CHKERRQ(ierr); 4646 ierr = VecCreate(PETSC_COMM_SELF,&vecInRed);CHKERRQ(ierr); 4647 ierr = DMGetLocalSection(dmVecIn,&secIn);CHKERRQ(ierr); 4648 ierr = DMGetLocalVector(dmVecIn,&vecInLocal);CHKERRQ(ierr); 4649 ierr = DMGlobalToLocalBegin(dmVecIn,vecIn,INSERT_VALUES,vecInLocal);CHKERRQ(ierr); 4650 ierr = DMGlobalToLocalEnd(dmVecIn,vecIn,INSERT_VALUES,vecInLocal);CHKERRQ(ierr); 4651 ierr = DMPlexDistributeField(dmVecIn,sfRed,secIn,vecInLocal,secInRed,vecInRed);CHKERRQ(ierr); 4652 ierr = DMRestoreLocalVector(dmVecIn,&vecInLocal);CHKERRQ(ierr); 4653 ierr = PetscSectionDestroy(&secInRed);CHKERRQ(ierr); 4654 vecIn = vecInRed; 4655 } 4656 4657 /* we first search through the AdaptivityForest hierarchy 4658 once we found the first disconnected forest, we upsweep the DM hierarchy */ 4659 hiforest = PETSC_TRUE; 4660 4661 /* upsweep to the coarsest DM */ 4662 n_hi = 0; 4663 coarseDM = dm; 4664 do { 4665 PetscBool isforest; 4666 4667 dmIn = coarseDM; 4668 /* need to call DMSetUp to have the hierarchy recursively setup */ 4669 ierr = DMSetUp(dmIn);CHKERRQ(ierr); 4670 ierr = DMIsForest(dmIn,&isforest);CHKERRQ(ierr); 4671 PetscCheckFalse(!isforest,PetscObjectComm((PetscObject)dmIn),PETSC_ERR_SUP,"Cannot currently transfer through a mixed hierarchy! Found DM type %s",((PetscObject)dmIn)->type_name); 4672 coarseDM = NULL; 4673 if (hiforest) { 4674 ierr = DMForestGetAdaptivityForest(dmIn,&coarseDM);CHKERRQ(ierr); 4675 } 4676 if (!coarseDM) { /* DMForest hierarchy ended, we keep upsweeping through the DM hierarchy */ 4677 hiforest = PETSC_FALSE; 4678 ierr = DMGetCoarseDM(dmIn,&coarseDM);CHKERRQ(ierr); 4679 } 4680 n_hi++; 4681 } while (coarseDM); 4682 4683 ierr = PetscMalloc2(n_hi,&hierarchy,n_hi,&hierarchy_forest);CHKERRQ(ierr); 4684 4685 i = 0; 4686 hiforest = PETSC_TRUE; 4687 coarseDM = dm; 4688 do { 4689 dmIn = coarseDM; 4690 coarseDM = NULL; 4691 if (hiforest) { 4692 ierr = DMForestGetAdaptivityForest(dmIn,&coarseDM);CHKERRQ(ierr); 4693 } 4694 if (!coarseDM) { /* DMForest hierarchy ended, we keep upsweeping through the DM hierarchy */ 4695 hiforest = PETSC_FALSE; 4696 ierr = DMGetCoarseDM(dmIn,&coarseDM);CHKERRQ(ierr); 4697 } 4698 i++; 4699 hierarchy[n_hi - i] = dmIn; 4700 } while (coarseDM); 4701 4702 /* project base vector on the coarsest forest (minimum refinement = 0) */ 4703 ierr = DMPforestGetPlex(dmIn,&plex);CHKERRQ(ierr); 4704 4705 /* Check this plex is compatible with the base */ 4706 { 4707 IS gnum[2]; 4708 PetscInt ncells[2],gncells[2]; 4709 4710 ierr = DMPlexGetCellNumbering(base,&gnum[0]);CHKERRQ(ierr); 4711 ierr = DMPlexGetCellNumbering(plex,&gnum[1]);CHKERRQ(ierr); 4712 ierr = ISGetMinMax(gnum[0],NULL,&ncells[0]);CHKERRQ(ierr); 4713 ierr = ISGetMinMax(gnum[1],NULL,&ncells[1]);CHKERRQ(ierr); 4714 ierr = MPIU_Allreduce(ncells,gncells,2,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)dm));CHKERRMPI(ierr); 4715 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); 4716 } 4717 4718 ierr = DMGetLabel(dmIn,"_forest_base_subpoint_map",&subpointMap);CHKERRQ(ierr); 4719 PetscCheckFalse(!subpointMap,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing _forest_base_subpoint_map label"); 4720 4721 ierr = DMPlexGetMaxProjectionHeight(base,&mh);CHKERRQ(ierr); 4722 ierr = DMPlexSetMaxProjectionHeight(plex,mh);CHKERRQ(ierr); 4723 4724 ierr = DMClone(base,&basec);CHKERRQ(ierr); 4725 ierr = DMCopyDisc(dmVecIn,basec);CHKERRQ(ierr); 4726 if (sfRed) { 4727 ierr = PetscObjectReference((PetscObject)vecIn);CHKERRQ(ierr); 4728 vecInLocal = vecIn; 4729 } else { 4730 ierr = DMCreateLocalVector(basec,&vecInLocal);CHKERRQ(ierr); 4731 ierr = DMGlobalToLocalBegin(basec,vecIn,INSERT_VALUES,vecInLocal);CHKERRQ(ierr); 4732 ierr = DMGlobalToLocalEnd(basec,vecIn,INSERT_VALUES,vecInLocal);CHKERRQ(ierr); 4733 } 4734 4735 ierr = DMGetLocalVector(dmIn,&vecOutLocal);CHKERRQ(ierr); 4736 { /* get degrees of freedom ordered onto dmIn */ 4737 PetscSF basetocoarse; 4738 PetscInt bStart, bEnd, nroots; 4739 PetscInt iStart, iEnd, nleaves, leaf; 4740 PetscMPIInt rank; 4741 PetscSFNode *remotes; 4742 PetscSection secIn, secOut; 4743 PetscInt *remoteOffsets; 4744 PetscSF transferSF; 4745 const PetscScalar *inArray; 4746 PetscScalar *outArray; 4747 4748 ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)basec), &rank);CHKERRMPI(ierr); 4749 ierr = DMPlexGetChart(basec, &bStart, &bEnd);CHKERRQ(ierr); 4750 nroots = PetscMax(bEnd - bStart, 0); 4751 ierr = DMPlexGetChart(plex, &iStart, &iEnd);CHKERRQ(ierr); 4752 nleaves = PetscMax(iEnd - iStart, 0); 4753 4754 ierr = PetscMalloc1(nleaves, &remotes);CHKERRQ(ierr); 4755 for (leaf = iStart; leaf < iEnd; leaf++) { 4756 PetscInt index; 4757 4758 remotes[leaf - iStart].rank = rank; 4759 ierr = DMLabelGetValue(subpointMap, leaf, &index);CHKERRQ(ierr); 4760 remotes[leaf - iStart].index = index; 4761 } 4762 4763 ierr = PetscSFCreate(PetscObjectComm((PetscObject)basec), &basetocoarse);CHKERRQ(ierr); 4764 ierr = PetscSFSetGraph(basetocoarse, nroots, nleaves, NULL, PETSC_OWN_POINTER, remotes, PETSC_OWN_POINTER);CHKERRQ(ierr); 4765 ierr = PetscSFSetUp(basetocoarse);CHKERRQ(ierr); 4766 ierr = DMGetLocalSection(basec,&secIn);CHKERRQ(ierr); 4767 ierr = PetscSectionCreate(PetscObjectComm((PetscObject)dmIn),&secOut);CHKERRQ(ierr); 4768 ierr = PetscSFDistributeSection(basetocoarse, secIn, &remoteOffsets, secOut);CHKERRQ(ierr); 4769 ierr = PetscSFCreateSectionSF(basetocoarse, secIn, remoteOffsets, secOut, &transferSF);CHKERRQ(ierr); 4770 ierr = PetscFree(remoteOffsets);CHKERRQ(ierr); 4771 ierr = VecGetArrayWrite(vecOutLocal, &outArray);CHKERRQ(ierr); 4772 ierr = VecGetArrayRead(vecInLocal, &inArray);CHKERRQ(ierr); 4773 ierr = PetscSFBcastBegin(transferSF, MPIU_SCALAR, inArray, outArray,MPI_REPLACE);CHKERRQ(ierr); 4774 ierr = PetscSFBcastEnd(transferSF, MPIU_SCALAR, inArray, outArray,MPI_REPLACE);CHKERRQ(ierr); 4775 ierr = VecRestoreArrayRead(vecInLocal, &inArray);CHKERRQ(ierr); 4776 ierr = VecRestoreArrayWrite(vecOutLocal, &outArray);CHKERRQ(ierr); 4777 ierr = PetscSFDestroy(&transferSF);CHKERRQ(ierr); 4778 ierr = PetscSectionDestroy(&secOut);CHKERRQ(ierr); 4779 ierr = PetscSFDestroy(&basetocoarse);CHKERRQ(ierr); 4780 } 4781 ierr = VecDestroy(&vecInLocal);CHKERRQ(ierr); 4782 ierr = DMDestroy(&basec);CHKERRQ(ierr); 4783 ierr = VecDestroy(&vecIn);CHKERRQ(ierr); 4784 4785 /* output */ 4786 if (n_hi > 1) { /* downsweep the stored hierarchy */ 4787 Vec vecOut1, vecOut2; 4788 DM fineDM; 4789 4790 ierr = DMGetGlobalVector(dmIn,&vecOut1);CHKERRQ(ierr); 4791 ierr = DMLocalToGlobal(dmIn,vecOutLocal,INSERT_VALUES,vecOut1);CHKERRQ(ierr); 4792 ierr = DMRestoreLocalVector(dmIn,&vecOutLocal);CHKERRQ(ierr); 4793 for (i = 1; i < n_hi-1; i++) { 4794 fineDM = hierarchy[i]; 4795 ierr = DMGetGlobalVector(fineDM,&vecOut2);CHKERRQ(ierr); 4796 ierr = DMForestTransferVec(dmIn,vecOut1,fineDM,vecOut2,PETSC_TRUE,0.0);CHKERRQ(ierr); 4797 ierr = DMRestoreGlobalVector(dmIn,&vecOut1);CHKERRQ(ierr); 4798 vecOut1 = vecOut2; 4799 dmIn = fineDM; 4800 } 4801 ierr = DMForestTransferVec(dmIn,vecOut1,dm,vecOut,PETSC_TRUE,0.0);CHKERRQ(ierr); 4802 ierr = DMRestoreGlobalVector(dmIn,&vecOut1);CHKERRQ(ierr); 4803 } else { 4804 ierr = DMLocalToGlobal(dmIn,vecOutLocal,INSERT_VALUES,vecOut);CHKERRQ(ierr); 4805 ierr = DMRestoreLocalVector(dmIn,&vecOutLocal);CHKERRQ(ierr); 4806 } 4807 ierr = PetscFree2(hierarchy,hierarchy_forest);CHKERRQ(ierr); 4808 PetscFunctionReturn(0); 4809 } 4810 4811 #define DMForestTransferVec_pforest _append_pforest(DMForestTransferVec) 4812 static PetscErrorCode DMForestTransferVec_pforest(DM dmIn, Vec vecIn, DM dmOut, Vec vecOut, PetscBool useBCs, PetscReal time) 4813 { 4814 DM adaptIn, adaptOut, plexIn, plexOut; 4815 DM_Forest *forestIn, *forestOut, *forestAdaptIn, *forestAdaptOut; 4816 PetscInt dofPerDim[] = {1, 1, 1, 1}; 4817 PetscSF inSF = NULL, outSF = NULL; 4818 PetscInt *inCids = NULL, *outCids = NULL; 4819 DMAdaptFlag purposeIn, purposeOut; 4820 PetscErrorCode ierr; 4821 4822 PetscFunctionBegin; 4823 forestOut = (DM_Forest *) dmOut->data; 4824 forestIn = (DM_Forest *) dmIn->data; 4825 4826 ierr = DMForestGetAdaptivityForest(dmOut,&adaptOut);CHKERRQ(ierr); 4827 ierr = DMForestGetAdaptivityPurpose(dmOut,&purposeOut);CHKERRQ(ierr); 4828 forestAdaptOut = adaptOut ? (DM_Forest *) adaptOut->data : NULL; 4829 4830 ierr = DMForestGetAdaptivityForest(dmIn,&adaptIn);CHKERRQ(ierr); 4831 ierr = DMForestGetAdaptivityPurpose(dmIn,&purposeIn);CHKERRQ(ierr); 4832 forestAdaptIn = adaptIn ? (DM_Forest *) adaptIn->data : NULL; 4833 4834 if (forestAdaptOut == forestIn) { 4835 switch (purposeOut) { 4836 case DM_ADAPT_REFINE: 4837 ierr = DMPforestGetTransferSF_Internal(dmIn,dmOut,dofPerDim,&inSF,PETSC_TRUE,&inCids);CHKERRQ(ierr); 4838 ierr = PetscSFSetUp(inSF);CHKERRQ(ierr); 4839 break; 4840 case DM_ADAPT_COARSEN: 4841 case DM_ADAPT_COARSEN_LAST: 4842 ierr = DMPforestGetTransferSF_Internal(dmOut,dmIn,dofPerDim,&outSF,PETSC_TRUE,&outCids);CHKERRQ(ierr); 4843 ierr = PetscSFSetUp(outSF);CHKERRQ(ierr); 4844 break; 4845 default: 4846 ierr = DMPforestGetTransferSF_Internal(dmIn,dmOut,dofPerDim,&inSF,PETSC_TRUE,&inCids);CHKERRQ(ierr); 4847 ierr = DMPforestGetTransferSF_Internal(dmOut,dmIn,dofPerDim,&outSF,PETSC_FALSE,&outCids);CHKERRQ(ierr); 4848 ierr = PetscSFSetUp(inSF);CHKERRQ(ierr); 4849 ierr = PetscSFSetUp(outSF);CHKERRQ(ierr); 4850 } 4851 } else if (forestAdaptIn == forestOut) { 4852 switch (purposeIn) { 4853 case DM_ADAPT_REFINE: 4854 ierr = DMPforestGetTransferSF_Internal(dmOut,dmIn,dofPerDim,&outSF,PETSC_TRUE,&inCids);CHKERRQ(ierr); 4855 ierr = PetscSFSetUp(outSF);CHKERRQ(ierr); 4856 break; 4857 case DM_ADAPT_COARSEN: 4858 case DM_ADAPT_COARSEN_LAST: 4859 ierr = DMPforestGetTransferSF_Internal(dmIn,dmOut,dofPerDim,&inSF,PETSC_TRUE,&inCids);CHKERRQ(ierr); 4860 ierr = PetscSFSetUp(inSF);CHKERRQ(ierr); 4861 break; 4862 default: 4863 ierr = DMPforestGetTransferSF_Internal(dmIn,dmOut,dofPerDim,&inSF,PETSC_TRUE,&inCids);CHKERRQ(ierr); 4864 ierr = DMPforestGetTransferSF_Internal(dmOut,dmIn,dofPerDim,&outSF,PETSC_FALSE,&outCids);CHKERRQ(ierr); 4865 ierr = PetscSFSetUp(inSF);CHKERRQ(ierr); 4866 ierr = PetscSFSetUp(outSF);CHKERRQ(ierr); 4867 } 4868 } else SETERRQ(PetscObjectComm((PetscObject)dmIn),PETSC_ERR_SUP,"Only support transfer from pre-adaptivity to post-adaptivity right now"); 4869 ierr = DMPforestGetPlex(dmIn,&plexIn);CHKERRQ(ierr); 4870 ierr = DMPforestGetPlex(dmOut,&plexOut);CHKERRQ(ierr); 4871 4872 ierr = DMPlexTransferVecTree(plexIn,vecIn,plexOut,vecOut,inSF,outSF,inCids,outCids,useBCs,time);CHKERRQ(ierr); 4873 ierr = PetscFree(inCids);CHKERRQ(ierr); 4874 ierr = PetscFree(outCids);CHKERRQ(ierr); 4875 ierr = PetscSFDestroy(&inSF);CHKERRQ(ierr); 4876 ierr = PetscSFDestroy(&outSF);CHKERRQ(ierr); 4877 ierr = PetscFree(inCids);CHKERRQ(ierr); 4878 ierr = PetscFree(outCids);CHKERRQ(ierr); 4879 PetscFunctionReturn(0); 4880 } 4881 4882 #define DMCreateCoordinateDM_pforest _append_pforest(DMCreateCoordinateDM) 4883 static PetscErrorCode DMCreateCoordinateDM_pforest(DM dm,DM *cdm) 4884 { 4885 DM plex; 4886 PetscErrorCode ierr; 4887 4888 PetscFunctionBegin; 4889 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 4890 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 4891 ierr = DMGetCoordinateDM(plex,cdm);CHKERRQ(ierr); 4892 ierr = PetscObjectReference((PetscObject)*cdm);CHKERRQ(ierr); 4893 PetscFunctionReturn(0); 4894 } 4895 4896 #define VecViewLocal_pforest _append_pforest(VecViewLocal) 4897 static PetscErrorCode VecViewLocal_pforest(Vec vec,PetscViewer viewer) 4898 { 4899 DM dm, plex; 4900 PetscErrorCode ierr; 4901 4902 PetscFunctionBegin; 4903 ierr = VecGetDM(vec,&dm);CHKERRQ(ierr); 4904 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 4905 ierr = VecSetDM(vec,plex);CHKERRQ(ierr); 4906 ierr = VecView_Plex_Local(vec,viewer);CHKERRQ(ierr); 4907 ierr = VecSetDM(vec,dm);CHKERRQ(ierr); 4908 PetscFunctionReturn(0); 4909 } 4910 4911 #define VecView_pforest _append_pforest(VecView) 4912 static PetscErrorCode VecView_pforest(Vec vec,PetscViewer viewer) 4913 { 4914 DM dm, plex; 4915 PetscErrorCode ierr; 4916 4917 PetscFunctionBegin; 4918 ierr = VecGetDM(vec,&dm);CHKERRQ(ierr); 4919 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 4920 ierr = VecSetDM(vec,plex);CHKERRQ(ierr); 4921 ierr = VecView_Plex(vec,viewer);CHKERRQ(ierr); 4922 ierr = VecSetDM(vec,dm);CHKERRQ(ierr); 4923 PetscFunctionReturn(0); 4924 } 4925 4926 #define VecView_pforest_Native _infix_pforest(VecView,_Native) 4927 static PetscErrorCode VecView_pforest_Native(Vec vec,PetscViewer viewer) 4928 { 4929 DM dm, plex; 4930 PetscErrorCode ierr; 4931 4932 PetscFunctionBegin; 4933 ierr = VecGetDM(vec,&dm);CHKERRQ(ierr); 4934 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 4935 ierr = VecSetDM(vec,plex);CHKERRQ(ierr); 4936 ierr = VecView_Plex_Native(vec,viewer);CHKERRQ(ierr); 4937 ierr = VecSetDM(vec,dm);CHKERRQ(ierr); 4938 PetscFunctionReturn(0); 4939 } 4940 4941 #define VecLoad_pforest _append_pforest(VecLoad) 4942 static PetscErrorCode VecLoad_pforest(Vec vec,PetscViewer viewer) 4943 { 4944 DM dm, plex; 4945 PetscErrorCode ierr; 4946 4947 PetscFunctionBegin; 4948 ierr = VecGetDM(vec,&dm);CHKERRQ(ierr); 4949 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 4950 ierr = VecSetDM(vec,plex);CHKERRQ(ierr); 4951 ierr = VecLoad_Plex(vec,viewer);CHKERRQ(ierr); 4952 ierr = VecSetDM(vec,dm);CHKERRQ(ierr); 4953 PetscFunctionReturn(0); 4954 } 4955 4956 #define VecLoad_pforest_Native _infix_pforest(VecLoad,_Native) 4957 static PetscErrorCode VecLoad_pforest_Native(Vec vec,PetscViewer viewer) 4958 { 4959 DM dm, plex; 4960 PetscErrorCode ierr; 4961 4962 PetscFunctionBegin; 4963 ierr = VecGetDM(vec,&dm);CHKERRQ(ierr); 4964 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 4965 ierr = VecSetDM(vec,plex);CHKERRQ(ierr); 4966 ierr = VecLoad_Plex_Native(vec,viewer);CHKERRQ(ierr); 4967 ierr = VecSetDM(vec,dm);CHKERRQ(ierr); 4968 PetscFunctionReturn(0); 4969 } 4970 4971 #define DMCreateGlobalVector_pforest _append_pforest(DMCreateGlobalVector) 4972 static PetscErrorCode DMCreateGlobalVector_pforest(DM dm,Vec *vec) 4973 { 4974 PetscErrorCode ierr; 4975 4976 PetscFunctionBegin; 4977 ierr = DMCreateGlobalVector_Section_Private(dm,vec);CHKERRQ(ierr); 4978 /* ierr = VecSetOperation(*vec, VECOP_DUPLICATE, (void(*)(void)) VecDuplicate_MPI_DM);CHKERRQ(ierr); */ 4979 ierr = VecSetOperation(*vec, VECOP_VIEW, (void (*)(void))VecView_pforest);CHKERRQ(ierr); 4980 ierr = VecSetOperation(*vec, VECOP_VIEWNATIVE, (void (*)(void))VecView_pforest_Native);CHKERRQ(ierr); 4981 ierr = VecSetOperation(*vec, VECOP_LOAD, (void (*)(void))VecLoad_pforest);CHKERRQ(ierr); 4982 ierr = VecSetOperation(*vec, VECOP_LOADNATIVE, (void (*)(void))VecLoad_pforest_Native);CHKERRQ(ierr); 4983 PetscFunctionReturn(0); 4984 } 4985 4986 #define DMCreateLocalVector_pforest _append_pforest(DMCreateLocalVector) 4987 static PetscErrorCode DMCreateLocalVector_pforest(DM dm,Vec *vec) 4988 { 4989 PetscErrorCode ierr; 4990 4991 PetscFunctionBegin; 4992 ierr = DMCreateLocalVector_Section_Private(dm,vec);CHKERRQ(ierr); 4993 ierr = VecSetOperation(*vec, VECOP_VIEW, (void (*)(void))VecViewLocal_pforest);CHKERRQ(ierr); 4994 PetscFunctionReturn(0); 4995 } 4996 4997 #define DMCreateMatrix_pforest _append_pforest(DMCreateMatrix) 4998 static PetscErrorCode DMCreateMatrix_pforest(DM dm,Mat *mat) 4999 { 5000 DM plex; 5001 PetscErrorCode ierr; 5002 5003 PetscFunctionBegin; 5004 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 5005 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 5006 if (plex->prealloc_only != dm->prealloc_only) plex->prealloc_only = dm->prealloc_only; /* maybe this should go into forest->plex */ 5007 ierr = DMCreateMatrix(plex,mat);CHKERRQ(ierr); 5008 ierr = MatSetDM(*mat,dm);CHKERRQ(ierr); 5009 PetscFunctionReturn(0); 5010 } 5011 5012 #define DMProjectFunctionLocal_pforest _append_pforest(DMProjectFunctionLocal) 5013 static PetscErrorCode DMProjectFunctionLocal_pforest(DM dm, PetscReal time, PetscErrorCode (**funcs) (PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void*), void **ctxs, InsertMode mode, Vec localX) 5014 { 5015 DM plex; 5016 PetscErrorCode ierr; 5017 5018 PetscFunctionBegin; 5019 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 5020 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 5021 ierr = DMProjectFunctionLocal(plex,time,funcs,ctxs,mode,localX);CHKERRQ(ierr); 5022 PetscFunctionReturn(0); 5023 } 5024 5025 #define DMProjectFunctionLabelLocal_pforest _append_pforest(DMProjectFunctionLabelLocal) 5026 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) 5027 { 5028 DM plex; 5029 PetscErrorCode ierr; 5030 5031 PetscFunctionBegin; 5032 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 5033 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 5034 ierr = DMProjectFunctionLabelLocal(plex,time,label,numIds,ids,Ncc,comps,funcs,ctxs,mode,localX);CHKERRQ(ierr); 5035 PetscFunctionReturn(0); 5036 } 5037 5038 #define DMProjectFieldLocal_pforest _append_pforest(DMProjectFieldLocal) 5039 PetscErrorCode DMProjectFieldLocal_pforest(DM dm, PetscReal time, Vec localU,void (**funcs) (PetscInt, PetscInt, PetscInt, 5040 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 5041 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 5042 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]),InsertMode mode, Vec localX) 5043 { 5044 DM plex; 5045 PetscErrorCode ierr; 5046 5047 PetscFunctionBegin; 5048 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 5049 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 5050 ierr = DMProjectFieldLocal(plex,time,localU,funcs,mode,localX);CHKERRQ(ierr); 5051 PetscFunctionReturn(0); 5052 } 5053 5054 #define DMComputeL2Diff_pforest _append_pforest(DMComputeL2Diff) 5055 PetscErrorCode DMComputeL2Diff_pforest(DM dm, PetscReal time, PetscErrorCode (**funcs) (PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void*), void **ctxs, Vec X, PetscReal *diff) 5056 { 5057 DM plex; 5058 PetscErrorCode ierr; 5059 5060 PetscFunctionBegin; 5061 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 5062 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 5063 ierr = DMComputeL2Diff(plex,time,funcs,ctxs,X,diff);CHKERRQ(ierr); 5064 PetscFunctionReturn(0); 5065 } 5066 5067 #define DMComputeL2FieldDiff_pforest _append_pforest(DMComputeL2FieldDiff) 5068 PetscErrorCode DMComputeL2FieldDiff_pforest(DM dm, PetscReal time, PetscErrorCode (**funcs) (PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void*), void **ctxs, Vec X, PetscReal diff[]) 5069 { 5070 DM plex; 5071 PetscErrorCode ierr; 5072 5073 PetscFunctionBegin; 5074 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 5075 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 5076 ierr = DMComputeL2FieldDiff(plex,time,funcs,ctxs,X,diff);CHKERRQ(ierr); 5077 PetscFunctionReturn(0); 5078 } 5079 5080 #define DMCreatelocalsection_pforest _append_pforest(DMCreatelocalsection) 5081 static PetscErrorCode DMCreatelocalsection_pforest(DM dm) 5082 { 5083 DM plex; 5084 PetscSection section; 5085 PetscErrorCode ierr; 5086 5087 PetscFunctionBegin; 5088 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 5089 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 5090 ierr = DMGetLocalSection(plex,§ion);CHKERRQ(ierr); 5091 ierr = DMSetLocalSection(dm,section);CHKERRQ(ierr); 5092 PetscFunctionReturn(0); 5093 } 5094 5095 #define DMCreateDefaultConstraints_pforest _append_pforest(DMCreateDefaultConstraints) 5096 static PetscErrorCode DMCreateDefaultConstraints_pforest(DM dm) 5097 { 5098 DM plex; 5099 Mat mat; 5100 Vec bias; 5101 PetscSection section; 5102 PetscErrorCode ierr; 5103 5104 PetscFunctionBegin; 5105 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 5106 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 5107 ierr = DMGetDefaultConstraints(plex,§ion,&mat,&bias);CHKERRQ(ierr); 5108 ierr = DMSetDefaultConstraints(dm,section,mat,bias);CHKERRQ(ierr); 5109 PetscFunctionReturn(0); 5110 } 5111 5112 #define DMGetDimPoints_pforest _append_pforest(DMGetDimPoints) 5113 static PetscErrorCode DMGetDimPoints_pforest(DM dm, PetscInt dim, PetscInt *cStart, PetscInt *cEnd) 5114 { 5115 DM plex; 5116 PetscErrorCode ierr; 5117 5118 PetscFunctionBegin; 5119 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 5120 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 5121 ierr = DMGetDimPoints(plex,dim,cStart,cEnd);CHKERRQ(ierr); 5122 PetscFunctionReturn(0); 5123 } 5124 5125 /* Need to forward declare */ 5126 #define DMInitialize_pforest _append_pforest(DMInitialize) 5127 static PetscErrorCode DMInitialize_pforest(DM dm); 5128 5129 #define DMClone_pforest _append_pforest(DMClone) 5130 static PetscErrorCode DMClone_pforest(DM dm, DM *newdm) 5131 { 5132 PetscErrorCode ierr; 5133 5134 PetscFunctionBegin; 5135 ierr = DMClone_Forest(dm,newdm);CHKERRQ(ierr); 5136 ierr = DMInitialize_pforest(*newdm);CHKERRQ(ierr); 5137 PetscFunctionReturn(0); 5138 } 5139 5140 #define DMForestCreateCellChart_pforest _append_pforest(DMForestCreateCellChart) 5141 static PetscErrorCode DMForestCreateCellChart_pforest(DM dm, PetscInt *cStart, PetscInt *cEnd) 5142 { 5143 DM_Forest *forest; 5144 DM_Forest_pforest *pforest; 5145 PetscInt overlap; 5146 PetscErrorCode ierr; 5147 5148 PetscFunctionBegin; 5149 ierr = DMSetUp(dm);CHKERRQ(ierr); 5150 forest = (DM_Forest*) dm->data; 5151 pforest = (DM_Forest_pforest*) forest->data; 5152 *cStart = 0; 5153 ierr = DMForestGetPartitionOverlap(dm,&overlap);CHKERRQ(ierr); 5154 if (overlap && pforest->ghost) { 5155 *cEnd = pforest->forest->local_num_quadrants + pforest->ghost->proc_offsets[pforest->forest->mpisize]; 5156 } else { 5157 *cEnd = pforest->forest->local_num_quadrants; 5158 } 5159 PetscFunctionReturn(0); 5160 } 5161 5162 #define DMForestCreateCellSF_pforest _append_pforest(DMForestCreateCellSF) 5163 static PetscErrorCode DMForestCreateCellSF_pforest(DM dm, PetscSF *cellSF) 5164 { 5165 DM_Forest *forest; 5166 DM_Forest_pforest *pforest; 5167 PetscMPIInt rank; 5168 PetscInt overlap; 5169 PetscInt cStart, cEnd, cLocalStart, cLocalEnd; 5170 PetscInt nRoots, nLeaves, *mine = NULL; 5171 PetscSFNode *remote = NULL; 5172 PetscSF sf; 5173 PetscErrorCode ierr; 5174 5175 PetscFunctionBegin; 5176 ierr = DMForestGetCellChart(dm,&cStart,&cEnd);CHKERRQ(ierr); 5177 forest = (DM_Forest*) dm->data; 5178 pforest = (DM_Forest_pforest*) forest->data; 5179 nRoots = cEnd - cStart; 5180 cLocalStart = pforest->cLocalStart; 5181 cLocalEnd = pforest->cLocalEnd; 5182 nLeaves = 0; 5183 ierr = DMForestGetPartitionOverlap(dm,&overlap);CHKERRQ(ierr); 5184 ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)dm),&rank);CHKERRMPI(ierr); 5185 if (overlap && pforest->ghost) { 5186 PetscSFNode *mirror; 5187 p4est_quadrant_t *mirror_array; 5188 PetscInt nMirror, nGhostPre, nSelf, q; 5189 void **mirrorPtrs; 5190 5191 nMirror = (PetscInt) pforest->ghost->mirrors.elem_count; 5192 nSelf = cLocalEnd - cLocalStart; 5193 nLeaves = nRoots - nSelf; 5194 nGhostPre = (PetscInt) pforest->ghost->proc_offsets[rank]; 5195 ierr = PetscMalloc1(nLeaves,&mine);CHKERRQ(ierr); 5196 ierr = PetscMalloc1(nLeaves,&remote);CHKERRQ(ierr); 5197 ierr = PetscMalloc2(nMirror,&mirror,nMirror,&mirrorPtrs);CHKERRQ(ierr); 5198 mirror_array = (p4est_quadrant_t*) pforest->ghost->mirrors.array; 5199 for (q = 0; q < nMirror; q++) { 5200 p4est_quadrant_t *mir = &(mirror_array[q]); 5201 5202 mirror[q].rank = rank; 5203 mirror[q].index = (PetscInt) mir->p.piggy3.local_num + cLocalStart; 5204 mirrorPtrs[q] = (void*) &(mirror[q]); 5205 } 5206 PetscStackCallP4est(p4est_ghost_exchange_custom,(pforest->forest,pforest->ghost,sizeof(PetscSFNode),mirrorPtrs,remote)); 5207 ierr = PetscFree2(mirror,mirrorPtrs);CHKERRQ(ierr); 5208 for (q = 0; q < nGhostPre; q++) mine[q] = q; 5209 for (; q < nLeaves; q++) mine[q] = (q - nGhostPre) + cLocalEnd; 5210 } 5211 ierr = PetscSFCreate(PetscObjectComm((PetscObject)dm),&sf);CHKERRQ(ierr); 5212 ierr = PetscSFSetGraph(sf,nRoots,nLeaves,mine,PETSC_OWN_POINTER,remote,PETSC_OWN_POINTER);CHKERRQ(ierr); 5213 *cellSF = sf; 5214 PetscFunctionReturn(0); 5215 } 5216 5217 static PetscErrorCode DMCreateNeumannOverlap_pforest(DM dm, IS* ovl, Mat *J, PetscErrorCode (**setup)(Mat, PetscReal, Vec, Vec, PetscReal, IS, void*), void **setup_ctx) 5218 { 5219 DM plex; 5220 PetscErrorCode ierr; 5221 5222 PetscFunctionBegin; 5223 ierr = DMPforestGetPlex(dm,&plex);CHKERRQ(ierr); 5224 ierr = DMCreateNeumannOverlap_Plex(plex,ovl,J,setup,setup_ctx);CHKERRQ(ierr); 5225 if (!*setup) { 5226 ierr = PetscObjectQueryFunction((PetscObject)dm, "MatComputeNeumannOverlap_C", setup);CHKERRQ(ierr); 5227 if (*setup) { 5228 ierr = PetscObjectCompose((PetscObject)*ovl, "_DM_Original_HPDDM", (PetscObject)dm);CHKERRQ(ierr); 5229 } 5230 } 5231 PetscFunctionReturn(0); 5232 } 5233 5234 static PetscErrorCode DMInitialize_pforest(DM dm) 5235 { 5236 PetscErrorCode ierr; 5237 5238 PetscFunctionBegin; 5239 dm->ops->setup = DMSetUp_pforest; 5240 dm->ops->view = DMView_pforest; 5241 dm->ops->clone = DMClone_pforest; 5242 dm->ops->createinterpolation = DMCreateInterpolation_pforest; 5243 dm->ops->createinjection = DMCreateInjection_pforest; 5244 dm->ops->setfromoptions = DMSetFromOptions_pforest; 5245 dm->ops->createcoordinatedm = DMCreateCoordinateDM_pforest; 5246 dm->ops->createglobalvector = DMCreateGlobalVector_pforest; 5247 dm->ops->createlocalvector = DMCreateLocalVector_pforest; 5248 dm->ops->creatematrix = DMCreateMatrix_pforest; 5249 dm->ops->projectfunctionlocal = DMProjectFunctionLocal_pforest; 5250 dm->ops->projectfunctionlabellocal = DMProjectFunctionLabelLocal_pforest; 5251 dm->ops->projectfieldlocal = DMProjectFieldLocal_pforest; 5252 dm->ops->createlocalsection = DMCreatelocalsection_pforest; 5253 dm->ops->createdefaultconstraints = DMCreateDefaultConstraints_pforest; 5254 dm->ops->computel2diff = DMComputeL2Diff_pforest; 5255 dm->ops->computel2fielddiff = DMComputeL2FieldDiff_pforest; 5256 dm->ops->getdimpoints = DMGetDimPoints_pforest; 5257 5258 ierr = PetscObjectComposeFunction((PetscObject)dm,PetscStringize(DMConvert_plex_pforest) "_C",DMConvert_plex_pforest);CHKERRQ(ierr); 5259 ierr = PetscObjectComposeFunction((PetscObject)dm,PetscStringize(DMConvert_pforest_plex) "_C",DMConvert_pforest_plex);CHKERRQ(ierr); 5260 ierr = PetscObjectComposeFunction((PetscObject)dm,"DMCreateNeumannOverlap_C",DMCreateNeumannOverlap_pforest);CHKERRQ(ierr); 5261 ierr = PetscObjectComposeFunction((PetscObject)dm,"DMPlexGetOverlap_C",DMForestGetPartitionOverlap);CHKERRQ(ierr); 5262 PetscFunctionReturn(0); 5263 } 5264 5265 #define DMCreate_pforest _append_pforest(DMCreate) 5266 PETSC_EXTERN PetscErrorCode DMCreate_pforest(DM dm) 5267 { 5268 DM_Forest *forest; 5269 DM_Forest_pforest *pforest; 5270 PetscErrorCode ierr; 5271 5272 PetscFunctionBegin; 5273 ierr = PetscP4estInitialize();CHKERRQ(ierr); 5274 ierr = DMCreate_Forest(dm);CHKERRQ(ierr); 5275 ierr = DMInitialize_pforest(dm);CHKERRQ(ierr); 5276 ierr = DMSetDimension(dm,P4EST_DIM);CHKERRQ(ierr); 5277 5278 /* set forest defaults */ 5279 ierr = DMForestSetTopology(dm,"unit");CHKERRQ(ierr); 5280 ierr = DMForestSetMinimumRefinement(dm,0);CHKERRQ(ierr); 5281 ierr = DMForestSetInitialRefinement(dm,0);CHKERRQ(ierr); 5282 ierr = DMForestSetMaximumRefinement(dm,P4EST_QMAXLEVEL);CHKERRQ(ierr); 5283 ierr = DMForestSetGradeFactor(dm,2);CHKERRQ(ierr); 5284 ierr = DMForestSetAdjacencyDimension(dm,0);CHKERRQ(ierr); 5285 ierr = DMForestSetPartitionOverlap(dm,0);CHKERRQ(ierr); 5286 5287 /* create p4est data */ 5288 ierr = PetscNewLog(dm,&pforest);CHKERRQ(ierr); 5289 5290 forest = (DM_Forest*) dm->data; 5291 forest->data = pforest; 5292 forest->destroy = DMForestDestroy_pforest; 5293 forest->ftemplate = DMForestTemplate_pforest; 5294 forest->transfervec = DMForestTransferVec_pforest; 5295 forest->transfervecfrombase = DMForestTransferVecFromBase_pforest; 5296 forest->createcellchart = DMForestCreateCellChart_pforest; 5297 forest->createcellsf = DMForestCreateCellSF_pforest; 5298 forest->clearadaptivityforest = DMForestClearAdaptivityForest_pforest; 5299 forest->getadaptivitysuccess = DMForestGetAdaptivitySuccess_pforest; 5300 pforest->topo = NULL; 5301 pforest->forest = NULL; 5302 pforest->ghost = NULL; 5303 pforest->lnodes = NULL; 5304 pforest->partition_for_coarsening = PETSC_TRUE; 5305 pforest->coarsen_hierarchy = PETSC_FALSE; 5306 pforest->cLocalStart = -1; 5307 pforest->cLocalEnd = -1; 5308 pforest->labelsFinalized = PETSC_FALSE; 5309 pforest->ghostName = NULL; 5310 PetscFunctionReturn(0); 5311 } 5312 5313 #endif /* defined(PETSC_HAVE_P4EST) */ 5314