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