1 #include <petsc/private/dmpleximpl.h> /*I "petscdmplex.h" I*/ 2 #include <petscsf.h> 3 4 #include <petsc/private/hashsetij.h> 5 #include <petsc/private/petscfeimpl.h> 6 #include <petsc/private/petscfvimpl.h> 7 8 static PetscErrorCode PetscContainerUserDestroy_PetscFEGeom (void *ctx) 9 { 10 PetscFEGeom *geom = (PetscFEGeom *) ctx; 11 PetscErrorCode ierr; 12 13 PetscFunctionBegin; 14 ierr = PetscFEGeomDestroy(&geom);CHKERRQ(ierr); 15 PetscFunctionReturn(0); 16 } 17 18 static PetscErrorCode DMPlexGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom) 19 { 20 char composeStr[33] = {0}; 21 PetscObjectId id; 22 PetscContainer container; 23 PetscErrorCode ierr; 24 25 PetscFunctionBegin; 26 ierr = PetscObjectGetId((PetscObject)quad,&id);CHKERRQ(ierr); 27 ierr = PetscSNPrintf(composeStr, 32, "DMPlexGetFEGeom_%x\n", id);CHKERRQ(ierr); 28 ierr = PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);CHKERRQ(ierr); 29 if (container) { 30 ierr = PetscContainerGetPointer(container, (void **) geom);CHKERRQ(ierr); 31 } else { 32 ierr = DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);CHKERRQ(ierr); 33 ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr); 34 ierr = PetscContainerSetPointer(container, (void *) *geom);CHKERRQ(ierr); 35 ierr = PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);CHKERRQ(ierr); 36 ierr = PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);CHKERRQ(ierr); 37 ierr = PetscContainerDestroy(&container);CHKERRQ(ierr); 38 } 39 PetscFunctionReturn(0); 40 } 41 42 static PetscErrorCode DMPlexRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom) 43 { 44 PetscFunctionBegin; 45 *geom = NULL; 46 PetscFunctionReturn(0); 47 } 48 49 /*@ 50 DMPlexGetScale - Get the scale for the specified fundamental unit 51 52 Not collective 53 54 Input Arguments: 55 + dm - the DM 56 - unit - The SI unit 57 58 Output Argument: 59 . scale - The value used to scale all quantities with this unit 60 61 Level: advanced 62 63 .seealso: DMPlexSetScale(), PetscUnit 64 @*/ 65 PetscErrorCode DMPlexGetScale(DM dm, PetscUnit unit, PetscReal *scale) 66 { 67 DM_Plex *mesh = (DM_Plex*) dm->data; 68 69 PetscFunctionBegin; 70 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 71 PetscValidPointer(scale, 3); 72 *scale = mesh->scale[unit]; 73 PetscFunctionReturn(0); 74 } 75 76 /*@ 77 DMPlexSetScale - Set the scale for the specified fundamental unit 78 79 Not collective 80 81 Input Arguments: 82 + dm - the DM 83 . unit - The SI unit 84 - scale - The value used to scale all quantities with this unit 85 86 Level: advanced 87 88 .seealso: DMPlexGetScale(), PetscUnit 89 @*/ 90 PetscErrorCode DMPlexSetScale(DM dm, PetscUnit unit, PetscReal scale) 91 { 92 DM_Plex *mesh = (DM_Plex*) dm->data; 93 94 PetscFunctionBegin; 95 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 96 mesh->scale[unit] = scale; 97 PetscFunctionReturn(0); 98 } 99 100 static PetscErrorCode DMPlexProjectRigidBody_Private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *mode, void *ctx) 101 { 102 const PetscInt eps[3][3][3] = {{{0, 0, 0}, {0, 0, 1}, {0, -1, 0}}, {{0, 0, -1}, {0, 0, 0}, {1, 0, 0}}, {{0, 1, 0}, {-1, 0, 0}, {0, 0, 0}}}; 103 PetscInt *ctxInt = (PetscInt *) ctx; 104 PetscInt dim2 = ctxInt[0]; 105 PetscInt d = ctxInt[1]; 106 PetscInt i, j, k = dim > 2 ? d - dim : d; 107 108 PetscFunctionBegin; 109 if (dim != dim2) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Input dimension %d does not match context dimension %d", dim, dim2); 110 for (i = 0; i < dim; i++) mode[i] = 0.; 111 if (d < dim) { 112 mode[d] = 1.; /* Translation along axis d */ 113 } else { 114 for (i = 0; i < dim; i++) { 115 for (j = 0; j < dim; j++) { 116 mode[j] += eps[i][j][k]*X[i]; /* Rotation about axis d */ 117 } 118 } 119 } 120 PetscFunctionReturn(0); 121 } 122 123 /*@ 124 DMPlexCreateRigidBody - For the default global section, create rigid body modes by function space interpolation 125 126 Collective on DM 127 128 Input Arguments: 129 . dm - the DM 130 131 Output Argument: 132 . sp - the null space 133 134 Note: This is necessary to provide a suitable coarse space for algebraic multigrid 135 136 Level: advanced 137 138 .seealso: MatNullSpaceCreate(), PCGAMG 139 @*/ 140 PetscErrorCode DMPlexCreateRigidBody(DM dm, MatNullSpace *sp) 141 { 142 MPI_Comm comm; 143 Vec mode[6]; 144 PetscSection section, globalSection; 145 PetscInt dim, dimEmbed, n, m, mmin, d, i, j; 146 PetscErrorCode ierr; 147 148 PetscFunctionBegin; 149 ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr); 150 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 151 ierr = DMGetCoordinateDim(dm, &dimEmbed);CHKERRQ(ierr); 152 if (dim == 1) { 153 ierr = MatNullSpaceCreate(comm, PETSC_TRUE, 0, NULL, sp);CHKERRQ(ierr); 154 PetscFunctionReturn(0); 155 } 156 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 157 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 158 ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr); 159 m = (dim*(dim+1))/2; 160 ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr); 161 ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr); 162 ierr = VecSetUp(mode[0]);CHKERRQ(ierr); 163 ierr = VecGetSize(mode[0], &n);CHKERRQ(ierr); 164 mmin = PetscMin(m, n); 165 for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);} 166 for (d = 0; d < m; d++) { 167 PetscInt ctx[2]; 168 PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *) = DMPlexProjectRigidBody_Private; 169 void *voidctx = (void *) (&ctx[0]); 170 171 ctx[0] = dimEmbed; 172 ctx[1] = d; 173 ierr = DMProjectFunction(dm, 0.0, &func, &voidctx, INSERT_VALUES, mode[d]);CHKERRQ(ierr); 174 } 175 for (i = 0; i < PetscMin(dim, mmin); ++i) {ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);} 176 /* Orthonormalize system */ 177 for (i = dim; i < mmin; ++i) { 178 PetscScalar dots[6]; 179 180 ierr = VecMDot(mode[i], i, mode, dots);CHKERRQ(ierr); 181 for (j = 0; j < i; ++j) dots[j] *= -1.0; 182 ierr = VecMAXPY(mode[i], i, dots, mode);CHKERRQ(ierr); 183 ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr); 184 } 185 ierr = MatNullSpaceCreate(comm, PETSC_FALSE, mmin, mode, sp);CHKERRQ(ierr); 186 for (i = 0; i < m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);} 187 PetscFunctionReturn(0); 188 } 189 190 /*@ 191 DMPlexCreateRigidBodies - For the default global section, create rigid body modes by function space interpolation 192 193 Collective on DM 194 195 Input Arguments: 196 + dm - the DM 197 . nb - The number of bodies 198 . label - The DMLabel marking each domain 199 . nids - The number of ids per body 200 - ids - An array of the label ids in sequence for each domain 201 202 Output Argument: 203 . sp - the null space 204 205 Note: This is necessary to provide a suitable coarse space for algebraic multigrid 206 207 Level: advanced 208 209 .seealso: MatNullSpaceCreate() 210 @*/ 211 PetscErrorCode DMPlexCreateRigidBodies(DM dm, PetscInt nb, DMLabel label, const PetscInt nids[], const PetscInt ids[], MatNullSpace *sp) 212 { 213 MPI_Comm comm; 214 PetscSection section, globalSection; 215 Vec *mode; 216 PetscScalar *dots; 217 PetscInt dim, dimEmbed, n, m, b, d, i, j, off; 218 PetscErrorCode ierr; 219 220 PetscFunctionBegin; 221 ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr); 222 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 223 ierr = DMGetCoordinateDim(dm, &dimEmbed);CHKERRQ(ierr); 224 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 225 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 226 ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr); 227 m = nb * (dim*(dim+1))/2; 228 ierr = PetscMalloc2(m, &mode, m, &dots);CHKERRQ(ierr); 229 ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr); 230 ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr); 231 ierr = VecSetUp(mode[0]);CHKERRQ(ierr); 232 for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);} 233 for (b = 0, off = 0; b < nb; ++b) { 234 for (d = 0; d < m/nb; ++d) { 235 PetscInt ctx[2]; 236 PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *) = DMPlexProjectRigidBody_Private; 237 void *voidctx = (void *) (&ctx[0]); 238 239 ctx[0] = dimEmbed; 240 ctx[1] = d; 241 ierr = DMProjectFunctionLabel(dm, 0.0, label, nids[b], &ids[off], 0, NULL, &func, &voidctx, INSERT_VALUES, mode[d]);CHKERRQ(ierr); 242 off += nids[b]; 243 } 244 } 245 for (i = 0; i < dim; ++i) {ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);} 246 /* Orthonormalize system */ 247 for (i = 0; i < m; ++i) { 248 ierr = VecMDot(mode[i], i, mode, dots);CHKERRQ(ierr); 249 for (j = 0; j < i; ++j) dots[j] *= -1.0; 250 ierr = VecMAXPY(mode[i], i, dots, mode);CHKERRQ(ierr); 251 ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr); 252 } 253 ierr = MatNullSpaceCreate(comm, PETSC_FALSE, m, mode, sp);CHKERRQ(ierr); 254 for (i = 0; i< m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);} 255 ierr = PetscFree2(mode, dots);CHKERRQ(ierr); 256 PetscFunctionReturn(0); 257 } 258 259 /*@ 260 DMPlexSetMaxProjectionHeight - In DMPlexProjectXXXLocal() functions, the projected values of a basis function's dofs 261 are computed by associating the basis function with one of the mesh points in its transitively-closed support, and 262 evaluating the dual space basis of that point. A basis function is associated with the point in its 263 transitively-closed support whose mesh height is highest (w.r.t. DAG height), but not greater than the maximum 264 projection height, which is set with this function. By default, the maximum projection height is zero, which means 265 that only mesh cells are used to project basis functions. A height of one, for example, evaluates a cell-interior 266 basis functions using its cells dual space basis, but all other basis functions with the dual space basis of a face. 267 268 Input Parameters: 269 + dm - the DMPlex object 270 - height - the maximum projection height >= 0 271 272 Level: advanced 273 274 .seealso: DMPlexGetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal() 275 @*/ 276 PetscErrorCode DMPlexSetMaxProjectionHeight(DM dm, PetscInt height) 277 { 278 DM_Plex *plex = (DM_Plex *) dm->data; 279 280 PetscFunctionBegin; 281 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 282 plex->maxProjectionHeight = height; 283 PetscFunctionReturn(0); 284 } 285 286 /*@ 287 DMPlexGetMaxProjectionHeight - Get the maximum height (w.r.t. DAG) of mesh points used to evaluate dual bases in 288 DMPlexProjectXXXLocal() functions. 289 290 Input Parameters: 291 . dm - the DMPlex object 292 293 Output Parameters: 294 . height - the maximum projection height 295 296 Level: intermediate 297 298 .seealso: DMPlexSetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal() 299 @*/ 300 PetscErrorCode DMPlexGetMaxProjectionHeight(DM dm, PetscInt *height) 301 { 302 DM_Plex *plex = (DM_Plex *) dm->data; 303 304 PetscFunctionBegin; 305 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 306 *height = plex->maxProjectionHeight; 307 PetscFunctionReturn(0); 308 } 309 310 /*@C 311 DMPlexInsertBoundaryValuesEssential - Insert boundary values into a local vector 312 313 Input Parameters: 314 + dm - The DM, with a PetscDS that matches the problem being constrained 315 . time - The time 316 . field - The field to constrain 317 . Nc - The number of constrained field components, or 0 for all components 318 . comps - An array of constrained component numbers, or NULL for all components 319 . label - The DMLabel defining constrained points 320 . numids - The number of DMLabel ids for constrained points 321 . ids - An array of ids for constrained points 322 . func - A pointwise function giving boundary values 323 - ctx - An optional user context for bcFunc 324 325 Output Parameter: 326 . locX - A local vector to receives the boundary values 327 328 Level: developer 329 330 .seealso: DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary() 331 @*/ 332 PetscErrorCode DMPlexInsertBoundaryValuesEssential(DM dm, PetscReal time, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[], PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *), void *ctx, Vec locX) 333 { 334 PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal x[], PetscInt, PetscScalar *u, void *ctx); 335 void **ctxs; 336 PetscInt numFields; 337 PetscErrorCode ierr; 338 339 PetscFunctionBegin; 340 ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr); 341 ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr); 342 funcs[field] = func; 343 ctxs[field] = ctx; 344 ierr = DMProjectFunctionLabelLocal(dm, time, label, numids, ids, Nc, comps, funcs, ctxs, INSERT_BC_VALUES, locX);CHKERRQ(ierr); 345 ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr); 346 PetscFunctionReturn(0); 347 } 348 349 /*@C 350 DMPlexInsertBoundaryValuesEssentialField - Insert boundary values into a local vector 351 352 Input Parameters: 353 + dm - The DM, with a PetscDS that matches the problem being constrained 354 . time - The time 355 . locU - A local vector with the input solution values 356 . field - The field to constrain 357 . Nc - The number of constrained field components, or 0 for all components 358 . comps - An array of constrained component numbers, or NULL for all components 359 . label - The DMLabel defining constrained points 360 . numids - The number of DMLabel ids for constrained points 361 . ids - An array of ids for constrained points 362 . func - A pointwise function giving boundary values 363 - ctx - An optional user context for bcFunc 364 365 Output Parameter: 366 . locX - A local vector to receives the boundary values 367 368 Level: developer 369 370 .seealso: DMPlexInsertBoundaryValuesEssential(), DMAddBoundary() 371 @*/ 372 PetscErrorCode DMPlexInsertBoundaryValuesEssentialField(DM dm, PetscReal time, Vec locU, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[], 373 void (*func)(PetscInt, PetscInt, PetscInt, 374 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 375 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 376 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], 377 PetscScalar[]), 378 void *ctx, Vec locX) 379 { 380 void (**funcs)(PetscInt, PetscInt, PetscInt, 381 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 382 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 383 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]); 384 void **ctxs; 385 PetscInt numFields; 386 PetscErrorCode ierr; 387 388 PetscFunctionBegin; 389 ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr); 390 ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr); 391 funcs[field] = func; 392 ctxs[field] = ctx; 393 ierr = DMProjectFieldLabelLocal(dm, time, label, numids, ids, Nc, comps, locU, funcs, INSERT_BC_VALUES, locX);CHKERRQ(ierr); 394 ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr); 395 PetscFunctionReturn(0); 396 } 397 398 /*@C 399 DMPlexInsertBoundaryValuesRiemann - Insert boundary values into a local vector 400 401 Input Parameters: 402 + dm - The DM, with a PetscDS that matches the problem being constrained 403 . time - The time 404 . faceGeometry - A vector with the FVM face geometry information 405 . cellGeometry - A vector with the FVM cell geometry information 406 . Grad - A vector with the FVM cell gradient information 407 . field - The field to constrain 408 . Nc - The number of constrained field components, or 0 for all components 409 . comps - An array of constrained component numbers, or NULL for all components 410 . label - The DMLabel defining constrained points 411 . numids - The number of DMLabel ids for constrained points 412 . ids - An array of ids for constrained points 413 . func - A pointwise function giving boundary values 414 - ctx - An optional user context for bcFunc 415 416 Output Parameter: 417 . locX - A local vector to receives the boundary values 418 419 Note: This implementation currently ignores the numcomps/comps argument from DMAddBoundary() 420 421 Level: developer 422 423 .seealso: DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary() 424 @*/ 425 PetscErrorCode DMPlexInsertBoundaryValuesRiemann(DM dm, PetscReal time, Vec faceGeometry, Vec cellGeometry, Vec Grad, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[], 426 PetscErrorCode (*func)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*), void *ctx, Vec locX) 427 { 428 PetscDS prob; 429 PetscSF sf; 430 DM dmFace, dmCell, dmGrad; 431 const PetscScalar *facegeom, *cellgeom = NULL, *grad; 432 const PetscInt *leaves; 433 PetscScalar *x, *fx; 434 PetscInt dim, nleaves, loc, fStart, fEnd, pdim, i; 435 PetscErrorCode ierr, ierru = 0; 436 437 PetscFunctionBegin; 438 ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr); 439 ierr = PetscSFGetGraph(sf, NULL, &nleaves, &leaves, NULL);CHKERRQ(ierr); 440 nleaves = PetscMax(0, nleaves); 441 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 442 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 443 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 444 ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr); 445 ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 446 if (cellGeometry) { 447 ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr); 448 ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 449 } 450 if (Grad) { 451 PetscFV fv; 452 453 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fv);CHKERRQ(ierr); 454 ierr = VecGetDM(Grad, &dmGrad);CHKERRQ(ierr); 455 ierr = VecGetArrayRead(Grad, &grad);CHKERRQ(ierr); 456 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr); 457 ierr = DMGetWorkArray(dm, pdim, MPIU_SCALAR, &fx);CHKERRQ(ierr); 458 } 459 ierr = VecGetArray(locX, &x);CHKERRQ(ierr); 460 for (i = 0; i < numids; ++i) { 461 IS faceIS; 462 const PetscInt *faces; 463 PetscInt numFaces, f; 464 465 ierr = DMLabelGetStratumIS(label, ids[i], &faceIS);CHKERRQ(ierr); 466 if (!faceIS) continue; /* No points with that id on this process */ 467 ierr = ISGetLocalSize(faceIS, &numFaces);CHKERRQ(ierr); 468 ierr = ISGetIndices(faceIS, &faces);CHKERRQ(ierr); 469 for (f = 0; f < numFaces; ++f) { 470 const PetscInt face = faces[f], *cells; 471 PetscFVFaceGeom *fg; 472 473 if ((face < fStart) || (face >= fEnd)) continue; /* Refinement adds non-faces to labels */ 474 ierr = PetscFindInt(face, nleaves, (PetscInt *) leaves, &loc);CHKERRQ(ierr); 475 if (loc >= 0) continue; 476 ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr); 477 ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr); 478 if (Grad) { 479 PetscFVCellGeom *cg; 480 PetscScalar *cx, *cgrad; 481 PetscScalar *xG; 482 PetscReal dx[3]; 483 PetscInt d; 484 485 ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cg);CHKERRQ(ierr); 486 ierr = DMPlexPointLocalRead(dm, cells[0], x, &cx);CHKERRQ(ierr); 487 ierr = DMPlexPointLocalRead(dmGrad, cells[0], grad, &cgrad);CHKERRQ(ierr); 488 ierr = DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);CHKERRQ(ierr); 489 DMPlex_WaxpyD_Internal(dim, -1, cg->centroid, fg->centroid, dx); 490 for (d = 0; d < pdim; ++d) fx[d] = cx[d] + DMPlex_DotD_Internal(dim, &cgrad[d*dim], dx); 491 ierru = (*func)(time, fg->centroid, fg->normal, fx, xG, ctx); 492 if (ierru) { 493 ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr); 494 ierr = ISDestroy(&faceIS);CHKERRQ(ierr); 495 goto cleanup; 496 } 497 } else { 498 PetscScalar *xI; 499 PetscScalar *xG; 500 501 ierr = DMPlexPointLocalRead(dm, cells[0], x, &xI);CHKERRQ(ierr); 502 ierr = DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);CHKERRQ(ierr); 503 ierru = (*func)(time, fg->centroid, fg->normal, xI, xG, ctx); 504 if (ierru) { 505 ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr); 506 ierr = ISDestroy(&faceIS);CHKERRQ(ierr); 507 goto cleanup; 508 } 509 } 510 } 511 ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr); 512 ierr = ISDestroy(&faceIS);CHKERRQ(ierr); 513 } 514 cleanup: 515 ierr = VecRestoreArray(locX, &x);CHKERRQ(ierr); 516 if (Grad) { 517 ierr = DMRestoreWorkArray(dm, pdim, MPIU_SCALAR, &fx);CHKERRQ(ierr); 518 ierr = VecRestoreArrayRead(Grad, &grad);CHKERRQ(ierr); 519 } 520 if (cellGeometry) {ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);} 521 ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 522 CHKERRQ(ierru); 523 PetscFunctionReturn(0); 524 } 525 526 PetscErrorCode DMPlexInsertBoundaryValues_Plex(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM) 527 { 528 PetscDS prob; 529 PetscInt numBd, b; 530 PetscErrorCode ierr; 531 532 PetscFunctionBegin; 533 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 534 ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr); 535 for (b = 0; b < numBd; ++b) { 536 DMBoundaryConditionType type; 537 const char *labelname; 538 DMLabel label; 539 PetscInt field, Nc; 540 const PetscInt *comps; 541 PetscObject obj; 542 PetscClassId id; 543 void (*func)(void); 544 PetscInt numids; 545 const PetscInt *ids; 546 void *ctx; 547 548 ierr = DMGetBoundary(dm, b, &type, NULL, &labelname, &field, &Nc, &comps, &func, &numids, &ids, &ctx);CHKERRQ(ierr); 549 if (insertEssential != (type & DM_BC_ESSENTIAL)) continue; 550 ierr = DMGetLabel(dm, labelname, &label);CHKERRQ(ierr); 551 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 552 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 553 if (id == PETSCFE_CLASSID) { 554 switch (type) { 555 /* for FEM, there is no insertion to be done for non-essential boundary conditions */ 556 case DM_BC_ESSENTIAL: 557 ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr); 558 ierr = DMPlexInsertBoundaryValuesEssential(dm, time, field, Nc, comps, label, numids, ids, (PetscErrorCode (*)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *)) func, ctx, locX);CHKERRQ(ierr); 559 ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr); 560 break; 561 case DM_BC_ESSENTIAL_FIELD: 562 ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr); 563 ierr = DMPlexInsertBoundaryValuesEssentialField(dm, time, locX, field, Nc, comps, label, numids, ids, 564 (void (*)(PetscInt, PetscInt, PetscInt, const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 565 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 566 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[])) func, ctx, locX);CHKERRQ(ierr); 567 ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr); 568 break; 569 default: break; 570 } 571 } else if (id == PETSCFV_CLASSID) { 572 if (!faceGeomFVM) continue; 573 ierr = DMPlexInsertBoundaryValuesRiemann(dm, time, faceGeomFVM, cellGeomFVM, gradFVM, field, Nc, comps, label, numids, ids, 574 (PetscErrorCode (*)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*)) func, ctx, locX);CHKERRQ(ierr); 575 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 576 } 577 PetscFunctionReturn(0); 578 } 579 580 /*@ 581 DMPlexInsertBoundaryValues - Puts coefficients which represent boundary values into the local solution vector 582 583 Input Parameters: 584 + dm - The DM 585 . insertEssential - Should I insert essential (e.g. Dirichlet) or inessential (e.g. Neumann) boundary conditions 586 . time - The time 587 . faceGeomFVM - Face geometry data for FV discretizations 588 . cellGeomFVM - Cell geometry data for FV discretizations 589 - gradFVM - Gradient reconstruction data for FV discretizations 590 591 Output Parameters: 592 . locX - Solution updated with boundary values 593 594 Level: developer 595 596 .seealso: DMProjectFunctionLabelLocal() 597 @*/ 598 PetscErrorCode DMPlexInsertBoundaryValues(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM) 599 { 600 PetscErrorCode ierr; 601 602 PetscFunctionBegin; 603 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 604 PetscValidHeaderSpecific(locX, VEC_CLASSID, 2); 605 if (faceGeomFVM) {PetscValidHeaderSpecific(faceGeomFVM, VEC_CLASSID, 4);} 606 if (cellGeomFVM) {PetscValidHeaderSpecific(cellGeomFVM, VEC_CLASSID, 5);} 607 if (gradFVM) {PetscValidHeaderSpecific(gradFVM, VEC_CLASSID, 6);} 608 ierr = PetscTryMethod(dm,"DMPlexInsertBoundaryValues_C",(DM,PetscBool,Vec,PetscReal,Vec,Vec,Vec),(dm,insertEssential,locX,time,faceGeomFVM,cellGeomFVM,gradFVM));CHKERRQ(ierr); 609 PetscFunctionReturn(0); 610 } 611 612 PetscErrorCode DMComputeL2Diff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff) 613 { 614 Vec localX; 615 PetscErrorCode ierr; 616 617 PetscFunctionBegin; 618 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr); 619 ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, localX, time, NULL, NULL, NULL);CHKERRQ(ierr); 620 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 621 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 622 ierr = DMPlexComputeL2DiffLocal(dm, time, funcs, ctxs, localX, diff);CHKERRQ(ierr); 623 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr); 624 PetscFunctionReturn(0); 625 } 626 627 /*@C 628 DMComputeL2Diff - This function computes the L_2 difference between a function u and an FEM interpolant solution u_h. 629 630 Input Parameters: 631 + dm - The DM 632 . time - The time 633 . funcs - The functions to evaluate for each field component 634 . ctxs - Optional array of contexts to pass to each function, or NULL. 635 - localX - The coefficient vector u_h, a local vector 636 637 Output Parameter: 638 . diff - The diff ||u - u_h||_2 639 640 Level: developer 641 642 .seealso: DMProjectFunction(), DMComputeL2FieldDiff(), DMComputeL2GradientDiff() 643 @*/ 644 PetscErrorCode DMPlexComputeL2DiffLocal(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec localX, PetscReal *diff) 645 { 646 const PetscInt debug = ((DM_Plex*)dm->data)->printL2; 647 PetscSection section; 648 PetscQuadrature quad; 649 PetscScalar *funcVal, *interpolant; 650 PetscReal *coords, *detJ, *J; 651 PetscReal localDiff = 0.0; 652 const PetscReal *quadWeights; 653 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cellHeight, cStart, cEnd, cEndInterior, c, field, fieldOffset; 654 PetscErrorCode ierr; 655 656 PetscFunctionBegin; 657 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 658 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 659 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 660 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 661 for (field = 0; field < numFields; ++field) { 662 PetscObject obj; 663 PetscClassId id; 664 PetscInt Nc; 665 666 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 667 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 668 if (id == PETSCFE_CLASSID) { 669 PetscFE fe = (PetscFE) obj; 670 671 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 672 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 673 } else if (id == PETSCFV_CLASSID) { 674 PetscFV fv = (PetscFV) obj; 675 676 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr); 677 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 678 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 679 numComponents += Nc; 680 } 681 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, NULL, &quadWeights);CHKERRQ(ierr); 682 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 683 ierr = PetscMalloc5(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J);CHKERRQ(ierr); 684 ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr); 685 ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr); 686 ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 687 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 688 for (c = cStart; c < cEnd; ++c) { 689 PetscScalar *x = NULL; 690 PetscReal elemDiff = 0.0; 691 PetscInt qc = 0; 692 693 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, NULL, detJ);CHKERRQ(ierr); 694 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 695 696 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 697 PetscObject obj; 698 PetscClassId id; 699 void * const ctx = ctxs ? ctxs[field] : NULL; 700 PetscInt Nb, Nc, q, fc; 701 702 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 703 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 704 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);} 705 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;} 706 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 707 if (debug) { 708 char title[1024]; 709 ierr = PetscSNPrintf(title, 1023, "Solution for Field %d", field);CHKERRQ(ierr); 710 ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr); 711 } 712 for (q = 0; q < Nq; ++q) { 713 if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, point %D", detJ[q], c, q); 714 ierr = (*funcs[field])(coordDim, time, &coords[coordDim * q], Nc, funcVal, ctx); 715 if (ierr) { 716 PetscErrorCode ierr2; 717 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2); 718 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2); 719 ierr2 = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr2); 720 CHKERRQ(ierr); 721 } 722 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 723 else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 724 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 725 for (fc = 0; fc < Nc; ++fc) { 726 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)]; 727 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %d field %d diff %g\n", c, field, PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]);CHKERRQ(ierr);} 728 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]; 729 } 730 } 731 fieldOffset += Nb; 732 qc += Nc; 733 } 734 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 735 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %d diff %g\n", c, elemDiff);CHKERRQ(ierr);} 736 localDiff += elemDiff; 737 } 738 ierr = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr); 739 ierr = MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr); 740 *diff = PetscSqrtReal(*diff); 741 PetscFunctionReturn(0); 742 } 743 744 PetscErrorCode DMComputeL2GradientDiff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, const PetscReal n[], PetscReal *diff) 745 { 746 const PetscInt debug = ((DM_Plex*)dm->data)->printL2; 747 PetscSection section; 748 PetscQuadrature quad; 749 Vec localX; 750 PetscScalar *funcVal, *interpolant; 751 const PetscReal *quadPoints, *quadWeights; 752 PetscReal *coords, *realSpaceDer, *J, *invJ, *detJ; 753 PetscReal localDiff = 0.0; 754 PetscInt dim, coordDim, qNc = 0, Nq = 0, numFields, numComponents = 0, cStart, cEnd, cEndInterior, c, field, fieldOffset; 755 PetscErrorCode ierr; 756 757 PetscFunctionBegin; 758 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 759 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 760 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 761 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 762 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr); 763 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 764 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 765 for (field = 0; field < numFields; ++field) { 766 PetscFE fe; 767 PetscInt Nc; 768 769 ierr = DMGetField(dm, field, NULL, (PetscObject *) &fe);CHKERRQ(ierr); 770 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 771 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 772 numComponents += Nc; 773 } 774 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 775 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 776 /* ierr = DMProjectFunctionLocal(dm, fe, funcs, INSERT_BC_VALUES, localX);CHKERRQ(ierr); */ 777 ierr = PetscMalloc7(numComponents,&funcVal,coordDim*Nq,&coords,coordDim*Nq,&realSpaceDer,coordDim*coordDim*Nq,&J,coordDim*coordDim*Nq,&invJ,numComponents,&interpolant,Nq,&detJ);CHKERRQ(ierr); 778 ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 779 ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 780 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 781 for (c = cStart; c < cEnd; ++c) { 782 PetscScalar *x = NULL; 783 PetscReal elemDiff = 0.0; 784 PetscInt qc = 0; 785 786 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, invJ, detJ);CHKERRQ(ierr); 787 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 788 789 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 790 PetscFE fe; 791 void * const ctx = ctxs ? ctxs[field] : NULL; 792 PetscReal *basisDer; 793 PetscInt Nb, Nc, q, fc; 794 795 ierr = DMGetField(dm, field, NULL, (PetscObject *) &fe);CHKERRQ(ierr); 796 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 797 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 798 ierr = PetscFEGetDefaultTabulation(fe, NULL, &basisDer, NULL);CHKERRQ(ierr); 799 if (debug) { 800 char title[1024]; 801 ierr = PetscSNPrintf(title, 1023, "Solution for Field %d", field);CHKERRQ(ierr); 802 ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr); 803 } 804 for (q = 0; q < Nq; ++q) { 805 if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", detJ[q], c, q); 806 ierr = (*funcs[field])(coordDim, time, &coords[q*coordDim], n, numFields, funcVal, ctx); 807 if (ierr) { 808 PetscErrorCode ierr2; 809 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2); 810 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2); 811 ierr2 = PetscFree7(funcVal,coords,realSpaceDer,J,invJ,interpolant,detJ);CHKERRQ(ierr2); 812 CHKERRQ(ierr); 813 } 814 ierr = PetscFEInterpolateGradient_Static(fe, &x[fieldOffset], coordDim, invJ, n, q, interpolant);CHKERRQ(ierr); 815 for (fc = 0; fc < Nc; ++fc) { 816 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)]; 817 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %d fieldDer %d diff %g\n", c, field, PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]);CHKERRQ(ierr);} 818 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]; 819 } 820 } 821 fieldOffset += Nb; 822 qc += Nc; 823 } 824 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 825 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %d diff %g\n", c, elemDiff);CHKERRQ(ierr);} 826 localDiff += elemDiff; 827 } 828 ierr = PetscFree7(funcVal,coords,realSpaceDer,J,invJ,interpolant,detJ);CHKERRQ(ierr); 829 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr); 830 ierr = MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr); 831 *diff = PetscSqrtReal(*diff); 832 PetscFunctionReturn(0); 833 } 834 835 PetscErrorCode DMComputeL2FieldDiff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff) 836 { 837 const PetscInt debug = ((DM_Plex*)dm->data)->printL2; 838 PetscSection section; 839 PetscQuadrature quad; 840 Vec localX; 841 PetscScalar *funcVal, *interpolant; 842 PetscReal *coords, *detJ, *J; 843 PetscReal *localDiff; 844 const PetscReal *quadPoints, *quadWeights; 845 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, cEndInterior, c, field, fieldOffset; 846 PetscErrorCode ierr; 847 848 PetscFunctionBegin; 849 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 850 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 851 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 852 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 853 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr); 854 ierr = DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);CHKERRQ(ierr); 855 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 856 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 857 for (field = 0; field < numFields; ++field) { 858 PetscObject obj; 859 PetscClassId id; 860 PetscInt Nc; 861 862 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 863 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 864 if (id == PETSCFE_CLASSID) { 865 PetscFE fe = (PetscFE) obj; 866 867 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 868 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 869 } else if (id == PETSCFV_CLASSID) { 870 PetscFV fv = (PetscFV) obj; 871 872 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr); 873 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 874 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 875 numComponents += Nc; 876 } 877 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 878 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 879 ierr = PetscCalloc6(numFields,&localDiff,numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J);CHKERRQ(ierr); 880 ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 881 ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 882 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 883 for (c = cStart; c < cEnd; ++c) { 884 PetscScalar *x = NULL; 885 PetscInt qc = 0; 886 887 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, NULL, detJ);CHKERRQ(ierr); 888 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 889 890 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 891 PetscObject obj; 892 PetscClassId id; 893 void * const ctx = ctxs ? ctxs[field] : NULL; 894 PetscInt Nb, Nc, q, fc; 895 896 PetscReal elemDiff = 0.0; 897 898 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 899 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 900 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);} 901 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;} 902 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 903 if (debug) { 904 char title[1024]; 905 ierr = PetscSNPrintf(title, 1023, "Solution for Field %d", field);CHKERRQ(ierr); 906 ierr = DMPrintCellVector(c, title, Nb*Nc, &x[fieldOffset]);CHKERRQ(ierr); 907 } 908 for (q = 0; q < Nq; ++q) { 909 if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature point %D", detJ, c, q); 910 ierr = (*funcs[field])(coordDim, time, &coords[coordDim*q], numFields, funcVal, ctx); 911 if (ierr) { 912 PetscErrorCode ierr2; 913 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2); 914 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2); 915 ierr2 = PetscFree6(localDiff,funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr2); 916 CHKERRQ(ierr); 917 } 918 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 919 else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 920 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 921 for (fc = 0; fc < Nc; ++fc) { 922 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)]; 923 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %d field %d point %g %g %g diff %g\n", c, field, coordDim > 0 ? coords[0] : 0., coordDim > 1 ? coords[1] : 0., coordDim > 2 ? coords[2] : 0., PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]);CHKERRQ(ierr);} 924 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]; 925 } 926 } 927 fieldOffset += Nb; 928 qc += Nc; 929 localDiff[field] += elemDiff; 930 } 931 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 932 } 933 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr); 934 ierr = MPIU_Allreduce(localDiff, diff, numFields, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr); 935 for (field = 0; field < numFields; ++field) diff[field] = PetscSqrtReal(diff[field]); 936 ierr = PetscFree6(localDiff,funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr); 937 PetscFunctionReturn(0); 938 } 939 940 /*@C 941 DMPlexComputeL2DiffVec - This function computes the cellwise L_2 difference between a function u and an FEM interpolant solution u_h, and stores it in a Vec. 942 943 Input Parameters: 944 + dm - The DM 945 . time - The time 946 . funcs - The functions to evaluate for each field component: NULL means that component does not contribute to error calculation 947 . ctxs - Optional array of contexts to pass to each function, or NULL. 948 - X - The coefficient vector u_h 949 950 Output Parameter: 951 . D - A Vec which holds the difference ||u - u_h||_2 for each cell 952 953 Level: developer 954 955 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff() 956 @*/ 957 PetscErrorCode DMPlexComputeL2DiffVec(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, Vec D) 958 { 959 PetscSection section; 960 PetscQuadrature quad; 961 Vec localX; 962 PetscScalar *funcVal, *interpolant; 963 PetscReal *coords, *detJ, *J; 964 const PetscReal *quadPoints, *quadWeights; 965 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, cEndInterior, c, field, fieldOffset; 966 PetscErrorCode ierr; 967 968 PetscFunctionBegin; 969 ierr = VecSet(D, 0.0);CHKERRQ(ierr); 970 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 971 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 972 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 973 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 974 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr); 975 ierr = DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);CHKERRQ(ierr); 976 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 977 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 978 for (field = 0; field < numFields; ++field) { 979 PetscObject obj; 980 PetscClassId id; 981 PetscInt Nc; 982 983 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 984 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 985 if (id == PETSCFE_CLASSID) { 986 PetscFE fe = (PetscFE) obj; 987 988 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 989 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 990 } else if (id == PETSCFV_CLASSID) { 991 PetscFV fv = (PetscFV) obj; 992 993 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr); 994 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 995 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 996 numComponents += Nc; 997 } 998 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 999 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 1000 ierr = PetscMalloc5(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J);CHKERRQ(ierr); 1001 ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 1002 ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 1003 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 1004 for (c = cStart; c < cEnd; ++c) { 1005 PetscScalar *x = NULL; 1006 PetscScalar elemDiff = 0.0; 1007 PetscInt qc = 0; 1008 1009 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, NULL, detJ);CHKERRQ(ierr); 1010 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1011 1012 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 1013 PetscObject obj; 1014 PetscClassId id; 1015 void * const ctx = ctxs ? ctxs[field] : NULL; 1016 PetscInt Nb, Nc, q, fc; 1017 1018 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1019 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1020 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);} 1021 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;} 1022 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1023 if (funcs[field]) { 1024 for (q = 0; q < Nq; ++q) { 1025 if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)detJ[q], c, q); 1026 ierr = (*funcs[field])(coordDim, time, &coords[q*coordDim], Nc, funcVal, ctx); 1027 if (ierr) { 1028 PetscErrorCode ierr2; 1029 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2); 1030 ierr2 = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr2); 1031 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2); 1032 CHKERRQ(ierr); 1033 } 1034 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 1035 else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 1036 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1037 for (fc = 0; fc < Nc; ++fc) { 1038 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)]; 1039 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]; 1040 } 1041 } 1042 } 1043 fieldOffset += Nb; 1044 qc += Nc; 1045 } 1046 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1047 ierr = VecSetValue(D, c - cStart, elemDiff, INSERT_VALUES);CHKERRQ(ierr); 1048 } 1049 ierr = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr); 1050 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr); 1051 ierr = VecSqrtAbs(D);CHKERRQ(ierr); 1052 PetscFunctionReturn(0); 1053 } 1054 1055 /*@C 1056 DMPlexComputeGradientClementInterpolant - This function computes the L2 projection of the cellwise gradient of a function u onto P1, and stores it in a Vec. 1057 1058 Input Parameters: 1059 + dm - The DM 1060 - LocX - The coefficient vector u_h 1061 1062 Output Parameter: 1063 . locC - A Vec which holds the Clement interpolant of the gradient 1064 1065 Notes: 1066 Add citation to (Clement, 1975) and definition of the interpolant 1067 \nabla u_h(v_i) = \sum_{T_i \in support(v_i)} |T_i| \nabla u_h(T_i) / \sum_{T_i \in support(v_i)} |T_i| where |T_i| is the cell volume 1068 1069 Level: developer 1070 1071 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff() 1072 @*/ 1073 PetscErrorCode DMPlexComputeGradientClementInterpolant(DM dm, Vec locX, Vec locC) 1074 { 1075 DM_Plex *mesh = (DM_Plex *) dm->data; 1076 PetscInt debug = mesh->printFEM; 1077 DM dmC; 1078 PetscSection section; 1079 PetscQuadrature quad; 1080 PetscScalar *interpolant, *gradsum; 1081 PetscReal *coords, *detJ, *J, *invJ; 1082 const PetscReal *quadPoints, *quadWeights; 1083 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, cEndInterior, vStart, vEnd, v, field, fieldOffset; 1084 PetscErrorCode ierr; 1085 1086 PetscFunctionBegin; 1087 ierr = VecGetDM(locC, &dmC);CHKERRQ(ierr); 1088 ierr = VecSet(locC, 0.0);CHKERRQ(ierr); 1089 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1090 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 1091 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 1092 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 1093 for (field = 0; field < numFields; ++field) { 1094 PetscObject obj; 1095 PetscClassId id; 1096 PetscInt Nc; 1097 1098 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1099 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1100 if (id == PETSCFE_CLASSID) { 1101 PetscFE fe = (PetscFE) obj; 1102 1103 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 1104 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1105 } else if (id == PETSCFV_CLASSID) { 1106 PetscFV fv = (PetscFV) obj; 1107 1108 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr); 1109 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 1110 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1111 numComponents += Nc; 1112 } 1113 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 1114 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 1115 ierr = PetscMalloc6(coordDim*numComponents*2,&gradsum,coordDim*numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J,coordDim*coordDim*Nq,&invJ);CHKERRQ(ierr); 1116 ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr); 1117 ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 1118 ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 1119 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 1120 for (v = vStart; v < vEnd; ++v) { 1121 PetscScalar volsum = 0.0; 1122 PetscInt *star = NULL; 1123 PetscInt starSize, st, d, fc; 1124 1125 ierr = PetscMemzero(gradsum, coordDim*numComponents * sizeof(PetscScalar));CHKERRQ(ierr); 1126 ierr = DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr); 1127 for (st = 0; st < starSize*2; st += 2) { 1128 const PetscInt cell = star[st]; 1129 PetscScalar *grad = &gradsum[coordDim*numComponents]; 1130 PetscScalar *x = NULL; 1131 PetscReal vol = 0.0; 1132 1133 if ((cell < cStart) || (cell >= cEnd)) continue; 1134 ierr = DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, J, invJ, detJ);CHKERRQ(ierr); 1135 ierr = DMPlexVecGetClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr); 1136 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 1137 PetscObject obj; 1138 PetscClassId id; 1139 PetscInt Nb, Nc, q, qc = 0; 1140 1141 ierr = PetscMemzero(grad, coordDim*numComponents * sizeof(PetscScalar));CHKERRQ(ierr); 1142 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1143 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1144 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);} 1145 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;} 1146 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1147 for (q = 0; q < Nq; ++q) { 1148 if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)detJ[q], cell, q); 1149 if (ierr) { 1150 PetscErrorCode ierr2; 1151 ierr2 = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr2); 1152 ierr2 = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr2); 1153 ierr2 = PetscFree4(interpolant,coords,detJ,J);CHKERRQ(ierr2); 1154 CHKERRQ(ierr); 1155 } 1156 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolateGradient_Static((PetscFE) obj, &x[fieldOffset], coordDim, invJ, NULL, q, interpolant);CHKERRQ(ierr);} 1157 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1158 for (fc = 0; fc < Nc; ++fc) { 1159 const PetscReal wt = quadWeights[q*qNc+qc+fc]; 1160 1161 for (d = 0; d < coordDim; ++d) grad[fc*coordDim+d] += interpolant[fc*dim+d]*wt*detJ[q]; 1162 } 1163 vol += quadWeights[q*qNc]*detJ[q]; 1164 } 1165 fieldOffset += Nb; 1166 qc += Nc; 1167 } 1168 ierr = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr); 1169 for (fc = 0; fc < numComponents; ++fc) { 1170 for (d = 0; d < coordDim; ++d) { 1171 gradsum[fc*coordDim+d] += grad[fc*coordDim+d]; 1172 } 1173 } 1174 volsum += vol; 1175 if (debug) { 1176 ierr = PetscPrintf(PETSC_COMM_SELF, "Cell %D gradient: [", cell);CHKERRQ(ierr); 1177 for (fc = 0; fc < numComponents; ++fc) { 1178 for (d = 0; d < coordDim; ++d) { 1179 if (fc || d > 0) {ierr = PetscPrintf(PETSC_COMM_SELF, ", ");CHKERRQ(ierr);} 1180 ierr = PetscPrintf(PETSC_COMM_SELF, "%g", (double)PetscRealPart(grad[fc*coordDim+d]));CHKERRQ(ierr); 1181 } 1182 } 1183 ierr = PetscPrintf(PETSC_COMM_SELF, "]\n");CHKERRQ(ierr); 1184 } 1185 } 1186 for (fc = 0; fc < numComponents; ++fc) { 1187 for (d = 0; d < coordDim; ++d) gradsum[fc*coordDim+d] /= volsum; 1188 } 1189 ierr = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr); 1190 ierr = DMPlexVecSetClosure(dmC, NULL, locC, v, gradsum, INSERT_VALUES);CHKERRQ(ierr); 1191 } 1192 ierr = PetscFree6(gradsum,interpolant,coords,detJ,J,invJ);CHKERRQ(ierr); 1193 PetscFunctionReturn(0); 1194 } 1195 1196 static PetscErrorCode DMPlexComputeIntegral_Internal(DM dm, Vec X, PetscInt cStart, PetscInt cEnd, PetscScalar *cintegral, void *user) 1197 { 1198 DM dmAux = NULL; 1199 PetscDS prob, probAux = NULL; 1200 PetscSection section, sectionAux; 1201 Vec locX, locA; 1202 PetscInt dim, numCells = cEnd - cStart, c, f; 1203 PetscBool useFVM = PETSC_FALSE; 1204 /* DS */ 1205 PetscInt Nf, totDim, *uOff, *uOff_x, numConstants; 1206 PetscInt NfAux, totDimAux, *aOff; 1207 PetscScalar *u, *a; 1208 const PetscScalar *constants; 1209 /* Geometry */ 1210 PetscFEGeom *cgeomFEM; 1211 DM dmGrad; 1212 PetscQuadrature affineQuad = NULL; 1213 Vec cellGeometryFVM = NULL, faceGeometryFVM = NULL, locGrad = NULL; 1214 PetscFVCellGeom *cgeomFVM; 1215 const PetscScalar *lgrad; 1216 PetscInt maxDegree; 1217 DMField coordField; 1218 IS cellIS; 1219 PetscErrorCode ierr; 1220 1221 PetscFunctionBegin; 1222 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 1223 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1224 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 1225 ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr); 1226 /* Determine which discretizations we have */ 1227 for (f = 0; f < Nf; ++f) { 1228 PetscObject obj; 1229 PetscClassId id; 1230 1231 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 1232 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1233 if (id == PETSCFV_CLASSID) useFVM = PETSC_TRUE; 1234 } 1235 /* Get local solution with boundary values */ 1236 ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr); 1237 ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);CHKERRQ(ierr); 1238 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr); 1239 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr); 1240 /* Read DS information */ 1241 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 1242 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr); 1243 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr); 1244 ierr = ISCreateStride(PETSC_COMM_SELF,numCells,cStart,1,&cellIS);CHKERRQ(ierr); 1245 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr); 1246 /* Read Auxiliary DS information */ 1247 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr); 1248 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 1249 if (dmAux) { 1250 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 1251 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr); 1252 ierr = DMGetSection(dmAux, §ionAux);CHKERRQ(ierr); 1253 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 1254 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr); 1255 } 1256 /* Allocate data arrays */ 1257 ierr = PetscCalloc1(numCells*totDim, &u);CHKERRQ(ierr); 1258 if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);} 1259 /* Read out geometry */ 1260 ierr = DMGetCoordinateField(dm,&coordField);CHKERRQ(ierr); 1261 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr); 1262 if (maxDegree <= 1) { 1263 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr); 1264 if (affineQuad) { 1265 ierr = DMFieldCreateFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr); 1266 } 1267 } 1268 if (useFVM) { 1269 PetscFV fv = NULL; 1270 Vec grad; 1271 PetscInt fStart, fEnd; 1272 PetscBool compGrad; 1273 1274 for (f = 0; f < Nf; ++f) { 1275 PetscObject obj; 1276 PetscClassId id; 1277 1278 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 1279 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1280 if (id == PETSCFV_CLASSID) {fv = (PetscFV) obj; break;} 1281 } 1282 ierr = PetscFVGetComputeGradients(fv, &compGrad);CHKERRQ(ierr); 1283 ierr = PetscFVSetComputeGradients(fv, PETSC_TRUE);CHKERRQ(ierr); 1284 ierr = DMPlexComputeGeometryFVM(dm, &cellGeometryFVM, &faceGeometryFVM);CHKERRQ(ierr); 1285 ierr = DMPlexComputeGradientFVM(dm, fv, faceGeometryFVM, cellGeometryFVM, &dmGrad);CHKERRQ(ierr); 1286 ierr = PetscFVSetComputeGradients(fv, compGrad);CHKERRQ(ierr); 1287 ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr); 1288 /* Reconstruct and limit cell gradients */ 1289 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 1290 ierr = DMGetGlobalVector(dmGrad, &grad);CHKERRQ(ierr); 1291 ierr = DMPlexReconstructGradients_Internal(dm, fv, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr); 1292 /* Communicate gradient values */ 1293 ierr = DMGetLocalVector(dmGrad, &locGrad);CHKERRQ(ierr); 1294 ierr = DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr); 1295 ierr = DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr); 1296 ierr = DMRestoreGlobalVector(dmGrad, &grad);CHKERRQ(ierr); 1297 /* Handle non-essential (e.g. outflow) boundary values */ 1298 ierr = DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, 0.0, faceGeometryFVM, cellGeometryFVM, locGrad);CHKERRQ(ierr); 1299 ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr); 1300 } 1301 /* Read out data from inputs */ 1302 for (c = cStart; c < cEnd; ++c) { 1303 PetscScalar *x = NULL; 1304 PetscInt i; 1305 1306 ierr = DMPlexVecGetClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr); 1307 for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i]; 1308 ierr = DMPlexVecRestoreClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr); 1309 if (dmAux) { 1310 ierr = DMPlexVecGetClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr); 1311 for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i]; 1312 ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr); 1313 } 1314 } 1315 /* Do integration for each field */ 1316 for (f = 0; f < Nf; ++f) { 1317 PetscObject obj; 1318 PetscClassId id; 1319 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset; 1320 1321 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 1322 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1323 if (id == PETSCFE_CLASSID) { 1324 PetscFE fe = (PetscFE) obj; 1325 PetscQuadrature q; 1326 PetscFEGeom *chunkGeom = NULL; 1327 PetscInt Nq, Nb; 1328 1329 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 1330 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr); 1331 ierr = PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 1332 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 1333 blockSize = Nb*Nq; 1334 batchSize = numBlocks * blockSize; 1335 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 1336 numChunks = numCells / (numBatches*batchSize); 1337 Ne = numChunks*numBatches*batchSize; 1338 Nr = numCells % (numBatches*batchSize); 1339 offset = numCells - Nr; 1340 if (!affineQuad) { 1341 ierr = DMFieldCreateFEGeom(coordField,cellIS,q,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr); 1342 } 1343 ierr = PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr); 1344 ierr = PetscFEIntegrate(fe, prob, f, Ne, chunkGeom, u, probAux, a, cintegral);CHKERRQ(ierr); 1345 ierr = PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&chunkGeom);CHKERRQ(ierr); 1346 ierr = PetscFEIntegrate(fe, prob, f, Nr, chunkGeom, &u[offset*totDim], probAux, &a[offset*totDimAux], &cintegral[offset*Nf]);CHKERRQ(ierr); 1347 ierr = PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&chunkGeom);CHKERRQ(ierr); 1348 if (!affineQuad) { 1349 ierr = PetscFEGeomDestroy(&cgeomFEM);CHKERRQ(ierr); 1350 } 1351 } else if (id == PETSCFV_CLASSID) { 1352 PetscInt foff; 1353 PetscPointFunc obj_func; 1354 PetscScalar lint; 1355 1356 ierr = PetscDSGetObjective(prob, f, &obj_func);CHKERRQ(ierr); 1357 ierr = PetscDSGetFieldOffset(prob, f, &foff);CHKERRQ(ierr); 1358 if (obj_func) { 1359 for (c = 0; c < numCells; ++c) { 1360 PetscScalar *u_x; 1361 1362 ierr = DMPlexPointLocalRead(dmGrad, c, lgrad, &u_x);CHKERRQ(ierr); 1363 obj_func(dim, Nf, NfAux, uOff, uOff_x, &u[totDim*c+foff], NULL, u_x, aOff, NULL, &a[totDimAux*c], NULL, NULL, 0.0, cgeomFVM[c].centroid, numConstants, constants, &lint); 1364 cintegral[c*Nf+f] += PetscRealPart(lint)*cgeomFVM[c].volume; 1365 } 1366 } 1367 } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", f); 1368 } 1369 /* Cleanup data arrays */ 1370 if (useFVM) { 1371 ierr = VecRestoreArrayRead(locGrad, &lgrad);CHKERRQ(ierr); 1372 ierr = VecRestoreArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr); 1373 ierr = DMRestoreLocalVector(dmGrad, &locGrad);CHKERRQ(ierr); 1374 ierr = VecDestroy(&faceGeometryFVM);CHKERRQ(ierr); 1375 ierr = VecDestroy(&cellGeometryFVM);CHKERRQ(ierr); 1376 ierr = DMDestroy(&dmGrad);CHKERRQ(ierr); 1377 } 1378 if (dmAux) {ierr = PetscFree(a);CHKERRQ(ierr);} 1379 ierr = PetscFree(u);CHKERRQ(ierr); 1380 /* Cleanup */ 1381 if (affineQuad) { 1382 ierr = PetscFEGeomDestroy(&cgeomFEM);CHKERRQ(ierr); 1383 } 1384 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr); 1385 ierr = ISDestroy(&cellIS);CHKERRQ(ierr); 1386 ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr); 1387 PetscFunctionReturn(0); 1388 } 1389 1390 /*@ 1391 DMPlexComputeIntegralFEM - Form the integral over the domain from the global input X using pointwise functions specified by the user 1392 1393 Input Parameters: 1394 + dm - The mesh 1395 . X - Global input vector 1396 - user - The user context 1397 1398 Output Parameter: 1399 . integral - Integral for each field 1400 1401 Level: developer 1402 1403 .seealso: DMPlexComputeResidualFEM() 1404 @*/ 1405 PetscErrorCode DMPlexComputeIntegralFEM(DM dm, Vec X, PetscScalar *integral, void *user) 1406 { 1407 DM_Plex *mesh = (DM_Plex *) dm->data; 1408 PetscScalar *cintegral, *lintegral; 1409 PetscInt Nf, f, cellHeight, cStart, cEnd, cEndInterior[4], cell; 1410 PetscErrorCode ierr; 1411 1412 PetscFunctionBegin; 1413 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 1414 PetscValidHeaderSpecific(X, VEC_CLASSID, 2); 1415 PetscValidPointer(integral, 3); 1416 ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 1417 ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr); 1418 ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr); 1419 ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr); 1420 ierr = DMPlexGetHybridBounds(dm, &cEndInterior[0], &cEndInterior[1], &cEndInterior[2], &cEndInterior[3]);CHKERRQ(ierr); 1421 cEnd = cEndInterior[cellHeight] < 0 ? cEnd : cEndInterior[cellHeight]; 1422 /* TODO Introduce a loop over large chunks (right now this is a single chunk) */ 1423 ierr = PetscCalloc2(Nf, &lintegral, (cEnd-cStart)*Nf, &cintegral);CHKERRQ(ierr); 1424 ierr = DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);CHKERRQ(ierr); 1425 /* Sum up values */ 1426 for (cell = cStart; cell < cEnd; ++cell) { 1427 const PetscInt c = cell - cStart; 1428 1429 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);CHKERRQ(ierr);} 1430 for (f = 0; f < Nf; ++f) lintegral[f] += cintegral[c*Nf+f]; 1431 } 1432 ierr = MPIU_Allreduce(lintegral, integral, Nf, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject) dm));CHKERRQ(ierr); 1433 if (mesh->printFEM) { 1434 ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "Integral:");CHKERRQ(ierr); 1435 for (f = 0; f < Nf; ++f) {ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), " %g", (double) PetscRealPart(integral[f]));CHKERRQ(ierr);} 1436 ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "\n");CHKERRQ(ierr); 1437 } 1438 ierr = PetscFree2(lintegral, cintegral);CHKERRQ(ierr); 1439 ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 1440 PetscFunctionReturn(0); 1441 } 1442 1443 /*@ 1444 DMPlexComputeCellwiseIntegralFEM - Form the vector of cellwise integrals F from the global input X using pointwise functions specified by the user 1445 1446 Input Parameters: 1447 + dm - The mesh 1448 . X - Global input vector 1449 - user - The user context 1450 1451 Output Parameter: 1452 . integral - Cellwise integrals for each field 1453 1454 Level: developer 1455 1456 .seealso: DMPlexComputeResidualFEM() 1457 @*/ 1458 PetscErrorCode DMPlexComputeCellwiseIntegralFEM(DM dm, Vec X, Vec F, void *user) 1459 { 1460 DM_Plex *mesh = (DM_Plex *) dm->data; 1461 DM dmF; 1462 PetscSection sectionF; 1463 PetscScalar *cintegral, *af; 1464 PetscInt Nf, f, cellHeight, cStart, cEnd, cEndInterior[4], cell; 1465 PetscErrorCode ierr; 1466 1467 PetscFunctionBegin; 1468 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 1469 PetscValidHeaderSpecific(X, VEC_CLASSID, 2); 1470 PetscValidHeaderSpecific(F, VEC_CLASSID, 3); 1471 ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 1472 ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr); 1473 ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr); 1474 ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr); 1475 ierr = DMPlexGetHybridBounds(dm, &cEndInterior[0], &cEndInterior[1], &cEndInterior[2], &cEndInterior[3]);CHKERRQ(ierr); 1476 cEnd = cEndInterior[cellHeight] < 0 ? cEnd : cEndInterior[cellHeight]; 1477 /* TODO Introduce a loop over large chunks (right now this is a single chunk) */ 1478 ierr = PetscCalloc1((cEnd-cStart)*Nf, &cintegral);CHKERRQ(ierr); 1479 ierr = DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);CHKERRQ(ierr); 1480 /* Put values in F*/ 1481 ierr = VecGetDM(F, &dmF);CHKERRQ(ierr); 1482 ierr = DMGetSection(dmF, §ionF);CHKERRQ(ierr); 1483 ierr = VecGetArray(F, &af);CHKERRQ(ierr); 1484 for (cell = cStart; cell < cEnd; ++cell) { 1485 const PetscInt c = cell - cStart; 1486 PetscInt dof, off; 1487 1488 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);CHKERRQ(ierr);} 1489 ierr = PetscSectionGetDof(sectionF, cell, &dof);CHKERRQ(ierr); 1490 ierr = PetscSectionGetOffset(sectionF, cell, &off);CHKERRQ(ierr); 1491 if (dof != Nf) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "The number of cell dofs %D != %D", dof, Nf); 1492 for (f = 0; f < Nf; ++f) af[off+f] = cintegral[c*Nf+f]; 1493 } 1494 ierr = VecRestoreArray(F, &af);CHKERRQ(ierr); 1495 ierr = PetscFree(cintegral);CHKERRQ(ierr); 1496 ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 1497 PetscFunctionReturn(0); 1498 } 1499 1500 static PetscErrorCode DMPlexComputeBdIntegral_Internal(DM dm, Vec locX, IS pointIS, 1501 void (*func)(PetscInt, PetscInt, PetscInt, 1502 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 1503 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 1504 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]), 1505 PetscScalar *fintegral, void *user) 1506 { 1507 DM plex = NULL, plexA = NULL; 1508 PetscDS prob, probAux = NULL; 1509 PetscSection section, sectionAux = NULL; 1510 Vec locA = NULL; 1511 DMField coordField; 1512 PetscInt Nf, totDim, *uOff, *uOff_x; 1513 PetscInt NfAux = 0, totDimAux = 0, *aOff = NULL; 1514 PetscScalar *u, *a = NULL; 1515 const PetscScalar *constants; 1516 PetscInt numConstants, f; 1517 PetscErrorCode ierr; 1518 1519 PetscFunctionBegin; 1520 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 1521 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr); 1522 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 1523 ierr = DMGetDefaultSection(dm, §ion);CHKERRQ(ierr); 1524 ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr); 1525 /* Determine which discretizations we have */ 1526 for (f = 0; f < Nf; ++f) { 1527 PetscObject obj; 1528 PetscClassId id; 1529 1530 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 1531 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1532 if (id == PETSCFV_CLASSID) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Not supported for FVM (field %D)", f); 1533 } 1534 /* Read DS information */ 1535 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 1536 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr); 1537 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr); 1538 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr); 1539 /* Read Auxiliary DS information */ 1540 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 1541 if (locA) { 1542 DM dmAux; 1543 1544 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 1545 ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr); 1546 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 1547 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr); 1548 ierr = DMGetDefaultSection(dmAux, §ionAux);CHKERRQ(ierr); 1549 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 1550 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr); 1551 } 1552 /* Integrate over points */ 1553 { 1554 PetscFEGeom *fgeom, *chunkGeom = NULL; 1555 PetscInt maxDegree; 1556 PetscQuadrature qGeom = NULL; 1557 const PetscInt *points; 1558 PetscInt numFaces, face, Nq, field; 1559 PetscInt numChunks, chunkSize, chunk, Nr, offset; 1560 1561 ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr); 1562 ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr); 1563 ierr = PetscCalloc2(numFaces*totDim, &u, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr); 1564 ierr = DMFieldGetDegree(coordField, pointIS, NULL, &maxDegree);CHKERRQ(ierr); 1565 for (field = 0; field < Nf; ++field) { 1566 PetscFE fe; 1567 1568 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr); 1569 if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, pointIS, &qGeom);CHKERRQ(ierr);} 1570 if (!qGeom) { 1571 ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr); 1572 ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr); 1573 } 1574 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 1575 ierr = DMPlexGetFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);CHKERRQ(ierr); 1576 for (face = 0; face < numFaces; ++face) { 1577 const PetscInt point = points[face], *support, *cone; 1578 PetscScalar *x = NULL; 1579 PetscInt i, coneSize, faceLoc; 1580 1581 ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr); 1582 ierr = DMPlexGetConeSize(dm, support[0], &coneSize);CHKERRQ(ierr); 1583 ierr = DMPlexGetCone(dm, support[0], &cone);CHKERRQ(ierr); 1584 for (faceLoc = 0; faceLoc < coneSize; ++faceLoc) if (cone[faceLoc] == point) break; 1585 if (faceLoc == coneSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Could not find face %D in cone of support[0] %D", face, support[0]); 1586 fgeom->face[face][0] = faceLoc; 1587 ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 1588 for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i]; 1589 ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 1590 if (locA) { 1591 PetscInt subp; 1592 ierr = DMPlexGetSubpoint(plexA, support[0], &subp);CHKERRQ(ierr); 1593 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 1594 for (i = 0; i < totDimAux; ++i) a[f*totDimAux+i] = x[i]; 1595 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 1596 } 1597 } 1598 /* Get blocking */ 1599 { 1600 PetscQuadrature q; 1601 PetscInt numBatches, batchSize, numBlocks, blockSize; 1602 PetscInt Nq, Nb; 1603 1604 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 1605 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr); 1606 ierr = PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 1607 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 1608 blockSize = Nb*Nq; 1609 batchSize = numBlocks * blockSize; 1610 chunkSize = numBatches*batchSize; 1611 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 1612 numChunks = numFaces / chunkSize; 1613 Nr = numFaces % chunkSize; 1614 offset = numFaces - Nr; 1615 } 1616 /* Do integration for each field */ 1617 for (chunk = 0; chunk < numChunks; ++chunk) { 1618 ierr = PetscFEGeomGetChunk(fgeom, chunk*chunkSize, (chunk+1)*chunkSize, &chunkGeom);CHKERRQ(ierr); 1619 ierr = PetscFEIntegrateBd(fe, prob, field, func, chunkSize, chunkGeom, u, probAux, a, fintegral);CHKERRQ(ierr); 1620 ierr = PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom);CHKERRQ(ierr); 1621 } 1622 ierr = PetscFEGeomGetChunk(fgeom, offset, numFaces, &chunkGeom);CHKERRQ(ierr); 1623 ierr = PetscFEIntegrateBd(fe, prob, field, func, Nr, chunkGeom, &u[offset*totDim], probAux, a ? &a[offset*totDimAux] : NULL, &fintegral[offset*Nf]);CHKERRQ(ierr); 1624 ierr = PetscFEGeomRestoreChunk(fgeom, offset, numFaces, &chunkGeom);CHKERRQ(ierr); 1625 /* Cleanup data arrays */ 1626 ierr = DMPlexRestoreFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);CHKERRQ(ierr); 1627 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 1628 ierr = PetscFree2(u, a);CHKERRQ(ierr); 1629 ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr); 1630 } 1631 } 1632 if (plex) {ierr = DMDestroy(&plex);CHKERRQ(ierr);} 1633 if (plexA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);} 1634 PetscFunctionReturn(0); 1635 } 1636 1637 /*@ 1638 DMPlexComputeBdIntegral - Form the integral over the specified boundary from the global input X using pointwise functions specified by the user 1639 1640 Input Parameters: 1641 + dm - The mesh 1642 . X - Global input vector 1643 . label - The boundary DMLabel 1644 . numVals - The number of label values to use, or PETSC_DETERMINE for all values 1645 . vals - The label values to use, or PETSC_NULL for all values 1646 . func = The function to integrate along the boundary 1647 - user - The user context 1648 1649 Output Parameter: 1650 . integral - Integral for each field 1651 1652 Level: developer 1653 1654 .seealso: DMPlexComputeIntegralFEM(), DMPlexComputeBdResidualFEM() 1655 @*/ 1656 PetscErrorCode DMPlexComputeBdIntegral(DM dm, Vec X, DMLabel label, PetscInt numVals, const PetscInt vals[], 1657 void (*func)(PetscInt, PetscInt, PetscInt, 1658 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 1659 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 1660 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]), 1661 PetscScalar *integral, void *user) 1662 { 1663 Vec locX; 1664 PetscSection section; 1665 DMLabel depthLabel; 1666 IS facetIS; 1667 PetscInt dim, Nf, f, v; 1668 PetscErrorCode ierr; 1669 1670 PetscFunctionBegin; 1671 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 1672 PetscValidHeaderSpecific(X, VEC_CLASSID, 2); 1673 PetscValidPointer(label, 3); 1674 if (vals) PetscValidPointer(vals, 5); 1675 PetscValidPointer(integral, 6); 1676 ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 1677 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 1678 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1679 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr); 1680 ierr = DMGetDefaultSection(dm, §ion);CHKERRQ(ierr); 1681 ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr); 1682 /* Get local solution with boundary values */ 1683 ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr); 1684 ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);CHKERRQ(ierr); 1685 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr); 1686 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr); 1687 /* Loop over label values */ 1688 ierr = PetscMemzero(integral, Nf * sizeof(PetscScalar));CHKERRQ(ierr); 1689 for (v = 0; v < numVals; ++v) { 1690 IS pointIS; 1691 PetscInt numFaces, face; 1692 PetscScalar *fintegral; 1693 1694 ierr = DMLabelGetStratumIS(label, vals[v], &pointIS);CHKERRQ(ierr); 1695 if (!pointIS) continue; /* No points with that id on this process */ 1696 { 1697 IS isectIS; 1698 1699 /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */ 1700 ierr = ISIntersect_Caching_Internal(facetIS, pointIS, &isectIS);CHKERRQ(ierr); 1701 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 1702 pointIS = isectIS; 1703 } 1704 ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr); 1705 ierr = PetscCalloc1(numFaces*Nf, &fintegral);CHKERRQ(ierr); 1706 ierr = DMPlexComputeBdIntegral_Internal(dm, locX, pointIS, func, fintegral, user);CHKERRQ(ierr); 1707 /* Sum point contributions into integral */ 1708 for (f = 0; f < Nf; ++f) for (face = 0; face < numFaces; ++face) integral[f] += fintegral[face*Nf+f]; 1709 ierr = PetscFree(fintegral);CHKERRQ(ierr); 1710 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 1711 } 1712 ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr); 1713 ierr = ISDestroy(&facetIS);CHKERRQ(ierr); 1714 ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 1715 PetscFunctionReturn(0); 1716 } 1717 1718 /*@ 1719 DMPlexComputeInterpolatorNested - Form the local portion of the interpolation matrix I from the coarse DM to the uniformly refined DM. 1720 1721 Input Parameters: 1722 + dmf - The fine mesh 1723 . dmc - The coarse mesh 1724 - user - The user context 1725 1726 Output Parameter: 1727 . In - The interpolation matrix 1728 1729 Level: developer 1730 1731 .seealso: DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM() 1732 @*/ 1733 PetscErrorCode DMPlexComputeInterpolatorNested(DM dmc, DM dmf, Mat In, void *user) 1734 { 1735 DM_Plex *mesh = (DM_Plex *) dmc->data; 1736 const char *name = "Interpolator"; 1737 PetscDS prob; 1738 PetscFE *feRef; 1739 PetscFV *fvRef; 1740 PetscSection fsection, fglobalSection; 1741 PetscSection csection, cglobalSection; 1742 PetscScalar *elemMat; 1743 PetscInt dim, Nf, f, fieldI, fieldJ, offsetI, offsetJ, cStart, cEnd, cEndInterior, c; 1744 PetscInt cTotDim, rTotDim = 0; 1745 PetscErrorCode ierr; 1746 1747 PetscFunctionBegin; 1748 ierr = PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 1749 ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr); 1750 ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr); 1751 ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr); 1752 ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr); 1753 ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr); 1754 ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr); 1755 ierr = DMPlexGetHeightStratum(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr); 1756 ierr = DMPlexGetHybridBounds(dmc, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 1757 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 1758 ierr = DMGetDS(dmf, &prob);CHKERRQ(ierr); 1759 ierr = PetscCalloc2(Nf,&feRef,Nf,&fvRef);CHKERRQ(ierr); 1760 for (f = 0; f < Nf; ++f) { 1761 PetscObject obj; 1762 PetscClassId id; 1763 PetscInt rNb = 0, Nc = 0; 1764 1765 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 1766 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1767 if (id == PETSCFE_CLASSID) { 1768 PetscFE fe = (PetscFE) obj; 1769 1770 ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr); 1771 ierr = PetscFEGetDimension(feRef[f], &rNb);CHKERRQ(ierr); 1772 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1773 } else if (id == PETSCFV_CLASSID) { 1774 PetscFV fv = (PetscFV) obj; 1775 PetscDualSpace Q; 1776 1777 ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr); 1778 ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr); 1779 ierr = PetscDualSpaceGetDimension(Q, &rNb);CHKERRQ(ierr); 1780 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 1781 } 1782 rTotDim += rNb; 1783 } 1784 ierr = PetscDSGetTotalDimension(prob, &cTotDim);CHKERRQ(ierr); 1785 ierr = PetscMalloc1(rTotDim*cTotDim,&elemMat);CHKERRQ(ierr); 1786 ierr = PetscMemzero(elemMat, rTotDim*cTotDim * sizeof(PetscScalar));CHKERRQ(ierr); 1787 for (fieldI = 0, offsetI = 0; fieldI < Nf; ++fieldI) { 1788 PetscDualSpace Qref; 1789 PetscQuadrature f; 1790 const PetscReal *qpoints, *qweights; 1791 PetscReal *points; 1792 PetscInt npoints = 0, Nc, Np, fpdim, i, k, p, d; 1793 1794 /* Compose points from all dual basis functionals */ 1795 if (feRef[fieldI]) { 1796 ierr = PetscFEGetDualSpace(feRef[fieldI], &Qref);CHKERRQ(ierr); 1797 ierr = PetscFEGetNumComponents(feRef[fieldI], &Nc);CHKERRQ(ierr); 1798 } else { 1799 ierr = PetscFVGetDualSpace(fvRef[fieldI], &Qref);CHKERRQ(ierr); 1800 ierr = PetscFVGetNumComponents(fvRef[fieldI], &Nc);CHKERRQ(ierr); 1801 } 1802 ierr = PetscDualSpaceGetDimension(Qref, &fpdim);CHKERRQ(ierr); 1803 for (i = 0; i < fpdim; ++i) { 1804 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr); 1805 ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, NULL, NULL);CHKERRQ(ierr); 1806 npoints += Np; 1807 } 1808 ierr = PetscMalloc1(npoints*dim,&points);CHKERRQ(ierr); 1809 for (i = 0, k = 0; i < fpdim; ++i) { 1810 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr); 1811 ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);CHKERRQ(ierr); 1812 for (p = 0; p < Np; ++p, ++k) for (d = 0; d < dim; ++d) points[k*dim+d] = qpoints[p*dim+d]; 1813 } 1814 1815 for (fieldJ = 0, offsetJ = 0; fieldJ < Nf; ++fieldJ) { 1816 PetscObject obj; 1817 PetscClassId id; 1818 PetscReal *B; 1819 PetscInt NcJ = 0, cpdim = 0, j, qNc; 1820 1821 ierr = PetscDSGetDiscretization(prob, fieldJ, &obj);CHKERRQ(ierr); 1822 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1823 if (id == PETSCFE_CLASSID) { 1824 PetscFE fe = (PetscFE) obj; 1825 1826 /* Evaluate basis at points */ 1827 ierr = PetscFEGetNumComponents(fe, &NcJ);CHKERRQ(ierr); 1828 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr); 1829 /* For now, fields only interpolate themselves */ 1830 if (fieldI == fieldJ) { 1831 if (Nc != NcJ) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in fine space field %D does not match coarse field %D", Nc, NcJ); 1832 ierr = PetscFEGetTabulation(fe, npoints, points, &B, NULL, NULL);CHKERRQ(ierr); 1833 for (i = 0, k = 0; i < fpdim; ++i) { 1834 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr); 1835 ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);CHKERRQ(ierr); 1836 if (qNc != NcJ) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in quadrature %D does not match coarse field %D", qNc, NcJ); 1837 for (p = 0; p < Np; ++p, ++k) { 1838 for (j = 0; j < cpdim; ++j) { 1839 /* 1840 cTotDim: Total columns in element interpolation matrix, sum of number of dual basis functionals in each field 1841 offsetI, offsetJ: Offsets into the larger element interpolation matrix for different fields 1842 fpdim, i, cpdim, j: Dofs for fine and coarse grids, correspond to dual space basis functionals 1843 qNC, Nc, Ncj, c: Number of components in this field 1844 Np, p: Number of quad points in the fine grid functional i 1845 k: i*Np + p, overall point number for the interpolation 1846 */ 1847 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += B[k*cpdim*NcJ+j*Nc+c]*qweights[p*qNc+c]; 1848 } 1849 } 1850 } 1851 ierr = PetscFERestoreTabulation(fe, npoints, points, &B, NULL, NULL);CHKERRQ(ierr);CHKERRQ(ierr); 1852 } 1853 } else if (id == PETSCFV_CLASSID) { 1854 PetscFV fv = (PetscFV) obj; 1855 1856 /* Evaluate constant function at points */ 1857 ierr = PetscFVGetNumComponents(fv, &NcJ);CHKERRQ(ierr); 1858 cpdim = 1; 1859 /* For now, fields only interpolate themselves */ 1860 if (fieldI == fieldJ) { 1861 if (Nc != NcJ) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in fine space field %d does not match coarse field %d", Nc, NcJ); 1862 for (i = 0, k = 0; i < fpdim; ++i) { 1863 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr); 1864 ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);CHKERRQ(ierr); 1865 if (qNc != NcJ) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in quadrature %D does not match coarse field %D", qNc, NcJ); 1866 for (p = 0; p < Np; ++p, ++k) { 1867 for (j = 0; j < cpdim; ++j) { 1868 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += 1.0*qweights[p*qNc+c]; 1869 } 1870 } 1871 } 1872 } 1873 } 1874 offsetJ += cpdim; 1875 } 1876 offsetI += fpdim; 1877 ierr = PetscFree(points);CHKERRQ(ierr); 1878 } 1879 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(0, name, rTotDim, cTotDim, elemMat);CHKERRQ(ierr);} 1880 /* Preallocate matrix */ 1881 { 1882 Mat preallocator; 1883 PetscScalar *vals; 1884 PetscInt *cellCIndices, *cellFIndices; 1885 PetscInt locRows, locCols, cell; 1886 1887 ierr = MatGetLocalSize(In, &locRows, &locCols);CHKERRQ(ierr); 1888 ierr = MatCreate(PetscObjectComm((PetscObject) In), &preallocator);CHKERRQ(ierr); 1889 ierr = MatSetType(preallocator, MATPREALLOCATOR);CHKERRQ(ierr); 1890 ierr = MatSetSizes(preallocator, locRows, locCols, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr); 1891 ierr = MatSetUp(preallocator);CHKERRQ(ierr); 1892 ierr = PetscCalloc3(rTotDim*cTotDim, &vals,cTotDim,&cellCIndices,rTotDim,&cellFIndices);CHKERRQ(ierr); 1893 for (cell = cStart; cell < cEnd; ++cell) { 1894 ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, cell, cellCIndices, cellFIndices);CHKERRQ(ierr); 1895 ierr = MatSetValues(preallocator, rTotDim, cellFIndices, cTotDim, cellCIndices, vals, INSERT_VALUES);CHKERRQ(ierr); 1896 } 1897 ierr = PetscFree3(vals,cellCIndices,cellFIndices);CHKERRQ(ierr); 1898 ierr = MatAssemblyBegin(preallocator, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1899 ierr = MatAssemblyEnd(preallocator, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1900 ierr = MatPreallocatorPreallocate(preallocator, PETSC_TRUE, In);CHKERRQ(ierr); 1901 ierr = MatDestroy(&preallocator);CHKERRQ(ierr); 1902 } 1903 /* Fill matrix */ 1904 ierr = MatZeroEntries(In);CHKERRQ(ierr); 1905 for (c = cStart; c < cEnd; ++c) { 1906 ierr = DMPlexMatSetClosureRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES);CHKERRQ(ierr); 1907 } 1908 for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);} 1909 ierr = PetscFree2(feRef,fvRef);CHKERRQ(ierr); 1910 ierr = PetscFree(elemMat);CHKERRQ(ierr); 1911 ierr = MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1912 ierr = MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1913 if (mesh->printFEM) { 1914 ierr = PetscPrintf(PETSC_COMM_WORLD, "%s:\n", name);CHKERRQ(ierr); 1915 ierr = MatChop(In, 1.0e-10);CHKERRQ(ierr); 1916 ierr = MatView(In, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); 1917 } 1918 ierr = PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 1919 PetscFunctionReturn(0); 1920 } 1921 1922 PetscErrorCode DMPlexComputeMassMatrixNested(DM dmc, DM dmf, Mat mass, void *user) 1923 { 1924 SETERRQ(PetscObjectComm((PetscObject) dmc), PETSC_ERR_SUP, "Laziness"); 1925 } 1926 1927 /*@ 1928 DMPlexComputeInterpolatorGeneral - Form the local portion of the interpolation matrix I from the coarse DM to a non-nested fine DM. 1929 1930 Input Parameters: 1931 + dmf - The fine mesh 1932 . dmc - The coarse mesh 1933 - user - The user context 1934 1935 Output Parameter: 1936 . In - The interpolation matrix 1937 1938 Level: developer 1939 1940 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM() 1941 @*/ 1942 PetscErrorCode DMPlexComputeInterpolatorGeneral(DM dmc, DM dmf, Mat In, void *user) 1943 { 1944 DM_Plex *mesh = (DM_Plex *) dmf->data; 1945 const char *name = "Interpolator"; 1946 PetscDS prob; 1947 PetscSection fsection, csection, globalFSection, globalCSection; 1948 PetscHSetIJ ht; 1949 PetscLayout rLayout; 1950 PetscInt *dnz, *onz; 1951 PetscInt locRows, rStart, rEnd; 1952 PetscReal *x, *v0, *J, *invJ, detJ; 1953 PetscReal *v0c, *Jc, *invJc, detJc; 1954 PetscScalar *elemMat; 1955 PetscInt dim, Nf, field, totDim, cStart, cEnd, cell, ccell; 1956 PetscErrorCode ierr; 1957 1958 PetscFunctionBegin; 1959 ierr = PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 1960 ierr = DMGetCoordinateDim(dmc, &dim);CHKERRQ(ierr); 1961 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr); 1962 ierr = PetscDSGetRefCoordArrays(prob, &x, NULL);CHKERRQ(ierr); 1963 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 1964 ierr = PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);CHKERRQ(ierr); 1965 ierr = PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);CHKERRQ(ierr); 1966 ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr); 1967 ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr); 1968 ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr); 1969 ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr); 1970 ierr = DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);CHKERRQ(ierr); 1971 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 1972 ierr = PetscMalloc1(totDim, &elemMat);CHKERRQ(ierr); 1973 1974 ierr = MatGetLocalSize(In, &locRows, NULL);CHKERRQ(ierr); 1975 ierr = PetscLayoutCreate(PetscObjectComm((PetscObject) In), &rLayout);CHKERRQ(ierr); 1976 ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr); 1977 ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr); 1978 ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr); 1979 ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr); 1980 ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr); 1981 ierr = PetscCalloc2(locRows,&dnz,locRows,&onz);CHKERRQ(ierr); 1982 ierr = PetscHSetIJCreate(&ht);CHKERRQ(ierr); 1983 for (field = 0; field < Nf; ++field) { 1984 PetscObject obj; 1985 PetscClassId id; 1986 PetscDualSpace Q = NULL; 1987 PetscQuadrature f; 1988 const PetscReal *qpoints; 1989 PetscInt Nc, Np, fpdim, i, d; 1990 1991 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 1992 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1993 if (id == PETSCFE_CLASSID) { 1994 PetscFE fe = (PetscFE) obj; 1995 1996 ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr); 1997 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1998 } else if (id == PETSCFV_CLASSID) { 1999 PetscFV fv = (PetscFV) obj; 2000 2001 ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr); 2002 Nc = 1; 2003 } 2004 ierr = PetscDualSpaceGetDimension(Q, &fpdim);CHKERRQ(ierr); 2005 /* For each fine grid cell */ 2006 for (cell = cStart; cell < cEnd; ++cell) { 2007 PetscInt *findices, *cindices; 2008 PetscInt numFIndices, numCIndices; 2009 2010 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2011 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr); 2012 if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %d != %d dual basis vecs", numFIndices, fpdim); 2013 for (i = 0; i < fpdim; ++i) { 2014 Vec pointVec; 2015 PetscScalar *pV; 2016 PetscSF coarseCellSF = NULL; 2017 const PetscSFNode *coarseCells; 2018 PetscInt numCoarseCells, q, c; 2019 2020 /* Get points from the dual basis functional quadrature */ 2021 ierr = PetscDualSpaceGetFunctional(Q, i, &f);CHKERRQ(ierr); 2022 ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);CHKERRQ(ierr); 2023 ierr = VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);CHKERRQ(ierr); 2024 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr); 2025 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2026 for (q = 0; q < Np; ++q) { 2027 const PetscReal xi0[3] = {-1., -1., -1.}; 2028 2029 /* Transform point to real space */ 2030 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x); 2031 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d]; 2032 } 2033 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2034 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */ 2035 /* OPT: Pack all quad points from fine cell */ 2036 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr); 2037 ierr = PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");CHKERRQ(ierr); 2038 /* Update preallocation info */ 2039 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr); 2040 if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located"); 2041 { 2042 PetscHashIJKey key; 2043 PetscBool missing; 2044 2045 key.i = findices[i]; 2046 if (key.i >= 0) { 2047 /* Get indices for coarse elements */ 2048 for (ccell = 0; ccell < numCoarseCells; ++ccell) { 2049 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2050 for (c = 0; c < numCIndices; ++c) { 2051 key.j = cindices[c]; 2052 if (key.j < 0) continue; 2053 ierr = PetscHSetIJQueryAdd(ht, key, &missing);CHKERRQ(ierr); 2054 if (missing) { 2055 if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart]; 2056 else ++onz[key.i-rStart]; 2057 } 2058 } 2059 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2060 } 2061 } 2062 } 2063 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 2064 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 2065 } 2066 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2067 } 2068 } 2069 ierr = PetscHSetIJDestroy(&ht);CHKERRQ(ierr); 2070 ierr = MatXAIJSetPreallocation(In, 1, dnz, onz, NULL, NULL);CHKERRQ(ierr); 2071 ierr = MatSetOption(In, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 2072 ierr = PetscFree2(dnz,onz);CHKERRQ(ierr); 2073 for (field = 0; field < Nf; ++field) { 2074 PetscObject obj; 2075 PetscClassId id; 2076 PetscDualSpace Q = NULL; 2077 PetscQuadrature f; 2078 const PetscReal *qpoints, *qweights; 2079 PetscInt Nc, qNc, Np, fpdim, i, d; 2080 2081 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 2082 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2083 if (id == PETSCFE_CLASSID) { 2084 PetscFE fe = (PetscFE) obj; 2085 2086 ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr); 2087 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 2088 } else if (id == PETSCFV_CLASSID) { 2089 PetscFV fv = (PetscFV) obj; 2090 2091 ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr); 2092 Nc = 1; 2093 } else SETERRQ1(PetscObjectComm((PetscObject)dmc),PETSC_ERR_ARG_WRONG,"Unknown discretization type for field %d",field); 2094 ierr = PetscDualSpaceGetDimension(Q, &fpdim);CHKERRQ(ierr); 2095 /* For each fine grid cell */ 2096 for (cell = cStart; cell < cEnd; ++cell) { 2097 PetscInt *findices, *cindices; 2098 PetscInt numFIndices, numCIndices; 2099 2100 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2101 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr); 2102 if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %d != %d dual basis vecs", numFIndices, fpdim); 2103 for (i = 0; i < fpdim; ++i) { 2104 Vec pointVec; 2105 PetscScalar *pV; 2106 PetscSF coarseCellSF = NULL; 2107 const PetscSFNode *coarseCells; 2108 PetscInt numCoarseCells, cpdim, q, c, j; 2109 2110 /* Get points from the dual basis functional quadrature */ 2111 ierr = PetscDualSpaceGetFunctional(Q, i, &f);CHKERRQ(ierr); 2112 ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, &qpoints, &qweights);CHKERRQ(ierr); 2113 if (qNc != Nc) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in quadrature %D does not match coarse field %D", qNc, Nc); 2114 ierr = VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);CHKERRQ(ierr); 2115 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr); 2116 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2117 for (q = 0; q < Np; ++q) { 2118 const PetscReal xi0[3] = {-1., -1., -1.}; 2119 2120 /* Transform point to real space */ 2121 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x); 2122 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d]; 2123 } 2124 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2125 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */ 2126 /* OPT: Read this out from preallocation information */ 2127 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr); 2128 /* Update preallocation info */ 2129 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr); 2130 if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located"); 2131 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2132 for (ccell = 0; ccell < numCoarseCells; ++ccell) { 2133 PetscReal pVReal[3]; 2134 const PetscReal xi0[3] = {-1., -1., -1.}; 2135 2136 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2137 /* Transform points from real space to coarse reference space */ 2138 ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr); 2139 for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]); 2140 CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x); 2141 2142 if (id == PETSCFE_CLASSID) { 2143 PetscFE fe = (PetscFE) obj; 2144 PetscReal *B; 2145 2146 /* Evaluate coarse basis on contained point */ 2147 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr); 2148 ierr = PetscFEGetTabulation(fe, 1, x, &B, NULL, NULL);CHKERRQ(ierr); 2149 ierr = PetscMemzero(elemMat, cpdim * sizeof(PetscScalar));CHKERRQ(ierr); 2150 /* Get elemMat entries by multiplying by weight */ 2151 for (j = 0; j < cpdim; ++j) { 2152 for (c = 0; c < Nc; ++c) elemMat[j] += B[j*Nc + c]*qweights[ccell*qNc + c]; 2153 } 2154 ierr = PetscFERestoreTabulation(fe, 1, x, &B, NULL, NULL);CHKERRQ(ierr);CHKERRQ(ierr); 2155 } else { 2156 cpdim = 1; 2157 for (j = 0; j < cpdim; ++j) { 2158 for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*qweights[ccell*qNc + c]; 2159 } 2160 } 2161 /* Update interpolator */ 2162 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);} 2163 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim); 2164 ierr = MatSetValues(In, 1, &findices[i], numCIndices, cindices, elemMat, INSERT_VALUES);CHKERRQ(ierr); 2165 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2166 } 2167 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2168 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 2169 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 2170 } 2171 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2172 } 2173 } 2174 ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr); 2175 ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr); 2176 ierr = PetscFree(elemMat);CHKERRQ(ierr); 2177 ierr = MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2178 ierr = MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2179 ierr = PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 2180 PetscFunctionReturn(0); 2181 } 2182 2183 /*@ 2184 DMPlexComputeMassMatrixGeneral - Form the local portion of the mass matrix M from the coarse DM to a non-nested fine DM. 2185 2186 Input Parameters: 2187 + dmf - The fine mesh 2188 . dmc - The coarse mesh 2189 - user - The user context 2190 2191 Output Parameter: 2192 . mass - The mass matrix 2193 2194 Level: developer 2195 2196 .seealso: DMPlexComputeMassMatrixNested(), DMPlexComputeInterpolatorNested(), DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM() 2197 @*/ 2198 PetscErrorCode DMPlexComputeMassMatrixGeneral(DM dmc, DM dmf, Mat mass, void *user) 2199 { 2200 DM_Plex *mesh = (DM_Plex *) dmf->data; 2201 const char *name = "Mass Matrix"; 2202 PetscDS prob; 2203 PetscSection fsection, csection, globalFSection, globalCSection; 2204 PetscHSetIJ ht; 2205 PetscLayout rLayout; 2206 PetscInt *dnz, *onz; 2207 PetscInt locRows, rStart, rEnd; 2208 PetscReal *x, *v0, *J, *invJ, detJ; 2209 PetscReal *v0c, *Jc, *invJc, detJc; 2210 PetscScalar *elemMat; 2211 PetscInt dim, Nf, field, totDim, cStart, cEnd, cell, ccell; 2212 PetscErrorCode ierr; 2213 2214 PetscFunctionBegin; 2215 ierr = DMGetCoordinateDim(dmc, &dim);CHKERRQ(ierr); 2216 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr); 2217 ierr = PetscDSGetRefCoordArrays(prob, &x, NULL);CHKERRQ(ierr); 2218 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 2219 ierr = PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);CHKERRQ(ierr); 2220 ierr = PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);CHKERRQ(ierr); 2221 ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr); 2222 ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr); 2223 ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr); 2224 ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr); 2225 ierr = DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);CHKERRQ(ierr); 2226 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 2227 ierr = PetscMalloc1(totDim, &elemMat);CHKERRQ(ierr); 2228 2229 ierr = MatGetLocalSize(mass, &locRows, NULL);CHKERRQ(ierr); 2230 ierr = PetscLayoutCreate(PetscObjectComm((PetscObject) mass), &rLayout);CHKERRQ(ierr); 2231 ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr); 2232 ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr); 2233 ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr); 2234 ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr); 2235 ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr); 2236 ierr = PetscCalloc2(locRows,&dnz,locRows,&onz);CHKERRQ(ierr); 2237 ierr = PetscHSetIJCreate(&ht);CHKERRQ(ierr); 2238 for (field = 0; field < Nf; ++field) { 2239 PetscObject obj; 2240 PetscClassId id; 2241 PetscQuadrature quad; 2242 const PetscReal *qpoints; 2243 PetscInt Nq, Nc, i, d; 2244 2245 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 2246 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2247 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetQuadrature((PetscFE) obj, &quad);CHKERRQ(ierr);} 2248 else {ierr = PetscFVGetQuadrature((PetscFV) obj, &quad);CHKERRQ(ierr);} 2249 ierr = PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, NULL);CHKERRQ(ierr); 2250 /* For each fine grid cell */ 2251 for (cell = cStart; cell < cEnd; ++cell) { 2252 Vec pointVec; 2253 PetscScalar *pV; 2254 PetscSF coarseCellSF = NULL; 2255 const PetscSFNode *coarseCells; 2256 PetscInt numCoarseCells, q, c; 2257 PetscInt *findices, *cindices; 2258 PetscInt numFIndices, numCIndices; 2259 2260 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2261 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr); 2262 /* Get points from the quadrature */ 2263 ierr = VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);CHKERRQ(ierr); 2264 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr); 2265 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2266 for (q = 0; q < Nq; ++q) { 2267 const PetscReal xi0[3] = {-1., -1., -1.}; 2268 2269 /* Transform point to real space */ 2270 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x); 2271 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d]; 2272 } 2273 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2274 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */ 2275 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr); 2276 ierr = PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");CHKERRQ(ierr); 2277 /* Update preallocation info */ 2278 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr); 2279 if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located"); 2280 { 2281 PetscHashIJKey key; 2282 PetscBool missing; 2283 2284 for (i = 0; i < numFIndices; ++i) { 2285 key.i = findices[i]; 2286 if (key.i >= 0) { 2287 /* Get indices for coarse elements */ 2288 for (ccell = 0; ccell < numCoarseCells; ++ccell) { 2289 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2290 for (c = 0; c < numCIndices; ++c) { 2291 key.j = cindices[c]; 2292 if (key.j < 0) continue; 2293 ierr = PetscHSetIJQueryAdd(ht, key, &missing);CHKERRQ(ierr); 2294 if (missing) { 2295 if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart]; 2296 else ++onz[key.i-rStart]; 2297 } 2298 } 2299 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2300 } 2301 } 2302 } 2303 } 2304 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 2305 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 2306 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2307 } 2308 } 2309 ierr = PetscHSetIJDestroy(&ht);CHKERRQ(ierr); 2310 ierr = MatXAIJSetPreallocation(mass, 1, dnz, onz, NULL, NULL);CHKERRQ(ierr); 2311 ierr = MatSetOption(mass, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 2312 ierr = PetscFree2(dnz,onz);CHKERRQ(ierr); 2313 for (field = 0; field < Nf; ++field) { 2314 PetscObject obj; 2315 PetscClassId id; 2316 PetscQuadrature quad; 2317 PetscReal *Bfine; 2318 const PetscReal *qpoints, *qweights; 2319 PetscInt Nq, Nc, i, d; 2320 2321 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 2322 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2323 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetQuadrature((PetscFE) obj, &quad);CHKERRQ(ierr);ierr = PetscFEGetDefaultTabulation((PetscFE) obj, &Bfine, NULL, NULL);CHKERRQ(ierr);} 2324 else {ierr = PetscFVGetQuadrature((PetscFV) obj, &quad);CHKERRQ(ierr);} 2325 ierr = PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, &qweights);CHKERRQ(ierr); 2326 /* For each fine grid cell */ 2327 for (cell = cStart; cell < cEnd; ++cell) { 2328 Vec pointVec; 2329 PetscScalar *pV; 2330 PetscSF coarseCellSF = NULL; 2331 const PetscSFNode *coarseCells; 2332 PetscInt numCoarseCells, cpdim, q, c, j; 2333 PetscInt *findices, *cindices; 2334 PetscInt numFIndices, numCIndices; 2335 2336 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2337 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr); 2338 /* Get points from the quadrature */ 2339 ierr = VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);CHKERRQ(ierr); 2340 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr); 2341 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2342 for (q = 0; q < Nq; ++q) { 2343 const PetscReal xi0[3] = {-1., -1., -1.}; 2344 2345 /* Transform point to real space */ 2346 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x); 2347 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d]; 2348 } 2349 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2350 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */ 2351 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr); 2352 /* Update matrix */ 2353 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr); 2354 if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located"); 2355 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2356 for (ccell = 0; ccell < numCoarseCells; ++ccell) { 2357 PetscReal pVReal[3]; 2358 const PetscReal xi0[3] = {-1., -1., -1.}; 2359 2360 2361 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2362 /* Transform points from real space to coarse reference space */ 2363 ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr); 2364 for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]); 2365 CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x); 2366 2367 if (id == PETSCFE_CLASSID) { 2368 PetscFE fe = (PetscFE) obj; 2369 PetscReal *B; 2370 2371 /* Evaluate coarse basis on contained point */ 2372 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr); 2373 ierr = PetscFEGetTabulation(fe, 1, x, &B, NULL, NULL);CHKERRQ(ierr); 2374 /* Get elemMat entries by multiplying by weight */ 2375 for (i = 0; i < numFIndices; ++i) { 2376 ierr = PetscMemzero(elemMat, cpdim * sizeof(PetscScalar));CHKERRQ(ierr); 2377 for (j = 0; j < cpdim; ++j) { 2378 for (c = 0; c < Nc; ++c) elemMat[j] += B[j*Nc + c]*Bfine[(ccell*numFIndices + i)*Nc + c]*qweights[ccell*Nc + c]*detJ; 2379 } 2380 /* Update interpolator */ 2381 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);} 2382 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim); 2383 ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr); 2384 } 2385 ierr = PetscFERestoreTabulation(fe, 1, x, &B, NULL, NULL);CHKERRQ(ierr);CHKERRQ(ierr); 2386 } else { 2387 cpdim = 1; 2388 for (i = 0; i < numFIndices; ++i) { 2389 ierr = PetscMemzero(elemMat, cpdim * sizeof(PetscScalar));CHKERRQ(ierr); 2390 for (j = 0; j < cpdim; ++j) { 2391 for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*1.0*qweights[ccell*Nc + c]*detJ; 2392 } 2393 /* Update interpolator */ 2394 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);} 2395 ierr = PetscPrintf(PETSC_COMM_SELF, "Nq: %d %d Nf: %d %d Nc: %d %d\n", ccell, Nq, i, numFIndices, j, numCIndices);CHKERRQ(ierr); 2396 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim); 2397 ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr); 2398 } 2399 } 2400 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2401 } 2402 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2403 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 2404 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 2405 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2406 } 2407 } 2408 ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr); 2409 ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr); 2410 ierr = PetscFree(elemMat);CHKERRQ(ierr); 2411 ierr = MatAssemblyBegin(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2412 ierr = MatAssemblyEnd(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2413 PetscFunctionReturn(0); 2414 } 2415 2416 /*@ 2417 DMPlexComputeInjectorFEM - Compute a mapping from coarse unknowns to fine unknowns 2418 2419 Input Parameters: 2420 + dmc - The coarse mesh 2421 - dmf - The fine mesh 2422 - user - The user context 2423 2424 Output Parameter: 2425 . sc - The mapping 2426 2427 Level: developer 2428 2429 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM() 2430 @*/ 2431 PetscErrorCode DMPlexComputeInjectorFEM(DM dmc, DM dmf, VecScatter *sc, void *user) 2432 { 2433 PetscDS prob; 2434 PetscFE *feRef; 2435 PetscFV *fvRef; 2436 Vec fv, cv; 2437 IS fis, cis; 2438 PetscSection fsection, fglobalSection, csection, cglobalSection; 2439 PetscInt *cmap, *cellCIndices, *cellFIndices, *cindices, *findices; 2440 PetscInt cTotDim, fTotDim = 0, Nf, f, field, cStart, cEnd, cEndInterior, c, dim, d, startC, endC, offsetC, offsetF, m; 2441 PetscBool *needAvg; 2442 PetscErrorCode ierr; 2443 2444 PetscFunctionBegin; 2445 ierr = PetscLogEventBegin(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 2446 ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr); 2447 ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr); 2448 ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr); 2449 ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr); 2450 ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr); 2451 ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr); 2452 ierr = DMPlexGetHeightStratum(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr); 2453 ierr = DMPlexGetHybridBounds(dmc, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 2454 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 2455 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr); 2456 ierr = PetscCalloc3(Nf,&feRef,Nf,&fvRef,Nf,&needAvg);CHKERRQ(ierr); 2457 for (f = 0; f < Nf; ++f) { 2458 PetscObject obj; 2459 PetscClassId id; 2460 PetscInt fNb = 0, Nc = 0; 2461 2462 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 2463 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2464 if (id == PETSCFE_CLASSID) { 2465 PetscFE fe = (PetscFE) obj; 2466 PetscSpace sp; 2467 PetscInt maxDegree; 2468 2469 ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr); 2470 ierr = PetscFEGetDimension(feRef[f], &fNb);CHKERRQ(ierr); 2471 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 2472 ierr = PetscFEGetBasisSpace(fe, &sp);CHKERRQ(ierr); 2473 ierr = PetscSpaceGetDegree(sp, NULL, &maxDegree);CHKERRQ(ierr); 2474 if (!maxDegree) needAvg[f] = PETSC_TRUE; 2475 } else if (id == PETSCFV_CLASSID) { 2476 PetscFV fv = (PetscFV) obj; 2477 PetscDualSpace Q; 2478 2479 ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr); 2480 ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr); 2481 ierr = PetscDualSpaceGetDimension(Q, &fNb);CHKERRQ(ierr); 2482 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 2483 needAvg[f] = PETSC_TRUE; 2484 } 2485 fTotDim += fNb; 2486 } 2487 ierr = PetscDSGetTotalDimension(prob, &cTotDim);CHKERRQ(ierr); 2488 ierr = PetscMalloc1(cTotDim,&cmap);CHKERRQ(ierr); 2489 for (field = 0, offsetC = 0, offsetF = 0; field < Nf; ++field) { 2490 PetscFE feC; 2491 PetscFV fvC; 2492 PetscDualSpace QF, QC; 2493 PetscInt order = -1, NcF, NcC, fpdim, cpdim; 2494 2495 if (feRef[field]) { 2496 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &feC);CHKERRQ(ierr); 2497 ierr = PetscFEGetNumComponents(feC, &NcC);CHKERRQ(ierr); 2498 ierr = PetscFEGetNumComponents(feRef[field], &NcF);CHKERRQ(ierr); 2499 ierr = PetscFEGetDualSpace(feRef[field], &QF);CHKERRQ(ierr); 2500 ierr = PetscDualSpaceGetOrder(QF, &order);CHKERRQ(ierr); 2501 ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr); 2502 ierr = PetscFEGetDualSpace(feC, &QC);CHKERRQ(ierr); 2503 ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr); 2504 } else { 2505 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fvC);CHKERRQ(ierr); 2506 ierr = PetscFVGetNumComponents(fvC, &NcC);CHKERRQ(ierr); 2507 ierr = PetscFVGetNumComponents(fvRef[field], &NcF);CHKERRQ(ierr); 2508 ierr = PetscFVGetDualSpace(fvRef[field], &QF);CHKERRQ(ierr); 2509 ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr); 2510 ierr = PetscFVGetDualSpace(fvC, &QC);CHKERRQ(ierr); 2511 ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr); 2512 } 2513 if (NcF != NcC) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in fine space field %d does not match coarse field %d", NcF, NcC); 2514 for (c = 0; c < cpdim; ++c) { 2515 PetscQuadrature cfunc; 2516 const PetscReal *cqpoints, *cqweights; 2517 PetscInt NqcC, NpC; 2518 PetscBool found = PETSC_FALSE; 2519 2520 ierr = PetscDualSpaceGetFunctional(QC, c, &cfunc);CHKERRQ(ierr); 2521 ierr = PetscQuadratureGetData(cfunc, NULL, &NqcC, &NpC, &cqpoints, &cqweights);CHKERRQ(ierr); 2522 if (NqcC != NcC) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components", NqcC, NcC); 2523 if (NpC != 1 && feRef[field]) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Do not know how to do injection for moments"); 2524 for (f = 0; f < fpdim; ++f) { 2525 PetscQuadrature ffunc; 2526 const PetscReal *fqpoints, *fqweights; 2527 PetscReal sum = 0.0; 2528 PetscInt NqcF, NpF; 2529 2530 ierr = PetscDualSpaceGetFunctional(QF, f, &ffunc);CHKERRQ(ierr); 2531 ierr = PetscQuadratureGetData(ffunc, NULL, &NqcF, &NpF, &fqpoints, &fqweights);CHKERRQ(ierr); 2532 if (NqcF != NcF) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components", NqcF, NcF); 2533 if (NpC != NpF) continue; 2534 for (d = 0; d < dim; ++d) sum += PetscAbsReal(cqpoints[d] - fqpoints[d]); 2535 if (sum > 1.0e-9) continue; 2536 for (d = 0; d < NcC; ++d) sum += PetscAbsReal(cqweights[d]*fqweights[d]); 2537 if (sum < 1.0e-9) continue; 2538 cmap[offsetC+c] = offsetF+f; 2539 found = PETSC_TRUE; 2540 break; 2541 } 2542 if (!found) { 2543 /* TODO We really want the average here, but some asshole put VecScatter in the interface */ 2544 if (fvRef[field] || (feRef[field] && order == 0)) { 2545 cmap[offsetC+c] = offsetF+0; 2546 } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not locate matching functional for injection"); 2547 } 2548 } 2549 offsetC += cpdim; 2550 offsetF += fpdim; 2551 } 2552 for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);ierr = PetscFVDestroy(&fvRef[f]);CHKERRQ(ierr);} 2553 ierr = PetscFree3(feRef,fvRef,needAvg);CHKERRQ(ierr); 2554 2555 ierr = DMGetGlobalVector(dmf, &fv);CHKERRQ(ierr); 2556 ierr = DMGetGlobalVector(dmc, &cv);CHKERRQ(ierr); 2557 ierr = VecGetOwnershipRange(cv, &startC, &endC);CHKERRQ(ierr); 2558 ierr = PetscSectionGetConstrainedStorageSize(cglobalSection, &m);CHKERRQ(ierr); 2559 ierr = PetscMalloc2(cTotDim,&cellCIndices,fTotDim,&cellFIndices);CHKERRQ(ierr); 2560 ierr = PetscMalloc1(m,&cindices);CHKERRQ(ierr); 2561 ierr = PetscMalloc1(m,&findices);CHKERRQ(ierr); 2562 for (d = 0; d < m; ++d) cindices[d] = findices[d] = -1; 2563 for (c = cStart; c < cEnd; ++c) { 2564 ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, c, cellCIndices, cellFIndices);CHKERRQ(ierr); 2565 for (d = 0; d < cTotDim; ++d) { 2566 if ((cellCIndices[d] < startC) || (cellCIndices[d] >= endC)) continue; 2567 if ((findices[cellCIndices[d]-startC] >= 0) && (findices[cellCIndices[d]-startC] != cellFIndices[cmap[d]])) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Coarse dof %d maps to both %d and %d", cindices[cellCIndices[d]-startC], findices[cellCIndices[d]-startC], cellFIndices[cmap[d]]); 2568 cindices[cellCIndices[d]-startC] = cellCIndices[d]; 2569 findices[cellCIndices[d]-startC] = cellFIndices[cmap[d]]; 2570 } 2571 } 2572 ierr = PetscFree(cmap);CHKERRQ(ierr); 2573 ierr = PetscFree2(cellCIndices,cellFIndices);CHKERRQ(ierr); 2574 2575 ierr = ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis);CHKERRQ(ierr); 2576 ierr = ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis);CHKERRQ(ierr); 2577 ierr = VecScatterCreateWithData(cv, cis, fv, fis, sc);CHKERRQ(ierr); 2578 ierr = ISDestroy(&cis);CHKERRQ(ierr); 2579 ierr = ISDestroy(&fis);CHKERRQ(ierr); 2580 ierr = DMRestoreGlobalVector(dmf, &fv);CHKERRQ(ierr); 2581 ierr = DMRestoreGlobalVector(dmc, &cv);CHKERRQ(ierr); 2582 ierr = PetscLogEventEnd(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 2583 PetscFunctionReturn(0); 2584 } 2585 2586 PetscErrorCode DMSNESGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom) 2587 { 2588 char composeStr[33] = {0}; 2589 PetscObjectId id; 2590 PetscContainer container; 2591 PetscErrorCode ierr; 2592 2593 PetscFunctionBegin; 2594 ierr = PetscObjectGetId((PetscObject)quad,&id);CHKERRQ(ierr); 2595 ierr = PetscSNPrintf(composeStr, 32, "DMSNESGetFEGeom_%x\n", id);CHKERRQ(ierr); 2596 ierr = PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);CHKERRQ(ierr); 2597 if (container) { 2598 ierr = PetscContainerGetPointer(container, (void **) geom);CHKERRQ(ierr); 2599 } else { 2600 ierr = DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);CHKERRQ(ierr); 2601 ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr); 2602 ierr = PetscContainerSetPointer(container, (void *) *geom);CHKERRQ(ierr); 2603 ierr = PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);CHKERRQ(ierr); 2604 ierr = PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);CHKERRQ(ierr); 2605 ierr = PetscContainerDestroy(&container);CHKERRQ(ierr); 2606 } 2607 PetscFunctionReturn(0); 2608 } 2609 2610 PetscErrorCode DMSNESRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom) 2611 { 2612 PetscFunctionBegin; 2613 *geom = NULL; 2614 PetscFunctionReturn(0); 2615 } 2616 2617 /* 2618 We always assemble JacP, and if the matrix is different from Jac and two different sets of point functions are provided, we also assemble Jac 2619 2620 X - The local solution vector 2621 X_t - The local solution time derviative vector, or NULL 2622 */ 2623 PetscErrorCode DMPlexComputeJacobian_Patch_Internal(DM dm, PetscSection section, PetscSection globalSection, IS cellIS, 2624 PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP, void *ctx) 2625 { 2626 DM_Plex *mesh = (DM_Plex *) dm->data; 2627 const char *name = "Jacobian", *nameP = "JacobianPre"; 2628 DM dmAux = NULL; 2629 PetscDS prob, probAux = NULL; 2630 PetscSection sectionAux = NULL; 2631 Vec A; 2632 DMField coordField; 2633 PetscFEGeom *cgeomFEM; 2634 PetscQuadrature qGeom = NULL; 2635 Mat J = Jac, JP = JacP; 2636 PetscScalar *work, *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL, *elemMatP = NULL, *elemMatD = NULL; 2637 PetscBool hasJac, hasPrec, hasDyn, assembleJac, isMatIS, isMatISP, *isFE, hasFV = PETSC_FALSE; 2638 const PetscInt *cells; 2639 PetscInt Nf, fieldI, fieldJ, maxDegree, numCells, cStart, cEnd, numChunks, chunkSize, chunk, totDim, totDimAux = 0, sz, wsz, off = 0, offCell = 0; 2640 PetscErrorCode ierr; 2641 2642 PetscFunctionBegin; 2643 CHKMEMQ; 2644 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr); 2645 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 2646 ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 2647 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 2648 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr); 2649 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr); 2650 if (dmAux) { 2651 ierr = DMGetDefaultSection(dmAux, §ionAux);CHKERRQ(ierr); 2652 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 2653 } 2654 /* Get flags */ 2655 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 2656 ierr = DMGetWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr); 2657 for (fieldI = 0; fieldI < Nf; ++fieldI) { 2658 PetscObject disc; 2659 PetscClassId id; 2660 ierr = PetscDSGetDiscretization(prob, fieldI, &disc);CHKERRQ(ierr); 2661 ierr = PetscObjectGetClassId(disc, &id);CHKERRQ(ierr); 2662 if (id == PETSCFE_CLASSID) {isFE[fieldI] = PETSC_TRUE;} 2663 else if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; isFE[fieldI] = PETSC_FALSE;} 2664 } 2665 ierr = PetscDSHasJacobian(prob, &hasJac);CHKERRQ(ierr); 2666 ierr = PetscDSHasJacobianPreconditioner(prob, &hasPrec);CHKERRQ(ierr); 2667 ierr = PetscDSHasDynamicJacobian(prob, &hasDyn);CHKERRQ(ierr); 2668 assembleJac = hasJac && hasPrec && (Jac != JacP) ? PETSC_TRUE : PETSC_FALSE; 2669 hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE; 2670 ierr = PetscObjectTypeCompare((PetscObject) Jac, MATIS, &isMatIS);CHKERRQ(ierr); 2671 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr); 2672 /* Setup input data and temp arrays (should be DMGetWorkArray) */ 2673 if (isMatISP || isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &globalSection);CHKERRQ(ierr);} 2674 if (isMatIS) {ierr = MatISGetLocalMat(Jac, &J);CHKERRQ(ierr);} 2675 if (isMatISP) {ierr = MatISGetLocalMat(JacP, &JP);CHKERRQ(ierr);} 2676 if (hasFV) {ierr = MatSetOption(JP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE);CHKERRQ(ierr);} /* No allocated space for FV stuff, so ignore the zero entries */ 2677 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr); 2678 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr); 2679 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 2680 if (probAux) {ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);} 2681 CHKMEMQ; 2682 /* Compute batch sizes */ 2683 if (isFE[0]) { 2684 PetscFE fe; 2685 PetscQuadrature q; 2686 PetscInt numQuadPoints, numBatches, batchSize, numBlocks, blockSize, Nb; 2687 2688 ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr); 2689 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr); 2690 ierr = PetscQuadratureGetData(q, NULL, NULL, &numQuadPoints, NULL, NULL);CHKERRQ(ierr); 2691 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 2692 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 2693 blockSize = Nb*numQuadPoints; 2694 batchSize = numBlocks * blockSize; 2695 chunkSize = numBatches * batchSize; 2696 numChunks = numCells / chunkSize + numCells % chunkSize; 2697 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 2698 } else { 2699 chunkSize = numCells; 2700 numChunks = 1; 2701 } 2702 /* Get work space */ 2703 wsz = (((X?1:0) + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize; 2704 ierr = DMGetWorkArray(dm, wsz, MPIU_SCALAR, &work);CHKERRQ(ierr); 2705 ierr = PetscMemzero(work, wsz * sizeof(PetscScalar));CHKERRQ(ierr); 2706 off = 0; 2707 u = X ? (sz = chunkSize*totDim, off += sz, work+off-sz) : NULL; 2708 u_t = X_t ? (sz = chunkSize*totDim, off += sz, work+off-sz) : NULL; 2709 a = dmAux ? (sz = chunkSize*totDimAux, off += sz, work+off-sz) : NULL; 2710 elemMat = hasJac ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL; 2711 elemMatP = hasPrec ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL; 2712 elemMatD = hasDyn ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL; 2713 if (off != wsz) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Error is workspace size %D should be %D", off, wsz); 2714 /* Setup geometry */ 2715 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 2716 ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr); 2717 if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, cellIS, &qGeom);CHKERRQ(ierr);} 2718 if (!qGeom) { 2719 PetscFE fe; 2720 2721 ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr); 2722 ierr = PetscFEGetQuadrature(fe, &qGeom);CHKERRQ(ierr); 2723 ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr); 2724 } 2725 ierr = DMSNESGetFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr); 2726 /* Compute volume integrals */ 2727 if (assembleJac) {ierr = MatZeroEntries(J);CHKERRQ(ierr);} 2728 ierr = MatZeroEntries(JP);CHKERRQ(ierr); 2729 for (chunk = 0; chunk < numChunks; ++chunk, offCell += chunkSize) { 2730 const PetscInt Ncell = PetscMin(chunkSize, numCells - offCell); 2731 PetscInt c; 2732 2733 /* Extract values */ 2734 for (c = 0; c < Ncell; ++c) { 2735 const PetscInt cell = cells ? cells[c+offCell] : c+offCell; 2736 PetscScalar *x = NULL, *x_t = NULL; 2737 PetscInt i; 2738 2739 if (X) { 2740 ierr = DMPlexVecGetClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr); 2741 for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i]; 2742 ierr = DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr); 2743 } 2744 if (X_t) { 2745 ierr = DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 2746 for (i = 0; i < totDim; ++i) u_t[c*totDim+i] = x_t[i]; 2747 ierr = DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 2748 } 2749 if (dmAux) { 2750 ierr = DMPlexVecGetClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr); 2751 for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i]; 2752 ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr); 2753 } 2754 } 2755 CHKMEMQ; 2756 for (fieldI = 0; fieldI < Nf; ++fieldI) { 2757 PetscFE fe; 2758 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 2759 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 2760 if (hasJac) {ierr = PetscFEIntegrateJacobian(fe, prob, PETSCFE_JACOBIAN, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);} 2761 if (hasPrec) {ierr = PetscFEIntegrateJacobian(fe, prob, PETSCFE_JACOBIAN_PRE, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr);} 2762 if (hasDyn) {ierr = PetscFEIntegrateJacobian(fe, prob, PETSCFE_JACOBIAN_DYN, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatD);CHKERRQ(ierr);} 2763 } 2764 /* For finite volume, add the identity */ 2765 if (!isFE[fieldI]) { 2766 PetscFV fv; 2767 PetscInt eOffset = 0, Nc, fc, foff; 2768 2769 ierr = PetscDSGetFieldOffset(prob, fieldI, &foff);CHKERRQ(ierr); 2770 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv);CHKERRQ(ierr); 2771 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 2772 for (c = 0; c < chunkSize; ++c, eOffset += totDim*totDim) { 2773 for (fc = 0; fc < Nc; ++fc) { 2774 const PetscInt i = foff + fc; 2775 if (hasJac) {elemMat [eOffset+i*totDim+i] = 1.0;} 2776 if (hasPrec) {elemMatP[eOffset+i*totDim+i] = 1.0;} 2777 } 2778 } 2779 } 2780 } 2781 CHKMEMQ; 2782 /* Add contribution from X_t */ 2783 if (hasDyn) {for (c = 0; c < chunkSize*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];} 2784 /* Insert values into matrix */ 2785 for (c = 0; c < Ncell; ++c) { 2786 const PetscInt cell = cells ? cells[c+offCell] : c+offCell; 2787 if (mesh->printFEM > 1) { 2788 if (hasJac) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);} 2789 if (hasPrec) {ierr = DMPrintCellMatrix(cell, nameP, totDim, totDim, &elemMatP[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);} 2790 } 2791 if (assembleJac) {ierr = DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);} 2792 ierr = DMPlexMatSetClosure(dm, section, globalSection, JP, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 2793 } 2794 CHKMEMQ; 2795 } 2796 /* Cleanup */ 2797 ierr = DMSNESRestoreFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr); 2798 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 2799 if (hasFV) {ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);} 2800 ierr = DMRestoreWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr); 2801 ierr = DMRestoreWorkArray(dm, ((1 + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize, MPIU_SCALAR, &work);CHKERRQ(ierr); 2802 /* Compute boundary integrals */ 2803 /* ierr = DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, ctx);CHKERRQ(ierr); */ 2804 /* Assemble matrix */ 2805 if (assembleJac) {ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);} 2806 ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2807 ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 2808 CHKMEMQ; 2809 PetscFunctionReturn(0); 2810 } 2811