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