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