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