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