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