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