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