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