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 3060 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr); 3061 /* Transform points from real space to coarse reference space */ 3062 ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr); 3063 for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]); 3064 CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x); 3065 3066 if (id == PETSCFE_CLASSID) { 3067 PetscFE fe = (PetscFE) obj; 3068 3069 /* Evaluate coarse basis on contained point */ 3070 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr); 3071 ierr = PetscFEComputeTabulation(fe, 1, x, 0, T);CHKERRQ(ierr); 3072 /* Get elemMat entries by multiplying by weight */ 3073 for (i = 0; i < numFIndices; ++i) { 3074 ierr = PetscArrayzero(elemMat, cpdim);CHKERRQ(ierr); 3075 for (j = 0; j < cpdim; ++j) { 3076 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; 3077 } 3078 /* Update interpolator */ 3079 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);} 3080 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim); 3081 ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr); 3082 } 3083 } else { 3084 cpdim = 1; 3085 for (i = 0; i < numFIndices; ++i) { 3086 ierr = PetscArrayzero(elemMat, cpdim);CHKERRQ(ierr); 3087 for (j = 0; j < cpdim; ++j) { 3088 for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*1.0*qweights[ccell*Nc + c]*detJ; 3089 } 3090 /* Update interpolator */ 3091 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);} 3092 ierr = PetscPrintf(PETSC_COMM_SELF, "Nq: %D %D Nf: %D %D Nc: %D %D\n", ccell, Nq, i, numFIndices, j, numCIndices);CHKERRQ(ierr); 3093 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim); 3094 ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr); 3095 } 3096 } 3097 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr); 3098 } 3099 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 3100 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 3101 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 3102 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr); 3103 } 3104 if (id == PETSCFE_CLASSID) {ierr = PetscTabulationDestroy(&T);CHKERRQ(ierr);} 3105 } 3106 ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr); 3107 ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr); 3108 ierr = PetscFree(elemMat);CHKERRQ(ierr); 3109 ierr = MatAssemblyBegin(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3110 ierr = MatAssemblyEnd(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3111 PetscFunctionReturn(0); 3112 } 3113 3114 /*@ 3115 DMPlexComputeInjectorFEM - Compute a mapping from coarse unknowns to fine unknowns 3116 3117 Input Parameters: 3118 + dmc - The coarse mesh 3119 - dmf - The fine mesh 3120 - user - The user context 3121 3122 Output Parameter: 3123 . sc - The mapping 3124 3125 Level: developer 3126 3127 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM() 3128 @*/ 3129 PetscErrorCode DMPlexComputeInjectorFEM(DM dmc, DM dmf, VecScatter *sc, void *user) 3130 { 3131 PetscDS prob; 3132 PetscFE *feRef; 3133 PetscFV *fvRef; 3134 Vec fv, cv; 3135 IS fis, cis; 3136 PetscSection fsection, fglobalSection, csection, cglobalSection; 3137 PetscInt *cmap, *cellCIndices, *cellFIndices, *cindices, *findices; 3138 PetscInt cTotDim, fTotDim = 0, Nf, f, field, cStart, cEnd, c, dim, d, startC, endC, offsetC, offsetF, m; 3139 PetscBool *needAvg; 3140 PetscErrorCode ierr; 3141 3142 PetscFunctionBegin; 3143 ierr = PetscLogEventBegin(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 3144 ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr); 3145 ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr); 3146 ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr); 3147 ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr); 3148 ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr); 3149 ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr); 3150 ierr = DMPlexGetSimplexOrBoxCells(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr); 3151 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr); 3152 ierr = PetscCalloc3(Nf,&feRef,Nf,&fvRef,Nf,&needAvg);CHKERRQ(ierr); 3153 for (f = 0; f < Nf; ++f) { 3154 PetscObject obj; 3155 PetscClassId id; 3156 PetscInt fNb = 0, Nc = 0; 3157 3158 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3159 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3160 if (id == PETSCFE_CLASSID) { 3161 PetscFE fe = (PetscFE) obj; 3162 PetscSpace sp; 3163 PetscInt maxDegree; 3164 3165 ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr); 3166 ierr = PetscFEGetDimension(feRef[f], &fNb);CHKERRQ(ierr); 3167 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 3168 ierr = PetscFEGetBasisSpace(fe, &sp);CHKERRQ(ierr); 3169 ierr = PetscSpaceGetDegree(sp, NULL, &maxDegree);CHKERRQ(ierr); 3170 if (!maxDegree) needAvg[f] = PETSC_TRUE; 3171 } else if (id == PETSCFV_CLASSID) { 3172 PetscFV fv = (PetscFV) obj; 3173 PetscDualSpace Q; 3174 3175 ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr); 3176 ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr); 3177 ierr = PetscDualSpaceGetDimension(Q, &fNb);CHKERRQ(ierr); 3178 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 3179 needAvg[f] = PETSC_TRUE; 3180 } 3181 fTotDim += fNb; 3182 } 3183 ierr = PetscDSGetTotalDimension(prob, &cTotDim);CHKERRQ(ierr); 3184 ierr = PetscMalloc1(cTotDim,&cmap);CHKERRQ(ierr); 3185 for (field = 0, offsetC = 0, offsetF = 0; field < Nf; ++field) { 3186 PetscFE feC; 3187 PetscFV fvC; 3188 PetscDualSpace QF, QC; 3189 PetscInt order = -1, NcF, NcC, fpdim, cpdim; 3190 3191 if (feRef[field]) { 3192 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &feC);CHKERRQ(ierr); 3193 ierr = PetscFEGetNumComponents(feC, &NcC);CHKERRQ(ierr); 3194 ierr = PetscFEGetNumComponents(feRef[field], &NcF);CHKERRQ(ierr); 3195 ierr = PetscFEGetDualSpace(feRef[field], &QF);CHKERRQ(ierr); 3196 ierr = PetscDualSpaceGetOrder(QF, &order);CHKERRQ(ierr); 3197 ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr); 3198 ierr = PetscFEGetDualSpace(feC, &QC);CHKERRQ(ierr); 3199 ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr); 3200 } else { 3201 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fvC);CHKERRQ(ierr); 3202 ierr = PetscFVGetNumComponents(fvC, &NcC);CHKERRQ(ierr); 3203 ierr = PetscFVGetNumComponents(fvRef[field], &NcF);CHKERRQ(ierr); 3204 ierr = PetscFVGetDualSpace(fvRef[field], &QF);CHKERRQ(ierr); 3205 ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr); 3206 ierr = PetscFVGetDualSpace(fvC, &QC);CHKERRQ(ierr); 3207 ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr); 3208 } 3209 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); 3210 for (c = 0; c < cpdim; ++c) { 3211 PetscQuadrature cfunc; 3212 const PetscReal *cqpoints, *cqweights; 3213 PetscInt NqcC, NpC; 3214 PetscBool found = PETSC_FALSE; 3215 3216 ierr = PetscDualSpaceGetFunctional(QC, c, &cfunc);CHKERRQ(ierr); 3217 ierr = PetscQuadratureGetData(cfunc, NULL, &NqcC, &NpC, &cqpoints, &cqweights);CHKERRQ(ierr); 3218 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); 3219 if (NpC != 1 && feRef[field]) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Do not know how to do injection for moments"); 3220 for (f = 0; f < fpdim; ++f) { 3221 PetscQuadrature ffunc; 3222 const PetscReal *fqpoints, *fqweights; 3223 PetscReal sum = 0.0; 3224 PetscInt NqcF, NpF; 3225 3226 ierr = PetscDualSpaceGetFunctional(QF, f, &ffunc);CHKERRQ(ierr); 3227 ierr = PetscQuadratureGetData(ffunc, NULL, &NqcF, &NpF, &fqpoints, &fqweights);CHKERRQ(ierr); 3228 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); 3229 if (NpC != NpF) continue; 3230 for (d = 0; d < dim; ++d) sum += PetscAbsReal(cqpoints[d] - fqpoints[d]); 3231 if (sum > 1.0e-9) continue; 3232 for (d = 0; d < NcC; ++d) sum += PetscAbsReal(cqweights[d]*fqweights[d]); 3233 if (sum < 1.0e-9) continue; 3234 cmap[offsetC+c] = offsetF+f; 3235 found = PETSC_TRUE; 3236 break; 3237 } 3238 if (!found) { 3239 /* TODO We really want the average here, but some asshole put VecScatter in the interface */ 3240 if (fvRef[field] || (feRef[field] && order == 0)) { 3241 cmap[offsetC+c] = offsetF+0; 3242 } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not locate matching functional for injection"); 3243 } 3244 } 3245 offsetC += cpdim; 3246 offsetF += fpdim; 3247 } 3248 for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);ierr = PetscFVDestroy(&fvRef[f]);CHKERRQ(ierr);} 3249 ierr = PetscFree3(feRef,fvRef,needAvg);CHKERRQ(ierr); 3250 3251 ierr = DMGetGlobalVector(dmf, &fv);CHKERRQ(ierr); 3252 ierr = DMGetGlobalVector(dmc, &cv);CHKERRQ(ierr); 3253 ierr = VecGetOwnershipRange(cv, &startC, &endC);CHKERRQ(ierr); 3254 ierr = PetscSectionGetConstrainedStorageSize(cglobalSection, &m);CHKERRQ(ierr); 3255 ierr = PetscMalloc2(cTotDim,&cellCIndices,fTotDim,&cellFIndices);CHKERRQ(ierr); 3256 ierr = PetscMalloc1(m,&cindices);CHKERRQ(ierr); 3257 ierr = PetscMalloc1(m,&findices);CHKERRQ(ierr); 3258 for (d = 0; d < m; ++d) cindices[d] = findices[d] = -1; 3259 for (c = cStart; c < cEnd; ++c) { 3260 ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, c, cellCIndices, cellFIndices);CHKERRQ(ierr); 3261 for (d = 0; d < cTotDim; ++d) { 3262 if ((cellCIndices[d] < startC) || (cellCIndices[d] >= endC)) continue; 3263 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]]); 3264 cindices[cellCIndices[d]-startC] = cellCIndices[d]; 3265 findices[cellCIndices[d]-startC] = cellFIndices[cmap[d]]; 3266 } 3267 } 3268 ierr = PetscFree(cmap);CHKERRQ(ierr); 3269 ierr = PetscFree2(cellCIndices,cellFIndices);CHKERRQ(ierr); 3270 3271 ierr = ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis);CHKERRQ(ierr); 3272 ierr = ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis);CHKERRQ(ierr); 3273 ierr = VecScatterCreate(cv, cis, fv, fis, sc);CHKERRQ(ierr); 3274 ierr = ISDestroy(&cis);CHKERRQ(ierr); 3275 ierr = ISDestroy(&fis);CHKERRQ(ierr); 3276 ierr = DMRestoreGlobalVector(dmf, &fv);CHKERRQ(ierr); 3277 ierr = DMRestoreGlobalVector(dmc, &cv);CHKERRQ(ierr); 3278 ierr = PetscLogEventEnd(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 3279 PetscFunctionReturn(0); 3280 } 3281 3282 /*@C 3283 DMPlexGetCellFields - Retrieve the field values values for a chunk of cells 3284 3285 Input Parameters: 3286 + dm - The DM 3287 . cellIS - The cells to include 3288 . locX - A local vector with the solution fields 3289 . locX_t - A local vector with solution field time derivatives, or NULL 3290 - locA - A local vector with auxiliary fields, or NULL 3291 3292 Output Parameters: 3293 + u - The field coefficients 3294 . u_t - The fields derivative coefficients 3295 - a - The auxiliary field coefficients 3296 3297 Level: developer 3298 3299 .seealso: DMPlexGetFaceFields() 3300 @*/ 3301 PetscErrorCode DMPlexGetCellFields(DM dm, IS cellIS, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a) 3302 { 3303 DM plex, plexA = NULL; 3304 DMEnclosureType encAux; 3305 PetscSection section, sectionAux; 3306 PetscDS prob; 3307 const PetscInt *cells; 3308 PetscInt cStart, cEnd, numCells, totDim, totDimAux, c; 3309 PetscErrorCode ierr; 3310 3311 PetscFunctionBegin; 3312 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 3313 PetscValidHeaderSpecific(locX, VEC_CLASSID, 3); 3314 if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 4);} 3315 if (locA) {PetscValidHeaderSpecific(locA, VEC_CLASSID, 5);} 3316 PetscValidPointer(u, 6); 3317 PetscValidPointer(u_t, 7); 3318 PetscValidPointer(a, 8); 3319 ierr = DMPlexConvertPlex(dm, &plex, PETSC_FALSE);CHKERRQ(ierr); 3320 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3321 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 3322 ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob);CHKERRQ(ierr); 3323 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 3324 if (locA) { 3325 DM dmAux; 3326 PetscDS probAux; 3327 3328 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 3329 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr); 3330 ierr = DMPlexConvertPlex(dmAux, &plexA, PETSC_FALSE);CHKERRQ(ierr); 3331 ierr = DMGetLocalSection(dmAux, §ionAux);CHKERRQ(ierr); 3332 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 3333 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 3334 } 3335 numCells = cEnd - cStart; 3336 ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u);CHKERRQ(ierr); 3337 if (locX_t) {ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u_t);CHKERRQ(ierr);} else {*u_t = NULL;} 3338 if (locA) {ierr = DMGetWorkArray(dm, numCells*totDimAux, MPIU_SCALAR, a);CHKERRQ(ierr);} else {*a = NULL;} 3339 for (c = cStart; c < cEnd; ++c) { 3340 const PetscInt cell = cells ? cells[c] : c; 3341 const PetscInt cind = c - cStart; 3342 PetscScalar *x = NULL, *x_t = NULL, *ul = *u, *ul_t = *u_t, *al = *a; 3343 PetscInt i; 3344 3345 ierr = DMPlexVecGetClosure(plex, section, locX, cell, NULL, &x);CHKERRQ(ierr); 3346 for (i = 0; i < totDim; ++i) ul[cind*totDim+i] = x[i]; 3347 ierr = DMPlexVecRestoreClosure(plex, section, locX, cell, NULL, &x);CHKERRQ(ierr); 3348 if (locX_t) { 3349 ierr = DMPlexVecGetClosure(plex, section, locX_t, cell, NULL, &x_t);CHKERRQ(ierr); 3350 for (i = 0; i < totDim; ++i) ul_t[cind*totDim+i] = x_t[i]; 3351 ierr = DMPlexVecRestoreClosure(plex, section, locX_t, cell, NULL, &x_t);CHKERRQ(ierr); 3352 } 3353 if (locA) { 3354 PetscInt subcell; 3355 ierr = DMGetEnclosurePoint(plexA, dm, encAux, cell, &subcell);CHKERRQ(ierr); 3356 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subcell, NULL, &x);CHKERRQ(ierr); 3357 for (i = 0; i < totDimAux; ++i) al[cind*totDimAux+i] = x[i]; 3358 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subcell, NULL, &x);CHKERRQ(ierr); 3359 } 3360 } 3361 ierr = DMDestroy(&plex);CHKERRQ(ierr); 3362 if (locA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);} 3363 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3364 PetscFunctionReturn(0); 3365 } 3366 3367 /*@C 3368 DMPlexRestoreCellFields - Restore the field values values for a chunk of cells 3369 3370 Input Parameters: 3371 + dm - The DM 3372 . cellIS - The cells to include 3373 . locX - A local vector with the solution fields 3374 . locX_t - A local vector with solution field time derivatives, or NULL 3375 - locA - A local vector with auxiliary fields, or NULL 3376 3377 Output Parameters: 3378 + u - The field coefficients 3379 . u_t - The fields derivative coefficients 3380 - a - The auxiliary field coefficients 3381 3382 Level: developer 3383 3384 .seealso: DMPlexGetFaceFields() 3385 @*/ 3386 PetscErrorCode DMPlexRestoreCellFields(DM dm, IS cellIS, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a) 3387 { 3388 PetscErrorCode ierr; 3389 3390 PetscFunctionBegin; 3391 ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u);CHKERRQ(ierr); 3392 if (locX_t) {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u_t);CHKERRQ(ierr);} 3393 if (locA) {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, a);CHKERRQ(ierr);} 3394 PetscFunctionReturn(0); 3395 } 3396 3397 static PetscErrorCode DMPlexGetHybridAuxFields(DM dm, DM dmAux[], PetscDS dsAux[], IS cellIS, Vec locA[], PetscScalar *a[]) 3398 { 3399 DM plexA[2]; 3400 DMEnclosureType encAux[2]; 3401 PetscSection sectionAux[2]; 3402 const PetscInt *cells; 3403 PetscInt cStart, cEnd, numCells, c, s, totDimAux[2]; 3404 PetscErrorCode ierr; 3405 3406 PetscFunctionBegin; 3407 PetscValidPointer(locA, 5); 3408 if (!locA[0] || !locA[1]) PetscFunctionReturn(0); 3409 PetscValidPointer(dmAux, 2); 3410 PetscValidPointer(dsAux, 3); 3411 PetscValidPointer(a, 6); 3412 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3413 numCells = cEnd - cStart; 3414 for (s = 0; s < 2; ++s) { 3415 PetscValidHeaderSpecific(dmAux[s], DM_CLASSID, 2); 3416 PetscValidHeaderSpecific(dsAux[s], PETSCDS_CLASSID, 3); 3417 PetscValidHeaderSpecific(locA[s], VEC_CLASSID, 5); 3418 ierr = DMPlexConvertPlex(dmAux[s], &plexA[s], PETSC_FALSE);CHKERRQ(ierr); 3419 ierr = DMGetEnclosureRelation(dmAux[s], dm, &encAux[s]);CHKERRQ(ierr); 3420 ierr = DMGetLocalSection(dmAux[s], §ionAux[s]);CHKERRQ(ierr); 3421 ierr = PetscDSGetTotalDimension(dsAux[s], &totDimAux[s]);CHKERRQ(ierr); 3422 ierr = DMGetWorkArray(dmAux[s], numCells*totDimAux[s], MPIU_SCALAR, &a[s]);CHKERRQ(ierr); 3423 } 3424 for (c = cStart; c < cEnd; ++c) { 3425 const PetscInt cell = cells ? cells[c] : c; 3426 const PetscInt cind = c - cStart; 3427 const PetscInt *cone, *ornt; 3428 3429 ierr = DMPlexGetCone(dm, cell, &cone);CHKERRQ(ierr); 3430 ierr = DMPlexGetConeOrientation(dm, cell, &ornt);CHKERRQ(ierr); 3431 if (ornt[0]) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_SUP, "Face %D in hybrid cell %D has orientation %D != 0", cone[0], cell, ornt[0]); 3432 for (s = 0; s < 2; ++s) { 3433 PetscScalar *x = NULL, *al = a[s]; 3434 const PetscInt tdA = totDimAux[s]; 3435 PetscInt subface, Na, i; 3436 3437 ierr = DMGetEnclosurePoint(plexA[s], dm, encAux[s], cone[0], &subface);CHKERRQ(ierr); 3438 ierr = DMPlexVecGetClosure(plexA[s], sectionAux[s], locA[s], subface, &Na, &x);CHKERRQ(ierr); 3439 for (i = 0; i < Na; ++i) al[cind*tdA+i] = x[i]; 3440 ierr = DMPlexVecRestoreClosure(plexA[s], sectionAux[s], locA[s], subface, &Na, &x);CHKERRQ(ierr); 3441 } 3442 } 3443 for (s = 0; s < 2; ++s) {ierr = DMDestroy(&plexA[s]);CHKERRQ(ierr);} 3444 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3445 PetscFunctionReturn(0); 3446 } 3447 3448 static PetscErrorCode DMPlexRestoreHybridAuxFields(DM dmAux[], PetscDS dsAux[], IS cellIS, Vec locA[], PetscScalar *a[]) 3449 { 3450 PetscErrorCode ierr; 3451 3452 PetscFunctionBegin; 3453 if (!locA[0] || !locA[1]) PetscFunctionReturn(0); 3454 ierr = DMRestoreWorkArray(dmAux[0], 0, MPIU_SCALAR, &a[0]);CHKERRQ(ierr); 3455 ierr = DMRestoreWorkArray(dmAux[1], 0, MPIU_SCALAR, &a[1]);CHKERRQ(ierr); 3456 PetscFunctionReturn(0); 3457 } 3458 3459 /*@C 3460 DMPlexGetFaceFields - Retrieve the field values values for a chunk of faces 3461 3462 Input Parameters: 3463 + dm - The DM 3464 . fStart - The first face to include 3465 . fEnd - The first face to exclude 3466 . locX - A local vector with the solution fields 3467 . locX_t - A local vector with solution field time derivatives, or NULL 3468 . faceGeometry - A local vector with face geometry 3469 . cellGeometry - A local vector with cell geometry 3470 - locaGrad - A local vector with field gradients, or NULL 3471 3472 Output Parameters: 3473 + Nface - The number of faces with field values 3474 . uL - The field values at the left side of the face 3475 - uR - The field values at the right side of the face 3476 3477 Level: developer 3478 3479 .seealso: DMPlexGetCellFields() 3480 @*/ 3481 PetscErrorCode DMPlexGetFaceFields(DM dm, PetscInt fStart, PetscInt fEnd, Vec locX, Vec locX_t, Vec faceGeometry, Vec cellGeometry, Vec locGrad, PetscInt *Nface, PetscScalar **uL, PetscScalar **uR) 3482 { 3483 DM dmFace, dmCell, dmGrad = NULL; 3484 PetscSection section; 3485 PetscDS prob; 3486 DMLabel ghostLabel; 3487 const PetscScalar *facegeom, *cellgeom, *x, *lgrad; 3488 PetscBool *isFE; 3489 PetscInt dim, Nf, f, Nc, numFaces = fEnd - fStart, iface, face; 3490 PetscErrorCode ierr; 3491 3492 PetscFunctionBegin; 3493 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 3494 PetscValidHeaderSpecific(locX, VEC_CLASSID, 4); 3495 if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 5);} 3496 PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 6); 3497 PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 7); 3498 if (locGrad) {PetscValidHeaderSpecific(locGrad, VEC_CLASSID, 8);} 3499 PetscValidPointer(uL, 10); 3500 PetscValidPointer(uR, 11); 3501 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 3502 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 3503 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 3504 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 3505 ierr = PetscDSGetTotalComponents(prob, &Nc);CHKERRQ(ierr); 3506 ierr = PetscMalloc1(Nf, &isFE);CHKERRQ(ierr); 3507 for (f = 0; f < Nf; ++f) { 3508 PetscObject obj; 3509 PetscClassId id; 3510 3511 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3512 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3513 if (id == PETSCFE_CLASSID) {isFE[f] = PETSC_TRUE;} 3514 else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;} 3515 else {isFE[f] = PETSC_FALSE;} 3516 } 3517 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 3518 ierr = VecGetArrayRead(locX, &x);CHKERRQ(ierr); 3519 ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr); 3520 ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 3521 ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr); 3522 ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 3523 if (locGrad) { 3524 ierr = VecGetDM(locGrad, &dmGrad);CHKERRQ(ierr); 3525 ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr); 3526 } 3527 ierr = DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uL);CHKERRQ(ierr); 3528 ierr = DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uR);CHKERRQ(ierr); 3529 /* Right now just eat the extra work for FE (could make a cell loop) */ 3530 for (face = fStart, iface = 0; face < fEnd; ++face) { 3531 const PetscInt *cells; 3532 PetscFVFaceGeom *fg; 3533 PetscFVCellGeom *cgL, *cgR; 3534 PetscScalar *xL, *xR, *gL, *gR; 3535 PetscScalar *uLl = *uL, *uRl = *uR; 3536 PetscInt ghost, nsupp, nchild; 3537 3538 ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr); 3539 ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr); 3540 ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr); 3541 if (ghost >= 0 || nsupp > 2 || nchild > 0) continue; 3542 ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr); 3543 ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr); 3544 ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr); 3545 ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr); 3546 for (f = 0; f < Nf; ++f) { 3547 PetscInt off; 3548 3549 ierr = PetscDSGetComponentOffset(prob, f, &off);CHKERRQ(ierr); 3550 if (isFE[f]) { 3551 const PetscInt *cone; 3552 PetscInt comp, coneSizeL, coneSizeR, faceLocL, faceLocR, ldof, rdof, d; 3553 3554 xL = xR = NULL; 3555 ierr = PetscSectionGetFieldComponents(section, f, &comp);CHKERRQ(ierr); 3556 ierr = DMPlexVecGetClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL);CHKERRQ(ierr); 3557 ierr = DMPlexVecGetClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR);CHKERRQ(ierr); 3558 ierr = DMPlexGetCone(dm, cells[0], &cone);CHKERRQ(ierr); 3559 ierr = DMPlexGetConeSize(dm, cells[0], &coneSizeL);CHKERRQ(ierr); 3560 for (faceLocL = 0; faceLocL < coneSizeL; ++faceLocL) if (cone[faceLocL] == face) break; 3561 ierr = DMPlexGetCone(dm, cells[1], &cone);CHKERRQ(ierr); 3562 ierr = DMPlexGetConeSize(dm, cells[1], &coneSizeR);CHKERRQ(ierr); 3563 for (faceLocR = 0; faceLocR < coneSizeR; ++faceLocR) if (cone[faceLocR] == face) break; 3564 if (faceLocL == coneSizeL && faceLocR == coneSizeR) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Could not find face %D in cone of cell %D or cell %D", face, cells[0], cells[1]); 3565 /* Check that FEM field has values in the right cell (sometimes its an FV ghost cell) */ 3566 /* TODO: this is a hack that might not be right for nonconforming */ 3567 if (faceLocL < coneSizeL) { 3568 ierr = PetscFEEvaluateFaceFields_Internal(prob, f, faceLocL, xL, &uLl[iface*Nc+off]);CHKERRQ(ierr); 3569 if (rdof == ldof && faceLocR < coneSizeR) {ierr = PetscFEEvaluateFaceFields_Internal(prob, f, faceLocR, xR, &uRl[iface*Nc+off]);CHKERRQ(ierr);} 3570 else {for (d = 0; d < comp; ++d) uRl[iface*Nc+off+d] = uLl[iface*Nc+off+d];} 3571 } 3572 else { 3573 ierr = PetscFEEvaluateFaceFields_Internal(prob, f, faceLocR, xR, &uRl[iface*Nc+off]);CHKERRQ(ierr); 3574 ierr = PetscSectionGetFieldComponents(section, f, &comp);CHKERRQ(ierr); 3575 for (d = 0; d < comp; ++d) uLl[iface*Nc+off+d] = uRl[iface*Nc+off+d]; 3576 } 3577 ierr = DMPlexVecRestoreClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL);CHKERRQ(ierr); 3578 ierr = DMPlexVecRestoreClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR);CHKERRQ(ierr); 3579 } else { 3580 PetscFV fv; 3581 PetscInt numComp, c; 3582 3583 ierr = PetscDSGetDiscretization(prob, f, (PetscObject *) &fv);CHKERRQ(ierr); 3584 ierr = PetscFVGetNumComponents(fv, &numComp);CHKERRQ(ierr); 3585 ierr = DMPlexPointLocalFieldRead(dm, cells[0], f, x, &xL);CHKERRQ(ierr); 3586 ierr = DMPlexPointLocalFieldRead(dm, cells[1], f, x, &xR);CHKERRQ(ierr); 3587 if (dmGrad) { 3588 PetscReal dxL[3], dxR[3]; 3589 3590 ierr = DMPlexPointLocalRead(dmGrad, cells[0], lgrad, &gL);CHKERRQ(ierr); 3591 ierr = DMPlexPointLocalRead(dmGrad, cells[1], lgrad, &gR);CHKERRQ(ierr); 3592 DMPlex_WaxpyD_Internal(dim, -1, cgL->centroid, fg->centroid, dxL); 3593 DMPlex_WaxpyD_Internal(dim, -1, cgR->centroid, fg->centroid, dxR); 3594 for (c = 0; c < numComp; ++c) { 3595 uLl[iface*Nc+off+c] = xL[c] + DMPlex_DotD_Internal(dim, &gL[c*dim], dxL); 3596 uRl[iface*Nc+off+c] = xR[c] + DMPlex_DotD_Internal(dim, &gR[c*dim], dxR); 3597 } 3598 } else { 3599 for (c = 0; c < numComp; ++c) { 3600 uLl[iface*Nc+off+c] = xL[c]; 3601 uRl[iface*Nc+off+c] = xR[c]; 3602 } 3603 } 3604 } 3605 } 3606 ++iface; 3607 } 3608 *Nface = iface; 3609 ierr = VecRestoreArrayRead(locX, &x);CHKERRQ(ierr); 3610 ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 3611 ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 3612 if (locGrad) { 3613 ierr = VecRestoreArrayRead(locGrad, &lgrad);CHKERRQ(ierr); 3614 } 3615 ierr = PetscFree(isFE);CHKERRQ(ierr); 3616 PetscFunctionReturn(0); 3617 } 3618 3619 /*@C 3620 DMPlexRestoreFaceFields - Restore the field values values for a chunk of faces 3621 3622 Input Parameters: 3623 + dm - The DM 3624 . fStart - The first face to include 3625 . fEnd - The first face to exclude 3626 . locX - A local vector with the solution fields 3627 . locX_t - A local vector with solution field time derivatives, or NULL 3628 . faceGeometry - A local vector with face geometry 3629 . cellGeometry - A local vector with cell geometry 3630 - locaGrad - A local vector with field gradients, or NULL 3631 3632 Output Parameters: 3633 + Nface - The number of faces with field values 3634 . uL - The field values at the left side of the face 3635 - uR - The field values at the right side of the face 3636 3637 Level: developer 3638 3639 .seealso: DMPlexGetFaceFields() 3640 @*/ 3641 PetscErrorCode DMPlexRestoreFaceFields(DM dm, PetscInt fStart, PetscInt fEnd, Vec locX, Vec locX_t, Vec faceGeometry, Vec cellGeometry, Vec locGrad, PetscInt *Nface, PetscScalar **uL, PetscScalar **uR) 3642 { 3643 PetscErrorCode ierr; 3644 3645 PetscFunctionBegin; 3646 ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uL);CHKERRQ(ierr); 3647 ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uR);CHKERRQ(ierr); 3648 PetscFunctionReturn(0); 3649 } 3650 3651 /*@C 3652 DMPlexGetFaceGeometry - Retrieve the geometric values for a chunk of faces 3653 3654 Input Parameters: 3655 + dm - The DM 3656 . fStart - The first face to include 3657 . fEnd - The first face to exclude 3658 . faceGeometry - A local vector with face geometry 3659 - cellGeometry - A local vector with cell geometry 3660 3661 Output Parameters: 3662 + Nface - The number of faces with field values 3663 . fgeom - The extract the face centroid and normal 3664 - vol - The cell volume 3665 3666 Level: developer 3667 3668 .seealso: DMPlexGetCellFields() 3669 @*/ 3670 PetscErrorCode DMPlexGetFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscInt *Nface, PetscFVFaceGeom **fgeom, PetscReal **vol) 3671 { 3672 DM dmFace, dmCell; 3673 DMLabel ghostLabel; 3674 const PetscScalar *facegeom, *cellgeom; 3675 PetscInt dim, numFaces = fEnd - fStart, iface, face; 3676 PetscErrorCode ierr; 3677 3678 PetscFunctionBegin; 3679 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 3680 PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 4); 3681 PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 5); 3682 PetscValidPointer(fgeom, 7); 3683 PetscValidPointer(vol, 8); 3684 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 3685 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 3686 ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr); 3687 ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 3688 ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr); 3689 ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 3690 ierr = PetscMalloc1(numFaces, fgeom);CHKERRQ(ierr); 3691 ierr = DMGetWorkArray(dm, numFaces*2, MPIU_SCALAR, vol);CHKERRQ(ierr); 3692 for (face = fStart, iface = 0; face < fEnd; ++face) { 3693 const PetscInt *cells; 3694 PetscFVFaceGeom *fg; 3695 PetscFVCellGeom *cgL, *cgR; 3696 PetscFVFaceGeom *fgeoml = *fgeom; 3697 PetscReal *voll = *vol; 3698 PetscInt ghost, d, nchild, nsupp; 3699 3700 ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr); 3701 ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr); 3702 ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr); 3703 if (ghost >= 0 || nsupp > 2 || nchild > 0) continue; 3704 ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr); 3705 ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr); 3706 ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr); 3707 ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr); 3708 for (d = 0; d < dim; ++d) { 3709 fgeoml[iface].centroid[d] = fg->centroid[d]; 3710 fgeoml[iface].normal[d] = fg->normal[d]; 3711 } 3712 voll[iface*2+0] = cgL->volume; 3713 voll[iface*2+1] = cgR->volume; 3714 ++iface; 3715 } 3716 *Nface = iface; 3717 ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 3718 ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 3719 PetscFunctionReturn(0); 3720 } 3721 3722 /*@C 3723 DMPlexRestoreFaceGeometry - Restore the field values values for a chunk of faces 3724 3725 Input Parameters: 3726 + dm - The DM 3727 . fStart - The first face to include 3728 . fEnd - The first face to exclude 3729 . faceGeometry - A local vector with face geometry 3730 - cellGeometry - A local vector with cell geometry 3731 3732 Output Parameters: 3733 + Nface - The number of faces with field values 3734 . fgeom - The extract the face centroid and normal 3735 - vol - The cell volume 3736 3737 Level: developer 3738 3739 .seealso: DMPlexGetFaceFields() 3740 @*/ 3741 PetscErrorCode DMPlexRestoreFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscInt *Nface, PetscFVFaceGeom **fgeom, PetscReal **vol) 3742 { 3743 PetscErrorCode ierr; 3744 3745 PetscFunctionBegin; 3746 ierr = PetscFree(*fgeom);CHKERRQ(ierr); 3747 ierr = DMRestoreWorkArray(dm, 0, MPIU_REAL, vol);CHKERRQ(ierr); 3748 PetscFunctionReturn(0); 3749 } 3750 3751 PetscErrorCode DMSNESGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom) 3752 { 3753 char composeStr[33] = {0}; 3754 PetscObjectId id; 3755 PetscContainer container; 3756 PetscErrorCode ierr; 3757 3758 PetscFunctionBegin; 3759 ierr = PetscObjectGetId((PetscObject)quad,&id);CHKERRQ(ierr); 3760 ierr = PetscSNPrintf(composeStr, 32, "DMSNESGetFEGeom_%x\n", id);CHKERRQ(ierr); 3761 ierr = PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);CHKERRQ(ierr); 3762 if (container) { 3763 ierr = PetscContainerGetPointer(container, (void **) geom);CHKERRQ(ierr); 3764 } else { 3765 ierr = DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);CHKERRQ(ierr); 3766 ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr); 3767 ierr = PetscContainerSetPointer(container, (void *) *geom);CHKERRQ(ierr); 3768 ierr = PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);CHKERRQ(ierr); 3769 ierr = PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);CHKERRQ(ierr); 3770 ierr = PetscContainerDestroy(&container);CHKERRQ(ierr); 3771 } 3772 PetscFunctionReturn(0); 3773 } 3774 3775 PetscErrorCode DMSNESRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom) 3776 { 3777 PetscFunctionBegin; 3778 *geom = NULL; 3779 PetscFunctionReturn(0); 3780 } 3781 3782 PetscErrorCode DMPlexComputeResidual_Patch_Internal(DM dm, PetscSection section, IS cellIS, PetscReal t, Vec locX, Vec locX_t, Vec locF, void *user) 3783 { 3784 DM_Plex *mesh = (DM_Plex *) dm->data; 3785 const char *name = "Residual"; 3786 DM dmAux = NULL; 3787 DMLabel ghostLabel = NULL; 3788 PetscDS prob = NULL; 3789 PetscDS probAux = NULL; 3790 PetscBool useFEM = PETSC_FALSE; 3791 PetscBool isImplicit = (locX_t || t == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE; 3792 DMField coordField = NULL; 3793 Vec locA; 3794 PetscScalar *u = NULL, *u_t, *a, *uL = NULL, *uR = NULL; 3795 IS chunkIS; 3796 const PetscInt *cells; 3797 PetscInt cStart, cEnd, numCells; 3798 PetscInt Nf, f, totDim, totDimAux, numChunks, cellChunkSize, chunk, fStart, fEnd; 3799 PetscInt maxDegree = PETSC_MAX_INT; 3800 PetscFormKey key; 3801 PetscQuadrature affineQuad = NULL, *quads = NULL; 3802 PetscFEGeom *affineGeom = NULL, **geoms = NULL; 3803 PetscErrorCode ierr; 3804 3805 PetscFunctionBegin; 3806 ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 3807 /* FEM+FVM */ 3808 /* 1: Get sizes from dm and dmAux */ 3809 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 3810 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 3811 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 3812 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 3813 ierr = DMGetAuxiliaryVec(dm, NULL, 0, &locA);CHKERRQ(ierr); 3814 if (locA) { 3815 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 3816 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 3817 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 3818 } 3819 /* 2: Get geometric data */ 3820 for (f = 0; f < Nf; ++f) { 3821 PetscObject obj; 3822 PetscClassId id; 3823 PetscBool fimp; 3824 3825 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr); 3826 if (isImplicit != fimp) continue; 3827 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3828 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3829 if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;} 3830 if (id == PETSCFV_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Use of FVM with PCPATCH not yet implemented"); 3831 } 3832 if (useFEM) { 3833 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 3834 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr); 3835 if (maxDegree <= 1) { 3836 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr); 3837 if (affineQuad) { 3838 ierr = DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 3839 } 3840 } else { 3841 ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr); 3842 for (f = 0; f < Nf; ++f) { 3843 PetscObject obj; 3844 PetscClassId id; 3845 PetscBool fimp; 3846 3847 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr); 3848 if (isImplicit != fimp) continue; 3849 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3850 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3851 if (id == PETSCFE_CLASSID) { 3852 PetscFE fe = (PetscFE) obj; 3853 3854 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr); 3855 ierr = PetscObjectReference((PetscObject)quads[f]);CHKERRQ(ierr); 3856 ierr = DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr); 3857 } 3858 } 3859 } 3860 } 3861 /* Loop over chunks */ 3862 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3863 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 3864 if (useFEM) {ierr = ISCreate(PETSC_COMM_SELF, &chunkIS);CHKERRQ(ierr);} 3865 numCells = cEnd - cStart; 3866 numChunks = 1; 3867 cellChunkSize = numCells/numChunks; 3868 numChunks = PetscMin(1,numCells); 3869 key.label = NULL; 3870 key.value = 0; 3871 key.part = 0; 3872 for (chunk = 0; chunk < numChunks; ++chunk) { 3873 PetscScalar *elemVec, *fluxL = NULL, *fluxR = NULL; 3874 PetscReal *vol = NULL; 3875 PetscFVFaceGeom *fgeom = NULL; 3876 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c; 3877 PetscInt numFaces = 0; 3878 3879 /* Extract field coefficients */ 3880 if (useFEM) { 3881 ierr = ISGetPointSubrange(chunkIS, cS, cE, cells);CHKERRQ(ierr); 3882 ierr = DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr); 3883 ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 3884 ierr = PetscArrayzero(elemVec, numCells*totDim);CHKERRQ(ierr); 3885 } 3886 /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */ 3887 /* Loop over fields */ 3888 for (f = 0; f < Nf; ++f) { 3889 PetscObject obj; 3890 PetscClassId id; 3891 PetscBool fimp; 3892 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset; 3893 3894 key.field = f; 3895 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr); 3896 if (isImplicit != fimp) continue; 3897 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3898 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3899 if (id == PETSCFE_CLASSID) { 3900 PetscFE fe = (PetscFE) obj; 3901 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[f]; 3902 PetscFEGeom *chunkGeom = NULL; 3903 PetscQuadrature quad = affineQuad ? affineQuad : quads[f]; 3904 PetscInt Nq, Nb; 3905 3906 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 3907 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 3908 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 3909 blockSize = Nb; 3910 batchSize = numBlocks * blockSize; 3911 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 3912 numChunks = numCells / (numBatches*batchSize); 3913 Ne = numChunks*numBatches*batchSize; 3914 Nr = numCells % (numBatches*batchSize); 3915 offset = numCells - Nr; 3916 /* Integrate FE residual to get elemVec (need fields at quadrature points) */ 3917 /* For FV, I think we use a P0 basis and the cell coefficients (for subdivided cells, we can tweak the basis tabulation to be the indicator function) */ 3918 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 3919 ierr = PetscFEIntegrateResidual(prob, key, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec);CHKERRQ(ierr); 3920 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 3921 ierr = PetscFEIntegrateResidual(prob, key, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]);CHKERRQ(ierr); 3922 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 3923 } else if (id == PETSCFV_CLASSID) { 3924 PetscFV fv = (PetscFV) obj; 3925 3926 Ne = numFaces; 3927 /* Riemann solve over faces (need fields at face centroids) */ 3928 /* We need to evaluate FE fields at those coordinates */ 3929 ierr = PetscFVIntegrateRHSFunction(fv, prob, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR);CHKERRQ(ierr); 3930 } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f); 3931 } 3932 /* Loop over domain */ 3933 if (useFEM) { 3934 /* Add elemVec to locX */ 3935 for (c = cS; c < cE; ++c) { 3936 const PetscInt cell = cells ? cells[c] : c; 3937 const PetscInt cind = c - cStart; 3938 3939 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);} 3940 if (ghostLabel) { 3941 PetscInt ghostVal; 3942 3943 ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr); 3944 if (ghostVal > 0) continue; 3945 } 3946 ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr); 3947 } 3948 } 3949 /* Handle time derivative */ 3950 if (locX_t) { 3951 PetscScalar *x_t, *fa; 3952 3953 ierr = VecGetArray(locF, &fa);CHKERRQ(ierr); 3954 ierr = VecGetArray(locX_t, &x_t);CHKERRQ(ierr); 3955 for (f = 0; f < Nf; ++f) { 3956 PetscFV fv; 3957 PetscObject obj; 3958 PetscClassId id; 3959 PetscInt pdim, d; 3960 3961 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3962 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3963 if (id != PETSCFV_CLASSID) continue; 3964 fv = (PetscFV) obj; 3965 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr); 3966 for (c = cS; c < cE; ++c) { 3967 const PetscInt cell = cells ? cells[c] : c; 3968 PetscScalar *u_t, *r; 3969 3970 if (ghostLabel) { 3971 PetscInt ghostVal; 3972 3973 ierr = DMLabelGetValue(ghostLabel, cell, &ghostVal);CHKERRQ(ierr); 3974 if (ghostVal > 0) continue; 3975 } 3976 ierr = DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t);CHKERRQ(ierr); 3977 ierr = DMPlexPointLocalFieldRef(dm, cell, f, fa, &r);CHKERRQ(ierr); 3978 for (d = 0; d < pdim; ++d) r[d] += u_t[d]; 3979 } 3980 } 3981 ierr = VecRestoreArray(locX_t, &x_t);CHKERRQ(ierr); 3982 ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr); 3983 } 3984 if (useFEM) { 3985 ierr = DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr); 3986 ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 3987 } 3988 } 3989 if (useFEM) {ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);} 3990 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3991 /* TODO Could include boundary residual here (see DMPlexComputeResidual_Internal) */ 3992 if (useFEM) { 3993 if (maxDegree <= 1) { 3994 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 3995 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr); 3996 } else { 3997 for (f = 0; f < Nf; ++f) { 3998 ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr); 3999 ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr); 4000 } 4001 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr); 4002 } 4003 } 4004 ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 4005 PetscFunctionReturn(0); 4006 } 4007 4008 /* 4009 We always assemble JacP, and if the matrix is different from Jac and two different sets of point functions are provided, we also assemble Jac 4010 4011 X - The local solution vector 4012 X_t - The local solution time derviative vector, or NULL 4013 */ 4014 PetscErrorCode DMPlexComputeJacobian_Patch_Internal(DM dm, PetscSection section, PetscSection globalSection, IS cellIS, 4015 PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP, void *ctx) 4016 { 4017 DM_Plex *mesh = (DM_Plex *) dm->data; 4018 const char *name = "Jacobian", *nameP = "JacobianPre"; 4019 DM dmAux = NULL; 4020 PetscDS prob, probAux = NULL; 4021 PetscSection sectionAux = NULL; 4022 Vec A; 4023 DMField coordField; 4024 PetscFEGeom *cgeomFEM; 4025 PetscQuadrature qGeom = NULL; 4026 Mat J = Jac, JP = JacP; 4027 PetscScalar *work, *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL, *elemMatP = NULL, *elemMatD = NULL; 4028 PetscBool hasJac, hasPrec, hasDyn, assembleJac, isMatIS, isMatISP, *isFE, hasFV = PETSC_FALSE; 4029 const PetscInt *cells; 4030 PetscFormKey key; 4031 PetscInt Nf, fieldI, fieldJ, maxDegree, numCells, cStart, cEnd, numChunks, chunkSize, chunk, totDim, totDimAux = 0, sz, wsz, off = 0, offCell = 0; 4032 PetscErrorCode ierr; 4033 4034 PetscFunctionBegin; 4035 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr); 4036 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 4037 ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 4038 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 4039 ierr = DMGetAuxiliaryVec(dm, NULL, 0, &A);CHKERRQ(ierr); 4040 if (A) { 4041 ierr = VecGetDM(A, &dmAux);CHKERRQ(ierr); 4042 ierr = DMGetLocalSection(dmAux, §ionAux);CHKERRQ(ierr); 4043 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 4044 } 4045 /* Get flags */ 4046 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 4047 ierr = DMGetWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr); 4048 for (fieldI = 0; fieldI < Nf; ++fieldI) { 4049 PetscObject disc; 4050 PetscClassId id; 4051 ierr = PetscDSGetDiscretization(prob, fieldI, &disc);CHKERRQ(ierr); 4052 ierr = PetscObjectGetClassId(disc, &id);CHKERRQ(ierr); 4053 if (id == PETSCFE_CLASSID) {isFE[fieldI] = PETSC_TRUE;} 4054 else if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; isFE[fieldI] = PETSC_FALSE;} 4055 } 4056 ierr = PetscDSHasJacobian(prob, &hasJac);CHKERRQ(ierr); 4057 ierr = PetscDSHasJacobianPreconditioner(prob, &hasPrec);CHKERRQ(ierr); 4058 ierr = PetscDSHasDynamicJacobian(prob, &hasDyn);CHKERRQ(ierr); 4059 assembleJac = hasJac && hasPrec && (Jac != JacP) ? PETSC_TRUE : PETSC_FALSE; 4060 hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE; 4061 ierr = PetscObjectTypeCompare((PetscObject) Jac, MATIS, &isMatIS);CHKERRQ(ierr); 4062 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr); 4063 /* Setup input data and temp arrays (should be DMGetWorkArray) */ 4064 if (isMatISP || isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &globalSection);CHKERRQ(ierr);} 4065 if (isMatIS) {ierr = MatISGetLocalMat(Jac, &J);CHKERRQ(ierr);} 4066 if (isMatISP) {ierr = MatISGetLocalMat(JacP, &JP);CHKERRQ(ierr);} 4067 if (hasFV) {ierr = MatSetOption(JP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE);CHKERRQ(ierr);} /* No allocated space for FV stuff, so ignore the zero entries */ 4068 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 4069 if (probAux) {ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);} 4070 /* Compute batch sizes */ 4071 if (isFE[0]) { 4072 PetscFE fe; 4073 PetscQuadrature q; 4074 PetscInt numQuadPoints, numBatches, batchSize, numBlocks, blockSize, Nb; 4075 4076 ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr); 4077 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr); 4078 ierr = PetscQuadratureGetData(q, NULL, NULL, &numQuadPoints, NULL, NULL);CHKERRQ(ierr); 4079 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 4080 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 4081 blockSize = Nb*numQuadPoints; 4082 batchSize = numBlocks * blockSize; 4083 chunkSize = numBatches * batchSize; 4084 numChunks = numCells / chunkSize + numCells % chunkSize; 4085 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 4086 } else { 4087 chunkSize = numCells; 4088 numChunks = 1; 4089 } 4090 /* Get work space */ 4091 wsz = (((X?1:0) + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize; 4092 ierr = DMGetWorkArray(dm, wsz, MPIU_SCALAR, &work);CHKERRQ(ierr); 4093 ierr = PetscArrayzero(work, wsz);CHKERRQ(ierr); 4094 off = 0; 4095 u = X ? (sz = chunkSize*totDim, off += sz, work+off-sz) : NULL; 4096 u_t = X_t ? (sz = chunkSize*totDim, off += sz, work+off-sz) : NULL; 4097 a = dmAux ? (sz = chunkSize*totDimAux, off += sz, work+off-sz) : NULL; 4098 elemMat = hasJac ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL; 4099 elemMatP = hasPrec ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL; 4100 elemMatD = hasDyn ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL; 4101 if (off != wsz) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Error is workspace size %D should be %D", off, wsz); 4102 /* Setup geometry */ 4103 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 4104 ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr); 4105 if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, cellIS, &qGeom);CHKERRQ(ierr);} 4106 if (!qGeom) { 4107 PetscFE fe; 4108 4109 ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr); 4110 ierr = PetscFEGetQuadrature(fe, &qGeom);CHKERRQ(ierr); 4111 ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr); 4112 } 4113 ierr = DMSNESGetFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr); 4114 /* Compute volume integrals */ 4115 if (assembleJac) {ierr = MatZeroEntries(J);CHKERRQ(ierr);} 4116 ierr = MatZeroEntries(JP);CHKERRQ(ierr); 4117 key.label = NULL; 4118 key.value = 0; 4119 key.part = 0; 4120 for (chunk = 0; chunk < numChunks; ++chunk, offCell += chunkSize) { 4121 const PetscInt Ncell = PetscMin(chunkSize, numCells - offCell); 4122 PetscInt c; 4123 4124 /* Extract values */ 4125 for (c = 0; c < Ncell; ++c) { 4126 const PetscInt cell = cells ? cells[c+offCell] : c+offCell; 4127 PetscScalar *x = NULL, *x_t = NULL; 4128 PetscInt i; 4129 4130 if (X) { 4131 ierr = DMPlexVecGetClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr); 4132 for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i]; 4133 ierr = DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr); 4134 } 4135 if (X_t) { 4136 ierr = DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 4137 for (i = 0; i < totDim; ++i) u_t[c*totDim+i] = x_t[i]; 4138 ierr = DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 4139 } 4140 if (dmAux) { 4141 ierr = DMPlexVecGetClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr); 4142 for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i]; 4143 ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr); 4144 } 4145 } 4146 for (fieldI = 0; fieldI < Nf; ++fieldI) { 4147 PetscFE fe; 4148 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 4149 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 4150 key.field = fieldI*Nf + fieldJ; 4151 if (hasJac) {ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);} 4152 if (hasPrec) {ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr);} 4153 if (hasDyn) {ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatD);CHKERRQ(ierr);} 4154 } 4155 /* For finite volume, add the identity */ 4156 if (!isFE[fieldI]) { 4157 PetscFV fv; 4158 PetscInt eOffset = 0, Nc, fc, foff; 4159 4160 ierr = PetscDSGetFieldOffset(prob, fieldI, &foff);CHKERRQ(ierr); 4161 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv);CHKERRQ(ierr); 4162 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 4163 for (c = 0; c < chunkSize; ++c, eOffset += totDim*totDim) { 4164 for (fc = 0; fc < Nc; ++fc) { 4165 const PetscInt i = foff + fc; 4166 if (hasJac) {elemMat [eOffset+i*totDim+i] = 1.0;} 4167 if (hasPrec) {elemMatP[eOffset+i*totDim+i] = 1.0;} 4168 } 4169 } 4170 } 4171 } 4172 /* Add contribution from X_t */ 4173 if (hasDyn) {for (c = 0; c < chunkSize*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];} 4174 /* Insert values into matrix */ 4175 for (c = 0; c < Ncell; ++c) { 4176 const PetscInt cell = cells ? cells[c+offCell] : c+offCell; 4177 if (mesh->printFEM > 1) { 4178 if (hasJac) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);} 4179 if (hasPrec) {ierr = DMPrintCellMatrix(cell, nameP, totDim, totDim, &elemMatP[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);} 4180 } 4181 if (assembleJac) {ierr = DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);} 4182 ierr = DMPlexMatSetClosure(dm, section, globalSection, JP, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 4183 } 4184 } 4185 /* Cleanup */ 4186 ierr = DMSNESRestoreFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr); 4187 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 4188 if (hasFV) {ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);} 4189 ierr = DMRestoreWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr); 4190 ierr = DMRestoreWorkArray(dm, ((1 + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize, MPIU_SCALAR, &work);CHKERRQ(ierr); 4191 /* Compute boundary integrals */ 4192 /* ierr = DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, ctx);CHKERRQ(ierr); */ 4193 /* Assemble matrix */ 4194 if (assembleJac) {ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);} 4195 ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 4196 ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 4197 PetscFunctionReturn(0); 4198 } 4199 4200 /******** FEM Assembly Function ********/ 4201 4202 static PetscErrorCode DMConvertPlex_Internal(DM dm, DM *plex, PetscBool copy) 4203 { 4204 PetscBool isPlex; 4205 PetscErrorCode ierr; 4206 4207 PetscFunctionBegin; 4208 ierr = PetscObjectTypeCompare((PetscObject) dm, DMPLEX, &isPlex);CHKERRQ(ierr); 4209 if (isPlex) { 4210 *plex = dm; 4211 ierr = PetscObjectReference((PetscObject) dm);CHKERRQ(ierr); 4212 } else { 4213 ierr = PetscObjectQuery((PetscObject) dm, "dm_plex", (PetscObject *) plex);CHKERRQ(ierr); 4214 if (!*plex) { 4215 ierr = DMConvert(dm,DMPLEX,plex);CHKERRQ(ierr); 4216 ierr = PetscObjectCompose((PetscObject) dm, "dm_plex", (PetscObject) *plex);CHKERRQ(ierr); 4217 if (copy) { 4218 ierr = DMCopyAuxiliaryVec(dm, *plex);CHKERRQ(ierr); 4219 } 4220 } else { 4221 ierr = PetscObjectReference((PetscObject) *plex);CHKERRQ(ierr); 4222 } 4223 } 4224 PetscFunctionReturn(0); 4225 } 4226 4227 /*@ 4228 DMPlexGetGeometryFVM - Return precomputed geometric data 4229 4230 Collective on DM 4231 4232 Input Parameter: 4233 . dm - The DM 4234 4235 Output Parameters: 4236 + facegeom - The values precomputed from face geometry 4237 . cellgeom - The values precomputed from cell geometry 4238 - minRadius - The minimum radius over the mesh of an inscribed sphere in a cell 4239 4240 Level: developer 4241 4242 .seealso: DMTSSetRHSFunctionLocal() 4243 @*/ 4244 PetscErrorCode DMPlexGetGeometryFVM(DM dm, Vec *facegeom, Vec *cellgeom, PetscReal *minRadius) 4245 { 4246 DM plex; 4247 PetscErrorCode ierr; 4248 4249 PetscFunctionBegin; 4250 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 4251 ierr = DMConvertPlex_Internal(dm,&plex,PETSC_TRUE);CHKERRQ(ierr); 4252 ierr = DMPlexGetDataFVM(plex, NULL, cellgeom, facegeom, NULL);CHKERRQ(ierr); 4253 if (minRadius) {ierr = DMPlexGetMinRadius(plex, minRadius);CHKERRQ(ierr);} 4254 ierr = DMDestroy(&plex);CHKERRQ(ierr); 4255 PetscFunctionReturn(0); 4256 } 4257 4258 /*@ 4259 DMPlexGetGradientDM - Return gradient data layout 4260 4261 Collective on DM 4262 4263 Input Parameters: 4264 + dm - The DM 4265 - fv - The PetscFV 4266 4267 Output Parameter: 4268 . dmGrad - The layout for gradient values 4269 4270 Level: developer 4271 4272 .seealso: DMPlexGetGeometryFVM() 4273 @*/ 4274 PetscErrorCode DMPlexGetGradientDM(DM dm, PetscFV fv, DM *dmGrad) 4275 { 4276 DM plex; 4277 PetscBool computeGradients; 4278 PetscErrorCode ierr; 4279 4280 PetscFunctionBegin; 4281 PetscValidHeaderSpecific(dm,DM_CLASSID,1); 4282 PetscValidHeaderSpecific(fv,PETSCFV_CLASSID,2); 4283 PetscValidPointer(dmGrad,3); 4284 ierr = PetscFVGetComputeGradients(fv, &computeGradients);CHKERRQ(ierr); 4285 if (!computeGradients) {*dmGrad = NULL; PetscFunctionReturn(0);} 4286 ierr = DMConvertPlex_Internal(dm,&plex,PETSC_TRUE);CHKERRQ(ierr); 4287 ierr = DMPlexGetDataFVM(plex, fv, NULL, NULL, dmGrad);CHKERRQ(ierr); 4288 ierr = DMDestroy(&plex);CHKERRQ(ierr); 4289 PetscFunctionReturn(0); 4290 } 4291 4292 static PetscErrorCode DMPlexComputeBdResidual_Single_Internal(DM dm, PetscReal t, PetscWeakForm wf, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt field, Vec locX, Vec locX_t, Vec locF, DMField coordField, IS facetIS) 4293 { 4294 DM_Plex *mesh = (DM_Plex *) dm->data; 4295 DM plex = NULL, plexA = NULL; 4296 DMEnclosureType encAux; 4297 PetscDS prob, probAux = NULL; 4298 PetscSection section, sectionAux = NULL; 4299 Vec locA = NULL; 4300 PetscScalar *u = NULL, *u_t = NULL, *a = NULL, *elemVec = NULL; 4301 PetscInt v; 4302 PetscInt totDim, totDimAux = 0; 4303 PetscErrorCode ierr; 4304 4305 PetscFunctionBegin; 4306 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr); 4307 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 4308 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 4309 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 4310 ierr = DMGetAuxiliaryVec(dm, label, values[0], &locA);CHKERRQ(ierr); 4311 if (locA) { 4312 DM dmAux; 4313 4314 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 4315 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr); 4316 ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr); 4317 ierr = DMGetDS(plexA, &probAux);CHKERRQ(ierr); 4318 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 4319 ierr = DMGetLocalSection(plexA, §ionAux);CHKERRQ(ierr); 4320 } 4321 for (v = 0; v < numValues; ++v) { 4322 PetscFEGeom *fgeom; 4323 PetscInt maxDegree; 4324 PetscQuadrature qGeom = NULL; 4325 IS pointIS; 4326 const PetscInt *points; 4327 PetscFormKey key; 4328 PetscInt numFaces, face, Nq; 4329 4330 key.label = label; 4331 key.value = values[v]; 4332 key.field = field; 4333 key.part = 0; 4334 ierr = DMLabelGetStratumIS(label, values[v], &pointIS);CHKERRQ(ierr); 4335 if (!pointIS) continue; /* No points with that id on this process */ 4336 { 4337 IS isectIS; 4338 4339 /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */ 4340 ierr = ISIntersect_Caching_Internal(facetIS,pointIS,&isectIS);CHKERRQ(ierr); 4341 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 4342 pointIS = isectIS; 4343 } 4344 ierr = ISGetLocalSize(pointIS,&numFaces);CHKERRQ(ierr); 4345 ierr = ISGetIndices(pointIS,&points);CHKERRQ(ierr); 4346 ierr = PetscMalloc4(numFaces*totDim, &u, locX_t ? numFaces*totDim : 0, &u_t, numFaces*totDim, &elemVec, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr); 4347 ierr = DMFieldGetDegree(coordField,pointIS,NULL,&maxDegree);CHKERRQ(ierr); 4348 if (maxDegree <= 1) { 4349 ierr = DMFieldCreateDefaultQuadrature(coordField,pointIS,&qGeom);CHKERRQ(ierr); 4350 } 4351 if (!qGeom) { 4352 PetscFE fe; 4353 4354 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr); 4355 ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr); 4356 ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr); 4357 } 4358 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 4359 ierr = DMSNESGetFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr); 4360 for (face = 0; face < numFaces; ++face) { 4361 const PetscInt point = points[face], *support; 4362 PetscScalar *x = NULL; 4363 PetscInt i; 4364 4365 ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr); 4366 ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 4367 for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i]; 4368 ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 4369 if (locX_t) { 4370 ierr = DMPlexVecGetClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr); 4371 for (i = 0; i < totDim; ++i) u_t[face*totDim+i] = x[i]; 4372 ierr = DMPlexVecRestoreClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr); 4373 } 4374 if (locA) { 4375 PetscInt subp; 4376 4377 ierr = DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp);CHKERRQ(ierr); 4378 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 4379 for (i = 0; i < totDimAux; ++i) a[face*totDimAux+i] = x[i]; 4380 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 4381 } 4382 } 4383 ierr = PetscArrayzero(elemVec, numFaces*totDim);CHKERRQ(ierr); 4384 { 4385 PetscFE fe; 4386 PetscInt Nb; 4387 PetscFEGeom *chunkGeom = NULL; 4388 /* Conforming batches */ 4389 PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize; 4390 /* Remainder */ 4391 PetscInt Nr, offset; 4392 4393 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr); 4394 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 4395 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 4396 /* TODO: documentation is unclear about what is going on with these numbers: how should Nb / Nq factor in ? */ 4397 blockSize = Nb; 4398 batchSize = numBlocks * blockSize; 4399 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 4400 numChunks = numFaces / (numBatches*batchSize); 4401 Ne = numChunks*numBatches*batchSize; 4402 Nr = numFaces % (numBatches*batchSize); 4403 offset = numFaces - Nr; 4404 ierr = PetscFEGeomGetChunk(fgeom,0,offset,&chunkGeom);CHKERRQ(ierr); 4405 ierr = PetscFEIntegrateBdResidual(prob, wf, key, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec);CHKERRQ(ierr); 4406 ierr = PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom);CHKERRQ(ierr); 4407 ierr = PetscFEGeomGetChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr); 4408 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); 4409 ierr = PetscFEGeomRestoreChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr); 4410 } 4411 for (face = 0; face < numFaces; ++face) { 4412 const PetscInt point = points[face], *support; 4413 4414 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(point, "BdResidual", totDim, &elemVec[face*totDim]);CHKERRQ(ierr);} 4415 ierr = DMPlexGetSupport(plex, point, &support);CHKERRQ(ierr); 4416 ierr = DMPlexVecSetClosure(plex, NULL, locF, support[0], &elemVec[face*totDim], ADD_ALL_VALUES);CHKERRQ(ierr); 4417 } 4418 ierr = DMSNESRestoreFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr); 4419 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 4420 ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr); 4421 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 4422 ierr = PetscFree4(u, u_t, elemVec, a);CHKERRQ(ierr); 4423 } 4424 ierr = DMDestroy(&plex);CHKERRQ(ierr); 4425 ierr = DMDestroy(&plexA);CHKERRQ(ierr); 4426 PetscFunctionReturn(0); 4427 } 4428 4429 PetscErrorCode DMPlexComputeBdResidualSingle(DM dm, PetscReal t, PetscWeakForm wf, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt field, Vec locX, Vec locX_t, Vec locF) 4430 { 4431 DMField coordField; 4432 DMLabel depthLabel; 4433 IS facetIS; 4434 PetscInt dim; 4435 PetscErrorCode ierr; 4436 4437 PetscFunctionBegin; 4438 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 4439 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 4440 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr); 4441 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 4442 ierr = DMPlexComputeBdResidual_Single_Internal(dm, t, wf, label, numValues, values, field, locX, locX_t, locF, coordField, facetIS);CHKERRQ(ierr); 4443 ierr = ISDestroy(&facetIS);CHKERRQ(ierr); 4444 PetscFunctionReturn(0); 4445 } 4446 4447 PetscErrorCode DMPlexComputeBdResidual_Internal(DM dm, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user) 4448 { 4449 PetscDS prob; 4450 PetscInt numBd, bd; 4451 DMField coordField = NULL; 4452 IS facetIS = NULL; 4453 DMLabel depthLabel; 4454 PetscInt dim; 4455 PetscErrorCode ierr; 4456 4457 PetscFunctionBegin; 4458 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 4459 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 4460 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 4461 ierr = DMLabelGetStratumIS(depthLabel,dim - 1,&facetIS);CHKERRQ(ierr); 4462 ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr); 4463 for (bd = 0; bd < numBd; ++bd) { 4464 PetscWeakForm wf; 4465 DMBoundaryConditionType type; 4466 DMLabel label; 4467 const PetscInt *values; 4468 PetscInt field, numValues; 4469 PetscObject obj; 4470 PetscClassId id; 4471 4472 ierr = PetscDSGetBoundary(prob, bd, &wf, &type, NULL, &label, &numValues, &values, &field, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr); 4473 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 4474 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 4475 if ((id != PETSCFE_CLASSID) || (type & DM_BC_ESSENTIAL)) continue; 4476 if (!facetIS) { 4477 DMLabel depthLabel; 4478 PetscInt dim; 4479 4480 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 4481 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 4482 ierr = DMLabelGetStratumIS(depthLabel, dim - 1, &facetIS);CHKERRQ(ierr); 4483 } 4484 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 4485 ierr = DMPlexComputeBdResidual_Single_Internal(dm, t, wf, label, numValues, values, field, locX, locX_t, locF, coordField, facetIS);CHKERRQ(ierr); 4486 } 4487 ierr = ISDestroy(&facetIS);CHKERRQ(ierr); 4488 PetscFunctionReturn(0); 4489 } 4490 4491 PetscErrorCode DMPlexComputeResidual_Internal(DM dm, PetscFormKey key, IS cellIS, PetscReal time, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user) 4492 { 4493 DM_Plex *mesh = (DM_Plex *) dm->data; 4494 const char *name = "Residual"; 4495 DM dmAux = NULL; 4496 DM dmGrad = NULL; 4497 DMLabel ghostLabel = NULL; 4498 PetscDS ds = NULL; 4499 PetscDS dsAux = NULL; 4500 PetscSection section = NULL; 4501 PetscBool useFEM = PETSC_FALSE; 4502 PetscBool useFVM = PETSC_FALSE; 4503 PetscBool isImplicit = (locX_t || time == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE; 4504 PetscFV fvm = NULL; 4505 PetscFVCellGeom *cgeomFVM = NULL; 4506 PetscFVFaceGeom *fgeomFVM = NULL; 4507 DMField coordField = NULL; 4508 Vec locA, cellGeometryFVM = NULL, faceGeometryFVM = NULL, grad, locGrad = NULL; 4509 PetscScalar *u = NULL, *u_t, *a, *uL, *uR; 4510 IS chunkIS; 4511 const PetscInt *cells; 4512 PetscInt cStart, cEnd, numCells; 4513 PetscInt Nf, f, totDim, totDimAux, numChunks, cellChunkSize, faceChunkSize, chunk, fStart, fEnd; 4514 PetscInt maxDegree = PETSC_MAX_INT; 4515 PetscQuadrature affineQuad = NULL, *quads = NULL; 4516 PetscFEGeom *affineGeom = NULL, **geoms = NULL; 4517 PetscErrorCode ierr; 4518 4519 PetscFunctionBegin; 4520 ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 4521 /* TODO The places where we have to use isFE are probably the member functions for the PetscDisc class */ 4522 /* TODO The FVM geometry is over-manipulated. Make the precalc functions return exactly what we need */ 4523 /* FEM+FVM */ 4524 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 4525 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 4526 /* 1: Get sizes from dm and dmAux */ 4527 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 4528 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 4529 ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &ds);CHKERRQ(ierr); 4530 ierr = PetscDSGetNumFields(ds, &Nf);CHKERRQ(ierr); 4531 ierr = PetscDSGetTotalDimension(ds, &totDim);CHKERRQ(ierr); 4532 ierr = DMGetAuxiliaryVec(dm, key.label, key.value, &locA);CHKERRQ(ierr); 4533 if (locA) { 4534 PetscInt subcell; 4535 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 4536 ierr = DMGetEnclosurePoint(dmAux, dm, DM_ENC_UNKNOWN, cStart, &subcell);CHKERRQ(ierr); 4537 ierr = DMGetCellDS(dmAux, subcell, &dsAux);CHKERRQ(ierr); 4538 ierr = PetscDSGetTotalDimension(dsAux, &totDimAux);CHKERRQ(ierr); 4539 } 4540 /* 2: Get geometric data */ 4541 for (f = 0; f < Nf; ++f) { 4542 PetscObject obj; 4543 PetscClassId id; 4544 PetscBool fimp; 4545 4546 ierr = PetscDSGetImplicit(ds, f, &fimp);CHKERRQ(ierr); 4547 if (isImplicit != fimp) continue; 4548 ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr); 4549 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 4550 if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;} 4551 if (id == PETSCFV_CLASSID) {useFVM = PETSC_TRUE; fvm = (PetscFV) obj;} 4552 } 4553 if (useFEM) { 4554 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 4555 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr); 4556 if (maxDegree <= 1) { 4557 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr); 4558 if (affineQuad) { 4559 ierr = DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 4560 } 4561 } else { 4562 ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr); 4563 for (f = 0; f < Nf; ++f) { 4564 PetscObject obj; 4565 PetscClassId id; 4566 PetscBool fimp; 4567 4568 ierr = PetscDSGetImplicit(ds, f, &fimp);CHKERRQ(ierr); 4569 if (isImplicit != fimp) continue; 4570 ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr); 4571 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 4572 if (id == PETSCFE_CLASSID) { 4573 PetscFE fe = (PetscFE) obj; 4574 4575 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr); 4576 ierr = PetscObjectReference((PetscObject)quads[f]);CHKERRQ(ierr); 4577 ierr = DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr); 4578 } 4579 } 4580 } 4581 } 4582 if (useFVM) { 4583 ierr = DMPlexGetGeometryFVM(dm, &faceGeometryFVM, &cellGeometryFVM, NULL);CHKERRQ(ierr); 4584 ierr = VecGetArrayRead(faceGeometryFVM, (const PetscScalar **) &fgeomFVM);CHKERRQ(ierr); 4585 ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr); 4586 /* Reconstruct and limit cell gradients */ 4587 ierr = DMPlexGetGradientDM(dm, fvm, &dmGrad);CHKERRQ(ierr); 4588 if (dmGrad) { 4589 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 4590 ierr = DMGetGlobalVector(dmGrad, &grad);CHKERRQ(ierr); 4591 ierr = DMPlexReconstructGradients_Internal(dm, fvm, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr); 4592 /* Communicate gradient values */ 4593 ierr = DMGetLocalVector(dmGrad, &locGrad);CHKERRQ(ierr); 4594 ierr = DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr); 4595 ierr = DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr); 4596 ierr = DMRestoreGlobalVector(dmGrad, &grad);CHKERRQ(ierr); 4597 } 4598 /* Handle non-essential (e.g. outflow) boundary values */ 4599 ierr = DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, time, faceGeometryFVM, cellGeometryFVM, locGrad);CHKERRQ(ierr); 4600 } 4601 /* Loop over chunks */ 4602 if (useFEM) {ierr = ISCreate(PETSC_COMM_SELF, &chunkIS);CHKERRQ(ierr);} 4603 numCells = cEnd - cStart; 4604 numChunks = 1; 4605 cellChunkSize = numCells/numChunks; 4606 faceChunkSize = (fEnd - fStart)/numChunks; 4607 numChunks = PetscMin(1,numCells); 4608 for (chunk = 0; chunk < numChunks; ++chunk) { 4609 PetscScalar *elemVec, *fluxL, *fluxR; 4610 PetscReal *vol; 4611 PetscFVFaceGeom *fgeom; 4612 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c; 4613 PetscInt fS = fStart+chunk*faceChunkSize, fE = PetscMin(fS+faceChunkSize, fEnd), numFaces = 0, face; 4614 4615 /* Extract field coefficients */ 4616 if (useFEM) { 4617 ierr = ISGetPointSubrange(chunkIS, cS, cE, cells);CHKERRQ(ierr); 4618 ierr = DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr); 4619 ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 4620 ierr = PetscArrayzero(elemVec, numCells*totDim);CHKERRQ(ierr); 4621 } 4622 if (useFVM) { 4623 ierr = DMPlexGetFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR);CHKERRQ(ierr); 4624 ierr = DMPlexGetFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol);CHKERRQ(ierr); 4625 ierr = DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL);CHKERRQ(ierr); 4626 ierr = DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR);CHKERRQ(ierr); 4627 ierr = PetscArrayzero(fluxL, numFaces*totDim);CHKERRQ(ierr); 4628 ierr = PetscArrayzero(fluxR, numFaces*totDim);CHKERRQ(ierr); 4629 } 4630 /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */ 4631 /* Loop over fields */ 4632 for (f = 0; f < Nf; ++f) { 4633 PetscObject obj; 4634 PetscClassId id; 4635 PetscBool fimp; 4636 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset; 4637 4638 key.field = f; 4639 ierr = PetscDSGetImplicit(ds, f, &fimp);CHKERRQ(ierr); 4640 if (isImplicit != fimp) continue; 4641 ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr); 4642 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 4643 if (id == PETSCFE_CLASSID) { 4644 PetscFE fe = (PetscFE) obj; 4645 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[f]; 4646 PetscFEGeom *chunkGeom = NULL; 4647 PetscQuadrature quad = affineQuad ? affineQuad : quads[f]; 4648 PetscInt Nq, Nb; 4649 4650 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 4651 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 4652 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 4653 blockSize = Nb; 4654 batchSize = numBlocks * blockSize; 4655 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 4656 numChunks = numCells / (numBatches*batchSize); 4657 Ne = numChunks*numBatches*batchSize; 4658 Nr = numCells % (numBatches*batchSize); 4659 offset = numCells - Nr; 4660 /* Integrate FE residual to get elemVec (need fields at quadrature points) */ 4661 /* 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) */ 4662 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 4663 ierr = PetscFEIntegrateResidual(ds, key, Ne, chunkGeom, u, u_t, dsAux, a, t, elemVec);CHKERRQ(ierr); 4664 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 4665 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); 4666 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 4667 } else if (id == PETSCFV_CLASSID) { 4668 PetscFV fv = (PetscFV) obj; 4669 4670 Ne = numFaces; 4671 /* Riemann solve over faces (need fields at face centroids) */ 4672 /* We need to evaluate FE fields at those coordinates */ 4673 ierr = PetscFVIntegrateRHSFunction(fv, ds, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR);CHKERRQ(ierr); 4674 } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f); 4675 } 4676 /* Loop over domain */ 4677 if (useFEM) { 4678 /* Add elemVec to locX */ 4679 for (c = cS; c < cE; ++c) { 4680 const PetscInt cell = cells ? cells[c] : c; 4681 const PetscInt cind = c - cStart; 4682 4683 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);} 4684 if (ghostLabel) { 4685 PetscInt ghostVal; 4686 4687 ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr); 4688 if (ghostVal > 0) continue; 4689 } 4690 ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr); 4691 } 4692 } 4693 if (useFVM) { 4694 PetscScalar *fa; 4695 PetscInt iface; 4696 4697 ierr = VecGetArray(locF, &fa);CHKERRQ(ierr); 4698 for (f = 0; f < Nf; ++f) { 4699 PetscFV fv; 4700 PetscObject obj; 4701 PetscClassId id; 4702 PetscInt foff, pdim; 4703 4704 ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr); 4705 ierr = PetscDSGetFieldOffset(ds, f, &foff);CHKERRQ(ierr); 4706 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 4707 if (id != PETSCFV_CLASSID) continue; 4708 fv = (PetscFV) obj; 4709 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr); 4710 /* Accumulate fluxes to cells */ 4711 for (face = fS, iface = 0; face < fE; ++face) { 4712 const PetscInt *scells; 4713 PetscScalar *fL = NULL, *fR = NULL; 4714 PetscInt ghost, d, nsupp, nchild; 4715 4716 ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr); 4717 ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr); 4718 ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr); 4719 if (ghost >= 0 || nsupp > 2 || nchild > 0) continue; 4720 ierr = DMPlexGetSupport(dm, face, &scells);CHKERRQ(ierr); 4721 ierr = DMLabelGetValue(ghostLabel,scells[0],&ghost);CHKERRQ(ierr); 4722 if (ghost <= 0) {ierr = DMPlexPointLocalFieldRef(dm, scells[0], f, fa, &fL);CHKERRQ(ierr);} 4723 ierr = DMLabelGetValue(ghostLabel,scells[1],&ghost);CHKERRQ(ierr); 4724 if (ghost <= 0) {ierr = DMPlexPointLocalFieldRef(dm, scells[1], f, fa, &fR);CHKERRQ(ierr);} 4725 for (d = 0; d < pdim; ++d) { 4726 if (fL) fL[d] -= fluxL[iface*totDim+foff+d]; 4727 if (fR) fR[d] += fluxR[iface*totDim+foff+d]; 4728 } 4729 ++iface; 4730 } 4731 } 4732 ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr); 4733 } 4734 /* Handle time derivative */ 4735 if (locX_t) { 4736 PetscScalar *x_t, *fa; 4737 4738 ierr = VecGetArray(locF, &fa);CHKERRQ(ierr); 4739 ierr = VecGetArray(locX_t, &x_t);CHKERRQ(ierr); 4740 for (f = 0; f < Nf; ++f) { 4741 PetscFV fv; 4742 PetscObject obj; 4743 PetscClassId id; 4744 PetscInt pdim, d; 4745 4746 ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr); 4747 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 4748 if (id != PETSCFV_CLASSID) continue; 4749 fv = (PetscFV) obj; 4750 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr); 4751 for (c = cS; c < cE; ++c) { 4752 const PetscInt cell = cells ? cells[c] : c; 4753 PetscScalar *u_t, *r; 4754 4755 if (ghostLabel) { 4756 PetscInt ghostVal; 4757 4758 ierr = DMLabelGetValue(ghostLabel, cell, &ghostVal);CHKERRQ(ierr); 4759 if (ghostVal > 0) continue; 4760 } 4761 ierr = DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t);CHKERRQ(ierr); 4762 ierr = DMPlexPointLocalFieldRef(dm, cell, f, fa, &r);CHKERRQ(ierr); 4763 for (d = 0; d < pdim; ++d) r[d] += u_t[d]; 4764 } 4765 } 4766 ierr = VecRestoreArray(locX_t, &x_t);CHKERRQ(ierr); 4767 ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr); 4768 } 4769 if (useFEM) { 4770 ierr = DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr); 4771 ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 4772 } 4773 if (useFVM) { 4774 ierr = DMPlexRestoreFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR);CHKERRQ(ierr); 4775 ierr = DMPlexRestoreFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol);CHKERRQ(ierr); 4776 ierr = DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL);CHKERRQ(ierr); 4777 ierr = DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR);CHKERRQ(ierr); 4778 if (dmGrad) {ierr = DMRestoreLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);} 4779 } 4780 } 4781 if (useFEM) {ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);} 4782 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 4783 4784 if (useFEM) { 4785 ierr = DMPlexComputeBdResidual_Internal(dm, locX, locX_t, t, locF, user);CHKERRQ(ierr); 4786 4787 if (maxDegree <= 1) { 4788 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 4789 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr); 4790 } else { 4791 for (f = 0; f < Nf; ++f) { 4792 ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr); 4793 ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr); 4794 } 4795 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr); 4796 } 4797 } 4798 4799 /* FEM */ 4800 /* 1: Get sizes from dm and dmAux */ 4801 /* 2: Get geometric data */ 4802 /* 3: Handle boundary values */ 4803 /* 4: Loop over domain */ 4804 /* Extract coefficients */ 4805 /* Loop over fields */ 4806 /* Set tiling for FE*/ 4807 /* Integrate FE residual to get elemVec */ 4808 /* Loop over subdomain */ 4809 /* Loop over quad points */ 4810 /* Transform coords to real space */ 4811 /* Evaluate field and aux fields at point */ 4812 /* Evaluate residual at point */ 4813 /* Transform residual to real space */ 4814 /* Add residual to elemVec */ 4815 /* Loop over domain */ 4816 /* Add elemVec to locX */ 4817 4818 /* FVM */ 4819 /* Get geometric data */ 4820 /* If using gradients */ 4821 /* Compute gradient data */ 4822 /* Loop over domain faces */ 4823 /* Count computational faces */ 4824 /* Reconstruct cell gradient */ 4825 /* Loop over domain cells */ 4826 /* Limit cell gradients */ 4827 /* Handle boundary values */ 4828 /* Loop over domain faces */ 4829 /* Read out field, centroid, normal, volume for each side of face */ 4830 /* Riemann solve over faces */ 4831 /* Loop over domain faces */ 4832 /* Accumulate fluxes to cells */ 4833 /* TODO Change printFEM to printDisc here */ 4834 if (mesh->printFEM) { 4835 Vec locFbc; 4836 PetscInt pStart, pEnd, p, maxDof; 4837 PetscScalar *zeroes; 4838 4839 ierr = VecDuplicate(locF,&locFbc);CHKERRQ(ierr); 4840 ierr = VecCopy(locF,locFbc);CHKERRQ(ierr); 4841 ierr = PetscSectionGetChart(section,&pStart,&pEnd);CHKERRQ(ierr); 4842 ierr = PetscSectionGetMaxDof(section,&maxDof);CHKERRQ(ierr); 4843 ierr = PetscCalloc1(maxDof,&zeroes);CHKERRQ(ierr); 4844 for (p = pStart; p < pEnd; p++) { 4845 ierr = VecSetValuesSection(locFbc,section,p,zeroes,INSERT_BC_VALUES);CHKERRQ(ierr); 4846 } 4847 ierr = PetscFree(zeroes);CHKERRQ(ierr); 4848 ierr = DMPrintLocalVec(dm, name, mesh->printTol, locFbc);CHKERRQ(ierr); 4849 ierr = VecDestroy(&locFbc);CHKERRQ(ierr); 4850 } 4851 ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 4852 PetscFunctionReturn(0); 4853 } 4854 4855 /* 4856 1) Allow multiple kernels for BdResidual for hybrid DS 4857 4858 DONE 2) Get out dsAux for either side at the same time as cohesive cell dsAux 4859 4860 DONE 3) Change DMGetCellFields() to get different aux data a[] for each side 4861 - I think I just need to replace a[] with the closure from each face 4862 4863 4) Run both kernels for each non-hybrid field with correct dsAux, and then hybrid field as before 4864 */ 4865 PetscErrorCode DMPlexComputeResidual_Hybrid_Internal(DM dm, PetscFormKey key[], IS cellIS, PetscReal time, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user) 4866 { 4867 DM_Plex *mesh = (DM_Plex *) dm->data; 4868 const char *name = "Hybrid Residual"; 4869 DM dmAux[3] = {NULL, NULL, NULL}; 4870 DMLabel ghostLabel = NULL; 4871 PetscDS ds = NULL; 4872 PetscDS dsAux[3] = {NULL, NULL, NULL}; 4873 Vec locA[3] = {NULL, NULL, NULL}; 4874 PetscSection section = NULL; 4875 DMField coordField = NULL; 4876 PetscScalar *u = NULL, *u_t, *a[3]; 4877 PetscScalar *elemVec; 4878 IS chunkIS; 4879 const PetscInt *cells; 4880 PetscInt *faces; 4881 PetscInt cStart, cEnd, numCells; 4882 PetscInt Nf, f, totDim, totDimAux[3], numChunks, cellChunkSize, chunk; 4883 PetscInt maxDegree = PETSC_MAX_INT; 4884 PetscQuadrature affineQuad = NULL, *quads = NULL; 4885 PetscFEGeom *affineGeom = NULL, **geoms = NULL; 4886 PetscErrorCode ierr; 4887 4888 PetscFunctionBegin; 4889 ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 4890 /* TODO The places where we have to use isFE are probably the member functions for the PetscDisc class */ 4891 /* FEM */ 4892 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr); 4893 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 4894 /* 1: Get sizes from dm and dmAux */ 4895 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 4896 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 4897 ierr = DMGetCellDS(dm, cStart, &ds);CHKERRQ(ierr); 4898 ierr = PetscDSGetNumFields(ds, &Nf);CHKERRQ(ierr); 4899 ierr = PetscDSGetTotalDimension(ds, &totDim);CHKERRQ(ierr); 4900 ierr = DMGetAuxiliaryVec(dm, key[2].label, key[2].value, &locA[2]);CHKERRQ(ierr); 4901 if (locA[2]) { 4902 ierr = VecGetDM(locA[2], &dmAux[2]);CHKERRQ(ierr); 4903 ierr = DMGetCellDS(dmAux[2], cStart, &dsAux[2]);CHKERRQ(ierr); 4904 ierr = PetscDSGetTotalDimension(dsAux[2], &totDimAux[2]);CHKERRQ(ierr); 4905 { 4906 const PetscInt *cone; 4907 PetscInt c; 4908 4909 ierr = DMPlexGetCone(dm, cStart, &cone);CHKERRQ(ierr); 4910 for (c = 0; c < 2; ++c) { 4911 const PetscInt *support; 4912 PetscInt ssize, s; 4913 4914 ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr); 4915 ierr = DMPlexGetSupportSize(dm, cone[c], &ssize);CHKERRQ(ierr); 4916 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); 4917 if (support[0] == cStart) s = 1; 4918 else if (support[1] == cStart) s = 0; 4919 else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D does not have cell %D in its support", cone[c], cStart); 4920 ierr = DMGetAuxiliaryVec(dm, key[c].label, key[c].value, &locA[c]);CHKERRQ(ierr); 4921 if (locA[c]) {ierr = VecGetDM(locA[c], &dmAux[c]);CHKERRQ(ierr);} 4922 else {dmAux[c] = dmAux[2];} 4923 ierr = DMGetCellDS(dmAux[c], support[s], &dsAux[c]);CHKERRQ(ierr); 4924 ierr = PetscDSGetTotalDimension(dsAux[c], &totDimAux[c]);CHKERRQ(ierr); 4925 } 4926 } 4927 } 4928 /* 2: Setup geometric data */ 4929 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 4930 ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr); 4931 if (maxDegree > 1) { 4932 ierr = PetscCalloc2(Nf, &quads, Nf, &geoms);CHKERRQ(ierr); 4933 for (f = 0; f < Nf; ++f) { 4934 PetscFE fe; 4935 4936 ierr = PetscDSGetDiscretization(ds, f, (PetscObject *) &fe);CHKERRQ(ierr); 4937 if (fe) { 4938 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr); 4939 ierr = PetscObjectReference((PetscObject) quads[f]);CHKERRQ(ierr); 4940 } 4941 } 4942 } 4943 /* Loop over chunks */ 4944 cellChunkSize = numCells; 4945 numChunks = !numCells ? 0 : PetscCeilReal(((PetscReal) numCells)/cellChunkSize); 4946 ierr = PetscCalloc1(2*cellChunkSize, &faces);CHKERRQ(ierr); 4947 ierr = ISCreateGeneral(PETSC_COMM_SELF, cellChunkSize, faces, PETSC_USE_POINTER, &chunkIS);CHKERRQ(ierr); 4948 /* Extract field coefficients */ 4949 /* NOTE This needs the end cap faces to have identical orientations */ 4950 ierr = DMPlexGetCellFields(dm, cellIS, locX, locX_t, locA[2], &u, &u_t, &a[2]);CHKERRQ(ierr); 4951 ierr = DMPlexGetHybridAuxFields(dm, dmAux, dsAux, cellIS, locA, a);CHKERRQ(ierr); 4952 ierr = DMGetWorkArray(dm, cellChunkSize*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 4953 for (chunk = 0; chunk < numChunks; ++chunk) { 4954 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c; 4955 4956 ierr = PetscMemzero(elemVec, cellChunkSize*totDim * sizeof(PetscScalar));CHKERRQ(ierr); 4957 /* Get faces */ 4958 for (c = cS; c < cE; ++c) { 4959 const PetscInt cell = cells ? cells[c] : c; 4960 const PetscInt *cone; 4961 ierr = DMPlexGetCone(dm, cell, &cone);CHKERRQ(ierr); 4962 faces[(c-cS)*2+0] = cone[0]; 4963 faces[(c-cS)*2+1] = cone[1]; 4964 } 4965 ierr = ISGeneralSetIndices(chunkIS, cellChunkSize, faces, PETSC_USE_POINTER);CHKERRQ(ierr); 4966 /* Get geometric data */ 4967 if (maxDegree <= 1) { 4968 if (!affineQuad) {ierr = DMFieldCreateDefaultQuadrature(coordField, chunkIS, &affineQuad);CHKERRQ(ierr);} 4969 if (affineQuad) {ierr = DMSNESGetFEGeom(coordField, chunkIS, affineQuad, PETSC_TRUE, &affineGeom);CHKERRQ(ierr);} 4970 } else { 4971 for (f = 0; f < Nf; ++f) { 4972 if (quads[f]) {ierr = DMSNESGetFEGeom(coordField, chunkIS, quads[f], PETSC_TRUE, &geoms[f]);CHKERRQ(ierr);} 4973 } 4974 } 4975 /* Loop over fields */ 4976 for (f = 0; f < Nf; ++f) { 4977 PetscFE fe; 4978 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[f]; 4979 PetscFEGeom *chunkGeom = NULL, *remGeom = NULL; 4980 PetscQuadrature quad = affineQuad ? affineQuad : quads[f]; 4981 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset, Nq, Nb; 4982 4983 ierr = PetscDSGetDiscretization(ds, f, (PetscObject *) &fe);CHKERRQ(ierr); 4984 if (!fe) continue; 4985 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 4986 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 4987 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 4988 blockSize = Nb; 4989 batchSize = numBlocks * blockSize; 4990 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 4991 numChunks = numCells / (numBatches*batchSize); 4992 Ne = numChunks*numBatches*batchSize; 4993 Nr = numCells % (numBatches*batchSize); 4994 offset = numCells - Nr; 4995 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 4996 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&remGeom);CHKERRQ(ierr); 4997 if (f == Nf-1) { 4998 key[2].field = f; 4999 ierr = PetscFEIntegrateHybridResidual(ds, key[2], Ne, chunkGeom, u, u_t, dsAux[2], a[2], t, elemVec);CHKERRQ(ierr); 5000 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); 5001 } else { 5002 key[0].field = f; 5003 key[1].field = f; 5004 ierr = PetscFEIntegrateHybridResidual(ds, key[0], Ne, chunkGeom, u, u_t, dsAux[0], a[0], t, elemVec);CHKERRQ(ierr); 5005 ierr = PetscFEIntegrateHybridResidual(ds, key[1], Ne, chunkGeom, u, u_t, dsAux[1], a[1], t, elemVec);CHKERRQ(ierr); 5006 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); 5007 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); 5008 } 5009 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&remGeom);CHKERRQ(ierr); 5010 ierr = PetscFEGeomRestoreChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 5011 } 5012 /* Add elemVec to locX */ 5013 for (c = cS; c < cE; ++c) { 5014 const PetscInt cell = cells ? cells[c] : c; 5015 const PetscInt cind = c - cStart; 5016 5017 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);} 5018 if (ghostLabel) { 5019 PetscInt ghostVal; 5020 5021 ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr); 5022 if (ghostVal > 0) continue; 5023 } 5024 ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr); 5025 } 5026 } 5027 ierr = DMPlexRestoreCellFields(dm, cellIS, locX, locX_t, locA[2], &u, &u_t, &a[2]);CHKERRQ(ierr); 5028 ierr = DMPlexRestoreHybridAuxFields(dmAux, dsAux, cellIS, locA, a);CHKERRQ(ierr); 5029 ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 5030 ierr = PetscFree(faces);CHKERRQ(ierr); 5031 ierr = ISDestroy(&chunkIS);CHKERRQ(ierr); 5032 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 5033 if (maxDegree <= 1) { 5034 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 5035 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr); 5036 } else { 5037 for (f = 0; f < Nf; ++f) { 5038 if (geoms) {ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);} 5039 if (quads) {ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);} 5040 } 5041 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr); 5042 } 5043 ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 5044 PetscFunctionReturn(0); 5045 } 5046 5047 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) 5048 { 5049 DM_Plex *mesh = (DM_Plex *) dm->data; 5050 DM plex = NULL, plexA = NULL, tdm; 5051 DMEnclosureType encAux; 5052 PetscDS prob, probAux = NULL; 5053 PetscSection section, sectionAux = NULL; 5054 PetscSection globalSection, subSection = NULL; 5055 Vec locA = NULL, tv; 5056 PetscScalar *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL; 5057 PetscInt v; 5058 PetscInt Nf, totDim, totDimAux = 0; 5059 PetscBool isMatISP, transform; 5060 PetscErrorCode ierr; 5061 5062 PetscFunctionBegin; 5063 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr); 5064 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr); 5065 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr); 5066 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr); 5067 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 5068 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 5069 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 5070 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 5071 ierr = DMGetAuxiliaryVec(dm, label, values[0], &locA);CHKERRQ(ierr); 5072 if (locA) { 5073 DM dmAux; 5074 5075 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 5076 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr); 5077 ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr); 5078 ierr = DMGetDS(plexA, &probAux);CHKERRQ(ierr); 5079 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 5080 ierr = DMGetLocalSection(plexA, §ionAux);CHKERRQ(ierr); 5081 } 5082 5083 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr); 5084 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 5085 if (isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);} 5086 for (v = 0; v < numValues; ++v) { 5087 PetscFEGeom *fgeom; 5088 PetscInt maxDegree; 5089 PetscQuadrature qGeom = NULL; 5090 IS pointIS; 5091 const PetscInt *points; 5092 PetscFormKey key; 5093 PetscInt numFaces, face, Nq; 5094 5095 key.label = label; 5096 key.value = values[v]; 5097 key.part = 0; 5098 ierr = DMLabelGetStratumIS(label, values[v], &pointIS);CHKERRQ(ierr); 5099 if (!pointIS) continue; /* No points with that id on this process */ 5100 { 5101 IS isectIS; 5102 5103 /* TODO: Special cases of ISIntersect where it is quick to check a prior if one is a superset of the other */ 5104 ierr = ISIntersect_Caching_Internal(facetIS,pointIS,&isectIS);CHKERRQ(ierr); 5105 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 5106 pointIS = isectIS; 5107 } 5108 ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr); 5109 ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr); 5110 ierr = PetscMalloc4(numFaces*totDim, &u, locX_t ? numFaces*totDim : 0, &u_t, numFaces*totDim*totDim, &elemMat, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr); 5111 ierr = DMFieldGetDegree(coordField,pointIS,NULL,&maxDegree);CHKERRQ(ierr); 5112 if (maxDegree <= 1) { 5113 ierr = DMFieldCreateDefaultQuadrature(coordField,pointIS,&qGeom);CHKERRQ(ierr); 5114 } 5115 if (!qGeom) { 5116 PetscFE fe; 5117 5118 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 5119 ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr); 5120 ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr); 5121 } 5122 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 5123 ierr = DMSNESGetFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr); 5124 for (face = 0; face < numFaces; ++face) { 5125 const PetscInt point = points[face], *support; 5126 PetscScalar *x = NULL; 5127 PetscInt i; 5128 5129 ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr); 5130 ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 5131 for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i]; 5132 ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 5133 if (locX_t) { 5134 ierr = DMPlexVecGetClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr); 5135 for (i = 0; i < totDim; ++i) u_t[face*totDim+i] = x[i]; 5136 ierr = DMPlexVecRestoreClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr); 5137 } 5138 if (locA) { 5139 PetscInt subp; 5140 ierr = DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp);CHKERRQ(ierr); 5141 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 5142 for (i = 0; i < totDimAux; ++i) a[face*totDimAux+i] = x[i]; 5143 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 5144 } 5145 } 5146 ierr = PetscArrayzero(elemMat, numFaces*totDim*totDim);CHKERRQ(ierr); 5147 { 5148 PetscFE fe; 5149 PetscInt Nb; 5150 /* Conforming batches */ 5151 PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize; 5152 /* Remainder */ 5153 PetscFEGeom *chunkGeom = NULL; 5154 PetscInt fieldJ, Nr, offset; 5155 5156 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 5157 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 5158 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 5159 blockSize = Nb; 5160 batchSize = numBlocks * blockSize; 5161 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 5162 numChunks = numFaces / (numBatches*batchSize); 5163 Ne = numChunks*numBatches*batchSize; 5164 Nr = numFaces % (numBatches*batchSize); 5165 offset = numFaces - Nr; 5166 ierr = PetscFEGeomGetChunk(fgeom,0,offset,&chunkGeom);CHKERRQ(ierr); 5167 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 5168 key.field = fieldI*Nf+fieldJ; 5169 ierr = PetscFEIntegrateBdJacobian(prob, wf, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr); 5170 } 5171 ierr = PetscFEGeomGetChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr); 5172 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 5173 key.field = fieldI*Nf+fieldJ; 5174 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); 5175 } 5176 ierr = PetscFEGeomRestoreChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr); 5177 } 5178 for (face = 0; face < numFaces; ++face) { 5179 const PetscInt point = points[face], *support; 5180 5181 /* Transform to global basis before insertion in Jacobian */ 5182 ierr = DMPlexGetSupport(plex, point, &support);CHKERRQ(ierr); 5183 if (transform) {ierr = DMPlexBasisTransformPointTensor_Internal(dm, tdm, tv, support[0], PETSC_TRUE, totDim, &elemMat[face*totDim*totDim]);CHKERRQ(ierr);} 5184 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(point, "BdJacobian", totDim, totDim, &elemMat[face*totDim*totDim]);CHKERRQ(ierr);} 5185 if (!isMatISP) { 5186 ierr = DMPlexMatSetClosure(plex, section, globalSection, JacP, support[0], &elemMat[face*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5187 } else { 5188 Mat lJ; 5189 5190 ierr = MatISGetLocalMat(JacP, &lJ);CHKERRQ(ierr); 5191 ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, support[0], &elemMat[face*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5192 } 5193 } 5194 ierr = DMSNESRestoreFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr); 5195 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 5196 ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr); 5197 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 5198 ierr = PetscFree4(u, u_t, elemMat, a);CHKERRQ(ierr); 5199 } 5200 if (plex) {ierr = DMDestroy(&plex);CHKERRQ(ierr);} 5201 if (plexA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);} 5202 PetscFunctionReturn(0); 5203 } 5204 5205 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) 5206 { 5207 DMField coordField; 5208 DMLabel depthLabel; 5209 IS facetIS; 5210 PetscInt dim; 5211 PetscErrorCode ierr; 5212 5213 PetscFunctionBegin; 5214 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 5215 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 5216 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr); 5217 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 5218 ierr = DMPlexComputeBdJacobian_Single_Internal(dm, t, wf, label, numValues, values, field, locX, locX_t, X_tShift, Jac, JacP, coordField, facetIS);CHKERRQ(ierr); 5219 ierr = ISDestroy(&facetIS);CHKERRQ(ierr); 5220 PetscFunctionReturn(0); 5221 } 5222 5223 PetscErrorCode DMPlexComputeBdJacobian_Internal(DM dm, Vec locX, Vec locX_t, PetscReal t, PetscReal X_tShift, Mat Jac, Mat JacP, void *user) 5224 { 5225 PetscDS prob; 5226 PetscInt dim, numBd, bd; 5227 DMLabel depthLabel; 5228 DMField coordField = NULL; 5229 IS facetIS; 5230 PetscErrorCode ierr; 5231 5232 PetscFunctionBegin; 5233 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 5234 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 5235 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 5236 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr); 5237 ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr); 5238 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 5239 for (bd = 0; bd < numBd; ++bd) { 5240 PetscWeakForm wf; 5241 DMBoundaryConditionType type; 5242 DMLabel label; 5243 const PetscInt *values; 5244 PetscInt fieldI, numValues; 5245 PetscObject obj; 5246 PetscClassId id; 5247 5248 ierr = PetscDSGetBoundary(prob, bd, &wf, &type, NULL, &label, &numValues, &values, &fieldI, NULL, NULL, NULL, NULL, NULL);CHKERRQ(ierr); 5249 ierr = PetscDSGetDiscretization(prob, fieldI, &obj);CHKERRQ(ierr); 5250 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 5251 if ((id != PETSCFE_CLASSID) || (type & DM_BC_ESSENTIAL)) continue; 5252 ierr = DMPlexComputeBdJacobian_Single_Internal(dm, t, wf, label, numValues, values, fieldI, locX, locX_t, X_tShift, Jac, JacP, coordField, facetIS);CHKERRQ(ierr); 5253 } 5254 ierr = ISDestroy(&facetIS);CHKERRQ(ierr); 5255 PetscFunctionReturn(0); 5256 } 5257 5258 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) 5259 { 5260 DM_Plex *mesh = (DM_Plex *) dm->data; 5261 const char *name = "Jacobian"; 5262 DM dmAux = NULL, plex, tdm; 5263 DMEnclosureType encAux; 5264 Vec A, tv; 5265 DMField coordField; 5266 PetscDS prob, probAux = NULL; 5267 PetscSection section, globalSection, subSection, sectionAux; 5268 PetscScalar *elemMat, *elemMatP, *elemMatD, *u, *u_t, *a = NULL; 5269 const PetscInt *cells; 5270 PetscInt Nf, fieldI, fieldJ; 5271 PetscInt totDim, totDimAux, cStart, cEnd, numCells, c; 5272 PetscBool isMatIS, isMatISP, hasJac, hasPrec, hasDyn, hasFV = PETSC_FALSE, transform; 5273 PetscErrorCode ierr; 5274 5275 PetscFunctionBegin; 5276 ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 5277 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr); 5278 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 5279 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr); 5280 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr); 5281 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr); 5282 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 5283 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr); 5284 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 5285 if (isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);} 5286 ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob);CHKERRQ(ierr); 5287 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 5288 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 5289 ierr = PetscDSHasJacobian(prob, &hasJac);CHKERRQ(ierr); 5290 ierr = PetscDSHasJacobianPreconditioner(prob, &hasPrec);CHKERRQ(ierr); 5291 /* user passed in the same matrix, avoid double contributions and 5292 only assemble the Jacobian */ 5293 if (hasJac && Jac == JacP) hasPrec = PETSC_FALSE; 5294 ierr = PetscDSHasDynamicJacobian(prob, &hasDyn);CHKERRQ(ierr); 5295 hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE; 5296 ierr = DMGetAuxiliaryVec(dm, key.label, key.value, &A);CHKERRQ(ierr); 5297 if (A) { 5298 ierr = VecGetDM(A, &dmAux);CHKERRQ(ierr); 5299 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr); 5300 ierr = DMConvert(dmAux, DMPLEX, &plex);CHKERRQ(ierr); 5301 ierr = DMGetLocalSection(plex, §ionAux);CHKERRQ(ierr); 5302 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 5303 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 5304 } 5305 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); 5306 if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);} 5307 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 5308 for (c = cStart; c < cEnd; ++c) { 5309 const PetscInt cell = cells ? cells[c] : c; 5310 const PetscInt cind = c - cStart; 5311 PetscScalar *x = NULL, *x_t = NULL; 5312 PetscInt i; 5313 5314 ierr = DMPlexVecGetClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr); 5315 for (i = 0; i < totDim; ++i) u[cind*totDim+i] = x[i]; 5316 ierr = DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr); 5317 if (X_t) { 5318 ierr = DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 5319 for (i = 0; i < totDim; ++i) u_t[cind*totDim+i] = x_t[i]; 5320 ierr = DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 5321 } 5322 if (dmAux) { 5323 PetscInt subcell; 5324 ierr = DMGetEnclosurePoint(dmAux, dm, encAux, cell, &subcell);CHKERRQ(ierr); 5325 ierr = DMPlexVecGetClosure(plex, sectionAux, A, subcell, NULL, &x);CHKERRQ(ierr); 5326 for (i = 0; i < totDimAux; ++i) a[cind*totDimAux+i] = x[i]; 5327 ierr = DMPlexVecRestoreClosure(plex, sectionAux, A, subcell, NULL, &x);CHKERRQ(ierr); 5328 } 5329 } 5330 if (hasJac) {ierr = PetscArrayzero(elemMat, numCells*totDim*totDim);CHKERRQ(ierr);} 5331 if (hasPrec) {ierr = PetscArrayzero(elemMatP, numCells*totDim*totDim);CHKERRQ(ierr);} 5332 if (hasDyn) {ierr = PetscArrayzero(elemMatD, numCells*totDim*totDim);CHKERRQ(ierr);} 5333 for (fieldI = 0; fieldI < Nf; ++fieldI) { 5334 PetscClassId id; 5335 PetscFE fe; 5336 PetscQuadrature qGeom = NULL; 5337 PetscInt Nb; 5338 /* Conforming batches */ 5339 PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize; 5340 /* Remainder */ 5341 PetscInt Nr, offset, Nq; 5342 PetscInt maxDegree; 5343 PetscFEGeom *cgeomFEM, *chunkGeom = NULL, *remGeom = NULL; 5344 5345 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 5346 ierr = PetscObjectGetClassId((PetscObject) fe, &id);CHKERRQ(ierr); 5347 if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; continue;} 5348 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 5349 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 5350 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr); 5351 if (maxDegree <= 1) { 5352 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&qGeom);CHKERRQ(ierr); 5353 } 5354 if (!qGeom) { 5355 ierr = PetscFEGetQuadrature(fe,&qGeom);CHKERRQ(ierr); 5356 ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr); 5357 } 5358 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 5359 ierr = DMSNESGetFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr); 5360 blockSize = Nb; 5361 batchSize = numBlocks * blockSize; 5362 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 5363 numChunks = numCells / (numBatches*batchSize); 5364 Ne = numChunks*numBatches*batchSize; 5365 Nr = numCells % (numBatches*batchSize); 5366 offset = numCells - Nr; 5367 ierr = PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr); 5368 ierr = PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&remGeom);CHKERRQ(ierr); 5369 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 5370 key.field = fieldI*Nf+fieldJ; 5371 if (hasJac) { 5372 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr); 5373 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); 5374 } 5375 if (hasPrec) { 5376 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr); 5377 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); 5378 } 5379 if (hasDyn) { 5380 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatD);CHKERRQ(ierr); 5381 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); 5382 } 5383 } 5384 ierr = PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&remGeom);CHKERRQ(ierr); 5385 ierr = PetscFEGeomRestoreChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr); 5386 ierr = DMSNESRestoreFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr); 5387 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 5388 } 5389 /* Add contribution from X_t */ 5390 if (hasDyn) {for (c = 0; c < numCells*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];} 5391 if (hasFV) { 5392 PetscClassId id; 5393 PetscFV fv; 5394 PetscInt offsetI, NcI, NbI = 1, fc, f; 5395 5396 for (fieldI = 0; fieldI < Nf; ++fieldI) { 5397 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv);CHKERRQ(ierr); 5398 ierr = PetscDSGetFieldOffset(prob, fieldI, &offsetI);CHKERRQ(ierr); 5399 ierr = PetscObjectGetClassId((PetscObject) fv, &id);CHKERRQ(ierr); 5400 if (id != PETSCFV_CLASSID) continue; 5401 /* Put in the identity */ 5402 ierr = PetscFVGetNumComponents(fv, &NcI);CHKERRQ(ierr); 5403 for (c = cStart; c < cEnd; ++c) { 5404 const PetscInt cind = c - cStart; 5405 const PetscInt eOffset = cind*totDim*totDim; 5406 for (fc = 0; fc < NcI; ++fc) { 5407 for (f = 0; f < NbI; ++f) { 5408 const PetscInt i = offsetI + f*NcI+fc; 5409 if (hasPrec) { 5410 if (hasJac) {elemMat[eOffset+i*totDim+i] = 1.0;} 5411 elemMatP[eOffset+i*totDim+i] = 1.0; 5412 } else {elemMat[eOffset+i*totDim+i] = 1.0;} 5413 } 5414 } 5415 } 5416 } 5417 /* No allocated space for FV stuff, so ignore the zero entries */ 5418 ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE);CHKERRQ(ierr); 5419 } 5420 /* Insert values into matrix */ 5421 isMatIS = PETSC_FALSE; 5422 if (hasPrec && hasJac) { 5423 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatIS);CHKERRQ(ierr); 5424 } 5425 if (isMatIS && !subSection) { 5426 ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr); 5427 } 5428 for (c = cStart; c < cEnd; ++c) { 5429 const PetscInt cell = cells ? cells[c] : c; 5430 const PetscInt cind = c - cStart; 5431 5432 /* Transform to global basis before insertion in Jacobian */ 5433 if (transform) {ierr = DMPlexBasisTransformPointTensor_Internal(dm, tdm, tv, cell, PETSC_TRUE, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);} 5434 if (hasPrec) { 5435 if (hasJac) { 5436 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);} 5437 if (!isMatIS) { 5438 ierr = DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5439 } else { 5440 Mat lJ; 5441 5442 ierr = MatISGetLocalMat(Jac,&lJ);CHKERRQ(ierr); 5443 ierr = DMPlexMatSetClosure(dm, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5444 } 5445 } 5446 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMatP[cind*totDim*totDim]);CHKERRQ(ierr);} 5447 if (!isMatISP) { 5448 ierr = DMPlexMatSetClosure(dm, section, globalSection, JacP, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5449 } else { 5450 Mat lJ; 5451 5452 ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr); 5453 ierr = DMPlexMatSetClosure(dm, section, subSection, lJ, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5454 } 5455 } else { 5456 if (hasJac) { 5457 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);} 5458 if (!isMatISP) { 5459 ierr = DMPlexMatSetClosure(dm, section, globalSection, JacP, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5460 } else { 5461 Mat lJ; 5462 5463 ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr); 5464 ierr = DMPlexMatSetClosure(dm, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5465 } 5466 } 5467 } 5468 } 5469 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 5470 if (hasFV) {ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);} 5471 ierr = PetscFree5(u,u_t,elemMat,elemMatP,elemMatD);CHKERRQ(ierr); 5472 if (dmAux) { 5473 ierr = PetscFree(a);CHKERRQ(ierr); 5474 ierr = DMDestroy(&plex);CHKERRQ(ierr); 5475 } 5476 /* Compute boundary integrals */ 5477 ierr = DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, user);CHKERRQ(ierr); 5478 /* Assemble matrix */ 5479 if (hasJac && hasPrec) { 5480 ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5481 ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5482 } 5483 ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5484 ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5485 ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 5486 PetscFunctionReturn(0); 5487 } 5488 5489 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) 5490 { 5491 DM_Plex *mesh = (DM_Plex *) dm->data; 5492 const char *name = "Hybrid Jacobian"; 5493 DM dmAux[3] = {NULL, NULL, NULL}; 5494 DMLabel ghostLabel = NULL; 5495 DM plex = NULL; 5496 DM plexA = NULL; 5497 PetscDS ds = NULL; 5498 PetscDS dsAux[3] = {NULL, NULL, NULL}; 5499 Vec locA[3] = {NULL, NULL, NULL}; 5500 PetscSection section = NULL; 5501 PetscSection sectionAux[3] = {NULL, NULL, NULL}; 5502 DMField coordField = NULL; 5503 PetscScalar *u = NULL, *u_t, *a[3]; 5504 PetscScalar *elemMat, *elemMatP; 5505 PetscSection globalSection, subSection; 5506 IS chunkIS; 5507 const PetscInt *cells; 5508 PetscInt *faces; 5509 PetscInt cStart, cEnd, numCells; 5510 PetscInt Nf, fieldI, fieldJ, totDim, totDimAux[3], numChunks, cellChunkSize, chunk; 5511 PetscInt maxDegree = PETSC_MAX_INT; 5512 PetscQuadrature affineQuad = NULL, *quads = NULL; 5513 PetscFEGeom *affineGeom = NULL, **geoms = NULL; 5514 PetscBool repeatKey = PETSC_FALSE, isMatIS = PETSC_FALSE, isMatISP = PETSC_FALSE, hasBdJac, hasBdPrec; 5515 PetscErrorCode ierr; 5516 5517 PetscFunctionBegin; 5518 /* If keys are the same, both kernel will be run using the first key */ 5519 repeatKey = ((key[0].label == key[1].label) && (key[0].value == key[1].value)) ? PETSC_TRUE : PETSC_FALSE; 5520 ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 5521 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr); 5522 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 5523 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr); 5524 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 5525 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 5526 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 5527 ierr = DMGetCellDS(dm, cStart, &ds);CHKERRQ(ierr); 5528 ierr = PetscDSGetNumFields(ds, &Nf);CHKERRQ(ierr); 5529 ierr = PetscDSGetTotalDimension(ds, &totDim);CHKERRQ(ierr); 5530 ierr = PetscDSHasBdJacobian(ds, &hasBdJac);CHKERRQ(ierr); 5531 ierr = PetscDSHasBdJacobianPreconditioner(ds, &hasBdPrec);CHKERRQ(ierr); 5532 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr); 5533 if (isMatISP) {ierr = DMPlexGetSubdomainSection(plex, &subSection);CHKERRQ(ierr);} 5534 if (hasBdPrec && hasBdJac) {ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatIS);CHKERRQ(ierr);} 5535 if (isMatIS && !subSection) {ierr = DMPlexGetSubdomainSection(plex, &subSection);CHKERRQ(ierr);} 5536 ierr = DMGetAuxiliaryVec(dm, key[2].label, key[2].value, &locA[2]);CHKERRQ(ierr); 5537 if (locA[2]) { 5538 ierr = VecGetDM(locA[2], &dmAux[2]);CHKERRQ(ierr); 5539 ierr = DMConvert(dmAux[2], DMPLEX, &plexA);CHKERRQ(ierr); 5540 ierr = DMGetSection(dmAux[2], §ionAux[2]);CHKERRQ(ierr); 5541 ierr = DMGetCellDS(dmAux[2], cStart, &dsAux[2]);CHKERRQ(ierr); 5542 ierr = PetscDSGetTotalDimension(dsAux[2], &totDimAux[2]);CHKERRQ(ierr); 5543 { 5544 const PetscInt *cone; 5545 PetscInt c; 5546 5547 ierr = DMPlexGetCone(dm, cStart, &cone);CHKERRQ(ierr); 5548 for (c = 0; c < 2; ++c) { 5549 const PetscInt *support; 5550 PetscInt ssize, s; 5551 5552 ierr = DMPlexGetSupport(dm, cone[c], &support);CHKERRQ(ierr); 5553 ierr = DMPlexGetSupportSize(dm, cone[c], &ssize);CHKERRQ(ierr); 5554 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); 5555 if (support[0] == cStart) s = 1; 5556 else if (support[1] == cStart) s = 0; 5557 else SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Face %D does not have cell %D in its support", cone[c], cStart); 5558 ierr = DMGetAuxiliaryVec(dm, key[c].label, key[c].value, &locA[c]);CHKERRQ(ierr); 5559 if (locA[c]) {ierr = VecGetDM(locA[c], &dmAux[c]);CHKERRQ(ierr);} 5560 else {dmAux[c] = dmAux[2];} 5561 ierr = DMGetCellDS(dmAux[c], support[s], &dsAux[c]);CHKERRQ(ierr); 5562 ierr = PetscDSGetTotalDimension(dsAux[c], &totDimAux[c]);CHKERRQ(ierr); 5563 } 5564 } 5565 } 5566 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 5567 ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr); 5568 if (maxDegree > 1) { 5569 PetscInt f; 5570 ierr = PetscCalloc2(Nf, &quads, Nf, &geoms);CHKERRQ(ierr); 5571 for (f = 0; f < Nf; ++f) { 5572 PetscFE fe; 5573 5574 ierr = PetscDSGetDiscretization(ds, f, (PetscObject *) &fe);CHKERRQ(ierr); 5575 if (fe) { 5576 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr); 5577 ierr = PetscObjectReference((PetscObject) quads[f]);CHKERRQ(ierr); 5578 } 5579 } 5580 } 5581 cellChunkSize = numCells; 5582 numChunks = !numCells ? 0 : PetscCeilReal(((PetscReal) numCells)/cellChunkSize); 5583 ierr = PetscCalloc1(2*cellChunkSize, &faces);CHKERRQ(ierr); 5584 ierr = ISCreateGeneral(PETSC_COMM_SELF, cellChunkSize, faces, PETSC_USE_POINTER, &chunkIS);CHKERRQ(ierr); 5585 ierr = DMPlexGetCellFields(dm, cellIS, locX, locX_t, locA[2], &u, &u_t, &a[2]);CHKERRQ(ierr); 5586 ierr = DMPlexGetHybridAuxFields(dm, dmAux, dsAux, cellIS, locA, a);CHKERRQ(ierr); 5587 ierr = DMGetWorkArray(dm, hasBdJac ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMat);CHKERRQ(ierr); 5588 ierr = DMGetWorkArray(dm, hasBdPrec ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMatP);CHKERRQ(ierr); 5589 for (chunk = 0; chunk < numChunks; ++chunk) { 5590 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c; 5591 5592 if (hasBdJac) {ierr = PetscMemzero(elemMat, numCells*totDim*totDim * sizeof(PetscScalar));CHKERRQ(ierr);} 5593 if (hasBdPrec) {ierr = PetscMemzero(elemMatP, numCells*totDim*totDim * sizeof(PetscScalar));CHKERRQ(ierr);} 5594 /* Get faces */ 5595 for (c = cS; c < cE; ++c) { 5596 const PetscInt cell = cells ? cells[c] : c; 5597 const PetscInt *cone; 5598 ierr = DMPlexGetCone(plex, cell, &cone);CHKERRQ(ierr); 5599 faces[(c-cS)*2+0] = cone[0]; 5600 faces[(c-cS)*2+1] = cone[1]; 5601 } 5602 ierr = ISGeneralSetIndices(chunkIS, cellChunkSize, faces, PETSC_USE_POINTER);CHKERRQ(ierr); 5603 if (maxDegree <= 1) { 5604 if (!affineQuad) {ierr = DMFieldCreateDefaultQuadrature(coordField, chunkIS, &affineQuad);CHKERRQ(ierr);} 5605 if (affineQuad) {ierr = DMSNESGetFEGeom(coordField, chunkIS, affineQuad, PETSC_TRUE, &affineGeom);CHKERRQ(ierr);} 5606 } else { 5607 PetscInt f; 5608 for (f = 0; f < Nf; ++f) { 5609 if (quads[f]) {ierr = DMSNESGetFEGeom(coordField, chunkIS, quads[f], PETSC_TRUE, &geoms[f]);CHKERRQ(ierr);} 5610 } 5611 } 5612 5613 for (fieldI = 0; fieldI < Nf; ++fieldI) { 5614 PetscFE feI; 5615 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[fieldI]; 5616 PetscFEGeom *chunkGeom = NULL, *remGeom = NULL; 5617 PetscQuadrature quad = affineQuad ? affineQuad : quads[fieldI]; 5618 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset, Nq, Nb; 5619 5620 ierr = PetscDSGetDiscretization(ds, fieldI, (PetscObject *) &feI);CHKERRQ(ierr); 5621 if (!feI) continue; 5622 ierr = PetscFEGetTileSizes(feI, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 5623 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 5624 ierr = PetscFEGetDimension(feI, &Nb);CHKERRQ(ierr); 5625 blockSize = Nb; 5626 batchSize = numBlocks * blockSize; 5627 ierr = PetscFESetTileSizes(feI, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 5628 numChunks = numCells / (numBatches*batchSize); 5629 Ne = numChunks*numBatches*batchSize; 5630 Nr = numCells % (numBatches*batchSize); 5631 offset = numCells - Nr; 5632 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 5633 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&remGeom);CHKERRQ(ierr); 5634 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 5635 PetscFE feJ; 5636 5637 ierr = PetscDSGetDiscretization(ds, fieldJ, (PetscObject *) &feJ);CHKERRQ(ierr); 5638 if (!feJ) continue; 5639 if (fieldI == Nf-1) { 5640 key[2].field = fieldI*Nf+fieldJ; 5641 if (hasBdJac) { 5642 ierr = PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN, key[2], Ne, chunkGeom, u, u_t, dsAux[2], a[2], t, X_tShift, elemMat);CHKERRQ(ierr); 5643 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); 5644 } 5645 if (hasBdPrec) { 5646 ierr = PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN_PRE, key[2], Ne, chunkGeom, u, u_t, dsAux[2], a[2], t, X_tShift, elemMatP);CHKERRQ(ierr); 5647 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); 5648 } 5649 } else { 5650 key[0].field = fieldI*Nf+fieldJ; 5651 key[1].field = fieldI*Nf+fieldJ; 5652 if (hasBdJac) { 5653 ierr = PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN, key[0], Ne, chunkGeom, u, u_t, dsAux[0], a[0], t, X_tShift, elemMat);CHKERRQ(ierr); 5654 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); 5655 if (!repeatKey) { 5656 ierr = PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN, key[1], Ne, chunkGeom, u, u_t, dsAux[1], a[1], t, X_tShift, elemMat);CHKERRQ(ierr); 5657 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); 5658 } 5659 } 5660 if (hasBdPrec) { 5661 ierr = PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN_PRE, key[0], Ne, chunkGeom, u, u_t, dsAux[0], a[0], t, X_tShift, elemMatP);CHKERRQ(ierr); 5662 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); 5663 if (!repeatKey) { 5664 ierr = PetscFEIntegrateHybridJacobian(ds, PETSCFE_JACOBIAN_PRE, key[1], Ne, chunkGeom, u, u_t, dsAux[1], a[1], t, X_tShift, elemMatP);CHKERRQ(ierr); 5665 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); 5666 } 5667 } 5668 } 5669 } 5670 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&remGeom);CHKERRQ(ierr); 5671 ierr = PetscFEGeomRestoreChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 5672 } 5673 /* Insert values into matrix */ 5674 for (c = cS; c < cE; ++c) { 5675 const PetscInt cell = cells ? cells[c] : c; 5676 const PetscInt cind = c - cS; 5677 5678 if (hasBdPrec) { 5679 if (hasBdJac) { 5680 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);} 5681 if (!isMatIS) { 5682 ierr = DMPlexMatSetClosure(plex, section, globalSection, Jac, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5683 } else { 5684 Mat lJ; 5685 5686 ierr = MatISGetLocalMat(Jac,&lJ);CHKERRQ(ierr); 5687 ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5688 } 5689 } 5690 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMatP[cind*totDim*totDim]);CHKERRQ(ierr);} 5691 if (!isMatISP) { 5692 ierr = DMPlexMatSetClosure(plex, section, globalSection, JacP, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5693 } else { 5694 Mat lJ; 5695 5696 ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr); 5697 ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5698 } 5699 } else if (hasBdJac) { 5700 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);} 5701 if (!isMatISP) { 5702 ierr = DMPlexMatSetClosure(plex, section, globalSection, JacP, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5703 } else { 5704 Mat lJ; 5705 5706 ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr); 5707 ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 5708 } 5709 } 5710 } 5711 } 5712 ierr = DMPlexRestoreCellFields(dm, cellIS, locX, locX_t, locA[2], &u, &u_t, &a[2]);CHKERRQ(ierr); 5713 ierr = DMPlexRestoreHybridAuxFields(dmAux, dsAux, cellIS, locA, a);CHKERRQ(ierr); 5714 ierr = DMRestoreWorkArray(dm, hasBdJac ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMat);CHKERRQ(ierr); 5715 ierr = DMRestoreWorkArray(dm, hasBdPrec ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMatP);CHKERRQ(ierr); 5716 ierr = PetscFree(faces);CHKERRQ(ierr); 5717 ierr = ISDestroy(&chunkIS);CHKERRQ(ierr); 5718 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 5719 if (maxDegree <= 1) { 5720 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 5721 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr); 5722 } else { 5723 PetscInt f; 5724 for (f = 0; f < Nf; ++f) { 5725 if (geoms) {ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE, &geoms[f]);CHKERRQ(ierr);} 5726 if (quads) {ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);} 5727 } 5728 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr); 5729 } 5730 if (dmAux[2]) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);} 5731 ierr = DMDestroy(&plex);CHKERRQ(ierr); 5732 /* Assemble matrix */ 5733 if (hasBdJac && hasBdPrec) { 5734 ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5735 ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5736 } 5737 ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5738 ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 5739 ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 5740 PetscFunctionReturn(0); 5741 } 5742 5743 /* 5744 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. 5745 5746 Input Parameters: 5747 + dm - The mesh 5748 . key - The PetscWeakFormKey indcating where integration should happen 5749 . cellIS - The cells to integrate over 5750 . t - The time 5751 . X_tShift - The multiplier for the Jacobian with repsect to X_t 5752 . X - Local solution vector 5753 . X_t - Time-derivative of the local solution vector 5754 . Y - Local input vector 5755 - user - the user context 5756 5757 Output Parameter: 5758 . Z - Local output vector 5759 5760 Note: 5761 We form the residual one batch of elements at a time. This allows us to offload work onto an accelerator, 5762 like a GPU, or vectorize on a multicore machine. 5763 */ 5764 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) 5765 { 5766 DM_Plex *mesh = (DM_Plex *) dm->data; 5767 const char *name = "Jacobian"; 5768 DM dmAux = NULL, plex, plexAux = NULL; 5769 DMEnclosureType encAux; 5770 Vec A; 5771 DMField coordField; 5772 PetscDS prob, probAux = NULL; 5773 PetscQuadrature quad; 5774 PetscSection section, globalSection, sectionAux; 5775 PetscScalar *elemMat, *elemMatD, *u, *u_t, *a = NULL, *y, *z; 5776 const PetscInt *cells; 5777 PetscInt Nf, fieldI, fieldJ; 5778 PetscInt totDim, totDimAux = 0, cStart, cEnd, numCells, c; 5779 PetscBool hasDyn; 5780 PetscErrorCode ierr; 5781 5782 PetscFunctionBegin; 5783 ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 5784 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr); 5785 if (!cellIS) { 5786 PetscInt depth; 5787 5788 ierr = DMPlexGetDepth(plex, &depth);CHKERRQ(ierr); 5789 ierr = DMGetStratumIS(plex, "dim", depth, &cellIS);CHKERRQ(ierr); 5790 if (!cellIS) {ierr = DMGetStratumIS(plex, "depth", depth, &cellIS);CHKERRQ(ierr);} 5791 } else { 5792 ierr = PetscObjectReference((PetscObject) cellIS);CHKERRQ(ierr); 5793 } 5794 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr); 5795 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 5796 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr); 5797 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 5798 ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob);CHKERRQ(ierr); 5799 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 5800 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 5801 ierr = PetscDSHasDynamicJacobian(prob, &hasDyn);CHKERRQ(ierr); 5802 hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE; 5803 ierr = DMGetAuxiliaryVec(dm, NULL, 0, &A);CHKERRQ(ierr); 5804 if (A) { 5805 ierr = VecGetDM(A, &dmAux);CHKERRQ(ierr); 5806 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr); 5807 ierr = DMConvert(dmAux, DMPLEX, &plexAux);CHKERRQ(ierr); 5808 ierr = DMGetLocalSection(plexAux, §ionAux);CHKERRQ(ierr); 5809 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 5810 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 5811 } 5812 ierr = VecSet(Z, 0.0);CHKERRQ(ierr); 5813 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); 5814 if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);} 5815 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 5816 for (c = cStart; c < cEnd; ++c) { 5817 const PetscInt cell = cells ? cells[c] : c; 5818 const PetscInt cind = c - cStart; 5819 PetscScalar *x = NULL, *x_t = NULL; 5820 PetscInt i; 5821 5822 ierr = DMPlexVecGetClosure(plex, section, X, cell, NULL, &x);CHKERRQ(ierr); 5823 for (i = 0; i < totDim; ++i) u[cind*totDim+i] = x[i]; 5824 ierr = DMPlexVecRestoreClosure(plex, section, X, cell, NULL, &x);CHKERRQ(ierr); 5825 if (X_t) { 5826 ierr = DMPlexVecGetClosure(plex, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 5827 for (i = 0; i < totDim; ++i) u_t[cind*totDim+i] = x_t[i]; 5828 ierr = DMPlexVecRestoreClosure(plex, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 5829 } 5830 if (dmAux) { 5831 PetscInt subcell; 5832 ierr = DMGetEnclosurePoint(dmAux, dm, encAux, cell, &subcell);CHKERRQ(ierr); 5833 ierr = DMPlexVecGetClosure(plexAux, sectionAux, A, subcell, NULL, &x);CHKERRQ(ierr); 5834 for (i = 0; i < totDimAux; ++i) a[cind*totDimAux+i] = x[i]; 5835 ierr = DMPlexVecRestoreClosure(plexAux, sectionAux, A, subcell, NULL, &x);CHKERRQ(ierr); 5836 } 5837 ierr = DMPlexVecGetClosure(plex, section, Y, cell, NULL, &x);CHKERRQ(ierr); 5838 for (i = 0; i < totDim; ++i) y[cind*totDim+i] = x[i]; 5839 ierr = DMPlexVecRestoreClosure(plex, section, Y, cell, NULL, &x);CHKERRQ(ierr); 5840 } 5841 ierr = PetscArrayzero(elemMat, numCells*totDim*totDim);CHKERRQ(ierr); 5842 if (hasDyn) {ierr = PetscArrayzero(elemMatD, numCells*totDim*totDim);CHKERRQ(ierr);} 5843 for (fieldI = 0; fieldI < Nf; ++fieldI) { 5844 PetscFE fe; 5845 PetscInt Nb; 5846 /* Conforming batches */ 5847 PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize; 5848 /* Remainder */ 5849 PetscInt Nr, offset, Nq; 5850 PetscQuadrature qGeom = NULL; 5851 PetscInt maxDegree; 5852 PetscFEGeom *cgeomFEM, *chunkGeom = NULL, *remGeom = NULL; 5853 5854 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 5855 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 5856 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 5857 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 5858 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr); 5859 if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&qGeom);CHKERRQ(ierr);} 5860 if (!qGeom) { 5861 ierr = PetscFEGetQuadrature(fe,&qGeom);CHKERRQ(ierr); 5862 ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr); 5863 } 5864 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 5865 ierr = DMSNESGetFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr); 5866 blockSize = Nb; 5867 batchSize = numBlocks * blockSize; 5868 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 5869 numChunks = numCells / (numBatches*batchSize); 5870 Ne = numChunks*numBatches*batchSize; 5871 Nr = numCells % (numBatches*batchSize); 5872 offset = numCells - Nr; 5873 ierr = PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr); 5874 ierr = PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&remGeom);CHKERRQ(ierr); 5875 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 5876 key.field = fieldI*Nf + fieldJ; 5877 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr); 5878 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); 5879 if (hasDyn) { 5880 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, key, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatD);CHKERRQ(ierr); 5881 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); 5882 } 5883 } 5884 ierr = PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&remGeom);CHKERRQ(ierr); 5885 ierr = PetscFEGeomRestoreChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr); 5886 ierr = DMSNESRestoreFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr); 5887 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 5888 } 5889 if (hasDyn) { 5890 for (c = 0; c < numCells*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c]; 5891 } 5892 for (c = cStart; c < cEnd; ++c) { 5893 const PetscInt cell = cells ? cells[c] : c; 5894 const PetscInt cind = c - cStart; 5895 const PetscBLASInt M = totDim, one = 1; 5896 const PetscScalar a = 1.0, b = 0.0; 5897 5898 PetscStackCallBLAS("BLASgemv", BLASgemv_("N", &M, &M, &a, &elemMat[cind*totDim*totDim], &M, &y[cind*totDim], &one, &b, z, &one)); 5899 if (mesh->printFEM > 1) { 5900 ierr = DMPrintCellMatrix(c, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr); 5901 ierr = DMPrintCellVector(c, "Y", totDim, &y[cind*totDim]);CHKERRQ(ierr); 5902 ierr = DMPrintCellVector(c, "Z", totDim, z);CHKERRQ(ierr); 5903 } 5904 ierr = DMPlexVecSetClosure(dm, section, Z, cell, z, ADD_VALUES);CHKERRQ(ierr); 5905 } 5906 ierr = PetscFree6(u,u_t,elemMat,elemMatD,y,z);CHKERRQ(ierr); 5907 if (mesh->printFEM) { 5908 ierr = PetscPrintf(PetscObjectComm((PetscObject)Z), "Z:\n");CHKERRQ(ierr); 5909 ierr = VecView(Z, NULL);CHKERRQ(ierr); 5910 } 5911 ierr = PetscFree(a);CHKERRQ(ierr); 5912 ierr = ISDestroy(&cellIS);CHKERRQ(ierr); 5913 ierr = DMDestroy(&plexAux);CHKERRQ(ierr); 5914 ierr = DMDestroy(&plex);CHKERRQ(ierr); 5915 ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 5916 PetscFunctionReturn(0); 5917 } 5918