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