1 #include <petsc/private/dmpleximpl.h> /*I "petscdmplex.h" I*/ 2 #include <petscsf.h> 3 #include <petscsnes.h> 4 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 const char *comps[3] = {"A", "dmAux"}; 26 PetscObject obj; 27 PetscInt i; 28 29 { 30 /* Run the subdomain hook (this will copy the DMSNES/DMTS) */ 31 DMSubDomainHookLink link; 32 for (link = dm->subdomainhook; link; link = link->next) { 33 if (link->ddhook) {ierr = (*link->ddhook)(dm, *plex, link->ctx);CHKERRQ(ierr);} 34 } 35 } 36 for (i = 0; i < 3; i++) { 37 ierr = PetscObjectQuery((PetscObject) dm, comps[i], &obj);CHKERRQ(ierr); 38 ierr = PetscObjectCompose((PetscObject) *plex, comps[i], obj);CHKERRQ(ierr); 39 } 40 } 41 } else { 42 ierr = PetscObjectReference((PetscObject) *plex);CHKERRQ(ierr); 43 } 44 } 45 PetscFunctionReturn(0); 46 } 47 48 static PetscErrorCode PetscContainerUserDestroy_PetscFEGeom (void *ctx) 49 { 50 PetscFEGeom *geom = (PetscFEGeom *) ctx; 51 PetscErrorCode ierr; 52 53 PetscFunctionBegin; 54 ierr = PetscFEGeomDestroy(&geom);CHKERRQ(ierr); 55 PetscFunctionReturn(0); 56 } 57 58 static PetscErrorCode DMPlexGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom) 59 { 60 char composeStr[33] = {0}; 61 PetscObjectId id; 62 PetscContainer container; 63 PetscErrorCode ierr; 64 65 PetscFunctionBegin; 66 ierr = PetscObjectGetId((PetscObject)quad,&id);CHKERRQ(ierr); 67 ierr = PetscSNPrintf(composeStr, 32, "DMPlexGetFEGeom_%x\n", id);CHKERRQ(ierr); 68 ierr = PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);CHKERRQ(ierr); 69 if (container) { 70 ierr = PetscContainerGetPointer(container, (void **) geom);CHKERRQ(ierr); 71 } else { 72 ierr = DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);CHKERRQ(ierr); 73 ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr); 74 ierr = PetscContainerSetPointer(container, (void *) *geom);CHKERRQ(ierr); 75 ierr = PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);CHKERRQ(ierr); 76 ierr = PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);CHKERRQ(ierr); 77 ierr = PetscContainerDestroy(&container);CHKERRQ(ierr); 78 } 79 PetscFunctionReturn(0); 80 } 81 82 static PetscErrorCode DMPlexRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom) 83 { 84 PetscFunctionBegin; 85 *geom = NULL; 86 PetscFunctionReturn(0); 87 } 88 89 /*@ 90 DMPlexGetScale - Get the scale for the specified fundamental unit 91 92 Not collective 93 94 Input Arguments: 95 + dm - the DM 96 - unit - The SI unit 97 98 Output Argument: 99 . scale - The value used to scale all quantities with this unit 100 101 Level: advanced 102 103 .seealso: DMPlexSetScale(), PetscUnit 104 @*/ 105 PetscErrorCode DMPlexGetScale(DM dm, PetscUnit unit, PetscReal *scale) 106 { 107 DM_Plex *mesh = (DM_Plex*) dm->data; 108 109 PetscFunctionBegin; 110 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 111 PetscValidPointer(scale, 3); 112 *scale = mesh->scale[unit]; 113 PetscFunctionReturn(0); 114 } 115 116 /*@ 117 DMPlexSetScale - Set the scale for the specified fundamental unit 118 119 Not collective 120 121 Input Arguments: 122 + dm - the DM 123 . unit - The SI unit 124 - scale - The value used to scale all quantities with this unit 125 126 Level: advanced 127 128 .seealso: DMPlexGetScale(), PetscUnit 129 @*/ 130 PetscErrorCode DMPlexSetScale(DM dm, PetscUnit unit, PetscReal scale) 131 { 132 DM_Plex *mesh = (DM_Plex*) dm->data; 133 134 PetscFunctionBegin; 135 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 136 mesh->scale[unit] = scale; 137 PetscFunctionReturn(0); 138 } 139 140 static PetscErrorCode DMPlexProjectRigidBody_Private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *mode, void *ctx) 141 { 142 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}}}; 143 PetscInt *ctxInt = (PetscInt *) ctx; 144 PetscInt dim2 = ctxInt[0]; 145 PetscInt d = ctxInt[1]; 146 PetscInt i, j, k = dim > 2 ? d - dim : d; 147 148 PetscFunctionBegin; 149 if (dim != dim2) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Input dimension %d does not match context dimension %d", dim, dim2); 150 for (i = 0; i < dim; i++) mode[i] = 0.; 151 if (d < dim) { 152 mode[d] = 1.; /* Translation along axis d */ 153 } else { 154 for (i = 0; i < dim; i++) { 155 for (j = 0; j < dim; j++) { 156 mode[j] += eps[i][j][k]*X[i]; /* Rotation about axis d */ 157 } 158 } 159 } 160 PetscFunctionReturn(0); 161 } 162 163 /*@ 164 DMPlexCreateRigidBody - For the default global section, create rigid body modes by function space interpolation 165 166 Collective on DM 167 168 Input Arguments: 169 . dm - the DM 170 171 Output Argument: 172 . sp - the null space 173 174 Note: This is necessary to provide a suitable coarse space for algebraic multigrid 175 176 Level: advanced 177 178 .seealso: MatNullSpaceCreate(), PCGAMG 179 @*/ 180 PetscErrorCode DMPlexCreateRigidBody(DM dm, MatNullSpace *sp) 181 { 182 MPI_Comm comm; 183 Vec mode[6]; 184 PetscSection section, globalSection; 185 PetscInt dim, dimEmbed, n, m, mmin, d, i, j; 186 PetscErrorCode ierr; 187 188 PetscFunctionBegin; 189 ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr); 190 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 191 ierr = DMGetCoordinateDim(dm, &dimEmbed);CHKERRQ(ierr); 192 if (dim == 1) { 193 ierr = MatNullSpaceCreate(comm, PETSC_TRUE, 0, NULL, sp);CHKERRQ(ierr); 194 PetscFunctionReturn(0); 195 } 196 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 197 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 198 ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr); 199 m = (dim*(dim+1))/2; 200 ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr); 201 ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr); 202 ierr = VecSetUp(mode[0]);CHKERRQ(ierr); 203 ierr = VecGetSize(mode[0], &n);CHKERRQ(ierr); 204 mmin = PetscMin(m, n); 205 for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);} 206 for (d = 0; d < m; d++) { 207 PetscInt ctx[2]; 208 PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *) = DMPlexProjectRigidBody_Private; 209 void *voidctx = (void *) (&ctx[0]); 210 211 ctx[0] = dimEmbed; 212 ctx[1] = d; 213 ierr = DMProjectFunction(dm, 0.0, &func, &voidctx, INSERT_VALUES, mode[d]);CHKERRQ(ierr); 214 } 215 for (i = 0; i < PetscMin(dim, mmin); ++i) {ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);} 216 /* Orthonormalize system */ 217 for (i = dim; i < mmin; ++i) { 218 PetscScalar dots[6]; 219 220 ierr = VecMDot(mode[i], i, mode, dots);CHKERRQ(ierr); 221 for (j = 0; j < i; ++j) dots[j] *= -1.0; 222 ierr = VecMAXPY(mode[i], i, dots, mode);CHKERRQ(ierr); 223 ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr); 224 } 225 ierr = MatNullSpaceCreate(comm, PETSC_FALSE, mmin, mode, sp);CHKERRQ(ierr); 226 for (i = 0; i < m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);} 227 PetscFunctionReturn(0); 228 } 229 230 /*@ 231 DMPlexCreateRigidBodies - For the default global section, create rigid body modes by function space interpolation 232 233 Collective on DM 234 235 Input Arguments: 236 + dm - the DM 237 . nb - The number of bodies 238 . label - The DMLabel marking each domain 239 . nids - The number of ids per body 240 - ids - An array of the label ids in sequence for each domain 241 242 Output Argument: 243 . sp - the null space 244 245 Note: This is necessary to provide a suitable coarse space for algebraic multigrid 246 247 Level: advanced 248 249 .seealso: MatNullSpaceCreate() 250 @*/ 251 PetscErrorCode DMPlexCreateRigidBodies(DM dm, PetscInt nb, DMLabel label, const PetscInt nids[], const PetscInt ids[], MatNullSpace *sp) 252 { 253 MPI_Comm comm; 254 PetscSection section, globalSection; 255 Vec *mode; 256 PetscScalar *dots; 257 PetscInt dim, dimEmbed, n, m, b, d, i, j, off; 258 PetscErrorCode ierr; 259 260 PetscFunctionBegin; 261 ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr); 262 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 263 ierr = DMGetCoordinateDim(dm, &dimEmbed);CHKERRQ(ierr); 264 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 265 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr); 266 ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr); 267 m = nb * (dim*(dim+1))/2; 268 ierr = PetscMalloc2(m, &mode, m, &dots);CHKERRQ(ierr); 269 ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr); 270 ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr); 271 ierr = VecSetUp(mode[0]);CHKERRQ(ierr); 272 for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);} 273 for (b = 0, off = 0; b < nb; ++b) { 274 for (d = 0; d < m/nb; ++d) { 275 PetscInt ctx[2]; 276 PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *) = DMPlexProjectRigidBody_Private; 277 void *voidctx = (void *) (&ctx[0]); 278 279 ctx[0] = dimEmbed; 280 ctx[1] = d; 281 ierr = DMProjectFunctionLabel(dm, 0.0, label, nids[b], &ids[off], 0, NULL, &func, &voidctx, INSERT_VALUES, mode[d]);CHKERRQ(ierr); 282 off += nids[b]; 283 } 284 } 285 for (i = 0; i < dim; ++i) {ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);} 286 /* Orthonormalize system */ 287 for (i = 0; i < m; ++i) { 288 ierr = VecMDot(mode[i], i, mode, dots);CHKERRQ(ierr); 289 for (j = 0; j < i; ++j) dots[j] *= -1.0; 290 ierr = VecMAXPY(mode[i], i, dots, mode);CHKERRQ(ierr); 291 ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr); 292 } 293 ierr = MatNullSpaceCreate(comm, PETSC_FALSE, m, mode, sp);CHKERRQ(ierr); 294 for (i = 0; i< m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);} 295 ierr = PetscFree2(mode, dots);CHKERRQ(ierr); 296 PetscFunctionReturn(0); 297 } 298 299 /*@ 300 DMPlexSetMaxProjectionHeight - In DMPlexProjectXXXLocal() functions, the projected values of a basis function's dofs 301 are computed by associating the basis function with one of the mesh points in its transitively-closed support, and 302 evaluating the dual space basis of that point. A basis function is associated with the point in its 303 transitively-closed support whose mesh height is highest (w.r.t. DAG height), but not greater than the maximum 304 projection height, which is set with this function. By default, the maximum projection height is zero, which means 305 that only mesh cells are used to project basis functions. A height of one, for example, evaluates a cell-interior 306 basis functions using its cells dual space basis, but all other basis functions with the dual space basis of a face. 307 308 Input Parameters: 309 + dm - the DMPlex object 310 - height - the maximum projection height >= 0 311 312 Level: advanced 313 314 .seealso: DMPlexGetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal() 315 @*/ 316 PetscErrorCode DMPlexSetMaxProjectionHeight(DM dm, PetscInt height) 317 { 318 DM_Plex *plex = (DM_Plex *) dm->data; 319 320 PetscFunctionBegin; 321 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 322 plex->maxProjectionHeight = height; 323 PetscFunctionReturn(0); 324 } 325 326 /*@ 327 DMPlexGetMaxProjectionHeight - Get the maximum height (w.r.t. DAG) of mesh points used to evaluate dual bases in 328 DMPlexProjectXXXLocal() functions. 329 330 Input Parameters: 331 . dm - the DMPlex object 332 333 Output Parameters: 334 . height - the maximum projection height 335 336 Level: intermediate 337 338 .seealso: DMPlexSetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal() 339 @*/ 340 PetscErrorCode DMPlexGetMaxProjectionHeight(DM dm, PetscInt *height) 341 { 342 DM_Plex *plex = (DM_Plex *) dm->data; 343 344 PetscFunctionBegin; 345 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 346 *height = plex->maxProjectionHeight; 347 PetscFunctionReturn(0); 348 } 349 350 typedef struct { 351 PetscReal alpha; /* The first Euler angle, and in 2D the only one */ 352 PetscReal beta; /* The second Euler angle */ 353 PetscReal gamma; /* The third Euler angle */ 354 PetscInt dim; /* The dimension of R */ 355 PetscScalar *R; /* The rotation matrix, transforming a vector in the local basis to the global basis */ 356 PetscScalar *RT; /* The transposed rotation matrix, transforming a vector in the global basis to the local basis */ 357 } RotCtx; 358 359 /* 360 Note: Following https://en.wikipedia.org/wiki/Euler_angles, we will specify Euler angles by extrinsic rotations, meaning that 361 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: 362 $ The XYZ system rotates about the z axis by alpha. The X axis is now at angle alpha with respect to the x axis. 363 $ 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. 364 $ The XYZ system rotates a third time about the z axis by gamma. 365 */ 366 static PetscErrorCode DMPlexBasisTransformSetUp_Rotation_Internal(DM dm, void *ctx) 367 { 368 RotCtx *rc = (RotCtx *) ctx; 369 PetscInt dim = rc->dim; 370 PetscReal c1, s1, c2, s2, c3, s3; 371 PetscErrorCode ierr; 372 373 PetscFunctionBegin; 374 ierr = PetscMalloc2(PetscSqr(dim), &rc->R, PetscSqr(dim), &rc->RT);CHKERRQ(ierr); 375 switch (dim) { 376 case 2: 377 c1 = PetscCosReal(rc->alpha);s1 = PetscSinReal(rc->alpha); 378 rc->R[0] = c1;rc->R[1] = s1; 379 rc->R[2] = -s1;rc->R[3] = c1; 380 ierr = PetscMemcpy(rc->RT, rc->R, PetscSqr(dim) * sizeof(PetscScalar));CHKERRQ(ierr); 381 DMPlex_Transpose2D_Internal(rc->RT);break; 382 break; 383 case 3: 384 c1 = PetscCosReal(rc->alpha);s1 = PetscSinReal(rc->alpha); 385 c2 = PetscCosReal(rc->beta); s2 = PetscSinReal(rc->beta); 386 c3 = PetscCosReal(rc->gamma);s3 = PetscSinReal(rc->gamma); 387 rc->R[0] = c1*c3 - c2*s1*s3;rc->R[1] = c3*s1 + c1*c2*s3;rc->R[2] = s2*s3; 388 rc->R[3] = -c1*s3 - c2*c3*s1;rc->R[4] = c1*c2*c3 - s1*s3; rc->R[5] = c3*s2; 389 rc->R[6] = s1*s2; rc->R[7] = -c1*s2; rc->R[8] = c2; 390 ierr = PetscMemcpy(rc->RT, rc->R, PetscSqr(dim) * sizeof(PetscScalar));CHKERRQ(ierr); 391 DMPlex_Transpose3D_Internal(rc->RT);break; 392 break; 393 default: SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Dimension %D not supported", dim); 394 } 395 PetscFunctionReturn(0); 396 } 397 398 static PetscErrorCode DMPlexBasisTransformDestroy_Rotation_Internal(DM dm, void *ctx) 399 { 400 RotCtx *rc = (RotCtx *) ctx; 401 PetscErrorCode ierr; 402 403 PetscFunctionBegin; 404 ierr = PetscFree2(rc->R, rc->RT);CHKERRQ(ierr); 405 ierr = PetscFree(rc);CHKERRQ(ierr); 406 PetscFunctionReturn(0); 407 } 408 409 static PetscErrorCode DMPlexBasisTransformGetMatrix_Rotation_Internal(DM dm, const PetscReal x[], PetscBool l2g, const PetscScalar **A, void *ctx) 410 { 411 RotCtx *rc = (RotCtx *) ctx; 412 413 PetscFunctionBeginHot; 414 PetscValidPointer(ctx, 5); 415 if (l2g) {*A = rc->R;} 416 else {*A = rc->RT;} 417 PetscFunctionReturn(0); 418 } 419 420 PetscErrorCode DMPlexBasisTransformApplyReal_Internal(DM dm, const PetscReal x[], PetscBool l2g, PetscInt dim, const PetscReal *y, PetscReal *z, void *ctx) 421 { 422 #if defined(PETSC_USE_COMPLEX) 423 switch (dim) { 424 case 2: 425 { 426 PetscScalar yt[2], zt[2]; 427 428 yt[0] = y[0]; yt[1] = y[1]; 429 ierr = DMPlexBasisTransformApply_Internal(dm, x, l2g, dim, y, z, ctx);CHKERRQ(ierr); 430 z[0] = PetscRealPart(zt[0]); z[1] = PetscRealPart(zt[1]); 431 } 432 case 3: 433 { 434 PetscScalar yt[3], zt[3]; 435 436 yt[0] = y[0]; yt[1] = y[1]; yt[2] = y[2]; 437 ierr = DMPlexBasisTransformApply_Internal(dm, x, l2g, dim, y, z, ctx);CHKERRQ(ierr); 438 z[0] = PetscRealPart(zt[0]); z[1] = PetscRealPart(zt[1]); z[2] = PetscRealPart(zt[2]); 439 } 440 } 441 #else 442 ierr = DMPlexBasisTransformApply_Internal(dm, x, l2g, dim, y, z, ctx);CHKERRQ(ierr); 443 #endif 444 } 445 446 PetscErrorCode DMPlexBasisTransformApply_Internal(DM dm, const PetscReal x[], PetscBool l2g, PetscInt dim, const PetscReal *y, PetscReal *z, void *ctx) 447 { 448 const PetscScalar *A; 449 PetscErrorCode ierr; 450 451 PetscFunctionBeginHot; 452 ierr = (*dm->transformGetMatrix)(dm, x, l2g, &A, ctx);CHKERRQ(ierr); 453 switch (dim) { 454 case 2: DMPlex_Mult2D_Internal(A, y, z);break; 455 case 3: DMPlex_Mult3D_Internal(A, y, z);break; 456 } 457 PetscFunctionReturn(0); 458 } 459 460 static PetscErrorCode DMPlexBasisTransformField_Internal(DM dm, DM tdm, Vec tv, PetscInt p, PetscInt f, PetscBool l2g, PetscScalar *a) 461 { 462 PetscSection ts; 463 const PetscScalar *ta, *tva; 464 PetscInt dof; 465 PetscErrorCode ierr; 466 467 PetscFunctionBeginHot; 468 ierr = DMGetSection(tdm, &ts);CHKERRQ(ierr); 469 ierr = PetscSectionGetFieldDof(ts, p, f, &dof);CHKERRQ(ierr); 470 ierr = VecGetArrayRead(tv, &ta);CHKERRQ(ierr); 471 ierr = DMPlexPointLocalFieldRead(tdm, p, f, ta, (void *) &tva);CHKERRQ(ierr); 472 if (l2g) { 473 switch (dof) { 474 case 4: DMPlex_Mult2D_Internal(tva, a, a);break; 475 case 9: DMPlex_Mult3D_Internal(tva, a, a);break; 476 } 477 } else { 478 switch (dof) { 479 case 4: DMPlex_MultTranspose2D_Internal(tva, a, a);break; 480 case 9: DMPlex_MultTranspose3D_Internal(tva, a, a);break; 481 } 482 } 483 ierr = VecRestoreArrayRead(tv, &ta);CHKERRQ(ierr); 484 PetscFunctionReturn(0); 485 } 486 487 static PetscErrorCode DMPlexBasisTransformFieldTensor_Internal(DM dm, DM tdm, Vec tv, PetscInt pf, PetscInt f, PetscInt pg, PetscInt g, PetscBool l2g, PetscInt lda, PetscScalar *a) 488 { 489 PetscSection s, ts; 490 const PetscScalar *ta, *tvaf, *tvag; 491 PetscInt fdof, gdof, fpdof, gpdof; 492 PetscErrorCode ierr; 493 494 PetscFunctionBeginHot; 495 ierr = DMGetSection(dm, &s);CHKERRQ(ierr); 496 ierr = DMGetSection(tdm, &ts);CHKERRQ(ierr); 497 ierr = PetscSectionGetFieldDof(s, pf, f, &fpdof);CHKERRQ(ierr); 498 ierr = PetscSectionGetFieldDof(s, pg, g, &gpdof);CHKERRQ(ierr); 499 ierr = PetscSectionGetFieldDof(ts, pf, f, &fdof);CHKERRQ(ierr); 500 ierr = PetscSectionGetFieldDof(ts, pg, g, &gdof);CHKERRQ(ierr); 501 ierr = VecGetArrayRead(tv, &ta);CHKERRQ(ierr); 502 ierr = DMPlexPointLocalFieldRead(tdm, pf, f, ta, (void *) &tvaf);CHKERRQ(ierr); 503 ierr = DMPlexPointLocalFieldRead(tdm, pg, g, ta, (void *) &tvag);CHKERRQ(ierr); 504 if (l2g) { 505 switch (fdof) { 506 case 4: DMPlex_MatMult2D_Internal(tvaf, gpdof, lda, a, a);break; 507 case 9: DMPlex_MatMult3D_Internal(tvaf, gpdof, lda, a, a);break; 508 } 509 switch (gdof) { 510 case 4: DMPlex_MatMultTransposeLeft2D_Internal(tvag, fpdof, lda, a, a);break; 511 case 9: DMPlex_MatMultTransposeLeft3D_Internal(tvag, fpdof, lda, a, a);break; 512 } 513 } else { 514 switch (fdof) { 515 case 4: DMPlex_MatMultTranspose2D_Internal(tvaf, gpdof, lda, a, a);break; 516 case 9: DMPlex_MatMultTranspose3D_Internal(tvaf, gpdof, lda, a, a);break; 517 } 518 switch (gdof) { 519 case 4: DMPlex_MatMultLeft2D_Internal(tvag, fpdof, lda, a, a);break; 520 case 9: DMPlex_MatMultLeft3D_Internal(tvag, fpdof, lda, a, a);break; 521 } 522 } 523 ierr = VecRestoreArrayRead(tv, &ta);CHKERRQ(ierr); 524 PetscFunctionReturn(0); 525 } 526 527 PetscErrorCode DMPlexBasisTransformPoint_Internal(DM dm, DM tdm, Vec tv, PetscInt p, PetscBool fieldActive[], PetscBool l2g, PetscScalar *a) 528 { 529 PetscSection s; 530 PetscSection clSection; 531 IS clPoints; 532 const PetscInt *clp; 533 PetscInt *points = NULL; 534 PetscInt Nf, f, Np, cp, dof, d = 0; 535 PetscErrorCode ierr; 536 537 PetscFunctionBegin; 538 ierr = DMGetSection(dm, &s);CHKERRQ(ierr); 539 ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr); 540 ierr = DMPlexGetCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr); 541 for (f = 0; f < Nf; ++f) { 542 for (cp = 0; cp < Np*2; cp += 2) { 543 ierr = PetscSectionGetFieldDof(s, points[cp], f, &dof);CHKERRQ(ierr); 544 if (!dof) continue; 545 if (fieldActive[f]) {ierr = DMPlexBasisTransformField_Internal(dm, tdm, tv, points[cp], f, l2g, &a[d]);CHKERRQ(ierr);} 546 d += dof; 547 } 548 } 549 ierr = DMPlexRestoreCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr); 550 PetscFunctionReturn(0); 551 } 552 553 PetscErrorCode DMPlexBasisTransformPointTensor_Internal(DM dm, DM tdm, Vec tv, PetscInt p, PetscBool l2g, PetscInt lda, PetscScalar *a) 554 { 555 PetscSection s; 556 PetscSection clSection; 557 IS clPoints; 558 const PetscInt *clp; 559 PetscInt *points = NULL; 560 PetscInt Nf, f, g, Np, cpf, cpg, fdof, gdof, r, c; 561 PetscErrorCode ierr; 562 563 PetscFunctionBegin; 564 ierr = DMGetSection(dm, &s);CHKERRQ(ierr); 565 ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr); 566 ierr = DMPlexGetCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr); 567 for (f = 0, r = 0; f < Nf; ++f) { 568 for (cpf = 0; cpf < Np*2; cpf += 2) { 569 ierr = PetscSectionGetFieldDof(s, points[cpf], f, &fdof);CHKERRQ(ierr); 570 for (g = 0, c = 0; g < Nf; ++g) { 571 for (cpg = 0; cpg < Np*2; cpg += 2) { 572 ierr = PetscSectionGetFieldDof(s, points[cpg], g, &gdof);CHKERRQ(ierr); 573 ierr = DMPlexBasisTransformFieldTensor_Internal(dm, tdm, tv, points[cpf], f, points[cpg], g, l2g, lda, &a[r*lda+c]);CHKERRQ(ierr); 574 c += gdof; 575 } 576 } 577 if (c != lda) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of columns %D should be %D", c, lda); 578 r += fdof; 579 } 580 } 581 if (r != lda) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of rows %D should be %D", c, lda); 582 ierr = DMPlexRestoreCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr); 583 PetscFunctionReturn(0); 584 } 585 586 static PetscErrorCode DMPlexBasisTransform_Internal(DM dm, Vec lv, PetscBool l2g) 587 { 588 DM tdm; 589 Vec tv; 590 PetscSection ts, s; 591 const PetscScalar *ta; 592 PetscScalar *a, *va; 593 PetscInt pStart, pEnd, p, Nf, f; 594 PetscErrorCode ierr; 595 596 PetscFunctionBegin; 597 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr); 598 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr); 599 ierr = DMGetSection(tdm, &ts);CHKERRQ(ierr); 600 ierr = DMGetSection(dm, &s);CHKERRQ(ierr); 601 ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr); 602 ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr); 603 ierr = VecGetArray(lv, &a);CHKERRQ(ierr); 604 ierr = VecGetArrayRead(tv, &ta);CHKERRQ(ierr); 605 for (p = pStart; p < pEnd; ++p) { 606 for (f = 0; f < Nf; ++f) { 607 ierr = DMPlexPointLocalFieldRef(dm, p, f, a, (void *) &va);CHKERRQ(ierr); 608 ierr = DMPlexBasisTransformField_Internal(dm, tdm, tv, p, f, l2g, va);CHKERRQ(ierr); 609 } 610 } 611 ierr = VecRestoreArray(lv, &a);CHKERRQ(ierr); 612 ierr = VecRestoreArrayRead(tv, &ta);CHKERRQ(ierr); 613 PetscFunctionReturn(0); 614 } 615 616 /*@ 617 DMPlexGlobalToLocalBasis - Transform the values in the given local vector from the global basis to the local basis 618 619 Input Parameters: 620 + dm - The DM 621 - lv - A local vector with values in the global basis 622 623 Output Parameters: 624 . lv - A local vector with values in the local basis 625 626 Level: developer 627 628 .seealso: DMPlexLocalToGlobalBasis(), DMGetSection() 629 @*/ 630 PetscErrorCode DMPlexGlobalToLocalBasis(DM dm, Vec lv) 631 { 632 PetscErrorCode ierr; 633 634 PetscFunctionBegin; 635 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 636 PetscValidHeaderSpecific(lv, VEC_CLASSID, 2); 637 ierr = DMPlexBasisTransform_Internal(dm, lv, PETSC_FALSE);CHKERRQ(ierr); 638 PetscFunctionReturn(0); 639 } 640 641 /*@ 642 DMPlexLocalToGlobalBasis - Transform the values in the given local vector from the local basis to the global basis 643 644 Input Parameters: 645 + dm - The DM 646 - lv - A local vector with values in the local basis 647 648 Output Parameters: 649 . lv - A local vector with values in the global basis 650 651 Level: developer 652 653 .seealso: DMPlexGlobalToLocalBasis(), DMGetSection() 654 @*/ 655 PetscErrorCode DMPlexLocalToGlobalBasis(DM dm, Vec lv) 656 { 657 PetscErrorCode ierr; 658 659 PetscFunctionBegin; 660 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 661 PetscValidHeaderSpecific(lv, VEC_CLASSID, 2); 662 ierr = DMPlexBasisTransform_Internal(dm, lv, PETSC_TRUE);CHKERRQ(ierr); 663 PetscFunctionReturn(0); 664 } 665 666 /*@ 667 DMPlexCreateBasisRotation - Create an internal transformation from the global basis, used to specify boundary conditions 668 and global solutions, to a local basis, appropriate for discretization integrals and assembly. 669 670 Input Parameters: 671 + dm - The DM 672 . alpha - The first Euler angle, and in 2D the only one 673 . beta - The second Euler angle 674 . gamma - The third Euler angle 675 676 Note: Following https://en.wikipedia.org/wiki/Euler_angles, we will specify Euler angles by extrinsic rotations, meaning that 677 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: 678 $ The XYZ system rotates about the z axis by alpha. The X axis is now at angle alpha with respect to the x axis. 679 $ 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. 680 $ The XYZ system rotates a third time about the z axis by gamma. 681 682 Level: developer 683 684 .seealso: DMPlexGlobalToLocalBasis(), DMPlexLocalToGlobalBasis() 685 @*/ 686 PetscErrorCode DMPlexCreateBasisRotation(DM dm, PetscReal alpha, PetscReal beta, PetscReal gamma) 687 { 688 RotCtx *rc; 689 PetscInt cdim; 690 PetscErrorCode ierr; 691 692 ierr = DMGetCoordinateDim(dm, &cdim);CHKERRQ(ierr); 693 ierr = PetscMalloc1(1, &rc);CHKERRQ(ierr); 694 dm->transformCtx = rc; 695 dm->transformSetUp = DMPlexBasisTransformSetUp_Rotation_Internal; 696 dm->transformDestroy = DMPlexBasisTransformDestroy_Rotation_Internal; 697 dm->transformGetMatrix = DMPlexBasisTransformGetMatrix_Rotation_Internal; 698 rc->dim = cdim; 699 rc->alpha = alpha; 700 rc->beta = beta; 701 rc->gamma = gamma; 702 ierr = (*dm->transformSetUp)(dm, dm->transformCtx);CHKERRQ(ierr); 703 ierr = DMConstructBasisTransform_Internal(dm);CHKERRQ(ierr); 704 PetscFunctionReturn(0); 705 } 706 707 /*@C 708 DMPlexInsertBoundaryValuesEssential - Insert boundary values into a local vector 709 710 Input Parameters: 711 + dm - The DM, with a PetscDS that matches the problem being constrained 712 . time - The time 713 . field - The field to constrain 714 . Nc - The number of constrained field components, or 0 for all components 715 . comps - An array of constrained component numbers, or NULL for all components 716 . label - The DMLabel defining constrained points 717 . numids - The number of DMLabel ids for constrained points 718 . ids - An array of ids for constrained points 719 . func - A pointwise function giving boundary values 720 - ctx - An optional user context for bcFunc 721 722 Output Parameter: 723 . locX - A local vector to receives the boundary values 724 725 Level: developer 726 727 .seealso: DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary() 728 @*/ 729 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) 730 { 731 PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal x[], PetscInt, PetscScalar *u, void *ctx); 732 void **ctxs; 733 PetscInt numFields; 734 PetscErrorCode ierr; 735 736 PetscFunctionBegin; 737 ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr); 738 ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr); 739 funcs[field] = func; 740 ctxs[field] = ctx; 741 ierr = DMProjectFunctionLabelLocal(dm, time, label, numids, ids, Nc, comps, funcs, ctxs, INSERT_BC_VALUES, locX);CHKERRQ(ierr); 742 ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr); 743 PetscFunctionReturn(0); 744 } 745 746 /*@C 747 DMPlexInsertBoundaryValuesEssentialField - Insert boundary values into a local vector 748 749 Input Parameters: 750 + dm - The DM, with a PetscDS that matches the problem being constrained 751 . time - The time 752 . locU - A local vector with the input solution values 753 . field - The field to constrain 754 . Nc - The number of constrained field components, or 0 for all components 755 . comps - An array of constrained component numbers, or NULL for all components 756 . label - The DMLabel defining constrained points 757 . numids - The number of DMLabel ids for constrained points 758 . ids - An array of ids for constrained points 759 . func - A pointwise function giving boundary values 760 - ctx - An optional user context for bcFunc 761 762 Output Parameter: 763 . locX - A local vector to receives the boundary values 764 765 Level: developer 766 767 .seealso: DMPlexInsertBoundaryValuesEssential(), DMAddBoundary() 768 @*/ 769 PetscErrorCode DMPlexInsertBoundaryValuesEssentialField(DM dm, PetscReal time, Vec locU, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[], 770 void (*func)(PetscInt, PetscInt, PetscInt, 771 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 772 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 773 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], 774 PetscScalar[]), 775 void *ctx, Vec locX) 776 { 777 void (**funcs)(PetscInt, PetscInt, PetscInt, 778 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 779 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 780 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]); 781 void **ctxs; 782 PetscInt numFields; 783 PetscErrorCode ierr; 784 785 PetscFunctionBegin; 786 ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr); 787 ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr); 788 funcs[field] = func; 789 ctxs[field] = ctx; 790 ierr = DMProjectFieldLabelLocal(dm, time, label, numids, ids, Nc, comps, locU, funcs, INSERT_BC_VALUES, locX);CHKERRQ(ierr); 791 ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr); 792 PetscFunctionReturn(0); 793 } 794 795 /*@C 796 DMPlexInsertBoundaryValuesRiemann - Insert boundary values into a local vector 797 798 Input Parameters: 799 + dm - The DM, with a PetscDS that matches the problem being constrained 800 . time - The time 801 . faceGeometry - A vector with the FVM face geometry information 802 . cellGeometry - A vector with the FVM cell geometry information 803 . Grad - A vector with the FVM cell gradient information 804 . field - The field to constrain 805 . Nc - The number of constrained field components, or 0 for all components 806 . comps - An array of constrained component numbers, or NULL for all components 807 . label - The DMLabel defining constrained points 808 . numids - The number of DMLabel ids for constrained points 809 . ids - An array of ids for constrained points 810 . func - A pointwise function giving boundary values 811 - ctx - An optional user context for bcFunc 812 813 Output Parameter: 814 . locX - A local vector to receives the boundary values 815 816 Note: This implementation currently ignores the numcomps/comps argument from DMAddBoundary() 817 818 Level: developer 819 820 .seealso: DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary() 821 @*/ 822 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[], 823 PetscErrorCode (*func)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*), void *ctx, Vec locX) 824 { 825 PetscDS prob; 826 PetscSF sf; 827 DM dmFace, dmCell, dmGrad; 828 const PetscScalar *facegeom, *cellgeom = NULL, *grad; 829 const PetscInt *leaves; 830 PetscScalar *x, *fx; 831 PetscInt dim, nleaves, loc, fStart, fEnd, pdim, i; 832 PetscErrorCode ierr, ierru = 0; 833 834 PetscFunctionBegin; 835 ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr); 836 ierr = PetscSFGetGraph(sf, NULL, &nleaves, &leaves, NULL);CHKERRQ(ierr); 837 nleaves = PetscMax(0, nleaves); 838 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 839 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 840 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 841 ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr); 842 ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 843 if (cellGeometry) { 844 ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr); 845 ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 846 } 847 if (Grad) { 848 PetscFV fv; 849 850 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fv);CHKERRQ(ierr); 851 ierr = VecGetDM(Grad, &dmGrad);CHKERRQ(ierr); 852 ierr = VecGetArrayRead(Grad, &grad);CHKERRQ(ierr); 853 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr); 854 ierr = DMGetWorkArray(dm, pdim, MPIU_SCALAR, &fx);CHKERRQ(ierr); 855 } 856 ierr = VecGetArray(locX, &x);CHKERRQ(ierr); 857 for (i = 0; i < numids; ++i) { 858 IS faceIS; 859 const PetscInt *faces; 860 PetscInt numFaces, f; 861 862 ierr = DMLabelGetStratumIS(label, ids[i], &faceIS);CHKERRQ(ierr); 863 if (!faceIS) continue; /* No points with that id on this process */ 864 ierr = ISGetLocalSize(faceIS, &numFaces);CHKERRQ(ierr); 865 ierr = ISGetIndices(faceIS, &faces);CHKERRQ(ierr); 866 for (f = 0; f < numFaces; ++f) { 867 const PetscInt face = faces[f], *cells; 868 PetscFVFaceGeom *fg; 869 870 if ((face < fStart) || (face >= fEnd)) continue; /* Refinement adds non-faces to labels */ 871 ierr = PetscFindInt(face, nleaves, (PetscInt *) leaves, &loc);CHKERRQ(ierr); 872 if (loc >= 0) continue; 873 ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr); 874 ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr); 875 if (Grad) { 876 PetscFVCellGeom *cg; 877 PetscScalar *cx, *cgrad; 878 PetscScalar *xG; 879 PetscReal dx[3]; 880 PetscInt d; 881 882 ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cg);CHKERRQ(ierr); 883 ierr = DMPlexPointLocalRead(dm, cells[0], x, &cx);CHKERRQ(ierr); 884 ierr = DMPlexPointLocalRead(dmGrad, cells[0], grad, &cgrad);CHKERRQ(ierr); 885 ierr = DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);CHKERRQ(ierr); 886 DMPlex_WaxpyD_Internal(dim, -1, cg->centroid, fg->centroid, dx); 887 for (d = 0; d < pdim; ++d) fx[d] = cx[d] + DMPlex_DotD_Internal(dim, &cgrad[d*dim], dx); 888 ierru = (*func)(time, fg->centroid, fg->normal, fx, xG, ctx); 889 if (ierru) { 890 ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr); 891 ierr = ISDestroy(&faceIS);CHKERRQ(ierr); 892 goto cleanup; 893 } 894 } else { 895 PetscScalar *xI; 896 PetscScalar *xG; 897 898 ierr = DMPlexPointLocalRead(dm, cells[0], x, &xI);CHKERRQ(ierr); 899 ierr = DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);CHKERRQ(ierr); 900 ierru = (*func)(time, fg->centroid, fg->normal, xI, xG, ctx); 901 if (ierru) { 902 ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr); 903 ierr = ISDestroy(&faceIS);CHKERRQ(ierr); 904 goto cleanup; 905 } 906 } 907 } 908 ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr); 909 ierr = ISDestroy(&faceIS);CHKERRQ(ierr); 910 } 911 cleanup: 912 ierr = VecRestoreArray(locX, &x);CHKERRQ(ierr); 913 if (Grad) { 914 ierr = DMRestoreWorkArray(dm, pdim, MPIU_SCALAR, &fx);CHKERRQ(ierr); 915 ierr = VecRestoreArrayRead(Grad, &grad);CHKERRQ(ierr); 916 } 917 if (cellGeometry) {ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);} 918 ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 919 CHKERRQ(ierru); 920 PetscFunctionReturn(0); 921 } 922 923 PetscErrorCode DMPlexInsertBoundaryValues_Plex(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM) 924 { 925 PetscDS prob; 926 PetscInt numBd, b; 927 PetscErrorCode ierr; 928 929 PetscFunctionBegin; 930 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 931 ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr); 932 for (b = 0; b < numBd; ++b) { 933 DMBoundaryConditionType type; 934 const char *name, *labelname; 935 DMLabel label; 936 PetscInt field, Nc; 937 const PetscInt *comps; 938 PetscObject obj; 939 PetscClassId id; 940 void (*func)(void); 941 PetscInt numids; 942 const PetscInt *ids; 943 void *ctx; 944 945 ierr = DMGetBoundary(dm, b, &type, &name, &labelname, &field, &Nc, &comps, &func, &numids, &ids, &ctx);CHKERRQ(ierr); 946 if (insertEssential != (type & DM_BC_ESSENTIAL)) continue; 947 ierr = DMGetLabel(dm, labelname, &label);CHKERRQ(ierr); 948 if (!label) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONGSTATE, "Label %s for boundary condition %s does not exist in the DM", labelname, name); 949 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 950 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 951 if (id == PETSCFE_CLASSID) { 952 switch (type) { 953 /* for FEM, there is no insertion to be done for non-essential boundary conditions */ 954 case DM_BC_ESSENTIAL: 955 ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr); 956 ierr = DMPlexInsertBoundaryValuesEssential(dm, time, field, Nc, comps, label, numids, ids, (PetscErrorCode (*)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *)) func, ctx, locX);CHKERRQ(ierr); 957 ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr); 958 break; 959 case DM_BC_ESSENTIAL_FIELD: 960 ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr); 961 ierr = DMPlexInsertBoundaryValuesEssentialField(dm, time, locX, field, Nc, comps, label, numids, ids, 962 (void (*)(PetscInt, PetscInt, PetscInt, const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 963 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 964 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[])) func, ctx, locX);CHKERRQ(ierr); 965 ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr); 966 break; 967 default: break; 968 } 969 } else if (id == PETSCFV_CLASSID) { 970 if (!faceGeomFVM) continue; 971 ierr = DMPlexInsertBoundaryValuesRiemann(dm, time, faceGeomFVM, cellGeomFVM, gradFVM, field, Nc, comps, label, numids, ids, 972 (PetscErrorCode (*)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*)) func, ctx, locX);CHKERRQ(ierr); 973 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 974 } 975 PetscFunctionReturn(0); 976 } 977 978 /*@ 979 DMPlexInsertBoundaryValues - Puts coefficients which represent boundary values into the local solution vector 980 981 Input Parameters: 982 + dm - The DM 983 . insertEssential - Should I insert essential (e.g. Dirichlet) or inessential (e.g. Neumann) boundary conditions 984 . time - The time 985 . faceGeomFVM - Face geometry data for FV discretizations 986 . cellGeomFVM - Cell geometry data for FV discretizations 987 - gradFVM - Gradient reconstruction data for FV discretizations 988 989 Output Parameters: 990 . locX - Solution updated with boundary values 991 992 Level: developer 993 994 .seealso: DMProjectFunctionLabelLocal() 995 @*/ 996 PetscErrorCode DMPlexInsertBoundaryValues(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM) 997 { 998 PetscErrorCode ierr; 999 1000 PetscFunctionBegin; 1001 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 1002 PetscValidHeaderSpecific(locX, VEC_CLASSID, 2); 1003 if (faceGeomFVM) {PetscValidHeaderSpecific(faceGeomFVM, VEC_CLASSID, 4);} 1004 if (cellGeomFVM) {PetscValidHeaderSpecific(cellGeomFVM, VEC_CLASSID, 5);} 1005 if (gradFVM) {PetscValidHeaderSpecific(gradFVM, VEC_CLASSID, 6);} 1006 ierr = PetscTryMethod(dm,"DMPlexInsertBoundaryValues_C",(DM,PetscBool,Vec,PetscReal,Vec,Vec,Vec),(dm,insertEssential,locX,time,faceGeomFVM,cellGeomFVM,gradFVM));CHKERRQ(ierr); 1007 PetscFunctionReturn(0); 1008 } 1009 1010 PetscErrorCode DMComputeL2Diff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff) 1011 { 1012 Vec localX; 1013 PetscErrorCode ierr; 1014 1015 PetscFunctionBegin; 1016 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr); 1017 ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, localX, time, NULL, NULL, NULL);CHKERRQ(ierr); 1018 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1019 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1020 ierr = DMPlexComputeL2DiffLocal(dm, time, funcs, ctxs, localX, diff);CHKERRQ(ierr); 1021 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr); 1022 PetscFunctionReturn(0); 1023 } 1024 1025 /*@C 1026 DMComputeL2DiffLocal - This function computes the L_2 difference between a function u and an FEM interpolant solution u_h. 1027 1028 Input Parameters: 1029 + dm - The DM 1030 . time - The time 1031 . funcs - The functions to evaluate for each field component 1032 . ctxs - Optional array of contexts to pass to each function, or NULL. 1033 - localX - The coefficient vector u_h, a local vector 1034 1035 Output Parameter: 1036 . diff - The diff ||u - u_h||_2 1037 1038 Level: developer 1039 1040 .seealso: DMProjectFunction(), DMComputeL2FieldDiff(), DMComputeL2GradientDiff() 1041 @*/ 1042 PetscErrorCode DMPlexComputeL2DiffLocal(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec localX, PetscReal *diff) 1043 { 1044 const PetscInt debug = ((DM_Plex*)dm->data)->printL2; 1045 DM tdm; 1046 Vec tv; 1047 PetscSection section; 1048 PetscQuadrature quad; 1049 PetscScalar *funcVal, *interpolant; 1050 PetscReal *coords, *gcoords, *detJ, *J; 1051 PetscReal localDiff = 0.0; 1052 const PetscReal *quadWeights; 1053 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cellHeight, cStart, cEnd, cEndInterior, c, field, fieldOffset; 1054 PetscBool transform; 1055 PetscErrorCode ierr; 1056 1057 PetscFunctionBegin; 1058 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1059 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 1060 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 1061 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 1062 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr); 1063 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr); 1064 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr); 1065 for (field = 0; field < numFields; ++field) { 1066 PetscObject obj; 1067 PetscClassId id; 1068 PetscInt Nc; 1069 1070 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1071 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1072 if (id == PETSCFE_CLASSID) { 1073 PetscFE fe = (PetscFE) obj; 1074 1075 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 1076 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1077 } else if (id == PETSCFV_CLASSID) { 1078 PetscFV fv = (PetscFV) obj; 1079 1080 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr); 1081 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 1082 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1083 numComponents += Nc; 1084 } 1085 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, NULL, &quadWeights);CHKERRQ(ierr); 1086 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 1087 ierr = PetscMalloc5(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J);CHKERRQ(ierr); 1088 ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr); 1089 ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr); 1090 ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 1091 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 1092 for (c = cStart; c < cEnd; ++c) { 1093 PetscScalar *x = NULL; 1094 PetscReal elemDiff = 0.0; 1095 PetscInt qc = 0; 1096 1097 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, NULL, detJ);CHKERRQ(ierr); 1098 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1099 1100 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 1101 PetscObject obj; 1102 PetscClassId id; 1103 void * const ctx = ctxs ? ctxs[field] : NULL; 1104 PetscInt Nb, Nc, q, fc; 1105 1106 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1107 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1108 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);} 1109 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;} 1110 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1111 if (debug) { 1112 char title[1024]; 1113 ierr = PetscSNPrintf(title, 1023, "Solution for Field %d", field);CHKERRQ(ierr); 1114 ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr); 1115 } 1116 for (q = 0; q < Nq; ++q) { 1117 if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, point %D", detJ[q], c, q); 1118 if (transform) {gcoords = &coords[coordDim*Nq]; 1119 ierr = DMPlexBasisTransformApplyReal_Internal(dm, &coords[coordDim*q], PETSC_TRUE, coordDim, &coords[coordDim*q], gcoords, dm->transformCtx);CHKERRQ(ierr);} 1120 else {gcoords = &coords[coordDim*q];} 1121 ierr = (*funcs[field])(coordDim, time, gcoords, Nc, funcVal, ctx); 1122 if (ierr) { 1123 PetscErrorCode ierr2; 1124 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2); 1125 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2); 1126 ierr2 = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr2); 1127 CHKERRQ(ierr); 1128 } 1129 if (transform) {ierr = DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx);CHKERRQ(ierr);} 1130 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 1131 else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 1132 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1133 for (fc = 0; fc < Nc; ++fc) { 1134 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)]; 1135 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %d field %d diff %g\n", c, field, PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]);CHKERRQ(ierr);} 1136 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]; 1137 } 1138 } 1139 fieldOffset += Nb; 1140 qc += Nc; 1141 } 1142 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1143 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %d diff %g\n", c, elemDiff);CHKERRQ(ierr);} 1144 localDiff += elemDiff; 1145 } 1146 ierr = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr); 1147 ierr = MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr); 1148 *diff = PetscSqrtReal(*diff); 1149 PetscFunctionReturn(0); 1150 } 1151 1152 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) 1153 { 1154 const PetscInt debug = ((DM_Plex*)dm->data)->printL2; 1155 DM tdm; 1156 PetscSection section; 1157 PetscQuadrature quad; 1158 Vec localX, tv; 1159 PetscScalar *funcVal, *interpolant; 1160 const PetscReal *quadPoints, *quadWeights; 1161 PetscReal *coords, *gcoords, *realSpaceDer, *J, *invJ, *detJ; 1162 PetscReal localDiff = 0.0; 1163 PetscInt dim, coordDim, qNc = 0, Nq = 0, numFields, numComponents = 0, cStart, cEnd, cEndInterior, c, field, fieldOffset; 1164 PetscBool transform; 1165 PetscErrorCode ierr; 1166 1167 PetscFunctionBegin; 1168 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1169 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 1170 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 1171 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 1172 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr); 1173 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1174 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1175 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr); 1176 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr); 1177 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr); 1178 for (field = 0; field < numFields; ++field) { 1179 PetscFE fe; 1180 PetscInt Nc; 1181 1182 ierr = DMGetField(dm, field, NULL, (PetscObject *) &fe);CHKERRQ(ierr); 1183 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 1184 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1185 numComponents += Nc; 1186 } 1187 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 1188 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 1189 /* ierr = DMProjectFunctionLocal(dm, fe, funcs, INSERT_BC_VALUES, localX);CHKERRQ(ierr); */ 1190 ierr = PetscMalloc7(numComponents,&funcVal,coordDim*Nq,&coords,coordDim*Nq,&realSpaceDer,coordDim*coordDim*Nq,&J,coordDim*coordDim*Nq,&invJ,numComponents,&interpolant,Nq,&detJ);CHKERRQ(ierr); 1191 ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 1192 ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 1193 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 1194 for (c = cStart; c < cEnd; ++c) { 1195 PetscScalar *x = NULL; 1196 PetscReal elemDiff = 0.0; 1197 PetscInt qc = 0; 1198 1199 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, invJ, detJ);CHKERRQ(ierr); 1200 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1201 1202 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 1203 PetscFE fe; 1204 void * const ctx = ctxs ? ctxs[field] : NULL; 1205 PetscReal *basisDer; 1206 PetscInt Nb, Nc, q, fc; 1207 1208 ierr = DMGetField(dm, field, NULL, (PetscObject *) &fe);CHKERRQ(ierr); 1209 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 1210 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1211 ierr = PetscFEGetDefaultTabulation(fe, NULL, &basisDer, NULL);CHKERRQ(ierr); 1212 if (debug) { 1213 char title[1024]; 1214 ierr = PetscSNPrintf(title, 1023, "Solution for Field %d", field);CHKERRQ(ierr); 1215 ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr); 1216 } 1217 for (q = 0; q < Nq; ++q) { 1218 if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", detJ[q], c, q); 1219 if (transform) {gcoords = &coords[coordDim*Nq]; 1220 ierr = DMPlexBasisTransformApplyReal_Internal(dm, &coords[coordDim*q], PETSC_TRUE, coordDim, &coords[coordDim*q], gcoords, dm->transformCtx);CHKERRQ(ierr);} 1221 else {gcoords = &coords[coordDim*q];} 1222 ierr = (*funcs[field])(coordDim, time, &coords[q*coordDim], n, numFields, funcVal, ctx); 1223 if (ierr) { 1224 PetscErrorCode ierr2; 1225 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2); 1226 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2); 1227 ierr2 = PetscFree7(funcVal,coords,realSpaceDer,J,invJ,interpolant,detJ);CHKERRQ(ierr2); 1228 CHKERRQ(ierr); 1229 } 1230 if (transform) {ierr = DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx);CHKERRQ(ierr);} 1231 ierr = PetscFEInterpolateGradient_Static(fe, &x[fieldOffset], coordDim, invJ, n, q, interpolant);CHKERRQ(ierr); 1232 for (fc = 0; fc < Nc; ++fc) { 1233 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)]; 1234 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %d fieldDer %d diff %g\n", c, field, PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]);CHKERRQ(ierr);} 1235 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]; 1236 } 1237 } 1238 fieldOffset += Nb; 1239 qc += Nc; 1240 } 1241 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1242 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %d diff %g\n", c, elemDiff);CHKERRQ(ierr);} 1243 localDiff += elemDiff; 1244 } 1245 ierr = PetscFree7(funcVal,coords,realSpaceDer,J,invJ,interpolant,detJ);CHKERRQ(ierr); 1246 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr); 1247 ierr = MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr); 1248 *diff = PetscSqrtReal(*diff); 1249 PetscFunctionReturn(0); 1250 } 1251 1252 PetscErrorCode DMComputeL2FieldDiff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff) 1253 { 1254 const PetscInt debug = ((DM_Plex*)dm->data)->printL2; 1255 DM tdm; 1256 PetscSection section; 1257 PetscQuadrature quad; 1258 Vec localX, tv; 1259 PetscScalar *funcVal, *interpolant; 1260 PetscReal *coords, *gcoords, *detJ, *J; 1261 PetscReal *localDiff; 1262 const PetscReal *quadPoints, *quadWeights; 1263 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, cEndInterior, c, field, fieldOffset; 1264 PetscBool transform; 1265 PetscErrorCode ierr; 1266 1267 PetscFunctionBegin; 1268 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1269 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 1270 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 1271 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 1272 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr); 1273 ierr = VecSet(localX, 0.0);CHKERRQ(ierr); 1274 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1275 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1276 ierr = DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);CHKERRQ(ierr); 1277 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr); 1278 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr); 1279 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr); 1280 for (field = 0; field < numFields; ++field) { 1281 PetscObject obj; 1282 PetscClassId id; 1283 PetscInt Nc; 1284 1285 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1286 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1287 if (id == PETSCFE_CLASSID) { 1288 PetscFE fe = (PetscFE) obj; 1289 1290 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 1291 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1292 } else if (id == PETSCFV_CLASSID) { 1293 PetscFV fv = (PetscFV) obj; 1294 1295 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr); 1296 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 1297 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1298 numComponents += Nc; 1299 } 1300 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 1301 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 1302 ierr = PetscCalloc6(numFields,&localDiff,numComponents,&funcVal,numComponents,&interpolant,coordDim*(Nq+1),&coords,Nq,&detJ,coordDim*coordDim*Nq,&J);CHKERRQ(ierr); 1303 ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 1304 ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 1305 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 1306 for (c = cStart; c < cEnd; ++c) { 1307 PetscScalar *x = NULL; 1308 PetscInt qc = 0; 1309 1310 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, NULL, detJ);CHKERRQ(ierr); 1311 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1312 1313 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 1314 PetscObject obj; 1315 PetscClassId id; 1316 void * const ctx = ctxs ? ctxs[field] : NULL; 1317 PetscInt Nb, Nc, q, fc; 1318 1319 PetscReal elemDiff = 0.0; 1320 1321 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1322 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1323 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);} 1324 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;} 1325 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1326 if (debug) { 1327 char title[1024]; 1328 ierr = PetscSNPrintf(title, 1023, "Solution for Field %d", field);CHKERRQ(ierr); 1329 ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr); 1330 } 1331 for (q = 0; q < Nq; ++q) { 1332 if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature point %D", detJ, c, q); 1333 if (transform) {gcoords = &coords[coordDim*Nq]; 1334 ierr = DMPlexBasisTransformApplyReal_Internal(dm, &coords[coordDim*q], PETSC_TRUE, coordDim, &coords[coordDim*q], gcoords, dm->transformCtx);CHKERRQ(ierr);} 1335 else {gcoords = &coords[coordDim*q];} 1336 ierr = (*funcs[field])(coordDim, time, gcoords, numFields, funcVal, ctx); 1337 if (ierr) { 1338 PetscErrorCode ierr2; 1339 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2); 1340 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2); 1341 ierr2 = PetscFree6(localDiff,funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr2); 1342 CHKERRQ(ierr); 1343 } 1344 if (transform) {ierr = DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx);CHKERRQ(ierr);} 1345 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 1346 else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 1347 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1348 for (fc = 0; fc < Nc; ++fc) { 1349 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)]; 1350 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %d field %d point %g %g %g diff %g\n", c, field, coordDim > 0 ? coords[coordDim*q] : 0., coordDim > 1 ? coords[coordDim*q+1] : 0., coordDim > 2 ? coords[coordDim*q+2] : 0., PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]);CHKERRQ(ierr);} 1351 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]; 1352 } 1353 } 1354 fieldOffset += Nb; 1355 qc += Nc; 1356 localDiff[field] += elemDiff; 1357 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %d field %d cum diff %g\n", c, field, localDiff[field]);CHKERRQ(ierr);} 1358 } 1359 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1360 } 1361 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr); 1362 ierr = MPIU_Allreduce(localDiff, diff, numFields, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr); 1363 for (field = 0; field < numFields; ++field) diff[field] = PetscSqrtReal(diff[field]); 1364 ierr = PetscFree6(localDiff,funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr); 1365 PetscFunctionReturn(0); 1366 } 1367 1368 /*@C 1369 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. 1370 1371 Input Parameters: 1372 + dm - The DM 1373 . time - The time 1374 . funcs - The functions to evaluate for each field component: NULL means that component does not contribute to error calculation 1375 . ctxs - Optional array of contexts to pass to each function, or NULL. 1376 - X - The coefficient vector u_h 1377 1378 Output Parameter: 1379 . D - A Vec which holds the difference ||u - u_h||_2 for each cell 1380 1381 Level: developer 1382 1383 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff() 1384 @*/ 1385 PetscErrorCode DMPlexComputeL2DiffVec(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, Vec D) 1386 { 1387 PetscSection section; 1388 PetscQuadrature quad; 1389 Vec localX; 1390 PetscScalar *funcVal, *interpolant; 1391 PetscReal *coords, *detJ, *J; 1392 const PetscReal *quadPoints, *quadWeights; 1393 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, cEndInterior, c, field, fieldOffset; 1394 PetscErrorCode ierr; 1395 1396 PetscFunctionBegin; 1397 ierr = VecSet(D, 0.0);CHKERRQ(ierr); 1398 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1399 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 1400 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 1401 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 1402 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr); 1403 ierr = DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);CHKERRQ(ierr); 1404 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1405 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr); 1406 for (field = 0; field < numFields; ++field) { 1407 PetscObject obj; 1408 PetscClassId id; 1409 PetscInt Nc; 1410 1411 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1412 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1413 if (id == PETSCFE_CLASSID) { 1414 PetscFE fe = (PetscFE) obj; 1415 1416 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 1417 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1418 } else if (id == PETSCFV_CLASSID) { 1419 PetscFV fv = (PetscFV) obj; 1420 1421 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr); 1422 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 1423 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1424 numComponents += Nc; 1425 } 1426 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 1427 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 1428 ierr = PetscMalloc5(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J);CHKERRQ(ierr); 1429 ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 1430 ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 1431 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 1432 for (c = cStart; c < cEnd; ++c) { 1433 PetscScalar *x = NULL; 1434 PetscScalar elemDiff = 0.0; 1435 PetscInt qc = 0; 1436 1437 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, J, NULL, detJ);CHKERRQ(ierr); 1438 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1439 1440 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 1441 PetscObject obj; 1442 PetscClassId id; 1443 void * const ctx = ctxs ? ctxs[field] : NULL; 1444 PetscInt Nb, Nc, q, fc; 1445 1446 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1447 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1448 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);} 1449 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;} 1450 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1451 if (funcs[field]) { 1452 for (q = 0; q < Nq; ++q) { 1453 if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)detJ[q], c, q); 1454 ierr = (*funcs[field])(coordDim, time, &coords[q*coordDim], Nc, funcVal, ctx); 1455 if (ierr) { 1456 PetscErrorCode ierr2; 1457 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2); 1458 ierr2 = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr2); 1459 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2); 1460 CHKERRQ(ierr); 1461 } 1462 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 1463 else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);} 1464 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1465 for (fc = 0; fc < Nc; ++fc) { 1466 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)]; 1467 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*detJ[q]; 1468 } 1469 } 1470 } 1471 fieldOffset += Nb; 1472 qc += Nc; 1473 } 1474 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr); 1475 ierr = VecSetValue(D, c - cStart, elemDiff, INSERT_VALUES);CHKERRQ(ierr); 1476 } 1477 ierr = PetscFree5(funcVal,interpolant,coords,detJ,J);CHKERRQ(ierr); 1478 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr); 1479 ierr = VecSqrtAbs(D);CHKERRQ(ierr); 1480 PetscFunctionReturn(0); 1481 } 1482 1483 /*@C 1484 DMPlexComputeGradientClementInterpolant - This function computes the L2 projection of the cellwise gradient of a function u onto P1, and stores it in a Vec. 1485 1486 Input Parameters: 1487 + dm - The DM 1488 - LocX - The coefficient vector u_h 1489 1490 Output Parameter: 1491 . locC - A Vec which holds the Clement interpolant of the gradient 1492 1493 Notes: 1494 Add citation to (Clement, 1975) and definition of the interpolant 1495 \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 1496 1497 Level: developer 1498 1499 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff() 1500 @*/ 1501 PetscErrorCode DMPlexComputeGradientClementInterpolant(DM dm, Vec locX, Vec locC) 1502 { 1503 DM_Plex *mesh = (DM_Plex *) dm->data; 1504 PetscInt debug = mesh->printFEM; 1505 DM dmC; 1506 PetscSection section; 1507 PetscQuadrature quad; 1508 PetscScalar *interpolant, *gradsum; 1509 PetscReal *coords, *detJ, *J, *invJ; 1510 const PetscReal *quadPoints, *quadWeights; 1511 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, cEndInterior, vStart, vEnd, v, field, fieldOffset; 1512 PetscErrorCode ierr; 1513 1514 PetscFunctionBegin; 1515 ierr = VecGetDM(locC, &dmC);CHKERRQ(ierr); 1516 ierr = VecSet(locC, 0.0);CHKERRQ(ierr); 1517 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1518 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr); 1519 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 1520 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr); 1521 for (field = 0; field < numFields; ++field) { 1522 PetscObject obj; 1523 PetscClassId id; 1524 PetscInt Nc; 1525 1526 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1527 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1528 if (id == PETSCFE_CLASSID) { 1529 PetscFE fe = (PetscFE) obj; 1530 1531 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr); 1532 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1533 } else if (id == PETSCFV_CLASSID) { 1534 PetscFV fv = (PetscFV) obj; 1535 1536 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr); 1537 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 1538 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1539 numComponents += Nc; 1540 } 1541 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr); 1542 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents); 1543 ierr = PetscMalloc6(coordDim*numComponents*2,&gradsum,coordDim*numComponents,&interpolant,coordDim*Nq,&coords,Nq,&detJ,coordDim*coordDim*Nq,&J,coordDim*coordDim*Nq,&invJ);CHKERRQ(ierr); 1544 ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr); 1545 ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 1546 ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 1547 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 1548 for (v = vStart; v < vEnd; ++v) { 1549 PetscScalar volsum = 0.0; 1550 PetscInt *star = NULL; 1551 PetscInt starSize, st, d, fc; 1552 1553 ierr = PetscMemzero(gradsum, coordDim*numComponents * sizeof(PetscScalar));CHKERRQ(ierr); 1554 ierr = DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr); 1555 for (st = 0; st < starSize*2; st += 2) { 1556 const PetscInt cell = star[st]; 1557 PetscScalar *grad = &gradsum[coordDim*numComponents]; 1558 PetscScalar *x = NULL; 1559 PetscReal vol = 0.0; 1560 1561 if ((cell < cStart) || (cell >= cEnd)) continue; 1562 ierr = DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, J, invJ, detJ);CHKERRQ(ierr); 1563 ierr = DMPlexVecGetClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr); 1564 for (field = 0, fieldOffset = 0; field < numFields; ++field) { 1565 PetscObject obj; 1566 PetscClassId id; 1567 PetscInt Nb, Nc, q, qc = 0; 1568 1569 ierr = PetscMemzero(grad, coordDim*numComponents * sizeof(PetscScalar));CHKERRQ(ierr); 1570 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr); 1571 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1572 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);} 1573 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;} 1574 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1575 for (q = 0; q < Nq; ++q) { 1576 if (detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)detJ[q], cell, q); 1577 if (ierr) { 1578 PetscErrorCode ierr2; 1579 ierr2 = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr2); 1580 ierr2 = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr2); 1581 ierr2 = PetscFree4(interpolant,coords,detJ,J);CHKERRQ(ierr2); 1582 CHKERRQ(ierr); 1583 } 1584 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolateGradient_Static((PetscFE) obj, &x[fieldOffset], coordDim, invJ, NULL, q, interpolant);CHKERRQ(ierr);} 1585 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", field); 1586 for (fc = 0; fc < Nc; ++fc) { 1587 const PetscReal wt = quadWeights[q*qNc+qc+fc]; 1588 1589 for (d = 0; d < coordDim; ++d) grad[fc*coordDim+d] += interpolant[fc*dim+d]*wt*detJ[q]; 1590 } 1591 vol += quadWeights[q*qNc]*detJ[q]; 1592 } 1593 fieldOffset += Nb; 1594 qc += Nc; 1595 } 1596 ierr = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr); 1597 for (fc = 0; fc < numComponents; ++fc) { 1598 for (d = 0; d < coordDim; ++d) { 1599 gradsum[fc*coordDim+d] += grad[fc*coordDim+d]; 1600 } 1601 } 1602 volsum += vol; 1603 if (debug) { 1604 ierr = PetscPrintf(PETSC_COMM_SELF, "Cell %D gradient: [", cell);CHKERRQ(ierr); 1605 for (fc = 0; fc < numComponents; ++fc) { 1606 for (d = 0; d < coordDim; ++d) { 1607 if (fc || d > 0) {ierr = PetscPrintf(PETSC_COMM_SELF, ", ");CHKERRQ(ierr);} 1608 ierr = PetscPrintf(PETSC_COMM_SELF, "%g", (double)PetscRealPart(grad[fc*coordDim+d]));CHKERRQ(ierr); 1609 } 1610 } 1611 ierr = PetscPrintf(PETSC_COMM_SELF, "]\n");CHKERRQ(ierr); 1612 } 1613 } 1614 for (fc = 0; fc < numComponents; ++fc) { 1615 for (d = 0; d < coordDim; ++d) gradsum[fc*coordDim+d] /= volsum; 1616 } 1617 ierr = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr); 1618 ierr = DMPlexVecSetClosure(dmC, NULL, locC, v, gradsum, INSERT_VALUES);CHKERRQ(ierr); 1619 } 1620 ierr = PetscFree6(gradsum,interpolant,coords,detJ,J,invJ);CHKERRQ(ierr); 1621 PetscFunctionReturn(0); 1622 } 1623 1624 static PetscErrorCode DMPlexComputeIntegral_Internal(DM dm, Vec X, PetscInt cStart, PetscInt cEnd, PetscScalar *cintegral, void *user) 1625 { 1626 DM dmAux = NULL; 1627 PetscDS prob, probAux = NULL; 1628 PetscSection section, sectionAux; 1629 Vec locX, locA; 1630 PetscInt dim, numCells = cEnd - cStart, c, f; 1631 PetscBool useFVM = PETSC_FALSE; 1632 /* DS */ 1633 PetscInt Nf, totDim, *uOff, *uOff_x, numConstants; 1634 PetscInt NfAux, totDimAux, *aOff; 1635 PetscScalar *u, *a; 1636 const PetscScalar *constants; 1637 /* Geometry */ 1638 PetscFEGeom *cgeomFEM; 1639 DM dmGrad; 1640 PetscQuadrature affineQuad = NULL; 1641 Vec cellGeometryFVM = NULL, faceGeometryFVM = NULL, locGrad = NULL; 1642 PetscFVCellGeom *cgeomFVM; 1643 const PetscScalar *lgrad; 1644 PetscInt maxDegree; 1645 DMField coordField; 1646 IS cellIS; 1647 PetscErrorCode ierr; 1648 1649 PetscFunctionBegin; 1650 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 1651 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1652 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 1653 ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr); 1654 /* Determine which discretizations we have */ 1655 for (f = 0; f < Nf; ++f) { 1656 PetscObject obj; 1657 PetscClassId id; 1658 1659 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 1660 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1661 if (id == PETSCFV_CLASSID) useFVM = PETSC_TRUE; 1662 } 1663 /* Get local solution with boundary values */ 1664 ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr); 1665 ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);CHKERRQ(ierr); 1666 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr); 1667 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr); 1668 /* Read DS information */ 1669 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 1670 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr); 1671 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr); 1672 ierr = ISCreateStride(PETSC_COMM_SELF,numCells,cStart,1,&cellIS);CHKERRQ(ierr); 1673 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr); 1674 /* Read Auxiliary DS information */ 1675 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr); 1676 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 1677 if (dmAux) { 1678 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 1679 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr); 1680 ierr = DMGetSection(dmAux, §ionAux);CHKERRQ(ierr); 1681 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 1682 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr); 1683 } 1684 /* Allocate data arrays */ 1685 ierr = PetscCalloc1(numCells*totDim, &u);CHKERRQ(ierr); 1686 if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);} 1687 /* Read out geometry */ 1688 ierr = DMGetCoordinateField(dm,&coordField);CHKERRQ(ierr); 1689 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr); 1690 if (maxDegree <= 1) { 1691 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr); 1692 if (affineQuad) { 1693 ierr = DMFieldCreateFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr); 1694 } 1695 } 1696 if (useFVM) { 1697 PetscFV fv = NULL; 1698 Vec grad; 1699 PetscInt fStart, fEnd; 1700 PetscBool compGrad; 1701 1702 for (f = 0; f < Nf; ++f) { 1703 PetscObject obj; 1704 PetscClassId id; 1705 1706 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 1707 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1708 if (id == PETSCFV_CLASSID) {fv = (PetscFV) obj; break;} 1709 } 1710 ierr = PetscFVGetComputeGradients(fv, &compGrad);CHKERRQ(ierr); 1711 ierr = PetscFVSetComputeGradients(fv, PETSC_TRUE);CHKERRQ(ierr); 1712 ierr = DMPlexComputeGeometryFVM(dm, &cellGeometryFVM, &faceGeometryFVM);CHKERRQ(ierr); 1713 ierr = DMPlexComputeGradientFVM(dm, fv, faceGeometryFVM, cellGeometryFVM, &dmGrad);CHKERRQ(ierr); 1714 ierr = PetscFVSetComputeGradients(fv, compGrad);CHKERRQ(ierr); 1715 ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr); 1716 /* Reconstruct and limit cell gradients */ 1717 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 1718 ierr = DMGetGlobalVector(dmGrad, &grad);CHKERRQ(ierr); 1719 ierr = DMPlexReconstructGradients_Internal(dm, fv, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr); 1720 /* Communicate gradient values */ 1721 ierr = DMGetLocalVector(dmGrad, &locGrad);CHKERRQ(ierr); 1722 ierr = DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr); 1723 ierr = DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr); 1724 ierr = DMRestoreGlobalVector(dmGrad, &grad);CHKERRQ(ierr); 1725 /* Handle non-essential (e.g. outflow) boundary values */ 1726 ierr = DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, 0.0, faceGeometryFVM, cellGeometryFVM, locGrad);CHKERRQ(ierr); 1727 ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr); 1728 } 1729 /* Read out data from inputs */ 1730 for (c = cStart; c < cEnd; ++c) { 1731 PetscScalar *x = NULL; 1732 PetscInt i; 1733 1734 ierr = DMPlexVecGetClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr); 1735 for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i]; 1736 ierr = DMPlexVecRestoreClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr); 1737 if (dmAux) { 1738 ierr = DMPlexVecGetClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr); 1739 for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i]; 1740 ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr); 1741 } 1742 } 1743 /* Do integration for each field */ 1744 for (f = 0; f < Nf; ++f) { 1745 PetscObject obj; 1746 PetscClassId id; 1747 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset; 1748 1749 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 1750 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1751 if (id == PETSCFE_CLASSID) { 1752 PetscFE fe = (PetscFE) obj; 1753 PetscQuadrature q; 1754 PetscFEGeom *chunkGeom = NULL; 1755 PetscInt Nq, Nb; 1756 1757 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 1758 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr); 1759 ierr = PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 1760 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 1761 blockSize = Nb*Nq; 1762 batchSize = numBlocks * blockSize; 1763 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 1764 numChunks = numCells / (numBatches*batchSize); 1765 Ne = numChunks*numBatches*batchSize; 1766 Nr = numCells % (numBatches*batchSize); 1767 offset = numCells - Nr; 1768 if (!affineQuad) { 1769 ierr = DMFieldCreateFEGeom(coordField,cellIS,q,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr); 1770 } 1771 ierr = PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr); 1772 ierr = PetscFEIntegrate(fe, prob, f, Ne, chunkGeom, u, probAux, a, cintegral);CHKERRQ(ierr); 1773 ierr = PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&chunkGeom);CHKERRQ(ierr); 1774 ierr = PetscFEIntegrate(fe, prob, f, Nr, chunkGeom, &u[offset*totDim], probAux, &a[offset*totDimAux], &cintegral[offset*Nf]);CHKERRQ(ierr); 1775 ierr = PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&chunkGeom);CHKERRQ(ierr); 1776 if (!affineQuad) { 1777 ierr = PetscFEGeomDestroy(&cgeomFEM);CHKERRQ(ierr); 1778 } 1779 } else if (id == PETSCFV_CLASSID) { 1780 PetscInt foff; 1781 PetscPointFunc obj_func; 1782 PetscScalar lint; 1783 1784 ierr = PetscDSGetObjective(prob, f, &obj_func);CHKERRQ(ierr); 1785 ierr = PetscDSGetFieldOffset(prob, f, &foff);CHKERRQ(ierr); 1786 if (obj_func) { 1787 for (c = 0; c < numCells; ++c) { 1788 PetscScalar *u_x; 1789 1790 ierr = DMPlexPointLocalRead(dmGrad, c, lgrad, &u_x);CHKERRQ(ierr); 1791 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); 1792 cintegral[c*Nf+f] += PetscRealPart(lint)*cgeomFVM[c].volume; 1793 } 1794 } 1795 } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", f); 1796 } 1797 /* Cleanup data arrays */ 1798 if (useFVM) { 1799 ierr = VecRestoreArrayRead(locGrad, &lgrad);CHKERRQ(ierr); 1800 ierr = VecRestoreArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr); 1801 ierr = DMRestoreLocalVector(dmGrad, &locGrad);CHKERRQ(ierr); 1802 ierr = VecDestroy(&faceGeometryFVM);CHKERRQ(ierr); 1803 ierr = VecDestroy(&cellGeometryFVM);CHKERRQ(ierr); 1804 ierr = DMDestroy(&dmGrad);CHKERRQ(ierr); 1805 } 1806 if (dmAux) {ierr = PetscFree(a);CHKERRQ(ierr);} 1807 ierr = PetscFree(u);CHKERRQ(ierr); 1808 /* Cleanup */ 1809 if (affineQuad) { 1810 ierr = PetscFEGeomDestroy(&cgeomFEM);CHKERRQ(ierr); 1811 } 1812 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr); 1813 ierr = ISDestroy(&cellIS);CHKERRQ(ierr); 1814 ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr); 1815 PetscFunctionReturn(0); 1816 } 1817 1818 /*@ 1819 DMPlexComputeIntegralFEM - Form the integral over the domain from the global input X using pointwise functions specified by the user 1820 1821 Input Parameters: 1822 + dm - The mesh 1823 . X - Global input vector 1824 - user - The user context 1825 1826 Output Parameter: 1827 . integral - Integral for each field 1828 1829 Level: developer 1830 1831 .seealso: DMPlexComputeResidualFEM() 1832 @*/ 1833 PetscErrorCode DMPlexComputeIntegralFEM(DM dm, Vec X, PetscScalar *integral, void *user) 1834 { 1835 DM_Plex *mesh = (DM_Plex *) dm->data; 1836 PetscScalar *cintegral, *lintegral; 1837 PetscInt Nf, f, cellHeight, cStart, cEnd, cEndInterior[4], cell; 1838 PetscErrorCode ierr; 1839 1840 PetscFunctionBegin; 1841 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 1842 PetscValidHeaderSpecific(X, VEC_CLASSID, 2); 1843 PetscValidPointer(integral, 3); 1844 ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 1845 ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr); 1846 ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr); 1847 ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr); 1848 ierr = DMPlexGetHybridBounds(dm, &cEndInterior[0], &cEndInterior[1], &cEndInterior[2], &cEndInterior[3]);CHKERRQ(ierr); 1849 cEnd = cEndInterior[cellHeight] < 0 ? cEnd : cEndInterior[cellHeight]; 1850 /* TODO Introduce a loop over large chunks (right now this is a single chunk) */ 1851 ierr = PetscCalloc2(Nf, &lintegral, (cEnd-cStart)*Nf, &cintegral);CHKERRQ(ierr); 1852 ierr = DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);CHKERRQ(ierr); 1853 /* Sum up values */ 1854 for (cell = cStart; cell < cEnd; ++cell) { 1855 const PetscInt c = cell - cStart; 1856 1857 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);CHKERRQ(ierr);} 1858 for (f = 0; f < Nf; ++f) lintegral[f] += cintegral[c*Nf+f]; 1859 } 1860 ierr = MPIU_Allreduce(lintegral, integral, Nf, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject) dm));CHKERRQ(ierr); 1861 if (mesh->printFEM) { 1862 ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "Integral:");CHKERRQ(ierr); 1863 for (f = 0; f < Nf; ++f) {ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), " %g", (double) PetscRealPart(integral[f]));CHKERRQ(ierr);} 1864 ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "\n");CHKERRQ(ierr); 1865 } 1866 ierr = PetscFree2(lintegral, cintegral);CHKERRQ(ierr); 1867 ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 1868 PetscFunctionReturn(0); 1869 } 1870 1871 /*@ 1872 DMPlexComputeCellwiseIntegralFEM - Form the vector of cellwise integrals F from the global input X using pointwise functions specified by the user 1873 1874 Input Parameters: 1875 + dm - The mesh 1876 . X - Global input vector 1877 - user - The user context 1878 1879 Output Parameter: 1880 . integral - Cellwise integrals for each field 1881 1882 Level: developer 1883 1884 .seealso: DMPlexComputeResidualFEM() 1885 @*/ 1886 PetscErrorCode DMPlexComputeCellwiseIntegralFEM(DM dm, Vec X, Vec F, void *user) 1887 { 1888 DM_Plex *mesh = (DM_Plex *) dm->data; 1889 DM dmF; 1890 PetscSection sectionF; 1891 PetscScalar *cintegral, *af; 1892 PetscInt Nf, f, cellHeight, cStart, cEnd, cEndInterior[4], cell; 1893 PetscErrorCode ierr; 1894 1895 PetscFunctionBegin; 1896 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 1897 PetscValidHeaderSpecific(X, VEC_CLASSID, 2); 1898 PetscValidHeaderSpecific(F, VEC_CLASSID, 3); 1899 ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 1900 ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr); 1901 ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr); 1902 ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr); 1903 ierr = DMPlexGetHybridBounds(dm, &cEndInterior[0], &cEndInterior[1], &cEndInterior[2], &cEndInterior[3]);CHKERRQ(ierr); 1904 cEnd = cEndInterior[cellHeight] < 0 ? cEnd : cEndInterior[cellHeight]; 1905 /* TODO Introduce a loop over large chunks (right now this is a single chunk) */ 1906 ierr = PetscCalloc1((cEnd-cStart)*Nf, &cintegral);CHKERRQ(ierr); 1907 ierr = DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);CHKERRQ(ierr); 1908 /* Put values in F*/ 1909 ierr = VecGetDM(F, &dmF);CHKERRQ(ierr); 1910 ierr = DMGetSection(dmF, §ionF);CHKERRQ(ierr); 1911 ierr = VecGetArray(F, &af);CHKERRQ(ierr); 1912 for (cell = cStart; cell < cEnd; ++cell) { 1913 const PetscInt c = cell - cStart; 1914 PetscInt dof, off; 1915 1916 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);CHKERRQ(ierr);} 1917 ierr = PetscSectionGetDof(sectionF, cell, &dof);CHKERRQ(ierr); 1918 ierr = PetscSectionGetOffset(sectionF, cell, &off);CHKERRQ(ierr); 1919 if (dof != Nf) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "The number of cell dofs %D != %D", dof, Nf); 1920 for (f = 0; f < Nf; ++f) af[off+f] = cintegral[c*Nf+f]; 1921 } 1922 ierr = VecRestoreArray(F, &af);CHKERRQ(ierr); 1923 ierr = PetscFree(cintegral);CHKERRQ(ierr); 1924 ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 1925 PetscFunctionReturn(0); 1926 } 1927 1928 static PetscErrorCode DMPlexComputeBdIntegral_Internal(DM dm, Vec locX, IS pointIS, 1929 void (*func)(PetscInt, PetscInt, PetscInt, 1930 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 1931 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 1932 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]), 1933 PetscScalar *fintegral, void *user) 1934 { 1935 DM plex = NULL, plexA = NULL; 1936 PetscDS prob, probAux = NULL; 1937 PetscSection section, sectionAux = NULL; 1938 Vec locA = NULL; 1939 DMField coordField; 1940 PetscInt Nf, totDim, *uOff, *uOff_x; 1941 PetscInt NfAux = 0, totDimAux = 0, *aOff = NULL; 1942 PetscScalar *u, *a = NULL; 1943 const PetscScalar *constants; 1944 PetscInt numConstants, f; 1945 PetscErrorCode ierr; 1946 1947 PetscFunctionBegin; 1948 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 1949 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr); 1950 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 1951 ierr = DMGetDefaultSection(dm, §ion);CHKERRQ(ierr); 1952 ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr); 1953 /* Determine which discretizations we have */ 1954 for (f = 0; f < Nf; ++f) { 1955 PetscObject obj; 1956 PetscClassId id; 1957 1958 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 1959 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 1960 if (id == PETSCFV_CLASSID) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Not supported for FVM (field %D)", f); 1961 } 1962 /* Read DS information */ 1963 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 1964 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr); 1965 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr); 1966 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr); 1967 /* Read Auxiliary DS information */ 1968 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 1969 if (locA) { 1970 DM dmAux; 1971 1972 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 1973 ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr); 1974 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 1975 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr); 1976 ierr = DMGetDefaultSection(dmAux, §ionAux);CHKERRQ(ierr); 1977 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 1978 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr); 1979 } 1980 /* Integrate over points */ 1981 { 1982 PetscFEGeom *fgeom, *chunkGeom = NULL; 1983 PetscInt maxDegree; 1984 PetscQuadrature qGeom = NULL; 1985 const PetscInt *points; 1986 PetscInt numFaces, face, Nq, field; 1987 PetscInt numChunks, chunkSize, chunk, Nr, offset; 1988 1989 ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr); 1990 ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr); 1991 ierr = PetscCalloc2(numFaces*totDim, &u, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr); 1992 ierr = DMFieldGetDegree(coordField, pointIS, NULL, &maxDegree);CHKERRQ(ierr); 1993 for (field = 0; field < Nf; ++field) { 1994 PetscFE fe; 1995 1996 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr); 1997 if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, pointIS, &qGeom);CHKERRQ(ierr);} 1998 if (!qGeom) { 1999 ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr); 2000 ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr); 2001 } 2002 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 2003 ierr = DMPlexGetFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);CHKERRQ(ierr); 2004 for (face = 0; face < numFaces; ++face) { 2005 const PetscInt point = points[face], *support, *cone; 2006 PetscScalar *x = NULL; 2007 PetscInt i, coneSize, faceLoc; 2008 2009 ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr); 2010 ierr = DMPlexGetConeSize(dm, support[0], &coneSize);CHKERRQ(ierr); 2011 ierr = DMPlexGetCone(dm, support[0], &cone);CHKERRQ(ierr); 2012 for (faceLoc = 0; faceLoc < coneSize; ++faceLoc) if (cone[faceLoc] == point) break; 2013 if (faceLoc == coneSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Could not find face %D in cone of support[0] %D", face, support[0]); 2014 fgeom->face[face][0] = faceLoc; 2015 ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 2016 for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i]; 2017 ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr); 2018 if (locA) { 2019 PetscInt subp; 2020 ierr = DMPlexGetSubpoint(plexA, support[0], &subp);CHKERRQ(ierr); 2021 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 2022 for (i = 0; i < totDimAux; ++i) a[f*totDimAux+i] = x[i]; 2023 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr); 2024 } 2025 } 2026 /* Get blocking */ 2027 { 2028 PetscQuadrature q; 2029 PetscInt numBatches, batchSize, numBlocks, blockSize; 2030 PetscInt Nq, Nb; 2031 2032 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 2033 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr); 2034 ierr = PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 2035 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 2036 blockSize = Nb*Nq; 2037 batchSize = numBlocks * blockSize; 2038 chunkSize = numBatches*batchSize; 2039 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 2040 numChunks = numFaces / chunkSize; 2041 Nr = numFaces % chunkSize; 2042 offset = numFaces - Nr; 2043 } 2044 /* Do integration for each field */ 2045 for (chunk = 0; chunk < numChunks; ++chunk) { 2046 ierr = PetscFEGeomGetChunk(fgeom, chunk*chunkSize, (chunk+1)*chunkSize, &chunkGeom);CHKERRQ(ierr); 2047 ierr = PetscFEIntegrateBd(fe, prob, field, func, chunkSize, chunkGeom, u, probAux, a, fintegral);CHKERRQ(ierr); 2048 ierr = PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom);CHKERRQ(ierr); 2049 } 2050 ierr = PetscFEGeomGetChunk(fgeom, offset, numFaces, &chunkGeom);CHKERRQ(ierr); 2051 ierr = PetscFEIntegrateBd(fe, prob, field, func, Nr, chunkGeom, &u[offset*totDim], probAux, a ? &a[offset*totDimAux] : NULL, &fintegral[offset*Nf]);CHKERRQ(ierr); 2052 ierr = PetscFEGeomRestoreChunk(fgeom, offset, numFaces, &chunkGeom);CHKERRQ(ierr); 2053 /* Cleanup data arrays */ 2054 ierr = DMPlexRestoreFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);CHKERRQ(ierr); 2055 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 2056 ierr = PetscFree2(u, a);CHKERRQ(ierr); 2057 ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr); 2058 } 2059 } 2060 if (plex) {ierr = DMDestroy(&plex);CHKERRQ(ierr);} 2061 if (plexA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);} 2062 PetscFunctionReturn(0); 2063 } 2064 2065 /*@ 2066 DMPlexComputeBdIntegral - Form the integral over the specified boundary from the global input X using pointwise functions specified by the user 2067 2068 Input Parameters: 2069 + dm - The mesh 2070 . X - Global input vector 2071 . label - The boundary DMLabel 2072 . numVals - The number of label values to use, or PETSC_DETERMINE for all values 2073 . vals - The label values to use, or PETSC_NULL for all values 2074 . func = The function to integrate along the boundary 2075 - user - The user context 2076 2077 Output Parameter: 2078 . integral - Integral for each field 2079 2080 Level: developer 2081 2082 .seealso: DMPlexComputeIntegralFEM(), DMPlexComputeBdResidualFEM() 2083 @*/ 2084 PetscErrorCode DMPlexComputeBdIntegral(DM dm, Vec X, DMLabel label, PetscInt numVals, const PetscInt vals[], 2085 void (*func)(PetscInt, PetscInt, PetscInt, 2086 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 2087 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 2088 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]), 2089 PetscScalar *integral, void *user) 2090 { 2091 Vec locX; 2092 PetscSection section; 2093 DMLabel depthLabel; 2094 IS facetIS; 2095 PetscInt dim, Nf, f, v; 2096 PetscErrorCode ierr; 2097 2098 PetscFunctionBegin; 2099 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 2100 PetscValidHeaderSpecific(X, VEC_CLASSID, 2); 2101 PetscValidPointer(label, 3); 2102 if (vals) PetscValidPointer(vals, 5); 2103 PetscValidPointer(integral, 6); 2104 ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 2105 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr); 2106 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 2107 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr); 2108 ierr = DMGetDefaultSection(dm, §ion);CHKERRQ(ierr); 2109 ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr); 2110 /* Get local solution with boundary values */ 2111 ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr); 2112 ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);CHKERRQ(ierr); 2113 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr); 2114 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr); 2115 /* Loop over label values */ 2116 ierr = PetscMemzero(integral, Nf * sizeof(PetscScalar));CHKERRQ(ierr); 2117 for (v = 0; v < numVals; ++v) { 2118 IS pointIS; 2119 PetscInt numFaces, face; 2120 PetscScalar *fintegral; 2121 2122 ierr = DMLabelGetStratumIS(label, vals[v], &pointIS);CHKERRQ(ierr); 2123 if (!pointIS) continue; /* No points with that id on this process */ 2124 { 2125 IS isectIS; 2126 2127 /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */ 2128 ierr = ISIntersect_Caching_Internal(facetIS, pointIS, &isectIS);CHKERRQ(ierr); 2129 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 2130 pointIS = isectIS; 2131 } 2132 ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr); 2133 ierr = PetscCalloc1(numFaces*Nf, &fintegral);CHKERRQ(ierr); 2134 ierr = DMPlexComputeBdIntegral_Internal(dm, locX, pointIS, func, fintegral, user);CHKERRQ(ierr); 2135 /* Sum point contributions into integral */ 2136 for (f = 0; f < Nf; ++f) for (face = 0; face < numFaces; ++face) integral[f] += fintegral[face*Nf+f]; 2137 ierr = PetscFree(fintegral);CHKERRQ(ierr); 2138 ierr = ISDestroy(&pointIS);CHKERRQ(ierr); 2139 } 2140 ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr); 2141 ierr = ISDestroy(&facetIS);CHKERRQ(ierr); 2142 ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr); 2143 PetscFunctionReturn(0); 2144 } 2145 2146 /*@ 2147 DMPlexComputeInterpolatorNested - Form the local portion of the interpolation matrix I from the coarse DM to the uniformly refined DM. 2148 2149 Input Parameters: 2150 + dmf - The fine mesh 2151 . dmc - The coarse mesh 2152 - user - The user context 2153 2154 Output Parameter: 2155 . In - The interpolation matrix 2156 2157 Level: developer 2158 2159 .seealso: DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM() 2160 @*/ 2161 PetscErrorCode DMPlexComputeInterpolatorNested(DM dmc, DM dmf, Mat In, void *user) 2162 { 2163 DM_Plex *mesh = (DM_Plex *) dmc->data; 2164 const char *name = "Interpolator"; 2165 PetscDS prob; 2166 PetscFE *feRef; 2167 PetscFV *fvRef; 2168 PetscSection fsection, fglobalSection; 2169 PetscSection csection, cglobalSection; 2170 PetscScalar *elemMat; 2171 PetscInt dim, Nf, f, fieldI, fieldJ, offsetI, offsetJ, cStart, cEnd, cEndInterior, c; 2172 PetscInt cTotDim, rTotDim = 0; 2173 PetscErrorCode ierr; 2174 2175 PetscFunctionBegin; 2176 ierr = PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 2177 ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr); 2178 ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr); 2179 ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr); 2180 ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr); 2181 ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr); 2182 ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr); 2183 ierr = DMPlexGetHeightStratum(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr); 2184 ierr = DMPlexGetHybridBounds(dmc, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 2185 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 2186 ierr = DMGetDS(dmf, &prob);CHKERRQ(ierr); 2187 ierr = PetscCalloc2(Nf,&feRef,Nf,&fvRef);CHKERRQ(ierr); 2188 for (f = 0; f < Nf; ++f) { 2189 PetscObject obj; 2190 PetscClassId id; 2191 PetscInt rNb = 0, Nc = 0; 2192 2193 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 2194 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2195 if (id == PETSCFE_CLASSID) { 2196 PetscFE fe = (PetscFE) obj; 2197 2198 ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr); 2199 ierr = PetscFEGetDimension(feRef[f], &rNb);CHKERRQ(ierr); 2200 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 2201 } else if (id == PETSCFV_CLASSID) { 2202 PetscFV fv = (PetscFV) obj; 2203 PetscDualSpace Q; 2204 2205 ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr); 2206 ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr); 2207 ierr = PetscDualSpaceGetDimension(Q, &rNb);CHKERRQ(ierr); 2208 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 2209 } 2210 rTotDim += rNb; 2211 } 2212 ierr = PetscDSGetTotalDimension(prob, &cTotDim);CHKERRQ(ierr); 2213 ierr = PetscMalloc1(rTotDim*cTotDim,&elemMat);CHKERRQ(ierr); 2214 ierr = PetscMemzero(elemMat, rTotDim*cTotDim * sizeof(PetscScalar));CHKERRQ(ierr); 2215 for (fieldI = 0, offsetI = 0; fieldI < Nf; ++fieldI) { 2216 PetscDualSpace Qref; 2217 PetscQuadrature f; 2218 const PetscReal *qpoints, *qweights; 2219 PetscReal *points; 2220 PetscInt npoints = 0, Nc, Np, fpdim, i, k, p, d; 2221 2222 /* Compose points from all dual basis functionals */ 2223 if (feRef[fieldI]) { 2224 ierr = PetscFEGetDualSpace(feRef[fieldI], &Qref);CHKERRQ(ierr); 2225 ierr = PetscFEGetNumComponents(feRef[fieldI], &Nc);CHKERRQ(ierr); 2226 } else { 2227 ierr = PetscFVGetDualSpace(fvRef[fieldI], &Qref);CHKERRQ(ierr); 2228 ierr = PetscFVGetNumComponents(fvRef[fieldI], &Nc);CHKERRQ(ierr); 2229 } 2230 ierr = PetscDualSpaceGetDimension(Qref, &fpdim);CHKERRQ(ierr); 2231 for (i = 0; i < fpdim; ++i) { 2232 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr); 2233 ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, NULL, NULL);CHKERRQ(ierr); 2234 npoints += Np; 2235 } 2236 ierr = PetscMalloc1(npoints*dim,&points);CHKERRQ(ierr); 2237 for (i = 0, k = 0; i < fpdim; ++i) { 2238 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr); 2239 ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);CHKERRQ(ierr); 2240 for (p = 0; p < Np; ++p, ++k) for (d = 0; d < dim; ++d) points[k*dim+d] = qpoints[p*dim+d]; 2241 } 2242 2243 for (fieldJ = 0, offsetJ = 0; fieldJ < Nf; ++fieldJ) { 2244 PetscObject obj; 2245 PetscClassId id; 2246 PetscReal *B; 2247 PetscInt NcJ = 0, cpdim = 0, j, qNc; 2248 2249 ierr = PetscDSGetDiscretization(prob, fieldJ, &obj);CHKERRQ(ierr); 2250 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2251 if (id == PETSCFE_CLASSID) { 2252 PetscFE fe = (PetscFE) obj; 2253 2254 /* Evaluate basis at points */ 2255 ierr = PetscFEGetNumComponents(fe, &NcJ);CHKERRQ(ierr); 2256 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr); 2257 /* For now, fields only interpolate themselves */ 2258 if (fieldI == fieldJ) { 2259 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); 2260 ierr = PetscFEGetTabulation(fe, npoints, points, &B, NULL, NULL);CHKERRQ(ierr); 2261 for (i = 0, k = 0; i < fpdim; ++i) { 2262 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr); 2263 ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);CHKERRQ(ierr); 2264 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); 2265 for (p = 0; p < Np; ++p, ++k) { 2266 for (j = 0; j < cpdim; ++j) { 2267 /* 2268 cTotDim: Total columns in element interpolation matrix, sum of number of dual basis functionals in each field 2269 offsetI, offsetJ: Offsets into the larger element interpolation matrix for different fields 2270 fpdim, i, cpdim, j: Dofs for fine and coarse grids, correspond to dual space basis functionals 2271 qNC, Nc, Ncj, c: Number of components in this field 2272 Np, p: Number of quad points in the fine grid functional i 2273 k: i*Np + p, overall point number for the interpolation 2274 */ 2275 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += B[k*cpdim*NcJ+j*Nc+c]*qweights[p*qNc+c]; 2276 } 2277 } 2278 } 2279 ierr = PetscFERestoreTabulation(fe, npoints, points, &B, NULL, NULL);CHKERRQ(ierr);CHKERRQ(ierr); 2280 } 2281 } else if (id == PETSCFV_CLASSID) { 2282 PetscFV fv = (PetscFV) obj; 2283 2284 /* Evaluate constant function at points */ 2285 ierr = PetscFVGetNumComponents(fv, &NcJ);CHKERRQ(ierr); 2286 cpdim = 1; 2287 /* For now, fields only interpolate themselves */ 2288 if (fieldI == fieldJ) { 2289 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); 2290 for (i = 0, k = 0; i < fpdim; ++i) { 2291 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr); 2292 ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);CHKERRQ(ierr); 2293 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); 2294 for (p = 0; p < Np; ++p, ++k) { 2295 for (j = 0; j < cpdim; ++j) { 2296 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += 1.0*qweights[p*qNc+c]; 2297 } 2298 } 2299 } 2300 } 2301 } 2302 offsetJ += cpdim; 2303 } 2304 offsetI += fpdim; 2305 ierr = PetscFree(points);CHKERRQ(ierr); 2306 } 2307 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(0, name, rTotDim, cTotDim, elemMat);CHKERRQ(ierr);} 2308 /* Preallocate matrix */ 2309 { 2310 Mat preallocator; 2311 PetscScalar *vals; 2312 PetscInt *cellCIndices, *cellFIndices; 2313 PetscInt locRows, locCols, cell; 2314 2315 ierr = MatGetLocalSize(In, &locRows, &locCols);CHKERRQ(ierr); 2316 ierr = MatCreate(PetscObjectComm((PetscObject) In), &preallocator);CHKERRQ(ierr); 2317 ierr = MatSetType(preallocator, MATPREALLOCATOR);CHKERRQ(ierr); 2318 ierr = MatSetSizes(preallocator, locRows, locCols, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr); 2319 ierr = MatSetUp(preallocator);CHKERRQ(ierr); 2320 ierr = PetscCalloc3(rTotDim*cTotDim, &vals,cTotDim,&cellCIndices,rTotDim,&cellFIndices);CHKERRQ(ierr); 2321 for (cell = cStart; cell < cEnd; ++cell) { 2322 ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, cell, cellCIndices, cellFIndices);CHKERRQ(ierr); 2323 ierr = MatSetValues(preallocator, rTotDim, cellFIndices, cTotDim, cellCIndices, vals, INSERT_VALUES);CHKERRQ(ierr); 2324 } 2325 ierr = PetscFree3(vals,cellCIndices,cellFIndices);CHKERRQ(ierr); 2326 ierr = MatAssemblyBegin(preallocator, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2327 ierr = MatAssemblyEnd(preallocator, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2328 ierr = MatPreallocatorPreallocate(preallocator, PETSC_TRUE, In);CHKERRQ(ierr); 2329 ierr = MatDestroy(&preallocator);CHKERRQ(ierr); 2330 } 2331 /* Fill matrix */ 2332 ierr = MatZeroEntries(In);CHKERRQ(ierr); 2333 for (c = cStart; c < cEnd; ++c) { 2334 ierr = DMPlexMatSetClosureRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES);CHKERRQ(ierr); 2335 } 2336 for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);} 2337 ierr = PetscFree2(feRef,fvRef);CHKERRQ(ierr); 2338 ierr = PetscFree(elemMat);CHKERRQ(ierr); 2339 ierr = MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2340 ierr = MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2341 if (mesh->printFEM) { 2342 ierr = PetscPrintf(PetscObjectComm((PetscObject)In), "%s:\n", name);CHKERRQ(ierr); 2343 ierr = MatChop(In, 1.0e-10);CHKERRQ(ierr); 2344 ierr = MatView(In, NULL);CHKERRQ(ierr); 2345 } 2346 ierr = PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 2347 PetscFunctionReturn(0); 2348 } 2349 2350 PetscErrorCode DMPlexComputeMassMatrixNested(DM dmc, DM dmf, Mat mass, void *user) 2351 { 2352 SETERRQ(PetscObjectComm((PetscObject) dmc), PETSC_ERR_SUP, "Laziness"); 2353 } 2354 2355 /*@ 2356 DMPlexComputeInterpolatorGeneral - Form the local portion of the interpolation matrix I from the coarse DM to a non-nested fine DM. 2357 2358 Input Parameters: 2359 + dmf - The fine mesh 2360 . dmc - The coarse mesh 2361 - user - The user context 2362 2363 Output Parameter: 2364 . In - The interpolation matrix 2365 2366 Level: developer 2367 2368 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM() 2369 @*/ 2370 PetscErrorCode DMPlexComputeInterpolatorGeneral(DM dmc, DM dmf, Mat In, void *user) 2371 { 2372 DM_Plex *mesh = (DM_Plex *) dmf->data; 2373 const char *name = "Interpolator"; 2374 PetscDS prob; 2375 PetscSection fsection, csection, globalFSection, globalCSection; 2376 PetscHSetIJ ht; 2377 PetscLayout rLayout; 2378 PetscInt *dnz, *onz; 2379 PetscInt locRows, rStart, rEnd; 2380 PetscReal *x, *v0, *J, *invJ, detJ; 2381 PetscReal *v0c, *Jc, *invJc, detJc; 2382 PetscScalar *elemMat; 2383 PetscInt dim, Nf, field, totDim, cStart, cEnd, cell, ccell; 2384 PetscErrorCode ierr; 2385 2386 PetscFunctionBegin; 2387 ierr = PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 2388 ierr = DMGetCoordinateDim(dmc, &dim);CHKERRQ(ierr); 2389 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr); 2390 ierr = PetscDSGetRefCoordArrays(prob, &x, NULL);CHKERRQ(ierr); 2391 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 2392 ierr = PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);CHKERRQ(ierr); 2393 ierr = PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);CHKERRQ(ierr); 2394 ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr); 2395 ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr); 2396 ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr); 2397 ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr); 2398 ierr = DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);CHKERRQ(ierr); 2399 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 2400 ierr = PetscMalloc1(totDim, &elemMat);CHKERRQ(ierr); 2401 2402 ierr = MatGetLocalSize(In, &locRows, NULL);CHKERRQ(ierr); 2403 ierr = PetscLayoutCreate(PetscObjectComm((PetscObject) In), &rLayout);CHKERRQ(ierr); 2404 ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr); 2405 ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr); 2406 ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr); 2407 ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr); 2408 ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr); 2409 ierr = PetscCalloc2(locRows,&dnz,locRows,&onz);CHKERRQ(ierr); 2410 ierr = PetscHSetIJCreate(&ht);CHKERRQ(ierr); 2411 for (field = 0; field < Nf; ++field) { 2412 PetscObject obj; 2413 PetscClassId id; 2414 PetscDualSpace Q = NULL; 2415 PetscQuadrature f; 2416 const PetscReal *qpoints; 2417 PetscInt Nc, Np, fpdim, i, d; 2418 2419 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 2420 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2421 if (id == PETSCFE_CLASSID) { 2422 PetscFE fe = (PetscFE) obj; 2423 2424 ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr); 2425 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 2426 } else if (id == PETSCFV_CLASSID) { 2427 PetscFV fv = (PetscFV) obj; 2428 2429 ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr); 2430 Nc = 1; 2431 } 2432 ierr = PetscDualSpaceGetDimension(Q, &fpdim);CHKERRQ(ierr); 2433 /* For each fine grid cell */ 2434 for (cell = cStart; cell < cEnd; ++cell) { 2435 PetscInt *findices, *cindices; 2436 PetscInt numFIndices, numCIndices; 2437 2438 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2439 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr); 2440 if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %d != %d dual basis vecs", numFIndices, fpdim); 2441 for (i = 0; i < fpdim; ++i) { 2442 Vec pointVec; 2443 PetscScalar *pV; 2444 PetscSF coarseCellSF = NULL; 2445 const PetscSFNode *coarseCells; 2446 PetscInt numCoarseCells, q, c; 2447 2448 /* Get points from the dual basis functional quadrature */ 2449 ierr = PetscDualSpaceGetFunctional(Q, i, &f);CHKERRQ(ierr); 2450 ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);CHKERRQ(ierr); 2451 ierr = VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);CHKERRQ(ierr); 2452 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr); 2453 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2454 for (q = 0; q < Np; ++q) { 2455 const PetscReal xi0[3] = {-1., -1., -1.}; 2456 2457 /* Transform point to real space */ 2458 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x); 2459 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d]; 2460 } 2461 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2462 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */ 2463 /* OPT: Pack all quad points from fine cell */ 2464 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr); 2465 ierr = PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");CHKERRQ(ierr); 2466 /* Update preallocation info */ 2467 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr); 2468 if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located"); 2469 { 2470 PetscHashIJKey key; 2471 PetscBool missing; 2472 2473 key.i = findices[i]; 2474 if (key.i >= 0) { 2475 /* Get indices for coarse elements */ 2476 for (ccell = 0; ccell < numCoarseCells; ++ccell) { 2477 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2478 for (c = 0; c < numCIndices; ++c) { 2479 key.j = cindices[c]; 2480 if (key.j < 0) continue; 2481 ierr = PetscHSetIJQueryAdd(ht, key, &missing);CHKERRQ(ierr); 2482 if (missing) { 2483 if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart]; 2484 else ++onz[key.i-rStart]; 2485 } 2486 } 2487 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2488 } 2489 } 2490 } 2491 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 2492 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 2493 } 2494 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2495 } 2496 } 2497 ierr = PetscHSetIJDestroy(&ht);CHKERRQ(ierr); 2498 ierr = MatXAIJSetPreallocation(In, 1, dnz, onz, NULL, NULL);CHKERRQ(ierr); 2499 ierr = MatSetOption(In, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 2500 ierr = PetscFree2(dnz,onz);CHKERRQ(ierr); 2501 for (field = 0; field < Nf; ++field) { 2502 PetscObject obj; 2503 PetscClassId id; 2504 PetscDualSpace Q = NULL; 2505 PetscQuadrature f; 2506 const PetscReal *qpoints, *qweights; 2507 PetscInt Nc, qNc, Np, fpdim, i, d; 2508 2509 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 2510 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2511 if (id == PETSCFE_CLASSID) { 2512 PetscFE fe = (PetscFE) obj; 2513 2514 ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr); 2515 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 2516 } else if (id == PETSCFV_CLASSID) { 2517 PetscFV fv = (PetscFV) obj; 2518 2519 ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr); 2520 Nc = 1; 2521 } else SETERRQ1(PetscObjectComm((PetscObject)dmc),PETSC_ERR_ARG_WRONG,"Unknown discretization type for field %d",field); 2522 ierr = PetscDualSpaceGetDimension(Q, &fpdim);CHKERRQ(ierr); 2523 /* For each fine grid cell */ 2524 for (cell = cStart; cell < cEnd; ++cell) { 2525 PetscInt *findices, *cindices; 2526 PetscInt numFIndices, numCIndices; 2527 2528 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2529 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr); 2530 if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %d != %d dual basis vecs", numFIndices, fpdim); 2531 for (i = 0; i < fpdim; ++i) { 2532 Vec pointVec; 2533 PetscScalar *pV; 2534 PetscSF coarseCellSF = NULL; 2535 const PetscSFNode *coarseCells; 2536 PetscInt numCoarseCells, cpdim, q, c, j; 2537 2538 /* Get points from the dual basis functional quadrature */ 2539 ierr = PetscDualSpaceGetFunctional(Q, i, &f);CHKERRQ(ierr); 2540 ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, &qpoints, &qweights);CHKERRQ(ierr); 2541 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); 2542 ierr = VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);CHKERRQ(ierr); 2543 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr); 2544 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2545 for (q = 0; q < Np; ++q) { 2546 const PetscReal xi0[3] = {-1., -1., -1.}; 2547 2548 /* Transform point to real space */ 2549 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x); 2550 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d]; 2551 } 2552 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2553 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */ 2554 /* OPT: Read this out from preallocation information */ 2555 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr); 2556 /* Update preallocation info */ 2557 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr); 2558 if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located"); 2559 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2560 for (ccell = 0; ccell < numCoarseCells; ++ccell) { 2561 PetscReal pVReal[3]; 2562 const PetscReal xi0[3] = {-1., -1., -1.}; 2563 2564 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2565 /* Transform points from real space to coarse reference space */ 2566 ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr); 2567 for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]); 2568 CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x); 2569 2570 if (id == PETSCFE_CLASSID) { 2571 PetscFE fe = (PetscFE) obj; 2572 PetscReal *B; 2573 2574 /* Evaluate coarse basis on contained point */ 2575 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr); 2576 ierr = PetscFEGetTabulation(fe, 1, x, &B, NULL, NULL);CHKERRQ(ierr); 2577 ierr = PetscMemzero(elemMat, cpdim * sizeof(PetscScalar));CHKERRQ(ierr); 2578 /* Get elemMat entries by multiplying by weight */ 2579 for (j = 0; j < cpdim; ++j) { 2580 for (c = 0; c < Nc; ++c) elemMat[j] += B[j*Nc + c]*qweights[ccell*qNc + c]; 2581 } 2582 ierr = PetscFERestoreTabulation(fe, 1, x, &B, NULL, NULL);CHKERRQ(ierr);CHKERRQ(ierr); 2583 } else { 2584 cpdim = 1; 2585 for (j = 0; j < cpdim; ++j) { 2586 for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*qweights[ccell*qNc + c]; 2587 } 2588 } 2589 /* Update interpolator */ 2590 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);} 2591 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim); 2592 ierr = MatSetValues(In, 1, &findices[i], numCIndices, cindices, elemMat, INSERT_VALUES);CHKERRQ(ierr); 2593 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2594 } 2595 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2596 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 2597 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 2598 } 2599 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2600 } 2601 } 2602 ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr); 2603 ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr); 2604 ierr = PetscFree(elemMat);CHKERRQ(ierr); 2605 ierr = MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2606 ierr = MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2607 ierr = PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 2608 PetscFunctionReturn(0); 2609 } 2610 2611 /*@ 2612 DMPlexComputeMassMatrixGeneral - Form the local portion of the mass matrix M from the coarse DM to a non-nested fine DM. 2613 2614 Input Parameters: 2615 + dmf - The fine mesh 2616 . dmc - The coarse mesh 2617 - user - The user context 2618 2619 Output Parameter: 2620 . mass - The mass matrix 2621 2622 Level: developer 2623 2624 .seealso: DMPlexComputeMassMatrixNested(), DMPlexComputeInterpolatorNested(), DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM() 2625 @*/ 2626 PetscErrorCode DMPlexComputeMassMatrixGeneral(DM dmc, DM dmf, Mat mass, void *user) 2627 { 2628 DM_Plex *mesh = (DM_Plex *) dmf->data; 2629 const char *name = "Mass Matrix"; 2630 PetscDS prob; 2631 PetscSection fsection, csection, globalFSection, globalCSection; 2632 PetscHSetIJ ht; 2633 PetscLayout rLayout; 2634 PetscInt *dnz, *onz; 2635 PetscInt locRows, rStart, rEnd; 2636 PetscReal *x, *v0, *J, *invJ, detJ; 2637 PetscReal *v0c, *Jc, *invJc, detJc; 2638 PetscScalar *elemMat; 2639 PetscInt dim, Nf, field, totDim, cStart, cEnd, cell, ccell; 2640 PetscErrorCode ierr; 2641 2642 PetscFunctionBegin; 2643 ierr = DMGetCoordinateDim(dmc, &dim);CHKERRQ(ierr); 2644 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr); 2645 ierr = PetscDSGetRefCoordArrays(prob, &x, NULL);CHKERRQ(ierr); 2646 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 2647 ierr = PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);CHKERRQ(ierr); 2648 ierr = PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);CHKERRQ(ierr); 2649 ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr); 2650 ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr); 2651 ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr); 2652 ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr); 2653 ierr = DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);CHKERRQ(ierr); 2654 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 2655 ierr = PetscMalloc1(totDim, &elemMat);CHKERRQ(ierr); 2656 2657 ierr = MatGetLocalSize(mass, &locRows, NULL);CHKERRQ(ierr); 2658 ierr = PetscLayoutCreate(PetscObjectComm((PetscObject) mass), &rLayout);CHKERRQ(ierr); 2659 ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr); 2660 ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr); 2661 ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr); 2662 ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr); 2663 ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr); 2664 ierr = PetscCalloc2(locRows,&dnz,locRows,&onz);CHKERRQ(ierr); 2665 ierr = PetscHSetIJCreate(&ht);CHKERRQ(ierr); 2666 for (field = 0; field < Nf; ++field) { 2667 PetscObject obj; 2668 PetscClassId id; 2669 PetscQuadrature quad; 2670 const PetscReal *qpoints; 2671 PetscInt Nq, Nc, i, d; 2672 2673 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 2674 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2675 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetQuadrature((PetscFE) obj, &quad);CHKERRQ(ierr);} 2676 else {ierr = PetscFVGetQuadrature((PetscFV) obj, &quad);CHKERRQ(ierr);} 2677 ierr = PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, NULL);CHKERRQ(ierr); 2678 /* For each fine grid cell */ 2679 for (cell = cStart; cell < cEnd; ++cell) { 2680 Vec pointVec; 2681 PetscScalar *pV; 2682 PetscSF coarseCellSF = NULL; 2683 const PetscSFNode *coarseCells; 2684 PetscInt numCoarseCells, q, c; 2685 PetscInt *findices, *cindices; 2686 PetscInt numFIndices, numCIndices; 2687 2688 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2689 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr); 2690 /* Get points from the quadrature */ 2691 ierr = VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);CHKERRQ(ierr); 2692 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr); 2693 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2694 for (q = 0; q < Nq; ++q) { 2695 const PetscReal xi0[3] = {-1., -1., -1.}; 2696 2697 /* Transform point to real space */ 2698 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x); 2699 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d]; 2700 } 2701 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2702 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */ 2703 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr); 2704 ierr = PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");CHKERRQ(ierr); 2705 /* Update preallocation info */ 2706 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr); 2707 if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located"); 2708 { 2709 PetscHashIJKey key; 2710 PetscBool missing; 2711 2712 for (i = 0; i < numFIndices; ++i) { 2713 key.i = findices[i]; 2714 if (key.i >= 0) { 2715 /* Get indices for coarse elements */ 2716 for (ccell = 0; ccell < numCoarseCells; ++ccell) { 2717 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2718 for (c = 0; c < numCIndices; ++c) { 2719 key.j = cindices[c]; 2720 if (key.j < 0) continue; 2721 ierr = PetscHSetIJQueryAdd(ht, key, &missing);CHKERRQ(ierr); 2722 if (missing) { 2723 if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart]; 2724 else ++onz[key.i-rStart]; 2725 } 2726 } 2727 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2728 } 2729 } 2730 } 2731 } 2732 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 2733 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 2734 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2735 } 2736 } 2737 ierr = PetscHSetIJDestroy(&ht);CHKERRQ(ierr); 2738 ierr = MatXAIJSetPreallocation(mass, 1, dnz, onz, NULL, NULL);CHKERRQ(ierr); 2739 ierr = MatSetOption(mass, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 2740 ierr = PetscFree2(dnz,onz);CHKERRQ(ierr); 2741 for (field = 0; field < Nf; ++field) { 2742 PetscObject obj; 2743 PetscClassId id; 2744 PetscQuadrature quad; 2745 PetscReal *Bfine; 2746 const PetscReal *qpoints, *qweights; 2747 PetscInt Nq, Nc, i, d; 2748 2749 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr); 2750 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2751 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetQuadrature((PetscFE) obj, &quad);CHKERRQ(ierr);ierr = PetscFEGetDefaultTabulation((PetscFE) obj, &Bfine, NULL, NULL);CHKERRQ(ierr);} 2752 else {ierr = PetscFVGetQuadrature((PetscFV) obj, &quad);CHKERRQ(ierr);} 2753 ierr = PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, &qweights);CHKERRQ(ierr); 2754 /* For each fine grid cell */ 2755 for (cell = cStart; cell < cEnd; ++cell) { 2756 Vec pointVec; 2757 PetscScalar *pV; 2758 PetscSF coarseCellSF = NULL; 2759 const PetscSFNode *coarseCells; 2760 PetscInt numCoarseCells, cpdim, q, c, j; 2761 PetscInt *findices, *cindices; 2762 PetscInt numFIndices, numCIndices; 2763 2764 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2765 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr); 2766 /* Get points from the quadrature */ 2767 ierr = VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);CHKERRQ(ierr); 2768 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr); 2769 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2770 for (q = 0; q < Nq; ++q) { 2771 const PetscReal xi0[3] = {-1., -1., -1.}; 2772 2773 /* Transform point to real space */ 2774 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x); 2775 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d]; 2776 } 2777 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2778 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */ 2779 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr); 2780 /* Update matrix */ 2781 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr); 2782 if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located"); 2783 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr); 2784 for (ccell = 0; ccell < numCoarseCells; ++ccell) { 2785 PetscReal pVReal[3]; 2786 const PetscReal xi0[3] = {-1., -1., -1.}; 2787 2788 2789 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2790 /* Transform points from real space to coarse reference space */ 2791 ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr); 2792 for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]); 2793 CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x); 2794 2795 if (id == PETSCFE_CLASSID) { 2796 PetscFE fe = (PetscFE) obj; 2797 PetscReal *B; 2798 2799 /* Evaluate coarse basis on contained point */ 2800 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr); 2801 ierr = PetscFEGetTabulation(fe, 1, x, &B, NULL, NULL);CHKERRQ(ierr); 2802 /* Get elemMat entries by multiplying by weight */ 2803 for (i = 0; i < numFIndices; ++i) { 2804 ierr = PetscMemzero(elemMat, cpdim * sizeof(PetscScalar));CHKERRQ(ierr); 2805 for (j = 0; j < cpdim; ++j) { 2806 for (c = 0; c < Nc; ++c) elemMat[j] += B[j*Nc + c]*Bfine[(ccell*numFIndices + i)*Nc + c]*qweights[ccell*Nc + c]*detJ; 2807 } 2808 /* Update interpolator */ 2809 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);} 2810 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim); 2811 ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr); 2812 } 2813 ierr = PetscFERestoreTabulation(fe, 1, x, &B, NULL, NULL);CHKERRQ(ierr);CHKERRQ(ierr); 2814 } else { 2815 cpdim = 1; 2816 for (i = 0; i < numFIndices; ++i) { 2817 ierr = PetscMemzero(elemMat, cpdim * sizeof(PetscScalar));CHKERRQ(ierr); 2818 for (j = 0; j < cpdim; ++j) { 2819 for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*1.0*qweights[ccell*Nc + c]*detJ; 2820 } 2821 /* Update interpolator */ 2822 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);} 2823 ierr = PetscPrintf(PETSC_COMM_SELF, "Nq: %d %d Nf: %d %d Nc: %d %d\n", ccell, Nq, i, numFIndices, j, numCIndices);CHKERRQ(ierr); 2824 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim); 2825 ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr); 2826 } 2827 } 2828 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, &numCIndices, &cindices, NULL);CHKERRQ(ierr); 2829 } 2830 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr); 2831 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr); 2832 ierr = VecDestroy(&pointVec);CHKERRQ(ierr); 2833 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, &numFIndices, &findices, NULL);CHKERRQ(ierr); 2834 } 2835 } 2836 ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr); 2837 ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr); 2838 ierr = PetscFree(elemMat);CHKERRQ(ierr); 2839 ierr = MatAssemblyBegin(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2840 ierr = MatAssemblyEnd(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2841 PetscFunctionReturn(0); 2842 } 2843 2844 /*@ 2845 DMPlexComputeInjectorFEM - Compute a mapping from coarse unknowns to fine unknowns 2846 2847 Input Parameters: 2848 + dmc - The coarse mesh 2849 - dmf - The fine mesh 2850 - user - The user context 2851 2852 Output Parameter: 2853 . sc - The mapping 2854 2855 Level: developer 2856 2857 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM() 2858 @*/ 2859 PetscErrorCode DMPlexComputeInjectorFEM(DM dmc, DM dmf, VecScatter *sc, void *user) 2860 { 2861 PetscDS prob; 2862 PetscFE *feRef; 2863 PetscFV *fvRef; 2864 Vec fv, cv; 2865 IS fis, cis; 2866 PetscSection fsection, fglobalSection, csection, cglobalSection; 2867 PetscInt *cmap, *cellCIndices, *cellFIndices, *cindices, *findices; 2868 PetscInt cTotDim, fTotDim = 0, Nf, f, field, cStart, cEnd, cEndInterior, c, dim, d, startC, endC, offsetC, offsetF, m; 2869 PetscBool *needAvg; 2870 PetscErrorCode ierr; 2871 2872 PetscFunctionBegin; 2873 ierr = PetscLogEventBegin(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 2874 ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr); 2875 ierr = DMGetSection(dmf, &fsection);CHKERRQ(ierr); 2876 ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr); 2877 ierr = DMGetSection(dmc, &csection);CHKERRQ(ierr); 2878 ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr); 2879 ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr); 2880 ierr = DMPlexGetHeightStratum(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr); 2881 ierr = DMPlexGetHybridBounds(dmc, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr); 2882 cEnd = cEndInterior < 0 ? cEnd : cEndInterior; 2883 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr); 2884 ierr = PetscCalloc3(Nf,&feRef,Nf,&fvRef,Nf,&needAvg);CHKERRQ(ierr); 2885 for (f = 0; f < Nf; ++f) { 2886 PetscObject obj; 2887 PetscClassId id; 2888 PetscInt fNb = 0, Nc = 0; 2889 2890 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 2891 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 2892 if (id == PETSCFE_CLASSID) { 2893 PetscFE fe = (PetscFE) obj; 2894 PetscSpace sp; 2895 PetscInt maxDegree; 2896 2897 ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr); 2898 ierr = PetscFEGetDimension(feRef[f], &fNb);CHKERRQ(ierr); 2899 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 2900 ierr = PetscFEGetBasisSpace(fe, &sp);CHKERRQ(ierr); 2901 ierr = PetscSpaceGetDegree(sp, NULL, &maxDegree);CHKERRQ(ierr); 2902 if (!maxDegree) needAvg[f] = PETSC_TRUE; 2903 } else if (id == PETSCFV_CLASSID) { 2904 PetscFV fv = (PetscFV) obj; 2905 PetscDualSpace Q; 2906 2907 ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr); 2908 ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr); 2909 ierr = PetscDualSpaceGetDimension(Q, &fNb);CHKERRQ(ierr); 2910 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 2911 needAvg[f] = PETSC_TRUE; 2912 } 2913 fTotDim += fNb; 2914 } 2915 ierr = PetscDSGetTotalDimension(prob, &cTotDim);CHKERRQ(ierr); 2916 ierr = PetscMalloc1(cTotDim,&cmap);CHKERRQ(ierr); 2917 for (field = 0, offsetC = 0, offsetF = 0; field < Nf; ++field) { 2918 PetscFE feC; 2919 PetscFV fvC; 2920 PetscDualSpace QF, QC; 2921 PetscInt order = -1, NcF, NcC, fpdim, cpdim; 2922 2923 if (feRef[field]) { 2924 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &feC);CHKERRQ(ierr); 2925 ierr = PetscFEGetNumComponents(feC, &NcC);CHKERRQ(ierr); 2926 ierr = PetscFEGetNumComponents(feRef[field], &NcF);CHKERRQ(ierr); 2927 ierr = PetscFEGetDualSpace(feRef[field], &QF);CHKERRQ(ierr); 2928 ierr = PetscDualSpaceGetOrder(QF, &order);CHKERRQ(ierr); 2929 ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr); 2930 ierr = PetscFEGetDualSpace(feC, &QC);CHKERRQ(ierr); 2931 ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr); 2932 } else { 2933 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fvC);CHKERRQ(ierr); 2934 ierr = PetscFVGetNumComponents(fvC, &NcC);CHKERRQ(ierr); 2935 ierr = PetscFVGetNumComponents(fvRef[field], &NcF);CHKERRQ(ierr); 2936 ierr = PetscFVGetDualSpace(fvRef[field], &QF);CHKERRQ(ierr); 2937 ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr); 2938 ierr = PetscFVGetDualSpace(fvC, &QC);CHKERRQ(ierr); 2939 ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr); 2940 } 2941 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); 2942 for (c = 0; c < cpdim; ++c) { 2943 PetscQuadrature cfunc; 2944 const PetscReal *cqpoints, *cqweights; 2945 PetscInt NqcC, NpC; 2946 PetscBool found = PETSC_FALSE; 2947 2948 ierr = PetscDualSpaceGetFunctional(QC, c, &cfunc);CHKERRQ(ierr); 2949 ierr = PetscQuadratureGetData(cfunc, NULL, &NqcC, &NpC, &cqpoints, &cqweights);CHKERRQ(ierr); 2950 if (NqcC != NcC) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components", NqcC, NcC); 2951 if (NpC != 1 && feRef[field]) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Do not know how to do injection for moments"); 2952 for (f = 0; f < fpdim; ++f) { 2953 PetscQuadrature ffunc; 2954 const PetscReal *fqpoints, *fqweights; 2955 PetscReal sum = 0.0; 2956 PetscInt NqcF, NpF; 2957 2958 ierr = PetscDualSpaceGetFunctional(QF, f, &ffunc);CHKERRQ(ierr); 2959 ierr = PetscQuadratureGetData(ffunc, NULL, &NqcF, &NpF, &fqpoints, &fqweights);CHKERRQ(ierr); 2960 if (NqcF != NcF) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components", NqcF, NcF); 2961 if (NpC != NpF) continue; 2962 for (d = 0; d < dim; ++d) sum += PetscAbsReal(cqpoints[d] - fqpoints[d]); 2963 if (sum > 1.0e-9) continue; 2964 for (d = 0; d < NcC; ++d) sum += PetscAbsReal(cqweights[d]*fqweights[d]); 2965 if (sum < 1.0e-9) continue; 2966 cmap[offsetC+c] = offsetF+f; 2967 found = PETSC_TRUE; 2968 break; 2969 } 2970 if (!found) { 2971 /* TODO We really want the average here, but some asshole put VecScatter in the interface */ 2972 if (fvRef[field] || (feRef[field] && order == 0)) { 2973 cmap[offsetC+c] = offsetF+0; 2974 } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not locate matching functional for injection"); 2975 } 2976 } 2977 offsetC += cpdim; 2978 offsetF += fpdim; 2979 } 2980 for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);ierr = PetscFVDestroy(&fvRef[f]);CHKERRQ(ierr);} 2981 ierr = PetscFree3(feRef,fvRef,needAvg);CHKERRQ(ierr); 2982 2983 ierr = DMGetGlobalVector(dmf, &fv);CHKERRQ(ierr); 2984 ierr = DMGetGlobalVector(dmc, &cv);CHKERRQ(ierr); 2985 ierr = VecGetOwnershipRange(cv, &startC, &endC);CHKERRQ(ierr); 2986 ierr = PetscSectionGetConstrainedStorageSize(cglobalSection, &m);CHKERRQ(ierr); 2987 ierr = PetscMalloc2(cTotDim,&cellCIndices,fTotDim,&cellFIndices);CHKERRQ(ierr); 2988 ierr = PetscMalloc1(m,&cindices);CHKERRQ(ierr); 2989 ierr = PetscMalloc1(m,&findices);CHKERRQ(ierr); 2990 for (d = 0; d < m; ++d) cindices[d] = findices[d] = -1; 2991 for (c = cStart; c < cEnd; ++c) { 2992 ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, c, cellCIndices, cellFIndices);CHKERRQ(ierr); 2993 for (d = 0; d < cTotDim; ++d) { 2994 if ((cellCIndices[d] < startC) || (cellCIndices[d] >= endC)) continue; 2995 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]]); 2996 cindices[cellCIndices[d]-startC] = cellCIndices[d]; 2997 findices[cellCIndices[d]-startC] = cellFIndices[cmap[d]]; 2998 } 2999 } 3000 ierr = PetscFree(cmap);CHKERRQ(ierr); 3001 ierr = PetscFree2(cellCIndices,cellFIndices);CHKERRQ(ierr); 3002 3003 ierr = ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis);CHKERRQ(ierr); 3004 ierr = ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis);CHKERRQ(ierr); 3005 ierr = VecScatterCreate(cv, cis, fv, fis, sc);CHKERRQ(ierr); 3006 ierr = ISDestroy(&cis);CHKERRQ(ierr); 3007 ierr = ISDestroy(&fis);CHKERRQ(ierr); 3008 ierr = DMRestoreGlobalVector(dmf, &fv);CHKERRQ(ierr); 3009 ierr = DMRestoreGlobalVector(dmc, &cv);CHKERRQ(ierr); 3010 ierr = PetscLogEventEnd(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr); 3011 PetscFunctionReturn(0); 3012 } 3013 3014 /*@C 3015 DMPlexGetCellFields - Retrieve the field values values for a chunk of cells 3016 3017 Input Parameters: 3018 + dm - The DM 3019 . cellIS - The cells to include 3020 . locX - A local vector with the solution fields 3021 . locX_t - A local vector with solution field time derivatives, or NULL 3022 - locA - A local vector with auxiliary fields, or NULL 3023 3024 Output Parameters: 3025 + u - The field coefficients 3026 . u_t - The fields derivative coefficients 3027 - a - The auxiliary field coefficients 3028 3029 Level: developer 3030 3031 .seealso: DMPlexGetFaceFields() 3032 @*/ 3033 PetscErrorCode DMPlexGetCellFields(DM dm, IS cellIS, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a) 3034 { 3035 DM plex, plexA = NULL; 3036 PetscSection section, sectionAux; 3037 PetscDS prob; 3038 const PetscInt *cells; 3039 PetscInt cStart, cEnd, numCells, totDim, totDimAux, c; 3040 PetscErrorCode ierr; 3041 3042 PetscFunctionBegin; 3043 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 3044 PetscValidHeaderSpecific(locX, VEC_CLASSID, 4); 3045 if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 5);} 3046 if (locA) {PetscValidHeaderSpecific(locA, VEC_CLASSID, 6);} 3047 PetscValidPointer(u, 7); 3048 PetscValidPointer(u_t, 8); 3049 PetscValidPointer(a, 9); 3050 ierr = DMPlexConvertPlex(dm, &plex, PETSC_FALSE);CHKERRQ(ierr); 3051 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3052 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 3053 ierr = DMGetCellDS(dm, cStart, &prob);CHKERRQ(ierr); 3054 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 3055 if (locA) { 3056 DM dmAux; 3057 PetscDS probAux; 3058 3059 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 3060 ierr = DMPlexConvertPlex(dmAux, &plexA, PETSC_FALSE);CHKERRQ(ierr); 3061 ierr = DMGetSection(dmAux, §ionAux);CHKERRQ(ierr); 3062 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 3063 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 3064 } 3065 numCells = cEnd - cStart; 3066 ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u);CHKERRQ(ierr); 3067 if (locX_t) {ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u_t);CHKERRQ(ierr);} else {*u_t = NULL;} 3068 if (locA) {ierr = DMGetWorkArray(dm, numCells*totDimAux, MPIU_SCALAR, a);CHKERRQ(ierr);} else {*a = NULL;} 3069 for (c = cStart; c < cEnd; ++c) { 3070 const PetscInt cell = cells ? cells[c] : c; 3071 const PetscInt cind = c - cStart; 3072 PetscScalar *x = NULL, *x_t = NULL, *ul = *u, *ul_t = *u_t, *al = *a; 3073 PetscInt i; 3074 3075 ierr = DMPlexVecGetClosure(plex, section, locX, cell, NULL, &x);CHKERRQ(ierr); 3076 for (i = 0; i < totDim; ++i) ul[cind*totDim+i] = x[i]; 3077 ierr = DMPlexVecRestoreClosure(plex, section, locX, cell, NULL, &x);CHKERRQ(ierr); 3078 if (locX_t) { 3079 ierr = DMPlexVecGetClosure(plex, section, locX_t, cell, NULL, &x_t);CHKERRQ(ierr); 3080 for (i = 0; i < totDim; ++i) ul_t[cind*totDim+i] = x_t[i]; 3081 ierr = DMPlexVecRestoreClosure(plex, section, locX_t, cell, NULL, &x_t);CHKERRQ(ierr); 3082 } 3083 if (locA) { 3084 PetscInt subcell; 3085 ierr = DMPlexGetAuxiliaryPoint(plex, plexA, cell, &subcell);CHKERRQ(ierr); 3086 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subcell, NULL, &x);CHKERRQ(ierr); 3087 for (i = 0; i < totDimAux; ++i) al[cind*totDimAux+i] = x[i]; 3088 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subcell, NULL, &x);CHKERRQ(ierr); 3089 } 3090 } 3091 ierr = DMDestroy(&plex);CHKERRQ(ierr); 3092 if (locA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);} 3093 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3094 PetscFunctionReturn(0); 3095 } 3096 3097 /*@C 3098 DMPlexRestoreCellFields - Restore the field values values for a chunk of cells 3099 3100 Input Parameters: 3101 + dm - The DM 3102 . cellIS - The cells to include 3103 . locX - A local vector with the solution fields 3104 . locX_t - A local vector with solution field time derivatives, or NULL 3105 - locA - A local vector with auxiliary fields, or NULL 3106 3107 Output Parameters: 3108 + u - The field coefficients 3109 . u_t - The fields derivative coefficients 3110 - a - The auxiliary field coefficients 3111 3112 Level: developer 3113 3114 .seealso: DMPlexGetFaceFields() 3115 @*/ 3116 PetscErrorCode DMPlexRestoreCellFields(DM dm, IS cellIS, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a) 3117 { 3118 PetscErrorCode ierr; 3119 3120 PetscFunctionBegin; 3121 ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u);CHKERRQ(ierr); 3122 if (locX_t) {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u_t);CHKERRQ(ierr);} 3123 if (locA) {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, a);CHKERRQ(ierr);} 3124 PetscFunctionReturn(0); 3125 } 3126 3127 /*@C 3128 DMPlexGetFaceFields - Retrieve the field values values for a chunk of faces 3129 3130 Input Parameters: 3131 + dm - The DM 3132 . fStart - The first face to include 3133 . fEnd - The first face to exclude 3134 . locX - A local vector with the solution fields 3135 . locX_t - A local vector with solution field time derivatives, or NULL 3136 . faceGeometry - A local vector with face geometry 3137 . cellGeometry - A local vector with cell geometry 3138 - locaGrad - A local vector with field gradients, or NULL 3139 3140 Output Parameters: 3141 + Nface - The number of faces with field values 3142 . uL - The field values at the left side of the face 3143 - uR - The field values at the right side of the face 3144 3145 Level: developer 3146 3147 .seealso: DMPlexGetCellFields() 3148 @*/ 3149 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) 3150 { 3151 DM dmFace, dmCell, dmGrad = NULL; 3152 PetscSection section; 3153 PetscDS prob; 3154 DMLabel ghostLabel; 3155 const PetscScalar *facegeom, *cellgeom, *x, *lgrad; 3156 PetscBool *isFE; 3157 PetscInt dim, Nf, f, Nc, numFaces = fEnd - fStart, iface, face; 3158 PetscErrorCode ierr; 3159 3160 PetscFunctionBegin; 3161 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 3162 PetscValidHeaderSpecific(locX, VEC_CLASSID, 4); 3163 if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 5);} 3164 PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 6); 3165 PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 7); 3166 if (locGrad) {PetscValidHeaderSpecific(locGrad, VEC_CLASSID, 8);} 3167 PetscValidPointer(uL, 9); 3168 PetscValidPointer(uR, 10); 3169 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 3170 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 3171 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr); 3172 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 3173 ierr = PetscDSGetTotalComponents(prob, &Nc);CHKERRQ(ierr); 3174 ierr = PetscMalloc1(Nf, &isFE);CHKERRQ(ierr); 3175 for (f = 0; f < Nf; ++f) { 3176 PetscObject obj; 3177 PetscClassId id; 3178 3179 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3180 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3181 if (id == PETSCFE_CLASSID) {isFE[f] = PETSC_TRUE;} 3182 else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;} 3183 else {isFE[f] = PETSC_FALSE;} 3184 } 3185 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 3186 ierr = VecGetArrayRead(locX, &x);CHKERRQ(ierr); 3187 ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr); 3188 ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 3189 ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr); 3190 ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 3191 if (locGrad) { 3192 ierr = VecGetDM(locGrad, &dmGrad);CHKERRQ(ierr); 3193 ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr); 3194 } 3195 ierr = DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uL);CHKERRQ(ierr); 3196 ierr = DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uR);CHKERRQ(ierr); 3197 /* Right now just eat the extra work for FE (could make a cell loop) */ 3198 for (face = fStart, iface = 0; face < fEnd; ++face) { 3199 const PetscInt *cells; 3200 PetscFVFaceGeom *fg; 3201 PetscFVCellGeom *cgL, *cgR; 3202 PetscScalar *xL, *xR, *gL, *gR; 3203 PetscScalar *uLl = *uL, *uRl = *uR; 3204 PetscInt ghost, nsupp, nchild; 3205 3206 ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr); 3207 ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr); 3208 ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr); 3209 if (ghost >= 0 || nsupp > 2 || nchild > 0) continue; 3210 ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr); 3211 ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr); 3212 ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr); 3213 ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr); 3214 for (f = 0; f < Nf; ++f) { 3215 PetscInt off; 3216 3217 ierr = PetscDSGetComponentOffset(prob, f, &off);CHKERRQ(ierr); 3218 if (isFE[f]) { 3219 const PetscInt *cone; 3220 PetscInt comp, coneSizeL, coneSizeR, faceLocL, faceLocR, ldof, rdof, d; 3221 3222 xL = xR = NULL; 3223 ierr = PetscSectionGetFieldComponents(section, f, &comp);CHKERRQ(ierr); 3224 ierr = DMPlexVecGetClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL);CHKERRQ(ierr); 3225 ierr = DMPlexVecGetClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR);CHKERRQ(ierr); 3226 ierr = DMPlexGetCone(dm, cells[0], &cone);CHKERRQ(ierr); 3227 ierr = DMPlexGetConeSize(dm, cells[0], &coneSizeL);CHKERRQ(ierr); 3228 for (faceLocL = 0; faceLocL < coneSizeL; ++faceLocL) if (cone[faceLocL] == face) break; 3229 ierr = DMPlexGetCone(dm, cells[1], &cone);CHKERRQ(ierr); 3230 ierr = DMPlexGetConeSize(dm, cells[1], &coneSizeR);CHKERRQ(ierr); 3231 for (faceLocR = 0; faceLocR < coneSizeR; ++faceLocR) if (cone[faceLocR] == face) break; 3232 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]); 3233 /* Check that FEM field has values in the right cell (sometimes its an FV ghost cell) */ 3234 /* TODO: this is a hack that might not be right for nonconforming */ 3235 if (faceLocL < coneSizeL) { 3236 ierr = EvaluateFaceFields(prob, f, faceLocL, xL, &uLl[iface*Nc+off]);CHKERRQ(ierr); 3237 if (rdof == ldof && faceLocR < coneSizeR) {ierr = EvaluateFaceFields(prob, f, faceLocR, xR, &uRl[iface*Nc+off]);CHKERRQ(ierr);} 3238 else {for(d = 0; d < comp; ++d) uRl[iface*Nc+off+d] = uLl[iface*Nc+off+d];} 3239 } 3240 else { 3241 ierr = EvaluateFaceFields(prob, f, faceLocR, xR, &uRl[iface*Nc+off]);CHKERRQ(ierr); 3242 ierr = PetscSectionGetFieldComponents(section, f, &comp);CHKERRQ(ierr); 3243 for(d = 0; d < comp; ++d) uLl[iface*Nc+off+d] = uRl[iface*Nc+off+d]; 3244 } 3245 ierr = DMPlexVecRestoreClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL);CHKERRQ(ierr); 3246 ierr = DMPlexVecRestoreClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR);CHKERRQ(ierr); 3247 } else { 3248 PetscFV fv; 3249 PetscInt numComp, c; 3250 3251 ierr = PetscDSGetDiscretization(prob, f, (PetscObject *) &fv);CHKERRQ(ierr); 3252 ierr = PetscFVGetNumComponents(fv, &numComp);CHKERRQ(ierr); 3253 ierr = DMPlexPointLocalFieldRead(dm, cells[0], f, x, &xL);CHKERRQ(ierr); 3254 ierr = DMPlexPointLocalFieldRead(dm, cells[1], f, x, &xR);CHKERRQ(ierr); 3255 if (dmGrad) { 3256 PetscReal dxL[3], dxR[3]; 3257 3258 ierr = DMPlexPointLocalRead(dmGrad, cells[0], lgrad, &gL);CHKERRQ(ierr); 3259 ierr = DMPlexPointLocalRead(dmGrad, cells[1], lgrad, &gR);CHKERRQ(ierr); 3260 DMPlex_WaxpyD_Internal(dim, -1, cgL->centroid, fg->centroid, dxL); 3261 DMPlex_WaxpyD_Internal(dim, -1, cgR->centroid, fg->centroid, dxR); 3262 for (c = 0; c < numComp; ++c) { 3263 uLl[iface*Nc+off+c] = xL[c] + DMPlex_DotD_Internal(dim, &gL[c*dim], dxL); 3264 uRl[iface*Nc+off+c] = xR[c] + DMPlex_DotD_Internal(dim, &gR[c*dim], dxR); 3265 } 3266 } else { 3267 for (c = 0; c < numComp; ++c) { 3268 uLl[iface*Nc+off+c] = xL[c]; 3269 uRl[iface*Nc+off+c] = xR[c]; 3270 } 3271 } 3272 } 3273 } 3274 ++iface; 3275 } 3276 *Nface = iface; 3277 ierr = VecRestoreArrayRead(locX, &x);CHKERRQ(ierr); 3278 ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 3279 ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 3280 if (locGrad) { 3281 ierr = VecRestoreArrayRead(locGrad, &lgrad);CHKERRQ(ierr); 3282 } 3283 ierr = PetscFree(isFE);CHKERRQ(ierr); 3284 PetscFunctionReturn(0); 3285 } 3286 3287 /*@C 3288 DMPlexRestoreFaceFields - Restore the field values values for a chunk of faces 3289 3290 Input Parameters: 3291 + dm - The DM 3292 . fStart - The first face to include 3293 . fEnd - The first face to exclude 3294 . locX - A local vector with the solution fields 3295 . locX_t - A local vector with solution field time derivatives, or NULL 3296 . faceGeometry - A local vector with face geometry 3297 . cellGeometry - A local vector with cell geometry 3298 - locaGrad - A local vector with field gradients, or NULL 3299 3300 Output Parameters: 3301 + Nface - The number of faces with field values 3302 . uL - The field values at the left side of the face 3303 - uR - The field values at the right side of the face 3304 3305 Level: developer 3306 3307 .seealso: DMPlexGetFaceFields() 3308 @*/ 3309 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) 3310 { 3311 PetscErrorCode ierr; 3312 3313 PetscFunctionBegin; 3314 ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uL);CHKERRQ(ierr); 3315 ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uR);CHKERRQ(ierr); 3316 PetscFunctionReturn(0); 3317 } 3318 3319 /*@C 3320 DMPlexGetFaceGeometry - Retrieve the geometric values for a chunk of faces 3321 3322 Input Parameters: 3323 + dm - The DM 3324 . fStart - The first face to include 3325 . fEnd - The first face to exclude 3326 . faceGeometry - A local vector with face geometry 3327 - cellGeometry - A local vector with cell geometry 3328 3329 Output Parameters: 3330 + Nface - The number of faces with field values 3331 . fgeom - The extract the face centroid and normal 3332 - vol - The cell volume 3333 3334 Level: developer 3335 3336 .seealso: DMPlexGetCellFields() 3337 @*/ 3338 PetscErrorCode DMPlexGetFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscInt *Nface, PetscFVFaceGeom **fgeom, PetscReal **vol) 3339 { 3340 DM dmFace, dmCell; 3341 DMLabel ghostLabel; 3342 const PetscScalar *facegeom, *cellgeom; 3343 PetscInt dim, numFaces = fEnd - fStart, iface, face; 3344 PetscErrorCode ierr; 3345 3346 PetscFunctionBegin; 3347 PetscValidHeaderSpecific(dm, DM_CLASSID, 1); 3348 PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 4); 3349 PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 5); 3350 PetscValidPointer(fgeom, 6); 3351 PetscValidPointer(vol, 7); 3352 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 3353 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 3354 ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr); 3355 ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 3356 ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr); 3357 ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 3358 ierr = PetscMalloc1(numFaces, fgeom);CHKERRQ(ierr); 3359 ierr = DMGetWorkArray(dm, numFaces*2, MPIU_SCALAR, vol);CHKERRQ(ierr); 3360 for (face = fStart, iface = 0; face < fEnd; ++face) { 3361 const PetscInt *cells; 3362 PetscFVFaceGeom *fg; 3363 PetscFVCellGeom *cgL, *cgR; 3364 PetscFVFaceGeom *fgeoml = *fgeom; 3365 PetscReal *voll = *vol; 3366 PetscInt ghost, d, nchild, nsupp; 3367 3368 ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr); 3369 ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr); 3370 ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr); 3371 if (ghost >= 0 || nsupp > 2 || nchild > 0) continue; 3372 ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr); 3373 ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr); 3374 ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr); 3375 ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr); 3376 for (d = 0; d < dim; ++d) { 3377 fgeoml[iface].centroid[d] = fg->centroid[d]; 3378 fgeoml[iface].normal[d] = fg->normal[d]; 3379 } 3380 voll[iface*2+0] = cgL->volume; 3381 voll[iface*2+1] = cgR->volume; 3382 ++iface; 3383 } 3384 *Nface = iface; 3385 ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr); 3386 ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr); 3387 PetscFunctionReturn(0); 3388 } 3389 3390 /*@C 3391 DMPlexRestoreFaceGeometry - Restore the field values values for a chunk of faces 3392 3393 Input Parameters: 3394 + dm - The DM 3395 . fStart - The first face to include 3396 . fEnd - The first face to exclude 3397 . faceGeometry - A local vector with face geometry 3398 - cellGeometry - A local vector with cell geometry 3399 3400 Output Parameters: 3401 + Nface - The number of faces with field values 3402 . fgeom - The extract the face centroid and normal 3403 - vol - The cell volume 3404 3405 Level: developer 3406 3407 .seealso: DMPlexGetFaceFields() 3408 @*/ 3409 PetscErrorCode DMPlexRestoreFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscInt *Nface, PetscFVFaceGeom **fgeom, PetscReal **vol) 3410 { 3411 PetscErrorCode ierr; 3412 3413 PetscFunctionBegin; 3414 ierr = PetscFree(*fgeom);CHKERRQ(ierr); 3415 ierr = DMRestoreWorkArray(dm, 0, MPIU_REAL, vol);CHKERRQ(ierr); 3416 PetscFunctionReturn(0); 3417 } 3418 3419 PetscErrorCode DMSNESGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom) 3420 { 3421 char composeStr[33] = {0}; 3422 PetscObjectId id; 3423 PetscContainer container; 3424 PetscErrorCode ierr; 3425 3426 PetscFunctionBegin; 3427 ierr = PetscObjectGetId((PetscObject)quad,&id);CHKERRQ(ierr); 3428 ierr = PetscSNPrintf(composeStr, 32, "DMSNESGetFEGeom_%x\n", id);CHKERRQ(ierr); 3429 ierr = PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);CHKERRQ(ierr); 3430 if (container) { 3431 ierr = PetscContainerGetPointer(container, (void **) geom);CHKERRQ(ierr); 3432 } else { 3433 ierr = DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);CHKERRQ(ierr); 3434 ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr); 3435 ierr = PetscContainerSetPointer(container, (void *) *geom);CHKERRQ(ierr); 3436 ierr = PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);CHKERRQ(ierr); 3437 ierr = PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);CHKERRQ(ierr); 3438 ierr = PetscContainerDestroy(&container);CHKERRQ(ierr); 3439 } 3440 PetscFunctionReturn(0); 3441 } 3442 3443 PetscErrorCode DMSNESRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom) 3444 { 3445 PetscFunctionBegin; 3446 *geom = NULL; 3447 PetscFunctionReturn(0); 3448 } 3449 3450 PetscErrorCode DMPlexComputeResidual_Patch_Internal(DM dm, PetscSection section, IS cellIS, PetscReal t, Vec locX, Vec locX_t, Vec locF, void *user) 3451 { 3452 DM_Plex *mesh = (DM_Plex *) dm->data; 3453 const char *name = "Residual"; 3454 DM dmAux = NULL; 3455 DMLabel ghostLabel = NULL; 3456 PetscDS prob = NULL; 3457 PetscDS probAux = NULL; 3458 PetscBool useFEM = PETSC_FALSE; 3459 PetscBool isImplicit = (locX_t || t == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE; 3460 DMField coordField = NULL; 3461 Vec locA; 3462 PetscScalar *u = NULL, *u_t, *a, *uL = NULL, *uR = NULL; 3463 IS chunkIS; 3464 const PetscInt *cells; 3465 PetscInt cStart, cEnd, numCells; 3466 PetscInt Nf, f, totDim, totDimAux, numChunks, cellChunkSize, chunk, fStart, fEnd; 3467 PetscInt maxDegree = PETSC_MAX_INT; 3468 PetscQuadrature affineQuad = NULL, *quads = NULL; 3469 PetscFEGeom *affineGeom = NULL, **geoms = NULL; 3470 PetscErrorCode ierr; 3471 3472 PetscFunctionBegin; 3473 ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 3474 /* FEM+FVM */ 3475 /* 1: Get sizes from dm and dmAux */ 3476 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr); 3477 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 3478 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 3479 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 3480 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr); 3481 if (locA) { 3482 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr); 3483 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 3484 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr); 3485 } 3486 /* 2: Get geometric data */ 3487 for (f = 0; f < Nf; ++f) { 3488 PetscObject obj; 3489 PetscClassId id; 3490 PetscBool fimp; 3491 3492 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr); 3493 if (isImplicit != fimp) continue; 3494 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3495 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3496 if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;} 3497 if (id == PETSCFV_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Use of FVM with PCPATCH not yet implemented"); 3498 } 3499 if (useFEM) { 3500 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 3501 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr); 3502 if (maxDegree <= 1) { 3503 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr); 3504 if (affineQuad) { 3505 ierr = DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 3506 } 3507 } else { 3508 ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr); 3509 for (f = 0; f < Nf; ++f) { 3510 PetscObject obj; 3511 PetscClassId id; 3512 PetscBool fimp; 3513 3514 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr); 3515 if (isImplicit != fimp) continue; 3516 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3517 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3518 if (id == PETSCFE_CLASSID) { 3519 PetscFE fe = (PetscFE) obj; 3520 3521 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr); 3522 ierr = PetscObjectReference((PetscObject)quads[f]);CHKERRQ(ierr); 3523 ierr = DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr); 3524 } 3525 } 3526 } 3527 } 3528 /* Loop over chunks */ 3529 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3530 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr); 3531 if (useFEM) {ierr = ISCreate(PETSC_COMM_SELF, &chunkIS);CHKERRQ(ierr);} 3532 numCells = cEnd - cStart; 3533 numChunks = 1; 3534 cellChunkSize = numCells/numChunks; 3535 numChunks = PetscMin(1,numCells); 3536 for (chunk = 0; chunk < numChunks; ++chunk) { 3537 PetscScalar *elemVec, *fluxL = NULL, *fluxR = NULL; 3538 PetscReal *vol = NULL; 3539 PetscFVFaceGeom *fgeom = NULL; 3540 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c; 3541 PetscInt numFaces = 0; 3542 3543 /* Extract field coefficients */ 3544 if (useFEM) { 3545 ierr = ISGetPointSubrange(chunkIS, cS, cE, cells);CHKERRQ(ierr); 3546 ierr = DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr); 3547 ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 3548 ierr = PetscMemzero(elemVec, numCells*totDim * sizeof(PetscScalar));CHKERRQ(ierr); 3549 } 3550 /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */ 3551 /* Loop over fields */ 3552 for (f = 0; f < Nf; ++f) { 3553 PetscObject obj; 3554 PetscClassId id; 3555 PetscBool fimp; 3556 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset; 3557 3558 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr); 3559 if (isImplicit != fimp) continue; 3560 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3561 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3562 if (id == PETSCFE_CLASSID) { 3563 PetscFE fe = (PetscFE) obj; 3564 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[f]; 3565 PetscFEGeom *chunkGeom = NULL; 3566 PetscQuadrature quad = affineQuad ? affineQuad : quads[f]; 3567 PetscInt Nq, Nb; 3568 3569 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 3570 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 3571 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 3572 blockSize = Nb; 3573 batchSize = numBlocks * blockSize; 3574 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 3575 numChunks = numCells / (numBatches*batchSize); 3576 Ne = numChunks*numBatches*batchSize; 3577 Nr = numCells % (numBatches*batchSize); 3578 offset = numCells - Nr; 3579 /* Integrate FE residual to get elemVec (need fields at quadrature points) */ 3580 /* 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) */ 3581 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr); 3582 ierr = PetscFEIntegrateResidual(fe, prob, f, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec);CHKERRQ(ierr); 3583 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 3584 ierr = PetscFEIntegrateResidual(fe, prob, f, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]);CHKERRQ(ierr); 3585 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr); 3586 } else if (id == PETSCFV_CLASSID) { 3587 PetscFV fv = (PetscFV) obj; 3588 3589 Ne = numFaces; 3590 /* Riemann solve over faces (need fields at face centroids) */ 3591 /* We need to evaluate FE fields at those coordinates */ 3592 ierr = PetscFVIntegrateRHSFunction(fv, prob, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR);CHKERRQ(ierr); 3593 } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %d", f); 3594 } 3595 /* Loop over domain */ 3596 if (useFEM) { 3597 /* Add elemVec to locX */ 3598 for (c = cS; c < cE; ++c) { 3599 const PetscInt cell = cells ? cells[c] : c; 3600 const PetscInt cind = c - cStart; 3601 3602 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);} 3603 if (ghostLabel) { 3604 PetscInt ghostVal; 3605 3606 ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr); 3607 if (ghostVal > 0) continue; 3608 } 3609 ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr); 3610 } 3611 } 3612 /* Handle time derivative */ 3613 if (locX_t) { 3614 PetscScalar *x_t, *fa; 3615 3616 ierr = VecGetArray(locF, &fa);CHKERRQ(ierr); 3617 ierr = VecGetArray(locX_t, &x_t);CHKERRQ(ierr); 3618 for (f = 0; f < Nf; ++f) { 3619 PetscFV fv; 3620 PetscObject obj; 3621 PetscClassId id; 3622 PetscInt pdim, d; 3623 3624 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr); 3625 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr); 3626 if (id != PETSCFV_CLASSID) continue; 3627 fv = (PetscFV) obj; 3628 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr); 3629 for (c = cS; c < cE; ++c) { 3630 const PetscInt cell = cells ? cells[c] : c; 3631 PetscScalar *u_t, *r; 3632 3633 if (ghostLabel) { 3634 PetscInt ghostVal; 3635 3636 ierr = DMLabelGetValue(ghostLabel, cell, &ghostVal);CHKERRQ(ierr); 3637 if (ghostVal > 0) continue; 3638 } 3639 ierr = DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t);CHKERRQ(ierr); 3640 ierr = DMPlexPointLocalFieldRef(dm, cell, f, fa, &r);CHKERRQ(ierr); 3641 for (d = 0; d < pdim; ++d) r[d] += u_t[d]; 3642 } 3643 } 3644 ierr = VecRestoreArray(locX_t, &x_t);CHKERRQ(ierr); 3645 ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr); 3646 } 3647 if (useFEM) { 3648 ierr = DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr); 3649 ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr); 3650 } 3651 } 3652 if (useFEM) {ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);} 3653 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3654 /* TODO Could include boundary residual here (see DMPlexComputeResidual_Internal) */ 3655 if (useFEM) { 3656 if (maxDegree <= 1) { 3657 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr); 3658 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr); 3659 } else { 3660 for (f = 0; f < Nf; ++f) { 3661 ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr); 3662 ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr); 3663 } 3664 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr); 3665 } 3666 } 3667 ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr); 3668 PetscFunctionReturn(0); 3669 } 3670 3671 /* 3672 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 3673 3674 X - The local solution vector 3675 X_t - The local solution time derviative vector, or NULL 3676 */ 3677 PetscErrorCode DMPlexComputeJacobian_Patch_Internal(DM dm, PetscSection section, PetscSection globalSection, IS cellIS, 3678 PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP, void *ctx) 3679 { 3680 DM_Plex *mesh = (DM_Plex *) dm->data; 3681 const char *name = "Jacobian", *nameP = "JacobianPre"; 3682 DM dmAux = NULL; 3683 PetscDS prob, probAux = NULL; 3684 PetscSection sectionAux = NULL; 3685 Vec A; 3686 DMField coordField; 3687 PetscFEGeom *cgeomFEM; 3688 PetscQuadrature qGeom = NULL; 3689 Mat J = Jac, JP = JacP; 3690 PetscScalar *work, *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL, *elemMatP = NULL, *elemMatD = NULL; 3691 PetscBool hasJac, hasPrec, hasDyn, assembleJac, isMatIS, isMatISP, *isFE, hasFV = PETSC_FALSE; 3692 const PetscInt *cells; 3693 PetscInt Nf, fieldI, fieldJ, maxDegree, numCells, cStart, cEnd, numChunks, chunkSize, chunk, totDim, totDimAux = 0, sz, wsz, off = 0, offCell = 0; 3694 PetscErrorCode ierr; 3695 3696 PetscFunctionBegin; 3697 CHKMEMQ; 3698 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr); 3699 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr); 3700 ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 3701 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr); 3702 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr); 3703 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr); 3704 if (dmAux) { 3705 ierr = DMGetDefaultSection(dmAux, §ionAux);CHKERRQ(ierr); 3706 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr); 3707 } 3708 /* Get flags */ 3709 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr); 3710 ierr = DMGetWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr); 3711 for (fieldI = 0; fieldI < Nf; ++fieldI) { 3712 PetscObject disc; 3713 PetscClassId id; 3714 ierr = PetscDSGetDiscretization(prob, fieldI, &disc);CHKERRQ(ierr); 3715 ierr = PetscObjectGetClassId(disc, &id);CHKERRQ(ierr); 3716 if (id == PETSCFE_CLASSID) {isFE[fieldI] = PETSC_TRUE;} 3717 else if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; isFE[fieldI] = PETSC_FALSE;} 3718 } 3719 ierr = PetscDSHasJacobian(prob, &hasJac);CHKERRQ(ierr); 3720 ierr = PetscDSHasJacobianPreconditioner(prob, &hasPrec);CHKERRQ(ierr); 3721 ierr = PetscDSHasDynamicJacobian(prob, &hasDyn);CHKERRQ(ierr); 3722 assembleJac = hasJac && hasPrec && (Jac != JacP) ? PETSC_TRUE : PETSC_FALSE; 3723 hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE; 3724 ierr = PetscObjectTypeCompare((PetscObject) Jac, MATIS, &isMatIS);CHKERRQ(ierr); 3725 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr); 3726 /* Setup input data and temp arrays (should be DMGetWorkArray) */ 3727 if (isMatISP || isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &globalSection);CHKERRQ(ierr);} 3728 if (isMatIS) {ierr = MatISGetLocalMat(Jac, &J);CHKERRQ(ierr);} 3729 if (isMatISP) {ierr = MatISGetLocalMat(JacP, &JP);CHKERRQ(ierr);} 3730 if (hasFV) {ierr = MatSetOption(JP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE);CHKERRQ(ierr);} /* No allocated space for FV stuff, so ignore the zero entries */ 3731 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr); 3732 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr); 3733 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr); 3734 if (probAux) {ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);} 3735 CHKMEMQ; 3736 /* Compute batch sizes */ 3737 if (isFE[0]) { 3738 PetscFE fe; 3739 PetscQuadrature q; 3740 PetscInt numQuadPoints, numBatches, batchSize, numBlocks, blockSize, Nb; 3741 3742 ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr); 3743 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr); 3744 ierr = PetscQuadratureGetData(q, NULL, NULL, &numQuadPoints, NULL, NULL);CHKERRQ(ierr); 3745 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr); 3746 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr); 3747 blockSize = Nb*numQuadPoints; 3748 batchSize = numBlocks * blockSize; 3749 chunkSize = numBatches * batchSize; 3750 numChunks = numCells / chunkSize + numCells % chunkSize; 3751 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr); 3752 } else { 3753 chunkSize = numCells; 3754 numChunks = 1; 3755 } 3756 /* Get work space */ 3757 wsz = (((X?1:0) + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize; 3758 ierr = DMGetWorkArray(dm, wsz, MPIU_SCALAR, &work);CHKERRQ(ierr); 3759 ierr = PetscMemzero(work, wsz * sizeof(PetscScalar));CHKERRQ(ierr); 3760 off = 0; 3761 u = X ? (sz = chunkSize*totDim, off += sz, work+off-sz) : NULL; 3762 u_t = X_t ? (sz = chunkSize*totDim, off += sz, work+off-sz) : NULL; 3763 a = dmAux ? (sz = chunkSize*totDimAux, off += sz, work+off-sz) : NULL; 3764 elemMat = hasJac ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL; 3765 elemMatP = hasPrec ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL; 3766 elemMatD = hasDyn ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL; 3767 if (off != wsz) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Error is workspace size %D should be %D", off, wsz); 3768 /* Setup geometry */ 3769 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr); 3770 ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr); 3771 if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, cellIS, &qGeom);CHKERRQ(ierr);} 3772 if (!qGeom) { 3773 PetscFE fe; 3774 3775 ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr); 3776 ierr = PetscFEGetQuadrature(fe, &qGeom);CHKERRQ(ierr); 3777 ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr); 3778 } 3779 ierr = DMSNESGetFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr); 3780 /* Compute volume integrals */ 3781 if (assembleJac) {ierr = MatZeroEntries(J);CHKERRQ(ierr);} 3782 ierr = MatZeroEntries(JP);CHKERRQ(ierr); 3783 for (chunk = 0; chunk < numChunks; ++chunk, offCell += chunkSize) { 3784 const PetscInt Ncell = PetscMin(chunkSize, numCells - offCell); 3785 PetscInt c; 3786 3787 /* Extract values */ 3788 for (c = 0; c < Ncell; ++c) { 3789 const PetscInt cell = cells ? cells[c+offCell] : c+offCell; 3790 PetscScalar *x = NULL, *x_t = NULL; 3791 PetscInt i; 3792 3793 if (X) { 3794 ierr = DMPlexVecGetClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr); 3795 for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i]; 3796 ierr = DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr); 3797 } 3798 if (X_t) { 3799 ierr = DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 3800 for (i = 0; i < totDim; ++i) u_t[c*totDim+i] = x_t[i]; 3801 ierr = DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr); 3802 } 3803 if (dmAux) { 3804 ierr = DMPlexVecGetClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr); 3805 for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i]; 3806 ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr); 3807 } 3808 } 3809 CHKMEMQ; 3810 for (fieldI = 0; fieldI < Nf; ++fieldI) { 3811 PetscFE fe; 3812 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 3813 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) { 3814 if (hasJac) {ierr = PetscFEIntegrateJacobian(fe, prob, PETSCFE_JACOBIAN, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);} 3815 if (hasPrec) {ierr = PetscFEIntegrateJacobian(fe, prob, PETSCFE_JACOBIAN_PRE, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr);} 3816 if (hasDyn) {ierr = PetscFEIntegrateJacobian(fe, prob, PETSCFE_JACOBIAN_DYN, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatD);CHKERRQ(ierr);} 3817 } 3818 /* For finite volume, add the identity */ 3819 if (!isFE[fieldI]) { 3820 PetscFV fv; 3821 PetscInt eOffset = 0, Nc, fc, foff; 3822 3823 ierr = PetscDSGetFieldOffset(prob, fieldI, &foff);CHKERRQ(ierr); 3824 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv);CHKERRQ(ierr); 3825 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr); 3826 for (c = 0; c < chunkSize; ++c, eOffset += totDim*totDim) { 3827 for (fc = 0; fc < Nc; ++fc) { 3828 const PetscInt i = foff + fc; 3829 if (hasJac) {elemMat [eOffset+i*totDim+i] = 1.0;} 3830 if (hasPrec) {elemMatP[eOffset+i*totDim+i] = 1.0;} 3831 } 3832 } 3833 } 3834 } 3835 CHKMEMQ; 3836 /* Add contribution from X_t */ 3837 if (hasDyn) {for (c = 0; c < chunkSize*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];} 3838 /* Insert values into matrix */ 3839 for (c = 0; c < Ncell; ++c) { 3840 const PetscInt cell = cells ? cells[c+offCell] : c+offCell; 3841 if (mesh->printFEM > 1) { 3842 if (hasJac) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);} 3843 if (hasPrec) {ierr = DMPrintCellMatrix(cell, nameP, totDim, totDim, &elemMatP[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);} 3844 } 3845 if (assembleJac) {ierr = DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);} 3846 ierr = DMPlexMatSetClosure(dm, section, globalSection, JP, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr); 3847 } 3848 CHKMEMQ; 3849 } 3850 /* Cleanup */ 3851 ierr = DMSNESRestoreFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr); 3852 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr); 3853 if (hasFV) {ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);} 3854 ierr = DMRestoreWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr); 3855 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); 3856 /* Compute boundary integrals */ 3857 /* ierr = DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, ctx);CHKERRQ(ierr); */ 3858 /* Assemble matrix */ 3859 if (assembleJac) {ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);} 3860 ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3861 ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr); 3862 CHKMEMQ; 3863 PetscFunctionReturn(0); 3864 } 3865