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