1 /* Basis Jet Tabulation 2 3 We would like to tabulate the nodal basis functions and derivatives at a set of points, usually quadrature points. We 4 follow here the derviation in http://www.math.ttu.edu/~kirby/papers/fiat-toms-2004.pdf. The nodal basis $\psi_i$ can 5 be expressed in terms of a prime basis $\phi_i$ which can be stably evaluated. In PETSc, we will use the Legendre basis 6 as a prime basis. 7 8 \psi_i = \sum_k \alpha_{ki} \phi_k 9 10 Our nodal basis is defined in terms of the dual basis $n_j$ 11 12 n_j \cdot \psi_i = \delta_{ji} 13 14 and we may act on the first equation to obtain 15 16 n_j \cdot \psi_i = \sum_k \alpha_{ki} n_j \cdot \phi_k 17 \delta_{ji} = \sum_k \alpha_{ki} V_{jk} 18 I = V \alpha 19 20 so the coefficients of the nodal basis in the prime basis are 21 22 \alpha = V^{-1} 23 24 We will define the dual basis vectors $n_j$ using a quadrature rule. 25 26 Right now, we will just use the polynomial spaces P^k. I know some elements use the space of symmetric polynomials 27 (I think Nedelec), but we will neglect this for now. Constraints in the space, e.g. Arnold-Winther elements, can 28 be implemented exactly as in FIAT using functionals $L_j$. 29 30 I will have to count the degrees correctly for the Legendre product when we are on simplices. 31 32 We will have three objects: 33 - Space, P: this just need point evaluation I think 34 - Dual Space, P'+K: This looks like a set of functionals that can act on members of P, each n is defined by a Q 35 - FEM: This keeps {P, P', Q} 36 */ 37 #include <petsc/private/petscfeimpl.h> /*I "petscfe.h" I*/ 38 #include <petscdmplex.h> 39 40 PetscBool FEcite = PETSC_FALSE; 41 const char FECitation[] = "@article{kirby2004,\n" 42 " title = {Algorithm 839: FIAT, a New Paradigm for Computing Finite Element Basis Functions},\n" 43 " journal = {ACM Transactions on Mathematical Software},\n" 44 " author = {Robert C. Kirby},\n" 45 " volume = {30},\n" 46 " number = {4},\n" 47 " pages = {502--516},\n" 48 " doi = {10.1145/1039813.1039820},\n" 49 " year = {2004}\n}\n"; 50 51 PetscClassId PETSCFE_CLASSID = 0; 52 53 PetscFunctionList PetscFEList = NULL; 54 PetscBool PetscFERegisterAllCalled = PETSC_FALSE; 55 56 /*@C 57 PetscFERegister - Adds a new PetscFE implementation 58 59 Not Collective 60 61 Input Parameters: 62 + name - The name of a new user-defined creation routine 63 - create_func - The creation routine itself 64 65 Notes: 66 PetscFERegister() may be called multiple times to add several user-defined PetscFEs 67 68 Sample usage: 69 .vb 70 PetscFERegister("my_fe", MyPetscFECreate); 71 .ve 72 73 Then, your PetscFE type can be chosen with the procedural interface via 74 .vb 75 PetscFECreate(MPI_Comm, PetscFE *); 76 PetscFESetType(PetscFE, "my_fe"); 77 .ve 78 or at runtime via the option 79 .vb 80 -petscfe_type my_fe 81 .ve 82 83 Level: advanced 84 85 .seealso: PetscFERegisterAll(), PetscFERegisterDestroy() 86 87 @*/ 88 PetscErrorCode PetscFERegister(const char sname[], PetscErrorCode (*function)(PetscFE)) 89 { 90 PetscErrorCode ierr; 91 92 PetscFunctionBegin; 93 ierr = PetscFunctionListAdd(&PetscFEList, sname, function);CHKERRQ(ierr); 94 PetscFunctionReturn(0); 95 } 96 97 /*@C 98 PetscFESetType - Builds a particular PetscFE 99 100 Collective on fem 101 102 Input Parameters: 103 + fem - The PetscFE object 104 - name - The kind of FEM space 105 106 Options Database Key: 107 . -petscfe_type <type> - Sets the PetscFE type; use -help for a list of available types 108 109 Level: intermediate 110 111 .seealso: PetscFEGetType(), PetscFECreate() 112 @*/ 113 PetscErrorCode PetscFESetType(PetscFE fem, PetscFEType name) 114 { 115 PetscErrorCode (*r)(PetscFE); 116 PetscBool match; 117 PetscErrorCode ierr; 118 119 PetscFunctionBegin; 120 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 121 ierr = PetscObjectTypeCompare((PetscObject) fem, name, &match);CHKERRQ(ierr); 122 if (match) PetscFunctionReturn(0); 123 124 if (!PetscFERegisterAllCalled) {ierr = PetscFERegisterAll();CHKERRQ(ierr);} 125 ierr = PetscFunctionListFind(PetscFEList, name, &r);CHKERRQ(ierr); 126 if (!r) SETERRQ1(PetscObjectComm((PetscObject) fem), PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown PetscFE type: %s", name); 127 128 if (fem->ops->destroy) { 129 ierr = (*fem->ops->destroy)(fem);CHKERRQ(ierr); 130 fem->ops->destroy = NULL; 131 } 132 ierr = (*r)(fem);CHKERRQ(ierr); 133 ierr = PetscObjectChangeTypeName((PetscObject) fem, name);CHKERRQ(ierr); 134 PetscFunctionReturn(0); 135 } 136 137 /*@C 138 PetscFEGetType - Gets the PetscFE type name (as a string) from the object. 139 140 Not Collective 141 142 Input Parameter: 143 . fem - The PetscFE 144 145 Output Parameter: 146 . name - The PetscFE type name 147 148 Level: intermediate 149 150 .seealso: PetscFESetType(), PetscFECreate() 151 @*/ 152 PetscErrorCode PetscFEGetType(PetscFE fem, PetscFEType *name) 153 { 154 PetscErrorCode ierr; 155 156 PetscFunctionBegin; 157 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 158 PetscValidPointer(name, 2); 159 if (!PetscFERegisterAllCalled) { 160 ierr = PetscFERegisterAll();CHKERRQ(ierr); 161 } 162 *name = ((PetscObject) fem)->type_name; 163 PetscFunctionReturn(0); 164 } 165 166 /*@C 167 PetscFEViewFromOptions - View from Options 168 169 Collective on PetscFE 170 171 Input Parameters: 172 + A - the PetscFE object 173 . obj - Optional object 174 - name - command line option 175 176 Level: intermediate 177 .seealso: PetscFE(), PetscFEView(), PetscObjectViewFromOptions(), PetscFECreate() 178 @*/ 179 PetscErrorCode PetscFEViewFromOptions(PetscFE A,PetscObject obj,const char name[]) 180 { 181 PetscErrorCode ierr; 182 183 PetscFunctionBegin; 184 PetscValidHeaderSpecific(A,PETSCFE_CLASSID,1); 185 ierr = PetscObjectViewFromOptions((PetscObject)A,obj,name);CHKERRQ(ierr); 186 PetscFunctionReturn(0); 187 } 188 189 /*@C 190 PetscFEView - Views a PetscFE 191 192 Collective on fem 193 194 Input Parameter: 195 + fem - the PetscFE object to view 196 - viewer - the viewer 197 198 Level: beginner 199 200 .seealso PetscFEDestroy() 201 @*/ 202 PetscErrorCode PetscFEView(PetscFE fem, PetscViewer viewer) 203 { 204 PetscBool iascii; 205 PetscErrorCode ierr; 206 207 PetscFunctionBegin; 208 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 209 if (viewer) PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2); 210 if (!viewer) {ierr = PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) fem), &viewer);CHKERRQ(ierr);} 211 ierr = PetscObjectPrintClassNamePrefixType((PetscObject)fem, viewer);CHKERRQ(ierr); 212 ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr); 213 if (fem->ops->view) {ierr = (*fem->ops->view)(fem, viewer);CHKERRQ(ierr);} 214 PetscFunctionReturn(0); 215 } 216 217 /*@ 218 PetscFESetFromOptions - sets parameters in a PetscFE from the options database 219 220 Collective on fem 221 222 Input Parameter: 223 . fem - the PetscFE object to set options for 224 225 Options Database: 226 + -petscfe_num_blocks - the number of cell blocks to integrate concurrently 227 - -petscfe_num_batches - the number of cell batches to integrate serially 228 229 Level: intermediate 230 231 .seealso PetscFEView() 232 @*/ 233 PetscErrorCode PetscFESetFromOptions(PetscFE fem) 234 { 235 const char *defaultType; 236 char name[256]; 237 PetscBool flg; 238 PetscErrorCode ierr; 239 240 PetscFunctionBegin; 241 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 242 if (!((PetscObject) fem)->type_name) { 243 defaultType = PETSCFEBASIC; 244 } else { 245 defaultType = ((PetscObject) fem)->type_name; 246 } 247 if (!PetscFERegisterAllCalled) {ierr = PetscFERegisterAll();CHKERRQ(ierr);} 248 249 ierr = PetscObjectOptionsBegin((PetscObject) fem);CHKERRQ(ierr); 250 ierr = PetscOptionsFList("-petscfe_type", "Finite element space", "PetscFESetType", PetscFEList, defaultType, name, 256, &flg);CHKERRQ(ierr); 251 if (flg) { 252 ierr = PetscFESetType(fem, name);CHKERRQ(ierr); 253 } else if (!((PetscObject) fem)->type_name) { 254 ierr = PetscFESetType(fem, defaultType);CHKERRQ(ierr); 255 } 256 ierr = PetscOptionsBoundedInt("-petscfe_num_blocks", "The number of cell blocks to integrate concurrently", "PetscSpaceSetTileSizes", fem->numBlocks, &fem->numBlocks, NULL,1);CHKERRQ(ierr); 257 ierr = PetscOptionsBoundedInt("-petscfe_num_batches", "The number of cell batches to integrate serially", "PetscSpaceSetTileSizes", fem->numBatches, &fem->numBatches, NULL,1);CHKERRQ(ierr); 258 if (fem->ops->setfromoptions) { 259 ierr = (*fem->ops->setfromoptions)(PetscOptionsObject,fem);CHKERRQ(ierr); 260 } 261 /* process any options handlers added with PetscObjectAddOptionsHandler() */ 262 ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) fem);CHKERRQ(ierr); 263 ierr = PetscOptionsEnd();CHKERRQ(ierr); 264 ierr = PetscFEViewFromOptions(fem, NULL, "-petscfe_view");CHKERRQ(ierr); 265 PetscFunctionReturn(0); 266 } 267 268 /*@C 269 PetscFESetUp - Construct data structures for the PetscFE 270 271 Collective on fem 272 273 Input Parameter: 274 . fem - the PetscFE object to setup 275 276 Level: intermediate 277 278 .seealso PetscFEView(), PetscFEDestroy() 279 @*/ 280 PetscErrorCode PetscFESetUp(PetscFE fem) 281 { 282 PetscErrorCode ierr; 283 284 PetscFunctionBegin; 285 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 286 if (fem->setupcalled) PetscFunctionReturn(0); 287 fem->setupcalled = PETSC_TRUE; 288 if (fem->ops->setup) {ierr = (*fem->ops->setup)(fem);CHKERRQ(ierr);} 289 PetscFunctionReturn(0); 290 } 291 292 /*@ 293 PetscFEDestroy - Destroys a PetscFE object 294 295 Collective on fem 296 297 Input Parameter: 298 . fem - the PetscFE object to destroy 299 300 Level: beginner 301 302 .seealso PetscFEView() 303 @*/ 304 PetscErrorCode PetscFEDestroy(PetscFE *fem) 305 { 306 PetscErrorCode ierr; 307 308 PetscFunctionBegin; 309 if (!*fem) PetscFunctionReturn(0); 310 PetscValidHeaderSpecific((*fem), PETSCFE_CLASSID, 1); 311 312 if (--((PetscObject)(*fem))->refct > 0) {*fem = 0; PetscFunctionReturn(0);} 313 ((PetscObject) (*fem))->refct = 0; 314 315 if ((*fem)->subspaces) { 316 PetscInt dim, d; 317 318 ierr = PetscDualSpaceGetDimension((*fem)->dualSpace, &dim);CHKERRQ(ierr); 319 for (d = 0; d < dim; ++d) {ierr = PetscFEDestroy(&(*fem)->subspaces[d]);CHKERRQ(ierr);} 320 } 321 ierr = PetscFree((*fem)->subspaces);CHKERRQ(ierr); 322 ierr = PetscFree((*fem)->invV);CHKERRQ(ierr); 323 ierr = PetscTabulationDestroy(&(*fem)->T);CHKERRQ(ierr); 324 ierr = PetscTabulationDestroy(&(*fem)->Tf);CHKERRQ(ierr); 325 ierr = PetscTabulationDestroy(&(*fem)->Tc);CHKERRQ(ierr); 326 ierr = PetscSpaceDestroy(&(*fem)->basisSpace);CHKERRQ(ierr); 327 ierr = PetscDualSpaceDestroy(&(*fem)->dualSpace);CHKERRQ(ierr); 328 ierr = PetscQuadratureDestroy(&(*fem)->quadrature);CHKERRQ(ierr); 329 ierr = PetscQuadratureDestroy(&(*fem)->faceQuadrature);CHKERRQ(ierr); 330 331 if ((*fem)->ops->destroy) {ierr = (*(*fem)->ops->destroy)(*fem);CHKERRQ(ierr);} 332 ierr = PetscHeaderDestroy(fem);CHKERRQ(ierr); 333 PetscFunctionReturn(0); 334 } 335 336 /*@ 337 PetscFECreate - Creates an empty PetscFE object. The type can then be set with PetscFESetType(). 338 339 Collective 340 341 Input Parameter: 342 . comm - The communicator for the PetscFE object 343 344 Output Parameter: 345 . fem - The PetscFE object 346 347 Level: beginner 348 349 .seealso: PetscFESetType(), PETSCFEGALERKIN 350 @*/ 351 PetscErrorCode PetscFECreate(MPI_Comm comm, PetscFE *fem) 352 { 353 PetscFE f; 354 PetscErrorCode ierr; 355 356 PetscFunctionBegin; 357 PetscValidPointer(fem, 2); 358 ierr = PetscCitationsRegister(FECitation,&FEcite);CHKERRQ(ierr); 359 *fem = NULL; 360 ierr = PetscFEInitializePackage();CHKERRQ(ierr); 361 362 ierr = PetscHeaderCreate(f, PETSCFE_CLASSID, "PetscFE", "Finite Element", "PetscFE", comm, PetscFEDestroy, PetscFEView);CHKERRQ(ierr); 363 364 f->basisSpace = NULL; 365 f->dualSpace = NULL; 366 f->numComponents = 1; 367 f->subspaces = NULL; 368 f->invV = NULL; 369 f->T = NULL; 370 f->Tf = NULL; 371 f->Tc = NULL; 372 ierr = PetscArrayzero(&f->quadrature, 1);CHKERRQ(ierr); 373 ierr = PetscArrayzero(&f->faceQuadrature, 1);CHKERRQ(ierr); 374 f->blockSize = 0; 375 f->numBlocks = 1; 376 f->batchSize = 0; 377 f->numBatches = 1; 378 379 *fem = f; 380 PetscFunctionReturn(0); 381 } 382 383 /*@ 384 PetscFEGetSpatialDimension - Returns the spatial dimension of the element 385 386 Not collective 387 388 Input Parameter: 389 . fem - The PetscFE object 390 391 Output Parameter: 392 . dim - The spatial dimension 393 394 Level: intermediate 395 396 .seealso: PetscFECreate() 397 @*/ 398 PetscErrorCode PetscFEGetSpatialDimension(PetscFE fem, PetscInt *dim) 399 { 400 DM dm; 401 PetscErrorCode ierr; 402 403 PetscFunctionBegin; 404 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 405 PetscValidPointer(dim, 2); 406 ierr = PetscDualSpaceGetDM(fem->dualSpace, &dm);CHKERRQ(ierr); 407 ierr = DMGetDimension(dm, dim);CHKERRQ(ierr); 408 PetscFunctionReturn(0); 409 } 410 411 /*@ 412 PetscFESetNumComponents - Sets the number of components in the element 413 414 Not collective 415 416 Input Parameters: 417 + fem - The PetscFE object 418 - comp - The number of field components 419 420 Level: intermediate 421 422 .seealso: PetscFECreate() 423 @*/ 424 PetscErrorCode PetscFESetNumComponents(PetscFE fem, PetscInt comp) 425 { 426 PetscFunctionBegin; 427 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 428 fem->numComponents = comp; 429 PetscFunctionReturn(0); 430 } 431 432 /*@ 433 PetscFEGetNumComponents - Returns the number of components in the element 434 435 Not collective 436 437 Input Parameter: 438 . fem - The PetscFE object 439 440 Output Parameter: 441 . comp - The number of field components 442 443 Level: intermediate 444 445 .seealso: PetscFECreate() 446 @*/ 447 PetscErrorCode PetscFEGetNumComponents(PetscFE fem, PetscInt *comp) 448 { 449 PetscFunctionBegin; 450 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 451 PetscValidPointer(comp, 2); 452 *comp = fem->numComponents; 453 PetscFunctionReturn(0); 454 } 455 456 /*@ 457 PetscFESetTileSizes - Sets the tile sizes for evaluation 458 459 Not collective 460 461 Input Parameters: 462 + fem - The PetscFE object 463 . blockSize - The number of elements in a block 464 . numBlocks - The number of blocks in a batch 465 . batchSize - The number of elements in a batch 466 - numBatches - The number of batches in a chunk 467 468 Level: intermediate 469 470 .seealso: PetscFECreate() 471 @*/ 472 PetscErrorCode PetscFESetTileSizes(PetscFE fem, PetscInt blockSize, PetscInt numBlocks, PetscInt batchSize, PetscInt numBatches) 473 { 474 PetscFunctionBegin; 475 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 476 fem->blockSize = blockSize; 477 fem->numBlocks = numBlocks; 478 fem->batchSize = batchSize; 479 fem->numBatches = numBatches; 480 PetscFunctionReturn(0); 481 } 482 483 /*@ 484 PetscFEGetTileSizes - Returns the tile sizes for evaluation 485 486 Not collective 487 488 Input Parameter: 489 . fem - The PetscFE object 490 491 Output Parameters: 492 + blockSize - The number of elements in a block 493 . numBlocks - The number of blocks in a batch 494 . batchSize - The number of elements in a batch 495 - numBatches - The number of batches in a chunk 496 497 Level: intermediate 498 499 .seealso: PetscFECreate() 500 @*/ 501 PetscErrorCode PetscFEGetTileSizes(PetscFE fem, PetscInt *blockSize, PetscInt *numBlocks, PetscInt *batchSize, PetscInt *numBatches) 502 { 503 PetscFunctionBegin; 504 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 505 if (blockSize) PetscValidPointer(blockSize, 2); 506 if (numBlocks) PetscValidPointer(numBlocks, 3); 507 if (batchSize) PetscValidPointer(batchSize, 4); 508 if (numBatches) PetscValidPointer(numBatches, 5); 509 if (blockSize) *blockSize = fem->blockSize; 510 if (numBlocks) *numBlocks = fem->numBlocks; 511 if (batchSize) *batchSize = fem->batchSize; 512 if (numBatches) *numBatches = fem->numBatches; 513 PetscFunctionReturn(0); 514 } 515 516 /*@ 517 PetscFEGetBasisSpace - Returns the PetscSpace used for approximation of the solution 518 519 Not collective 520 521 Input Parameter: 522 . fem - The PetscFE object 523 524 Output Parameter: 525 . sp - The PetscSpace object 526 527 Level: intermediate 528 529 .seealso: PetscFECreate() 530 @*/ 531 PetscErrorCode PetscFEGetBasisSpace(PetscFE fem, PetscSpace *sp) 532 { 533 PetscFunctionBegin; 534 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 535 PetscValidPointer(sp, 2); 536 *sp = fem->basisSpace; 537 PetscFunctionReturn(0); 538 } 539 540 /*@ 541 PetscFESetBasisSpace - Sets the PetscSpace used for approximation of the solution 542 543 Not collective 544 545 Input Parameters: 546 + fem - The PetscFE object 547 - sp - The PetscSpace object 548 549 Level: intermediate 550 551 .seealso: PetscFECreate() 552 @*/ 553 PetscErrorCode PetscFESetBasisSpace(PetscFE fem, PetscSpace sp) 554 { 555 PetscErrorCode ierr; 556 557 PetscFunctionBegin; 558 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 559 PetscValidHeaderSpecific(sp, PETSCSPACE_CLASSID, 2); 560 ierr = PetscSpaceDestroy(&fem->basisSpace);CHKERRQ(ierr); 561 fem->basisSpace = sp; 562 ierr = PetscObjectReference((PetscObject) fem->basisSpace);CHKERRQ(ierr); 563 PetscFunctionReturn(0); 564 } 565 566 /*@ 567 PetscFEGetDualSpace - Returns the PetscDualSpace used to define the inner product 568 569 Not collective 570 571 Input Parameter: 572 . fem - The PetscFE object 573 574 Output Parameter: 575 . sp - The PetscDualSpace object 576 577 Level: intermediate 578 579 .seealso: PetscFECreate() 580 @*/ 581 PetscErrorCode PetscFEGetDualSpace(PetscFE fem, PetscDualSpace *sp) 582 { 583 PetscFunctionBegin; 584 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 585 PetscValidPointer(sp, 2); 586 *sp = fem->dualSpace; 587 PetscFunctionReturn(0); 588 } 589 590 /*@ 591 PetscFESetDualSpace - Sets the PetscDualSpace used to define the inner product 592 593 Not collective 594 595 Input Parameters: 596 + fem - The PetscFE object 597 - sp - The PetscDualSpace object 598 599 Level: intermediate 600 601 .seealso: PetscFECreate() 602 @*/ 603 PetscErrorCode PetscFESetDualSpace(PetscFE fem, PetscDualSpace sp) 604 { 605 PetscErrorCode ierr; 606 607 PetscFunctionBegin; 608 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 609 PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 2); 610 ierr = PetscDualSpaceDestroy(&fem->dualSpace);CHKERRQ(ierr); 611 fem->dualSpace = sp; 612 ierr = PetscObjectReference((PetscObject) fem->dualSpace);CHKERRQ(ierr); 613 PetscFunctionReturn(0); 614 } 615 616 /*@ 617 PetscFEGetQuadrature - Returns the PetscQuadrature used to calculate inner products 618 619 Not collective 620 621 Input Parameter: 622 . fem - The PetscFE object 623 624 Output Parameter: 625 . q - The PetscQuadrature object 626 627 Level: intermediate 628 629 .seealso: PetscFECreate() 630 @*/ 631 PetscErrorCode PetscFEGetQuadrature(PetscFE fem, PetscQuadrature *q) 632 { 633 PetscFunctionBegin; 634 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 635 PetscValidPointer(q, 2); 636 *q = fem->quadrature; 637 PetscFunctionReturn(0); 638 } 639 640 /*@ 641 PetscFESetQuadrature - Sets the PetscQuadrature used to calculate inner products 642 643 Not collective 644 645 Input Parameters: 646 + fem - The PetscFE object 647 - q - The PetscQuadrature object 648 649 Level: intermediate 650 651 .seealso: PetscFECreate() 652 @*/ 653 PetscErrorCode PetscFESetQuadrature(PetscFE fem, PetscQuadrature q) 654 { 655 PetscInt Nc, qNc; 656 PetscErrorCode ierr; 657 658 PetscFunctionBegin; 659 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 660 ierr = PetscFEGetNumComponents(fem, &Nc);CHKERRQ(ierr); 661 ierr = PetscQuadratureGetNumComponents(q, &qNc);CHKERRQ(ierr); 662 if ((qNc != 1) && (Nc != qNc)) SETERRQ2(PetscObjectComm((PetscObject) fem), PETSC_ERR_ARG_SIZ, "FE components %D != Quadrature components %D and non-scalar quadrature", Nc, qNc); 663 ierr = PetscTabulationDestroy(&fem->T);CHKERRQ(ierr); 664 ierr = PetscTabulationDestroy(&fem->Tc);CHKERRQ(ierr); 665 ierr = PetscQuadratureDestroy(&fem->quadrature);CHKERRQ(ierr); 666 fem->quadrature = q; 667 ierr = PetscObjectReference((PetscObject) q);CHKERRQ(ierr); 668 PetscFunctionReturn(0); 669 } 670 671 /*@ 672 PetscFEGetFaceQuadrature - Returns the PetscQuadrature used to calculate inner products on faces 673 674 Not collective 675 676 Input Parameter: 677 . fem - The PetscFE object 678 679 Output Parameter: 680 . q - The PetscQuadrature object 681 682 Level: intermediate 683 684 .seealso: PetscFECreate() 685 @*/ 686 PetscErrorCode PetscFEGetFaceQuadrature(PetscFE fem, PetscQuadrature *q) 687 { 688 PetscFunctionBegin; 689 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 690 PetscValidPointer(q, 2); 691 *q = fem->faceQuadrature; 692 PetscFunctionReturn(0); 693 } 694 695 /*@ 696 PetscFESetFaceQuadrature - Sets the PetscQuadrature used to calculate inner products on faces 697 698 Not collective 699 700 Input Parameters: 701 + fem - The PetscFE object 702 - q - The PetscQuadrature object 703 704 Level: intermediate 705 706 .seealso: PetscFECreate() 707 @*/ 708 PetscErrorCode PetscFESetFaceQuadrature(PetscFE fem, PetscQuadrature q) 709 { 710 PetscInt Nc, qNc; 711 PetscErrorCode ierr; 712 713 PetscFunctionBegin; 714 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 715 ierr = PetscFEGetNumComponents(fem, &Nc);CHKERRQ(ierr); 716 ierr = PetscQuadratureGetNumComponents(q, &qNc);CHKERRQ(ierr); 717 if ((qNc != 1) && (Nc != qNc)) SETERRQ2(PetscObjectComm((PetscObject) fem), PETSC_ERR_ARG_SIZ, "FE components %D != Quadrature components %D and non-scalar quadrature", Nc, qNc); 718 ierr = PetscTabulationDestroy(&fem->Tf);CHKERRQ(ierr); 719 ierr = PetscQuadratureDestroy(&fem->faceQuadrature);CHKERRQ(ierr); 720 fem->faceQuadrature = q; 721 ierr = PetscObjectReference((PetscObject) q);CHKERRQ(ierr); 722 PetscFunctionReturn(0); 723 } 724 725 /*@ 726 PetscFECopyQuadrature - Copy both volumetric and surface quadrature 727 728 Not collective 729 730 Input Parameters: 731 + sfe - The PetscFE source for the quadratures 732 - tfe - The PetscFE target for the quadratures 733 734 Level: intermediate 735 736 .seealso: PetscFECreate(), PetscFESetQuadrature(), PetscFESetFaceQuadrature() 737 @*/ 738 PetscErrorCode PetscFECopyQuadrature(PetscFE sfe, PetscFE tfe) 739 { 740 PetscQuadrature q; 741 PetscErrorCode ierr; 742 743 PetscFunctionBegin; 744 PetscValidHeaderSpecific(sfe, PETSCFE_CLASSID, 1); 745 PetscValidHeaderSpecific(tfe, PETSCFE_CLASSID, 2); 746 ierr = PetscFEGetQuadrature(sfe, &q);CHKERRQ(ierr); 747 ierr = PetscFESetQuadrature(tfe, q);CHKERRQ(ierr); 748 ierr = PetscFEGetFaceQuadrature(sfe, &q);CHKERRQ(ierr); 749 ierr = PetscFESetFaceQuadrature(tfe, q);CHKERRQ(ierr); 750 PetscFunctionReturn(0); 751 } 752 753 /*@C 754 PetscFEGetNumDof - Returns the number of dofs (dual basis vectors) associated to mesh points on the reference cell of a given dimension 755 756 Not collective 757 758 Input Parameter: 759 . fem - The PetscFE object 760 761 Output Parameter: 762 . numDof - Array with the number of dofs per dimension 763 764 Level: intermediate 765 766 .seealso: PetscFECreate() 767 @*/ 768 PetscErrorCode PetscFEGetNumDof(PetscFE fem, const PetscInt **numDof) 769 { 770 PetscErrorCode ierr; 771 772 PetscFunctionBegin; 773 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 774 PetscValidPointer(numDof, 2); 775 ierr = PetscDualSpaceGetNumDof(fem->dualSpace, numDof);CHKERRQ(ierr); 776 PetscFunctionReturn(0); 777 } 778 779 /*@C 780 PetscFEGetCellTabulation - Returns the tabulation of the basis functions at the quadrature points on the reference cell 781 782 Not collective 783 784 Input Parameter: 785 . fem - The PetscFE object 786 787 Output Parameter: 788 . T - The basis function values and derivatives at quadrature points 789 790 Note: 791 $ T->T[0] = B[(p*pdim + i)*Nc + c] is the value at point p for basis function i and component c 792 $ T->T[1] = D[((p*pdim + i)*Nc + c)*dim + d] is the derivative value at point p for basis function i, component c, in direction d 793 $ T->T[2] = H[(((p*pdim + i)*Nc + c)*dim + d)*dim + e] is the value at point p for basis function i, component c, in directions d and e 794 795 Level: intermediate 796 797 .seealso: PetscFECreateTabulation(), PetscTabulationDestroy() 798 @*/ 799 PetscErrorCode PetscFEGetCellTabulation(PetscFE fem, PetscTabulation *T) 800 { 801 PetscInt npoints; 802 const PetscReal *points; 803 PetscErrorCode ierr; 804 805 PetscFunctionBegin; 806 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 807 PetscValidPointer(T, 2); 808 ierr = PetscQuadratureGetData(fem->quadrature, NULL, NULL, &npoints, &points, NULL);CHKERRQ(ierr); 809 if (!fem->T) {ierr = PetscFECreateTabulation(fem, 1, npoints, points, 1, &fem->T);CHKERRQ(ierr);} 810 *T = fem->T; 811 PetscFunctionReturn(0); 812 } 813 814 /*@C 815 PetscFEGetFaceTabulation - Returns the tabulation of the basis functions at the face quadrature points for each face of the reference cell 816 817 Not collective 818 819 Input Parameter: 820 . fem - The PetscFE object 821 822 Output Parameters: 823 . Tf - The basis function values and derviatives at face quadrature points 824 825 Note: 826 $ T->T[0] = Bf[((f*Nq + q)*pdim + i)*Nc + c] is the value at point f,q for basis function i and component c 827 $ T->T[1] = Df[(((f*Nq + q)*pdim + i)*Nc + c)*dim + d] is the derivative value at point f,q for basis function i, component c, in direction d 828 $ T->T[2] = Hf[((((f*Nq + q)*pdim + i)*Nc + c)*dim + d)*dim + e] is the value at point f,q for basis function i, component c, in directions d and e 829 830 Level: intermediate 831 832 .seealso: PetscFEGetCellTabulation(), PetscFECreateTabulation(), PetscTabulationDestroy() 833 @*/ 834 PetscErrorCode PetscFEGetFaceTabulation(PetscFE fem, PetscTabulation *Tf) 835 { 836 PetscErrorCode ierr; 837 838 PetscFunctionBegin; 839 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 840 PetscValidPointer(Tf, 2); 841 if (!fem->Tf) { 842 const PetscReal xi0[3] = {-1., -1., -1.}; 843 PetscReal v0[3], J[9], detJ; 844 PetscQuadrature fq; 845 PetscDualSpace sp; 846 DM dm; 847 const PetscInt *faces; 848 PetscInt dim, numFaces, f, npoints, q; 849 const PetscReal *points; 850 PetscReal *facePoints; 851 852 ierr = PetscFEGetDualSpace(fem, &sp);CHKERRQ(ierr); 853 ierr = PetscDualSpaceGetDM(sp, &dm);CHKERRQ(ierr); 854 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 855 ierr = DMPlexGetConeSize(dm, 0, &numFaces);CHKERRQ(ierr); 856 ierr = DMPlexGetCone(dm, 0, &faces);CHKERRQ(ierr); 857 ierr = PetscFEGetFaceQuadrature(fem, &fq);CHKERRQ(ierr); 858 if (fq) { 859 ierr = PetscQuadratureGetData(fq, NULL, NULL, &npoints, &points, NULL);CHKERRQ(ierr); 860 ierr = PetscMalloc1(numFaces*npoints*dim, &facePoints);CHKERRQ(ierr); 861 for (f = 0; f < numFaces; ++f) { 862 ierr = DMPlexComputeCellGeometryFEM(dm, faces[f], NULL, v0, J, NULL, &detJ);CHKERRQ(ierr); 863 for (q = 0; q < npoints; ++q) CoordinatesRefToReal(dim, dim-1, xi0, v0, J, &points[q*(dim-1)], &facePoints[(f*npoints+q)*dim]); 864 } 865 ierr = PetscFECreateTabulation(fem, numFaces, npoints, facePoints, 1, &fem->Tf);CHKERRQ(ierr); 866 ierr = PetscFree(facePoints);CHKERRQ(ierr); 867 } 868 } 869 *Tf = fem->Tf; 870 PetscFunctionReturn(0); 871 } 872 873 /*@C 874 PetscFEGetFaceCentroidTabulation - Returns the tabulation of the basis functions at the face centroid points 875 876 Not collective 877 878 Input Parameter: 879 . fem - The PetscFE object 880 881 Output Parameters: 882 . Tc - The basis function values at face centroid points 883 884 Note: 885 $ T->T[0] = Bf[(f*pdim + i)*Nc + c] is the value at point f for basis function i and component c 886 887 Level: intermediate 888 889 .seealso: PetscFEGetFaceTabulation(), PetscFEGetCellTabulation(), PetscFECreateTabulation(), PetscTabulationDestroy() 890 @*/ 891 PetscErrorCode PetscFEGetFaceCentroidTabulation(PetscFE fem, PetscTabulation *Tc) 892 { 893 PetscErrorCode ierr; 894 895 PetscFunctionBegin; 896 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 897 PetscValidPointer(Tc, 2); 898 if (!fem->Tc) { 899 PetscDualSpace sp; 900 DM dm; 901 const PetscInt *cone; 902 PetscReal *centroids; 903 PetscInt dim, numFaces, f; 904 905 ierr = PetscFEGetDualSpace(fem, &sp);CHKERRQ(ierr); 906 ierr = PetscDualSpaceGetDM(sp, &dm);CHKERRQ(ierr); 907 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 908 ierr = DMPlexGetConeSize(dm, 0, &numFaces);CHKERRQ(ierr); 909 ierr = DMPlexGetCone(dm, 0, &cone);CHKERRQ(ierr); 910 ierr = PetscMalloc1(numFaces*dim, ¢roids);CHKERRQ(ierr); 911 for (f = 0; f < numFaces; ++f) {ierr = DMPlexComputeCellGeometryFVM(dm, cone[f], NULL, ¢roids[f*dim], NULL);CHKERRQ(ierr);} 912 ierr = PetscFECreateTabulation(fem, 1, numFaces, centroids, 0, &fem->Tc);CHKERRQ(ierr); 913 ierr = PetscFree(centroids);CHKERRQ(ierr); 914 } 915 *Tc = fem->Tc; 916 PetscFunctionReturn(0); 917 } 918 919 /*@C 920 PetscFECreateTabulation - Tabulates the basis functions, and perhaps derivatives, at the points provided. 921 922 Not collective 923 924 Input Parameters: 925 + fem - The PetscFE object 926 . nrepl - The number of replicas 927 . npoints - The number of tabulation points in a replica 928 . points - The tabulation point coordinates 929 - K - The number of derivatives calculated 930 931 Output Parameter: 932 . T - The basis function values and derivatives at tabulation points 933 934 Note: 935 $ T->T[0] = B[(p*pdim + i)*Nc + c] is the value at point p for basis function i and component c 936 $ T->T[1] = D[((p*pdim + i)*Nc + c)*dim + d] is the derivative value at point p for basis function i, component c, in direction d 937 $ T->T[2] = H[(((p*pdim + i)*Nc + c)*dim + d)*dim + e] is the value at point p for basis function i, component c, in directions d and e 938 939 Level: intermediate 940 941 .seealso: PetscFEGetCellTabulation(), PetscTabulationDestroy() 942 @*/ 943 PetscErrorCode PetscFECreateTabulation(PetscFE fem, PetscInt nrepl, PetscInt npoints, const PetscReal points[], PetscInt K, PetscTabulation *T) 944 { 945 DM dm; 946 PetscDualSpace Q; 947 PetscInt Nb; /* Dimension of FE space P */ 948 PetscInt Nc; /* Field components */ 949 PetscInt cdim; /* Reference coordinate dimension */ 950 PetscInt k; 951 PetscErrorCode ierr; 952 953 PetscFunctionBegin; 954 if (!npoints || !fem->dualSpace || K < 0) { 955 *T = NULL; 956 PetscFunctionReturn(0); 957 } 958 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 959 PetscValidPointer(points, 3); 960 PetscValidPointer(T, 5); 961 ierr = PetscFEGetDualSpace(fem, &Q);CHKERRQ(ierr); 962 ierr = PetscDualSpaceGetDM(Q, &dm);CHKERRQ(ierr); 963 ierr = DMGetDimension(dm, &cdim);CHKERRQ(ierr); 964 ierr = PetscDualSpaceGetDimension(Q, &Nb);CHKERRQ(ierr); 965 ierr = PetscFEGetNumComponents(fem, &Nc);CHKERRQ(ierr); 966 ierr = PetscMalloc1(1, T);CHKERRQ(ierr); 967 (*T)->K = !cdim ? 0 : K; 968 (*T)->Nr = nrepl; 969 (*T)->Np = npoints; 970 (*T)->Nb = Nb; 971 (*T)->Nc = Nc; 972 (*T)->cdim = cdim; 973 ierr = PetscMalloc1((*T)->K+1, &(*T)->T);CHKERRQ(ierr); 974 for (k = 0; k <= (*T)->K; ++k) { 975 ierr = PetscMalloc1(nrepl*npoints*Nb*Nc*PetscPowInt(cdim, k), &(*T)->T[k]);CHKERRQ(ierr); 976 } 977 ierr = (*fem->ops->createtabulation)(fem, nrepl*npoints, points, K, *T);CHKERRQ(ierr); 978 PetscFunctionReturn(0); 979 } 980 981 /*@C 982 PetscFEComputeTabulation - Tabulates the basis functions, and perhaps derivatives, at the points provided. 983 984 Not collective 985 986 Input Parameters: 987 + fem - The PetscFE object 988 . npoints - The number of tabulation points 989 . points - The tabulation point coordinates 990 . K - The number of derivatives calculated 991 - T - An existing tabulation object with enough allocated space 992 993 Output Parameter: 994 . T - The basis function values and derivatives at tabulation points 995 996 Note: 997 $ T->T[0] = B[(p*pdim + i)*Nc + c] is the value at point p for basis function i and component c 998 $ T->T[1] = D[((p*pdim + i)*Nc + c)*dim + d] is the derivative value at point p for basis function i, component c, in direction d 999 $ T->T[2] = H[(((p*pdim + i)*Nc + c)*dim + d)*dim + e] is the value at point p for basis function i, component c, in directions d and e 1000 1001 Level: intermediate 1002 1003 .seealso: PetscFEGetCellTabulation(), PetscTabulationDestroy() 1004 @*/ 1005 PetscErrorCode PetscFEComputeTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscInt K, PetscTabulation T) 1006 { 1007 PetscErrorCode ierr; 1008 1009 PetscFunctionBeginHot; 1010 if (!npoints || !fem->dualSpace || K < 0) PetscFunctionReturn(0); 1011 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 1012 PetscValidPointer(points, 3); 1013 PetscValidPointer(T, 5); 1014 #ifdef PETSC_USE_DEBUG 1015 { 1016 DM dm; 1017 PetscDualSpace Q; 1018 PetscInt Nb; /* Dimension of FE space P */ 1019 PetscInt Nc; /* Field components */ 1020 PetscInt cdim; /* Reference coordinate dimension */ 1021 1022 ierr = PetscFEGetDualSpace(fem, &Q);CHKERRQ(ierr); 1023 ierr = PetscDualSpaceGetDM(Q, &dm);CHKERRQ(ierr); 1024 ierr = DMGetDimension(dm, &cdim);CHKERRQ(ierr); 1025 ierr = PetscDualSpaceGetDimension(Q, &Nb);CHKERRQ(ierr); 1026 ierr = PetscFEGetNumComponents(fem, &Nc);CHKERRQ(ierr); 1027 if (T->K != (!cdim ? 0 : K)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Tabulation K %D must match requested K %D", T->K, !cdim ? 0 : K); 1028 if (T->Nb != Nb) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Tabulation Nb %D must match requested Nb %D", T->Nb, Nb); 1029 if (T->Nc != Nc) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Tabulation Nc %D must match requested Nc %D", T->Nc, Nc); 1030 if (T->cdim != cdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Tabulation cdim %D must match requested cdim %D", T->cdim, cdim); 1031 } 1032 #endif 1033 T->Nr = 1; 1034 T->Np = npoints; 1035 ierr = (*fem->ops->createtabulation)(fem, npoints, points, K, T);CHKERRQ(ierr); 1036 PetscFunctionReturn(0); 1037 } 1038 1039 /*@C 1040 PetscTabulationDestroy - Frees memory from the associated tabulation. 1041 1042 Not collective 1043 1044 Input Parameter: 1045 . T - The tabulation 1046 1047 Level: intermediate 1048 1049 .seealso: PetscFECreateTabulation(), PetscFEGetCellTabulation() 1050 @*/ 1051 PetscErrorCode PetscTabulationDestroy(PetscTabulation *T) 1052 { 1053 PetscInt k; 1054 PetscErrorCode ierr; 1055 1056 PetscFunctionBegin; 1057 PetscValidPointer(T, 1); 1058 if (!T || !(*T)) PetscFunctionReturn(0); 1059 for (k = 0; k <= (*T)->K; ++k) {ierr = PetscFree((*T)->T[k]);CHKERRQ(ierr);} 1060 ierr = PetscFree((*T)->T);CHKERRQ(ierr); 1061 ierr = PetscFree(*T);CHKERRQ(ierr); 1062 *T = NULL; 1063 PetscFunctionReturn(0); 1064 } 1065 1066 PETSC_EXTERN PetscErrorCode PetscFECreatePointTrace(PetscFE fe, PetscInt refPoint, PetscFE *trFE) 1067 { 1068 PetscSpace bsp, bsubsp; 1069 PetscDualSpace dsp, dsubsp; 1070 PetscInt dim, depth, numComp, i, j, coneSize, order; 1071 PetscFEType type; 1072 DM dm; 1073 DMLabel label; 1074 PetscReal *xi, *v, *J, detJ; 1075 const char *name; 1076 PetscQuadrature origin, fullQuad, subQuad; 1077 PetscErrorCode ierr; 1078 1079 PetscFunctionBegin; 1080 PetscValidHeaderSpecific(fe,PETSCFE_CLASSID,1); 1081 PetscValidPointer(trFE,3); 1082 ierr = PetscFEGetBasisSpace(fe,&bsp);CHKERRQ(ierr); 1083 ierr = PetscFEGetDualSpace(fe,&dsp);CHKERRQ(ierr); 1084 ierr = PetscDualSpaceGetDM(dsp,&dm);CHKERRQ(ierr); 1085 ierr = DMGetDimension(dm,&dim);CHKERRQ(ierr); 1086 ierr = DMPlexGetDepthLabel(dm,&label);CHKERRQ(ierr); 1087 ierr = DMLabelGetValue(label,refPoint,&depth);CHKERRQ(ierr); 1088 ierr = PetscCalloc1(depth,&xi);CHKERRQ(ierr); 1089 ierr = PetscMalloc1(dim,&v);CHKERRQ(ierr); 1090 ierr = PetscMalloc1(dim*dim,&J);CHKERRQ(ierr); 1091 for (i = 0; i < depth; i++) xi[i] = 0.; 1092 ierr = PetscQuadratureCreate(PETSC_COMM_SELF,&origin);CHKERRQ(ierr); 1093 ierr = PetscQuadratureSetData(origin,depth,0,1,xi,NULL);CHKERRQ(ierr); 1094 ierr = DMPlexComputeCellGeometryFEM(dm,refPoint,origin,v,J,NULL,&detJ);CHKERRQ(ierr); 1095 /* CellGeometryFEM computes the expanded Jacobian, we want the true jacobian */ 1096 for (i = 1; i < dim; i++) { 1097 for (j = 0; j < depth; j++) { 1098 J[i * depth + j] = J[i * dim + j]; 1099 } 1100 } 1101 ierr = PetscQuadratureDestroy(&origin);CHKERRQ(ierr); 1102 ierr = PetscDualSpaceGetPointSubspace(dsp,refPoint,&dsubsp);CHKERRQ(ierr); 1103 ierr = PetscSpaceCreateSubspace(bsp,dsubsp,v,J,NULL,NULL,PETSC_OWN_POINTER,&bsubsp);CHKERRQ(ierr); 1104 ierr = PetscSpaceSetUp(bsubsp);CHKERRQ(ierr); 1105 ierr = PetscFECreate(PetscObjectComm((PetscObject)fe),trFE);CHKERRQ(ierr); 1106 ierr = PetscFEGetType(fe,&type);CHKERRQ(ierr); 1107 ierr = PetscFESetType(*trFE,type);CHKERRQ(ierr); 1108 ierr = PetscFEGetNumComponents(fe,&numComp);CHKERRQ(ierr); 1109 ierr = PetscFESetNumComponents(*trFE,numComp);CHKERRQ(ierr); 1110 ierr = PetscFESetBasisSpace(*trFE,bsubsp);CHKERRQ(ierr); 1111 ierr = PetscFESetDualSpace(*trFE,dsubsp);CHKERRQ(ierr); 1112 ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr); 1113 if (name) {ierr = PetscFESetName(*trFE, name);CHKERRQ(ierr);} 1114 ierr = PetscFEGetQuadrature(fe,&fullQuad);CHKERRQ(ierr); 1115 ierr = PetscQuadratureGetOrder(fullQuad,&order);CHKERRQ(ierr); 1116 ierr = DMPlexGetConeSize(dm,refPoint,&coneSize);CHKERRQ(ierr); 1117 if (coneSize == 2 * depth) { 1118 ierr = PetscDTGaussTensorQuadrature(depth,1,(order + 1)/2,-1.,1.,&subQuad);CHKERRQ(ierr); 1119 } else { 1120 ierr = PetscDTGaussJacobiQuadrature(depth,1,(order + 1)/2,-1.,1.,&subQuad);CHKERRQ(ierr); 1121 } 1122 ierr = PetscFESetQuadrature(*trFE,subQuad);CHKERRQ(ierr); 1123 ierr = PetscFESetUp(*trFE);CHKERRQ(ierr); 1124 ierr = PetscQuadratureDestroy(&subQuad);CHKERRQ(ierr); 1125 ierr = PetscSpaceDestroy(&bsubsp);CHKERRQ(ierr); 1126 PetscFunctionReturn(0); 1127 } 1128 1129 PetscErrorCode PetscFECreateHeightTrace(PetscFE fe, PetscInt height, PetscFE *trFE) 1130 { 1131 PetscInt hStart, hEnd; 1132 PetscDualSpace dsp; 1133 DM dm; 1134 PetscErrorCode ierr; 1135 1136 PetscFunctionBegin; 1137 PetscValidHeaderSpecific(fe,PETSCFE_CLASSID,1); 1138 PetscValidPointer(trFE,3); 1139 *trFE = NULL; 1140 ierr = PetscFEGetDualSpace(fe,&dsp);CHKERRQ(ierr); 1141 ierr = PetscDualSpaceGetDM(dsp,&dm);CHKERRQ(ierr); 1142 ierr = DMPlexGetHeightStratum(dm,height,&hStart,&hEnd);CHKERRQ(ierr); 1143 if (hEnd <= hStart) PetscFunctionReturn(0); 1144 ierr = PetscFECreatePointTrace(fe,hStart,trFE);CHKERRQ(ierr); 1145 PetscFunctionReturn(0); 1146 } 1147 1148 1149 /*@ 1150 PetscFEGetDimension - Get the dimension of the finite element space on a cell 1151 1152 Not collective 1153 1154 Input Parameter: 1155 . fe - The PetscFE 1156 1157 Output Parameter: 1158 . dim - The dimension 1159 1160 Level: intermediate 1161 1162 .seealso: PetscFECreate(), PetscSpaceGetDimension(), PetscDualSpaceGetDimension() 1163 @*/ 1164 PetscErrorCode PetscFEGetDimension(PetscFE fem, PetscInt *dim) 1165 { 1166 PetscErrorCode ierr; 1167 1168 PetscFunctionBegin; 1169 PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1); 1170 PetscValidPointer(dim, 2); 1171 if (fem->ops->getdimension) {ierr = (*fem->ops->getdimension)(fem, dim);CHKERRQ(ierr);} 1172 PetscFunctionReturn(0); 1173 } 1174 1175 /*@C 1176 PetscFEPushforward - Map the reference element function to real space 1177 1178 Input Parameters: 1179 + fe - The PetscFE 1180 . fegeom - The cell geometry 1181 . Nv - The number of function values 1182 - vals - The function values 1183 1184 Output Parameter: 1185 . vals - The transformed function values 1186 1187 Level: advanced 1188 1189 Note: This just forwards the call onto PetscDualSpacePushforward(). 1190 1191 .seealso: PetscDualSpacePushforward() 1192 @*/ 1193 PetscErrorCode PetscFEPushforward(PetscFE fe, PetscFEGeom *fegeom, PetscInt Nv, PetscScalar vals[]) 1194 { 1195 PetscErrorCode ierr; 1196 1197 PetscFunctionBeginHot; 1198 ierr = PetscDualSpacePushforward(fe->dualSpace, fegeom, Nv, fe->numComponents, vals);CHKERRQ(ierr); 1199 PetscFunctionReturn(0); 1200 } 1201 1202 /*@C 1203 PetscFEPushforwardGradient - Map the reference element function gradient to real space 1204 1205 Input Parameters: 1206 + fe - The PetscFE 1207 . fegeom - The cell geometry 1208 . Nv - The number of function gradient values 1209 - vals - The function gradient values 1210 1211 Output Parameter: 1212 . vals - The transformed function gradient values 1213 1214 Level: advanced 1215 1216 Note: This just forwards the call onto PetscDualSpacePushforwardGradient(). 1217 1218 .seealso: PetscFEPushforward(), PetscDualSpacePushforwardGradient(), PetscDualSpacePushforward() 1219 @*/ 1220 PetscErrorCode PetscFEPushforwardGradient(PetscFE fe, PetscFEGeom *fegeom, PetscInt Nv, PetscScalar vals[]) 1221 { 1222 PetscErrorCode ierr; 1223 1224 PetscFunctionBeginHot; 1225 ierr = PetscDualSpacePushforwardGradient(fe->dualSpace, fegeom, Nv, fe->numComponents, vals);CHKERRQ(ierr); 1226 PetscFunctionReturn(0); 1227 } 1228 1229 /* 1230 Purpose: Compute element vector for chunk of elements 1231 1232 Input: 1233 Sizes: 1234 Ne: number of elements 1235 Nf: number of fields 1236 PetscFE 1237 dim: spatial dimension 1238 Nb: number of basis functions 1239 Nc: number of field components 1240 PetscQuadrature 1241 Nq: number of quadrature points 1242 1243 Geometry: 1244 PetscFEGeom[Ne] possibly *Nq 1245 PetscReal v0s[dim] 1246 PetscReal n[dim] 1247 PetscReal jacobians[dim*dim] 1248 PetscReal jacobianInverses[dim*dim] 1249 PetscReal jacobianDeterminants 1250 FEM: 1251 PetscFE 1252 PetscQuadrature 1253 PetscReal quadPoints[Nq*dim] 1254 PetscReal quadWeights[Nq] 1255 PetscReal basis[Nq*Nb*Nc] 1256 PetscReal basisDer[Nq*Nb*Nc*dim] 1257 PetscScalar coefficients[Ne*Nb*Nc] 1258 PetscScalar elemVec[Ne*Nb*Nc] 1259 1260 Problem: 1261 PetscInt f: the active field 1262 f0, f1 1263 1264 Work Space: 1265 PetscFE 1266 PetscScalar f0[Nq*dim]; 1267 PetscScalar f1[Nq*dim*dim]; 1268 PetscScalar u[Nc]; 1269 PetscScalar gradU[Nc*dim]; 1270 PetscReal x[dim]; 1271 PetscScalar realSpaceDer[dim]; 1272 1273 Purpose: Compute element vector for N_cb batches of elements 1274 1275 Input: 1276 Sizes: 1277 N_cb: Number of serial cell batches 1278 1279 Geometry: 1280 PetscReal v0s[Ne*dim] 1281 PetscReal jacobians[Ne*dim*dim] possibly *Nq 1282 PetscReal jacobianInverses[Ne*dim*dim] possibly *Nq 1283 PetscReal jacobianDeterminants[Ne] possibly *Nq 1284 FEM: 1285 static PetscReal quadPoints[Nq*dim] 1286 static PetscReal quadWeights[Nq] 1287 static PetscReal basis[Nq*Nb*Nc] 1288 static PetscReal basisDer[Nq*Nb*Nc*dim] 1289 PetscScalar coefficients[Ne*Nb*Nc] 1290 PetscScalar elemVec[Ne*Nb*Nc] 1291 1292 ex62.c: 1293 PetscErrorCode PetscFEIntegrateResidualBatch(PetscInt Ne, PetscInt numFields, PetscInt field, PetscQuadrature quad[], const PetscScalar coefficients[], 1294 const PetscReal v0s[], const PetscReal jacobians[], const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], 1295 void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f0[]), 1296 void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f1[]), PetscScalar elemVec[]) 1297 1298 ex52.c: 1299 PetscErrorCode IntegrateLaplacianBatchCPU(PetscInt Ne, PetscInt Nb, const PetscScalar coefficients[], const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscInt Nq, const PetscReal quadPoints[], const PetscReal quadWeights[], const PetscReal basisTabulation[], const PetscReal basisDerTabulation[], PetscScalar elemVec[], AppCtx *user) 1300 PetscErrorCode IntegrateElasticityBatchCPU(PetscInt Ne, PetscInt Nb, PetscInt Ncomp, const PetscScalar coefficients[], const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscInt Nq, const PetscReal quadPoints[], const PetscReal quadWeights[], const PetscReal basisTabulation[], const PetscReal basisDerTabulation[], PetscScalar elemVec[], AppCtx *user) 1301 1302 ex52_integrateElement.cu 1303 __global__ void integrateElementQuadrature(int N_cb, realType *coefficients, realType *jacobianInverses, realType *jacobianDeterminants, realType *elemVec) 1304 1305 PETSC_EXTERN PetscErrorCode IntegrateElementBatchGPU(PetscInt spatial_dim, PetscInt Ne, PetscInt Ncb, PetscInt Nbc, PetscInt Nbl, const PetscScalar coefficients[], 1306 const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscScalar elemVec[], 1307 PetscLogEvent event, PetscInt debug, PetscInt pde_op) 1308 1309 ex52_integrateElementOpenCL.c: 1310 PETSC_EXTERN PetscErrorCode IntegrateElementBatchGPU(PetscInt spatial_dim, PetscInt Ne, PetscInt Ncb, PetscInt Nbc, PetscInt N_bl, const PetscScalar coefficients[], 1311 const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscScalar elemVec[], 1312 PetscLogEvent event, PetscInt debug, PetscInt pde_op) 1313 1314 __kernel void integrateElementQuadrature(int N_cb, __global float *coefficients, __global float *jacobianInverses, __global float *jacobianDeterminants, __global float *elemVec) 1315 */ 1316 1317 /*@C 1318 PetscFEIntegrate - Produce the integral for the given field for a chunk of elements by quadrature integration 1319 1320 Not collective 1321 1322 Input Parameters: 1323 + fem - The PetscFE object for the field being integrated 1324 . prob - The PetscDS specifying the discretizations and continuum functions 1325 . field - The field being integrated 1326 . Ne - The number of elements in the chunk 1327 . cgeom - The cell geometry for each cell in the chunk 1328 . coefficients - The array of FEM basis coefficients for the elements 1329 . probAux - The PetscDS specifying the auxiliary discretizations 1330 - coefficientsAux - The array of FEM auxiliary basis coefficients for the elements 1331 1332 Output Parameter 1333 . integral - the integral for this field 1334 1335 Level: intermediate 1336 1337 .seealso: PetscFEIntegrateResidual() 1338 @*/ 1339 PetscErrorCode PetscFEIntegrate(PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *cgeom, 1340 const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscScalar integral[]) 1341 { 1342 PetscFE fe; 1343 PetscErrorCode ierr; 1344 1345 PetscFunctionBegin; 1346 PetscValidHeaderSpecific(prob, PETSCDS_CLASSID, 1); 1347 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr); 1348 if (fe->ops->integrate) {ierr = (*fe->ops->integrate)(prob, field, Ne, cgeom, coefficients, probAux, coefficientsAux, integral);CHKERRQ(ierr);} 1349 PetscFunctionReturn(0); 1350 } 1351 1352 /*@C 1353 PetscFEIntegrateBd - Produce the integral for the given field for a chunk of elements by quadrature integration 1354 1355 Not collective 1356 1357 Input Parameters: 1358 + fem - The PetscFE object for the field being integrated 1359 . prob - The PetscDS specifying the discretizations and continuum functions 1360 . field - The field being integrated 1361 . obj_func - The function to be integrated 1362 . Ne - The number of elements in the chunk 1363 . fgeom - The face geometry for each face in the chunk 1364 . coefficients - The array of FEM basis coefficients for the elements 1365 . probAux - The PetscDS specifying the auxiliary discretizations 1366 - coefficientsAux - The array of FEM auxiliary basis coefficients for the elements 1367 1368 Output Parameter 1369 . integral - the integral for this field 1370 1371 Level: intermediate 1372 1373 .seealso: PetscFEIntegrateResidual() 1374 @*/ 1375 PetscErrorCode PetscFEIntegrateBd(PetscDS prob, PetscInt field, 1376 void (*obj_func)(PetscInt, PetscInt, PetscInt, 1377 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 1378 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[], 1379 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]), 1380 PetscInt Ne, PetscFEGeom *geom, const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscScalar integral[]) 1381 { 1382 PetscFE fe; 1383 PetscErrorCode ierr; 1384 1385 PetscFunctionBegin; 1386 PetscValidHeaderSpecific(prob, PETSCDS_CLASSID, 1); 1387 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr); 1388 if (fe->ops->integratebd) {ierr = (*fe->ops->integratebd)(prob, field, obj_func, Ne, geom, coefficients, probAux, coefficientsAux, integral);CHKERRQ(ierr);} 1389 PetscFunctionReturn(0); 1390 } 1391 1392 /*@C 1393 PetscFEIntegrateResidual - Produce the element residual vector for a chunk of elements by quadrature integration 1394 1395 Not collective 1396 1397 Input Parameters: 1398 + fem - The PetscFE object for the field being integrated 1399 . prob - The PetscDS specifying the discretizations and continuum functions 1400 . field - The field being integrated 1401 . Ne - The number of elements in the chunk 1402 . cgeom - The cell geometry for each cell in the chunk 1403 . coefficients - The array of FEM basis coefficients for the elements 1404 . coefficients_t - The array of FEM basis time derivative coefficients for the elements 1405 . probAux - The PetscDS specifying the auxiliary discretizations 1406 . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements 1407 - t - The time 1408 1409 Output Parameter 1410 . elemVec - the element residual vectors from each element 1411 1412 Note: 1413 $ Loop over batch of elements (e): 1414 $ Loop over quadrature points (q): 1415 $ Make u_q and gradU_q (loops over fields,Nb,Ncomp) and x_q 1416 $ Call f_0 and f_1 1417 $ Loop over element vector entries (f,fc --> i): 1418 $ elemVec[i] += \psi^{fc}_f(q) f0_{fc}(u, \nabla u) + \nabla\psi^{fc}_f(q) \cdot f1_{fc,df}(u, \nabla u) 1419 1420 Level: intermediate 1421 1422 .seealso: PetscFEIntegrateResidual() 1423 @*/ 1424 PetscErrorCode PetscFEIntegrateResidual(PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *cgeom, 1425 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[]) 1426 { 1427 PetscFE fe; 1428 PetscErrorCode ierr; 1429 1430 PetscFunctionBegin; 1431 PetscValidHeaderSpecific(prob, PETSCDS_CLASSID, 1); 1432 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr); 1433 if (fe->ops->integrateresidual) {ierr = (*fe->ops->integrateresidual)(prob, field, Ne, cgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);CHKERRQ(ierr);} 1434 PetscFunctionReturn(0); 1435 } 1436 1437 /*@C 1438 PetscFEIntegrateBdResidual - Produce the element residual vector for a chunk of elements by quadrature integration over a boundary 1439 1440 Not collective 1441 1442 Input Parameters: 1443 + fem - The PetscFE object for the field being integrated 1444 . prob - The PetscDS specifying the discretizations and continuum functions 1445 . field - The field being integrated 1446 . Ne - The number of elements in the chunk 1447 . fgeom - The face geometry for each cell in the chunk 1448 . coefficients - The array of FEM basis coefficients for the elements 1449 . coefficients_t - The array of FEM basis time derivative coefficients for the elements 1450 . probAux - The PetscDS specifying the auxiliary discretizations 1451 . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements 1452 - t - The time 1453 1454 Output Parameter 1455 . elemVec - the element residual vectors from each element 1456 1457 Level: intermediate 1458 1459 .seealso: PetscFEIntegrateResidual() 1460 @*/ 1461 PetscErrorCode PetscFEIntegrateBdResidual(PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *fgeom, 1462 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[]) 1463 { 1464 PetscFE fe; 1465 PetscErrorCode ierr; 1466 1467 PetscFunctionBegin; 1468 PetscValidHeaderSpecific(prob, PETSCDS_CLASSID, 1); 1469 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr); 1470 if (fe->ops->integratebdresidual) {ierr = (*fe->ops->integratebdresidual)(prob, field, Ne, fgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);CHKERRQ(ierr);} 1471 PetscFunctionReturn(0); 1472 } 1473 1474 /*@C 1475 PetscFEIntegrateJacobian - Produce the element Jacobian for a chunk of elements by quadrature integration 1476 1477 Not collective 1478 1479 Input Parameters: 1480 + fem - The PetscFE object for the field being integrated 1481 . prob - The PetscDS specifying the discretizations and continuum functions 1482 . jtype - The type of matrix pointwise functions that should be used 1483 . fieldI - The test field being integrated 1484 . fieldJ - The basis field being integrated 1485 . Ne - The number of elements in the chunk 1486 . cgeom - The cell geometry for each cell in the chunk 1487 . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point 1488 . coefficients_t - The array of FEM basis time derivative coefficients for the elements 1489 . probAux - The PetscDS specifying the auxiliary discretizations 1490 . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements 1491 . t - The time 1492 - u_tShift - A multiplier for the dF/du_t term (as opposed to the dF/du term) 1493 1494 Output Parameter 1495 . elemMat - the element matrices for the Jacobian from each element 1496 1497 Note: 1498 $ Loop over batch of elements (e): 1499 $ Loop over element matrix entries (f,fc,g,gc --> i,j): 1500 $ Loop over quadrature points (q): 1501 $ Make u_q and gradU_q (loops over fields,Nb,Ncomp) 1502 $ elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q) 1503 $ + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q) 1504 $ + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q) 1505 $ + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q) 1506 Level: intermediate 1507 1508 .seealso: PetscFEIntegrateResidual() 1509 @*/ 1510 PetscErrorCode PetscFEIntegrateJacobian(PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEGeom *cgeom, 1511 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[]) 1512 { 1513 PetscFE fe; 1514 PetscErrorCode ierr; 1515 1516 PetscFunctionBegin; 1517 PetscValidHeaderSpecific(prob, PETSCDS_CLASSID, 1); 1518 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 1519 if (fe->ops->integratejacobian) {ierr = (*fe->ops->integratejacobian)(prob, jtype, fieldI, fieldJ, Ne, cgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, u_tshift, elemMat);CHKERRQ(ierr);} 1520 PetscFunctionReturn(0); 1521 } 1522 1523 /*@C 1524 PetscFEIntegrateBdJacobian - Produce the boundary element Jacobian for a chunk of elements by quadrature integration 1525 1526 Not collective 1527 1528 Input Parameters: 1529 . prob - The PetscDS specifying the discretizations and continuum functions 1530 . fieldI - The test field being integrated 1531 . fieldJ - The basis field being integrated 1532 . Ne - The number of elements in the chunk 1533 . fgeom - The face geometry for each cell in the chunk 1534 . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point 1535 . coefficients_t - The array of FEM basis time derivative coefficients for the elements 1536 . probAux - The PetscDS specifying the auxiliary discretizations 1537 . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements 1538 . t - The time 1539 - u_tShift - A multiplier for the dF/du_t term (as opposed to the dF/du term) 1540 1541 Output Parameter 1542 . elemMat - the element matrices for the Jacobian from each element 1543 1544 Note: 1545 $ Loop over batch of elements (e): 1546 $ Loop over element matrix entries (f,fc,g,gc --> i,j): 1547 $ Loop over quadrature points (q): 1548 $ Make u_q and gradU_q (loops over fields,Nb,Ncomp) 1549 $ elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q) 1550 $ + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q) 1551 $ + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q) 1552 $ + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q) 1553 Level: intermediate 1554 1555 .seealso: PetscFEIntegrateJacobian(), PetscFEIntegrateResidual() 1556 @*/ 1557 PetscErrorCode PetscFEIntegrateBdJacobian(PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEGeom *fgeom, 1558 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[]) 1559 { 1560 PetscFE fe; 1561 PetscErrorCode ierr; 1562 1563 PetscFunctionBegin; 1564 PetscValidHeaderSpecific(prob, PETSCDS_CLASSID, 1); 1565 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr); 1566 if (fe->ops->integratebdjacobian) {ierr = (*fe->ops->integratebdjacobian)(prob, fieldI, fieldJ, Ne, fgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, u_tshift, elemMat);CHKERRQ(ierr);} 1567 PetscFunctionReturn(0); 1568 } 1569 1570 /*@ 1571 PetscFEGetHeightSubspace - Get the subspace of this space for a mesh point of a given height 1572 1573 Input Parameters: 1574 + fe - The finite element space 1575 - height - The height of the Plex point 1576 1577 Output Parameter: 1578 . subfe - The subspace of this FE space 1579 1580 Note: For example, if we want the subspace of this space for a face, we would choose height = 1. 1581 1582 Level: advanced 1583 1584 .seealso: PetscFECreateDefault() 1585 @*/ 1586 PetscErrorCode PetscFEGetHeightSubspace(PetscFE fe, PetscInt height, PetscFE *subfe) 1587 { 1588 PetscSpace P, subP; 1589 PetscDualSpace Q, subQ; 1590 PetscQuadrature subq; 1591 PetscFEType fetype; 1592 PetscInt dim, Nc; 1593 PetscErrorCode ierr; 1594 1595 PetscFunctionBegin; 1596 PetscValidHeaderSpecific(fe, PETSCFE_CLASSID, 1); 1597 PetscValidPointer(subfe, 3); 1598 if (height == 0) { 1599 *subfe = fe; 1600 PetscFunctionReturn(0); 1601 } 1602 ierr = PetscFEGetBasisSpace(fe, &P);CHKERRQ(ierr); 1603 ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr); 1604 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr); 1605 ierr = PetscFEGetFaceQuadrature(fe, &subq);CHKERRQ(ierr); 1606 ierr = PetscDualSpaceGetDimension(Q, &dim);CHKERRQ(ierr); 1607 if (height > dim || height < 0) {SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Asked for space at height %D for dimension %D space", height, dim);} 1608 if (!fe->subspaces) {ierr = PetscCalloc1(dim, &fe->subspaces);CHKERRQ(ierr);} 1609 if (height <= dim) { 1610 if (!fe->subspaces[height-1]) { 1611 PetscFE sub; 1612 const char *name; 1613 1614 ierr = PetscSpaceGetHeightSubspace(P, height, &subP);CHKERRQ(ierr); 1615 ierr = PetscDualSpaceGetHeightSubspace(Q, height, &subQ);CHKERRQ(ierr); 1616 ierr = PetscFECreate(PetscObjectComm((PetscObject) fe), &sub);CHKERRQ(ierr); 1617 ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr); 1618 ierr = PetscObjectSetName((PetscObject) sub, name);CHKERRQ(ierr); 1619 ierr = PetscFEGetType(fe, &fetype);CHKERRQ(ierr); 1620 ierr = PetscFESetType(sub, fetype);CHKERRQ(ierr); 1621 ierr = PetscFESetBasisSpace(sub, subP);CHKERRQ(ierr); 1622 ierr = PetscFESetDualSpace(sub, subQ);CHKERRQ(ierr); 1623 ierr = PetscFESetNumComponents(sub, Nc);CHKERRQ(ierr); 1624 ierr = PetscFESetUp(sub);CHKERRQ(ierr); 1625 ierr = PetscFESetQuadrature(sub, subq);CHKERRQ(ierr); 1626 fe->subspaces[height-1] = sub; 1627 } 1628 *subfe = fe->subspaces[height-1]; 1629 } else { 1630 *subfe = NULL; 1631 } 1632 PetscFunctionReturn(0); 1633 } 1634 1635 /*@ 1636 PetscFERefine - Create a "refined" PetscFE object that refines the reference cell into smaller copies. This is typically used 1637 to precondition a higher order method with a lower order method on a refined mesh having the same number of dofs (but more 1638 sparsity). It is also used to create an interpolation between regularly refined meshes. 1639 1640 Collective on fem 1641 1642 Input Parameter: 1643 . fe - The initial PetscFE 1644 1645 Output Parameter: 1646 . feRef - The refined PetscFE 1647 1648 Level: advanced 1649 1650 .seealso: PetscFEType, PetscFECreate(), PetscFESetType() 1651 @*/ 1652 PetscErrorCode PetscFERefine(PetscFE fe, PetscFE *feRef) 1653 { 1654 PetscSpace P, Pref; 1655 PetscDualSpace Q, Qref; 1656 DM K, Kref; 1657 PetscQuadrature q, qref; 1658 const PetscReal *v0, *jac; 1659 PetscInt numComp, numSubelements; 1660 PetscErrorCode ierr; 1661 1662 PetscFunctionBegin; 1663 ierr = PetscFEGetBasisSpace(fe, &P);CHKERRQ(ierr); 1664 ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr); 1665 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr); 1666 ierr = PetscDualSpaceGetDM(Q, &K);CHKERRQ(ierr); 1667 /* Create space */ 1668 ierr = PetscObjectReference((PetscObject) P);CHKERRQ(ierr); 1669 Pref = P; 1670 /* Create dual space */ 1671 ierr = PetscDualSpaceDuplicate(Q, &Qref);CHKERRQ(ierr); 1672 ierr = DMRefine(K, PetscObjectComm((PetscObject) fe), &Kref);CHKERRQ(ierr); 1673 ierr = PetscDualSpaceSetDM(Qref, Kref);CHKERRQ(ierr); 1674 ierr = DMDestroy(&Kref);CHKERRQ(ierr); 1675 ierr = PetscDualSpaceSetUp(Qref);CHKERRQ(ierr); 1676 /* Create element */ 1677 ierr = PetscFECreate(PetscObjectComm((PetscObject) fe), feRef);CHKERRQ(ierr); 1678 ierr = PetscFESetType(*feRef, PETSCFECOMPOSITE);CHKERRQ(ierr); 1679 ierr = PetscFESetBasisSpace(*feRef, Pref);CHKERRQ(ierr); 1680 ierr = PetscFESetDualSpace(*feRef, Qref);CHKERRQ(ierr); 1681 ierr = PetscFEGetNumComponents(fe, &numComp);CHKERRQ(ierr); 1682 ierr = PetscFESetNumComponents(*feRef, numComp);CHKERRQ(ierr); 1683 ierr = PetscFESetUp(*feRef);CHKERRQ(ierr); 1684 ierr = PetscSpaceDestroy(&Pref);CHKERRQ(ierr); 1685 ierr = PetscDualSpaceDestroy(&Qref);CHKERRQ(ierr); 1686 /* Create quadrature */ 1687 ierr = PetscFECompositeGetMapping(*feRef, &numSubelements, &v0, &jac, NULL);CHKERRQ(ierr); 1688 ierr = PetscQuadratureExpandComposite(q, numSubelements, v0, jac, &qref);CHKERRQ(ierr); 1689 ierr = PetscFESetQuadrature(*feRef, qref);CHKERRQ(ierr); 1690 ierr = PetscQuadratureDestroy(&qref);CHKERRQ(ierr); 1691 PetscFunctionReturn(0); 1692 } 1693 1694 /*@C 1695 PetscFECreateDefault - Create a PetscFE for basic FEM computation 1696 1697 Collective 1698 1699 Input Parameters: 1700 + comm - The MPI comm 1701 . dim - The spatial dimension 1702 . Nc - The number of components 1703 . isSimplex - Flag for simplex reference cell, otherwise its a tensor product 1704 . prefix - The options prefix, or NULL 1705 - qorder - The quadrature order or PETSC_DETERMINE to use PetscSpace polynomial degree 1706 1707 Output Parameter: 1708 . fem - The PetscFE object 1709 1710 Level: beginner 1711 1712 .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate() 1713 @*/ 1714 PetscErrorCode PetscFECreateDefault(MPI_Comm comm, PetscInt dim, PetscInt Nc, PetscBool isSimplex, const char prefix[], PetscInt qorder, PetscFE *fem) 1715 { 1716 PetscQuadrature q, fq; 1717 DM K; 1718 PetscSpace P; 1719 PetscDualSpace Q; 1720 PetscInt order, quadPointsPerEdge; 1721 PetscBool tensor = isSimplex ? PETSC_FALSE : PETSC_TRUE; 1722 PetscErrorCode ierr; 1723 1724 PetscFunctionBegin; 1725 /* Create space */ 1726 ierr = PetscSpaceCreate(comm, &P);CHKERRQ(ierr); 1727 ierr = PetscObjectSetOptionsPrefix((PetscObject) P, prefix);CHKERRQ(ierr); 1728 ierr = PetscSpacePolynomialSetTensor(P, tensor);CHKERRQ(ierr); 1729 ierr = PetscSpaceSetNumComponents(P, Nc);CHKERRQ(ierr); 1730 ierr = PetscSpaceSetNumVariables(P, dim);CHKERRQ(ierr); 1731 ierr = PetscSpaceSetFromOptions(P);CHKERRQ(ierr); 1732 ierr = PetscSpaceSetUp(P);CHKERRQ(ierr); 1733 ierr = PetscSpaceGetDegree(P, &order, NULL);CHKERRQ(ierr); 1734 ierr = PetscSpacePolynomialGetTensor(P, &tensor);CHKERRQ(ierr); 1735 /* Create dual space */ 1736 ierr = PetscDualSpaceCreate(comm, &Q);CHKERRQ(ierr); 1737 ierr = PetscDualSpaceSetType(Q,PETSCDUALSPACELAGRANGE);CHKERRQ(ierr); 1738 ierr = PetscObjectSetOptionsPrefix((PetscObject) Q, prefix);CHKERRQ(ierr); 1739 ierr = PetscDualSpaceCreateReferenceCell(Q, dim, isSimplex, &K);CHKERRQ(ierr); 1740 ierr = PetscDualSpaceSetDM(Q, K);CHKERRQ(ierr); 1741 ierr = DMDestroy(&K);CHKERRQ(ierr); 1742 ierr = PetscDualSpaceSetNumComponents(Q, Nc);CHKERRQ(ierr); 1743 ierr = PetscDualSpaceSetOrder(Q, order);CHKERRQ(ierr); 1744 ierr = PetscDualSpaceLagrangeSetTensor(Q, tensor);CHKERRQ(ierr); 1745 ierr = PetscDualSpaceSetFromOptions(Q);CHKERRQ(ierr); 1746 ierr = PetscDualSpaceSetUp(Q);CHKERRQ(ierr); 1747 /* Create element */ 1748 ierr = PetscFECreate(comm, fem);CHKERRQ(ierr); 1749 ierr = PetscObjectSetOptionsPrefix((PetscObject) *fem, prefix);CHKERRQ(ierr); 1750 ierr = PetscFESetBasisSpace(*fem, P);CHKERRQ(ierr); 1751 ierr = PetscFESetDualSpace(*fem, Q);CHKERRQ(ierr); 1752 ierr = PetscFESetNumComponents(*fem, Nc);CHKERRQ(ierr); 1753 ierr = PetscFESetFromOptions(*fem);CHKERRQ(ierr); 1754 ierr = PetscFESetUp(*fem);CHKERRQ(ierr); 1755 ierr = PetscSpaceDestroy(&P);CHKERRQ(ierr); 1756 ierr = PetscDualSpaceDestroy(&Q);CHKERRQ(ierr); 1757 /* Create quadrature (with specified order if given) */ 1758 qorder = qorder >= 0 ? qorder : order; 1759 ierr = PetscObjectOptionsBegin((PetscObject)*fem);CHKERRQ(ierr); 1760 ierr = PetscOptionsBoundedInt("-petscfe_default_quadrature_order","Quadrature order is one less than quadrature points per edge","PetscFECreateDefault",qorder,&qorder,NULL,0);CHKERRQ(ierr); 1761 ierr = PetscOptionsEnd();CHKERRQ(ierr); 1762 quadPointsPerEdge = PetscMax(qorder + 1,1); 1763 if (isSimplex) { 1764 ierr = PetscDTGaussJacobiQuadrature(dim, 1, quadPointsPerEdge, -1.0, 1.0, &q);CHKERRQ(ierr); 1765 ierr = PetscDTGaussJacobiQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);CHKERRQ(ierr); 1766 } else { 1767 ierr = PetscDTGaussTensorQuadrature(dim, 1, quadPointsPerEdge, -1.0, 1.0, &q);CHKERRQ(ierr); 1768 ierr = PetscDTGaussTensorQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);CHKERRQ(ierr); 1769 } 1770 ierr = PetscFESetQuadrature(*fem, q);CHKERRQ(ierr); 1771 ierr = PetscFESetFaceQuadrature(*fem, fq);CHKERRQ(ierr); 1772 ierr = PetscQuadratureDestroy(&q);CHKERRQ(ierr); 1773 ierr = PetscQuadratureDestroy(&fq);CHKERRQ(ierr); 1774 PetscFunctionReturn(0); 1775 } 1776 1777 /*@C 1778 PetscFESetName - Names the FE and its subobjects 1779 1780 Not collective 1781 1782 Input Parameters: 1783 + fe - The PetscFE 1784 - name - The name 1785 1786 Level: intermediate 1787 1788 .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate() 1789 @*/ 1790 PetscErrorCode PetscFESetName(PetscFE fe, const char name[]) 1791 { 1792 PetscSpace P; 1793 PetscDualSpace Q; 1794 PetscErrorCode ierr; 1795 1796 PetscFunctionBegin; 1797 ierr = PetscFEGetBasisSpace(fe, &P);CHKERRQ(ierr); 1798 ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr); 1799 ierr = PetscObjectSetName((PetscObject) fe, name);CHKERRQ(ierr); 1800 ierr = PetscObjectSetName((PetscObject) P, name);CHKERRQ(ierr); 1801 ierr = PetscObjectSetName((PetscObject) Q, name);CHKERRQ(ierr); 1802 PetscFunctionReturn(0); 1803 } 1804 1805 PetscErrorCode PetscFEEvaluateFieldJets_Internal(PetscDS ds, PetscInt Nf, PetscInt r, PetscInt q, PetscTabulation T[], PetscFEGeom *fegeom, const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscScalar u[], PetscScalar u_x[], PetscScalar u_t[]) 1806 { 1807 PetscInt dOffset = 0, fOffset = 0, f; 1808 PetscErrorCode ierr; 1809 1810 for (f = 0; f < Nf; ++f) { 1811 PetscFE fe; 1812 const PetscInt cdim = T[f]->cdim; 1813 const PetscInt Nq = T[f]->Np; 1814 const PetscInt Nbf = T[f]->Nb; 1815 const PetscInt Ncf = T[f]->Nc; 1816 const PetscReal *Bq = &T[f]->T[0][(r*Nq+q)*Nbf*Ncf]; 1817 const PetscReal *Dq = &T[f]->T[1][(r*Nq+q)*Nbf*Ncf*cdim]; 1818 PetscInt b, c, d; 1819 1820 ierr = PetscDSGetDiscretization(ds, f, (PetscObject *) &fe);CHKERRQ(ierr); 1821 for (c = 0; c < Ncf; ++c) u[fOffset+c] = 0.0; 1822 for (d = 0; d < cdim*Ncf; ++d) u_x[fOffset*cdim+d] = 0.0; 1823 for (b = 0; b < Nbf; ++b) { 1824 for (c = 0; c < Ncf; ++c) { 1825 const PetscInt cidx = b*Ncf+c; 1826 1827 u[fOffset+c] += Bq[cidx]*coefficients[dOffset+b]; 1828 for (d = 0; d < cdim; ++d) u_x[(fOffset+c)*cdim+d] += Dq[cidx*cdim+d]*coefficients[dOffset+b]; 1829 } 1830 } 1831 ierr = PetscFEPushforward(fe, fegeom, 1, &u[fOffset]);CHKERRQ(ierr); 1832 ierr = PetscFEPushforwardGradient(fe, fegeom, 1, &u_x[fOffset*cdim]);CHKERRQ(ierr); 1833 if (u_t) { 1834 for (c = 0; c < Ncf; ++c) u_t[fOffset+c] = 0.0; 1835 for (b = 0; b < Nbf; ++b) { 1836 for (c = 0; c < Ncf; ++c) { 1837 const PetscInt cidx = b*Ncf+c; 1838 1839 u_t[fOffset+c] += Bq[cidx]*coefficients_t[dOffset+b]; 1840 } 1841 } 1842 ierr = PetscFEPushforward(fe, fegeom, 1, &u_t[fOffset]);CHKERRQ(ierr); 1843 } 1844 fOffset += Ncf; 1845 dOffset += Nbf; 1846 } 1847 return 0; 1848 } 1849 1850 PetscErrorCode PetscFEEvaluateFaceFields_Internal(PetscDS prob, PetscInt field, PetscInt faceLoc, const PetscScalar coefficients[], PetscScalar u[]) 1851 { 1852 PetscFE fe; 1853 PetscTabulation Tc; 1854 PetscInt b, c; 1855 PetscErrorCode ierr; 1856 1857 if (!prob) return 0; 1858 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr); 1859 ierr = PetscFEGetFaceCentroidTabulation(fe, &Tc);CHKERRQ(ierr); 1860 { 1861 const PetscReal *faceBasis = Tc->T[0]; 1862 const PetscInt Nb = Tc->Nb; 1863 const PetscInt Nc = Tc->Nc; 1864 1865 for (c = 0; c < Nc; ++c) {u[c] = 0.0;} 1866 for (b = 0; b < Nb; ++b) { 1867 for (c = 0; c < Nc; ++c) { 1868 const PetscInt cidx = b*Nc+c; 1869 1870 u[c] += coefficients[cidx]*faceBasis[faceLoc*Nb*Nc+cidx]; 1871 } 1872 } 1873 } 1874 return 0; 1875 } 1876 1877 PetscErrorCode PetscFEUpdateElementVec_Internal(PetscFE fe, PetscTabulation T, PetscInt r, PetscScalar tmpBasis[], PetscScalar tmpBasisDer[], PetscFEGeom *fegeom, PetscScalar f0[], PetscScalar f1[], PetscScalar elemVec[]) 1878 { 1879 const PetscInt dim = T->cdim; 1880 const PetscInt Nq = T->Np; 1881 const PetscInt Nb = T->Nb; 1882 const PetscInt Nc = T->Nc; 1883 const PetscReal *basis = &T->T[0][r*Nq*Nb*Nc]; 1884 const PetscReal *basisDer = &T->T[1][r*Nq*Nb*Nc*dim]; 1885 PetscInt q, b, c, d; 1886 PetscErrorCode ierr; 1887 1888 for (b = 0; b < Nb; ++b) elemVec[b] = 0.0; 1889 for (q = 0; q < Nq; ++q) { 1890 for (b = 0; b < Nb; ++b) { 1891 for (c = 0; c < Nc; ++c) { 1892 const PetscInt bcidx = b*Nc+c; 1893 1894 tmpBasis[bcidx] = basis[q*Nb*Nc+bcidx]; 1895 for (d = 0; d < dim; ++d) tmpBasisDer[bcidx*dim+d] = basisDer[q*Nb*Nc*dim+bcidx*dim+d]; 1896 } 1897 } 1898 ierr = PetscFEPushforward(fe, fegeom, Nb, tmpBasis);CHKERRQ(ierr); 1899 ierr = PetscFEPushforwardGradient(fe, fegeom, Nb, tmpBasisDer);CHKERRQ(ierr); 1900 for (b = 0; b < Nb; ++b) { 1901 for (c = 0; c < Nc; ++c) { 1902 const PetscInt bcidx = b*Nc+c; 1903 const PetscInt qcidx = q*Nc+c; 1904 1905 elemVec[b] += tmpBasis[bcidx]*f0[qcidx]; 1906 for (d = 0; d < dim; ++d) elemVec[b] += tmpBasisDer[bcidx*dim+d]*f1[qcidx*dim+d]; 1907 } 1908 } 1909 } 1910 return(0); 1911 } 1912 1913 PetscErrorCode PetscFEUpdateElementMat_Internal(PetscFE feI, PetscFE feJ, PetscInt r, PetscInt q, PetscTabulation TI, PetscScalar tmpBasisI[], PetscScalar tmpBasisDerI[], PetscTabulation TJ, PetscScalar tmpBasisJ[], PetscScalar tmpBasisDerJ[], PetscFEGeom *fegeom, const PetscScalar g0[], const PetscScalar g1[], const PetscScalar g2[], const PetscScalar g3[], PetscInt eOffset, PetscInt totDim, PetscInt offsetI, PetscInt offsetJ, PetscScalar elemMat[]) 1914 { 1915 const PetscInt dim = TI->cdim; 1916 const PetscInt NqI = TI->Np; 1917 const PetscInt NbI = TI->Nb; 1918 const PetscInt NcI = TI->Nc; 1919 const PetscReal *basisI = &TI->T[0][(r*NqI+q)*NbI*NcI]; 1920 const PetscReal *basisDerI = &TI->T[1][(r*NqI+q)*NbI*NcI*dim]; 1921 const PetscInt NqJ = TJ->Np; 1922 const PetscInt NbJ = TJ->Nb; 1923 const PetscInt NcJ = TJ->Nc; 1924 const PetscReal *basisJ = &TJ->T[0][(r*NqJ+q)*NbJ*NcJ]; 1925 const PetscReal *basisDerJ = &TJ->T[1][(r*NqJ+q)*NbJ*NcJ*dim]; 1926 PetscInt f, fc, g, gc, df, dg; 1927 PetscErrorCode ierr; 1928 1929 for (f = 0; f < NbI; ++f) { 1930 for (fc = 0; fc < NcI; ++fc) { 1931 const PetscInt fidx = f*NcI+fc; /* Test function basis index */ 1932 1933 tmpBasisI[fidx] = basisI[fidx]; 1934 for (df = 0; df < dim; ++df) tmpBasisDerI[fidx*dim+df] = basisDerI[fidx*dim+df]; 1935 } 1936 } 1937 ierr = PetscFEPushforward(feI, fegeom, NbI, tmpBasisI);CHKERRQ(ierr); 1938 ierr = PetscFEPushforwardGradient(feI, fegeom, NbI, tmpBasisDerI);CHKERRQ(ierr); 1939 for (g = 0; g < NbJ; ++g) { 1940 for (gc = 0; gc < NcJ; ++gc) { 1941 const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */ 1942 1943 tmpBasisJ[gidx] = basisJ[gidx]; 1944 for (dg = 0; dg < dim; ++dg) tmpBasisDerJ[gidx*dim+dg] = basisDerJ[gidx*dim+dg]; 1945 } 1946 } 1947 ierr = PetscFEPushforward(feJ, fegeom, NbJ, tmpBasisJ);CHKERRQ(ierr); 1948 ierr = PetscFEPushforwardGradient(feJ, fegeom, NbJ, tmpBasisDerJ);CHKERRQ(ierr); 1949 for (f = 0; f < NbI; ++f) { 1950 for (fc = 0; fc < NcI; ++fc) { 1951 const PetscInt fidx = f*NcI+fc; /* Test function basis index */ 1952 const PetscInt i = offsetI+f; /* Element matrix row */ 1953 for (g = 0; g < NbJ; ++g) { 1954 for (gc = 0; gc < NcJ; ++gc) { 1955 const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */ 1956 const PetscInt j = offsetJ+g; /* Element matrix column */ 1957 const PetscInt fOff = eOffset+i*totDim+j; 1958 1959 elemMat[fOff] += tmpBasisI[fidx]*g0[fc*NcJ+gc]*tmpBasisJ[gidx]; 1960 for (df = 0; df < dim; ++df) { 1961 elemMat[fOff] += tmpBasisI[fidx]*g1[(fc*NcJ+gc)*dim+df]*tmpBasisDerJ[gidx*dim+df]; 1962 elemMat[fOff] += tmpBasisDerI[fidx*dim+df]*g2[(fc*NcJ+gc)*dim+df]*tmpBasisJ[gidx]; 1963 for (dg = 0; dg < dim; ++dg) { 1964 elemMat[fOff] += tmpBasisDerI[fidx*dim+df]*g3[((fc*NcJ+gc)*dim+df)*dim+dg]*tmpBasisDerJ[gidx*dim+dg]; 1965 } 1966 } 1967 } 1968 } 1969 } 1970 } 1971 return(0); 1972 } 1973 1974 PetscErrorCode PetscFECreateCellGeometry(PetscFE fe, PetscQuadrature quad, PetscFEGeom *cgeom) 1975 { 1976 PetscDualSpace dsp; 1977 DM dm; 1978 PetscQuadrature quadDef; 1979 PetscInt dim, cdim, Nq; 1980 PetscErrorCode ierr; 1981 1982 PetscFunctionBegin; 1983 ierr = PetscFEGetDualSpace(fe, &dsp);CHKERRQ(ierr); 1984 ierr = PetscDualSpaceGetDM(dsp, &dm);CHKERRQ(ierr); 1985 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 1986 ierr = DMGetCoordinateDim(dm, &cdim);CHKERRQ(ierr); 1987 ierr = PetscFEGetQuadrature(fe, &quadDef);CHKERRQ(ierr); 1988 quad = quad ? quad : quadDef; 1989 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr); 1990 ierr = PetscMalloc1(Nq*cdim, &cgeom->v);CHKERRQ(ierr); 1991 ierr = PetscMalloc1(Nq*cdim*cdim, &cgeom->J);CHKERRQ(ierr); 1992 ierr = PetscMalloc1(Nq*cdim*cdim, &cgeom->invJ);CHKERRQ(ierr); 1993 ierr = PetscMalloc1(Nq, &cgeom->detJ);CHKERRQ(ierr); 1994 cgeom->dim = dim; 1995 cgeom->dimEmbed = cdim; 1996 cgeom->numCells = 1; 1997 cgeom->numPoints = Nq; 1998 ierr = DMPlexComputeCellGeometryFEM(dm, 0, quad, cgeom->v, cgeom->J, cgeom->invJ, cgeom->detJ);CHKERRQ(ierr); 1999 PetscFunctionReturn(0); 2000 } 2001 2002 PetscErrorCode PetscFEDestroyCellGeometry(PetscFE fe, PetscFEGeom *cgeom) 2003 { 2004 PetscErrorCode ierr; 2005 2006 PetscFunctionBegin; 2007 ierr = PetscFree(cgeom->v);CHKERRQ(ierr); 2008 ierr = PetscFree(cgeom->J);CHKERRQ(ierr); 2009 ierr = PetscFree(cgeom->invJ);CHKERRQ(ierr); 2010 ierr = PetscFree(cgeom->detJ);CHKERRQ(ierr); 2011 PetscFunctionReturn(0); 2012 } 2013