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