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