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