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 Nc, 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 - field - The field number for the rigid body space, or 0 for the default 170 171 Output Argument: 172 . sp - the null space 173 174 Note: This is necessary to provide a suitable coarse space for algebraic multigrid 175 176 Level: advanced 177 178 .seealso: MatNullSpaceCreate(), PCGAMG 179 @*/ 180 PetscErrorCode DMPlexCreateRigidBody(DM dm, PetscInt field, MatNullSpace *sp) 181 { 182 PetscErrorCode (**func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *); 183 MPI_Comm comm; 184 Vec mode[6]; 185 PetscSection section, globalSection; 186 PetscInt dim, dimEmbed, Nf, n, m, mmin, d, i, j; 187 PetscErrorCode ierr; 188 189 PetscFunctionBegin; 190 ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr); 191 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 192 ierr = DMGetCoordinateDim(dm, &dimEmbed);CHKERRQ(ierr); 193 ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr); 194 if (Nf && (field < 0 || field >= Nf)) SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Field %D is not in [0, Nf)", field, Nf); 195 if (dim == 1 && Nf < 2) { 196 ierr = MatNullSpaceCreate(comm, PETSC_TRUE, 0, NULL, sp);CHKERRQ(ierr); 197 PetscFunctionReturn(0); 198 } 199 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 200 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 201 ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr); 202 ierr = PetscCalloc1(Nf, &func);CHKERRQ(ierr); 203 m = (dim*(dim+1))/2; 204 ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr); 205 ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr); 206 ierr = VecSetUp(mode[0]);CHKERRQ(ierr); 207 ierr = VecGetSize(mode[0], &n);CHKERRQ(ierr); 208 mmin = PetscMin(m, n); 209 func[field] = DMPlexProjectRigidBody_Private; 210 for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);} 211 for (d = 0; d < m; d++) { 212 PetscInt ctx[2]; 213 void *voidctx = (void *) (&ctx[0]); 214 215 ctx[0] = dimEmbed; 216 ctx[1] = d; 217 ierr = DMProjectFunction(dm, 0.0, func, &voidctx, INSERT_VALUES, mode[d]);CHKERRQ(ierr); 218 } 219 /* Orthonormalize system */ 220 for (i = 0; i < mmin; ++i) { 221 PetscScalar dots[6]; 222 223 ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr); 224 ierr = VecMDot(mode[i], mmin-i-1, mode+i+1, dots+i+1);CHKERRQ(ierr); 225 for (j = i+1; j < mmin; ++j) { 226 dots[j] *= -1.0; 227 ierr = VecAXPY(mode[j], dots[j], mode[i]);CHKERRQ(ierr); 228 } 229 } 230 ierr = MatNullSpaceCreate(comm, PETSC_FALSE, mmin, mode, sp);CHKERRQ(ierr); 231 for (i = 0; i < m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);} 232 ierr = PetscFree(func);CHKERRQ(ierr); 233 PetscFunctionReturn(0); 234 } 235 236 /*@ 237 DMPlexCreateRigidBodies - For the default global section, create rigid body modes by function space interpolation 238 239 Collective on dm 240 241 Input Arguments: 242 + dm - the DM 243 . nb - The number of bodies 244 . label - The DMLabel marking each domain 245 . nids - The number of ids per body 246 - ids - An array of the label ids in sequence for each domain 247 248 Output Argument: 249 . sp - the null space 250 251 Note: This is necessary to provide a suitable coarse space for algebraic multigrid 252 253 Level: advanced 254 255 .seealso: MatNullSpaceCreate() 256 @*/ 257 PetscErrorCode DMPlexCreateRigidBodies(DM dm, PetscInt nb, DMLabel label, const PetscInt nids[], const PetscInt ids[], MatNullSpace *sp) 258 { 259 MPI_Comm comm; 260 PetscSection section, globalSection; 261 Vec *mode; 262 PetscScalar *dots; 263 PetscInt dim, dimEmbed, n, m, b, d, i, j, off; 264 PetscErrorCode ierr; 265 266 PetscFunctionBegin; 267 ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr); 268 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 269 ierr = DMGetCoordinateDim(dm, &dimEmbed);CHKERRQ(ierr); 270 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 271 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 272 ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr); 273 m = nb * (dim*(dim+1))/2; 274 ierr = PetscMalloc2(m, &mode, m, &dots);CHKERRQ(ierr); 275 ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr); 276 ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr); 277 ierr = VecSetUp(mode[0]);CHKERRQ(ierr); 278 for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);} 279 for (b = 0, off = 0; b < nb; ++b) { 280 for (d = 0; d < m/nb; ++d) { 281 PetscInt ctx[2]; 282 PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *) = DMPlexProjectRigidBody_Private; 283 void *voidctx = (void *) (&ctx[0]); 284 285 ctx[0] = dimEmbed; 286 ctx[1] = d; 287 ierr = DMProjectFunctionLabel(dm, 0.0, label, nids[b], &ids[off], 0, NULL, &func, &voidctx, INSERT_VALUES, mode[d]);CHKERRQ(ierr); 288 off += nids[b]; 289 } 290 } 291 /* Orthonormalize system */ 292 for (i = 0; i < m; ++i) { 293 PetscScalar dots[6]; 294 295 ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr); 296 ierr = VecMDot(mode[i], m-i-1, mode+i+1, dots+i+1);CHKERRQ(ierr); 297 for (j = i+1; j < m; ++j) { 298 dots[j] *= -1.0; 299 ierr = VecAXPY(mode[j], dots[j], mode[i]);CHKERRQ(ierr); 300 } 301 } 302 ierr = MatNullSpaceCreate(comm, PETSC_FALSE, m, mode, sp);CHKERRQ(ierr); 303 for (i = 0; i< m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);} 304 ierr = PetscFree2(mode, dots);CHKERRQ(ierr); 305 PetscFunctionReturn(0); 306 } 307 308 /*@ 309 DMPlexSetMaxProjectionHeight - In DMPlexProjectXXXLocal() functions, the projected values of a basis function's dofs 310 are computed by associating the basis function with one of the mesh points in its transitively-closed support, and 311 evaluating the dual space basis of that point. A basis function is associated with the point in its 312 transitively-closed support whose mesh height is highest (w.r.t. DAG height), but not greater than the maximum 313 projection height, which is set with this function. By default, the maximum projection height is zero, which means 314 that only mesh cells are used to project basis functions. A height of one, for example, evaluates a cell-interior 315 basis functions using its cells dual space basis, but all other basis functions with the dual space basis of a face. 316 317 Input Parameters: 318 + dm - the DMPlex object 319 - height - the maximum projection height >= 0 320 321 Level: advanced 322 323 .seealso: DMPlexGetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal() 324 @*/ 325 PetscErrorCode DMPlexSetMaxProjectionHeight(DM dm, PetscInt height) 326 { 327 DM_Plex *plex = (DM_Plex *) dm->data; 328 329 PetscFunctionBegin; 330 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 331 plex->maxProjectionHeight = height; 332 PetscFunctionReturn(0); 333 } 334 335 /*@ 336 DMPlexGetMaxProjectionHeight - Get the maximum height (w.r.t. DAG) of mesh points used to evaluate dual bases in 337 DMPlexProjectXXXLocal() functions. 338 339 Input Parameters: 340 . dm - the DMPlex object 341 342 Output Parameters: 343 . height - the maximum projection height 344 345 Level: intermediate 346 347 .seealso: DMPlexSetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal() 348 @*/ 349 PetscErrorCode DMPlexGetMaxProjectionHeight(DM dm, PetscInt *height) 350 { 351 DM_Plex *plex = (DM_Plex *) dm->data; 352 353 PetscFunctionBegin; 354 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 355 *height = plex->maxProjectionHeight; 356 PetscFunctionReturn(0); 357 } 358 359 typedef struct { 360 PetscReal alpha; /* The first Euler angle, and in 2D the only one */ 361 PetscReal beta; /* The second Euler angle */ 362 PetscReal gamma; /* The third Euler angle */ 363 PetscInt dim; /* The dimension of R */ 364 PetscScalar *R; /* The rotation matrix, transforming a vector in the local basis to the global basis */ 365 PetscScalar *RT; /* The transposed rotation matrix, transforming a vector in the global basis to the local basis */ 366 } RotCtx; 367 368 /* 369 Note: Following https://en.wikipedia.org/wiki/Euler_angles, we will specify Euler angles by extrinsic rotations, meaning that 370 we rotate with respect to a fixed initial coordinate system, the local basis (x-y-z). The global basis (X-Y-Z) is reached as follows: 371 $ The XYZ system rotates about the z axis by alpha. The X axis is now at angle alpha with respect to the x axis. 372 $ The XYZ system rotates again about the x axis by beta. The Z axis is now at angle beta with respect to the z axis. 373 $ The XYZ system rotates a third time about the z axis by gamma. 374 */ 375 static PetscErrorCode DMPlexBasisTransformSetUp_Rotation_Internal(DM dm, void *ctx) 376 { 377 RotCtx *rc = (RotCtx *) ctx; 378 PetscInt dim = rc->dim; 379 PetscReal c1, s1, c2, s2, c3, s3; 380 PetscErrorCode ierr; 381 382 PetscFunctionBegin; 383 ierr = PetscMalloc2(PetscSqr(dim), &rc->R, PetscSqr(dim), &rc->RT);CHKERRQ(ierr); 384 switch (dim) { 385 case 2: 386 c1 = PetscCosReal(rc->alpha);s1 = PetscSinReal(rc->alpha); 387 rc->R[0] = c1;rc->R[1] = s1; 388 rc->R[2] = -s1;rc->R[3] = c1; 389 ierr = PetscArraycpy(rc->RT, rc->R, PetscSqr(dim));CHKERRQ(ierr); 390 DMPlex_Transpose2D_Internal(rc->RT); 391 break; 392 case 3: 393 c1 = PetscCosReal(rc->alpha);s1 = PetscSinReal(rc->alpha); 394 c2 = PetscCosReal(rc->beta); s2 = PetscSinReal(rc->beta); 395 c3 = PetscCosReal(rc->gamma);s3 = PetscSinReal(rc->gamma); 396 rc->R[0] = c1*c3 - c2*s1*s3;rc->R[1] = c3*s1 + c1*c2*s3;rc->R[2] = s2*s3; 397 rc->R[3] = -c1*s3 - c2*c3*s1;rc->R[4] = c1*c2*c3 - s1*s3; rc->R[5] = c3*s2; 398 rc->R[6] = s1*s2; rc->R[7] = -c1*s2; rc->R[8] = c2; 399 ierr = PetscArraycpy(rc->RT, rc->R, PetscSqr(dim));CHKERRQ(ierr); 400 DMPlex_Transpose3D_Internal(rc->RT); 401 break; 402 default: SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Dimension %D not supported", dim); 403 } 404 PetscFunctionReturn(0); 405 } 406 407 static PetscErrorCode DMPlexBasisTransformDestroy_Rotation_Internal(DM dm, void *ctx) 408 { 409 RotCtx *rc = (RotCtx *) ctx; 410 PetscErrorCode ierr; 411 412 PetscFunctionBegin; 413 ierr = PetscFree2(rc->R, rc->RT);CHKERRQ(ierr); 414 ierr = PetscFree(rc);CHKERRQ(ierr); 415 PetscFunctionReturn(0); 416 } 417 418 static PetscErrorCode DMPlexBasisTransformGetMatrix_Rotation_Internal(DM dm, const PetscReal x[], PetscBool l2g, const PetscScalar **A, void *ctx) 419 { 420 RotCtx *rc = (RotCtx *) ctx; 421 422 PetscFunctionBeginHot; 423 PetscValidPointer(ctx, 5); 424 if (l2g) {*A = rc->R;} 425 else {*A = rc->RT;} 426 PetscFunctionReturn(0); 427 } 428 429 PetscErrorCode DMPlexBasisTransformApplyReal_Internal(DM dm, const PetscReal x[], PetscBool l2g, PetscInt dim, const PetscReal *y, PetscReal *z, void *ctx) 430 { 431 PetscErrorCode ierr; 432 433 PetscFunctionBegin; 434 #if defined(PETSC_USE_COMPLEX) 435 switch (dim) { 436 case 2: 437 { 438 PetscScalar yt[2], zt[2] = {0.0,0.0}; 439 440 yt[0] = y[0]; yt[1] = y[1]; 441 ierr = DMPlexBasisTransformApply_Internal(dm, x, l2g, dim, yt, zt, ctx);CHKERRQ(ierr); 442 z[0] = PetscRealPart(zt[0]); z[1] = PetscRealPart(zt[1]); 443 } 444 break; 445 case 3: 446 { 447 PetscScalar yt[3], zt[3] = {0.0,0.0,0.0}; 448 449 yt[0] = y[0]; yt[1] = y[1]; yt[2] = y[2]; 450 ierr = DMPlexBasisTransformApply_Internal(dm, x, l2g, dim, yt, zt, ctx);CHKERRQ(ierr); 451 z[0] = PetscRealPart(zt[0]); z[1] = PetscRealPart(zt[1]); z[2] = PetscRealPart(zt[2]); 452 } 453 break; 454 } 455 #else 456 ierr = DMPlexBasisTransformApply_Internal(dm, x, l2g, dim, y, z, ctx);CHKERRQ(ierr); 457 #endif 458 PetscFunctionReturn(0); 459 } 460 461 PetscErrorCode DMPlexBasisTransformApply_Internal(DM dm, const PetscReal x[], PetscBool l2g, PetscInt dim, const PetscScalar *y, PetscScalar *z, void *ctx) 462 { 463 const PetscScalar *A; 464 PetscErrorCode ierr; 465 466 PetscFunctionBeginHot; 467 ierr = (*dm->transformGetMatrix)(dm, x, l2g, &A, ctx);CHKERRQ(ierr); 468 switch (dim) { 469 case 2: DMPlex_Mult2D_Internal(A, 1, y, z);break; 470 case 3: DMPlex_Mult3D_Internal(A, 1, y, z);break; 471 } 472 PetscFunctionReturn(0); 473 } 474 475 static PetscErrorCode DMPlexBasisTransformField_Internal(DM dm, DM tdm, Vec tv, PetscInt p, PetscInt f, PetscBool l2g, PetscScalar *a) 476 { 477 PetscSection ts; 478 const PetscScalar *ta, *tva; 479 PetscInt dof; 480 PetscErrorCode ierr; 481 482 PetscFunctionBeginHot; 483 ierr = DMGetLocalSection(tdm, &ts);CHKERRQ(ierr); 484 ierr = PetscSectionGetFieldDof(ts, p, f, &dof);CHKERRQ(ierr); 485 ierr = VecGetArrayRead(tv, &ta);CHKERRQ(ierr); 486 ierr = DMPlexPointLocalFieldRead(tdm, p, f, ta, (void *) &tva);CHKERRQ(ierr); 487 if (l2g) { 488 switch (dof) { 489 case 4: DMPlex_Mult2D_Internal(tva, 1, a, a);break; 490 case 9: DMPlex_Mult3D_Internal(tva, 1, a, a);break; 491 } 492 } else { 493 switch (dof) { 494 case 4: DMPlex_MultTranspose2D_Internal(tva, 1, a, a);break; 495 case 9: DMPlex_MultTranspose3D_Internal(tva, 1, a, a);break; 496 } 497 } 498 ierr = VecRestoreArrayRead(tv, &ta);CHKERRQ(ierr); 499 PetscFunctionReturn(0); 500 } 501 502 static PetscErrorCode DMPlexBasisTransformFieldTensor_Internal(DM dm, DM tdm, Vec tv, PetscInt pf, PetscInt f, PetscInt pg, PetscInt g, PetscBool l2g, PetscInt lda, PetscScalar *a) 503 { 504 PetscSection s, ts; 505 const PetscScalar *ta, *tvaf, *tvag; 506 PetscInt fdof, gdof, fpdof, gpdof; 507 PetscErrorCode ierr; 508 509 PetscFunctionBeginHot; 510 ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr); 511 ierr = DMGetLocalSection(tdm, &ts);CHKERRQ(ierr); 512 ierr = PetscSectionGetFieldDof(s, pf, f, &fpdof);CHKERRQ(ierr); 513 ierr = PetscSectionGetFieldDof(s, pg, g, &gpdof);CHKERRQ(ierr); 514 ierr = PetscSectionGetFieldDof(ts, pf, f, &fdof);CHKERRQ(ierr); 515 ierr = PetscSectionGetFieldDof(ts, pg, g, &gdof);CHKERRQ(ierr); 516 ierr = VecGetArrayRead(tv, &ta);CHKERRQ(ierr); 517 ierr = DMPlexPointLocalFieldRead(tdm, pf, f, ta, (void *) &tvaf);CHKERRQ(ierr); 518 ierr = DMPlexPointLocalFieldRead(tdm, pg, g, ta, (void *) &tvag);CHKERRQ(ierr); 519 if (l2g) { 520 switch (fdof) { 521 case 4: DMPlex_MatMult2D_Internal(tvaf, gpdof, lda, a, a);break; 522 case 9: DMPlex_MatMult3D_Internal(tvaf, gpdof, lda, a, a);break; 523 } 524 switch (gdof) { 525 case 4: DMPlex_MatMultTransposeLeft2D_Internal(tvag, fpdof, lda, a, a);break; 526 case 9: DMPlex_MatMultTransposeLeft3D_Internal(tvag, fpdof, lda, a, a);break; 527 } 528 } else { 529 switch (fdof) { 530 case 4: DMPlex_MatMultTranspose2D_Internal(tvaf, gpdof, lda, a, a);break; 531 case 9: DMPlex_MatMultTranspose3D_Internal(tvaf, gpdof, lda, a, a);break; 532 } 533 switch (gdof) { 534 case 4: DMPlex_MatMultLeft2D_Internal(tvag, fpdof, lda, a, a);break; 535 case 9: DMPlex_MatMultLeft3D_Internal(tvag, fpdof, lda, a, a);break; 536 } 537 } 538 ierr = VecRestoreArrayRead(tv, &ta);CHKERRQ(ierr); 539 PetscFunctionReturn(0); 540 } 541 542 PetscErrorCode DMPlexBasisTransformPoint_Internal(DM dm, DM tdm, Vec tv, PetscInt p, PetscBool fieldActive[], PetscBool l2g, PetscScalar *a) 543 { 544 PetscSection s; 545 PetscSection clSection; 546 IS clPoints; 547 const PetscInt *clp; 548 PetscInt *points = NULL; 549 PetscInt Nf, f, Np, cp, dof, d = 0; 550 PetscErrorCode ierr; 551 552 PetscFunctionBegin; 553 ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr); 554 ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr); 555 ierr = DMPlexGetCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr); 556 for (f = 0; f < Nf; ++f) { 557 for (cp = 0; cp < Np*2; cp += 2) { 558 ierr = PetscSectionGetFieldDof(s, points[cp], f, &dof);CHKERRQ(ierr); 559 if (!dof) continue; 560 if (fieldActive[f]) {ierr = DMPlexBasisTransformField_Internal(dm, tdm, tv, points[cp], f, l2g, &a[d]);CHKERRQ(ierr);} 561 d += dof; 562 } 563 } 564 ierr = DMPlexRestoreCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr); 565 PetscFunctionReturn(0); 566 } 567 568 PetscErrorCode DMPlexBasisTransformPointTensor_Internal(DM dm, DM tdm, Vec tv, PetscInt p, PetscBool l2g, PetscInt lda, PetscScalar *a) 569 { 570 PetscSection s; 571 PetscSection clSection; 572 IS clPoints; 573 const PetscInt *clp; 574 PetscInt *points = NULL; 575 PetscInt Nf, f, g, Np, cpf, cpg, fdof, gdof, r, c = 0; 576 PetscErrorCode ierr; 577 578 PetscFunctionBegin; 579 ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr); 580 ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr); 581 ierr = DMPlexGetCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr); 582 for (f = 0, r = 0; f < Nf; ++f) { 583 for (cpf = 0; cpf < Np*2; cpf += 2) { 584 ierr = PetscSectionGetFieldDof(s, points[cpf], f, &fdof);CHKERRQ(ierr); 585 for (g = 0, c = 0; g < Nf; ++g) { 586 for (cpg = 0; cpg < Np*2; cpg += 2) { 587 ierr = PetscSectionGetFieldDof(s, points[cpg], g, &gdof);CHKERRQ(ierr); 588 ierr = DMPlexBasisTransformFieldTensor_Internal(dm, tdm, tv, points[cpf], f, points[cpg], g, l2g, lda, &a[r*lda+c]);CHKERRQ(ierr); 589 c += gdof; 590 } 591 } 592 if (c != lda) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of columns %D should be %D", c, lda); 593 r += fdof; 594 } 595 } 596 if (r != lda) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of rows %D should be %D", c, lda); 597 ierr = DMPlexRestoreCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr); 598 PetscFunctionReturn(0); 599 } 600 601 static PetscErrorCode DMPlexBasisTransform_Internal(DM dm, Vec lv, PetscBool l2g) 602 { 603 DM tdm; 604 Vec tv; 605 PetscSection ts, s; 606 const PetscScalar *ta; 607 PetscScalar *a, *va; 608 PetscInt pStart, pEnd, p, Nf, f; 609 PetscErrorCode ierr; 610 611 PetscFunctionBegin; 612 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr); 613 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr); 614 ierr = DMGetLocalSection(tdm, &ts);CHKERRQ(ierr); 615 ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr); 616 ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr); 617 ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr); 618 ierr = VecGetArray(lv, &a);CHKERRQ(ierr); 619 ierr = VecGetArrayRead(tv, &ta);CHKERRQ(ierr); 620 for (p = pStart; p < pEnd; ++p) { 621 for (f = 0; f < Nf; ++f) { 622 ierr = DMPlexPointLocalFieldRef(dm, p, f, a, (void *) &va);CHKERRQ(ierr); 623 ierr = DMPlexBasisTransformField_Internal(dm, tdm, tv, p, f, l2g, va);CHKERRQ(ierr); 624 } 625 } 626 ierr = VecRestoreArray(lv, &a);CHKERRQ(ierr); 627 ierr = VecRestoreArrayRead(tv, &ta);CHKERRQ(ierr); 628 PetscFunctionReturn(0); 629 } 630 631 /*@ 632 DMPlexGlobalToLocalBasis - Transform the values in the given local vector from the global basis to the local basis 633 634 Input Parameters: 635 + dm - The DM 636 - lv - A local vector with values in the global basis 637 638 Output Parameters: 639 . lv - A local vector with values in the local basis 640 641 Note: This method is only intended to be called inside DMGlobalToLocal(). It is unlikely that a user will have a local vector full of coefficients for the global basis unless they are reimplementing GlobalToLocal. 642 643 Level: developer 644 645 .seealso: DMPlexLocalToGlobalBasis(), DMGetLocalSection(), DMPlexCreateBasisRotation() 646 @*/ 647 PetscErrorCode DMPlexGlobalToLocalBasis(DM dm, Vec lv) 648 { 649 PetscErrorCode ierr; 650 651 PetscFunctionBegin; 652 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 653 PetscValidHeaderSpecific(lv, VEC_CLASSID, 2); 654 ierr = DMPlexBasisTransform_Internal(dm, lv, PETSC_FALSE);CHKERRQ(ierr); 655 PetscFunctionReturn(0); 656 } 657 658 /*@ 659 DMPlexLocalToGlobalBasis - Transform the values in the given local vector from the local basis to the global basis 660 661 Input Parameters: 662 + dm - The DM 663 - lv - A local vector with values in the local basis 664 665 Output Parameters: 666 . lv - A local vector with values in the global basis 667 668 Note: This method is only intended to be called inside DMGlobalToLocal(). It is unlikely that a user would want a local vector full of coefficients for the global basis unless they are reimplementing GlobalToLocal. 669 670 Level: developer 671 672 .seealso: DMPlexGlobalToLocalBasis(), DMGetLocalSection(), DMPlexCreateBasisRotation() 673 @*/ 674 PetscErrorCode DMPlexLocalToGlobalBasis(DM dm, Vec lv) 675 { 676 PetscErrorCode ierr; 677 678 PetscFunctionBegin; 679 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 680 PetscValidHeaderSpecific(lv, VEC_CLASSID, 2); 681 ierr = DMPlexBasisTransform_Internal(dm, lv, PETSC_TRUE);CHKERRQ(ierr); 682 PetscFunctionReturn(0); 683 } 684 685 /*@ 686 DMPlexCreateBasisRotation - Create an internal transformation from the global basis, used to specify boundary conditions 687 and global solutions, to a local basis, appropriate for discretization integrals and assembly. 688 689 Input Parameters: 690 + dm - The DM 691 . alpha - The first Euler angle, and in 2D the only one 692 . beta - The second Euler angle 693 - gamma - The third Euler angle 694 695 Note: Following https://en.wikipedia.org/wiki/Euler_angles, we will specify Euler angles by extrinsic rotations, meaning that 696 we rotate with respect to a fixed initial coordinate system, the local basis (x-y-z). The global basis (X-Y-Z) is reached as follows: 697 $ The XYZ system rotates about the z axis by alpha. The X axis is now at angle alpha with respect to the x axis. 698 $ The XYZ system rotates again about the x axis by beta. The Z axis is now at angle beta with respect to the z axis. 699 $ The XYZ system rotates a third time about the z axis by gamma. 700 701 Level: developer 702 703 .seealso: DMPlexGlobalToLocalBasis(), DMPlexLocalToGlobalBasis() 704 @*/ 705 PetscErrorCode DMPlexCreateBasisRotation(DM dm, PetscReal alpha, PetscReal beta, PetscReal gamma) 706 { 707 RotCtx *rc; 708 PetscInt cdim; 709 PetscErrorCode ierr; 710 711 ierr = DMGetCoordinateDim(dm, &cdim);CHKERRQ(ierr); 712 ierr = PetscMalloc1(1, &rc);CHKERRQ(ierr); 713 dm->transformCtx = rc; 714 dm->transformSetUp = DMPlexBasisTransformSetUp_Rotation_Internal; 715 dm->transformDestroy = DMPlexBasisTransformDestroy_Rotation_Internal; 716 dm->transformGetMatrix = DMPlexBasisTransformGetMatrix_Rotation_Internal; 717 rc->dim = cdim; 718 rc->alpha = alpha; 719 rc->beta = beta; 720 rc->gamma = gamma; 721 ierr = (*dm->transformSetUp)(dm, dm->transformCtx);CHKERRQ(ierr); 722 ierr = DMConstructBasisTransform_Internal(dm);CHKERRQ(ierr); 723 PetscFunctionReturn(0); 724 } 725 726 /*@C 727 DMPlexInsertBoundaryValuesEssential - Insert boundary values into a local vector using a function of the coordinates 728 729 Input Parameters: 730 + dm - The DM, with a PetscDS that matches the problem being constrained 731 . time - The time 732 . field - The field to constrain 733 . Nc - The number of constrained field components, or 0 for all components 734 . comps - An array of constrained component numbers, or NULL for all components 735 . label - The DMLabel defining constrained points 736 . numids - The number of DMLabel ids for constrained points 737 . ids - An array of ids for constrained points 738 . func - A pointwise function giving boundary values 739 - ctx - An optional user context for bcFunc 740 741 Output Parameter: 742 . locX - A local vector to receives the boundary values 743 744 Level: developer 745 746 .seealso: DMPlexInsertBoundaryValuesEssentialField(), DMPlexInsertBoundaryValuesEssentialBdField(), DMAddBoundary() 747 @*/ 748 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) 749 { 750 PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal x[], PetscInt, PetscScalar *u, void *ctx); 751 void **ctxs; 752 PetscInt numFields; 753 PetscErrorCode ierr; 754 755 PetscFunctionBegin; 756 ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr); 757 ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr); 758 funcs[field] = func; 759 ctxs[field] = ctx; 760 ierr = DMProjectFunctionLabelLocal(dm, time, label, numids, ids, Nc, comps, funcs, ctxs, INSERT_BC_VALUES, locX);CHKERRQ(ierr); 761 ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr); 762 PetscFunctionReturn(0); 763 } 764 765 /*@C 766 DMPlexInsertBoundaryValuesEssentialField - Insert boundary values into a local vector using a function of the coordinates and field data 767 768 Input Parameters: 769 + dm - The DM, with a PetscDS that matches the problem being constrained 770 . time - The time 771 . locU - A local vector with the input solution values 772 . field - The field to constrain 773 . Nc - The number of constrained field components, or 0 for all components 774 . comps - An array of constrained component numbers, or NULL for all components 775 . label - The DMLabel defining constrained points 776 . numids - The number of DMLabel ids for constrained points 777 . ids - An array of ids for constrained points 778 . func - A pointwise function giving boundary values 779 - ctx - An optional user context for bcFunc 780 781 Output Parameter: 782 . locX - A local vector to receives the boundary values 783 784 Level: developer 785 786 .seealso: DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialBdField(), DMAddBoundary() 787 @*/ 788 PetscErrorCode DMPlexInsertBoundaryValuesEssentialField(DM dm, PetscReal time, Vec locU, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[], 789 void (*func)(PetscInt, PetscInt, PetscInt, 790 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 791 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 792 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], 793 PetscScalar[]), 794 void *ctx, Vec locX) 795 { 796 void (**funcs)(PetscInt, PetscInt, PetscInt, 797 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 798 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 799 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]); 800 void **ctxs; 801 PetscInt numFields; 802 PetscErrorCode ierr; 803 804 PetscFunctionBegin; 805 ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr); 806 ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr); 807 funcs[field] = func; 808 ctxs[field] = ctx; 809 ierr = DMProjectFieldLabelLocal(dm, time, label, numids, ids, Nc, comps, locU, funcs, INSERT_BC_VALUES, locX);CHKERRQ(ierr); 810 ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr); 811 PetscFunctionReturn(0); 812 } 813 814 /*@C 815 DMPlexInsertBoundaryValuesEssentialBdField - Insert boundary values into a local vector using a function of the coodinates and boundary field data 816 817 Collective on dm 818 819 Input Parameters: 820 + dm - The DM, with a PetscDS that matches the problem being constrained 821 . time - The time 822 . locU - A local vector with the input solution values 823 . field - The field to constrain 824 . Nc - The number of constrained field components, or 0 for all components 825 . comps - An array of constrained component numbers, or NULL for all components 826 . label - The DMLabel defining constrained points 827 . numids - The number of DMLabel ids for constrained points 828 . ids - An array of ids for constrained points 829 . func - A pointwise function giving boundary values, the calling sequence is given in DMProjectBdFieldLabelLocal() 830 - ctx - An optional user context for bcFunc 831 832 Output Parameter: 833 . locX - A local vector to receive the boundary values 834 835 Level: developer 836 837 .seealso: DMProjectBdFieldLabelLocal(), DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary() 838 @*/ 839 PetscErrorCode DMPlexInsertBoundaryValuesEssentialBdField(DM dm, PetscReal time, Vec locU, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[], 840 void (*func)(PetscInt, PetscInt, PetscInt, 841 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 842 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 843 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], 844 PetscScalar[]), 845 void *ctx, Vec locX) 846 { 847 void (**funcs)(PetscInt, PetscInt, PetscInt, 848 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 849 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 850 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]); 851 void **ctxs; 852 PetscInt numFields; 853 PetscErrorCode ierr; 854 855 PetscFunctionBegin; 856 ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr); 857 ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr); 858 funcs[field] = func; 859 ctxs[field] = ctx; 860 ierr = DMProjectBdFieldLabelLocal(dm, time, label, numids, ids, Nc, comps, locU, funcs, INSERT_BC_VALUES, locX);CHKERRQ(ierr); 861 ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr); 862 PetscFunctionReturn(0); 863 } 864 865 /*@C 866 DMPlexInsertBoundaryValuesRiemann - Insert boundary values into a local vector 867 868 Input Parameters: 869 + dm - The DM, with a PetscDS that matches the problem being constrained 870 . time - The time 871 . faceGeometry - A vector with the FVM face geometry information 872 . cellGeometry - A vector with the FVM cell geometry information 873 . Grad - A vector with the FVM cell gradient information 874 . field - The field to constrain 875 . Nc - The number of constrained field components, or 0 for all components 876 . comps - An array of constrained component numbers, or NULL for all components 877 . label - The DMLabel defining constrained points 878 . numids - The number of DMLabel ids for constrained points 879 . ids - An array of ids for constrained points 880 . func - A pointwise function giving boundary values 881 - ctx - An optional user context for bcFunc 882 883 Output Parameter: 884 . locX - A local vector to receives the boundary values 885 886 Note: This implementation currently ignores the numcomps/comps argument from DMAddBoundary() 887 888 Level: developer 889 890 .seealso: DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary() 891 @*/ 892 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[], 893 PetscErrorCode (*func)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*), void *ctx, Vec locX) 894 { 895 PetscDS prob; 896 PetscSF sf; 897 DM dmFace, dmCell, dmGrad; 898 const PetscScalar *facegeom, *cellgeom = NULL, *grad; 899 const PetscInt *leaves; 900 PetscScalar *x, *fx; 901 PetscInt dim, nleaves, loc, fStart, fEnd, pdim, i; 902 PetscErrorCode ierr, ierru = 0; 903 904 PetscFunctionBegin; 905 ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr); 906 ierr = PetscSFGetGraph(sf, NULL, &nleaves, &leaves, NULL);CHKERRQ(ierr); 907 nleaves = PetscMax(0, nleaves); 908 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 909 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 910 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 911 ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr); 912 ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 913 if (cellGeometry) { 914 ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr); 915 ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 916 } 917 if (Grad) { 918 PetscFV fv; 919 920 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fv);CHKERRQ(ierr); 921 ierr = VecGetDM(Grad, &dmGrad);CHKERRQ(ierr); 922 ierr = VecGetArrayRead(Grad, &grad);CHKERRQ(ierr); 923 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr); 924 ierr = DMGetWorkArray(dm, pdim, MPIU_SCALAR, &fx);CHKERRQ(ierr); 925 } 926 ierr = VecGetArray(locX, &x);CHKERRQ(ierr); 927 for (i = 0; i < numids; ++i) { 928 IS faceIS; 929 const PetscInt *faces; 930 PetscInt numFaces, f; 931 932 ierr = DMLabelGetStratumIS(label, ids[i], &faceIS);CHKERRQ(ierr); 933 if (!faceIS) continue; /* No points with that id on this process */ 934 ierr = ISGetLocalSize(faceIS, &numFaces);CHKERRQ(ierr); 935 ierr = ISGetIndices(faceIS, &faces);CHKERRQ(ierr); 936 for (f = 0; f < numFaces; ++f) { 937 const PetscInt face = faces[f], *cells; 938 PetscFVFaceGeom *fg; 939 940 if ((face < fStart) || (face >= fEnd)) continue; /* Refinement adds non-faces to labels */ 941 ierr = PetscFindInt(face, nleaves, (PetscInt *) leaves, &loc);CHKERRQ(ierr); 942 if (loc >= 0) continue; 943 ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr); 944 ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr); 945 if (Grad) { 946 PetscFVCellGeom *cg; 947 PetscScalar *cx, *cgrad; 948 PetscScalar *xG; 949 PetscReal dx[3]; 950 PetscInt d; 951 952 ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cg);CHKERRQ(ierr); 953 ierr = DMPlexPointLocalRead(dm, cells[0], x, &cx);CHKERRQ(ierr); 954 ierr = DMPlexPointLocalRead(dmGrad, cells[0], grad, &cgrad);CHKERRQ(ierr); 955 ierr = DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);CHKERRQ(ierr); 956 DMPlex_WaxpyD_Internal(dim, -1, cg->centroid, fg->centroid, dx); 957 for (d = 0; d < pdim; ++d) fx[d] = cx[d] + DMPlex_DotD_Internal(dim, &cgrad[d*dim], dx); 958 ierru = (*func)(time, fg->centroid, fg->normal, fx, xG, ctx); 959 if (ierru) { 960 ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr); 961 ierr = ISDestroy(&faceIS);CHKERRQ(ierr); 962 goto cleanup; 963 } 964 } else { 965 PetscScalar *xI; 966 PetscScalar *xG; 967 968 ierr = DMPlexPointLocalRead(dm, cells[0], x, &xI);CHKERRQ(ierr); 969 ierr = DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);CHKERRQ(ierr); 970 ierru = (*func)(time, fg->centroid, fg->normal, xI, xG, ctx); 971 if (ierru) { 972 ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr); 973 ierr = ISDestroy(&faceIS);CHKERRQ(ierr); 974 goto cleanup; 975 } 976 } 977 } 978 ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr); 979 ierr = ISDestroy(&faceIS);CHKERRQ(ierr); 980 } 981 cleanup: 982 ierr = VecRestoreArray(locX, &x);CHKERRQ(ierr); 983 if (Grad) { 984 ierr = DMRestoreWorkArray(dm, pdim, MPIU_SCALAR, &fx);CHKERRQ(ierr); 985 ierr = VecRestoreArrayRead(Grad, &grad);CHKERRQ(ierr); 986 } 987 if (cellGeometry) {ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);} 988 ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 989 CHKERRQ(ierru); 990 PetscFunctionReturn(0); 991 } 992 993 static PetscErrorCode zero(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx) 994 { 995 PetscInt c; 996 for (c = 0; c < Nc; ++c) u[c] = 0.0; 997 return 0; 998 } 999 1000 PetscErrorCode DMPlexInsertBoundaryValues_Plex(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM) 1001 { 1002 PetscObject isZero; 1003 PetscDS prob; 1004 PetscInt numBd, b; 1005 PetscErrorCode ierr; 1006 1007 PetscFunctionBegin; 1008 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 1009 ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr); 1010 ierr = PetscObjectQuery((PetscObject) locX, "__Vec_bc_zero__", &isZero);CHKERRQ(ierr); 1011 for (b = 0; b < numBd; ++b) { 1012 DMBoundaryConditionType type; 1013 const char *name, *labelname; 1014 DMLabel label; 1015 PetscInt field, Nc; 1016 const PetscInt *comps; 1017 PetscObject obj; 1018 PetscClassId id; 1019 void (*func)(void); 1020 PetscInt numids; 1021 const PetscInt *ids; 1022 void *ctx; 1023 1024 ierr = DMGetBoundary(dm, b, &type, &name, &labelname, &field, &Nc, &comps, &func, NULL, &numids, &ids, &ctx);CHKERRQ(ierr); 1025 if (insertEssential != (type & DM_BC_ESSENTIAL)) continue; 1026 ierr = DMGetLabel(dm, labelname, &label);CHKERRQ(ierr); 1027 if (!label) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONGSTATE, "Label %s for boundary condition %s does not exist in the DM", labelname, name); 1028 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1029 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1030 if (id == PETSCFE_CLASSID) { 1031 switch (type) { 1032 /* for FEM, there is no insertion to be done for non-essential boundary conditions */ 1033 case DM_BC_ESSENTIAL: 1034 if (isZero) func = (void (*)(void)) zero; 1035 ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr); 1036 ierr = DMPlexInsertBoundaryValuesEssential(dm, time, field, Nc, comps, label, numids, ids, (PetscErrorCode (*)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *)) func, ctx, locX);CHKERRQ(ierr); 1037 ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr); 1038 break; 1039 case DM_BC_ESSENTIAL_FIELD: 1040 ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr); 1041 ierr = DMPlexInsertBoundaryValuesEssentialField(dm, time, locX, field, Nc, comps, label, numids, ids, 1042 (void (*)(PetscInt, PetscInt, PetscInt, const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 1043 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 1044 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[])) func, ctx, locX);CHKERRQ(ierr); 1045 ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr); 1046 break; 1047 default: break; 1048 } 1049 } else if (id == PETSCFV_CLASSID) { 1050 if (!faceGeomFVM) continue; 1051 ierr = DMPlexInsertBoundaryValuesRiemann(dm, time, faceGeomFVM, cellGeomFVM, gradFVM, field, Nc, comps, label, numids, ids, 1052 (PetscErrorCode (*)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*)) func, ctx, locX);CHKERRQ(ierr); 1053 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field); 1054 } 1055 PetscFunctionReturn(0); 1056 } 1057 1058 PetscErrorCode DMPlexInsertTimeDerivativeBoundaryValues_Plex(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM) 1059 { 1060 PetscObject isZero; 1061 PetscDS prob; 1062 PetscInt numBd, b; 1063 PetscErrorCode ierr; 1064 1065 PetscFunctionBegin; 1066 if (!locX) PetscFunctionReturn(0); 1067 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 1068 ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr); 1069 ierr = PetscObjectQuery((PetscObject) locX, "__Vec_bc_zero__", &isZero);CHKERRQ(ierr); 1070 for (b = 0; b < numBd; ++b) { 1071 DMBoundaryConditionType type; 1072 const char *name, *labelname; 1073 DMLabel label; 1074 PetscInt field, Nc; 1075 const PetscInt *comps; 1076 PetscObject obj; 1077 PetscClassId id; 1078 void (*func_t)(void); 1079 PetscInt numids; 1080 const PetscInt *ids; 1081 void *ctx; 1082 1083 ierr = DMGetBoundary(dm, b, &type, &name, &labelname, &field, &Nc, &comps, NULL, &func_t, &numids, &ids, &ctx);CHKERRQ(ierr); 1084 if (!func_t) continue; 1085 if (insertEssential != (type & DM_BC_ESSENTIAL)) continue; 1086 ierr = DMGetLabel(dm, labelname, &label);CHKERRQ(ierr); 1087 if (!label) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONGSTATE, "Label %s for boundary condition %s does not exist in the DM", labelname, name); 1088 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1089 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1090 if (id == PETSCFE_CLASSID) { 1091 switch (type) { 1092 /* for FEM, there is no insertion to be done for non-essential boundary conditions */ 1093 case DM_BC_ESSENTIAL: 1094 if (isZero) func_t = (void (*)(void)) zero; 1095 ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr); 1096 ierr = DMPlexInsertBoundaryValuesEssential(dm, time, field, Nc, comps, label, numids, ids, (PetscErrorCode (*)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *)) func_t, ctx, locX);CHKERRQ(ierr); 1097 ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr); 1098 break; 1099 case DM_BC_ESSENTIAL_FIELD: 1100 ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr); 1101 ierr = DMPlexInsertBoundaryValuesEssentialField(dm, time, locX, field, Nc, comps, label, numids, ids, 1102 (void (*)(PetscInt, PetscInt, PetscInt, const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 1103 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 1104 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[])) func_t, ctx, locX);CHKERRQ(ierr); 1105 ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr); 1106 break; 1107 default: break; 1108 } 1109 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field); 1110 } 1111 PetscFunctionReturn(0); 1112 } 1113 1114 /*@ 1115 DMPlexInsertBoundaryValues - Puts coefficients which represent boundary values into the local solution vector 1116 1117 Input Parameters: 1118 + dm - The DM 1119 . insertEssential - Should I insert essential (e.g. Dirichlet) or inessential (e.g. Neumann) boundary conditions 1120 . time - The time 1121 . faceGeomFVM - Face geometry data for FV discretizations 1122 . cellGeomFVM - Cell geometry data for FV discretizations 1123 - gradFVM - Gradient reconstruction data for FV discretizations 1124 1125 Output Parameters: 1126 . locX - Solution updated with boundary values 1127 1128 Level: developer 1129 1130 .seealso: DMProjectFunctionLabelLocal() 1131 @*/ 1132 PetscErrorCode DMPlexInsertBoundaryValues(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM) 1133 { 1134 PetscErrorCode ierr; 1135 1136 PetscFunctionBegin; 1137 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 1138 PetscValidHeaderSpecific(locX, VEC_CLASSID, 2); 1139 if (faceGeomFVM) {PetscValidHeaderSpecific(faceGeomFVM, VEC_CLASSID, 4);} 1140 if (cellGeomFVM) {PetscValidHeaderSpecific(cellGeomFVM, VEC_CLASSID, 5);} 1141 if (gradFVM) {PetscValidHeaderSpecific(gradFVM, VEC_CLASSID, 6);} 1142 ierr = PetscTryMethod(dm,"DMPlexInsertBoundaryValues_C",(DM,PetscBool,Vec,PetscReal,Vec,Vec,Vec),(dm,insertEssential,locX,time,faceGeomFVM,cellGeomFVM,gradFVM));CHKERRQ(ierr); 1143 PetscFunctionReturn(0); 1144 } 1145 1146 /*@ 1147 DMPlexInsertTimeDerivativeBoundaryValues - Puts coefficients which represent boundary values of the time derviative into the local solution vector 1148 1149 Input Parameters: 1150 + dm - The DM 1151 . insertEssential - Should I insert essential (e.g. Dirichlet) or inessential (e.g. Neumann) boundary conditions 1152 . time - The time 1153 . faceGeomFVM - Face geometry data for FV discretizations 1154 . cellGeomFVM - Cell geometry data for FV discretizations 1155 - gradFVM - Gradient reconstruction data for FV discretizations 1156 1157 Output Parameters: 1158 . locX_t - Solution updated with boundary values 1159 1160 Level: developer 1161 1162 .seealso: DMProjectFunctionLabelLocal() 1163 @*/ 1164 PetscErrorCode DMPlexInsertTimeDerivativeBoundaryValues(DM dm, PetscBool insertEssential, Vec locX_t, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM) 1165 { 1166 PetscErrorCode ierr; 1167 1168 PetscFunctionBegin; 1169 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 1170 if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 2);} 1171 if (faceGeomFVM) {PetscValidHeaderSpecific(faceGeomFVM, VEC_CLASSID, 4);} 1172 if (cellGeomFVM) {PetscValidHeaderSpecific(cellGeomFVM, VEC_CLASSID, 5);} 1173 if (gradFVM) {PetscValidHeaderSpecific(gradFVM, VEC_CLASSID, 6);} 1174 ierr = PetscTryMethod(dm,"DMPlexInsertTimeDerviativeBoundaryValues_C",(DM,PetscBool,Vec,PetscReal,Vec,Vec,Vec),(dm,insertEssential,locX_t,time,faceGeomFVM,cellGeomFVM,gradFVM));CHKERRQ(ierr); 1175 PetscFunctionReturn(0); 1176 } 1177 1178 PetscErrorCode DMComputeL2Diff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff) 1179 { 1180 Vec localX; 1181 PetscErrorCode ierr; 1182 1183 PetscFunctionBegin; 1184 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr); 1185 ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, localX, time, NULL, NULL, NULL);CHKERRQ(ierr); 1186 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1187 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1188 ierr = DMPlexComputeL2DiffLocal(dm, time, funcs, ctxs, localX, diff);CHKERRQ(ierr); 1189 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr); 1190 PetscFunctionReturn(0); 1191 } 1192 1193 /*@C 1194 DMComputeL2DiffLocal - This function computes the L_2 difference between a function u and an FEM interpolant solution u_h. 1195 1196 Collective on dm 1197 1198 Input Parameters: 1199 + dm - The DM 1200 . time - The time 1201 . funcs - The functions to evaluate for each field component 1202 . ctxs - Optional array of contexts to pass to each function, or NULL. 1203 - localX - The coefficient vector u_h, a local vector 1204 1205 Output Parameter: 1206 . diff - The diff ||u - u_h||_2 1207 1208 Level: developer 1209 1210 .seealso: DMProjectFunction(), DMComputeL2FieldDiff(), DMComputeL2GradientDiff() 1211 @*/ 1212 PetscErrorCode DMPlexComputeL2DiffLocal(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec localX, PetscReal *diff) 1213 { 1214 const PetscInt debug = ((DM_Plex*)dm->data)->printL2; 1215 DM tdm; 1216 Vec tv; 1217 PetscSection section; 1218 PetscQuadrature quad; 1219 PetscFEGeom fegeom; 1220 PetscScalar *funcVal, *interpolant; 1221 PetscReal *coords, *gcoords; 1222 PetscReal localDiff = 0.0; 1223 const PetscReal *quadWeights; 1224 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cellHeight, cStart, cEnd, c, field, fieldOffset; 1225 PetscBool transform; 1226 PetscErrorCode ierr; 1227 1228 PetscFunctionBegin; 1229 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1230 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 1231 fegeom.dimEmbed = coordDim; 1232 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 1233 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 1234 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr); 1235 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr); 1236 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr); 1237 for (field = 0; field < numFields; ++field) { 1238 PetscObject obj; 1239 PetscClassId id; 1240 PetscInt Nc; 1241 1242 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1243 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1244 if (id == PETSCFE_CLASSID) { 1245 PetscFE fe = (PetscFE) obj; 1246 1247 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 1248 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1249 } else if (id == PETSCFV_CLASSID) { 1250 PetscFV fv = (PetscFV) obj; 1251 1252 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr); 1253 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 1254 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field); 1255 numComponents += Nc; 1256 } 1257 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, NULL, &quadWeights);CHKERRQ(ierr); 1258 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 1259 ierr = PetscMalloc6(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ);CHKERRQ(ierr); 1260 ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr); 1261 ierr = DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr); 1262 for (c = cStart; c < cEnd; ++c) { 1263 PetscScalar *x = NULL; 1264 PetscReal elemDiff = 0.0; 1265 PetscInt qc = 0; 1266 1267 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr); 1268 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1269 1270 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 1271 PetscObject obj; 1272 PetscClassId id; 1273 void * const ctx = ctxs ? ctxs[field] : NULL; 1274 PetscInt Nb, Nc, q, fc; 1275 1276 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1277 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1278 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);} 1279 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;} 1280 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field); 1281 if (debug) { 1282 char title[1024]; 1283 ierr = PetscSNPrintf(title, 1023, "Solution for Field %D", field);CHKERRQ(ierr); 1284 ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr); 1285 } 1286 for (q = 0; q < Nq; ++q) { 1287 PetscFEGeom qgeom; 1288 1289 qgeom.dimEmbed = fegeom.dimEmbed; 1290 qgeom.J = &fegeom.J[q*coordDim*coordDim]; 1291 qgeom.invJ = &fegeom.invJ[q*coordDim*coordDim]; 1292 qgeom.detJ = &fegeom.detJ[q]; 1293 if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, point %D", (double)fegeom.detJ[q], c, q); 1294 if (transform) { 1295 gcoords = &coords[coordDim*Nq]; 1296 ierr = DMPlexBasisTransformApplyReal_Internal(dm, &coords[coordDim*q], PETSC_TRUE, coordDim, &coords[coordDim*q], gcoords, dm->transformCtx);CHKERRQ(ierr); 1297 } else { 1298 gcoords = &coords[coordDim*q]; 1299 } 1300 ierr = (*funcs[field])(coordDim, time, gcoords, Nc, funcVal, ctx); 1301 if (ierr) { 1302 PetscErrorCode ierr2; 1303 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2); 1304 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2); 1305 ierr2 = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr2); 1306 CHKERRQ(ierr); 1307 } 1308 if (transform) {ierr = DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx);CHKERRQ(ierr);} 1309 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], &qgeom, q, interpolant);CHKERRQ(ierr);} 1310 else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 1311 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field); 1312 for (fc = 0; fc < Nc; ++fc) { 1313 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)]; 1314 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %D field %D,%D point %g %g %g diff %g\n", c, field, fc, (double)(coordDim > 0 ? coords[coordDim*q] : 0.), (double)(coordDim > 1 ? coords[coordDim*q+1] : 0.),(double)(coordDim > 2 ? coords[coordDim*q+2] : 0.), (double)(PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]));CHKERRQ(ierr);} 1315 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]; 1316 } 1317 } 1318 fieldOffset += Nb; 1319 qc += Nc; 1320 } 1321 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1322 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %D diff %g\n", c, (double)elemDiff);CHKERRQ(ierr);} 1323 localDiff += elemDiff; 1324 } 1325 ierr = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr); 1326 ierr = MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr); 1327 *diff = PetscSqrtReal(*diff); 1328 PetscFunctionReturn(0); 1329 } 1330 1331 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) 1332 { 1333 const PetscInt debug = ((DM_Plex*)dm->data)->printL2; 1334 DM tdm; 1335 PetscSection section; 1336 PetscQuadrature quad; 1337 Vec localX, tv; 1338 PetscScalar *funcVal, *interpolant; 1339 const PetscReal *quadWeights; 1340 PetscFEGeom fegeom; 1341 PetscReal *coords, *gcoords; 1342 PetscReal localDiff = 0.0; 1343 PetscInt dim, coordDim, qNc = 0, Nq = 0, numFields, numComponents = 0, cStart, cEnd, c, field, fieldOffset; 1344 PetscBool transform; 1345 PetscErrorCode ierr; 1346 1347 PetscFunctionBegin; 1348 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1349 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 1350 fegeom.dimEmbed = coordDim; 1351 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 1352 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 1353 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr); 1354 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1355 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1356 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr); 1357 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr); 1358 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr); 1359 for (field = 0; field < numFields; ++field) { 1360 PetscFE fe; 1361 PetscInt Nc; 1362 1363 ierr = DMGetField(dm, field, NULL, (PetscObject *) &fe);CHKERRQ(ierr); 1364 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 1365 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1366 numComponents += Nc; 1367 } 1368 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, NULL, &quadWeights);CHKERRQ(ierr); 1369 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 1370 /* ierr = DMProjectFunctionLocal(dm, fe, funcs, INSERT_BC_VALUES, localX);CHKERRQ(ierr); */ 1371 ierr = PetscMalloc6(numComponents,&funcVal,coordDim*Nq,&coords,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ,numComponents*coordDim,&interpolant,Nq,&fegeom.detJ);CHKERRQ(ierr); 1372 ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 1373 for (c = cStart; c < cEnd; ++c) { 1374 PetscScalar *x = NULL; 1375 PetscReal elemDiff = 0.0; 1376 PetscInt qc = 0; 1377 1378 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr); 1379 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1380 1381 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 1382 PetscFE fe; 1383 void * const ctx = ctxs ? ctxs[field] : NULL; 1384 PetscInt Nb, Nc, q, fc; 1385 1386 ierr = DMGetField(dm, field, NULL, (PetscObject *) &fe);CHKERRQ(ierr); 1387 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 1388 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1389 if (debug) { 1390 char title[1024]; 1391 ierr = PetscSNPrintf(title, 1023, "Solution for Field %D", field);CHKERRQ(ierr); 1392 ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr); 1393 } 1394 for (q = 0; q < Nq; ++q) { 1395 PetscFEGeom qgeom; 1396 1397 qgeom.dimEmbed = fegeom.dimEmbed; 1398 qgeom.J = &fegeom.J[q*coordDim*coordDim]; 1399 qgeom.invJ = &fegeom.invJ[q*coordDim*coordDim]; 1400 qgeom.detJ = &fegeom.detJ[q]; 1401 if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)fegeom.detJ[q], c, q); 1402 if (transform) { 1403 gcoords = &coords[coordDim*Nq]; 1404 ierr = DMPlexBasisTransformApplyReal_Internal(dm, &coords[coordDim*q], PETSC_TRUE, coordDim, &coords[coordDim*q], gcoords, dm->transformCtx);CHKERRQ(ierr); 1405 } else { 1406 gcoords = &coords[coordDim*q]; 1407 } 1408 ierr = (*funcs[field])(coordDim, time, gcoords, n, Nc, funcVal, ctx); 1409 if (ierr) { 1410 PetscErrorCode ierr2; 1411 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2); 1412 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2); 1413 ierr2 = PetscFree6(funcVal,coords,fegeom.J,fegeom.invJ,interpolant,fegeom.detJ);CHKERRQ(ierr2); 1414 CHKERRQ(ierr); 1415 } 1416 if (transform) {ierr = DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx);CHKERRQ(ierr);} 1417 ierr = PetscFEInterpolateGradient_Static(fe, 1, &x[fieldOffset], &qgeom, q, interpolant);CHKERRQ(ierr); 1418 /* Overwrite with the dot product if the normal is given */ 1419 if (n) { 1420 for (fc = 0; fc < Nc; ++fc) { 1421 PetscScalar sum = 0.0; 1422 PetscInt d; 1423 for (d = 0; d < dim; ++d) sum += interpolant[fc*dim+d]*n[d]; 1424 interpolant[fc] = sum; 1425 } 1426 } 1427 for (fc = 0; fc < Nc; ++fc) { 1428 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)]; 1429 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %D fieldDer %D,%D diff %g\n", c, field, fc, (double)(PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]));CHKERRQ(ierr);} 1430 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]; 1431 } 1432 } 1433 fieldOffset += Nb; 1434 qc += Nc; 1435 } 1436 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1437 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %D diff %g\n", c, (double)elemDiff);CHKERRQ(ierr);} 1438 localDiff += elemDiff; 1439 } 1440 ierr = PetscFree6(funcVal,coords,fegeom.J,fegeom.invJ,interpolant,fegeom.detJ);CHKERRQ(ierr); 1441 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr); 1442 ierr = MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr); 1443 *diff = PetscSqrtReal(*diff); 1444 PetscFunctionReturn(0); 1445 } 1446 1447 PetscErrorCode DMComputeL2FieldDiff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff) 1448 { 1449 const PetscInt debug = ((DM_Plex*)dm->data)->printL2; 1450 DM tdm; 1451 DMLabel depthLabel; 1452 PetscSection section; 1453 Vec localX, tv; 1454 PetscReal *localDiff; 1455 PetscInt dim, depth, dE, Nf, f, Nds, s; 1456 PetscBool transform; 1457 PetscErrorCode ierr; 1458 1459 PetscFunctionBegin; 1460 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1461 ierr = DMGetCoordinateDim(dm, &dE);CHKERRQ(ierr); 1462 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 1463 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr); 1464 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr); 1465 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr); 1466 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr); 1467 ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr); 1468 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 1469 ierr = DMLabelGetNumValues(depthLabel, &depth);CHKERRQ(ierr); 1470 1471 ierr = VecSet(localX, 0.0);CHKERRQ(ierr); 1472 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1473 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1474 ierr = DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);CHKERRQ(ierr); 1475 ierr = DMGetNumDS(dm, &Nds);CHKERRQ(ierr); 1476 ierr = PetscCalloc1(Nf, &localDiff);CHKERRQ(ierr); 1477 for (s = 0; s < Nds; ++s) { 1478 PetscDS ds; 1479 DMLabel label; 1480 IS fieldIS, pointIS; 1481 const PetscInt *fields, *points = NULL; 1482 PetscQuadrature quad; 1483 const PetscReal *quadPoints, *quadWeights; 1484 PetscFEGeom fegeom; 1485 PetscReal *coords, *gcoords; 1486 PetscScalar *funcVal, *interpolant; 1487 PetscBool isHybrid; 1488 PetscInt qNc, Nq, totNc, cStart = 0, cEnd, c, dsNf; 1489 1490 ierr = DMGetRegionNumDS(dm, s, &label, &fieldIS, &ds);CHKERRQ(ierr); 1491 ierr = ISGetIndices(fieldIS, &fields);CHKERRQ(ierr); 1492 ierr = PetscDSGetHybrid(ds, &isHybrid);CHKERRQ(ierr); 1493 ierr = PetscDSGetNumFields(ds, &dsNf);CHKERRQ(ierr); 1494 ierr = PetscDSGetTotalComponents(ds, &totNc);CHKERRQ(ierr); 1495 ierr = PetscDSGetQuadrature(ds, &quad);CHKERRQ(ierr); 1496 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 1497 if ((qNc != 1) && (qNc != totNc)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, totNc); 1498 ierr = PetscCalloc6(totNc, &funcVal, totNc, &interpolant, dE*(Nq+1), &coords,Nq, &fegeom.detJ, dE*dE*Nq, &fegeom.J, dE*dE*Nq, &fegeom.invJ);CHKERRQ(ierr); 1499 if (!label) { 1500 ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 1501 } else { 1502 ierr = DMLabelGetStratumIS(label, 1, &pointIS);CHKERRQ(ierr); 1503 ierr = ISGetLocalSize(pointIS, &cEnd);CHKERRQ(ierr); 1504 ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr); 1505 } 1506 for (c = cStart; c < cEnd; ++c) { 1507 const PetscInt cell = points ? points[c] : c; 1508 PetscScalar *x = NULL; 1509 PetscInt qc = 0, fOff = 0, dep, fStart = isHybrid ? dsNf-1 : 0; 1510 1511 ierr = DMLabelGetValue(depthLabel, cell, &dep);CHKERRQ(ierr); 1512 if (dep != depth-1) continue; 1513 if (isHybrid) { 1514 const PetscInt *cone; 1515 1516 ierr = DMPlexGetCone(dm, cell, &cone);CHKERRQ(ierr); 1517 ierr = DMPlexComputeCellGeometryFEM(dm, cone[0], quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr); 1518 } else { 1519 ierr = DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr); 1520 } 1521 ierr = DMPlexVecGetClosure(dm, NULL, localX, cell, NULL, &x);CHKERRQ(ierr); 1522 for (f = fStart; f < dsNf; ++f) { 1523 PetscObject obj; 1524 PetscClassId id; 1525 void * const ctx = ctxs ? ctxs[fields[f]] : NULL; 1526 PetscInt Nb, Nc, q, fc; 1527 PetscReal elemDiff = 0.0; 1528 1529 ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr); 1530 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1531 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);} 1532 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;} 1533 else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", fields[f]); 1534 if (debug) { 1535 char title[1024]; 1536 ierr = PetscSNPrintf(title, 1023, "Solution for Field %D", fields[f]);CHKERRQ(ierr); 1537 ierr = DMPrintCellVector(cell, title, Nb, &x[fOff]);CHKERRQ(ierr); 1538 } 1539 for (q = 0; q < Nq; ++q) { 1540 PetscFEGeom qgeom; 1541 1542 qgeom.dimEmbed = fegeom.dimEmbed; 1543 qgeom.J = &fegeom.J[q*dE*dE]; 1544 qgeom.invJ = &fegeom.invJ[q*dE*dE]; 1545 qgeom.detJ = &fegeom.detJ[q]; 1546 if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for cell %D, quadrature point %D", (double)fegeom.detJ[q], cell, q); 1547 if (transform) { 1548 gcoords = &coords[dE*Nq]; 1549 ierr = DMPlexBasisTransformApplyReal_Internal(dm, &coords[dE*q], PETSC_TRUE, dE, &coords[dE*q], gcoords, dm->transformCtx);CHKERRQ(ierr); 1550 } else { 1551 gcoords = &coords[dE*q]; 1552 } 1553 ierr = (*funcs[fields[f]])(dE, time, gcoords, Nc, funcVal, ctx); 1554 if (ierr) { 1555 PetscErrorCode ierr2; 1556 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, cell, NULL, &x);CHKERRQ(ierr2); 1557 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2); 1558 ierr2 = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr2); 1559 CHKERRQ(ierr); 1560 } 1561 if (transform) {ierr = DMPlexBasisTransformApply_Internal(dm, &coords[dE*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx);CHKERRQ(ierr);} 1562 /* Call once for each face, except for lagrange field */ 1563 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fOff], &qgeom, q, interpolant);CHKERRQ(ierr);} 1564 else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fOff], q, interpolant);CHKERRQ(ierr);} 1565 else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", fields[f]); 1566 for (fc = 0; fc < Nc; ++fc) { 1567 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)]; 1568 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " cell %D field %D,%D point %g %g %g diff %g\n", cell, fields[f], fc, (double)(dE > 0 ? coords[dE*q] : 0.), (double)(dE > 1 ? coords[dE*q+1] : 0.),(double)(dE > 2 ? coords[dE*q+2] : 0.), (double)(PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]));CHKERRQ(ierr);} 1569 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]; 1570 } 1571 } 1572 fOff += Nb; 1573 qc += Nc; 1574 localDiff[fields[f]] += elemDiff; 1575 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " cell %D field %D cum diff %g\n", cell, fields[f], (double)localDiff[fields[f]]);CHKERRQ(ierr);} 1576 } 1577 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, cell, NULL, &x);CHKERRQ(ierr); 1578 } 1579 if (label) { 1580 ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr); 1581 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 1582 } 1583 ierr = ISRestoreIndices(fieldIS, &fields);CHKERRQ(ierr); 1584 ierr = PetscFree6(funcVal, interpolant, coords, fegeom.detJ, fegeom.J, fegeom.invJ);CHKERRQ(ierr); 1585 } 1586 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr); 1587 ierr = MPIU_Allreduce(localDiff, diff, Nf, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr); 1588 ierr = PetscFree(localDiff);CHKERRQ(ierr); 1589 for (f = 0; f < Nf; ++f) diff[f] = PetscSqrtReal(diff[f]); 1590 PetscFunctionReturn(0); 1591 } 1592 1593 /*@C 1594 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. 1595 1596 Collective on dm 1597 1598 Input Parameters: 1599 + dm - The DM 1600 . time - The time 1601 . funcs - The functions to evaluate for each field component: NULL means that component does not contribute to error calculation 1602 . ctxs - Optional array of contexts to pass to each function, or NULL. 1603 - X - The coefficient vector u_h 1604 1605 Output Parameter: 1606 . D - A Vec which holds the difference ||u - u_h||_2 for each cell 1607 1608 Level: developer 1609 1610 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff() 1611 @*/ 1612 PetscErrorCode DMPlexComputeL2DiffVec(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, Vec D) 1613 { 1614 PetscSection section; 1615 PetscQuadrature quad; 1616 Vec localX; 1617 PetscFEGeom fegeom; 1618 PetscScalar *funcVal, *interpolant; 1619 PetscReal *coords; 1620 const PetscReal *quadPoints, *quadWeights; 1621 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, c, field, fieldOffset; 1622 PetscErrorCode ierr; 1623 1624 PetscFunctionBegin; 1625 ierr = VecSet(D, 0.0);CHKERRQ(ierr); 1626 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1627 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 1628 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 1629 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 1630 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr); 1631 ierr = DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);CHKERRQ(ierr); 1632 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1633 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1634 for (field = 0; field < numFields; ++field) { 1635 PetscObject obj; 1636 PetscClassId id; 1637 PetscInt Nc; 1638 1639 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1640 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1641 if (id == PETSCFE_CLASSID) { 1642 PetscFE fe = (PetscFE) obj; 1643 1644 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 1645 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1646 } else if (id == PETSCFV_CLASSID) { 1647 PetscFV fv = (PetscFV) obj; 1648 1649 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr); 1650 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 1651 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field); 1652 numComponents += Nc; 1653 } 1654 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 1655 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 1656 ierr = PetscMalloc6(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ);CHKERRQ(ierr); 1657 ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 1658 for (c = cStart; c < cEnd; ++c) { 1659 PetscScalar *x = NULL; 1660 PetscScalar elemDiff = 0.0; 1661 PetscInt qc = 0; 1662 1663 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr); 1664 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1665 1666 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 1667 PetscObject obj; 1668 PetscClassId id; 1669 void * const ctx = ctxs ? ctxs[field] : NULL; 1670 PetscInt Nb, Nc, q, fc; 1671 1672 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1673 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1674 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);} 1675 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;} 1676 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field); 1677 if (funcs[field]) { 1678 for (q = 0; q < Nq; ++q) { 1679 PetscFEGeom qgeom; 1680 1681 qgeom.dimEmbed = fegeom.dimEmbed; 1682 qgeom.J = &fegeom.J[q*coordDim*coordDim]; 1683 qgeom.invJ = &fegeom.invJ[q*coordDim*coordDim]; 1684 qgeom.detJ = &fegeom.detJ[q]; 1685 if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)fegeom.detJ[q], c, q); 1686 ierr = (*funcs[field])(coordDim, time, &coords[q*coordDim], Nc, funcVal, ctx); 1687 if (ierr) { 1688 PetscErrorCode ierr2; 1689 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2); 1690 ierr2 = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr2); 1691 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2); 1692 CHKERRQ(ierr); 1693 } 1694 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], &qgeom, q, interpolant);CHKERRQ(ierr);} 1695 else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 1696 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field); 1697 for (fc = 0; fc < Nc; ++fc) { 1698 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)]; 1699 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]; 1700 } 1701 } 1702 } 1703 fieldOffset += Nb; 1704 qc += Nc; 1705 } 1706 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1707 ierr = VecSetValue(D, c - cStart, elemDiff, INSERT_VALUES);CHKERRQ(ierr); 1708 } 1709 ierr = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr); 1710 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr); 1711 ierr = VecSqrtAbs(D);CHKERRQ(ierr); 1712 PetscFunctionReturn(0); 1713 } 1714 1715 /*@C 1716 DMPlexComputeGradientClementInterpolant - This function computes the L2 projection of the cellwise gradient of a function u onto P1, and stores it in a Vec. 1717 1718 Collective on dm 1719 1720 Input Parameters: 1721 + dm - The DM 1722 - LocX - The coefficient vector u_h 1723 1724 Output Parameter: 1725 . locC - A Vec which holds the Clement interpolant of the gradient 1726 1727 Notes: 1728 Add citation to (Clement, 1975) and definition of the interpolant 1729 \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 1730 1731 Level: developer 1732 1733 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff() 1734 @*/ 1735 PetscErrorCode DMPlexComputeGradientClementInterpolant(DM dm, Vec locX, Vec locC) 1736 { 1737 DM_Plex *mesh = (DM_Plex *) dm->data; 1738 PetscInt debug = mesh->printFEM; 1739 DM dmC; 1740 PetscSection section; 1741 PetscQuadrature quad; 1742 PetscScalar *interpolant, *gradsum; 1743 PetscFEGeom fegeom; 1744 PetscReal *coords; 1745 const PetscReal *quadPoints, *quadWeights; 1746 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, vStart, vEnd, v, field, fieldOffset; 1747 PetscErrorCode ierr; 1748 1749 PetscFunctionBegin; 1750 ierr = VecGetDM(locC, &dmC);CHKERRQ(ierr); 1751 ierr = VecSet(locC, 0.0);CHKERRQ(ierr); 1752 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1753 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 1754 fegeom.dimEmbed = coordDim; 1755 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 1756 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 1757 for (field = 0; field < numFields; ++field) { 1758 PetscObject obj; 1759 PetscClassId id; 1760 PetscInt Nc; 1761 1762 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1763 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1764 if (id == PETSCFE_CLASSID) { 1765 PetscFE fe = (PetscFE) obj; 1766 1767 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 1768 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1769 } else if (id == PETSCFV_CLASSID) { 1770 PetscFV fv = (PetscFV) obj; 1771 1772 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr); 1773 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 1774 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field); 1775 numComponents += Nc; 1776 } 1777 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 1778 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 1779 ierr = PetscMalloc6(coordDim*numComponents*2,&gradsum,coordDim*numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ);CHKERRQ(ierr); 1780 ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr); 1781 ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 1782 for (v = vStart; v < vEnd; ++v) { 1783 PetscScalar volsum = 0.0; 1784 PetscInt *star = NULL; 1785 PetscInt starSize, st, d, fc; 1786 1787 ierr = PetscArrayzero(gradsum, coordDim*numComponents);CHKERRQ(ierr); 1788 ierr = DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr); 1789 for (st = 0; st < starSize*2; st += 2) { 1790 const PetscInt cell = star[st]; 1791 PetscScalar *grad = &gradsum[coordDim*numComponents]; 1792 PetscScalar *x = NULL; 1793 PetscReal vol = 0.0; 1794 1795 if ((cell < cStart) || (cell >= cEnd)) continue; 1796 ierr = DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr); 1797 ierr = DMPlexVecGetClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr); 1798 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 1799 PetscObject obj; 1800 PetscClassId id; 1801 PetscInt Nb, Nc, q, qc = 0; 1802 1803 ierr = PetscArrayzero(grad, coordDim*numComponents);CHKERRQ(ierr); 1804 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1805 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1806 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);} 1807 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;} 1808 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field); 1809 for (q = 0; q < Nq; ++q) { 1810 PetscFEGeom qgeom; 1811 1812 qgeom.dimEmbed = fegeom.dimEmbed; 1813 qgeom.J = &fegeom.J[q*coordDim*coordDim]; 1814 qgeom.invJ = &fegeom.invJ[q*coordDim*coordDim]; 1815 qgeom.detJ = &fegeom.detJ[q]; 1816 if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)fegeom.detJ[q], cell, q); 1817 if (ierr) { 1818 PetscErrorCode ierr2; 1819 ierr2 = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr2); 1820 ierr2 = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr2); 1821 ierr2 = PetscFree6(gradsum,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr2); 1822 CHKERRQ(ierr); 1823 } 1824 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolateGradient_Static((PetscFE) obj, 1, &x[fieldOffset], &qgeom, q, interpolant);CHKERRQ(ierr);} 1825 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field); 1826 for (fc = 0; fc < Nc; ++fc) { 1827 const PetscReal wt = quadWeights[q*qNc+qc+fc]; 1828 1829 for (d = 0; d < coordDim; ++d) grad[fc*coordDim+d] += interpolant[fc*dim+d]*wt*fegeom.detJ[q]; 1830 } 1831 vol += quadWeights[q*qNc]*fegeom.detJ[q]; 1832 } 1833 fieldOffset += Nb; 1834 qc += Nc; 1835 } 1836 ierr = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr); 1837 for (fc = 0; fc < numComponents; ++fc) { 1838 for (d = 0; d < coordDim; ++d) { 1839 gradsum[fc*coordDim+d] += grad[fc*coordDim+d]; 1840 } 1841 } 1842 volsum += vol; 1843 if (debug) { 1844 ierr = PetscPrintf(PETSC_COMM_SELF, "Cell %D gradient: [", cell);CHKERRQ(ierr); 1845 for (fc = 0; fc < numComponents; ++fc) { 1846 for (d = 0; d < coordDim; ++d) { 1847 if (fc || d > 0) {ierr = PetscPrintf(PETSC_COMM_SELF, ", ");CHKERRQ(ierr);} 1848 ierr = PetscPrintf(PETSC_COMM_SELF, "%g", (double)PetscRealPart(grad[fc*coordDim+d]));CHKERRQ(ierr); 1849 } 1850 } 1851 ierr = PetscPrintf(PETSC_COMM_SELF, "]\n");CHKERRQ(ierr); 1852 } 1853 } 1854 for (fc = 0; fc < numComponents; ++fc) { 1855 for (d = 0; d < coordDim; ++d) gradsum[fc*coordDim+d] /= volsum; 1856 } 1857 ierr = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr); 1858 ierr = DMPlexVecSetClosure(dmC, NULL, locC, v, gradsum, INSERT_VALUES);CHKERRQ(ierr); 1859 } 1860 ierr = PetscFree6(gradsum,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr); 1861 PetscFunctionReturn(0); 1862 } 1863 1864 static PetscErrorCode DMPlexComputeIntegral_Internal(DM dm, Vec X, PetscInt cStart, PetscInt cEnd, PetscScalar *cintegral, void *user) 1865 { 1866 DM dmAux = NULL; 1867 PetscDS prob, probAux = NULL; 1868 PetscSection section, sectionAux; 1869 Vec locX, locA; 1870 PetscInt dim, numCells = cEnd - cStart, c, f; 1871 PetscBool useFVM = PETSC_FALSE; 1872 /* DS */ 1873 PetscInt Nf, totDim, *uOff, *uOff_x, numConstants; 1874 PetscInt NfAux, totDimAux, *aOff; 1875 PetscScalar *u, *a; 1876 const PetscScalar *constants; 1877 /* Geometry */ 1878 PetscFEGeom *cgeomFEM; 1879 DM dmGrad; 1880 PetscQuadrature affineQuad = NULL; 1881 Vec cellGeometryFVM = NULL, faceGeometryFVM = NULL, locGrad = NULL; 1882 PetscFVCellGeom *cgeomFVM; 1883 const PetscScalar *lgrad; 1884 PetscInt maxDegree; 1885 DMField coordField; 1886 IS cellIS; 1887 PetscErrorCode ierr; 1888 1889 PetscFunctionBegin; 1890 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 1891 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1892 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 1893 ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr); 1894 /* Determine which discretizations we have */ 1895 for (f = 0; f < Nf; ++f) { 1896 PetscObject obj; 1897 PetscClassId id; 1898 1899 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 1900 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1901 if (id == PETSCFV_CLASSID) useFVM = PETSC_TRUE; 1902 } 1903 /* Get local solution with boundary values */ 1904 ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr); 1905 ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);CHKERRQ(ierr); 1906 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr); 1907 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr); 1908 /* Read DS information */ 1909 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 1910 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr); 1911 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr); 1912 ierr = ISCreateStride(PETSC_COMM_SELF,numCells,cStart,1,&cellIS);CHKERRQ(ierr); 1913 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr); 1914 /* Read Auxiliary DS information */ 1915 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr); 1916 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 1917 if (dmAux) { 1918 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 1919 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr); 1920 ierr = DMGetLocalSection(dmAux, §ionAux);CHKERRQ(ierr); 1921 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 1922 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr); 1923 } 1924 /* Allocate data arrays */ 1925 ierr = PetscCalloc1(numCells*totDim, &u);CHKERRQ(ierr); 1926 if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);} 1927 /* Read out geometry */ 1928 ierr = DMGetCoordinateField(dm,&coordField);CHKERRQ(ierr); 1929 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr); 1930 if (maxDegree <= 1) { 1931 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr); 1932 if (affineQuad) { 1933 ierr = DMFieldCreateFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr); 1934 } 1935 } 1936 if (useFVM) { 1937 PetscFV fv = NULL; 1938 Vec grad; 1939 PetscInt fStart, fEnd; 1940 PetscBool compGrad; 1941 1942 for (f = 0; f < Nf; ++f) { 1943 PetscObject obj; 1944 PetscClassId id; 1945 1946 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 1947 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1948 if (id == PETSCFV_CLASSID) {fv = (PetscFV) obj; break;} 1949 } 1950 ierr = PetscFVGetComputeGradients(fv, &compGrad);CHKERRQ(ierr); 1951 ierr = PetscFVSetComputeGradients(fv, PETSC_TRUE);CHKERRQ(ierr); 1952 ierr = DMPlexComputeGeometryFVM(dm, &cellGeometryFVM, &faceGeometryFVM);CHKERRQ(ierr); 1953 ierr = DMPlexComputeGradientFVM(dm, fv, faceGeometryFVM, cellGeometryFVM, &dmGrad);CHKERRQ(ierr); 1954 ierr = PetscFVSetComputeGradients(fv, compGrad);CHKERRQ(ierr); 1955 ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr); 1956 /* Reconstruct and limit cell gradients */ 1957 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 1958 ierr = DMGetGlobalVector(dmGrad, &grad);CHKERRQ(ierr); 1959 ierr = DMPlexReconstructGradients_Internal(dm, fv, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr); 1960 /* Communicate gradient values */ 1961 ierr = DMGetLocalVector(dmGrad, &locGrad);CHKERRQ(ierr); 1962 ierr = DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr); 1963 ierr = DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr); 1964 ierr = DMRestoreGlobalVector(dmGrad, &grad);CHKERRQ(ierr); 1965 /* Handle non-essential (e.g. outflow) boundary values */ 1966 ierr = DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, 0.0, faceGeometryFVM, cellGeometryFVM, locGrad);CHKERRQ(ierr); 1967 ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr); 1968 } 1969 /* Read out data from inputs */ 1970 for (c = cStart; c < cEnd; ++c) { 1971 PetscScalar *x = NULL; 1972 PetscInt i; 1973 1974 ierr = DMPlexVecGetClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr); 1975 for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i]; 1976 ierr = DMPlexVecRestoreClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr); 1977 if (dmAux) { 1978 ierr = DMPlexVecGetClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr); 1979 for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i]; 1980 ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr); 1981 } 1982 } 1983 /* Do integration for each field */ 1984 for (f = 0; f < Nf; ++f) { 1985 PetscObject obj; 1986 PetscClassId id; 1987 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset; 1988 1989 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 1990 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1991 if (id == PETSCFE_CLASSID) { 1992 PetscFE fe = (PetscFE) obj; 1993 PetscQuadrature q; 1994 PetscFEGeom *chunkGeom = NULL; 1995 PetscInt Nq, Nb; 1996 1997 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 1998 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr); 1999 ierr = PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 2000 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 2001 blockSize = Nb*Nq; 2002 batchSize = numBlocks * blockSize; 2003 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 2004 numChunks = numCells / (numBatches*batchSize); 2005 Ne = numChunks*numBatches*batchSize; 2006 Nr = numCells % (numBatches*batchSize); 2007 offset = numCells - Nr; 2008 if (!affineQuad) { 2009 ierr = DMFieldCreateFEGeom(coordField,cellIS,q,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr); 2010 } 2011 ierr = PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr); 2012 ierr = PetscFEIntegrate(prob, f, Ne, chunkGeom, u, probAux, a, cintegral);CHKERRQ(ierr); 2013 ierr = PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&chunkGeom);CHKERRQ(ierr); 2014 ierr = PetscFEIntegrate(prob, f, Nr, chunkGeom, &u[offset*totDim], probAux, &a[offset*totDimAux], &cintegral[offset*Nf]);CHKERRQ(ierr); 2015 ierr = PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&chunkGeom);CHKERRQ(ierr); 2016 if (!affineQuad) { 2017 ierr = PetscFEGeomDestroy(&cgeomFEM);CHKERRQ(ierr); 2018 } 2019 } else if (id == PETSCFV_CLASSID) { 2020 PetscInt foff; 2021 PetscPointFunc obj_func; 2022 PetscScalar lint; 2023 2024 ierr = PetscDSGetObjective(prob, f, &obj_func);CHKERRQ(ierr); 2025 ierr = PetscDSGetFieldOffset(prob, f, &foff);CHKERRQ(ierr); 2026 if (obj_func) { 2027 for (c = 0; c < numCells; ++c) { 2028 PetscScalar *u_x; 2029 2030 ierr = DMPlexPointLocalRead(dmGrad, c, lgrad, &u_x);CHKERRQ(ierr); 2031 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); 2032 cintegral[c*Nf+f] += PetscRealPart(lint)*cgeomFVM[c].volume; 2033 } 2034 } 2035 } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f); 2036 } 2037 /* Cleanup data arrays */ 2038 if (useFVM) { 2039 ierr = VecRestoreArrayRead(locGrad, &lgrad);CHKERRQ(ierr); 2040 ierr = VecRestoreArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr); 2041 ierr = DMRestoreLocalVector(dmGrad, &locGrad);CHKERRQ(ierr); 2042 ierr = VecDestroy(&faceGeometryFVM);CHKERRQ(ierr); 2043 ierr = VecDestroy(&cellGeometryFVM);CHKERRQ(ierr); 2044 ierr = DMDestroy(&dmGrad);CHKERRQ(ierr); 2045 } 2046 if (dmAux) {ierr = PetscFree(a);CHKERRQ(ierr);} 2047 ierr = PetscFree(u);CHKERRQ(ierr); 2048 /* Cleanup */ 2049 if (affineQuad) { 2050 ierr = PetscFEGeomDestroy(&cgeomFEM);CHKERRQ(ierr); 2051 } 2052 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr); 2053 ierr = ISDestroy(&cellIS);CHKERRQ(ierr); 2054 ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr); 2055 PetscFunctionReturn(0); 2056 } 2057 2058 /*@ 2059 DMPlexComputeIntegralFEM - Form the integral over the domain from the global input X using pointwise functions specified by the user 2060 2061 Input Parameters: 2062 + dm - The mesh 2063 . X - Global input vector 2064 - user - The user context 2065 2066 Output Parameter: 2067 . integral - Integral for each field 2068 2069 Level: developer 2070 2071 .seealso: DMPlexSNESComputeResidualFEM() 2072 @*/ 2073 PetscErrorCode DMPlexComputeIntegralFEM(DM dm, Vec X, PetscScalar *integral, void *user) 2074 { 2075 DM_Plex *mesh = (DM_Plex *) dm->data; 2076 PetscScalar *cintegral, *lintegral; 2077 PetscInt Nf, f, cellHeight, cStart, cEnd, cell; 2078 PetscErrorCode ierr; 2079 2080 PetscFunctionBegin; 2081 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 2082 PetscValidHeaderSpecific(X, VEC_CLASSID, 2); 2083 PetscValidPointer(integral, 3); 2084 ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 2085 ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr); 2086 ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr); 2087 ierr = DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr); 2088 /* TODO Introduce a loop over large chunks (right now this is a single chunk) */ 2089 ierr = PetscCalloc2(Nf, &lintegral, (cEnd-cStart)*Nf, &cintegral);CHKERRQ(ierr); 2090 ierr = DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);CHKERRQ(ierr); 2091 /* Sum up values */ 2092 for (cell = cStart; cell < cEnd; ++cell) { 2093 const PetscInt c = cell - cStart; 2094 2095 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);CHKERRQ(ierr);} 2096 for (f = 0; f < Nf; ++f) lintegral[f] += cintegral[c*Nf+f]; 2097 } 2098 ierr = MPIU_Allreduce(lintegral, integral, Nf, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject) dm));CHKERRQ(ierr); 2099 if (mesh->printFEM) { 2100 ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "Integral:");CHKERRQ(ierr); 2101 for (f = 0; f < Nf; ++f) {ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), " %g", (double) PetscRealPart(integral[f]));CHKERRQ(ierr);} 2102 ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "\n");CHKERRQ(ierr); 2103 } 2104 ierr = PetscFree2(lintegral, cintegral);CHKERRQ(ierr); 2105 ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 2106 PetscFunctionReturn(0); 2107 } 2108 2109 /*@ 2110 DMPlexComputeCellwiseIntegralFEM - Form the vector of cellwise integrals F from the global input X using pointwise functions specified by the user 2111 2112 Input Parameters: 2113 + dm - The mesh 2114 . X - Global input vector 2115 - user - The user context 2116 2117 Output Parameter: 2118 . integral - Cellwise integrals for each field 2119 2120 Level: developer 2121 2122 .seealso: DMPlexSNESComputeResidualFEM() 2123 @*/ 2124 PetscErrorCode DMPlexComputeCellwiseIntegralFEM(DM dm, Vec X, Vec F, void *user) 2125 { 2126 DM_Plex *mesh = (DM_Plex *) dm->data; 2127 DM dmF; 2128 PetscSection sectionF; 2129 PetscScalar *cintegral, *af; 2130 PetscInt Nf, f, cellHeight, cStart, cEnd, cell; 2131 PetscErrorCode ierr; 2132 2133 PetscFunctionBegin; 2134 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 2135 PetscValidHeaderSpecific(X, VEC_CLASSID, 2); 2136 PetscValidHeaderSpecific(F, VEC_CLASSID, 3); 2137 ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 2138 ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr); 2139 ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr); 2140 ierr = DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr); 2141 /* TODO Introduce a loop over large chunks (right now this is a single chunk) */ 2142 ierr = PetscCalloc1((cEnd-cStart)*Nf, &cintegral);CHKERRQ(ierr); 2143 ierr = DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);CHKERRQ(ierr); 2144 /* Put values in F*/ 2145 ierr = VecGetDM(F, &dmF);CHKERRQ(ierr); 2146 ierr = DMGetLocalSection(dmF, §ionF);CHKERRQ(ierr); 2147 ierr = VecGetArray(F, &af);CHKERRQ(ierr); 2148 for (cell = cStart; cell < cEnd; ++cell) { 2149 const PetscInt c = cell - cStart; 2150 PetscInt dof, off; 2151 2152 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);CHKERRQ(ierr);} 2153 ierr = PetscSectionGetDof(sectionF, cell, &dof);CHKERRQ(ierr); 2154 ierr = PetscSectionGetOffset(sectionF, cell, &off);CHKERRQ(ierr); 2155 if (dof != Nf) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "The number of cell dofs %D != %D", dof, Nf); 2156 for (f = 0; f < Nf; ++f) af[off+f] = cintegral[c*Nf+f]; 2157 } 2158 ierr = VecRestoreArray(F, &af);CHKERRQ(ierr); 2159 ierr = PetscFree(cintegral);CHKERRQ(ierr); 2160 ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 2161 PetscFunctionReturn(0); 2162 } 2163 2164 static PetscErrorCode DMPlexComputeBdIntegral_Internal(DM dm, Vec locX, IS pointIS, 2165 void (*func)(PetscInt, PetscInt, PetscInt, 2166 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 2167 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 2168 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]), 2169 PetscScalar *fintegral, void *user) 2170 { 2171 DM plex = NULL, plexA = NULL; 2172 DMEnclosureType encAux; 2173 PetscDS prob, probAux = NULL; 2174 PetscSection section, sectionAux = NULL; 2175 Vec locA = NULL; 2176 DMField coordField; 2177 PetscInt Nf, totDim, *uOff, *uOff_x; 2178 PetscInt NfAux = 0, totDimAux = 0, *aOff = NULL; 2179 PetscScalar *u, *a = NULL; 2180 const PetscScalar *constants; 2181 PetscInt numConstants, f; 2182 PetscErrorCode ierr; 2183 2184 PetscFunctionBegin; 2185 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 2186 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr); 2187 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 2188 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 2189 ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr); 2190 /* Determine which discretizations we have */ 2191 for (f = 0; f < Nf; ++f) { 2192 PetscObject obj; 2193 PetscClassId id; 2194 2195 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 2196 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2197 if (id == PETSCFV_CLASSID) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Not supported for FVM (field %D)", f); 2198 } 2199 /* Read DS information */ 2200 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 2201 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr); 2202 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr); 2203 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr); 2204 /* Read Auxiliary DS information */ 2205 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 2206 if (locA) { 2207 DM dmAux; 2208 2209 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 2210 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr); 2211 ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr); 2212 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 2213 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr); 2214 ierr = DMGetLocalSection(dmAux, §ionAux);CHKERRQ(ierr); 2215 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 2216 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr); 2217 } 2218 /* Integrate over points */ 2219 { 2220 PetscFEGeom *fgeom, *chunkGeom = NULL; 2221 PetscInt maxDegree; 2222 PetscQuadrature qGeom = NULL; 2223 const PetscInt *points; 2224 PetscInt numFaces, face, Nq, field; 2225 PetscInt numChunks, chunkSize, chunk, Nr, offset; 2226 2227 ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr); 2228 ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr); 2229 ierr = PetscCalloc2(numFaces*totDim, &u, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr); 2230 ierr = DMFieldGetDegree(coordField, pointIS, NULL, &maxDegree);CHKERRQ(ierr); 2231 for (field = 0; field < Nf; ++field) { 2232 PetscFE fe; 2233 2234 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr); 2235 if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, pointIS, &qGeom);CHKERRQ(ierr);} 2236 if (!qGeom) { 2237 ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr); 2238 ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr); 2239 } 2240 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 2241 ierr = DMPlexGetFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);CHKERRQ(ierr); 2242 for (face = 0; face < numFaces; ++face) { 2243 const PetscInt point = points[face], *support; 2244 PetscScalar *x = NULL; 2245 PetscInt i; 2246 2247 ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr); 2248 ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 2249 for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i]; 2250 ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 2251 if (locA) { 2252 PetscInt subp; 2253 ierr = DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp);CHKERRQ(ierr); 2254 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 2255 for (i = 0; i < totDimAux; ++i) a[f*totDimAux+i] = x[i]; 2256 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 2257 } 2258 } 2259 /* Get blocking */ 2260 { 2261 PetscQuadrature q; 2262 PetscInt numBatches, batchSize, numBlocks, blockSize; 2263 PetscInt Nq, Nb; 2264 2265 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 2266 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr); 2267 ierr = PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 2268 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 2269 blockSize = Nb*Nq; 2270 batchSize = numBlocks * blockSize; 2271 chunkSize = numBatches*batchSize; 2272 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 2273 numChunks = numFaces / chunkSize; 2274 Nr = numFaces % chunkSize; 2275 offset = numFaces - Nr; 2276 } 2277 /* Do integration for each field */ 2278 for (chunk = 0; chunk < numChunks; ++chunk) { 2279 ierr = PetscFEGeomGetChunk(fgeom, chunk*chunkSize, (chunk+1)*chunkSize, &chunkGeom);CHKERRQ(ierr); 2280 ierr = PetscFEIntegrateBd(prob, field, func, chunkSize, chunkGeom, u, probAux, a, fintegral);CHKERRQ(ierr); 2281 ierr = PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom);CHKERRQ(ierr); 2282 } 2283 ierr = PetscFEGeomGetChunk(fgeom, offset, numFaces, &chunkGeom);CHKERRQ(ierr); 2284 ierr = PetscFEIntegrateBd(prob, field, func, Nr, chunkGeom, &u[offset*totDim], probAux, a ? &a[offset*totDimAux] : NULL, &fintegral[offset*Nf]);CHKERRQ(ierr); 2285 ierr = PetscFEGeomRestoreChunk(fgeom, offset, numFaces, &chunkGeom);CHKERRQ(ierr); 2286 /* Cleanup data arrays */ 2287 ierr = DMPlexRestoreFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);CHKERRQ(ierr); 2288 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 2289 ierr = PetscFree2(u, a);CHKERRQ(ierr); 2290 ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr); 2291 } 2292 } 2293 if (plex) {ierr = DMDestroy(&plex);CHKERRQ(ierr);} 2294 if (plexA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);} 2295 PetscFunctionReturn(0); 2296 } 2297 2298 /*@ 2299 DMPlexComputeBdIntegral - Form the integral over the specified boundary from the global input X using pointwise functions specified by the user 2300 2301 Input Parameters: 2302 + dm - The mesh 2303 . X - Global input vector 2304 . label - The boundary DMLabel 2305 . numVals - The number of label values to use, or PETSC_DETERMINE for all values 2306 . vals - The label values to use, or PETSC_NULL for all values 2307 . func = The function to integrate along the boundary 2308 - user - The user context 2309 2310 Output Parameter: 2311 . integral - Integral for each field 2312 2313 Level: developer 2314 2315 .seealso: DMPlexComputeIntegralFEM(), DMPlexComputeBdResidualFEM() 2316 @*/ 2317 PetscErrorCode DMPlexComputeBdIntegral(DM dm, Vec X, DMLabel label, PetscInt numVals, const PetscInt vals[], 2318 void (*func)(PetscInt, PetscInt, PetscInt, 2319 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 2320 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 2321 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]), 2322 PetscScalar *integral, void *user) 2323 { 2324 Vec locX; 2325 PetscSection section; 2326 DMLabel depthLabel; 2327 IS facetIS; 2328 PetscInt dim, Nf, f, v; 2329 PetscErrorCode ierr; 2330 2331 PetscFunctionBegin; 2332 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 2333 PetscValidHeaderSpecific(X, VEC_CLASSID, 2); 2334 PetscValidPointer(label, 3); 2335 if (vals) PetscValidPointer(vals, 5); 2336 PetscValidPointer(integral, 6); 2337 ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 2338 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 2339 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 2340 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr); 2341 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 2342 ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr); 2343 /* Get local solution with boundary values */ 2344 ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr); 2345 ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);CHKERRQ(ierr); 2346 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr); 2347 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr); 2348 /* Loop over label values */ 2349 ierr = PetscArrayzero(integral, Nf);CHKERRQ(ierr); 2350 for (v = 0; v < numVals; ++v) { 2351 IS pointIS; 2352 PetscInt numFaces, face; 2353 PetscScalar *fintegral; 2354 2355 ierr = DMLabelGetStratumIS(label, vals[v], &pointIS);CHKERRQ(ierr); 2356 if (!pointIS) continue; /* No points with that id on this process */ 2357 { 2358 IS isectIS; 2359 2360 /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */ 2361 ierr = ISIntersect_Caching_Internal(facetIS, pointIS, &isectIS);CHKERRQ(ierr); 2362 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 2363 pointIS = isectIS; 2364 } 2365 ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr); 2366 ierr = PetscCalloc1(numFaces*Nf, &fintegral);CHKERRQ(ierr); 2367 ierr = DMPlexComputeBdIntegral_Internal(dm, locX, pointIS, func, fintegral, user);CHKERRQ(ierr); 2368 /* Sum point contributions into integral */ 2369 for (f = 0; f < Nf; ++f) for (face = 0; face < numFaces; ++face) integral[f] += fintegral[face*Nf+f]; 2370 ierr = PetscFree(fintegral);CHKERRQ(ierr); 2371 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 2372 } 2373 ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr); 2374 ierr = ISDestroy(&facetIS);CHKERRQ(ierr); 2375 ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 2376 PetscFunctionReturn(0); 2377 } 2378 2379 /*@ 2380 DMPlexComputeInterpolatorNested - Form the local portion of the interpolation matrix I from the coarse DM to a uniformly refined DM. 2381 2382 Input Parameters: 2383 + dmc - The coarse mesh 2384 . dmf - The fine mesh 2385 . isRefined - Flag indicating regular refinement, rather than the same topology 2386 - user - The user context 2387 2388 Output Parameter: 2389 . In - The interpolation matrix 2390 2391 Level: developer 2392 2393 .seealso: DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM() 2394 @*/ 2395 PetscErrorCode DMPlexComputeInterpolatorNested(DM dmc, DM dmf, PetscBool isRefined, Mat In, void *user) 2396 { 2397 DM_Plex *mesh = (DM_Plex *) dmc->data; 2398 const char *name = "Interpolator"; 2399 PetscFE *feRef; 2400 PetscFV *fvRef; 2401 PetscSection fsection, fglobalSection; 2402 PetscSection csection, cglobalSection; 2403 PetscScalar *elemMat; 2404 PetscInt dim, Nf, f, fieldI, fieldJ, offsetI, offsetJ, cStart, cEnd, c; 2405 PetscInt cTotDim=0, rTotDim = 0; 2406 PetscErrorCode ierr; 2407 2408 PetscFunctionBegin; 2409 ierr = PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 2410 ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr); 2411 ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr); 2412 ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr); 2413 ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr); 2414 ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr); 2415 ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr); 2416 ierr = DMPlexGetSimplexOrBoxCells(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr); 2417 ierr = PetscCalloc2(Nf, &feRef, Nf, &fvRef);CHKERRQ(ierr); 2418 for (f = 0; f < Nf; ++f) { 2419 PetscObject obj, objc; 2420 PetscClassId id, idc; 2421 PetscInt rNb = 0, Nc = 0, cNb = 0; 2422 2423 ierr = DMGetField(dmf, f, NULL, &obj);CHKERRQ(ierr); 2424 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2425 if (id == PETSCFE_CLASSID) { 2426 PetscFE fe = (PetscFE) obj; 2427 2428 if (isRefined) { 2429 ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr); 2430 } else { 2431 ierr = PetscObjectReference((PetscObject) fe);CHKERRQ(ierr); 2432 feRef[f] = fe; 2433 } 2434 ierr = PetscFEGetDimension(feRef[f], &rNb);CHKERRQ(ierr); 2435 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 2436 } else if (id == PETSCFV_CLASSID) { 2437 PetscFV fv = (PetscFV) obj; 2438 PetscDualSpace Q; 2439 2440 if (isRefined) { 2441 ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr); 2442 } else { 2443 ierr = PetscObjectReference((PetscObject) fv);CHKERRQ(ierr); 2444 fvRef[f] = fv; 2445 } 2446 ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr); 2447 ierr = PetscDualSpaceGetDimension(Q, &rNb);CHKERRQ(ierr); 2448 ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr); 2449 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 2450 } 2451 ierr = DMGetField(dmc, f, NULL, &objc);CHKERRQ(ierr); 2452 ierr = PetscObjectGetClassId(objc, &idc);CHKERRQ(ierr); 2453 if (idc == PETSCFE_CLASSID) { 2454 PetscFE fe = (PetscFE) objc; 2455 2456 ierr = PetscFEGetDimension(fe, &cNb);CHKERRQ(ierr); 2457 } else if (id == PETSCFV_CLASSID) { 2458 PetscFV fv = (PetscFV) obj; 2459 PetscDualSpace Q; 2460 2461 ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr); 2462 ierr = PetscDualSpaceGetDimension(Q, &cNb);CHKERRQ(ierr); 2463 } 2464 rTotDim += rNb; 2465 cTotDim += cNb; 2466 } 2467 ierr = PetscMalloc1(rTotDim*cTotDim,&elemMat);CHKERRQ(ierr); 2468 ierr = PetscArrayzero(elemMat, rTotDim*cTotDim);CHKERRQ(ierr); 2469 for (fieldI = 0, offsetI = 0; fieldI < Nf; ++fieldI) { 2470 PetscDualSpace Qref; 2471 PetscQuadrature f; 2472 const PetscReal *qpoints, *qweights; 2473 PetscReal *points; 2474 PetscInt npoints = 0, Nc, Np, fpdim, i, k, p, d; 2475 2476 /* Compose points from all dual basis functionals */ 2477 if (feRef[fieldI]) { 2478 ierr = PetscFEGetDualSpace(feRef[fieldI], &Qref);CHKERRQ(ierr); 2479 ierr = PetscFEGetNumComponents(feRef[fieldI], &Nc);CHKERRQ(ierr); 2480 } else { 2481 ierr = PetscFVGetDualSpace(fvRef[fieldI], &Qref);CHKERRQ(ierr); 2482 ierr = PetscFVGetNumComponents(fvRef[fieldI], &Nc);CHKERRQ(ierr); 2483 } 2484 ierr = PetscDualSpaceGetDimension(Qref, &fpdim);CHKERRQ(ierr); 2485 for (i = 0; i < fpdim; ++i) { 2486 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr); 2487 ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, NULL, NULL);CHKERRQ(ierr); 2488 npoints += Np; 2489 } 2490 ierr = PetscMalloc1(npoints*dim,&points);CHKERRQ(ierr); 2491 for (i = 0, k = 0; i < fpdim; ++i) { 2492 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr); 2493 ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);CHKERRQ(ierr); 2494 for (p = 0; p < Np; ++p, ++k) for (d = 0; d < dim; ++d) points[k*dim+d] = qpoints[p*dim+d]; 2495 } 2496 2497 for (fieldJ = 0, offsetJ = 0; fieldJ < Nf; ++fieldJ) { 2498 PetscObject obj; 2499 PetscClassId id; 2500 PetscInt NcJ = 0, cpdim = 0, j, qNc; 2501 2502 ierr = DMGetField(dmc, fieldJ, NULL, &obj);CHKERRQ(ierr); 2503 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2504 if (id == PETSCFE_CLASSID) { 2505 PetscFE fe = (PetscFE) obj; 2506 PetscTabulation T = NULL; 2507 2508 /* Evaluate basis at points */ 2509 ierr = PetscFEGetNumComponents(fe, &NcJ);CHKERRQ(ierr); 2510 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr); 2511 /* For now, fields only interpolate themselves */ 2512 if (fieldI == fieldJ) { 2513 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); 2514 ierr = PetscFECreateTabulation(fe, 1, npoints, points, 0, &T);CHKERRQ(ierr); 2515 for (i = 0, k = 0; i < fpdim; ++i) { 2516 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr); 2517 ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);CHKERRQ(ierr); 2518 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); 2519 for (p = 0; p < Np; ++p, ++k) { 2520 for (j = 0; j < cpdim; ++j) { 2521 /* 2522 cTotDim: Total columns in element interpolation matrix, sum of number of dual basis functionals in each field 2523 offsetI, offsetJ: Offsets into the larger element interpolation matrix for different fields 2524 fpdim, i, cpdim, j: Dofs for fine and coarse grids, correspond to dual space basis functionals 2525 qNC, Nc, Ncj, c: Number of components in this field 2526 Np, p: Number of quad points in the fine grid functional i 2527 k: i*Np + p, overall point number for the interpolation 2528 */ 2529 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += T->T[0][k*cpdim*NcJ+j*Nc+c]*qweights[p*qNc+c]; 2530 } 2531 } 2532 } 2533 ierr = PetscTabulationDestroy(&T);CHKERRQ(ierr);CHKERRQ(ierr); 2534 } 2535 } else if (id == PETSCFV_CLASSID) { 2536 PetscFV fv = (PetscFV) obj; 2537 2538 /* Evaluate constant function at points */ 2539 ierr = PetscFVGetNumComponents(fv, &NcJ);CHKERRQ(ierr); 2540 cpdim = 1; 2541 /* For now, fields only interpolate themselves */ 2542 if (fieldI == fieldJ) { 2543 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); 2544 for (i = 0, k = 0; i < fpdim; ++i) { 2545 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr); 2546 ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);CHKERRQ(ierr); 2547 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); 2548 for (p = 0; p < Np; ++p, ++k) { 2549 for (j = 0; j < cpdim; ++j) { 2550 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += 1.0*qweights[p*qNc+c]; 2551 } 2552 } 2553 } 2554 } 2555 } 2556 offsetJ += cpdim; 2557 } 2558 offsetI += fpdim; 2559 ierr = PetscFree(points);CHKERRQ(ierr); 2560 } 2561 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(0, name, rTotDim, cTotDim, elemMat);CHKERRQ(ierr);} 2562 /* Preallocate matrix */ 2563 { 2564 Mat preallocator; 2565 PetscScalar *vals; 2566 PetscInt *cellCIndices, *cellFIndices; 2567 PetscInt locRows, locCols, cell; 2568 2569 ierr = MatGetLocalSize(In, &locRows, &locCols);CHKERRQ(ierr); 2570 ierr = MatCreate(PetscObjectComm((PetscObject) In), &preallocator);CHKERRQ(ierr); 2571 ierr = MatSetType(preallocator, MATPREALLOCATOR);CHKERRQ(ierr); 2572 ierr = MatSetSizes(preallocator, locRows, locCols, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr); 2573 ierr = MatSetUp(preallocator);CHKERRQ(ierr); 2574 ierr = PetscCalloc3(rTotDim*cTotDim, &vals,cTotDim,&cellCIndices,rTotDim,&cellFIndices);CHKERRQ(ierr); 2575 for (cell = cStart; cell < cEnd; ++cell) { 2576 if (isRefined) { 2577 ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, cell, cellCIndices, cellFIndices);CHKERRQ(ierr); 2578 ierr = MatSetValues(preallocator, rTotDim, cellFIndices, cTotDim, cellCIndices, vals, INSERT_VALUES);CHKERRQ(ierr); 2579 } else { 2580 ierr = DMPlexMatSetClosureGeneral(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, preallocator, cell, vals, INSERT_VALUES);CHKERRQ(ierr); 2581 } 2582 } 2583 ierr = PetscFree3(vals,cellCIndices,cellFIndices);CHKERRQ(ierr); 2584 ierr = MatAssemblyBegin(preallocator, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2585 ierr = MatAssemblyEnd(preallocator, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2586 ierr = MatPreallocatorPreallocate(preallocator, PETSC_TRUE, In);CHKERRQ(ierr); 2587 ierr = MatDestroy(&preallocator);CHKERRQ(ierr); 2588 } 2589 /* Fill matrix */ 2590 ierr = MatZeroEntries(In);CHKERRQ(ierr); 2591 for (c = cStart; c < cEnd; ++c) { 2592 if (isRefined) { 2593 ierr = DMPlexMatSetClosureRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES);CHKERRQ(ierr); 2594 } else { 2595 ierr = DMPlexMatSetClosureGeneral(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES);CHKERRQ(ierr); 2596 } 2597 } 2598 for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);} 2599 ierr = PetscFree2(feRef,fvRef);CHKERRQ(ierr); 2600 ierr = PetscFree(elemMat);CHKERRQ(ierr); 2601 ierr = MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2602 ierr = MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2603 if (mesh->printFEM) { 2604 ierr = PetscPrintf(PetscObjectComm((PetscObject)In), "%s:\n", name);CHKERRQ(ierr); 2605 ierr = MatChop(In, 1.0e-10);CHKERRQ(ierr); 2606 ierr = MatView(In, NULL);CHKERRQ(ierr); 2607 } 2608 ierr = PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 2609 PetscFunctionReturn(0); 2610 } 2611 2612 PetscErrorCode DMPlexComputeMassMatrixNested(DM dmc, DM dmf, Mat mass, void *user) 2613 { 2614 SETERRQ(PetscObjectComm((PetscObject) dmc), PETSC_ERR_SUP, "Laziness"); 2615 } 2616 2617 /*@ 2618 DMPlexComputeInterpolatorGeneral - Form the local portion of the interpolation matrix I from the coarse DM to a non-nested fine DM. 2619 2620 Input Parameters: 2621 + dmf - The fine mesh 2622 . dmc - The coarse mesh 2623 - user - The user context 2624 2625 Output Parameter: 2626 . In - The interpolation matrix 2627 2628 Level: developer 2629 2630 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM() 2631 @*/ 2632 PetscErrorCode DMPlexComputeInterpolatorGeneral(DM dmc, DM dmf, Mat In, void *user) 2633 { 2634 DM_Plex *mesh = (DM_Plex *) dmf->data; 2635 const char *name = "Interpolator"; 2636 PetscDS prob; 2637 PetscSection fsection, csection, globalFSection, globalCSection; 2638 PetscHSetIJ ht; 2639 PetscLayout rLayout; 2640 PetscInt *dnz, *onz; 2641 PetscInt locRows, rStart, rEnd; 2642 PetscReal *x, *v0, *J, *invJ, detJ; 2643 PetscReal *v0c, *Jc, *invJc, detJc; 2644 PetscScalar *elemMat; 2645 PetscInt dim, Nf, field, totDim, cStart, cEnd, cell, ccell; 2646 PetscErrorCode ierr; 2647 2648 PetscFunctionBegin; 2649 ierr = PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 2650 ierr = DMGetCoordinateDim(dmc, &dim);CHKERRQ(ierr); 2651 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr); 2652 ierr = PetscDSGetWorkspace(prob, &x, NULL, NULL, NULL, NULL);CHKERRQ(ierr); 2653 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 2654 ierr = PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);CHKERRQ(ierr); 2655 ierr = PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);CHKERRQ(ierr); 2656 ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr); 2657 ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr); 2658 ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr); 2659 ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr); 2660 ierr = DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);CHKERRQ(ierr); 2661 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 2662 ierr = PetscMalloc1(totDim, &elemMat);CHKERRQ(ierr); 2663 2664 ierr = MatGetLocalSize(In, &locRows, NULL);CHKERRQ(ierr); 2665 ierr = PetscLayoutCreate(PetscObjectComm((PetscObject) In), &rLayout);CHKERRQ(ierr); 2666 ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr); 2667 ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr); 2668 ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr); 2669 ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr); 2670 ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr); 2671 ierr = PetscCalloc2(locRows,&dnz,locRows,&onz);CHKERRQ(ierr); 2672 ierr = PetscHSetIJCreate(&ht);CHKERRQ(ierr); 2673 for (field = 0; field < Nf; ++field) { 2674 PetscObject obj; 2675 PetscClassId id; 2676 PetscDualSpace Q = NULL; 2677 PetscQuadrature f; 2678 const PetscReal *qpoints; 2679 PetscInt Nc, Np, fpdim, i, d; 2680 2681 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 2682 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2683 if (id == PETSCFE_CLASSID) { 2684 PetscFE fe = (PetscFE) obj; 2685 2686 ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr); 2687 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 2688 } else if (id == PETSCFV_CLASSID) { 2689 PetscFV fv = (PetscFV) obj; 2690 2691 ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr); 2692 Nc = 1; 2693 } 2694 ierr = PetscDualSpaceGetDimension(Q, &fpdim);CHKERRQ(ierr); 2695 /* For each fine grid cell */ 2696 for (cell = cStart; cell < cEnd; ++cell) { 2697 PetscInt *findices, *cindices; 2698 PetscInt numFIndices, numCIndices; 2699 2700 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr); 2701 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr); 2702 if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %D != %D dual basis vecs", numFIndices, fpdim); 2703 for (i = 0; i < fpdim; ++i) { 2704 Vec pointVec; 2705 PetscScalar *pV; 2706 PetscSF coarseCellSF = NULL; 2707 const PetscSFNode *coarseCells; 2708 PetscInt numCoarseCells, q, c; 2709 2710 /* Get points from the dual basis functional quadrature */ 2711 ierr = PetscDualSpaceGetFunctional(Q, i, &f);CHKERRQ(ierr); 2712 ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);CHKERRQ(ierr); 2713 ierr = VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);CHKERRQ(ierr); 2714 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr); 2715 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2716 for (q = 0; q < Np; ++q) { 2717 const PetscReal xi0[3] = {-1., -1., -1.}; 2718 2719 /* Transform point to real space */ 2720 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x); 2721 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d]; 2722 } 2723 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2724 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */ 2725 /* OPT: Pack all quad points from fine cell */ 2726 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr); 2727 ierr = PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");CHKERRQ(ierr); 2728 /* Update preallocation info */ 2729 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr); 2730 if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located"); 2731 { 2732 PetscHashIJKey key; 2733 PetscBool missing; 2734 2735 key.i = findices[i]; 2736 if (key.i >= 0) { 2737 /* Get indices for coarse elements */ 2738 for (ccell = 0; ccell < numCoarseCells; ++ccell) { 2739 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr); 2740 for (c = 0; c < numCIndices; ++c) { 2741 key.j = cindices[c]; 2742 if (key.j < 0) continue; 2743 ierr = PetscHSetIJQueryAdd(ht, key, &missing);CHKERRQ(ierr); 2744 if (missing) { 2745 if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart]; 2746 else ++onz[key.i-rStart]; 2747 } 2748 } 2749 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr); 2750 } 2751 } 2752 } 2753 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 2754 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 2755 } 2756 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr); 2757 } 2758 } 2759 ierr = PetscHSetIJDestroy(&ht);CHKERRQ(ierr); 2760 ierr = MatXAIJSetPreallocation(In, 1, dnz, onz, NULL, NULL);CHKERRQ(ierr); 2761 ierr = MatSetOption(In, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 2762 ierr = PetscFree2(dnz,onz);CHKERRQ(ierr); 2763 for (field = 0; field < Nf; ++field) { 2764 PetscObject obj; 2765 PetscClassId id; 2766 PetscDualSpace Q = NULL; 2767 PetscTabulation T = NULL; 2768 PetscQuadrature f; 2769 const PetscReal *qpoints, *qweights; 2770 PetscInt Nc, qNc, Np, fpdim, i, d; 2771 2772 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 2773 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2774 if (id == PETSCFE_CLASSID) { 2775 PetscFE fe = (PetscFE) obj; 2776 2777 ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr); 2778 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 2779 ierr = PetscFECreateTabulation(fe, 1, 1, x, 0, &T);CHKERRQ(ierr); 2780 } else if (id == PETSCFV_CLASSID) { 2781 PetscFV fv = (PetscFV) obj; 2782 2783 ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr); 2784 Nc = 1; 2785 } else SETERRQ1(PetscObjectComm((PetscObject)dmc),PETSC_ERR_ARG_WRONG,"Unknown discretization type for field %D",field); 2786 ierr = PetscDualSpaceGetDimension(Q, &fpdim);CHKERRQ(ierr); 2787 /* For each fine grid cell */ 2788 for (cell = cStart; cell < cEnd; ++cell) { 2789 PetscInt *findices, *cindices; 2790 PetscInt numFIndices, numCIndices; 2791 2792 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr); 2793 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr); 2794 if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %D != %D dual basis vecs", numFIndices, fpdim); 2795 for (i = 0; i < fpdim; ++i) { 2796 Vec pointVec; 2797 PetscScalar *pV; 2798 PetscSF coarseCellSF = NULL; 2799 const PetscSFNode *coarseCells; 2800 PetscInt numCoarseCells, cpdim, q, c, j; 2801 2802 /* Get points from the dual basis functional quadrature */ 2803 ierr = PetscDualSpaceGetFunctional(Q, i, &f);CHKERRQ(ierr); 2804 ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, &qpoints, &qweights);CHKERRQ(ierr); 2805 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); 2806 ierr = VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);CHKERRQ(ierr); 2807 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr); 2808 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2809 for (q = 0; q < Np; ++q) { 2810 const PetscReal xi0[3] = {-1., -1., -1.}; 2811 2812 /* Transform point to real space */ 2813 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x); 2814 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d]; 2815 } 2816 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2817 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */ 2818 /* OPT: Read this out from preallocation information */ 2819 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr); 2820 /* Update preallocation info */ 2821 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr); 2822 if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located"); 2823 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2824 for (ccell = 0; ccell < numCoarseCells; ++ccell) { 2825 PetscReal pVReal[3]; 2826 const PetscReal xi0[3] = {-1., -1., -1.}; 2827 2828 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr); 2829 /* Transform points from real space to coarse reference space */ 2830 ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr); 2831 for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]); 2832 CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x); 2833 2834 if (id == PETSCFE_CLASSID) { 2835 PetscFE fe = (PetscFE) obj; 2836 2837 /* Evaluate coarse basis on contained point */ 2838 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr); 2839 ierr = PetscFEComputeTabulation(fe, 1, x, 0, T);CHKERRQ(ierr); 2840 ierr = PetscArrayzero(elemMat, cpdim);CHKERRQ(ierr); 2841 /* Get elemMat entries by multiplying by weight */ 2842 for (j = 0; j < cpdim; ++j) { 2843 for (c = 0; c < Nc; ++c) elemMat[j] += T->T[0][j*Nc + c]*qweights[ccell*qNc + c]; 2844 } 2845 } else { 2846 cpdim = 1; 2847 for (j = 0; j < cpdim; ++j) { 2848 for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*qweights[ccell*qNc + c]; 2849 } 2850 } 2851 /* Update interpolator */ 2852 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);} 2853 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim); 2854 ierr = MatSetValues(In, 1, &findices[i], numCIndices, cindices, elemMat, INSERT_VALUES);CHKERRQ(ierr); 2855 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr); 2856 } 2857 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2858 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 2859 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 2860 } 2861 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr); 2862 } 2863 if (id == PETSCFE_CLASSID) {ierr = PetscTabulationDestroy(&T);CHKERRQ(ierr);} 2864 } 2865 ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr); 2866 ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr); 2867 ierr = PetscFree(elemMat);CHKERRQ(ierr); 2868 ierr = MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2869 ierr = MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2870 ierr = PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 2871 PetscFunctionReturn(0); 2872 } 2873 2874 /*@ 2875 DMPlexComputeMassMatrixGeneral - Form the local portion of the mass matrix M from the coarse DM to a non-nested fine DM. 2876 2877 Input Parameters: 2878 + dmf - The fine mesh 2879 . dmc - The coarse mesh 2880 - user - The user context 2881 2882 Output Parameter: 2883 . mass - The mass matrix 2884 2885 Level: developer 2886 2887 .seealso: DMPlexComputeMassMatrixNested(), DMPlexComputeInterpolatorNested(), DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM() 2888 @*/ 2889 PetscErrorCode DMPlexComputeMassMatrixGeneral(DM dmc, DM dmf, Mat mass, void *user) 2890 { 2891 DM_Plex *mesh = (DM_Plex *) dmf->data; 2892 const char *name = "Mass Matrix"; 2893 PetscDS prob; 2894 PetscSection fsection, csection, globalFSection, globalCSection; 2895 PetscHSetIJ ht; 2896 PetscLayout rLayout; 2897 PetscInt *dnz, *onz; 2898 PetscInt locRows, rStart, rEnd; 2899 PetscReal *x, *v0, *J, *invJ, detJ; 2900 PetscReal *v0c, *Jc, *invJc, detJc; 2901 PetscScalar *elemMat; 2902 PetscInt dim, Nf, field, totDim, cStart, cEnd, cell, ccell; 2903 PetscErrorCode ierr; 2904 2905 PetscFunctionBegin; 2906 ierr = DMGetCoordinateDim(dmc, &dim);CHKERRQ(ierr); 2907 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr); 2908 ierr = PetscDSGetWorkspace(prob, &x, NULL, NULL, NULL, NULL);CHKERRQ(ierr); 2909 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 2910 ierr = PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);CHKERRQ(ierr); 2911 ierr = PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);CHKERRQ(ierr); 2912 ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr); 2913 ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr); 2914 ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr); 2915 ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr); 2916 ierr = DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);CHKERRQ(ierr); 2917 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 2918 ierr = PetscMalloc1(totDim, &elemMat);CHKERRQ(ierr); 2919 2920 ierr = MatGetLocalSize(mass, &locRows, NULL);CHKERRQ(ierr); 2921 ierr = PetscLayoutCreate(PetscObjectComm((PetscObject) mass), &rLayout);CHKERRQ(ierr); 2922 ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr); 2923 ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr); 2924 ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr); 2925 ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr); 2926 ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr); 2927 ierr = PetscCalloc2(locRows,&dnz,locRows,&onz);CHKERRQ(ierr); 2928 ierr = PetscHSetIJCreate(&ht);CHKERRQ(ierr); 2929 for (field = 0; field < Nf; ++field) { 2930 PetscObject obj; 2931 PetscClassId id; 2932 PetscQuadrature quad; 2933 const PetscReal *qpoints; 2934 PetscInt Nq, Nc, i, d; 2935 2936 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 2937 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2938 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetQuadrature((PetscFE) obj, &quad);CHKERRQ(ierr);} 2939 else {ierr = PetscFVGetQuadrature((PetscFV) obj, &quad);CHKERRQ(ierr);} 2940 ierr = PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, NULL);CHKERRQ(ierr); 2941 /* For each fine grid cell */ 2942 for (cell = cStart; cell < cEnd; ++cell) { 2943 Vec pointVec; 2944 PetscScalar *pV; 2945 PetscSF coarseCellSF = NULL; 2946 const PetscSFNode *coarseCells; 2947 PetscInt numCoarseCells, q, c; 2948 PetscInt *findices, *cindices; 2949 PetscInt numFIndices, numCIndices; 2950 2951 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr); 2952 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr); 2953 /* Get points from the quadrature */ 2954 ierr = VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);CHKERRQ(ierr); 2955 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr); 2956 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2957 for (q = 0; q < Nq; ++q) { 2958 const PetscReal xi0[3] = {-1., -1., -1.}; 2959 2960 /* Transform point to real space */ 2961 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x); 2962 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d]; 2963 } 2964 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2965 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */ 2966 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr); 2967 ierr = PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");CHKERRQ(ierr); 2968 /* Update preallocation info */ 2969 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr); 2970 if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located"); 2971 { 2972 PetscHashIJKey key; 2973 PetscBool missing; 2974 2975 for (i = 0; i < numFIndices; ++i) { 2976 key.i = findices[i]; 2977 if (key.i >= 0) { 2978 /* Get indices for coarse elements */ 2979 for (ccell = 0; ccell < numCoarseCells; ++ccell) { 2980 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr); 2981 for (c = 0; c < numCIndices; ++c) { 2982 key.j = cindices[c]; 2983 if (key.j < 0) continue; 2984 ierr = PetscHSetIJQueryAdd(ht, key, &missing);CHKERRQ(ierr); 2985 if (missing) { 2986 if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart]; 2987 else ++onz[key.i-rStart]; 2988 } 2989 } 2990 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr); 2991 } 2992 } 2993 } 2994 } 2995 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 2996 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 2997 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr); 2998 } 2999 } 3000 ierr = PetscHSetIJDestroy(&ht);CHKERRQ(ierr); 3001 ierr = MatXAIJSetPreallocation(mass, 1, dnz, onz, NULL, NULL);CHKERRQ(ierr); 3002 ierr = MatSetOption(mass, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 3003 ierr = PetscFree2(dnz,onz);CHKERRQ(ierr); 3004 for (field = 0; field < Nf; ++field) { 3005 PetscObject obj; 3006 PetscClassId id; 3007 PetscTabulation T, Tfine; 3008 PetscQuadrature quad; 3009 const PetscReal *qpoints, *qweights; 3010 PetscInt Nq, Nc, i, d; 3011 3012 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 3013 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3014 if (id == PETSCFE_CLASSID) { 3015 ierr = PetscFEGetQuadrature((PetscFE) obj, &quad);CHKERRQ(ierr); 3016 ierr = PetscFEGetCellTabulation((PetscFE) obj, 1, &Tfine);CHKERRQ(ierr); 3017 ierr = PetscFECreateTabulation((PetscFE) obj, 1, 1, x, 0, &T);CHKERRQ(ierr); 3018 } else { 3019 ierr = PetscFVGetQuadrature((PetscFV) obj, &quad);CHKERRQ(ierr); 3020 } 3021 ierr = PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, &qweights);CHKERRQ(ierr); 3022 /* For each fine grid cell */ 3023 for (cell = cStart; cell < cEnd; ++cell) { 3024 Vec pointVec; 3025 PetscScalar *pV; 3026 PetscSF coarseCellSF = NULL; 3027 const PetscSFNode *coarseCells; 3028 PetscInt numCoarseCells, cpdim, q, c, j; 3029 PetscInt *findices, *cindices; 3030 PetscInt numFIndices, numCIndices; 3031 3032 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr); 3033 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr); 3034 /* Get points from the quadrature */ 3035 ierr = VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);CHKERRQ(ierr); 3036 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr); 3037 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 3038 for (q = 0; q < Nq; ++q) { 3039 const PetscReal xi0[3] = {-1., -1., -1.}; 3040 3041 /* Transform point to real space */ 3042 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x); 3043 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d]; 3044 } 3045 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 3046 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */ 3047 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr); 3048 /* Update matrix */ 3049 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr); 3050 if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located"); 3051 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 3052 for (ccell = 0; ccell < numCoarseCells; ++ccell) { 3053 PetscReal pVReal[3]; 3054 const PetscReal xi0[3] = {-1., -1., -1.}; 3055 3056 3057 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr); 3058 /* Transform points from real space to coarse reference space */ 3059 ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr); 3060 for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]); 3061 CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x); 3062 3063 if (id == PETSCFE_CLASSID) { 3064 PetscFE fe = (PetscFE) obj; 3065 3066 /* Evaluate coarse basis on contained point */ 3067 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr); 3068 ierr = PetscFEComputeTabulation(fe, 1, x, 0, T);CHKERRQ(ierr); 3069 /* Get elemMat entries by multiplying by weight */ 3070 for (i = 0; i < numFIndices; ++i) { 3071 ierr = PetscArrayzero(elemMat, cpdim);CHKERRQ(ierr); 3072 for (j = 0; j < cpdim; ++j) { 3073 for (c = 0; c < Nc; ++c) elemMat[j] += T->T[0][j*Nc + c]*Tfine->T[0][(ccell*numFIndices + i)*Nc + c]*qweights[ccell*Nc + c]*detJ; 3074 } 3075 /* Update interpolator */ 3076 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);} 3077 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim); 3078 ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr); 3079 } 3080 } else { 3081 cpdim = 1; 3082 for (i = 0; i < numFIndices; ++i) { 3083 ierr = PetscArrayzero(elemMat, cpdim);CHKERRQ(ierr); 3084 for (j = 0; j < cpdim; ++j) { 3085 for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*1.0*qweights[ccell*Nc + c]*detJ; 3086 } 3087 /* Update interpolator */ 3088 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);} 3089 ierr = PetscPrintf(PETSC_COMM_SELF, "Nq: %D %D Nf: %D %D Nc: %D %D\n", ccell, Nq, i, numFIndices, j, numCIndices);CHKERRQ(ierr); 3090 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim); 3091 ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr); 3092 } 3093 } 3094 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr); 3095 } 3096 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 3097 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 3098 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 3099 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr); 3100 } 3101 if (id == PETSCFE_CLASSID) {ierr = PetscTabulationDestroy(&T);CHKERRQ(ierr);} 3102 } 3103 ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr); 3104 ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr); 3105 ierr = PetscFree(elemMat);CHKERRQ(ierr); 3106 ierr = MatAssemblyBegin(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3107 ierr = MatAssemblyEnd(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3108 PetscFunctionReturn(0); 3109 } 3110 3111 /*@ 3112 DMPlexComputeInjectorFEM - Compute a mapping from coarse unknowns to fine unknowns 3113 3114 Input Parameters: 3115 + dmc - The coarse mesh 3116 - dmf - The fine mesh 3117 - user - The user context 3118 3119 Output Parameter: 3120 . sc - The mapping 3121 3122 Level: developer 3123 3124 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM() 3125 @*/ 3126 PetscErrorCode DMPlexComputeInjectorFEM(DM dmc, DM dmf, VecScatter *sc, void *user) 3127 { 3128 PetscDS prob; 3129 PetscFE *feRef; 3130 PetscFV *fvRef; 3131 Vec fv, cv; 3132 IS fis, cis; 3133 PetscSection fsection, fglobalSection, csection, cglobalSection; 3134 PetscInt *cmap, *cellCIndices, *cellFIndices, *cindices, *findices; 3135 PetscInt cTotDim, fTotDim = 0, Nf, f, field, cStart, cEnd, c, dim, d, startC, endC, offsetC, offsetF, m; 3136 PetscBool *needAvg; 3137 PetscErrorCode ierr; 3138 3139 PetscFunctionBegin; 3140 ierr = PetscLogEventBegin(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 3141 ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr); 3142 ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr); 3143 ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr); 3144 ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr); 3145 ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr); 3146 ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr); 3147 ierr = DMPlexGetSimplexOrBoxCells(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr); 3148 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr); 3149 ierr = PetscCalloc3(Nf,&feRef,Nf,&fvRef,Nf,&needAvg);CHKERRQ(ierr); 3150 for (f = 0; f < Nf; ++f) { 3151 PetscObject obj; 3152 PetscClassId id; 3153 PetscInt fNb = 0, Nc = 0; 3154 3155 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3156 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3157 if (id == PETSCFE_CLASSID) { 3158 PetscFE fe = (PetscFE) obj; 3159 PetscSpace sp; 3160 PetscInt maxDegree; 3161 3162 ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr); 3163 ierr = PetscFEGetDimension(feRef[f], &fNb);CHKERRQ(ierr); 3164 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 3165 ierr = PetscFEGetBasisSpace(fe, &sp);CHKERRQ(ierr); 3166 ierr = PetscSpaceGetDegree(sp, NULL, &maxDegree);CHKERRQ(ierr); 3167 if (!maxDegree) needAvg[f] = PETSC_TRUE; 3168 } else if (id == PETSCFV_CLASSID) { 3169 PetscFV fv = (PetscFV) obj; 3170 PetscDualSpace Q; 3171 3172 ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr); 3173 ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr); 3174 ierr = PetscDualSpaceGetDimension(Q, &fNb);CHKERRQ(ierr); 3175 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 3176 needAvg[f] = PETSC_TRUE; 3177 } 3178 fTotDim += fNb; 3179 } 3180 ierr = PetscDSGetTotalDimension(prob, &cTotDim);CHKERRQ(ierr); 3181 ierr = PetscMalloc1(cTotDim,&cmap);CHKERRQ(ierr); 3182 for (field = 0, offsetC = 0, offsetF = 0; field < Nf; ++field) { 3183 PetscFE feC; 3184 PetscFV fvC; 3185 PetscDualSpace QF, QC; 3186 PetscInt order = -1, NcF, NcC, fpdim, cpdim; 3187 3188 if (feRef[field]) { 3189 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &feC);CHKERRQ(ierr); 3190 ierr = PetscFEGetNumComponents(feC, &NcC);CHKERRQ(ierr); 3191 ierr = PetscFEGetNumComponents(feRef[field], &NcF);CHKERRQ(ierr); 3192 ierr = PetscFEGetDualSpace(feRef[field], &QF);CHKERRQ(ierr); 3193 ierr = PetscDualSpaceGetOrder(QF, &order);CHKERRQ(ierr); 3194 ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr); 3195 ierr = PetscFEGetDualSpace(feC, &QC);CHKERRQ(ierr); 3196 ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr); 3197 } else { 3198 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fvC);CHKERRQ(ierr); 3199 ierr = PetscFVGetNumComponents(fvC, &NcC);CHKERRQ(ierr); 3200 ierr = PetscFVGetNumComponents(fvRef[field], &NcF);CHKERRQ(ierr); 3201 ierr = PetscFVGetDualSpace(fvRef[field], &QF);CHKERRQ(ierr); 3202 ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr); 3203 ierr = PetscFVGetDualSpace(fvC, &QC);CHKERRQ(ierr); 3204 ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr); 3205 } 3206 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); 3207 for (c = 0; c < cpdim; ++c) { 3208 PetscQuadrature cfunc; 3209 const PetscReal *cqpoints, *cqweights; 3210 PetscInt NqcC, NpC; 3211 PetscBool found = PETSC_FALSE; 3212 3213 ierr = PetscDualSpaceGetFunctional(QC, c, &cfunc);CHKERRQ(ierr); 3214 ierr = PetscQuadratureGetData(cfunc, NULL, &NqcC, &NpC, &cqpoints, &cqweights);CHKERRQ(ierr); 3215 if (NqcC != NcC) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components %D", NqcC, NcC); 3216 if (NpC != 1 && feRef[field]) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Do not know how to do injection for moments"); 3217 for (f = 0; f < fpdim; ++f) { 3218 PetscQuadrature ffunc; 3219 const PetscReal *fqpoints, *fqweights; 3220 PetscReal sum = 0.0; 3221 PetscInt NqcF, NpF; 3222 3223 ierr = PetscDualSpaceGetFunctional(QF, f, &ffunc);CHKERRQ(ierr); 3224 ierr = PetscQuadratureGetData(ffunc, NULL, &NqcF, &NpF, &fqpoints, &fqweights);CHKERRQ(ierr); 3225 if (NqcF != NcF) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components %D", NqcF, NcF); 3226 if (NpC != NpF) continue; 3227 for (d = 0; d < dim; ++d) sum += PetscAbsReal(cqpoints[d] - fqpoints[d]); 3228 if (sum > 1.0e-9) continue; 3229 for (d = 0; d < NcC; ++d) sum += PetscAbsReal(cqweights[d]*fqweights[d]); 3230 if (sum < 1.0e-9) continue; 3231 cmap[offsetC+c] = offsetF+f; 3232 found = PETSC_TRUE; 3233 break; 3234 } 3235 if (!found) { 3236 /* TODO We really want the average here, but some asshole put VecScatter in the interface */ 3237 if (fvRef[field] || (feRef[field] && order == 0)) { 3238 cmap[offsetC+c] = offsetF+0; 3239 } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not locate matching functional for injection"); 3240 } 3241 } 3242 offsetC += cpdim; 3243 offsetF += fpdim; 3244 } 3245 for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);ierr = PetscFVDestroy(&fvRef[f]);CHKERRQ(ierr);} 3246 ierr = PetscFree3(feRef,fvRef,needAvg);CHKERRQ(ierr); 3247 3248 ierr = DMGetGlobalVector(dmf, &fv);CHKERRQ(ierr); 3249 ierr = DMGetGlobalVector(dmc, &cv);CHKERRQ(ierr); 3250 ierr = VecGetOwnershipRange(cv, &startC, &endC);CHKERRQ(ierr); 3251 ierr = PetscSectionGetConstrainedStorageSize(cglobalSection, &m);CHKERRQ(ierr); 3252 ierr = PetscMalloc2(cTotDim,&cellCIndices,fTotDim,&cellFIndices);CHKERRQ(ierr); 3253 ierr = PetscMalloc1(m,&cindices);CHKERRQ(ierr); 3254 ierr = PetscMalloc1(m,&findices);CHKERRQ(ierr); 3255 for (d = 0; d < m; ++d) cindices[d] = findices[d] = -1; 3256 for (c = cStart; c < cEnd; ++c) { 3257 ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, c, cellCIndices, cellFIndices);CHKERRQ(ierr); 3258 for (d = 0; d < cTotDim; ++d) { 3259 if ((cellCIndices[d] < startC) || (cellCIndices[d] >= endC)) continue; 3260 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]]); 3261 cindices[cellCIndices[d]-startC] = cellCIndices[d]; 3262 findices[cellCIndices[d]-startC] = cellFIndices[cmap[d]]; 3263 } 3264 } 3265 ierr = PetscFree(cmap);CHKERRQ(ierr); 3266 ierr = PetscFree2(cellCIndices,cellFIndices);CHKERRQ(ierr); 3267 3268 ierr = ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis);CHKERRQ(ierr); 3269 ierr = ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis);CHKERRQ(ierr); 3270 ierr = VecScatterCreate(cv, cis, fv, fis, sc);CHKERRQ(ierr); 3271 ierr = ISDestroy(&cis);CHKERRQ(ierr); 3272 ierr = ISDestroy(&fis);CHKERRQ(ierr); 3273 ierr = DMRestoreGlobalVector(dmf, &fv);CHKERRQ(ierr); 3274 ierr = DMRestoreGlobalVector(dmc, &cv);CHKERRQ(ierr); 3275 ierr = PetscLogEventEnd(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 3276 PetscFunctionReturn(0); 3277 } 3278 3279 /*@C 3280 DMPlexGetCellFields - Retrieve the field values values for a chunk of cells 3281 3282 Input Parameters: 3283 + dm - The DM 3284 . cellIS - The cells to include 3285 . locX - A local vector with the solution fields 3286 . locX_t - A local vector with solution field time derivatives, or NULL 3287 - locA - A local vector with auxiliary fields, or NULL 3288 3289 Output Parameters: 3290 + u - The field coefficients 3291 . u_t - The fields derivative coefficients 3292 - a - The auxiliary field coefficients 3293 3294 Level: developer 3295 3296 .seealso: DMPlexGetFaceFields() 3297 @*/ 3298 PetscErrorCode DMPlexGetCellFields(DM dm, IS cellIS, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a) 3299 { 3300 DM plex, plexA = NULL; 3301 DMEnclosureType encAux; 3302 PetscSection section, sectionAux; 3303 PetscDS prob; 3304 const PetscInt *cells; 3305 PetscInt cStart, cEnd, numCells, totDim, totDimAux, c; 3306 PetscErrorCode ierr; 3307 3308 PetscFunctionBegin; 3309 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 3310 PetscValidHeaderSpecific(locX, VEC_CLASSID, 4); 3311 if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 5);} 3312 if (locA) {PetscValidHeaderSpecific(locA, VEC_CLASSID, 6);} 3313 PetscValidPointer(u, 7); 3314 PetscValidPointer(u_t, 8); 3315 PetscValidPointer(a, 9); 3316 ierr = DMPlexConvertPlex(dm, &plex, PETSC_FALSE);CHKERRQ(ierr); 3317 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3318 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 3319 ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob);CHKERRQ(ierr); 3320 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 3321 if (locA) { 3322 DM dmAux; 3323 PetscDS probAux; 3324 3325 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 3326 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr); 3327 ierr = DMPlexConvertPlex(dmAux, &plexA, PETSC_FALSE);CHKERRQ(ierr); 3328 ierr = DMGetLocalSection(dmAux, §ionAux);CHKERRQ(ierr); 3329 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 3330 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 3331 } 3332 numCells = cEnd - cStart; 3333 ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u);CHKERRQ(ierr); 3334 if (locX_t) {ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u_t);CHKERRQ(ierr);} else {*u_t = NULL;} 3335 if (locA) {ierr = DMGetWorkArray(dm, numCells*totDimAux, MPIU_SCALAR, a);CHKERRQ(ierr);} else {*a = NULL;} 3336 for (c = cStart; c < cEnd; ++c) { 3337 const PetscInt cell = cells ? cells[c] : c; 3338 const PetscInt cind = c - cStart; 3339 PetscScalar *x = NULL, *x_t = NULL, *ul = *u, *ul_t = *u_t, *al = *a; 3340 PetscInt i; 3341 3342 ierr = DMPlexVecGetClosure(plex, section, locX, cell, NULL, &x);CHKERRQ(ierr); 3343 for (i = 0; i < totDim; ++i) ul[cind*totDim+i] = x[i]; 3344 ierr = DMPlexVecRestoreClosure(plex, section, locX, cell, NULL, &x);CHKERRQ(ierr); 3345 if (locX_t) { 3346 ierr = DMPlexVecGetClosure(plex, section, locX_t, cell, NULL, &x_t);CHKERRQ(ierr); 3347 for (i = 0; i < totDim; ++i) ul_t[cind*totDim+i] = x_t[i]; 3348 ierr = DMPlexVecRestoreClosure(plex, section, locX_t, cell, NULL, &x_t);CHKERRQ(ierr); 3349 } 3350 if (locA) { 3351 PetscInt subcell; 3352 ierr = DMGetEnclosurePoint(plexA, dm, encAux, cell, &subcell);CHKERRQ(ierr); 3353 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subcell, NULL, &x);CHKERRQ(ierr); 3354 for (i = 0; i < totDimAux; ++i) al[cind*totDimAux+i] = x[i]; 3355 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subcell, NULL, &x);CHKERRQ(ierr); 3356 } 3357 } 3358 ierr = DMDestroy(&plex);CHKERRQ(ierr); 3359 if (locA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);} 3360 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3361 PetscFunctionReturn(0); 3362 } 3363 3364 /*@C 3365 DMPlexRestoreCellFields - Restore the field values values for a chunk of cells 3366 3367 Input Parameters: 3368 + dm - The DM 3369 . cellIS - The cells to include 3370 . locX - A local vector with the solution fields 3371 . locX_t - A local vector with solution field time derivatives, or NULL 3372 - locA - A local vector with auxiliary fields, or NULL 3373 3374 Output Parameters: 3375 + u - The field coefficients 3376 . u_t - The fields derivative coefficients 3377 - a - The auxiliary field coefficients 3378 3379 Level: developer 3380 3381 .seealso: DMPlexGetFaceFields() 3382 @*/ 3383 PetscErrorCode DMPlexRestoreCellFields(DM dm, IS cellIS, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a) 3384 { 3385 PetscErrorCode ierr; 3386 3387 PetscFunctionBegin; 3388 ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u);CHKERRQ(ierr); 3389 if (locX_t) {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u_t);CHKERRQ(ierr);} 3390 if (locA) {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, a);CHKERRQ(ierr);} 3391 PetscFunctionReturn(0); 3392 } 3393 3394 static PetscErrorCode DMPlexGetHybridAuxFields(DM dmAux, PetscDS dsAux[], IS cellIS, Vec locA, PetscScalar *a[]) 3395 { 3396 DM plexA; 3397 PetscSection sectionAux; 3398 const PetscInt *cells; 3399 PetscInt cStart, cEnd, numCells, c, totDimAux[2]; 3400 PetscErrorCode ierr; 3401 3402 PetscFunctionBegin; 3403 if (!locA) PetscFunctionReturn(0); 3404 PetscValidHeaderSpecific(dmAux, DM_CLASSID, 1); 3405 PetscValidPointer(dsAux, 2); 3406 PetscValidHeaderSpecific(locA, VEC_CLASSID, 4); 3407 PetscValidPointer(a, 5); 3408 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3409 ierr = DMPlexConvertPlex(dmAux, &plexA, PETSC_FALSE);CHKERRQ(ierr); 3410 ierr = DMGetLocalSection(dmAux, §ionAux);CHKERRQ(ierr); 3411 numCells = cEnd - cStart; 3412 ierr = PetscDSGetTotalDimension(dsAux[0], &totDimAux[0]);CHKERRQ(ierr); 3413 ierr = DMGetWorkArray(dmAux, numCells*totDimAux[0], MPIU_SCALAR, &a[0]);CHKERRQ(ierr); 3414 ierr = PetscDSGetTotalDimension(dsAux[1], &totDimAux[1]);CHKERRQ(ierr); 3415 ierr = DMGetWorkArray(dmAux, numCells*totDimAux[1], MPIU_SCALAR, &a[1]);CHKERRQ(ierr); 3416 for (c = cStart; c < cEnd; ++c) { 3417 const PetscInt cell = cells ? cells[c] : c; 3418 const PetscInt cind = c - cStart; 3419 const PetscInt *cone, *ornt; 3420 PetscInt c; 3421 3422 ierr = DMPlexGetCone(dmAux, cell, &cone);CHKERRQ(ierr); 3423 ierr = DMPlexGetConeOrientation(dmAux, cell, &ornt);CHKERRQ(ierr); 3424 for (c = 0; c < 2; ++c) { 3425 PetscScalar *x = NULL, *al = a[c]; 3426 const PetscInt tdA = totDimAux[c]; 3427 PetscInt Na, i; 3428 3429 if (ornt[c]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_SUP, "Face %D in hybrid cell %D has orientation %D != 0", cone[c], cell, ornt[c]); 3430 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, cone[c], &Na, &x);CHKERRQ(ierr); 3431 for (i = 0; i < Na; ++i) al[cind*tdA+i] = x[i]; 3432 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, cone[c], &Na, &x);CHKERRQ(ierr); 3433 } 3434 } 3435 ierr = DMDestroy(&plexA);CHKERRQ(ierr); 3436 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3437 PetscFunctionReturn(0); 3438 } 3439 3440 static PetscErrorCode DMPlexRestoreHybridAuxFields(DM dmAux, PetscDS dsAux[], IS cellIS, Vec locA, PetscScalar *a[]) 3441 { 3442 PetscErrorCode ierr; 3443 3444 PetscFunctionBegin; 3445 if (!locA) PetscFunctionReturn(0); 3446 ierr = DMRestoreWorkArray(dmAux, 0, MPIU_SCALAR, &a[0]);CHKERRQ(ierr); 3447 ierr = DMRestoreWorkArray(dmAux, 0, MPIU_SCALAR, &a[1]);CHKERRQ(ierr); 3448 PetscFunctionReturn(0); 3449 } 3450 3451 /*@C 3452 DMPlexGetFaceFields - Retrieve the field values values for a chunk of faces 3453 3454 Input Parameters: 3455 + dm - The DM 3456 . fStart - The first face to include 3457 . fEnd - The first face to exclude 3458 . locX - A local vector with the solution fields 3459 . locX_t - A local vector with solution field time derivatives, or NULL 3460 . faceGeometry - A local vector with face geometry 3461 . cellGeometry - A local vector with cell geometry 3462 - locaGrad - A local vector with field gradients, or NULL 3463 3464 Output Parameters: 3465 + Nface - The number of faces with field values 3466 . uL - The field values at the left side of the face 3467 - uR - The field values at the right side of the face 3468 3469 Level: developer 3470 3471 .seealso: DMPlexGetCellFields() 3472 @*/ 3473 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) 3474 { 3475 DM dmFace, dmCell, dmGrad = NULL; 3476 PetscSection section; 3477 PetscDS prob; 3478 DMLabel ghostLabel; 3479 const PetscScalar *facegeom, *cellgeom, *x, *lgrad; 3480 PetscBool *isFE; 3481 PetscInt dim, Nf, f, Nc, numFaces = fEnd - fStart, iface, face; 3482 PetscErrorCode ierr; 3483 3484 PetscFunctionBegin; 3485 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 3486 PetscValidHeaderSpecific(locX, VEC_CLASSID, 4); 3487 if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 5);} 3488 PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 6); 3489 PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 7); 3490 if (locGrad) {PetscValidHeaderSpecific(locGrad, VEC_CLASSID, 8);} 3491 PetscValidPointer(uL, 9); 3492 PetscValidPointer(uR, 10); 3493 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 3494 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 3495 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 3496 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 3497 ierr = PetscDSGetTotalComponents(prob, &Nc);CHKERRQ(ierr); 3498 ierr = PetscMalloc1(Nf, &isFE);CHKERRQ(ierr); 3499 for (f = 0; f < Nf; ++f) { 3500 PetscObject obj; 3501 PetscClassId id; 3502 3503 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3504 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3505 if (id == PETSCFE_CLASSID) {isFE[f] = PETSC_TRUE;} 3506 else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;} 3507 else {isFE[f] = PETSC_FALSE;} 3508 } 3509 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 3510 ierr = VecGetArrayRead(locX, &x);CHKERRQ(ierr); 3511 ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr); 3512 ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 3513 ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr); 3514 ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 3515 if (locGrad) { 3516 ierr = VecGetDM(locGrad, &dmGrad);CHKERRQ(ierr); 3517 ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr); 3518 } 3519 ierr = DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uL);CHKERRQ(ierr); 3520 ierr = DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uR);CHKERRQ(ierr); 3521 /* Right now just eat the extra work for FE (could make a cell loop) */ 3522 for (face = fStart, iface = 0; face < fEnd; ++face) { 3523 const PetscInt *cells; 3524 PetscFVFaceGeom *fg; 3525 PetscFVCellGeom *cgL, *cgR; 3526 PetscScalar *xL, *xR, *gL, *gR; 3527 PetscScalar *uLl = *uL, *uRl = *uR; 3528 PetscInt ghost, nsupp, nchild; 3529 3530 ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr); 3531 ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr); 3532 ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr); 3533 if (ghost >= 0 || nsupp > 2 || nchild > 0) continue; 3534 ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr); 3535 ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr); 3536 ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr); 3537 ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr); 3538 for (f = 0; f < Nf; ++f) { 3539 PetscInt off; 3540 3541 ierr = PetscDSGetComponentOffset(prob, f, &off);CHKERRQ(ierr); 3542 if (isFE[f]) { 3543 const PetscInt *cone; 3544 PetscInt comp, coneSizeL, coneSizeR, faceLocL, faceLocR, ldof, rdof, d; 3545 3546 xL = xR = NULL; 3547 ierr = PetscSectionGetFieldComponents(section, f, &comp);CHKERRQ(ierr); 3548 ierr = DMPlexVecGetClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL);CHKERRQ(ierr); 3549 ierr = DMPlexVecGetClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR);CHKERRQ(ierr); 3550 ierr = DMPlexGetCone(dm, cells[0], &cone);CHKERRQ(ierr); 3551 ierr = DMPlexGetConeSize(dm, cells[0], &coneSizeL);CHKERRQ(ierr); 3552 for (faceLocL = 0; faceLocL < coneSizeL; ++faceLocL) if (cone[faceLocL] == face) break; 3553 ierr = DMPlexGetCone(dm, cells[1], &cone);CHKERRQ(ierr); 3554 ierr = DMPlexGetConeSize(dm, cells[1], &coneSizeR);CHKERRQ(ierr); 3555 for (faceLocR = 0; faceLocR < coneSizeR; ++faceLocR) if (cone[faceLocR] == face) break; 3556 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]); 3557 /* Check that FEM field has values in the right cell (sometimes its an FV ghost cell) */ 3558 /* TODO: this is a hack that might not be right for nonconforming */ 3559 if (faceLocL < coneSizeL) { 3560 ierr = PetscFEEvaluateFaceFields_Internal(prob, f, faceLocL, xL, &uLl[iface*Nc+off]);CHKERRQ(ierr); 3561 if (rdof == ldof && faceLocR < coneSizeR) {ierr = PetscFEEvaluateFaceFields_Internal(prob, f, faceLocR, xR, &uRl[iface*Nc+off]);CHKERRQ(ierr);} 3562 else {for (d = 0; d < comp; ++d) uRl[iface*Nc+off+d] = uLl[iface*Nc+off+d];} 3563 } 3564 else { 3565 ierr = PetscFEEvaluateFaceFields_Internal(prob, f, faceLocR, xR, &uRl[iface*Nc+off]);CHKERRQ(ierr); 3566 ierr = PetscSectionGetFieldComponents(section, f, &comp);CHKERRQ(ierr); 3567 for (d = 0; d < comp; ++d) uLl[iface*Nc+off+d] = uRl[iface*Nc+off+d]; 3568 } 3569 ierr = DMPlexVecRestoreClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL);CHKERRQ(ierr); 3570 ierr = DMPlexVecRestoreClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR);CHKERRQ(ierr); 3571 } else { 3572 PetscFV fv; 3573 PetscInt numComp, c; 3574 3575 ierr = PetscDSGetDiscretization(prob, f, (PetscObject *) &fv);CHKERRQ(ierr); 3576 ierr = PetscFVGetNumComponents(fv, &numComp);CHKERRQ(ierr); 3577 ierr = DMPlexPointLocalFieldRead(dm, cells[0], f, x, &xL);CHKERRQ(ierr); 3578 ierr = DMPlexPointLocalFieldRead(dm, cells[1], f, x, &xR);CHKERRQ(ierr); 3579 if (dmGrad) { 3580 PetscReal dxL[3], dxR[3]; 3581 3582 ierr = DMPlexPointLocalRead(dmGrad, cells[0], lgrad, &gL);CHKERRQ(ierr); 3583 ierr = DMPlexPointLocalRead(dmGrad, cells[1], lgrad, &gR);CHKERRQ(ierr); 3584 DMPlex_WaxpyD_Internal(dim, -1, cgL->centroid, fg->centroid, dxL); 3585 DMPlex_WaxpyD_Internal(dim, -1, cgR->centroid, fg->centroid, dxR); 3586 for (c = 0; c < numComp; ++c) { 3587 uLl[iface*Nc+off+c] = xL[c] + DMPlex_DotD_Internal(dim, &gL[c*dim], dxL); 3588 uRl[iface*Nc+off+c] = xR[c] + DMPlex_DotD_Internal(dim, &gR[c*dim], dxR); 3589 } 3590 } else { 3591 for (c = 0; c < numComp; ++c) { 3592 uLl[iface*Nc+off+c] = xL[c]; 3593 uRl[iface*Nc+off+c] = xR[c]; 3594 } 3595 } 3596 } 3597 } 3598 ++iface; 3599 } 3600 *Nface = iface; 3601 ierr = VecRestoreArrayRead(locX, &x);CHKERRQ(ierr); 3602 ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 3603 ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 3604 if (locGrad) { 3605 ierr = VecRestoreArrayRead(locGrad, &lgrad);CHKERRQ(ierr); 3606 } 3607 ierr = PetscFree(isFE);CHKERRQ(ierr); 3608 PetscFunctionReturn(0); 3609 } 3610 3611 /*@C 3612 DMPlexRestoreFaceFields - Restore the field values values for a chunk of faces 3613 3614 Input Parameters: 3615 + dm - The DM 3616 . fStart - The first face to include 3617 . fEnd - The first face to exclude 3618 . locX - A local vector with the solution fields 3619 . locX_t - A local vector with solution field time derivatives, or NULL 3620 . faceGeometry - A local vector with face geometry 3621 . cellGeometry - A local vector with cell geometry 3622 - locaGrad - A local vector with field gradients, or NULL 3623 3624 Output Parameters: 3625 + Nface - The number of faces with field values 3626 . uL - The field values at the left side of the face 3627 - uR - The field values at the right side of the face 3628 3629 Level: developer 3630 3631 .seealso: DMPlexGetFaceFields() 3632 @*/ 3633 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) 3634 { 3635 PetscErrorCode ierr; 3636 3637 PetscFunctionBegin; 3638 ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uL);CHKERRQ(ierr); 3639 ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uR);CHKERRQ(ierr); 3640 PetscFunctionReturn(0); 3641 } 3642 3643 /*@C 3644 DMPlexGetFaceGeometry - Retrieve the geometric values for a chunk of faces 3645 3646 Input Parameters: 3647 + dm - The DM 3648 . fStart - The first face to include 3649 . fEnd - The first face to exclude 3650 . faceGeometry - A local vector with face geometry 3651 - cellGeometry - A local vector with cell geometry 3652 3653 Output Parameters: 3654 + Nface - The number of faces with field values 3655 . fgeom - The extract the face centroid and normal 3656 - vol - The cell volume 3657 3658 Level: developer 3659 3660 .seealso: DMPlexGetCellFields() 3661 @*/ 3662 PetscErrorCode DMPlexGetFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscInt *Nface, PetscFVFaceGeom **fgeom, PetscReal **vol) 3663 { 3664 DM dmFace, dmCell; 3665 DMLabel ghostLabel; 3666 const PetscScalar *facegeom, *cellgeom; 3667 PetscInt dim, numFaces = fEnd - fStart, iface, face; 3668 PetscErrorCode ierr; 3669 3670 PetscFunctionBegin; 3671 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 3672 PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 4); 3673 PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 5); 3674 PetscValidPointer(fgeom, 6); 3675 PetscValidPointer(vol, 7); 3676 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 3677 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 3678 ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr); 3679 ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 3680 ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr); 3681 ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 3682 ierr = PetscMalloc1(numFaces, fgeom);CHKERRQ(ierr); 3683 ierr = DMGetWorkArray(dm, numFaces*2, MPIU_SCALAR, vol);CHKERRQ(ierr); 3684 for (face = fStart, iface = 0; face < fEnd; ++face) { 3685 const PetscInt *cells; 3686 PetscFVFaceGeom *fg; 3687 PetscFVCellGeom *cgL, *cgR; 3688 PetscFVFaceGeom *fgeoml = *fgeom; 3689 PetscReal *voll = *vol; 3690 PetscInt ghost, d, nchild, nsupp; 3691 3692 ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr); 3693 ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr); 3694 ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr); 3695 if (ghost >= 0 || nsupp > 2 || nchild > 0) continue; 3696 ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr); 3697 ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr); 3698 ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr); 3699 ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr); 3700 for (d = 0; d < dim; ++d) { 3701 fgeoml[iface].centroid[d] = fg->centroid[d]; 3702 fgeoml[iface].normal[d] = fg->normal[d]; 3703 } 3704 voll[iface*2+0] = cgL->volume; 3705 voll[iface*2+1] = cgR->volume; 3706 ++iface; 3707 } 3708 *Nface = iface; 3709 ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 3710 ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 3711 PetscFunctionReturn(0); 3712 } 3713 3714 /*@C 3715 DMPlexRestoreFaceGeometry - Restore the field values values for a chunk of faces 3716 3717 Input Parameters: 3718 + dm - The DM 3719 . fStart - The first face to include 3720 . fEnd - The first face to exclude 3721 . faceGeometry - A local vector with face geometry 3722 - cellGeometry - A local vector with cell geometry 3723 3724 Output Parameters: 3725 + Nface - The number of faces with field values 3726 . fgeom - The extract the face centroid and normal 3727 - vol - The cell volume 3728 3729 Level: developer 3730 3731 .seealso: DMPlexGetFaceFields() 3732 @*/ 3733 PetscErrorCode DMPlexRestoreFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscInt *Nface, PetscFVFaceGeom **fgeom, PetscReal **vol) 3734 { 3735 PetscErrorCode ierr; 3736 3737 PetscFunctionBegin; 3738 ierr = PetscFree(*fgeom);CHKERRQ(ierr); 3739 ierr = DMRestoreWorkArray(dm, 0, MPIU_REAL, vol);CHKERRQ(ierr); 3740 PetscFunctionReturn(0); 3741 } 3742 3743 PetscErrorCode DMSNESGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom) 3744 { 3745 char composeStr[33] = {0}; 3746 PetscObjectId id; 3747 PetscContainer container; 3748 PetscErrorCode ierr; 3749 3750 PetscFunctionBegin; 3751 ierr = PetscObjectGetId((PetscObject)quad,&id);CHKERRQ(ierr); 3752 ierr = PetscSNPrintf(composeStr, 32, "DMSNESGetFEGeom_%x\n", id);CHKERRQ(ierr); 3753 ierr = PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);CHKERRQ(ierr); 3754 if (container) { 3755 ierr = PetscContainerGetPointer(container, (void **) geom);CHKERRQ(ierr); 3756 } else { 3757 ierr = DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);CHKERRQ(ierr); 3758 ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr); 3759 ierr = PetscContainerSetPointer(container, (void *) *geom);CHKERRQ(ierr); 3760 ierr = PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);CHKERRQ(ierr); 3761 ierr = PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);CHKERRQ(ierr); 3762 ierr = PetscContainerDestroy(&container);CHKERRQ(ierr); 3763 } 3764 PetscFunctionReturn(0); 3765 } 3766 3767 PetscErrorCode DMSNESRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom) 3768 { 3769 PetscFunctionBegin; 3770 *geom = NULL; 3771 PetscFunctionReturn(0); 3772 } 3773 3774 PetscErrorCode DMPlexComputeResidual_Patch_Internal(DM dm, PetscSection section, IS cellIS, PetscReal t, Vec locX, Vec locX_t, Vec locF, void *user) 3775 { 3776 DM_Plex *mesh = (DM_Plex *) dm->data; 3777 const char *name = "Residual"; 3778 DM dmAux = NULL; 3779 DMLabel ghostLabel = NULL; 3780 PetscDS prob = NULL; 3781 PetscDS probAux = NULL; 3782 PetscBool useFEM = PETSC_FALSE; 3783 PetscBool isImplicit = (locX_t || t == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE; 3784 DMField coordField = NULL; 3785 Vec locA; 3786 PetscScalar *u = NULL, *u_t, *a, *uL = NULL, *uR = NULL; 3787 IS chunkIS; 3788 const PetscInt *cells; 3789 PetscInt cStart, cEnd, numCells; 3790 PetscInt Nf, f, totDim, totDimAux, numChunks, cellChunkSize, chunk, fStart, fEnd; 3791 PetscInt maxDegree = PETSC_MAX_INT; 3792 PetscHashFormKey key; 3793 PetscQuadrature affineQuad = NULL, *quads = NULL; 3794 PetscFEGeom *affineGeom = NULL, **geoms = NULL; 3795 PetscErrorCode ierr; 3796 3797 PetscFunctionBegin; 3798 ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 3799 /* FEM+FVM */ 3800 /* 1: Get sizes from dm and dmAux */ 3801 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 3802 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 3803 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 3804 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 3805 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 3806 if (locA) { 3807 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 3808 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 3809 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 3810 } 3811 /* 2: Get geometric data */ 3812 for (f = 0; f < Nf; ++f) { 3813 PetscObject obj; 3814 PetscClassId id; 3815 PetscBool fimp; 3816 3817 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr); 3818 if (isImplicit != fimp) continue; 3819 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3820 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3821 if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;} 3822 if (id == PETSCFV_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Use of FVM with PCPATCH not yet implemented"); 3823 } 3824 if (useFEM) { 3825 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 3826 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr); 3827 if (maxDegree <= 1) { 3828 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr); 3829 if (affineQuad) { 3830 ierr = DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 3831 } 3832 } else { 3833 ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr); 3834 for (f = 0; f < Nf; ++f) { 3835 PetscObject obj; 3836 PetscClassId id; 3837 PetscBool fimp; 3838 3839 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr); 3840 if (isImplicit != fimp) continue; 3841 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3842 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3843 if (id == PETSCFE_CLASSID) { 3844 PetscFE fe = (PetscFE) obj; 3845 3846 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr); 3847 ierr = PetscObjectReference((PetscObject)quads[f]);CHKERRQ(ierr); 3848 ierr = DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr); 3849 } 3850 } 3851 } 3852 } 3853 /* Loop over chunks */ 3854 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3855 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 3856 if (useFEM) {ierr = ISCreate(PETSC_COMM_SELF, &chunkIS);CHKERRQ(ierr);} 3857 numCells = cEnd - cStart; 3858 numChunks = 1; 3859 cellChunkSize = numCells/numChunks; 3860 numChunks = PetscMin(1,numCells); 3861 key.label = NULL; 3862 key.value = 0; 3863 for (chunk = 0; chunk < numChunks; ++chunk) { 3864 PetscScalar *elemVec, *fluxL = NULL, *fluxR = NULL; 3865 PetscReal *vol = NULL; 3866 PetscFVFaceGeom *fgeom = NULL; 3867 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c; 3868 PetscInt numFaces = 0; 3869 3870 /* Extract field coefficients */ 3871 if (useFEM) { 3872 ierr = ISGetPointSubrange(chunkIS, cS, cE, cells);CHKERRQ(ierr); 3873 ierr = DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr); 3874 ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 3875 ierr = PetscArrayzero(elemVec, numCells*totDim);CHKERRQ(ierr); 3876 } 3877 /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */ 3878 /* Loop over fields */ 3879 for (f = 0; f < Nf; ++f) { 3880 PetscObject obj; 3881 PetscClassId id; 3882 PetscBool fimp; 3883 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset; 3884 3885 key.field = f; 3886 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr); 3887 if (isImplicit != fimp) continue; 3888 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3889 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3890 if (id == PETSCFE_CLASSID) { 3891 PetscFE fe = (PetscFE) obj; 3892 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[f]; 3893 PetscFEGeom *chunkGeom = NULL; 3894 PetscQuadrature quad = affineQuad ? affineQuad : quads[f]; 3895 PetscInt Nq, Nb; 3896 3897 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 3898 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 3899 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 3900 blockSize = Nb; 3901 batchSize = numBlocks * blockSize; 3902 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 3903 numChunks = numCells / (numBatches*batchSize); 3904 Ne = numChunks*numBatches*batchSize; 3905 Nr = numCells % (numBatches*batchSize); 3906 offset = numCells - Nr; 3907 /* Integrate FE residual to get elemVec (need fields at quadrature points) */ 3908 /* 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) */ 3909 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 3910 ierr = PetscFEIntegrateResidual(prob, key, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec);CHKERRQ(ierr); 3911 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 3912 ierr = PetscFEIntegrateResidual(prob, key, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]);CHKERRQ(ierr); 3913 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 3914 } else if (id == PETSCFV_CLASSID) { 3915 PetscFV fv = (PetscFV) obj; 3916 3917 Ne = numFaces; 3918 /* Riemann solve over faces (need fields at face centroids) */ 3919 /* We need to evaluate FE fields at those coordinates */ 3920 ierr = PetscFVIntegrateRHSFunction(fv, prob, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR);CHKERRQ(ierr); 3921 } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f); 3922 } 3923 /* Loop over domain */ 3924 if (useFEM) { 3925 /* Add elemVec to locX */ 3926 for (c = cS; c < cE; ++c) { 3927 const PetscInt cell = cells ? cells[c] : c; 3928 const PetscInt cind = c - cStart; 3929 3930 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);} 3931 if (ghostLabel) { 3932 PetscInt ghostVal; 3933 3934 ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr); 3935 if (ghostVal > 0) continue; 3936 } 3937 ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr); 3938 } 3939 } 3940 /* Handle time derivative */ 3941 if (locX_t) { 3942 PetscScalar *x_t, *fa; 3943 3944 ierr = VecGetArray(locF, &fa);CHKERRQ(ierr); 3945 ierr = VecGetArray(locX_t, &x_t);CHKERRQ(ierr); 3946 for (f = 0; f < Nf; ++f) { 3947 PetscFV fv; 3948 PetscObject obj; 3949 PetscClassId id; 3950 PetscInt pdim, d; 3951 3952 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3953 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3954 if (id != PETSCFV_CLASSID) continue; 3955 fv = (PetscFV) obj; 3956 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr); 3957 for (c = cS; c < cE; ++c) { 3958 const PetscInt cell = cells ? cells[c] : c; 3959 PetscScalar *u_t, *r; 3960 3961 if (ghostLabel) { 3962 PetscInt ghostVal; 3963 3964 ierr = DMLabelGetValue(ghostLabel, cell, &ghostVal);CHKERRQ(ierr); 3965 if (ghostVal > 0) continue; 3966 } 3967 ierr = DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t);CHKERRQ(ierr); 3968 ierr = DMPlexPointLocalFieldRef(dm, cell, f, fa, &r);CHKERRQ(ierr); 3969 for (d = 0; d < pdim; ++d) r[d] += u_t[d]; 3970 } 3971 } 3972 ierr = VecRestoreArray(locX_t, &x_t);CHKERRQ(ierr); 3973 ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr); 3974 } 3975 if (useFEM) { 3976 ierr = DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr); 3977 ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 3978 } 3979 } 3980 if (useFEM) {ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);} 3981 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3982 /* TODO Could include boundary residual here (see DMPlexComputeResidual_Internal) */ 3983 if (useFEM) { 3984 if (maxDegree <= 1) { 3985 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 3986 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr); 3987 } else { 3988 for (f = 0; f < Nf; ++f) { 3989 ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr); 3990 ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr); 3991 } 3992 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr); 3993 } 3994 } 3995 ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 3996 PetscFunctionReturn(0); 3997 } 3998 3999 /* 4000 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 4001 4002 X - The local solution vector 4003 X_t - The local solution time derviative vector, or NULL 4004 */ 4005 PetscErrorCode DMPlexComputeJacobian_Patch_Internal(DM dm, PetscSection section, PetscSection globalSection, IS cellIS, 4006 PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP, void *ctx) 4007 { 4008 DM_Plex *mesh = (DM_Plex *) dm->data; 4009 const char *name = "Jacobian", *nameP = "JacobianPre"; 4010 DM dmAux = NULL; 4011 PetscDS prob, probAux = NULL; 4012 PetscSection sectionAux = NULL; 4013 Vec A; 4014 DMField coordField; 4015 PetscFEGeom *cgeomFEM; 4016 PetscQuadrature qGeom = NULL; 4017 Mat J = Jac, JP = JacP; 4018 PetscScalar *work, *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL, *elemMatP = NULL, *elemMatD = NULL; 4019 PetscBool hasJac, hasPrec, hasDyn, assembleJac, isMatIS, isMatISP, *isFE, hasFV = PETSC_FALSE; 4020 const PetscInt *cells; 4021 PetscHashFormKey key; 4022 PetscInt Nf, fieldI, fieldJ, maxDegree, numCells, cStart, cEnd, numChunks, chunkSize, chunk, totDim, totDimAux = 0, sz, wsz, off = 0, offCell = 0; 4023 PetscErrorCode ierr; 4024 4025 PetscFunctionBegin; 4026 CHKMEMQ; 4027 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr); 4028 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 4029 ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 4030 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 4031 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr); 4032 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr); 4033 if (dmAux) { 4034 ierr = DMGetLocalSection(dmAux, §ionAux);CHKERRQ(ierr); 4035 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 4036 } 4037 /* Get flags */ 4038 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 4039 ierr = DMGetWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr); 4040 for (fieldI = 0; fieldI < Nf; ++fieldI) { 4041 PetscObject disc; 4042 PetscClassId id; 4043 ierr = PetscDSGetDiscretization(prob, fieldI, &disc);CHKERRQ(ierr); 4044 ierr = PetscObjectGetClassId(disc, &id);CHKERRQ(ierr); 4045 if (id == PETSCFE_CLASSID) {isFE[fieldI] = PETSC_TRUE;} 4046 else if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; isFE[fieldI] = PETSC_FALSE;} 4047 } 4048 ierr = PetscDSHasJacobian(prob, &hasJac);CHKERRQ(ierr); 4049 ierr = PetscDSHasJacobianPreconditioner(prob, &hasPrec);CHKERRQ(ierr); 4050 ierr = PetscDSHasDynamicJacobian(prob, &hasDyn);CHKERRQ(ierr); 4051 assembleJac = hasJac && hasPrec && (Jac != JacP) ? PETSC_TRUE : PETSC_FALSE; 4052 hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE; 4053 ierr = PetscObjectTypeCompare((PetscObject) Jac, MATIS, &isMatIS);CHKERRQ(ierr); 4054 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr); 4055 /* Setup input data and temp arrays (should be DMGetWorkArray) */ 4056 if (isMatISP || isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &globalSection);CHKERRQ(ierr);} 4057 if (isMatIS) {ierr = MatISGetLocalMat(Jac, &J);CHKERRQ(ierr);} 4058 if (isMatISP) {ierr = MatISGetLocalMat(JacP, &JP);CHKERRQ(ierr);} 4059 if (hasFV) {ierr = MatSetOption(JP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE);CHKERRQ(ierr);} /* No allocated space for FV stuff, so ignore the zero entries */ 4060 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr); 4061 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr); 4062 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 4063 if (probAux) {ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);} 4064 CHKMEMQ; 4065 /* Compute batch sizes */ 4066 if (isFE[0]) { 4067 PetscFE fe; 4068 PetscQuadrature q; 4069 PetscInt numQuadPoints, numBatches, batchSize, numBlocks, blockSize, Nb; 4070 4071 ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr); 4072 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr); 4073 ierr = PetscQuadratureGetData(q, NULL, NULL, &numQuadPoints, NULL, NULL);CHKERRQ(ierr); 4074 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 4075 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 4076 blockSize = Nb*numQuadPoints; 4077 batchSize = numBlocks * blockSize; 4078 chunkSize = numBatches * batchSize; 4079 numChunks = numCells / chunkSize + numCells % chunkSize; 4080 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 4081 } else { 4082 chunkSize = numCells; 4083 numChunks = 1; 4084 } 4085 /* Get work space */ 4086 wsz = (((X?1:0) + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize; 4087 ierr = DMGetWorkArray(dm, wsz, MPIU_SCALAR, &work);CHKERRQ(ierr); 4088 ierr = PetscArrayzero(work, wsz);CHKERRQ(ierr); 4089 off = 0; 4090 u = X ? (sz = chunkSize*totDim, off += sz, work+off-sz) : NULL; 4091 u_t = X_t ? (sz = chunkSize*totDim, off += sz, work+off-sz) : NULL; 4092 a = dmAux ? (sz = chunkSize*totDimAux, off += sz, work+off-sz) : NULL; 4093 elemMat = hasJac ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL; 4094 elemMatP = hasPrec ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL; 4095 elemMatD = hasDyn ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL; 4096 if (off != wsz) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Error is workspace size %D should be %D", off, wsz); 4097 /* Setup geometry */ 4098 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 4099 ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr); 4100 if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, cellIS, &qGeom);CHKERRQ(ierr);} 4101 if (!qGeom) { 4102 PetscFE fe; 4103 4104 ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr); 4105 ierr = PetscFEGetQuadrature(fe, &qGeom);CHKERRQ(ierr); 4106 ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr); 4107 } 4108 ierr = DMSNESGetFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr); 4109 /* Compute volume integrals */ 4110 if (assembleJac) {ierr = MatZeroEntries(J);CHKERRQ(ierr);} 4111 ierr = MatZeroEntries(JP);CHKERRQ(ierr); 4112 key.label = NULL; 4113 key.value = 0; 4114 for (chunk = 0; chunk < numChunks; ++chunk, offCell += chunkSize) { 4115 const PetscInt Ncell = PetscMin(chunkSize, numCells - offCell); 4116 PetscInt c; 4117 4118 /* Extract values */ 4119 for (c = 0; c < Ncell; ++c) { 4120 const PetscInt cell = cells ? cells[c+offCell] : c+offCell; 4121 PetscScalar *x = NULL, *x_t = NULL; 4122 PetscInt i; 4123 4124 if (X) { 4125 ierr = DMPlexVecGetClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr); 4126 for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i]; 4127 ierr = DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr); 4128 } 4129 if (X_t) { 4130 ierr = DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 4131 for (i = 0; i < totDim; ++i) u_t[c*totDim+i] = x_t[i]; 4132 ierr = DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 4133 } 4134 if (dmAux) { 4135 ierr = DMPlexVecGetClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr); 4136 for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i]; 4137 ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr); 4138 } 4139 } 4140 CHKMEMQ; 4141 for (fieldI = 0; fieldI < Nf; ++fieldI) { 4142 PetscFE fe; 4143 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 4144 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 4145 key.field = fieldI*Nf + fieldJ; 4146 if (hasJac) {ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);} 4147 if (hasPrec) {ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr);} 4148 if (hasDyn) {ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatD);CHKERRQ(ierr);} 4149 } 4150 /* For finite volume, add the identity */ 4151 if (!isFE[fieldI]) { 4152 PetscFV fv; 4153 PetscInt eOffset = 0, Nc, fc, foff; 4154 4155 ierr = PetscDSGetFieldOffset(prob, fieldI, &foff);CHKERRQ(ierr); 4156 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv);CHKERRQ(ierr); 4157 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 4158 for (c = 0; c < chunkSize; ++c, eOffset += totDim*totDim) { 4159 for (fc = 0; fc < Nc; ++fc) { 4160 const PetscInt i = foff + fc; 4161 if (hasJac) {elemMat [eOffset+i*totDim+i] = 1.0;} 4162 if (hasPrec) {elemMatP[eOffset+i*totDim+i] = 1.0;} 4163 } 4164 } 4165 } 4166 } 4167 CHKMEMQ; 4168 /* Add contribution from X_t */ 4169 if (hasDyn) {for (c = 0; c < chunkSize*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];} 4170 /* Insert values into matrix */ 4171 for (c = 0; c < Ncell; ++c) { 4172 const PetscInt cell = cells ? cells[c+offCell] : c+offCell; 4173 if (mesh->printFEM > 1) { 4174 if (hasJac) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);} 4175 if (hasPrec) {ierr = DMPrintCellMatrix(cell, nameP, totDim, totDim, &elemMatP[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);} 4176 } 4177 if (assembleJac) {ierr = DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);} 4178 ierr = DMPlexMatSetClosure(dm, section, globalSection, JP, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 4179 } 4180 CHKMEMQ; 4181 } 4182 /* Cleanup */ 4183 ierr = DMSNESRestoreFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr); 4184 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 4185 if (hasFV) {ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);} 4186 ierr = DMRestoreWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr); 4187 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); 4188 /* Compute boundary integrals */ 4189 /* ierr = DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, ctx);CHKERRQ(ierr); */ 4190 /* Assemble matrix */ 4191 if (assembleJac) {ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);} 4192 ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 4193 ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 4194 CHKMEMQ; 4195 PetscFunctionReturn(0); 4196 } 4197 4198 /******** FEM Assembly Function ********/ 4199 4200 static PetscErrorCode DMConvertPlex_Internal(DM dm, DM *plex, PetscBool copy) 4201 { 4202 PetscBool isPlex; 4203 PetscErrorCode ierr; 4204 4205 PetscFunctionBegin; 4206 ierr = PetscObjectTypeCompare((PetscObject) dm, DMPLEX, &isPlex);CHKERRQ(ierr); 4207 if (isPlex) { 4208 *plex = dm; 4209 ierr = PetscObjectReference((PetscObject) dm);CHKERRQ(ierr); 4210 } else { 4211 ierr = PetscObjectQuery((PetscObject) dm, "dm_plex", (PetscObject *) plex);CHKERRQ(ierr); 4212 if (!*plex) { 4213 ierr = DMConvert(dm,DMPLEX,plex);CHKERRQ(ierr); 4214 ierr = PetscObjectCompose((PetscObject) dm, "dm_plex", (PetscObject) *plex);CHKERRQ(ierr); 4215 if (copy) { 4216 const char *comps[] = {"A", "dmAux"}; 4217 PetscObject obj; 4218 PetscInt i; 4219 4220 for (i = 0; i < 2; ++i) { 4221 ierr = PetscObjectQuery((PetscObject) dm, comps[i], &obj);CHKERRQ(ierr); 4222 ierr = PetscObjectCompose((PetscObject) *plex, comps[i], obj);CHKERRQ(ierr); 4223 } 4224 } 4225 } else { 4226 ierr = PetscObjectReference((PetscObject) *plex);CHKERRQ(ierr); 4227 } 4228 } 4229 PetscFunctionReturn(0); 4230 } 4231 4232 /*@ 4233 DMPlexGetGeometryFVM - Return precomputed geometric data 4234 4235 Collective on DM 4236 4237 Input Parameter: 4238 . dm - The DM 4239 4240 Output Parameters: 4241 + facegeom - The values precomputed from face geometry 4242 . cellgeom - The values precomputed from cell geometry 4243 - minRadius - The minimum radius over the mesh of an inscribed sphere in a cell 4244 4245 Level: developer 4246 4247 .seealso: DMTSSetRHSFunctionLocal() 4248 @*/ 4249 PetscErrorCode DMPlexGetGeometryFVM(DM dm, Vec *facegeom, Vec *cellgeom, PetscReal *minRadius) 4250 { 4251 DM plex; 4252 PetscErrorCode ierr; 4253 4254 PetscFunctionBegin; 4255 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 4256 ierr = DMConvertPlex_Internal(dm,&plex,PETSC_TRUE);CHKERRQ(ierr); 4257 ierr = DMPlexGetDataFVM(plex, NULL, cellgeom, facegeom, NULL);CHKERRQ(ierr); 4258 if (minRadius) {ierr = DMPlexGetMinRadius(plex, minRadius);CHKERRQ(ierr);} 4259 ierr = DMDestroy(&plex);CHKERRQ(ierr); 4260 PetscFunctionReturn(0); 4261 } 4262 4263 /*@ 4264 DMPlexGetGradientDM - Return gradient data layout 4265 4266 Collective on DM 4267 4268 Input Parameters: 4269 + dm - The DM 4270 - fv - The PetscFV 4271 4272 Output Parameter: 4273 . dmGrad - The layout for gradient values 4274 4275 Level: developer 4276 4277 .seealso: DMPlexGetGeometryFVM() 4278 @*/ 4279 PetscErrorCode DMPlexGetGradientDM(DM dm, PetscFV fv, DM *dmGrad) 4280 { 4281 DM plex; 4282 PetscBool computeGradients; 4283 PetscErrorCode ierr; 4284 4285 PetscFunctionBegin; 4286 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 4287 PetscValidHeaderSpecific(fv,PETSCFV_CLASSID,2); 4288 PetscValidPointer(dmGrad,3); 4289 ierr = PetscFVGetComputeGradients(fv, &computeGradients);CHKERRQ(ierr); 4290 if (!computeGradients) {*dmGrad = NULL; PetscFunctionReturn(0);} 4291 ierr = DMConvertPlex_Internal(dm,&plex,PETSC_TRUE);CHKERRQ(ierr); 4292 ierr = DMPlexGetDataFVM(plex, fv, NULL, NULL, dmGrad);CHKERRQ(ierr); 4293 ierr = DMDestroy(&plex);CHKERRQ(ierr); 4294 PetscFunctionReturn(0); 4295 } 4296 4297 static PetscErrorCode DMPlexComputeBdResidual_Single_Internal(DM dm, PetscReal t, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt field, Vec locX, Vec locX_t, Vec locF, DMField coordField, IS facetIS) 4298 { 4299 DM_Plex *mesh = (DM_Plex *) dm->data; 4300 DM plex = NULL, plexA = NULL; 4301 DMEnclosureType encAux; 4302 PetscDS prob, probAux = NULL; 4303 PetscSection section, sectionAux = NULL; 4304 Vec locA = NULL; 4305 PetscScalar *u = NULL, *u_t = NULL, *a = NULL, *elemVec = NULL; 4306 PetscInt v; 4307 PetscInt totDim, totDimAux = 0; 4308 PetscErrorCode ierr; 4309 4310 PetscFunctionBegin; 4311 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr); 4312 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 4313 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 4314 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 4315 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 4316 if (locA) { 4317 DM dmAux; 4318 4319 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 4320 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr); 4321 ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr); 4322 ierr = DMGetDS(plexA, &probAux);CHKERRQ(ierr); 4323 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 4324 ierr = DMGetLocalSection(plexA, §ionAux);CHKERRQ(ierr); 4325 } 4326 for (v = 0; v < numValues; ++v) { 4327 PetscFEGeom *fgeom; 4328 PetscInt maxDegree; 4329 PetscQuadrature qGeom = NULL; 4330 IS pointIS; 4331 const PetscInt *points; 4332 PetscInt numFaces, face, Nq; 4333 4334 ierr = DMLabelGetStratumIS(label, values[v], &pointIS);CHKERRQ(ierr); 4335 if (!pointIS) continue; /* No points with that id on this process */ 4336 { 4337 IS isectIS; 4338 4339 /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */ 4340 ierr = ISIntersect_Caching_Internal(facetIS,pointIS,&isectIS);CHKERRQ(ierr); 4341 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 4342 pointIS = isectIS; 4343 } 4344 ierr = ISGetLocalSize(pointIS,&numFaces);CHKERRQ(ierr); 4345 ierr = ISGetIndices(pointIS,&points);CHKERRQ(ierr); 4346 ierr = PetscMalloc4(numFaces*totDim, &u, locX_t ? numFaces*totDim : 0, &u_t, numFaces*totDim, &elemVec, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr); 4347 ierr = DMFieldGetDegree(coordField,pointIS,NULL,&maxDegree);CHKERRQ(ierr); 4348 if (maxDegree <= 1) { 4349 ierr = DMFieldCreateDefaultQuadrature(coordField,pointIS,&qGeom);CHKERRQ(ierr); 4350 } 4351 if (!qGeom) { 4352 PetscFE fe; 4353 4354 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr); 4355 ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr); 4356 ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr); 4357 } 4358 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 4359 ierr = DMSNESGetFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr); 4360 for (face = 0; face < numFaces; ++face) { 4361 const PetscInt point = points[face], *support; 4362 PetscScalar *x = NULL; 4363 PetscInt i; 4364 4365 ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr); 4366 ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 4367 for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i]; 4368 ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 4369 if (locX_t) { 4370 ierr = DMPlexVecGetClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr); 4371 for (i = 0; i < totDim; ++i) u_t[face*totDim+i] = x[i]; 4372 ierr = DMPlexVecRestoreClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr); 4373 } 4374 if (locA) { 4375 PetscInt subp; 4376 4377 ierr = DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp);CHKERRQ(ierr); 4378 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 4379 for (i = 0; i < totDimAux; ++i) a[face*totDimAux+i] = x[i]; 4380 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 4381 } 4382 } 4383 ierr = PetscArrayzero(elemVec, numFaces*totDim);CHKERRQ(ierr); 4384 { 4385 PetscFE fe; 4386 PetscInt Nb; 4387 PetscFEGeom *chunkGeom = NULL; 4388 /* Conforming batches */ 4389 PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize; 4390 /* Remainder */ 4391 PetscInt Nr, offset; 4392 4393 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr); 4394 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 4395 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 4396 /* TODO: documentation is unclear about what is going on with these numbers: how should Nb / Nq factor in ? */ 4397 blockSize = Nb; 4398 batchSize = numBlocks * blockSize; 4399 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 4400 numChunks = numFaces / (numBatches*batchSize); 4401 Ne = numChunks*numBatches*batchSize; 4402 Nr = numFaces % (numBatches*batchSize); 4403 offset = numFaces - Nr; 4404 ierr = PetscFEGeomGetChunk(fgeom,0,offset,&chunkGeom);CHKERRQ(ierr); 4405 ierr = PetscFEIntegrateBdResidual(prob, field, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec);CHKERRQ(ierr); 4406 ierr = PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom);CHKERRQ(ierr); 4407 ierr = PetscFEGeomGetChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr); 4408 ierr = PetscFEIntegrateBdResidual(prob, field, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, a ? &a[offset*totDimAux] : NULL, t, &elemVec[offset*totDim]);CHKERRQ(ierr); 4409 ierr = PetscFEGeomRestoreChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr); 4410 } 4411 for (face = 0; face < numFaces; ++face) { 4412 const PetscInt point = points[face], *support; 4413 4414 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(point, "BdResidual", totDim, &elemVec[face*totDim]);CHKERRQ(ierr);} 4415 ierr = DMPlexGetSupport(plex, point, &support);CHKERRQ(ierr); 4416 ierr = DMPlexVecSetClosure(plex, NULL, locF, support[0], &elemVec[face*totDim], ADD_ALL_VALUES);CHKERRQ(ierr); 4417 } 4418 ierr = DMSNESRestoreFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr); 4419 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 4420 ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr); 4421 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 4422 ierr = PetscFree4(u, u_t, elemVec, a);CHKERRQ(ierr); 4423 } 4424 ierr = DMDestroy(&plex);CHKERRQ(ierr); 4425 ierr = DMDestroy(&plexA);CHKERRQ(ierr); 4426 PetscFunctionReturn(0); 4427 } 4428 4429 PetscErrorCode DMPlexComputeBdResidualSingle(DM dm, PetscReal t, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt field, Vec locX, Vec locX_t, Vec locF) 4430 { 4431 DMField coordField; 4432 DMLabel depthLabel; 4433 IS facetIS; 4434 PetscInt dim; 4435 PetscErrorCode ierr; 4436 4437 PetscFunctionBegin; 4438 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 4439 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 4440 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr); 4441 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 4442 ierr = DMPlexComputeBdResidual_Single_Internal(dm, t, label, numValues, values, field, locX, locX_t, locF, coordField, facetIS);CHKERRQ(ierr); 4443 ierr = ISDestroy(&facetIS);CHKERRQ(ierr); 4444 PetscFunctionReturn(0); 4445 } 4446 4447 PetscErrorCode DMPlexComputeBdResidual_Internal(DM dm, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user) 4448 { 4449 PetscDS prob; 4450 PetscInt numBd, bd; 4451 DMField coordField = NULL; 4452 IS facetIS = NULL; 4453 DMLabel depthLabel; 4454 PetscInt dim; 4455 PetscErrorCode ierr; 4456 4457 PetscFunctionBegin; 4458 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 4459 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 4460 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 4461 ierr = DMLabelGetStratumIS(depthLabel,dim - 1,&facetIS);CHKERRQ(ierr); 4462 ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr); 4463 for (bd = 0; bd < numBd; ++bd) { 4464 DMBoundaryConditionType type; 4465 const char *bdLabel; 4466 DMLabel label; 4467 const PetscInt *values; 4468 PetscInt field, numValues; 4469 PetscObject obj; 4470 PetscClassId id; 4471 4472 ierr = PetscDSGetBoundary(prob, bd, &type, NULL, &bdLabel, &field, NULL, NULL, NULL, NULL, &numValues, &values, NULL);CHKERRQ(ierr); 4473 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 4474 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 4475 if ((id != PETSCFE_CLASSID) || (type & DM_BC_ESSENTIAL)) continue; 4476 if (!facetIS) { 4477 DMLabel depthLabel; 4478 PetscInt dim; 4479 4480 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 4481 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 4482 ierr = DMLabelGetStratumIS(depthLabel, dim - 1, &facetIS);CHKERRQ(ierr); 4483 } 4484 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 4485 ierr = DMGetLabel(dm, bdLabel, &label);CHKERRQ(ierr); 4486 ierr = DMPlexComputeBdResidual_Single_Internal(dm, t, label, numValues, values, field, locX, locX_t, locF, coordField, facetIS);CHKERRQ(ierr); 4487 } 4488 ierr = ISDestroy(&facetIS);CHKERRQ(ierr); 4489 PetscFunctionReturn(0); 4490 } 4491 4492 PetscErrorCode DMPlexComputeResidual_Internal(DM dm, PetscHashFormKey key, IS cellIS, PetscReal time, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user) 4493 { 4494 DM_Plex *mesh = (DM_Plex *) dm->data; 4495 const char *name = "Residual"; 4496 DM dmAux = NULL; 4497 DM dmGrad = NULL; 4498 DMLabel ghostLabel = NULL; 4499 PetscDS ds = NULL; 4500 PetscDS dsAux = NULL; 4501 PetscSection section = NULL; 4502 PetscBool useFEM = PETSC_FALSE; 4503 PetscBool useFVM = PETSC_FALSE; 4504 PetscBool isImplicit = (locX_t || time == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE; 4505 PetscFV fvm = NULL; 4506 PetscFVCellGeom *cgeomFVM = NULL; 4507 PetscFVFaceGeom *fgeomFVM = NULL; 4508 DMField coordField = NULL; 4509 Vec locA, cellGeometryFVM = NULL, faceGeometryFVM = NULL, grad, locGrad = NULL; 4510 PetscScalar *u = NULL, *u_t, *a, *uL, *uR; 4511 IS chunkIS; 4512 const PetscInt *cells; 4513 PetscInt cStart, cEnd, numCells; 4514 PetscInt Nf, f, totDim, totDimAux, numChunks, cellChunkSize, faceChunkSize, chunk, fStart, fEnd; 4515 PetscInt maxDegree = PETSC_MAX_INT; 4516 PetscQuadrature affineQuad = NULL, *quads = NULL; 4517 PetscFEGeom *affineGeom = NULL, **geoms = NULL; 4518 PetscErrorCode ierr; 4519 4520 PetscFunctionBegin; 4521 ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 4522 /* TODO The places where we have to use isFE are probably the member functions for the PetscDisc class */ 4523 /* TODO The FVM geometry is over-manipulated. Make the precalc functions return exactly what we need */ 4524 /* FEM+FVM */ 4525 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 4526 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 4527 /* 1: Get sizes from dm and dmAux */ 4528 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 4529 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 4530 ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &ds);CHKERRQ(ierr); 4531 ierr = PetscDSGetNumFields(ds, &Nf);CHKERRQ(ierr); 4532 ierr = PetscDSGetTotalDimension(ds, &totDim);CHKERRQ(ierr); 4533 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 4534 if (locA) { 4535 PetscInt subcell; 4536 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 4537 ierr = DMGetEnclosurePoint(dmAux, dm, DM_ENC_UNKNOWN, cStart, &subcell);CHKERRQ(ierr); 4538 ierr = DMGetCellDS(dmAux, subcell, &dsAux);CHKERRQ(ierr); 4539 ierr = PetscDSGetTotalDimension(dsAux, &totDimAux);CHKERRQ(ierr); 4540 } 4541 /* 2: Get geometric data */ 4542 for (f = 0; f < Nf; ++f) { 4543 PetscObject obj; 4544 PetscClassId id; 4545 PetscBool fimp; 4546 4547 ierr = PetscDSGetImplicit(ds, f, &fimp);CHKERRQ(ierr); 4548 if (isImplicit != fimp) continue; 4549 ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr); 4550 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 4551 if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;} 4552 if (id == PETSCFV_CLASSID) {useFVM = PETSC_TRUE; fvm = (PetscFV) obj;} 4553 } 4554 if (useFEM) { 4555 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 4556 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr); 4557 if (maxDegree <= 1) { 4558 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr); 4559 if (affineQuad) { 4560 ierr = DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 4561 } 4562 } else { 4563 ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr); 4564 for (f = 0; f < Nf; ++f) { 4565 PetscObject obj; 4566 PetscClassId id; 4567 PetscBool fimp; 4568 4569 ierr = PetscDSGetImplicit(ds, f, &fimp);CHKERRQ(ierr); 4570 if (isImplicit != fimp) continue; 4571 ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr); 4572 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 4573 if (id == PETSCFE_CLASSID) { 4574 PetscFE fe = (PetscFE) obj; 4575 4576 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr); 4577 ierr = PetscObjectReference((PetscObject)quads[f]);CHKERRQ(ierr); 4578 ierr = DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr); 4579 } 4580 } 4581 } 4582 } 4583 if (useFVM) { 4584 ierr = DMPlexGetGeometryFVM(dm, &faceGeometryFVM, &cellGeometryFVM, NULL);CHKERRQ(ierr); 4585 ierr = VecGetArrayRead(faceGeometryFVM, (const PetscScalar **) &fgeomFVM);CHKERRQ(ierr); 4586 ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr); 4587 /* Reconstruct and limit cell gradients */ 4588 ierr = DMPlexGetGradientDM(dm, fvm, &dmGrad);CHKERRQ(ierr); 4589 if (dmGrad) { 4590 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 4591 ierr = DMGetGlobalVector(dmGrad, &grad);CHKERRQ(ierr); 4592 ierr = DMPlexReconstructGradients_Internal(dm, fvm, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr); 4593 /* Communicate gradient values */ 4594 ierr = DMGetLocalVector(dmGrad, &locGrad);CHKERRQ(ierr); 4595 ierr = DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr); 4596 ierr = DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr); 4597 ierr = DMRestoreGlobalVector(dmGrad, &grad);CHKERRQ(ierr); 4598 } 4599 /* Handle non-essential (e.g. outflow) boundary values */ 4600 ierr = DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, time, faceGeometryFVM, cellGeometryFVM, locGrad);CHKERRQ(ierr); 4601 } 4602 /* Loop over chunks */ 4603 if (useFEM) {ierr = ISCreate(PETSC_COMM_SELF, &chunkIS);CHKERRQ(ierr);} 4604 numCells = cEnd - cStart; 4605 numChunks = 1; 4606 cellChunkSize = numCells/numChunks; 4607 faceChunkSize = (fEnd - fStart)/numChunks; 4608 numChunks = PetscMin(1,numCells); 4609 for (chunk = 0; chunk < numChunks; ++chunk) { 4610 PetscScalar *elemVec, *fluxL, *fluxR; 4611 PetscReal *vol; 4612 PetscFVFaceGeom *fgeom; 4613 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c; 4614 PetscInt fS = fStart+chunk*faceChunkSize, fE = PetscMin(fS+faceChunkSize, fEnd), numFaces = 0, face; 4615 4616 /* Extract field coefficients */ 4617 if (useFEM) { 4618 ierr = ISGetPointSubrange(chunkIS, cS, cE, cells);CHKERRQ(ierr); 4619 ierr = DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr); 4620 ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 4621 ierr = PetscArrayzero(elemVec, numCells*totDim);CHKERRQ(ierr); 4622 } 4623 if (useFVM) { 4624 ierr = DMPlexGetFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR);CHKERRQ(ierr); 4625 ierr = DMPlexGetFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol);CHKERRQ(ierr); 4626 ierr = DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL);CHKERRQ(ierr); 4627 ierr = DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR);CHKERRQ(ierr); 4628 ierr = PetscArrayzero(fluxL, numFaces*totDim);CHKERRQ(ierr); 4629 ierr = PetscArrayzero(fluxR, numFaces*totDim);CHKERRQ(ierr); 4630 } 4631 /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */ 4632 /* Loop over fields */ 4633 for (f = 0; f < Nf; ++f) { 4634 PetscObject obj; 4635 PetscClassId id; 4636 PetscBool fimp; 4637 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset; 4638 4639 key.field = f; 4640 ierr = PetscDSGetImplicit(ds, f, &fimp);CHKERRQ(ierr); 4641 if (isImplicit != fimp) continue; 4642 ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr); 4643 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 4644 if (id == PETSCFE_CLASSID) { 4645 PetscFE fe = (PetscFE) obj; 4646 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[f]; 4647 PetscFEGeom *chunkGeom = NULL; 4648 PetscQuadrature quad = affineQuad ? affineQuad : quads[f]; 4649 PetscInt Nq, Nb; 4650 4651 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 4652 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 4653 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 4654 blockSize = Nb; 4655 batchSize = numBlocks * blockSize; 4656 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 4657 numChunks = numCells / (numBatches*batchSize); 4658 Ne = numChunks*numBatches*batchSize; 4659 Nr = numCells % (numBatches*batchSize); 4660 offset = numCells - Nr; 4661 /* Integrate FE residual to get elemVec (need fields at quadrature points) */ 4662 /* 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) */ 4663 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 4664 ierr = PetscFEIntegrateResidual(ds, key, Ne, chunkGeom, u, u_t, dsAux, a, t, elemVec);CHKERRQ(ierr); 4665 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 4666 ierr = PetscFEIntegrateResidual(ds, key, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, dsAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]);CHKERRQ(ierr); 4667 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 4668 } else if (id == PETSCFV_CLASSID) { 4669 PetscFV fv = (PetscFV) obj; 4670 4671 Ne = numFaces; 4672 /* Riemann solve over faces (need fields at face centroids) */ 4673 /* We need to evaluate FE fields at those coordinates */ 4674 ierr = PetscFVIntegrateRHSFunction(fv, ds, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR);CHKERRQ(ierr); 4675 } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f); 4676 } 4677 /* Loop over domain */ 4678 if (useFEM) { 4679 /* Add elemVec to locX */ 4680 for (c = cS; c < cE; ++c) { 4681 const PetscInt cell = cells ? cells[c] : c; 4682 const PetscInt cind = c - cStart; 4683 4684 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);} 4685 if (ghostLabel) { 4686 PetscInt ghostVal; 4687 4688 ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr); 4689 if (ghostVal > 0) continue; 4690 } 4691 ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr); 4692 } 4693 } 4694 if (useFVM) { 4695 PetscScalar *fa; 4696 PetscInt iface; 4697 4698 ierr = VecGetArray(locF, &fa);CHKERRQ(ierr); 4699 for (f = 0; f < Nf; ++f) { 4700 PetscFV fv; 4701 PetscObject obj; 4702 PetscClassId id; 4703 PetscInt foff, pdim; 4704 4705 ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr); 4706 ierr = PetscDSGetFieldOffset(ds, f, &foff);CHKERRQ(ierr); 4707 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 4708 if (id != PETSCFV_CLASSID) continue; 4709 fv = (PetscFV) obj; 4710 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr); 4711 /* Accumulate fluxes to cells */ 4712 for (face = fS, iface = 0; face < fE; ++face) { 4713 const PetscInt *scells; 4714 PetscScalar *fL = NULL, *fR = NULL; 4715 PetscInt ghost, d, nsupp, nchild; 4716 4717 ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr); 4718 ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr); 4719 ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr); 4720 if (ghost >= 0 || nsupp > 2 || nchild > 0) continue; 4721 ierr = DMPlexGetSupport(dm, face, &scells);CHKERRQ(ierr); 4722 ierr = DMLabelGetValue(ghostLabel,scells[0],&ghost);CHKERRQ(ierr); 4723 if (ghost <= 0) {ierr = DMPlexPointLocalFieldRef(dm, scells[0], f, fa, &fL);CHKERRQ(ierr);} 4724 ierr = DMLabelGetValue(ghostLabel,scells[1],&ghost);CHKERRQ(ierr); 4725 if (ghost <= 0) {ierr = DMPlexPointLocalFieldRef(dm, scells[1], f, fa, &fR);CHKERRQ(ierr);} 4726 for (d = 0; d < pdim; ++d) { 4727 if (fL) fL[d] -= fluxL[iface*totDim+foff+d]; 4728 if (fR) fR[d] += fluxR[iface*totDim+foff+d]; 4729 } 4730 ++iface; 4731 } 4732 } 4733 ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr); 4734 } 4735 /* Handle time derivative */ 4736 if (locX_t) { 4737 PetscScalar *x_t, *fa; 4738 4739 ierr = VecGetArray(locF, &fa);CHKERRQ(ierr); 4740 ierr = VecGetArray(locX_t, &x_t);CHKERRQ(ierr); 4741 for (f = 0; f < Nf; ++f) { 4742 PetscFV fv; 4743 PetscObject obj; 4744 PetscClassId id; 4745 PetscInt pdim, d; 4746 4747 ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr); 4748 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 4749 if (id != PETSCFV_CLASSID) continue; 4750 fv = (PetscFV) obj; 4751 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr); 4752 for (c = cS; c < cE; ++c) { 4753 const PetscInt cell = cells ? cells[c] : c; 4754 PetscScalar *u_t, *r; 4755 4756 if (ghostLabel) { 4757 PetscInt ghostVal; 4758 4759 ierr = DMLabelGetValue(ghostLabel, cell, &ghostVal);CHKERRQ(ierr); 4760 if (ghostVal > 0) continue; 4761 } 4762 ierr = DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t);CHKERRQ(ierr); 4763 ierr = DMPlexPointLocalFieldRef(dm, cell, f, fa, &r);CHKERRQ(ierr); 4764 for (d = 0; d < pdim; ++d) r[d] += u_t[d]; 4765 } 4766 } 4767 ierr = VecRestoreArray(locX_t, &x_t);CHKERRQ(ierr); 4768 ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr); 4769 } 4770 if (useFEM) { 4771 ierr = DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr); 4772 ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 4773 } 4774 if (useFVM) { 4775 ierr = DMPlexRestoreFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR);CHKERRQ(ierr); 4776 ierr = DMPlexRestoreFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol);CHKERRQ(ierr); 4777 ierr = DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL);CHKERRQ(ierr); 4778 ierr = DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR);CHKERRQ(ierr); 4779 if (dmGrad) {ierr = DMRestoreLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);} 4780 } 4781 } 4782 if (useFEM) {ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);} 4783 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 4784 4785 if (useFEM) { 4786 ierr = DMPlexComputeBdResidual_Internal(dm, locX, locX_t, t, locF, user);CHKERRQ(ierr); 4787 4788 if (maxDegree <= 1) { 4789 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 4790 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr); 4791 } else { 4792 for (f = 0; f < Nf; ++f) { 4793 ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr); 4794 ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr); 4795 } 4796 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr); 4797 } 4798 } 4799 4800 /* FEM */ 4801 /* 1: Get sizes from dm and dmAux */ 4802 /* 2: Get geometric data */ 4803 /* 3: Handle boundary values */ 4804 /* 4: Loop over domain */ 4805 /* Extract coefficients */ 4806 /* Loop over fields */ 4807 /* Set tiling for FE*/ 4808 /* Integrate FE residual to get elemVec */ 4809 /* Loop over subdomain */ 4810 /* Loop over quad points */ 4811 /* Transform coords to real space */ 4812 /* Evaluate field and aux fields at point */ 4813 /* Evaluate residual at point */ 4814 /* Transform residual to real space */ 4815 /* Add residual to elemVec */ 4816 /* Loop over domain */ 4817 /* Add elemVec to locX */ 4818 4819 /* FVM */ 4820 /* Get geometric data */ 4821 /* If using gradients */ 4822 /* Compute gradient data */ 4823 /* Loop over domain faces */ 4824 /* Count computational faces */ 4825 /* Reconstruct cell gradient */ 4826 /* Loop over domain cells */ 4827 /* Limit cell gradients */ 4828 /* Handle boundary values */ 4829 /* Loop over domain faces */ 4830 /* Read out field, centroid, normal, volume for each side of face */ 4831 /* Riemann solve over faces */ 4832 /* Loop over domain faces */ 4833 /* Accumulate fluxes to cells */ 4834 /* TODO Change printFEM to printDisc here */ 4835 if (mesh->printFEM) { 4836 Vec locFbc; 4837 PetscInt pStart, pEnd, p, maxDof; 4838 PetscScalar *zeroes; 4839 4840 ierr = VecDuplicate(locF,&locFbc);CHKERRQ(ierr); 4841 ierr = VecCopy(locF,locFbc);CHKERRQ(ierr); 4842 ierr = PetscSectionGetChart(section,&pStart,&pEnd);CHKERRQ(ierr); 4843 ierr = PetscSectionGetMaxDof(section,&maxDof);CHKERRQ(ierr); 4844 ierr = PetscCalloc1(maxDof,&zeroes);CHKERRQ(ierr); 4845 for (p = pStart; p < pEnd; p++) { 4846 ierr = VecSetValuesSection(locFbc,section,p,zeroes,INSERT_BC_VALUES);CHKERRQ(ierr); 4847 } 4848 ierr = PetscFree(zeroes);CHKERRQ(ierr); 4849 ierr = DMPrintLocalVec(dm, name, mesh->printTol, locFbc);CHKERRQ(ierr); 4850 ierr = VecDestroy(&locFbc);CHKERRQ(ierr); 4851 } 4852 ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 4853 PetscFunctionReturn(0); 4854 } 4855 4856 /* 4857 1) Allow multiple kernels for BdResidual for hybrid DS 4858 4859 DONE 2) Get out dsAux for either side at the same time as cohesive cell dsAux 4860 4861 DONE 3) Change DMGetCellFields() to get different aux data a[] for each side 4862 - I think I just need to replace a[] with the closure from each face 4863 4864 4) Run both kernels for each non-hybrid field with correct dsAux, and then hybrid field as before 4865 */ 4866 PetscErrorCode DMPlexComputeResidual_Hybrid_Internal(DM dm, PetscHashFormKey key[], IS cellIS, PetscReal time, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user) 4867 { 4868 DM_Plex *mesh = (DM_Plex *) dm->data; 4869 const char *name = "Hybrid Residual"; 4870 DM dmAux = NULL; 4871 DMLabel ghostLabel = NULL; 4872 PetscDS ds = NULL; 4873 PetscDS dsAux[3] = {NULL, NULL, NULL}; 4874 PetscSection section = NULL; 4875 DMField coordField = NULL; 4876 Vec locA; 4877 PetscScalar *u = NULL, *u_t, *a[3]; 4878 PetscScalar *elemVec; 4879 IS chunkIS; 4880 const PetscInt *cells; 4881 PetscInt *faces; 4882 PetscInt cStart, cEnd, numCells; 4883 PetscInt Nf, f, totDim, totDimAux[3], numChunks, cellChunkSize, chunk; 4884 PetscInt maxDegree = PETSC_MAX_INT; 4885 PetscQuadrature affineQuad = NULL, *quads = NULL; 4886 PetscFEGeom *affineGeom = NULL, **geoms = NULL; 4887 PetscErrorCode ierr; 4888 4889 PetscFunctionBegin; 4890 ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 4891 /* TODO The places where we have to use isFE are probably the member functions for the PetscDisc class */ 4892 /* FEM */ 4893 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 4894 /* 1: Get sizes from dm and dmAux */ 4895 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 4896 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 4897 ierr = DMGetCellDS(dm, cStart, &ds);CHKERRQ(ierr); 4898 ierr = PetscDSGetNumFields(ds, &Nf);CHKERRQ(ierr); 4899 ierr = PetscDSGetTotalDimension(ds, &totDim);CHKERRQ(ierr); 4900 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 4901 if (locA) { 4902 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 4903 ierr = DMGetCellDS(dmAux, cStart, &dsAux[2]);CHKERRQ(ierr); 4904 ierr = PetscDSGetTotalDimension(dsAux[2], &totDimAux[2]);CHKERRQ(ierr); 4905 { 4906 const PetscInt *cone; 4907 PetscInt c; 4908 4909 ierr = DMPlexGetCone(dm, cStart, &cone);CHKERRQ(ierr); 4910 for (c = 0; c < 2; ++c) { 4911 const PetscInt *support; 4912 PetscInt ssize, s; 4913 4914 ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr); 4915 ierr = DMPlexGetSupportSize(dm, cone[c], &ssize);CHKERRQ(ierr); 4916 if (ssize != 2) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D from cell %D has support size %D != 2", cone[c], cStart, ssize); 4917 if (support[0] == cStart) s = 1; 4918 else if (support[1] == cStart) s = 0; 4919 else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D does not have cell %D in its support", cone[c], cStart); 4920 ierr = DMGetCellDS(dmAux, support[s], &dsAux[c]);CHKERRQ(ierr); 4921 ierr = PetscDSGetTotalDimension(dsAux[c], &totDimAux[c]);CHKERRQ(ierr); 4922 } 4923 } 4924 } 4925 /* 2: Setup geometric data */ 4926 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 4927 ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr); 4928 if (maxDegree > 1) { 4929 ierr = PetscCalloc2(Nf, &quads, Nf, &geoms);CHKERRQ(ierr); 4930 for (f = 0; f < Nf; ++f) { 4931 PetscFE fe; 4932 4933 ierr = PetscDSGetDiscretization(ds, f, (PetscObject *) &fe);CHKERRQ(ierr); 4934 if (fe) { 4935 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr); 4936 ierr = PetscObjectReference((PetscObject) quads[f]);CHKERRQ(ierr); 4937 } 4938 } 4939 } 4940 /* Loop over chunks */ 4941 numCells = cEnd - cStart; 4942 cellChunkSize = numCells; 4943 numChunks = !numCells ? 0 : PetscCeilReal(((PetscReal) numCells)/cellChunkSize); 4944 ierr = PetscCalloc1(2*cellChunkSize, &faces);CHKERRQ(ierr); 4945 ierr = ISCreateGeneral(PETSC_COMM_SELF, cellChunkSize, faces, PETSC_USE_POINTER, &chunkIS);CHKERRQ(ierr); 4946 /* Extract field coefficients */ 4947 /* NOTE This needs the end cap faces to have identical orientations */ 4948 ierr = DMPlexGetCellFields(dm, cellIS, locX, locX_t, locA, &u, &u_t, &a[2]);CHKERRQ(ierr); 4949 ierr = DMPlexGetHybridAuxFields(dm, dsAux, cellIS, locA, a);CHKERRQ(ierr); 4950 ierr = DMGetWorkArray(dm, cellChunkSize*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 4951 for (chunk = 0; chunk < numChunks; ++chunk) { 4952 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c; 4953 4954 ierr = PetscMemzero(elemVec, cellChunkSize*totDim * sizeof(PetscScalar));CHKERRQ(ierr); 4955 /* Get faces */ 4956 for (c = cS; c < cE; ++c) { 4957 const PetscInt cell = cells ? cells[c] : c; 4958 const PetscInt *cone; 4959 ierr = DMPlexGetCone(dm, cell, &cone);CHKERRQ(ierr); 4960 faces[(c-cS)*2+0] = cone[0]; 4961 faces[(c-cS)*2+1] = cone[1]; 4962 } 4963 ierr = ISGeneralSetIndices(chunkIS, cellChunkSize, faces, PETSC_USE_POINTER);CHKERRQ(ierr); 4964 /* Get geometric data */ 4965 if (maxDegree <= 1) { 4966 if (!affineQuad) {ierr = DMFieldCreateDefaultQuadrature(coordField, chunkIS, &affineQuad);CHKERRQ(ierr);} 4967 if (affineQuad) {ierr = DMSNESGetFEGeom(coordField, chunkIS, affineQuad, PETSC_TRUE, &affineGeom);CHKERRQ(ierr);} 4968 } else { 4969 for (f = 0; f < Nf; ++f) { 4970 if (quads[f]) {ierr = DMSNESGetFEGeom(coordField, chunkIS, quads[f], PETSC_TRUE, &geoms[f]);CHKERRQ(ierr);} 4971 } 4972 } 4973 /* Loop over fields */ 4974 for (f = 0; f < Nf; ++f) { 4975 PetscFE fe; 4976 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[f]; 4977 PetscFEGeom *chunkGeom = NULL; 4978 PetscQuadrature quad = affineQuad ? affineQuad : quads[f]; 4979 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset, Nq, Nb; 4980 4981 ierr = PetscDSGetDiscretization(ds, f, (PetscObject *) &fe);CHKERRQ(ierr); 4982 if (!fe) continue; 4983 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 4984 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 4985 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 4986 blockSize = Nb; 4987 batchSize = numBlocks * blockSize; 4988 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 4989 numChunks = numCells / (numBatches*batchSize); 4990 Ne = numChunks*numBatches*batchSize; 4991 Nr = numCells % (numBatches*batchSize); 4992 offset = numCells - Nr; 4993 if (f == Nf-1) { 4994 key[2].field = f; 4995 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 4996 ierr = PetscFEIntegrateHybridResidual(ds, key[2], Ne, chunkGeom, u, u_t, dsAux[2], a[2], t, elemVec);CHKERRQ(ierr); 4997 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 4998 ierr = PetscFEIntegrateHybridResidual(ds, key[2], Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, dsAux[2], &a[2][offset*totDimAux[2]], t, &elemVec[offset*totDim]);CHKERRQ(ierr); 4999 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 5000 } else { 5001 key[0].field = f; 5002 key[1].field = f; 5003 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 5004 ierr = PetscFEIntegrateHybridResidual(ds, key[0], Ne, chunkGeom, u, u_t, dsAux[0], a[0], t, elemVec);CHKERRQ(ierr); 5005 ierr = PetscFEIntegrateHybridResidual(ds, key[1], Ne, chunkGeom, u, u_t, dsAux[1], a[1], t, elemVec);CHKERRQ(ierr); 5006 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 5007 ierr = PetscFEIntegrateHybridResidual(ds, key[0], Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, dsAux[0], &a[0][offset*totDimAux[0]], t, &elemVec[offset*totDim]);CHKERRQ(ierr); 5008 ierr = PetscFEIntegrateHybridResidual(ds, key[1], Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, dsAux[1], &a[1][offset*totDimAux[1]], t, &elemVec[offset*totDim]);CHKERRQ(ierr); 5009 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 5010 } 5011 } 5012 /* Add elemVec to locX */ 5013 for (c = cS; c < cE; ++c) { 5014 const PetscInt cell = cells ? cells[c] : c; 5015 const PetscInt cind = c - cStart; 5016 5017 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);} 5018 if (ghostLabel) { 5019 PetscInt ghostVal; 5020 5021 ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr); 5022 if (ghostVal > 0) continue; 5023 } 5024 ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr); 5025 } 5026 } 5027 ierr = DMPlexRestoreCellFields(dm, cellIS, locX, locX_t, locA, &u, &u_t, &a[2]);CHKERRQ(ierr); 5028 ierr = DMPlexRestoreHybridAuxFields(dm, dsAux, cellIS, locA, a);CHKERRQ(ierr); 5029 ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 5030 ierr = PetscFree(faces);CHKERRQ(ierr); 5031 ierr = ISDestroy(&chunkIS);CHKERRQ(ierr); 5032 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 5033 if (maxDegree <= 1) { 5034 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 5035 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr); 5036 } else { 5037 for (f = 0; f < Nf; ++f) { 5038 if (geoms) {ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);} 5039 if (quads) {ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);} 5040 } 5041 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr); 5042 } 5043 ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 5044 PetscFunctionReturn(0); 5045 } 5046 5047 PetscErrorCode DMPlexComputeBdJacobian_Single_Internal(DM dm, PetscReal t, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt fieldI, Vec locX, Vec locX_t, PetscReal X_tShift, Mat Jac, Mat JacP, DMField coordField, IS facetIS) 5048 { 5049 DM_Plex *mesh = (DM_Plex *) dm->data; 5050 DM plex = NULL, plexA = NULL, tdm; 5051 DMEnclosureType encAux; 5052 PetscDS prob, probAux = NULL; 5053 PetscSection section, sectionAux = NULL; 5054 PetscSection globalSection, subSection = NULL; 5055 Vec locA = NULL, tv; 5056 PetscScalar *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL; 5057 PetscInt v; 5058 PetscInt Nf, totDim, totDimAux = 0; 5059 PetscBool isMatISP, transform; 5060 PetscErrorCode ierr; 5061 5062 PetscFunctionBegin; 5063 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr); 5064 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr); 5065 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr); 5066 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr); 5067 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 5068 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 5069 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 5070 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 5071 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 5072 if (locA) { 5073 DM dmAux; 5074 5075 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 5076 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr); 5077 ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr); 5078 ierr = DMGetDS(plexA, &probAux);CHKERRQ(ierr); 5079 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 5080 ierr = DMGetLocalSection(plexA, §ionAux);CHKERRQ(ierr); 5081 } 5082 5083 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr); 5084 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 5085 if (isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);} 5086 for (v = 0; v < numValues; ++v) { 5087 PetscFEGeom *fgeom; 5088 PetscInt maxDegree; 5089 PetscQuadrature qGeom = NULL; 5090 IS pointIS; 5091 const PetscInt *points; 5092 PetscInt numFaces, face, Nq; 5093 5094 ierr = DMLabelGetStratumIS(label, values[v], &pointIS);CHKERRQ(ierr); 5095 if (!pointIS) continue; /* No points with that id on this process */ 5096 { 5097 IS isectIS; 5098 5099 /* TODO: Special cases of ISIntersect where it is quick to check a prior if one is a superset of the other */ 5100 ierr = ISIntersect_Caching_Internal(facetIS,pointIS,&isectIS);CHKERRQ(ierr); 5101 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 5102 pointIS = isectIS; 5103 } 5104 ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr); 5105 ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr); 5106 ierr = PetscMalloc4(numFaces*totDim, &u, locX_t ? numFaces*totDim : 0, &u_t, numFaces*totDim*totDim, &elemMat, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr); 5107 ierr = DMFieldGetDegree(coordField,pointIS,NULL,&maxDegree);CHKERRQ(ierr); 5108 if (maxDegree <= 1) { 5109 ierr = DMFieldCreateDefaultQuadrature(coordField,pointIS,&qGeom);CHKERRQ(ierr); 5110 } 5111 if (!qGeom) { 5112 PetscFE fe; 5113 5114 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 5115 ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr); 5116 ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr); 5117 } 5118 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 5119 ierr = DMSNESGetFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr); 5120 for (face = 0; face < numFaces; ++face) { 5121 const PetscInt point = points[face], *support; 5122 PetscScalar *x = NULL; 5123 PetscInt i; 5124 5125 ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr); 5126 ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 5127 for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i]; 5128 ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 5129 if (locX_t) { 5130 ierr = DMPlexVecGetClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr); 5131 for (i = 0; i < totDim; ++i) u_t[face*totDim+i] = x[i]; 5132 ierr = DMPlexVecRestoreClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr); 5133 } 5134 if (locA) { 5135 PetscInt subp; 5136 ierr = DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp);CHKERRQ(ierr); 5137 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 5138 for (i = 0; i < totDimAux; ++i) a[face*totDimAux+i] = x[i]; 5139 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 5140 } 5141 } 5142 ierr = PetscArrayzero(elemMat, numFaces*totDim*totDim);CHKERRQ(ierr); 5143 { 5144 PetscFE fe; 5145 PetscInt Nb; 5146 /* Conforming batches */ 5147 PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize; 5148 /* Remainder */ 5149 PetscFEGeom *chunkGeom = NULL; 5150 PetscInt fieldJ, Nr, offset; 5151 5152 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 5153 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 5154 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 5155 blockSize = Nb; 5156 batchSize = numBlocks * blockSize; 5157 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 5158 numChunks = numFaces / (numBatches*batchSize); 5159 Ne = numChunks*numBatches*batchSize; 5160 Nr = numFaces % (numBatches*batchSize); 5161 offset = numFaces - Nr; 5162 ierr = PetscFEGeomGetChunk(fgeom,0,offset,&chunkGeom);CHKERRQ(ierr); 5163 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 5164 ierr = PetscFEIntegrateBdJacobian(prob, fieldI, fieldJ, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr); 5165 } 5166 ierr = PetscFEGeomGetChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr); 5167 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 5168 ierr = PetscFEIntegrateBdJacobian(prob, fieldI, fieldJ, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, a ? &a[offset*totDimAux] : NULL, t, X_tShift, &elemMat[offset*totDim*totDim]);CHKERRQ(ierr); 5169 } 5170 ierr = PetscFEGeomRestoreChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr); 5171 } 5172 for (face = 0; face < numFaces; ++face) { 5173 const PetscInt point = points[face], *support; 5174 5175 /* Transform to global basis before insertion in Jacobian */ 5176 ierr = DMPlexGetSupport(plex, point, &support);CHKERRQ(ierr); 5177 if (transform) {ierr = DMPlexBasisTransformPointTensor_Internal(dm, tdm, tv, support[0], PETSC_TRUE, totDim, &elemMat[face*totDim*totDim]);CHKERRQ(ierr);} 5178 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(point, "BdJacobian", totDim, totDim, &elemMat[face*totDim*totDim]);CHKERRQ(ierr);} 5179 if (!isMatISP) { 5180 ierr = DMPlexMatSetClosure(plex, section, globalSection, JacP, support[0], &elemMat[face*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5181 } else { 5182 Mat lJ; 5183 5184 ierr = MatISGetLocalMat(JacP, &lJ);CHKERRQ(ierr); 5185 ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, support[0], &elemMat[face*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5186 } 5187 } 5188 ierr = DMSNESRestoreFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr); 5189 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 5190 ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr); 5191 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 5192 ierr = PetscFree4(u, u_t, elemMat, a);CHKERRQ(ierr); 5193 } 5194 if (plex) {ierr = DMDestroy(&plex);CHKERRQ(ierr);} 5195 if (plexA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);} 5196 PetscFunctionReturn(0); 5197 } 5198 5199 PetscErrorCode DMPlexComputeBdJacobianSingle(DM dm, PetscReal t, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt field, Vec locX, Vec locX_t, PetscReal X_tShift, Mat Jac, Mat JacP) 5200 { 5201 DMField coordField; 5202 DMLabel depthLabel; 5203 IS facetIS; 5204 PetscInt dim; 5205 PetscErrorCode ierr; 5206 5207 PetscFunctionBegin; 5208 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 5209 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 5210 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr); 5211 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 5212 ierr = DMPlexComputeBdJacobian_Single_Internal(dm, t, label, numValues, values, field, locX, locX_t, X_tShift, Jac, JacP, coordField, facetIS);CHKERRQ(ierr); 5213 ierr = ISDestroy(&facetIS);CHKERRQ(ierr); 5214 PetscFunctionReturn(0); 5215 } 5216 5217 PetscErrorCode DMPlexComputeBdJacobian_Internal(DM dm, Vec locX, Vec locX_t, PetscReal t, PetscReal X_tShift, Mat Jac, Mat JacP, void *user) 5218 { 5219 PetscDS prob; 5220 PetscInt dim, numBd, bd; 5221 DMLabel depthLabel; 5222 DMField coordField = NULL; 5223 IS facetIS; 5224 PetscErrorCode ierr; 5225 5226 PetscFunctionBegin; 5227 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 5228 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 5229 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 5230 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr); 5231 ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr); 5232 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 5233 for (bd = 0; bd < numBd; ++bd) { 5234 DMBoundaryConditionType type; 5235 const char *bdLabel; 5236 DMLabel label; 5237 const PetscInt *values; 5238 PetscInt fieldI, numValues; 5239 PetscObject obj; 5240 PetscClassId id; 5241 5242 ierr = PetscDSGetBoundary(prob, bd, &type, NULL, &bdLabel, &fieldI, NULL, NULL, NULL, NULL, &numValues, &values, NULL);CHKERRQ(ierr); 5243 ierr = PetscDSGetDiscretization(prob, fieldI, &obj);CHKERRQ(ierr); 5244 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 5245 if ((id != PETSCFE_CLASSID) || (type & DM_BC_ESSENTIAL)) continue; 5246 ierr = DMGetLabel(dm, bdLabel, &label);CHKERRQ(ierr); 5247 ierr = DMPlexComputeBdJacobian_Single_Internal(dm, t, label, numValues, values, fieldI, locX, locX_t, X_tShift, Jac, JacP, coordField, facetIS);CHKERRQ(ierr); 5248 } 5249 ierr = ISDestroy(&facetIS);CHKERRQ(ierr); 5250 PetscFunctionReturn(0); 5251 } 5252 5253 PetscErrorCode DMPlexComputeJacobian_Internal(DM dm, PetscHashFormKey key, IS cellIS, PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP,void *user) 5254 { 5255 DM_Plex *mesh = (DM_Plex *) dm->data; 5256 const char *name = "Jacobian"; 5257 DM dmAux, plex, tdm; 5258 DMEnclosureType encAux; 5259 Vec A, tv; 5260 DMField coordField; 5261 PetscDS prob, probAux = NULL; 5262 PetscSection section, globalSection, subSection, sectionAux; 5263 PetscScalar *elemMat, *elemMatP, *elemMatD, *u, *u_t, *a = NULL; 5264 const PetscInt *cells; 5265 PetscInt Nf, fieldI, fieldJ; 5266 PetscInt totDim, totDimAux, cStart, cEnd, numCells, c; 5267 PetscBool isMatIS, isMatISP, hasJac, hasPrec, hasDyn, hasFV = PETSC_FALSE, transform; 5268 PetscErrorCode ierr; 5269 5270 PetscFunctionBegin; 5271 ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 5272 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr); 5273 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 5274 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr); 5275 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr); 5276 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr); 5277 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 5278 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr); 5279 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 5280 if (isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);} 5281 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr); 5282 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 5283 ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob);CHKERRQ(ierr); 5284 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 5285 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 5286 ierr = PetscDSHasJacobian(prob, &hasJac);CHKERRQ(ierr); 5287 ierr = PetscDSHasJacobianPreconditioner(prob, &hasPrec);CHKERRQ(ierr); 5288 /* user passed in the same matrix, avoid double contributions and 5289 only assemble the Jacobian */ 5290 if (hasJac && Jac == JacP) hasPrec = PETSC_FALSE; 5291 ierr = PetscDSHasDynamicJacobian(prob, &hasDyn);CHKERRQ(ierr); 5292 hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE; 5293 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr); 5294 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr); 5295 if (dmAux) { 5296 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr); 5297 ierr = DMConvert(dmAux, DMPLEX, &plex);CHKERRQ(ierr); 5298 ierr = DMGetLocalSection(plex, §ionAux);CHKERRQ(ierr); 5299 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 5300 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 5301 } 5302 ierr = PetscMalloc5(numCells*totDim,&u,X_t ? numCells*totDim : 0,&u_t,hasJac ? numCells*totDim*totDim : 0,&elemMat,hasPrec ? numCells*totDim*totDim : 0, &elemMatP,hasDyn ? numCells*totDim*totDim : 0, &elemMatD);CHKERRQ(ierr); 5303 if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);} 5304 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 5305 for (c = cStart; c < cEnd; ++c) { 5306 const PetscInt cell = cells ? cells[c] : c; 5307 const PetscInt cind = c - cStart; 5308 PetscScalar *x = NULL, *x_t = NULL; 5309 PetscInt i; 5310 5311 ierr = DMPlexVecGetClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr); 5312 for (i = 0; i < totDim; ++i) u[cind*totDim+i] = x[i]; 5313 ierr = DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr); 5314 if (X_t) { 5315 ierr = DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 5316 for (i = 0; i < totDim; ++i) u_t[cind*totDim+i] = x_t[i]; 5317 ierr = DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 5318 } 5319 if (dmAux) { 5320 PetscInt subcell; 5321 ierr = DMGetEnclosurePoint(dmAux, dm, encAux, cell, &subcell);CHKERRQ(ierr); 5322 ierr = DMPlexVecGetClosure(plex, sectionAux, A, subcell, NULL, &x);CHKERRQ(ierr); 5323 for (i = 0; i < totDimAux; ++i) a[cind*totDimAux+i] = x[i]; 5324 ierr = DMPlexVecRestoreClosure(plex, sectionAux, A, subcell, NULL, &x);CHKERRQ(ierr); 5325 } 5326 } 5327 if (hasJac) {ierr = PetscArrayzero(elemMat, numCells*totDim*totDim);CHKERRQ(ierr);} 5328 if (hasPrec) {ierr = PetscArrayzero(elemMatP, numCells*totDim*totDim);CHKERRQ(ierr);} 5329 if (hasDyn) {ierr = PetscArrayzero(elemMatD, numCells*totDim*totDim);CHKERRQ(ierr);} 5330 for (fieldI = 0; fieldI < Nf; ++fieldI) { 5331 PetscClassId id; 5332 PetscFE fe; 5333 PetscQuadrature qGeom = NULL; 5334 PetscInt Nb; 5335 /* Conforming batches */ 5336 PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize; 5337 /* Remainder */ 5338 PetscInt Nr, offset, Nq; 5339 PetscInt maxDegree; 5340 PetscFEGeom *cgeomFEM, *chunkGeom = NULL, *remGeom = NULL; 5341 5342 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 5343 ierr = PetscObjectGetClassId((PetscObject) fe, &id);CHKERRQ(ierr); 5344 if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; continue;} 5345 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 5346 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 5347 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr); 5348 if (maxDegree <= 1) { 5349 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&qGeom);CHKERRQ(ierr); 5350 } 5351 if (!qGeom) { 5352 ierr = PetscFEGetQuadrature(fe,&qGeom);CHKERRQ(ierr); 5353 ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr); 5354 } 5355 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 5356 ierr = DMSNESGetFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr); 5357 blockSize = Nb; 5358 batchSize = numBlocks * blockSize; 5359 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 5360 numChunks = numCells / (numBatches*batchSize); 5361 Ne = numChunks*numBatches*batchSize; 5362 Nr = numCells % (numBatches*batchSize); 5363 offset = numCells - Nr; 5364 ierr = PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr); 5365 ierr = PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&remGeom);CHKERRQ(ierr); 5366 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 5367 key.field = fieldI*Nf+fieldJ; 5368 if (hasJac) { 5369 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr); 5370 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, key, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMat[offset*totDim*totDim]);CHKERRQ(ierr); 5371 } 5372 if (hasPrec) { 5373 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr); 5374 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMatP[offset*totDim*totDim]);CHKERRQ(ierr); 5375 } 5376 if (hasDyn) { 5377 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatD);CHKERRQ(ierr); 5378 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMatD[offset*totDim*totDim]);CHKERRQ(ierr); 5379 } 5380 } 5381 ierr = PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&remGeom);CHKERRQ(ierr); 5382 ierr = PetscFEGeomRestoreChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr); 5383 ierr = DMSNESRestoreFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr); 5384 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 5385 } 5386 /* Add contribution from X_t */ 5387 if (hasDyn) {for (c = 0; c < numCells*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];} 5388 if (hasFV) { 5389 PetscClassId id; 5390 PetscFV fv; 5391 PetscInt offsetI, NcI, NbI = 1, fc, f; 5392 5393 for (fieldI = 0; fieldI < Nf; ++fieldI) { 5394 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv);CHKERRQ(ierr); 5395 ierr = PetscDSGetFieldOffset(prob, fieldI, &offsetI);CHKERRQ(ierr); 5396 ierr = PetscObjectGetClassId((PetscObject) fv, &id);CHKERRQ(ierr); 5397 if (id != PETSCFV_CLASSID) continue; 5398 /* Put in the identity */ 5399 ierr = PetscFVGetNumComponents(fv, &NcI);CHKERRQ(ierr); 5400 for (c = cStart; c < cEnd; ++c) { 5401 const PetscInt cind = c - cStart; 5402 const PetscInt eOffset = cind*totDim*totDim; 5403 for (fc = 0; fc < NcI; ++fc) { 5404 for (f = 0; f < NbI; ++f) { 5405 const PetscInt i = offsetI + f*NcI+fc; 5406 if (hasPrec) { 5407 if (hasJac) {elemMat[eOffset+i*totDim+i] = 1.0;} 5408 elemMatP[eOffset+i*totDim+i] = 1.0; 5409 } else {elemMat[eOffset+i*totDim+i] = 1.0;} 5410 } 5411 } 5412 } 5413 } 5414 /* No allocated space for FV stuff, so ignore the zero entries */ 5415 ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE);CHKERRQ(ierr); 5416 } 5417 /* Insert values into matrix */ 5418 isMatIS = PETSC_FALSE; 5419 if (hasPrec && hasJac) { 5420 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatIS);CHKERRQ(ierr); 5421 } 5422 if (isMatIS && !subSection) { 5423 ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr); 5424 } 5425 for (c = cStart; c < cEnd; ++c) { 5426 const PetscInt cell = cells ? cells[c] : c; 5427 const PetscInt cind = c - cStart; 5428 5429 /* Transform to global basis before insertion in Jacobian */ 5430 if (transform) {ierr = DMPlexBasisTransformPointTensor_Internal(dm, tdm, tv, cell, PETSC_TRUE, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);} 5431 if (hasPrec) { 5432 if (hasJac) { 5433 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);} 5434 if (!isMatIS) { 5435 ierr = DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5436 } else { 5437 Mat lJ; 5438 5439 ierr = MatISGetLocalMat(Jac,&lJ);CHKERRQ(ierr); 5440 ierr = DMPlexMatSetClosure(dm, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5441 } 5442 } 5443 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMatP[cind*totDim*totDim]);CHKERRQ(ierr);} 5444 if (!isMatISP) { 5445 ierr = DMPlexMatSetClosure(dm, section, globalSection, JacP, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5446 } else { 5447 Mat lJ; 5448 5449 ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr); 5450 ierr = DMPlexMatSetClosure(dm, section, subSection, lJ, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5451 } 5452 } else { 5453 if (hasJac) { 5454 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);} 5455 if (!isMatISP) { 5456 ierr = DMPlexMatSetClosure(dm, section, globalSection, JacP, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5457 } else { 5458 Mat lJ; 5459 5460 ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr); 5461 ierr = DMPlexMatSetClosure(dm, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5462 } 5463 } 5464 } 5465 } 5466 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 5467 if (hasFV) {ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);} 5468 ierr = PetscFree5(u,u_t,elemMat,elemMatP,elemMatD);CHKERRQ(ierr); 5469 if (dmAux) { 5470 ierr = PetscFree(a);CHKERRQ(ierr); 5471 ierr = DMDestroy(&plex);CHKERRQ(ierr); 5472 } 5473 /* Compute boundary integrals */ 5474 ierr = DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, user);CHKERRQ(ierr); 5475 /* Assemble matrix */ 5476 if (hasJac && hasPrec) { 5477 ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5478 ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5479 } 5480 ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5481 ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5482 ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 5483 PetscFunctionReturn(0); 5484 } 5485 5486 PetscErrorCode DMPlexComputeJacobian_Hybrid_Internal(DM dm, IS cellIS, PetscReal t, PetscReal X_tShift, Vec locX, Vec locX_t, Mat Jac, Mat JacP, void *user) 5487 { 5488 DM_Plex *mesh = (DM_Plex *) dm->data; 5489 const char *name = "Hybrid Jacobian"; 5490 DM dmAux = NULL; 5491 DM plex = NULL; 5492 DM plexA = NULL; 5493 DMLabel ghostLabel = NULL; 5494 PetscDS prob = NULL; 5495 PetscDS probAux = NULL; 5496 PetscSection section = NULL; 5497 DMField coordField = NULL; 5498 Vec locA; 5499 PetscScalar *u = NULL, *u_t, *a = NULL; 5500 PetscScalar *elemMat, *elemMatP; 5501 PetscSection globalSection, subSection, sectionAux; 5502 IS chunkIS; 5503 const PetscInt *cells; 5504 PetscInt *faces; 5505 PetscInt cStart, cEnd, numCells; 5506 PetscInt Nf, fieldI, fieldJ, totDim, totDimAux, numChunks, cellChunkSize, chunk; 5507 PetscInt maxDegree = PETSC_MAX_INT; 5508 PetscQuadrature affineQuad = NULL, *quads = NULL; 5509 PetscFEGeom *affineGeom = NULL, **geoms = NULL; 5510 PetscBool isMatIS = PETSC_FALSE, isMatISP = PETSC_FALSE, hasBdJac, hasBdPrec; 5511 PetscErrorCode ierr; 5512 5513 PetscFunctionBegin; 5514 ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 5515 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr); 5516 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 5517 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr); 5518 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 5519 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 5520 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 5521 ierr = DMGetCellDS(dm, cStart, &prob);CHKERRQ(ierr); 5522 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 5523 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 5524 ierr = PetscDSHasBdJacobian(prob, &hasBdJac);CHKERRQ(ierr); 5525 ierr = PetscDSHasBdJacobianPreconditioner(prob, &hasBdPrec);CHKERRQ(ierr); 5526 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr); 5527 if (isMatISP) {ierr = DMPlexGetSubdomainSection(plex, &subSection);CHKERRQ(ierr);} 5528 if (hasBdPrec && hasBdJac) {ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatIS);CHKERRQ(ierr);} 5529 if (isMatIS && !subSection) {ierr = DMPlexGetSubdomainSection(plex, &subSection);CHKERRQ(ierr);} 5530 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 5531 if (locA) { 5532 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 5533 ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr); 5534 ierr = DMGetSection(dmAux, §ionAux);CHKERRQ(ierr); 5535 ierr = DMGetCellDS(dmAux, cStart, &probAux);CHKERRQ(ierr); 5536 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 5537 } 5538 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 5539 ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr); 5540 if (maxDegree > 1) { 5541 PetscInt f; 5542 ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr); 5543 for (f = 0; f < Nf; ++f) { 5544 PetscFE fe; 5545 5546 ierr = PetscDSGetDiscretization(prob, f, (PetscObject *) &fe);CHKERRQ(ierr); 5547 if (fe) { 5548 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr); 5549 ierr = PetscObjectReference((PetscObject) quads[f]);CHKERRQ(ierr); 5550 } 5551 } 5552 } 5553 cellChunkSize = numCells; 5554 numChunks = !numCells ? 0 : PetscCeilReal(((PetscReal) numCells)/cellChunkSize); 5555 ierr = PetscCalloc1(2*cellChunkSize, &faces);CHKERRQ(ierr); 5556 ierr = ISCreateGeneral(PETSC_COMM_SELF, cellChunkSize, faces, PETSC_USE_POINTER, &chunkIS);CHKERRQ(ierr); 5557 ierr = DMPlexGetCellFields(dm, cellIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr); 5558 ierr = DMGetWorkArray(dm, hasBdJac ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMat);CHKERRQ(ierr); 5559 ierr = DMGetWorkArray(dm, hasBdPrec ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMatP);CHKERRQ(ierr); 5560 for (chunk = 0; chunk < numChunks; ++chunk) { 5561 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c; 5562 5563 if (hasBdJac) {ierr = PetscMemzero(elemMat, numCells*totDim*totDim * sizeof(PetscScalar));CHKERRQ(ierr);} 5564 if (hasBdPrec) {ierr = PetscMemzero(elemMatP, numCells*totDim*totDim * sizeof(PetscScalar));CHKERRQ(ierr);} 5565 /* Get faces */ 5566 for (c = cS; c < cE; ++c) { 5567 const PetscInt cell = cells ? cells[c] : c; 5568 const PetscInt *cone; 5569 ierr = DMPlexGetCone(plex, cell, &cone);CHKERRQ(ierr); 5570 faces[(c-cS)*2+0] = cone[0]; 5571 faces[(c-cS)*2+1] = cone[1]; 5572 } 5573 ierr = ISGeneralSetIndices(chunkIS, cellChunkSize, faces, PETSC_USE_POINTER);CHKERRQ(ierr); 5574 if (maxDegree <= 1) { 5575 if (!affineQuad) {ierr = DMFieldCreateDefaultQuadrature(coordField, chunkIS, &affineQuad);CHKERRQ(ierr);} 5576 if (affineQuad) {ierr = DMSNESGetFEGeom(coordField, chunkIS, affineQuad, PETSC_TRUE, &affineGeom);CHKERRQ(ierr);} 5577 } else { 5578 PetscInt f; 5579 for (f = 0; f < Nf; ++f) { 5580 if (quads[f]) {ierr = DMSNESGetFEGeom(coordField, chunkIS, quads[f], PETSC_TRUE, &geoms[f]);CHKERRQ(ierr);} 5581 } 5582 } 5583 5584 for (fieldI = 0; fieldI < Nf; ++fieldI) { 5585 PetscFE feI; 5586 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[fieldI]; 5587 PetscFEGeom *chunkGeom = NULL, *remGeom = NULL; 5588 PetscQuadrature quad = affineQuad ? affineQuad : quads[fieldI]; 5589 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset, Nq, Nb; 5590 5591 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &feI);CHKERRQ(ierr); 5592 if (!feI) continue; 5593 ierr = PetscFEGetTileSizes(feI, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 5594 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 5595 ierr = PetscFEGetDimension(feI, &Nb);CHKERRQ(ierr); 5596 blockSize = Nb; 5597 batchSize = numBlocks * blockSize; 5598 ierr = PetscFESetTileSizes(feI, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 5599 numChunks = numCells / (numBatches*batchSize); 5600 Ne = numChunks*numBatches*batchSize; 5601 Nr = numCells % (numBatches*batchSize); 5602 offset = numCells - Nr; 5603 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 5604 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&remGeom);CHKERRQ(ierr); 5605 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 5606 PetscFE feJ; 5607 5608 ierr = PetscDSGetDiscretization(prob, fieldJ, (PetscObject *) &feJ);CHKERRQ(ierr); 5609 if (!feJ) continue; 5610 if (hasBdJac) { 5611 ierr = PetscFEIntegrateHybridJacobian(prob, PETSCFE_JACOBIAN, fieldI, fieldJ, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr); 5612 ierr = PetscFEIntegrateHybridJacobian(prob, PETSCFE_JACOBIAN, fieldI, fieldJ, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMat[offset*totDim*totDim]);CHKERRQ(ierr); 5613 } 5614 if (hasBdPrec) { 5615 ierr = PetscFEIntegrateHybridJacobian(prob, PETSCFE_JACOBIAN_PRE, fieldI, fieldJ, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr); 5616 ierr = PetscFEIntegrateHybridJacobian(prob, PETSCFE_JACOBIAN_PRE, fieldI, fieldJ, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMatP[offset*totDim*totDim]);CHKERRQ(ierr); 5617 } 5618 } 5619 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&remGeom);CHKERRQ(ierr); 5620 ierr = PetscFEGeomRestoreChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 5621 } 5622 /* Insert values into matrix */ 5623 for (c = cS; c < cE; ++c) { 5624 const PetscInt cell = cells ? cells[c] : c; 5625 const PetscInt cind = c - cS; 5626 5627 if (hasBdPrec) { 5628 if (hasBdJac) { 5629 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);} 5630 if (!isMatIS) { 5631 ierr = DMPlexMatSetClosure(plex, section, globalSection, Jac, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5632 } else { 5633 Mat lJ; 5634 5635 ierr = MatISGetLocalMat(Jac,&lJ);CHKERRQ(ierr); 5636 ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5637 } 5638 } 5639 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMatP[cind*totDim*totDim]);CHKERRQ(ierr);} 5640 if (!isMatISP) { 5641 ierr = DMPlexMatSetClosure(plex, section, globalSection, JacP, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5642 } else { 5643 Mat lJ; 5644 5645 ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr); 5646 ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5647 } 5648 } else if (hasBdJac) { 5649 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);} 5650 if (!isMatISP) { 5651 ierr = DMPlexMatSetClosure(plex, section, globalSection, JacP, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5652 } else { 5653 Mat lJ; 5654 5655 ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr); 5656 ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5657 } 5658 } 5659 } 5660 } 5661 ierr = DMPlexRestoreCellFields(dm, cellIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr); 5662 ierr = DMRestoreWorkArray(dm, hasBdJac ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMat);CHKERRQ(ierr); 5663 ierr = DMRestoreWorkArray(dm, hasBdPrec ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMatP);CHKERRQ(ierr); 5664 ierr = PetscFree(faces);CHKERRQ(ierr); 5665 ierr = ISDestroy(&chunkIS);CHKERRQ(ierr); 5666 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 5667 if (maxDegree <= 1) { 5668 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 5669 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr); 5670 } else { 5671 PetscInt f; 5672 for (f = 0; f < Nf; ++f) { 5673 if (geoms) {ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE, &geoms[f]);CHKERRQ(ierr);} 5674 if (quads) {ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);} 5675 } 5676 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr); 5677 } 5678 if (dmAux) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);} 5679 ierr = DMDestroy(&plex);CHKERRQ(ierr); 5680 /* Assemble matrix */ 5681 if (hasBdJac && hasBdPrec) { 5682 ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5683 ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5684 } 5685 ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5686 ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5687 ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 5688 PetscFunctionReturn(0); 5689 } 5690