xref: /petsc/src/dm/dt/fe/interface/fe.c (revision 3280a7ba245b57f140f2314380c3a895b9c13f96)
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, &centroids);CHKERRQ(ierr);
911     for (f = 0; f < numFaces; ++f) {ierr = DMPlexComputeCellGeometryFVM(dm, cone[f], NULL, &centroids[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, 4);
960   PetscValidPointer(T, 6);
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   if (PetscDefined(USE_DEBUG)) {
1015     DM               dm;
1016     PetscDualSpace   Q;
1017     PetscInt         Nb;   /* Dimension of FE space P */
1018     PetscInt         Nc;   /* Field components */
1019     PetscInt         cdim; /* Reference coordinate dimension */
1020 
1021     ierr = PetscFEGetDualSpace(fem, &Q);CHKERRQ(ierr);
1022     ierr = PetscDualSpaceGetDM(Q, &dm);CHKERRQ(ierr);
1023     ierr = DMGetDimension(dm, &cdim);CHKERRQ(ierr);
1024     ierr = PetscDualSpaceGetDimension(Q, &Nb);CHKERRQ(ierr);
1025     ierr = PetscFEGetNumComponents(fem, &Nc);CHKERRQ(ierr);
1026     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);
1027     if (T->Nb   != Nb)              SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Tabulation Nb %D must match requested Nb %D", T->Nb, Nb);
1028     if (T->Nc   != Nc)              SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Tabulation Nc %D must match requested Nc %D", T->Nc, Nc);
1029     if (T->cdim != cdim)            SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Tabulation cdim %D must match requested cdim %D", T->cdim, cdim);
1030   }
1031   T->Nr = 1;
1032   T->Np = npoints;
1033   ierr = (*fem->ops->createtabulation)(fem, npoints, points, K, T);CHKERRQ(ierr);
1034   PetscFunctionReturn(0);
1035 }
1036 
1037 /*@C
1038   PetscTabulationDestroy - Frees memory from the associated tabulation.
1039 
1040   Not collective
1041 
1042   Input Parameter:
1043 . T - The tabulation
1044 
1045   Level: intermediate
1046 
1047 .seealso: PetscFECreateTabulation(), PetscFEGetCellTabulation()
1048 @*/
1049 PetscErrorCode PetscTabulationDestroy(PetscTabulation *T)
1050 {
1051   PetscInt       k;
1052   PetscErrorCode ierr;
1053 
1054   PetscFunctionBegin;
1055   PetscValidPointer(T, 1);
1056   if (!T || !(*T)) PetscFunctionReturn(0);
1057   for (k = 0; k <= (*T)->K; ++k) {ierr = PetscFree((*T)->T[k]);CHKERRQ(ierr);}
1058   ierr = PetscFree((*T)->T);CHKERRQ(ierr);
1059   ierr = PetscFree(*T);CHKERRQ(ierr);
1060   *T = NULL;
1061   PetscFunctionReturn(0);
1062 }
1063 
1064 PETSC_EXTERN PetscErrorCode PetscFECreatePointTrace(PetscFE fe, PetscInt refPoint, PetscFE *trFE)
1065 {
1066   PetscSpace     bsp, bsubsp;
1067   PetscDualSpace dsp, dsubsp;
1068   PetscInt       dim, depth, numComp, i, j, coneSize, order;
1069   PetscFEType    type;
1070   DM             dm;
1071   DMLabel        label;
1072   PetscReal      *xi, *v, *J, detJ;
1073   const char     *name;
1074   PetscQuadrature origin, fullQuad, subQuad;
1075   PetscErrorCode ierr;
1076 
1077   PetscFunctionBegin;
1078   PetscValidHeaderSpecific(fe,PETSCFE_CLASSID,1);
1079   PetscValidPointer(trFE,3);
1080   ierr = PetscFEGetBasisSpace(fe,&bsp);CHKERRQ(ierr);
1081   ierr = PetscFEGetDualSpace(fe,&dsp);CHKERRQ(ierr);
1082   ierr = PetscDualSpaceGetDM(dsp,&dm);CHKERRQ(ierr);
1083   ierr = DMGetDimension(dm,&dim);CHKERRQ(ierr);
1084   ierr = DMPlexGetDepthLabel(dm,&label);CHKERRQ(ierr);
1085   ierr = DMLabelGetValue(label,refPoint,&depth);CHKERRQ(ierr);
1086   ierr = PetscCalloc1(depth,&xi);CHKERRQ(ierr);
1087   ierr = PetscMalloc1(dim,&v);CHKERRQ(ierr);
1088   ierr = PetscMalloc1(dim*dim,&J);CHKERRQ(ierr);
1089   for (i = 0; i < depth; i++) xi[i] = 0.;
1090   ierr = PetscQuadratureCreate(PETSC_COMM_SELF,&origin);CHKERRQ(ierr);
1091   ierr = PetscQuadratureSetData(origin,depth,0,1,xi,NULL);CHKERRQ(ierr);
1092   ierr = DMPlexComputeCellGeometryFEM(dm,refPoint,origin,v,J,NULL,&detJ);CHKERRQ(ierr);
1093   /* CellGeometryFEM computes the expanded Jacobian, we want the true jacobian */
1094   for (i = 1; i < dim; i++) {
1095     for (j = 0; j < depth; j++) {
1096       J[i * depth + j] = J[i * dim + j];
1097     }
1098   }
1099   ierr = PetscQuadratureDestroy(&origin);CHKERRQ(ierr);
1100   ierr = PetscDualSpaceGetPointSubspace(dsp,refPoint,&dsubsp);CHKERRQ(ierr);
1101   ierr = PetscSpaceCreateSubspace(bsp,dsubsp,v,J,NULL,NULL,PETSC_OWN_POINTER,&bsubsp);CHKERRQ(ierr);
1102   ierr = PetscSpaceSetUp(bsubsp);CHKERRQ(ierr);
1103   ierr = PetscFECreate(PetscObjectComm((PetscObject)fe),trFE);CHKERRQ(ierr);
1104   ierr = PetscFEGetType(fe,&type);CHKERRQ(ierr);
1105   ierr = PetscFESetType(*trFE,type);CHKERRQ(ierr);
1106   ierr = PetscFEGetNumComponents(fe,&numComp);CHKERRQ(ierr);
1107   ierr = PetscFESetNumComponents(*trFE,numComp);CHKERRQ(ierr);
1108   ierr = PetscFESetBasisSpace(*trFE,bsubsp);CHKERRQ(ierr);
1109   ierr = PetscFESetDualSpace(*trFE,dsubsp);CHKERRQ(ierr);
1110   ierr = PetscObjectGetName((PetscObject) fe, &name);CHKERRQ(ierr);
1111   if (name) {ierr = PetscFESetName(*trFE, name);CHKERRQ(ierr);}
1112   ierr = PetscFEGetQuadrature(fe,&fullQuad);CHKERRQ(ierr);
1113   ierr = PetscQuadratureGetOrder(fullQuad,&order);CHKERRQ(ierr);
1114   ierr = DMPlexGetConeSize(dm,refPoint,&coneSize);CHKERRQ(ierr);
1115   if (coneSize == 2 * depth) {
1116     ierr = PetscDTGaussTensorQuadrature(depth,1,(order + 1)/2,-1.,1.,&subQuad);CHKERRQ(ierr);
1117   } else {
1118     ierr = PetscDTStroudConicalQuadrature(depth,1,(order + 1)/2,-1.,1.,&subQuad);CHKERRQ(ierr);
1119   }
1120   ierr = PetscFESetQuadrature(*trFE,subQuad);CHKERRQ(ierr);
1121   ierr = PetscFESetUp(*trFE);CHKERRQ(ierr);
1122   ierr = PetscQuadratureDestroy(&subQuad);CHKERRQ(ierr);
1123   ierr = PetscSpaceDestroy(&bsubsp);CHKERRQ(ierr);
1124   PetscFunctionReturn(0);
1125 }
1126 
1127 PetscErrorCode PetscFECreateHeightTrace(PetscFE fe, PetscInt height, PetscFE *trFE)
1128 {
1129   PetscInt       hStart, hEnd;
1130   PetscDualSpace dsp;
1131   DM             dm;
1132   PetscErrorCode ierr;
1133 
1134   PetscFunctionBegin;
1135   PetscValidHeaderSpecific(fe,PETSCFE_CLASSID,1);
1136   PetscValidPointer(trFE,3);
1137   *trFE = NULL;
1138   ierr = PetscFEGetDualSpace(fe,&dsp);CHKERRQ(ierr);
1139   ierr = PetscDualSpaceGetDM(dsp,&dm);CHKERRQ(ierr);
1140   ierr = DMPlexGetHeightStratum(dm,height,&hStart,&hEnd);CHKERRQ(ierr);
1141   if (hEnd <= hStart) PetscFunctionReturn(0);
1142   ierr = PetscFECreatePointTrace(fe,hStart,trFE);CHKERRQ(ierr);
1143   PetscFunctionReturn(0);
1144 }
1145 
1146 
1147 /*@
1148   PetscFEGetDimension - Get the dimension of the finite element space on a cell
1149 
1150   Not collective
1151 
1152   Input Parameter:
1153 . fe - The PetscFE
1154 
1155   Output Parameter:
1156 . dim - The dimension
1157 
1158   Level: intermediate
1159 
1160 .seealso: PetscFECreate(), PetscSpaceGetDimension(), PetscDualSpaceGetDimension()
1161 @*/
1162 PetscErrorCode PetscFEGetDimension(PetscFE fem, PetscInt *dim)
1163 {
1164   PetscErrorCode ierr;
1165 
1166   PetscFunctionBegin;
1167   PetscValidHeaderSpecific(fem, PETSCFE_CLASSID, 1);
1168   PetscValidPointer(dim, 2);
1169   if (fem->ops->getdimension) {ierr = (*fem->ops->getdimension)(fem, dim);CHKERRQ(ierr);}
1170   PetscFunctionReturn(0);
1171 }
1172 
1173 /*@C
1174   PetscFEPushforward - Map the reference element function to real space
1175 
1176   Input Parameters:
1177 + fe     - The PetscFE
1178 . fegeom - The cell geometry
1179 . Nv     - The number of function values
1180 - vals   - The function values
1181 
1182   Output Parameter:
1183 . vals   - The transformed function values
1184 
1185   Level: advanced
1186 
1187   Note: This just forwards the call onto PetscDualSpacePushforward().
1188 
1189   Note: This only handles tranformations when the embedding dimension of the geometry in fegeom is the same as the reference dimension.
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   Note: This only handles tranformations when the embedding dimension of the geometry in fegeom is the same as the reference dimension.
1219 
1220 .seealso: PetscFEPushforward(), PetscDualSpacePushforwardGradient(), PetscDualSpacePushforward()
1221 @*/
1222 PetscErrorCode PetscFEPushforwardGradient(PetscFE fe, PetscFEGeom *fegeom, PetscInt Nv, PetscScalar vals[])
1223 {
1224   PetscErrorCode ierr;
1225 
1226   PetscFunctionBeginHot;
1227   ierr = PetscDualSpacePushforwardGradient(fe->dualSpace, fegeom, Nv, fe->numComponents, vals);CHKERRQ(ierr);
1228   PetscFunctionReturn(0);
1229 }
1230 
1231 /*
1232 Purpose: Compute element vector for chunk of elements
1233 
1234 Input:
1235   Sizes:
1236      Ne:  number of elements
1237      Nf:  number of fields
1238      PetscFE
1239        dim: spatial dimension
1240        Nb:  number of basis functions
1241        Nc:  number of field components
1242        PetscQuadrature
1243          Nq:  number of quadrature points
1244 
1245   Geometry:
1246      PetscFEGeom[Ne] possibly *Nq
1247        PetscReal v0s[dim]
1248        PetscReal n[dim]
1249        PetscReal jacobians[dim*dim]
1250        PetscReal jacobianInverses[dim*dim]
1251        PetscReal jacobianDeterminants
1252   FEM:
1253      PetscFE
1254        PetscQuadrature
1255          PetscReal   quadPoints[Nq*dim]
1256          PetscReal   quadWeights[Nq]
1257        PetscReal   basis[Nq*Nb*Nc]
1258        PetscReal   basisDer[Nq*Nb*Nc*dim]
1259      PetscScalar coefficients[Ne*Nb*Nc]
1260      PetscScalar elemVec[Ne*Nb*Nc]
1261 
1262   Problem:
1263      PetscInt f: the active field
1264      f0, f1
1265 
1266   Work Space:
1267      PetscFE
1268        PetscScalar f0[Nq*dim];
1269        PetscScalar f1[Nq*dim*dim];
1270        PetscScalar u[Nc];
1271        PetscScalar gradU[Nc*dim];
1272        PetscReal   x[dim];
1273        PetscScalar realSpaceDer[dim];
1274 
1275 Purpose: Compute element vector for N_cb batches of elements
1276 
1277 Input:
1278   Sizes:
1279      N_cb: Number of serial cell batches
1280 
1281   Geometry:
1282      PetscReal v0s[Ne*dim]
1283      PetscReal jacobians[Ne*dim*dim]        possibly *Nq
1284      PetscReal jacobianInverses[Ne*dim*dim] possibly *Nq
1285      PetscReal jacobianDeterminants[Ne]     possibly *Nq
1286   FEM:
1287      static PetscReal   quadPoints[Nq*dim]
1288      static PetscReal   quadWeights[Nq]
1289      static PetscReal   basis[Nq*Nb*Nc]
1290      static PetscReal   basisDer[Nq*Nb*Nc*dim]
1291      PetscScalar coefficients[Ne*Nb*Nc]
1292      PetscScalar elemVec[Ne*Nb*Nc]
1293 
1294 ex62.c:
1295   PetscErrorCode PetscFEIntegrateResidualBatch(PetscInt Ne, PetscInt numFields, PetscInt field, PetscQuadrature quad[], const PetscScalar coefficients[],
1296                                                const PetscReal v0s[], const PetscReal jacobians[], const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[],
1297                                                void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f0[]),
1298                                                void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f1[]), PetscScalar elemVec[])
1299 
1300 ex52.c:
1301   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)
1302   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)
1303 
1304 ex52_integrateElement.cu
1305 __global__ void integrateElementQuadrature(int N_cb, realType *coefficients, realType *jacobianInverses, realType *jacobianDeterminants, realType *elemVec)
1306 
1307 PETSC_EXTERN PetscErrorCode IntegrateElementBatchGPU(PetscInt spatial_dim, PetscInt Ne, PetscInt Ncb, PetscInt Nbc, PetscInt Nbl, const PetscScalar coefficients[],
1308                                                      const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscScalar elemVec[],
1309                                                      PetscLogEvent event, PetscInt debug, PetscInt pde_op)
1310 
1311 ex52_integrateElementOpenCL.c:
1312 PETSC_EXTERN PetscErrorCode IntegrateElementBatchGPU(PetscInt spatial_dim, PetscInt Ne, PetscInt Ncb, PetscInt Nbc, PetscInt N_bl, const PetscScalar coefficients[],
1313                                                      const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscScalar elemVec[],
1314                                                      PetscLogEvent event, PetscInt debug, PetscInt pde_op)
1315 
1316 __kernel void integrateElementQuadrature(int N_cb, __global float *coefficients, __global float *jacobianInverses, __global float *jacobianDeterminants, __global float *elemVec)
1317 */
1318 
1319 /*@C
1320   PetscFEIntegrate - Produce the integral for the given field for a chunk of elements by quadrature integration
1321 
1322   Not collective
1323 
1324   Input Parameters:
1325 + fem          - The PetscFE object for the field being integrated
1326 . prob         - The PetscDS specifying the discretizations and continuum functions
1327 . field        - The field being integrated
1328 . Ne           - The number of elements in the chunk
1329 . cgeom        - The cell geometry for each cell in the chunk
1330 . coefficients - The array of FEM basis coefficients for the elements
1331 . probAux      - The PetscDS specifying the auxiliary discretizations
1332 - coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
1333 
1334   Output Parameter:
1335 . integral     - the integral for this field
1336 
1337   Level: intermediate
1338 
1339 .seealso: PetscFEIntegrateResidual()
1340 @*/
1341 PetscErrorCode PetscFEIntegrate(PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *cgeom,
1342                                 const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscScalar integral[])
1343 {
1344   PetscFE        fe;
1345   PetscErrorCode ierr;
1346 
1347   PetscFunctionBegin;
1348   PetscValidHeaderSpecific(prob, PETSCDS_CLASSID, 1);
1349   ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
1350   if (fe->ops->integrate) {ierr = (*fe->ops->integrate)(prob, field, Ne, cgeom, coefficients, probAux, coefficientsAux, integral);CHKERRQ(ierr);}
1351   PetscFunctionReturn(0);
1352 }
1353 
1354 /*@C
1355   PetscFEIntegrateBd - Produce the integral for the given field for a chunk of elements by quadrature integration
1356 
1357   Not collective
1358 
1359   Input Parameters:
1360 + fem          - The PetscFE object for the field being integrated
1361 . prob         - The PetscDS specifying the discretizations and continuum functions
1362 . field        - The field being integrated
1363 . obj_func     - The function to be integrated
1364 . Ne           - The number of elements in the chunk
1365 . fgeom        - The face geometry for each face in the chunk
1366 . coefficients - The array of FEM basis coefficients for the elements
1367 . probAux      - The PetscDS specifying the auxiliary discretizations
1368 - coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
1369 
1370   Output Parameter:
1371 . integral     - the integral for this field
1372 
1373   Level: intermediate
1374 
1375 .seealso: PetscFEIntegrateResidual()
1376 @*/
1377 PetscErrorCode PetscFEIntegrateBd(PetscDS prob, PetscInt field,
1378                                   void (*obj_func)(PetscInt, PetscInt, PetscInt,
1379                                                    const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1380                                                    const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1381                                                    PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]),
1382                                   PetscInt Ne, PetscFEGeom *geom, const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscScalar integral[])
1383 {
1384   PetscFE        fe;
1385   PetscErrorCode ierr;
1386 
1387   PetscFunctionBegin;
1388   PetscValidHeaderSpecific(prob, PETSCDS_CLASSID, 1);
1389   ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
1390   if (fe->ops->integratebd) {ierr = (*fe->ops->integratebd)(prob, field, obj_func, Ne, geom, coefficients, probAux, coefficientsAux, integral);CHKERRQ(ierr);}
1391   PetscFunctionReturn(0);
1392 }
1393 
1394 /*@C
1395   PetscFEIntegrateResidual - Produce the element residual vector for a chunk of elements by quadrature integration
1396 
1397   Not collective
1398 
1399   Input Parameters:
1400 + fem          - The PetscFE object for the field being integrated
1401 . prob         - The PetscDS specifying the discretizations and continuum functions
1402 . field        - The field being integrated
1403 . Ne           - The number of elements in the chunk
1404 . cgeom        - The cell geometry for each cell in the chunk
1405 . coefficients - The array of FEM basis coefficients for the elements
1406 . coefficients_t - The array of FEM basis time derivative coefficients for the elements
1407 . probAux      - The PetscDS specifying the auxiliary discretizations
1408 . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
1409 - t            - The time
1410 
1411   Output Parameter:
1412 . elemVec      - the element residual vectors from each element
1413 
1414   Note:
1415 $ Loop over batch of elements (e):
1416 $   Loop over quadrature points (q):
1417 $     Make u_q and gradU_q (loops over fields,Nb,Ncomp) and x_q
1418 $     Call f_0 and f_1
1419 $   Loop over element vector entries (f,fc --> i):
1420 $     elemVec[i] += \psi^{fc}_f(q) f0_{fc}(u, \nabla u) + \nabla\psi^{fc}_f(q) \cdot f1_{fc,df}(u, \nabla u)
1421 
1422   Level: intermediate
1423 
1424 .seealso: PetscFEIntegrateResidual()
1425 @*/
1426 PetscErrorCode PetscFEIntegrateResidual(PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *cgeom,
1427                                         const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
1428 {
1429   PetscFE        fe;
1430   PetscErrorCode ierr;
1431 
1432   PetscFunctionBegin;
1433   PetscValidHeaderSpecific(prob, PETSCDS_CLASSID, 1);
1434   ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
1435   if (fe->ops->integrateresidual) {ierr = (*fe->ops->integrateresidual)(prob, field, Ne, cgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);CHKERRQ(ierr);}
1436   PetscFunctionReturn(0);
1437 }
1438 
1439 /*@C
1440   PetscFEIntegrateBdResidual - Produce the element residual vector for a chunk of elements by quadrature integration over a boundary
1441 
1442   Not collective
1443 
1444   Input Parameters:
1445 + fem          - The PetscFE object for the field being integrated
1446 . prob         - The PetscDS specifying the discretizations and continuum functions
1447 . field        - The field being integrated
1448 . Ne           - The number of elements in the chunk
1449 . fgeom        - The face geometry for each cell in the chunk
1450 . coefficients - The array of FEM basis coefficients for the elements
1451 . coefficients_t - The array of FEM basis time derivative coefficients for the elements
1452 . probAux      - The PetscDS specifying the auxiliary discretizations
1453 . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
1454 - t            - The time
1455 
1456   Output Parameter:
1457 . elemVec      - the element residual vectors from each element
1458 
1459   Level: intermediate
1460 
1461 .seealso: PetscFEIntegrateResidual()
1462 @*/
1463 PetscErrorCode PetscFEIntegrateBdResidual(PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *fgeom,
1464                                           const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
1465 {
1466   PetscFE        fe;
1467   PetscErrorCode ierr;
1468 
1469   PetscFunctionBegin;
1470   PetscValidHeaderSpecific(prob, PETSCDS_CLASSID, 1);
1471   ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
1472   if (fe->ops->integratebdresidual) {ierr = (*fe->ops->integratebdresidual)(prob, field, Ne, fgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);CHKERRQ(ierr);}
1473   PetscFunctionReturn(0);
1474 }
1475 
1476 /*@C
1477   PetscFEIntegrateJacobian - Produce the element Jacobian for a chunk of elements by quadrature integration
1478 
1479   Not collective
1480 
1481   Input Parameters:
1482 + fem          - The PetscFE object for the field being integrated
1483 . prob         - The PetscDS specifying the discretizations and continuum functions
1484 . jtype        - The type of matrix pointwise functions that should be used
1485 . fieldI       - The test field being integrated
1486 . fieldJ       - The basis field being integrated
1487 . Ne           - The number of elements in the chunk
1488 . cgeom        - The cell geometry for each cell in the chunk
1489 . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
1490 . coefficients_t - The array of FEM basis time derivative coefficients for the elements
1491 . probAux      - The PetscDS specifying the auxiliary discretizations
1492 . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
1493 . t            - The time
1494 - u_tShift     - A multiplier for the dF/du_t term (as opposed to the dF/du term)
1495 
1496   Output Parameter:
1497 . elemMat      - the element matrices for the Jacobian from each element
1498 
1499   Note:
1500 $ Loop over batch of elements (e):
1501 $   Loop over element matrix entries (f,fc,g,gc --> i,j):
1502 $     Loop over quadrature points (q):
1503 $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
1504 $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
1505 $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
1506 $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
1507 $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
1508   Level: intermediate
1509 
1510 .seealso: PetscFEIntegrateResidual()
1511 @*/
1512 PetscErrorCode PetscFEIntegrateJacobian(PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEGeom *cgeom,
1513                                         const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
1514 {
1515   PetscFE        fe;
1516   PetscErrorCode ierr;
1517 
1518   PetscFunctionBegin;
1519   PetscValidHeaderSpecific(prob, PETSCDS_CLASSID, 1);
1520   ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
1521   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);}
1522   PetscFunctionReturn(0);
1523 }
1524 
1525 /*@C
1526   PetscFEIntegrateBdJacobian - Produce the boundary element Jacobian for a chunk of elements by quadrature integration
1527 
1528   Not collective
1529 
1530   Input Parameters:
1531 + prob         - The PetscDS specifying the discretizations and continuum functions
1532 . fieldI       - The test field being integrated
1533 . fieldJ       - The basis field being integrated
1534 . Ne           - The number of elements in the chunk
1535 . fgeom        - The face geometry for each cell in the chunk
1536 . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
1537 . coefficients_t - The array of FEM basis time derivative coefficients for the elements
1538 . probAux      - The PetscDS specifying the auxiliary discretizations
1539 . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
1540 . t            - The time
1541 - u_tShift     - A multiplier for the dF/du_t term (as opposed to the dF/du term)
1542 
1543   Output Parameter:
1544 . elemMat              - the element matrices for the Jacobian from each element
1545 
1546   Note:
1547 $ Loop over batch of elements (e):
1548 $   Loop over element matrix entries (f,fc,g,gc --> i,j):
1549 $     Loop over quadrature points (q):
1550 $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
1551 $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
1552 $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
1553 $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
1554 $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
1555   Level: intermediate
1556 
1557 .seealso: PetscFEIntegrateJacobian(), PetscFEIntegrateResidual()
1558 @*/
1559 PetscErrorCode PetscFEIntegrateBdJacobian(PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEGeom *fgeom,
1560                                           const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
1561 {
1562   PetscFE        fe;
1563   PetscErrorCode ierr;
1564 
1565   PetscFunctionBegin;
1566   PetscValidHeaderSpecific(prob, PETSCDS_CLASSID, 1);
1567   ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
1568   if (fe->ops->integratebdjacobian) {ierr = (*fe->ops->integratebdjacobian)(prob, fieldI, fieldJ, Ne, fgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, u_tshift, elemMat);CHKERRQ(ierr);}
1569   PetscFunctionReturn(0);
1570 }
1571 
1572 /*@
1573   PetscFEGetHeightSubspace - Get the subspace of this space for a mesh point of a given height
1574 
1575   Input Parameters:
1576 + fe     - The finite element space
1577 - height - The height of the Plex point
1578 
1579   Output Parameter:
1580 . subfe  - The subspace of this FE space
1581 
1582   Note: For example, if we want the subspace of this space for a face, we would choose height = 1.
1583 
1584   Level: advanced
1585 
1586 .seealso: PetscFECreateDefault()
1587 @*/
1588 PetscErrorCode PetscFEGetHeightSubspace(PetscFE fe, PetscInt height, PetscFE *subfe)
1589 {
1590   PetscSpace      P, subP;
1591   PetscDualSpace  Q, subQ;
1592   PetscQuadrature subq;
1593   PetscFEType     fetype;
1594   PetscInt        dim, Nc;
1595   PetscErrorCode  ierr;
1596 
1597   PetscFunctionBegin;
1598   PetscValidHeaderSpecific(fe, PETSCFE_CLASSID, 1);
1599   PetscValidPointer(subfe, 3);
1600   if (height == 0) {
1601     *subfe = fe;
1602     PetscFunctionReturn(0);
1603   }
1604   ierr = PetscFEGetBasisSpace(fe, &P);CHKERRQ(ierr);
1605   ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr);
1606   ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1607   ierr = PetscFEGetFaceQuadrature(fe, &subq);CHKERRQ(ierr);
1608   ierr = PetscDualSpaceGetDimension(Q, &dim);CHKERRQ(ierr);
1609   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);}
1610   if (!fe->subspaces) {ierr = PetscCalloc1(dim, &fe->subspaces);CHKERRQ(ierr);}
1611   if (height <= dim) {
1612     if (!fe->subspaces[height-1]) {
1613       PetscFE     sub;
1614       const char *name;
1615 
1616       ierr = PetscSpaceGetHeightSubspace(P, height, &subP);CHKERRQ(ierr);
1617       ierr = PetscDualSpaceGetHeightSubspace(Q, height, &subQ);CHKERRQ(ierr);
1618       ierr = PetscFECreate(PetscObjectComm((PetscObject) fe), &sub);CHKERRQ(ierr);
1619       ierr = PetscObjectGetName((PetscObject) fe,  &name);CHKERRQ(ierr);
1620       ierr = PetscObjectSetName((PetscObject) sub,  name);CHKERRQ(ierr);
1621       ierr = PetscFEGetType(fe, &fetype);CHKERRQ(ierr);
1622       ierr = PetscFESetType(sub, fetype);CHKERRQ(ierr);
1623       ierr = PetscFESetBasisSpace(sub, subP);CHKERRQ(ierr);
1624       ierr = PetscFESetDualSpace(sub, subQ);CHKERRQ(ierr);
1625       ierr = PetscFESetNumComponents(sub, Nc);CHKERRQ(ierr);
1626       ierr = PetscFESetUp(sub);CHKERRQ(ierr);
1627       ierr = PetscFESetQuadrature(sub, subq);CHKERRQ(ierr);
1628       fe->subspaces[height-1] = sub;
1629     }
1630     *subfe = fe->subspaces[height-1];
1631   } else {
1632     *subfe = NULL;
1633   }
1634   PetscFunctionReturn(0);
1635 }
1636 
1637 /*@
1638   PetscFERefine - Create a "refined" PetscFE object that refines the reference cell into smaller copies. This is typically used
1639   to precondition a higher order method with a lower order method on a refined mesh having the same number of dofs (but more
1640   sparsity). It is also used to create an interpolation between regularly refined meshes.
1641 
1642   Collective on fem
1643 
1644   Input Parameter:
1645 . fe - The initial PetscFE
1646 
1647   Output Parameter:
1648 . feRef - The refined PetscFE
1649 
1650   Level: advanced
1651 
1652 .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
1653 @*/
1654 PetscErrorCode PetscFERefine(PetscFE fe, PetscFE *feRef)
1655 {
1656   PetscSpace       P, Pref;
1657   PetscDualSpace   Q, Qref;
1658   DM               K, Kref;
1659   PetscQuadrature  q, qref;
1660   const PetscReal *v0, *jac;
1661   PetscInt         numComp, numSubelements;
1662   PetscInt         cStart, cEnd, c;
1663   PetscDualSpace  *cellSpaces;
1664   PetscErrorCode   ierr;
1665 
1666   PetscFunctionBegin;
1667   ierr = PetscFEGetBasisSpace(fe, &P);CHKERRQ(ierr);
1668   ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr);
1669   ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
1670   ierr = PetscDualSpaceGetDM(Q, &K);CHKERRQ(ierr);
1671   /* Create space */
1672   ierr = PetscObjectReference((PetscObject) P);CHKERRQ(ierr);
1673   Pref = P;
1674   /* Create dual space */
1675   ierr = PetscDualSpaceDuplicate(Q, &Qref);CHKERRQ(ierr);
1676   ierr = PetscDualSpaceSetType(Qref, PETSCDUALSPACEREFINED);CHKERRQ(ierr);
1677   ierr = DMRefine(K, PetscObjectComm((PetscObject) fe), &Kref);CHKERRQ(ierr);
1678   ierr = PetscDualSpaceSetDM(Qref, Kref);CHKERRQ(ierr);
1679   ierr = DMPlexGetHeightStratum(Kref, 0, &cStart, &cEnd);CHKERRQ(ierr);
1680   ierr = PetscMalloc1(cEnd - cStart, &cellSpaces);CHKERRQ(ierr);
1681   /* TODO: fix for non-uniform refinement */
1682   for (c = 0; c < cEnd - cStart; c++) cellSpaces[c] = Q;
1683   ierr = PetscDualSpaceRefinedSetCellSpaces(Qref, cellSpaces);CHKERRQ(ierr);
1684   ierr = PetscFree(cellSpaces);CHKERRQ(ierr);
1685   ierr = DMDestroy(&Kref);CHKERRQ(ierr);
1686   ierr = PetscDualSpaceSetUp(Qref);CHKERRQ(ierr);
1687   /* Create element */
1688   ierr = PetscFECreate(PetscObjectComm((PetscObject) fe), feRef);CHKERRQ(ierr);
1689   ierr = PetscFESetType(*feRef, PETSCFECOMPOSITE);CHKERRQ(ierr);
1690   ierr = PetscFESetBasisSpace(*feRef, Pref);CHKERRQ(ierr);
1691   ierr = PetscFESetDualSpace(*feRef, Qref);CHKERRQ(ierr);
1692   ierr = PetscFEGetNumComponents(fe,    &numComp);CHKERRQ(ierr);
1693   ierr = PetscFESetNumComponents(*feRef, numComp);CHKERRQ(ierr);
1694   ierr = PetscFESetUp(*feRef);CHKERRQ(ierr);
1695   ierr = PetscSpaceDestroy(&Pref);CHKERRQ(ierr);
1696   ierr = PetscDualSpaceDestroy(&Qref);CHKERRQ(ierr);
1697   /* Create quadrature */
1698   ierr = PetscFECompositeGetMapping(*feRef, &numSubelements, &v0, &jac, NULL);CHKERRQ(ierr);
1699   ierr = PetscQuadratureExpandComposite(q, numSubelements, v0, jac, &qref);CHKERRQ(ierr);
1700   ierr = PetscFESetQuadrature(*feRef, qref);CHKERRQ(ierr);
1701   ierr = PetscQuadratureDestroy(&qref);CHKERRQ(ierr);
1702   PetscFunctionReturn(0);
1703 }
1704 
1705 /*@C
1706   PetscFECreateDefault - Create a PetscFE for basic FEM computation
1707 
1708   Collective
1709 
1710   Input Parameters:
1711 + comm      - The MPI comm
1712 . dim       - The spatial dimension
1713 . Nc        - The number of components
1714 . isSimplex - Flag for simplex reference cell, otherwise its a tensor product
1715 . prefix    - The options prefix, or NULL
1716 - qorder    - The quadrature order or PETSC_DETERMINE to use PetscSpace polynomial degree
1717 
1718   Output Parameter:
1719 . fem - The PetscFE object
1720 
1721   Note:
1722   Each object is SetFromOption() during creation, so that the object may be customized from the command line.
1723 
1724   Level: beginner
1725 
1726 .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate()
1727 @*/
1728 PetscErrorCode PetscFECreateDefault(MPI_Comm comm, PetscInt dim, PetscInt Nc, PetscBool isSimplex, const char prefix[], PetscInt qorder, PetscFE *fem)
1729 {
1730   PetscQuadrature q, fq;
1731   DM              K;
1732   PetscSpace      P;
1733   PetscDualSpace  Q;
1734   PetscInt        order, quadPointsPerEdge;
1735   PetscBool       tensor = isSimplex ? PETSC_FALSE : PETSC_TRUE;
1736   PetscErrorCode  ierr;
1737 
1738   PetscFunctionBegin;
1739   /* Create space */
1740   ierr = PetscSpaceCreate(comm, &P);CHKERRQ(ierr);
1741   ierr = PetscObjectSetOptionsPrefix((PetscObject) P, prefix);CHKERRQ(ierr);
1742   ierr = PetscSpacePolynomialSetTensor(P, tensor);CHKERRQ(ierr);
1743   ierr = PetscSpaceSetNumComponents(P, Nc);CHKERRQ(ierr);
1744   ierr = PetscSpaceSetNumVariables(P, dim);CHKERRQ(ierr);
1745   ierr = PetscSpaceSetFromOptions(P);CHKERRQ(ierr);
1746   ierr = PetscSpaceSetUp(P);CHKERRQ(ierr);
1747   ierr = PetscSpaceGetDegree(P, &order, NULL);CHKERRQ(ierr);
1748   ierr = PetscSpacePolynomialGetTensor(P, &tensor);CHKERRQ(ierr);
1749   /* Create dual space */
1750   ierr = PetscDualSpaceCreate(comm, &Q);CHKERRQ(ierr);
1751   ierr = PetscDualSpaceSetType(Q,PETSCDUALSPACELAGRANGE);CHKERRQ(ierr);
1752   ierr = PetscObjectSetOptionsPrefix((PetscObject) Q, prefix);CHKERRQ(ierr);
1753   ierr = PetscDualSpaceCreateReferenceCell(Q, dim, isSimplex, &K);CHKERRQ(ierr);
1754   ierr = PetscDualSpaceSetDM(Q, K);CHKERRQ(ierr);
1755   ierr = DMDestroy(&K);CHKERRQ(ierr);
1756   ierr = PetscDualSpaceSetNumComponents(Q, Nc);CHKERRQ(ierr);
1757   ierr = PetscDualSpaceSetOrder(Q, order);CHKERRQ(ierr);
1758   ierr = PetscDualSpaceLagrangeSetTensor(Q, tensor);CHKERRQ(ierr);
1759   ierr = PetscDualSpaceSetFromOptions(Q);CHKERRQ(ierr);
1760   ierr = PetscDualSpaceSetUp(Q);CHKERRQ(ierr);
1761   /* Create element */
1762   ierr = PetscFECreate(comm, fem);CHKERRQ(ierr);
1763   ierr = PetscObjectSetOptionsPrefix((PetscObject) *fem, prefix);CHKERRQ(ierr);
1764   ierr = PetscFESetBasisSpace(*fem, P);CHKERRQ(ierr);
1765   ierr = PetscFESetDualSpace(*fem, Q);CHKERRQ(ierr);
1766   ierr = PetscFESetNumComponents(*fem, Nc);CHKERRQ(ierr);
1767   ierr = PetscFESetFromOptions(*fem);CHKERRQ(ierr);
1768   ierr = PetscFESetUp(*fem);CHKERRQ(ierr);
1769   ierr = PetscSpaceDestroy(&P);CHKERRQ(ierr);
1770   ierr = PetscDualSpaceDestroy(&Q);CHKERRQ(ierr);
1771   /* Create quadrature (with specified order if given) */
1772   qorder = qorder >= 0 ? qorder : order;
1773   ierr = PetscObjectOptionsBegin((PetscObject)*fem);CHKERRQ(ierr);
1774   ierr = PetscOptionsBoundedInt("-petscfe_default_quadrature_order","Quadrature order is one less than quadrature points per edge","PetscFECreateDefault",qorder,&qorder,NULL,0);CHKERRQ(ierr);
1775   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1776   quadPointsPerEdge = PetscMax(qorder + 1,1);
1777   if (isSimplex) {
1778     ierr = PetscDTStroudConicalQuadrature(dim,   1, quadPointsPerEdge, -1.0, 1.0, &q);CHKERRQ(ierr);
1779     ierr = PetscDTStroudConicalQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);CHKERRQ(ierr);
1780   } else {
1781     ierr = PetscDTGaussTensorQuadrature(dim,   1, quadPointsPerEdge, -1.0, 1.0, &q);CHKERRQ(ierr);
1782     ierr = PetscDTGaussTensorQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);CHKERRQ(ierr);
1783   }
1784   ierr = PetscFESetQuadrature(*fem, q);CHKERRQ(ierr);
1785   ierr = PetscFESetFaceQuadrature(*fem, fq);CHKERRQ(ierr);
1786   ierr = PetscQuadratureDestroy(&q);CHKERRQ(ierr);
1787   ierr = PetscQuadratureDestroy(&fq);CHKERRQ(ierr);
1788   PetscFunctionReturn(0);
1789 }
1790 
1791 /*@
1792   PetscFECreateLagrange - Create a PetscFE for the basic Lagrange space of degree k
1793 
1794   Collective
1795 
1796   Input Parameters:
1797 + comm      - The MPI comm
1798 . dim       - The spatial dimension
1799 . Nc        - The number of components
1800 . isSimplex - Flag for simplex reference cell, otherwise its a tensor product
1801 . k         - The degree k of the space
1802 - qorder    - The quadrature order or PETSC_DETERMINE to use PetscSpace polynomial degree
1803 
1804   Output Parameter:
1805 . fem       - The PetscFE object
1806 
1807   Level: beginner
1808 
1809   Notes:
1810   For simplices, this element is the space of maximum polynomial degree k, otherwise it is a tensor product of 1D polynomials, each with maximal degree k.
1811 
1812 .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate()
1813 @*/
1814 PetscErrorCode PetscFECreateLagrange(MPI_Comm comm, PetscInt dim, PetscInt Nc, PetscBool isSimplex, PetscInt k, PetscInt qorder, PetscFE *fem)
1815 {
1816   PetscQuadrature q, fq;
1817   DM              K;
1818   PetscSpace      P;
1819   PetscDualSpace  Q;
1820   PetscInt        quadPointsPerEdge;
1821   PetscBool       tensor = isSimplex ? PETSC_FALSE : PETSC_TRUE;
1822   char            name[64];
1823   PetscErrorCode  ierr;
1824 
1825   PetscFunctionBegin;
1826   /* Create space */
1827   ierr = PetscSpaceCreate(comm, &P);CHKERRQ(ierr);
1828   ierr = PetscSpaceSetType(P, PETSCSPACEPOLYNOMIAL);CHKERRQ(ierr);
1829   ierr = PetscSpacePolynomialSetTensor(P, tensor);CHKERRQ(ierr);
1830   ierr = PetscSpaceSetNumComponents(P, Nc);CHKERRQ(ierr);
1831   ierr = PetscSpaceSetNumVariables(P, dim);CHKERRQ(ierr);
1832   ierr = PetscSpaceSetDegree(P, k, PETSC_DETERMINE);CHKERRQ(ierr);
1833   ierr = PetscSpaceSetUp(P);CHKERRQ(ierr);
1834   /* Create dual space */
1835   ierr = PetscDualSpaceCreate(comm, &Q);CHKERRQ(ierr);
1836   ierr = PetscDualSpaceSetType(Q, PETSCDUALSPACELAGRANGE);CHKERRQ(ierr);
1837   ierr = PetscDualSpaceCreateReferenceCell(Q, dim, isSimplex, &K);CHKERRQ(ierr);
1838   ierr = PetscDualSpaceSetDM(Q, K);CHKERRQ(ierr);
1839   ierr = DMDestroy(&K);CHKERRQ(ierr);
1840   ierr = PetscDualSpaceSetNumComponents(Q, Nc);CHKERRQ(ierr);
1841   ierr = PetscDualSpaceSetOrder(Q, k);CHKERRQ(ierr);
1842   ierr = PetscDualSpaceLagrangeSetTensor(Q, tensor);CHKERRQ(ierr);
1843   ierr = PetscDualSpaceSetUp(Q);CHKERRQ(ierr);
1844   /* Create element */
1845   ierr = PetscFECreate(comm, fem);CHKERRQ(ierr);
1846   ierr = PetscSNPrintf(name, 64, "P%d", (int) k);CHKERRQ(ierr);
1847   ierr = PetscObjectSetName((PetscObject) *fem, name);CHKERRQ(ierr);
1848   ierr = PetscFESetType(*fem, PETSCFEBASIC);CHKERRQ(ierr);
1849   ierr = PetscFESetBasisSpace(*fem, P);CHKERRQ(ierr);
1850   ierr = PetscFESetDualSpace(*fem, Q);CHKERRQ(ierr);
1851   ierr = PetscFESetNumComponents(*fem, Nc);CHKERRQ(ierr);
1852   ierr = PetscFESetUp(*fem);CHKERRQ(ierr);
1853   ierr = PetscSpaceDestroy(&P);CHKERRQ(ierr);
1854   ierr = PetscDualSpaceDestroy(&Q);CHKERRQ(ierr);
1855   /* Create quadrature (with specified order if given) */
1856   qorder = qorder >= 0 ? qorder : k;
1857   quadPointsPerEdge = PetscMax(qorder + 1,1);
1858   if (isSimplex) {
1859     ierr = PetscDTStroudConicalQuadrature(dim,   1, quadPointsPerEdge, -1.0, 1.0, &q);CHKERRQ(ierr);
1860     ierr = PetscDTStroudConicalQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);CHKERRQ(ierr);
1861   } else {
1862     ierr = PetscDTGaussTensorQuadrature(dim,   1, quadPointsPerEdge, -1.0, 1.0, &q);CHKERRQ(ierr);
1863     ierr = PetscDTGaussTensorQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);CHKERRQ(ierr);
1864   }
1865   ierr = PetscFESetQuadrature(*fem, q);CHKERRQ(ierr);
1866   ierr = PetscFESetFaceQuadrature(*fem, fq);CHKERRQ(ierr);
1867   ierr = PetscQuadratureDestroy(&q);CHKERRQ(ierr);
1868   ierr = PetscQuadratureDestroy(&fq);CHKERRQ(ierr);
1869   PetscFunctionReturn(0);
1870 }
1871 
1872 /*@C
1873   PetscFESetName - Names the FE and its subobjects
1874 
1875   Not collective
1876 
1877   Input Parameters:
1878 + fe   - The PetscFE
1879 - name - The name
1880 
1881   Level: intermediate
1882 
1883 .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate()
1884 @*/
1885 PetscErrorCode PetscFESetName(PetscFE fe, const char name[])
1886 {
1887   PetscSpace     P;
1888   PetscDualSpace Q;
1889   PetscErrorCode ierr;
1890 
1891   PetscFunctionBegin;
1892   ierr = PetscFEGetBasisSpace(fe, &P);CHKERRQ(ierr);
1893   ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr);
1894   ierr = PetscObjectSetName((PetscObject) fe, name);CHKERRQ(ierr);
1895   ierr = PetscObjectSetName((PetscObject) P,  name);CHKERRQ(ierr);
1896   ierr = PetscObjectSetName((PetscObject) Q,  name);CHKERRQ(ierr);
1897   PetscFunctionReturn(0);
1898 }
1899 
1900 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[])
1901 {
1902   PetscInt       dOffset = 0, fOffset = 0, f;
1903   PetscErrorCode ierr;
1904 
1905   for (f = 0; f < Nf; ++f) {
1906     PetscFE          fe;
1907     const PetscInt   cdim = T[f]->cdim;
1908     const PetscInt   Nq   = T[f]->Np;
1909     const PetscInt   Nbf  = T[f]->Nb;
1910     const PetscInt   Ncf  = T[f]->Nc;
1911     const PetscReal *Bq   = &T[f]->T[0][(r*Nq+q)*Nbf*Ncf];
1912     const PetscReal *Dq   = &T[f]->T[1][(r*Nq+q)*Nbf*Ncf*cdim];
1913     PetscInt         b, c, d;
1914 
1915     ierr = PetscDSGetDiscretization(ds, f, (PetscObject *) &fe);CHKERRQ(ierr);
1916     for (c = 0; c < Ncf; ++c) u[fOffset+c] = 0.0;
1917     for (d = 0; d < cdim*Ncf; ++d) u_x[fOffset*cdim+d] = 0.0;
1918     for (b = 0; b < Nbf; ++b) {
1919       for (c = 0; c < Ncf; ++c) {
1920         const PetscInt cidx = b*Ncf+c;
1921 
1922         u[fOffset+c] += Bq[cidx]*coefficients[dOffset+b];
1923         for (d = 0; d < cdim; ++d) u_x[(fOffset+c)*cdim+d] += Dq[cidx*cdim+d]*coefficients[dOffset+b];
1924       }
1925     }
1926     ierr = PetscFEPushforward(fe, fegeom, 1, &u[fOffset]);CHKERRQ(ierr);
1927     ierr = PetscFEPushforwardGradient(fe, fegeom, 1, &u_x[fOffset*cdim]);CHKERRQ(ierr);
1928     if (u_t) {
1929       for (c = 0; c < Ncf; ++c) u_t[fOffset+c] = 0.0;
1930       for (b = 0; b < Nbf; ++b) {
1931         for (c = 0; c < Ncf; ++c) {
1932           const PetscInt cidx = b*Ncf+c;
1933 
1934           u_t[fOffset+c] += Bq[cidx]*coefficients_t[dOffset+b];
1935         }
1936       }
1937       ierr = PetscFEPushforward(fe, fegeom, 1, &u_t[fOffset]);CHKERRQ(ierr);
1938     }
1939     fOffset += Ncf;
1940     dOffset += Nbf;
1941   }
1942   return 0;
1943 }
1944 
1945 PetscErrorCode PetscFEEvaluateFaceFields_Internal(PetscDS prob, PetscInt field, PetscInt faceLoc, const PetscScalar coefficients[], PetscScalar u[])
1946 {
1947   PetscFE         fe;
1948   PetscTabulation Tc;
1949   PetscInt        b, c;
1950   PetscErrorCode  ierr;
1951 
1952   if (!prob) return 0;
1953   ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
1954   ierr = PetscFEGetFaceCentroidTabulation(fe, &Tc);CHKERRQ(ierr);
1955   {
1956     const PetscReal *faceBasis = Tc->T[0];
1957     const PetscInt   Nb        = Tc->Nb;
1958     const PetscInt   Nc        = Tc->Nc;
1959 
1960     for (c = 0; c < Nc; ++c) {u[c] = 0.0;}
1961     for (b = 0; b < Nb; ++b) {
1962       for (c = 0; c < Nc; ++c) {
1963         const PetscInt cidx = b*Nc+c;
1964 
1965         u[c] += coefficients[cidx]*faceBasis[faceLoc*Nb*Nc+cidx];
1966       }
1967     }
1968   }
1969   return 0;
1970 }
1971 
1972 PetscErrorCode PetscFEUpdateElementVec_Internal(PetscFE fe, PetscTabulation T, PetscInt r, PetscScalar tmpBasis[], PetscScalar tmpBasisDer[], PetscFEGeom *fegeom, PetscScalar f0[], PetscScalar f1[], PetscScalar elemVec[])
1973 {
1974   const PetscInt   dim      = T->cdim;
1975   const PetscInt   Nq       = T->Np;
1976   const PetscInt   Nb       = T->Nb;
1977   const PetscInt   Nc       = T->Nc;
1978   const PetscReal *basis    = &T->T[0][r*Nq*Nb*Nc];
1979   const PetscReal *basisDer = &T->T[1][r*Nq*Nb*Nc*dim];
1980   PetscInt         q, b, c, d;
1981   PetscErrorCode   ierr;
1982 
1983   for (b = 0; b < Nb; ++b) elemVec[b] = 0.0;
1984   for (q = 0; q < Nq; ++q) {
1985     for (b = 0; b < Nb; ++b) {
1986       for (c = 0; c < Nc; ++c) {
1987         const PetscInt bcidx = b*Nc+c;
1988 
1989         tmpBasis[bcidx] = basis[q*Nb*Nc+bcidx];
1990         for (d = 0; d < dim; ++d) tmpBasisDer[bcidx*dim+d] = basisDer[q*Nb*Nc*dim+bcidx*dim+d];
1991       }
1992     }
1993     ierr = PetscFEPushforward(fe, fegeom, Nb, tmpBasis);CHKERRQ(ierr);
1994     ierr = PetscFEPushforwardGradient(fe, fegeom, Nb, tmpBasisDer);CHKERRQ(ierr);
1995     for (b = 0; b < Nb; ++b) {
1996       for (c = 0; c < Nc; ++c) {
1997         const PetscInt bcidx = b*Nc+c;
1998         const PetscInt qcidx = q*Nc+c;
1999 
2000         elemVec[b] += tmpBasis[bcidx]*f0[qcidx];
2001         for (d = 0; d < dim; ++d) elemVec[b] += tmpBasisDer[bcidx*dim+d]*f1[qcidx*dim+d];
2002       }
2003     }
2004   }
2005   return(0);
2006 }
2007 
2008 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[])
2009 {
2010   const PetscInt   dim       = TI->cdim;
2011   const PetscInt   NqI       = TI->Np;
2012   const PetscInt   NbI       = TI->Nb;
2013   const PetscInt   NcI       = TI->Nc;
2014   const PetscReal *basisI    = &TI->T[0][(r*NqI+q)*NbI*NcI];
2015   const PetscReal *basisDerI = &TI->T[1][(r*NqI+q)*NbI*NcI*dim];
2016   const PetscInt   NqJ       = TJ->Np;
2017   const PetscInt   NbJ       = TJ->Nb;
2018   const PetscInt   NcJ       = TJ->Nc;
2019   const PetscReal *basisJ    = &TJ->T[0][(r*NqJ+q)*NbJ*NcJ];
2020   const PetscReal *basisDerJ = &TJ->T[1][(r*NqJ+q)*NbJ*NcJ*dim];
2021   PetscInt         f, fc, g, gc, df, dg;
2022   PetscErrorCode   ierr;
2023 
2024   for (f = 0; f < NbI; ++f) {
2025     for (fc = 0; fc < NcI; ++fc) {
2026       const PetscInt fidx = f*NcI+fc; /* Test function basis index */
2027 
2028       tmpBasisI[fidx] = basisI[fidx];
2029       for (df = 0; df < dim; ++df) tmpBasisDerI[fidx*dim+df] = basisDerI[fidx*dim+df];
2030     }
2031   }
2032   ierr = PetscFEPushforward(feI, fegeom, NbI, tmpBasisI);CHKERRQ(ierr);
2033   ierr = PetscFEPushforwardGradient(feI, fegeom, NbI, tmpBasisDerI);CHKERRQ(ierr);
2034   for (g = 0; g < NbJ; ++g) {
2035     for (gc = 0; gc < NcJ; ++gc) {
2036       const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
2037 
2038       tmpBasisJ[gidx] = basisJ[gidx];
2039       for (dg = 0; dg < dim; ++dg) tmpBasisDerJ[gidx*dim+dg] = basisDerJ[gidx*dim+dg];
2040     }
2041   }
2042   ierr = PetscFEPushforward(feJ, fegeom, NbJ, tmpBasisJ);CHKERRQ(ierr);
2043   ierr = PetscFEPushforwardGradient(feJ, fegeom, NbJ, tmpBasisDerJ);CHKERRQ(ierr);
2044   for (f = 0; f < NbI; ++f) {
2045     for (fc = 0; fc < NcI; ++fc) {
2046       const PetscInt fidx = f*NcI+fc; /* Test function basis index */
2047       const PetscInt i    = offsetI+f; /* Element matrix row */
2048       for (g = 0; g < NbJ; ++g) {
2049         for (gc = 0; gc < NcJ; ++gc) {
2050           const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
2051           const PetscInt j    = offsetJ+g; /* Element matrix column */
2052           const PetscInt fOff = eOffset+i*totDim+j;
2053 
2054           elemMat[fOff] += tmpBasisI[fidx]*g0[fc*NcJ+gc]*tmpBasisJ[gidx];
2055           for (df = 0; df < dim; ++df) {
2056             elemMat[fOff] += tmpBasisI[fidx]*g1[(fc*NcJ+gc)*dim+df]*tmpBasisDerJ[gidx*dim+df];
2057             elemMat[fOff] += tmpBasisDerI[fidx*dim+df]*g2[(fc*NcJ+gc)*dim+df]*tmpBasisJ[gidx];
2058             for (dg = 0; dg < dim; ++dg) {
2059               elemMat[fOff] += tmpBasisDerI[fidx*dim+df]*g3[((fc*NcJ+gc)*dim+df)*dim+dg]*tmpBasisDerJ[gidx*dim+dg];
2060             }
2061           }
2062         }
2063       }
2064     }
2065   }
2066   return(0);
2067 }
2068 
2069 PetscErrorCode PetscFECreateCellGeometry(PetscFE fe, PetscQuadrature quad, PetscFEGeom *cgeom)
2070 {
2071   PetscDualSpace  dsp;
2072   DM              dm;
2073   PetscQuadrature quadDef;
2074   PetscInt        dim, cdim, Nq;
2075   PetscErrorCode  ierr;
2076 
2077   PetscFunctionBegin;
2078   ierr = PetscFEGetDualSpace(fe, &dsp);CHKERRQ(ierr);
2079   ierr = PetscDualSpaceGetDM(dsp, &dm);CHKERRQ(ierr);
2080   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2081   ierr = DMGetCoordinateDim(dm, &cdim);CHKERRQ(ierr);
2082   ierr = PetscFEGetQuadrature(fe, &quadDef);CHKERRQ(ierr);
2083   quad = quad ? quad : quadDef;
2084   ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
2085   ierr = PetscMalloc1(Nq*cdim,      &cgeom->v);CHKERRQ(ierr);
2086   ierr = PetscMalloc1(Nq*cdim*cdim, &cgeom->J);CHKERRQ(ierr);
2087   ierr = PetscMalloc1(Nq*cdim*cdim, &cgeom->invJ);CHKERRQ(ierr);
2088   ierr = PetscMalloc1(Nq,           &cgeom->detJ);CHKERRQ(ierr);
2089   cgeom->dim       = dim;
2090   cgeom->dimEmbed  = cdim;
2091   cgeom->numCells  = 1;
2092   cgeom->numPoints = Nq;
2093   ierr = DMPlexComputeCellGeometryFEM(dm, 0, quad, cgeom->v, cgeom->J, cgeom->invJ, cgeom->detJ);CHKERRQ(ierr);
2094   PetscFunctionReturn(0);
2095 }
2096 
2097 PetscErrorCode PetscFEDestroyCellGeometry(PetscFE fe, PetscFEGeom *cgeom)
2098 {
2099   PetscErrorCode ierr;
2100 
2101   PetscFunctionBegin;
2102   ierr = PetscFree(cgeom->v);CHKERRQ(ierr);
2103   ierr = PetscFree(cgeom->J);CHKERRQ(ierr);
2104   ierr = PetscFree(cgeom->invJ);CHKERRQ(ierr);
2105   ierr = PetscFree(cgeom->detJ);CHKERRQ(ierr);
2106   PetscFunctionReturn(0);
2107 }
2108