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