xref: /petsc/src/dm/dt/fe/interface/fe.c (revision 3f27d89970ea7eca446883c23db92691e281cd4c)
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 #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 = PetscDTStroudConicalQuadrature(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, const PetscScalar refVals[], PetscScalar realVals[])
1194 {
1195   PetscErrorCode ierr;
1196 
1197   PetscFunctionBeginHot;
1198   ierr = PetscDualSpacePushforward(fe->dualSpace, fegeom, Nv, fe->numComponents, refVals, realVals);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, const PetscScalar refVals[], PetscScalar realVals[])
1221 {
1222   PetscErrorCode ierr;
1223 
1224   PetscFunctionBeginHot;
1225   ierr = PetscDualSpacePushforwardGradient(fe->dualSpace, fegeom, Nv, fe->numComponents, NULL, realVals);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   PetscInt         cStart, cEnd, c;
1661   PetscDualSpace  *cellSpaces;
1662   PetscErrorCode   ierr;
1663 
1664   PetscFunctionBegin;
1665   ierr = PetscFEGetBasisSpace(fe, &P);CHKERRQ(ierr);
1666   ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr);
1667   ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
1668   ierr = PetscDualSpaceGetDM(Q, &K);CHKERRQ(ierr);
1669   /* Create space */
1670   ierr = PetscObjectReference((PetscObject) P);CHKERRQ(ierr);
1671   Pref = P;
1672   /* Create dual space */
1673   ierr = PetscDualSpaceDuplicate(Q, &Qref);CHKERRQ(ierr);
1674   ierr = PetscDualSpaceSetType(Qref, PETSCDUALSPACEREFINED);CHKERRQ(ierr);
1675   ierr = DMRefine(K, PetscObjectComm((PetscObject) fe), &Kref);CHKERRQ(ierr);
1676   ierr = PetscDualSpaceSetDM(Qref, Kref);CHKERRQ(ierr);
1677   ierr = DMPlexGetHeightStratum(Kref, 0, &cStart, &cEnd);CHKERRQ(ierr);
1678   ierr = PetscMalloc1(cEnd - cStart, &cellSpaces);CHKERRQ(ierr);
1679   /* TODO: fix for non-uniform refinement */
1680   for (c = 0; c < cEnd - cStart; c++) cellSpaces[c] = Q;
1681   ierr = PetscDualSpaceRefinedSetCellSpaces(Qref, cellSpaces);CHKERRQ(ierr);
1682   ierr = PetscFree(cellSpaces);CHKERRQ(ierr);
1683   ierr = DMDestroy(&Kref);CHKERRQ(ierr);
1684   ierr = PetscDualSpaceSetUp(Qref);CHKERRQ(ierr);
1685   /* Create element */
1686   ierr = PetscFECreate(PetscObjectComm((PetscObject) fe), feRef);CHKERRQ(ierr);
1687   ierr = PetscFESetType(*feRef, PETSCFECOMPOSITE);CHKERRQ(ierr);
1688   ierr = PetscFESetBasisSpace(*feRef, Pref);CHKERRQ(ierr);
1689   ierr = PetscFESetDualSpace(*feRef, Qref);CHKERRQ(ierr);
1690   ierr = PetscFEGetNumComponents(fe,    &numComp);CHKERRQ(ierr);
1691   ierr = PetscFESetNumComponents(*feRef, numComp);CHKERRQ(ierr);
1692   ierr = PetscFESetUp(*feRef);CHKERRQ(ierr);
1693   ierr = PetscSpaceDestroy(&Pref);CHKERRQ(ierr);
1694   ierr = PetscDualSpaceDestroy(&Qref);CHKERRQ(ierr);
1695   /* Create quadrature */
1696   ierr = PetscFECompositeGetMapping(*feRef, &numSubelements, &v0, &jac, NULL);CHKERRQ(ierr);
1697   ierr = PetscQuadratureExpandComposite(q, numSubelements, v0, jac, &qref);CHKERRQ(ierr);
1698   ierr = PetscFESetQuadrature(*feRef, qref);CHKERRQ(ierr);
1699   ierr = PetscQuadratureDestroy(&qref);CHKERRQ(ierr);
1700   PetscFunctionReturn(0);
1701 }
1702 
1703 /*@C
1704   PetscFECreateDefault - Create a PetscFE for basic FEM computation
1705 
1706   Collective
1707 
1708   Input Parameters:
1709 + comm      - The MPI comm
1710 . dim       - The spatial dimension
1711 . Nc        - The number of components
1712 . isSimplex - Flag for simplex reference cell, otherwise its a tensor product
1713 . prefix    - The options prefix, or NULL
1714 - qorder    - The quadrature order or PETSC_DETERMINE to use PetscSpace polynomial degree
1715 
1716   Output Parameter:
1717 . fem - The PetscFE object
1718 
1719   Note:
1720   Each object is SetFromOption() during creation, so that the object may be customized from the command line.
1721 
1722   Level: beginner
1723 
1724 .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate()
1725 @*/
1726 PetscErrorCode PetscFECreateDefault(MPI_Comm comm, PetscInt dim, PetscInt Nc, PetscBool isSimplex, const char prefix[], PetscInt qorder, PetscFE *fem)
1727 {
1728   PetscQuadrature q, fq;
1729   DM              K;
1730   PetscSpace      P;
1731   PetscDualSpace  Q;
1732   PetscInt        order, quadPointsPerEdge;
1733   PetscBool       tensor = isSimplex ? PETSC_FALSE : PETSC_TRUE;
1734   PetscErrorCode  ierr;
1735 
1736   PetscFunctionBegin;
1737   /* Create space */
1738   ierr = PetscSpaceCreate(comm, &P);CHKERRQ(ierr);
1739   ierr = PetscObjectSetOptionsPrefix((PetscObject) P, prefix);CHKERRQ(ierr);
1740   ierr = PetscSpacePolynomialSetTensor(P, tensor);CHKERRQ(ierr);
1741   ierr = PetscSpaceSetNumComponents(P, Nc);CHKERRQ(ierr);
1742   ierr = PetscSpaceSetNumVariables(P, dim);CHKERRQ(ierr);
1743   ierr = PetscSpaceSetFromOptions(P);CHKERRQ(ierr);
1744   ierr = PetscSpaceSetUp(P);CHKERRQ(ierr);
1745   ierr = PetscSpaceGetDegree(P, &order, NULL);CHKERRQ(ierr);
1746   ierr = PetscSpacePolynomialGetTensor(P, &tensor);CHKERRQ(ierr);
1747   /* Create dual space */
1748   ierr = PetscDualSpaceCreate(comm, &Q);CHKERRQ(ierr);
1749   ierr = PetscDualSpaceSetType(Q,PETSCDUALSPACELAGRANGE);CHKERRQ(ierr);
1750   ierr = PetscObjectSetOptionsPrefix((PetscObject) Q, prefix);CHKERRQ(ierr);
1751   ierr = PetscDualSpaceCreateReferenceCell(Q, dim, isSimplex, &K);CHKERRQ(ierr);
1752   ierr = PetscDualSpaceSetDM(Q, K);CHKERRQ(ierr);
1753   ierr = DMDestroy(&K);CHKERRQ(ierr);
1754   ierr = PetscDualSpaceSetNumComponents(Q, Nc);CHKERRQ(ierr);
1755   ierr = PetscDualSpaceSetOrder(Q, order);CHKERRQ(ierr);
1756   ierr = PetscDualSpaceLagrangeSetTensor(Q, tensor);CHKERRQ(ierr);
1757   ierr = PetscDualSpaceSetFromOptions(Q);CHKERRQ(ierr);
1758   ierr = PetscDualSpaceSetUp(Q);CHKERRQ(ierr);
1759   /* Create element */
1760   ierr = PetscFECreate(comm, fem);CHKERRQ(ierr);
1761   ierr = PetscObjectSetOptionsPrefix((PetscObject) *fem, prefix);CHKERRQ(ierr);
1762   ierr = PetscFESetBasisSpace(*fem, P);CHKERRQ(ierr);
1763   ierr = PetscFESetDualSpace(*fem, Q);CHKERRQ(ierr);
1764   ierr = PetscFESetNumComponents(*fem, Nc);CHKERRQ(ierr);
1765   ierr = PetscFESetFromOptions(*fem);CHKERRQ(ierr);
1766   ierr = PetscFESetUp(*fem);CHKERRQ(ierr);
1767   ierr = PetscSpaceDestroy(&P);CHKERRQ(ierr);
1768   ierr = PetscDualSpaceDestroy(&Q);CHKERRQ(ierr);
1769   /* Create quadrature (with specified order if given) */
1770   qorder = qorder >= 0 ? qorder : order;
1771   ierr = PetscObjectOptionsBegin((PetscObject)*fem);CHKERRQ(ierr);
1772   ierr = PetscOptionsBoundedInt("-petscfe_default_quadrature_order","Quadrature order is one less than quadrature points per edge","PetscFECreateDefault",qorder,&qorder,NULL,0);CHKERRQ(ierr);
1773   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1774   quadPointsPerEdge = PetscMax(qorder + 1,1);
1775   if (isSimplex) {
1776     ierr = PetscDTStroudConicalQuadrature(dim,   1, quadPointsPerEdge, -1.0, 1.0, &q);CHKERRQ(ierr);
1777     ierr = PetscDTStroudConicalQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);CHKERRQ(ierr);
1778   } else {
1779     ierr = PetscDTGaussTensorQuadrature(dim,   1, quadPointsPerEdge, -1.0, 1.0, &q);CHKERRQ(ierr);
1780     ierr = PetscDTGaussTensorQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);CHKERRQ(ierr);
1781   }
1782   ierr = PetscFESetQuadrature(*fem, q);CHKERRQ(ierr);
1783   ierr = PetscFESetFaceQuadrature(*fem, fq);CHKERRQ(ierr);
1784   ierr = PetscQuadratureDestroy(&q);CHKERRQ(ierr);
1785   ierr = PetscQuadratureDestroy(&fq);CHKERRQ(ierr);
1786   PetscFunctionReturn(0);
1787 }
1788 
1789 /*@
1790   PetscFECreateLagrange - Create a PetscFE for the basic Lagrange space of degree k
1791 
1792   Collective
1793 
1794   Input Parameters:
1795 + comm      - The MPI comm
1796 . dim       - The spatial dimension
1797 . Nc        - The number of components
1798 . isSimplex - Flag for simplex reference cell, otherwise its a tensor product
1799 . k         - The degree k of the space
1800 - qorder    - The quadrature order or PETSC_DETERMINE to use PetscSpace polynomial degree
1801 
1802   Output Parameter:
1803 . fem       - The PetscFE object
1804 
1805   Level: beginner
1806 
1807   Notes:
1808   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.
1809 
1810 .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate()
1811 @*/
1812 PetscErrorCode PetscFECreateLagrange(MPI_Comm comm, PetscInt dim, PetscInt Nc, PetscBool isSimplex, PetscInt k, PetscInt qorder, PetscFE *fem)
1813 {
1814   PetscQuadrature q, fq;
1815   DM              K;
1816   PetscSpace      P;
1817   PetscDualSpace  Q;
1818   PetscInt        quadPointsPerEdge;
1819   PetscBool       tensor = isSimplex ? PETSC_FALSE : PETSC_TRUE;
1820   char            name[64];
1821   PetscErrorCode  ierr;
1822 
1823   PetscFunctionBegin;
1824   /* Create space */
1825   ierr = PetscSpaceCreate(comm, &P);CHKERRQ(ierr);
1826   ierr = PetscSpaceSetType(P, PETSCSPACEPOLYNOMIAL);CHKERRQ(ierr);
1827   ierr = PetscSpacePolynomialSetTensor(P, tensor);CHKERRQ(ierr);
1828   ierr = PetscSpaceSetNumComponents(P, Nc);CHKERRQ(ierr);
1829   ierr = PetscSpaceSetNumVariables(P, dim);CHKERRQ(ierr);
1830   ierr = PetscSpaceSetDegree(P, k, PETSC_DETERMINE);CHKERRQ(ierr);
1831   ierr = PetscSpaceSetUp(P);CHKERRQ(ierr);
1832   /* Create dual space */
1833   ierr = PetscDualSpaceCreate(comm, &Q);CHKERRQ(ierr);
1834   ierr = PetscDualSpaceSetType(Q, PETSCDUALSPACELAGRANGE);CHKERRQ(ierr);
1835   ierr = PetscDualSpaceCreateReferenceCell(Q, dim, isSimplex, &K);CHKERRQ(ierr);
1836   ierr = PetscDualSpaceSetDM(Q, K);CHKERRQ(ierr);
1837   ierr = DMDestroy(&K);CHKERRQ(ierr);
1838   ierr = PetscDualSpaceSetNumComponents(Q, Nc);CHKERRQ(ierr);
1839   ierr = PetscDualSpaceSetOrder(Q, k);CHKERRQ(ierr);
1840   ierr = PetscDualSpaceLagrangeSetTensor(Q, tensor);CHKERRQ(ierr);
1841   ierr = PetscDualSpaceSetUp(Q);CHKERRQ(ierr);
1842   /* Create element */
1843   ierr = PetscFECreate(comm, fem);CHKERRQ(ierr);
1844   ierr = PetscSNPrintf(name, 64, "P%d", (int) k);CHKERRQ(ierr);
1845   ierr = PetscObjectSetName((PetscObject) *fem, name);CHKERRQ(ierr);
1846   ierr = PetscFESetType(*fem, PETSCFEBASIC);CHKERRQ(ierr);
1847   ierr = PetscFESetBasisSpace(*fem, P);CHKERRQ(ierr);
1848   ierr = PetscFESetDualSpace(*fem, Q);CHKERRQ(ierr);
1849   ierr = PetscFESetNumComponents(*fem, Nc);CHKERRQ(ierr);
1850   ierr = PetscFESetUp(*fem);CHKERRQ(ierr);
1851   ierr = PetscSpaceDestroy(&P);CHKERRQ(ierr);
1852   ierr = PetscDualSpaceDestroy(&Q);CHKERRQ(ierr);
1853   /* Create quadrature (with specified order if given) */
1854   qorder = qorder >= 0 ? qorder : k;
1855   quadPointsPerEdge = PetscMax(qorder + 1,1);
1856   if (isSimplex) {
1857     ierr = PetscDTStroudConicalQuadrature(dim,   1, quadPointsPerEdge, -1.0, 1.0, &q);CHKERRQ(ierr);
1858     ierr = PetscDTStroudConicalQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);CHKERRQ(ierr);
1859   } else {
1860     ierr = PetscDTGaussTensorQuadrature(dim,   1, quadPointsPerEdge, -1.0, 1.0, &q);CHKERRQ(ierr);
1861     ierr = PetscDTGaussTensorQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);CHKERRQ(ierr);
1862   }
1863   ierr = PetscFESetQuadrature(*fem, q);CHKERRQ(ierr);
1864   ierr = PetscFESetFaceQuadrature(*fem, fq);CHKERRQ(ierr);
1865   ierr = PetscQuadratureDestroy(&q);CHKERRQ(ierr);
1866   ierr = PetscQuadratureDestroy(&fq);CHKERRQ(ierr);
1867   PetscFunctionReturn(0);
1868 }
1869 
1870 /*@C
1871   PetscFESetName - Names the FE and its subobjects
1872 
1873   Not collective
1874 
1875   Input Parameters:
1876 + fe   - The PetscFE
1877 - name - The name
1878 
1879   Level: intermediate
1880 
1881 .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate()
1882 @*/
1883 PetscErrorCode PetscFESetName(PetscFE fe, const char name[])
1884 {
1885   PetscSpace     P;
1886   PetscDualSpace Q;
1887   PetscErrorCode ierr;
1888 
1889   PetscFunctionBegin;
1890   ierr = PetscFEGetBasisSpace(fe, &P);CHKERRQ(ierr);
1891   ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr);
1892   ierr = PetscObjectSetName((PetscObject) fe, name);CHKERRQ(ierr);
1893   ierr = PetscObjectSetName((PetscObject) P,  name);CHKERRQ(ierr);
1894   ierr = PetscObjectSetName((PetscObject) Q,  name);CHKERRQ(ierr);
1895   PetscFunctionReturn(0);
1896 }
1897 
1898 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[])
1899 {
1900   PetscInt       dOffset = 0, fOffset = 0, f;
1901   PetscErrorCode ierr;
1902 
1903   for (f = 0; f < Nf; ++f) {
1904     PetscFE          fe;
1905     const PetscInt   cdim = T[f]->cdim;
1906     const PetscInt   Nq   = T[f]->Np;
1907     const PetscInt   Nbf  = T[f]->Nb;
1908     const PetscInt   Ncf  = T[f]->Nc;
1909     const PetscReal *Bq   = &T[f]->T[0][(r*Nq+q)*Nbf*Ncf];
1910     const PetscReal *Dq   = &T[f]->T[1][(r*Nq+q)*Nbf*Ncf*cdim];
1911     PetscInt         b, c, d;
1912 
1913     ierr = PetscDSGetDiscretization(ds, f, (PetscObject *) &fe);CHKERRQ(ierr);
1914     for (c = 0; c < Ncf; ++c) u[fOffset+c] = 0.0;
1915     for (d = 0; d < cdim*Ncf; ++d) u_x[fOffset*cdim+d] = 0.0;
1916     for (b = 0; b < Nbf; ++b) {
1917       for (c = 0; c < Ncf; ++c) {
1918         const PetscInt cidx = b*Ncf+c;
1919 
1920         u[fOffset+c] += Bq[cidx]*coefficients[dOffset+b];
1921         for (d = 0; d < cdim; ++d) u_x[(fOffset+c)*cdim+d] += Dq[cidx*cdim+d]*coefficients[dOffset+b];
1922       }
1923     }
1924     ierr = PetscFEPushforward(fe, fegeom, 1, NULL, &u[fOffset]);CHKERRQ(ierr);
1925     ierr = PetscFEPushforwardGradient(fe, fegeom, 1, NULL, &u_x[fOffset*cdim]);CHKERRQ(ierr);
1926     if (u_t) {
1927       for (c = 0; c < Ncf; ++c) u_t[fOffset+c] = 0.0;
1928       for (b = 0; b < Nbf; ++b) {
1929         for (c = 0; c < Ncf; ++c) {
1930           const PetscInt cidx = b*Ncf+c;
1931 
1932           u_t[fOffset+c] += Bq[cidx]*coefficients_t[dOffset+b];
1933         }
1934       }
1935       ierr = PetscFEPushforward(fe, fegeom, 1, NULL, &u_t[fOffset]);CHKERRQ(ierr);
1936     }
1937     fOffset += Ncf;
1938     dOffset += Nbf;
1939   }
1940   return 0;
1941 }
1942 
1943 PetscErrorCode PetscFEEvaluateFaceFields_Internal(PetscDS prob, PetscInt field, PetscInt faceLoc, const PetscScalar coefficients[], PetscScalar u[])
1944 {
1945   PetscFE         fe;
1946   PetscTabulation Tc;
1947   PetscInt        b, c;
1948   PetscErrorCode  ierr;
1949 
1950   if (!prob) return 0;
1951   ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
1952   ierr = PetscFEGetFaceCentroidTabulation(fe, &Tc);CHKERRQ(ierr);
1953   {
1954     const PetscReal *faceBasis = Tc->T[0];
1955     const PetscInt   Nb        = Tc->Nb;
1956     const PetscInt   Nc        = Tc->Nc;
1957 
1958     for (c = 0; c < Nc; ++c) {u[c] = 0.0;}
1959     for (b = 0; b < Nb; ++b) {
1960       for (c = 0; c < Nc; ++c) {
1961         const PetscInt cidx = b*Nc+c;
1962 
1963         u[c] += coefficients[cidx]*faceBasis[faceLoc*Nb*Nc+cidx];
1964       }
1965     }
1966   }
1967   return 0;
1968 }
1969 
1970 PetscErrorCode PetscFEUpdateElementVec_Internal(PetscFE fe, PetscTabulation T, PetscInt r, PetscScalar tmpBasis[], PetscScalar tmpBasisDer[], PetscFEGeom *fegeom, PetscScalar f0[], PetscScalar f1[], PetscScalar elemVec[])
1971 {
1972   const PetscInt   dim      = T->cdim;
1973   const PetscInt   Nq       = T->Np;
1974   const PetscInt   Nb       = T->Nb;
1975   const PetscInt   Nc       = T->Nc;
1976   const PetscReal *basis    = &T->T[0][r*Nq*Nb*Nc];
1977   const PetscReal *basisDer = &T->T[1][r*Nq*Nb*Nc*dim];
1978   PetscInt         q, b, c, d;
1979   PetscErrorCode   ierr;
1980 
1981   for (b = 0; b < Nb; ++b) elemVec[b] = 0.0;
1982   for (q = 0; q < Nq; ++q) {
1983     for (b = 0; b < Nb; ++b) {
1984       for (c = 0; c < Nc; ++c) {
1985         const PetscInt bcidx = b*Nc+c;
1986 
1987         tmpBasis[bcidx] = basis[q*Nb*Nc+bcidx];
1988         for (d = 0; d < dim; ++d) tmpBasisDer[bcidx*dim+d] = basisDer[q*Nb*Nc*dim+bcidx*dim+d];
1989       }
1990     }
1991     ierr = PetscFEPushforward(fe, fegeom, Nb, NULL, tmpBasis);CHKERRQ(ierr);
1992     ierr = PetscFEPushforwardGradient(fe, fegeom, Nb, NULL, tmpBasisDer);CHKERRQ(ierr);
1993     for (b = 0; b < Nb; ++b) {
1994       for (c = 0; c < Nc; ++c) {
1995         const PetscInt bcidx = b*Nc+c;
1996         const PetscInt qcidx = q*Nc+c;
1997 
1998         elemVec[b] += tmpBasis[bcidx]*f0[qcidx];
1999         for (d = 0; d < dim; ++d) elemVec[b] += tmpBasisDer[bcidx*dim+d]*f1[qcidx*dim+d];
2000       }
2001     }
2002   }
2003   return(0);
2004 }
2005 
2006 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[])
2007 {
2008   const PetscInt   dim       = TI->cdim;
2009   const PetscInt   NqI       = TI->Np;
2010   const PetscInt   NbI       = TI->Nb;
2011   const PetscInt   NcI       = TI->Nc;
2012   const PetscReal *basisI    = &TI->T[0][(r*NqI+q)*NbI*NcI];
2013   const PetscReal *basisDerI = &TI->T[1][(r*NqI+q)*NbI*NcI*dim];
2014   const PetscInt   NqJ       = TJ->Np;
2015   const PetscInt   NbJ       = TJ->Nb;
2016   const PetscInt   NcJ       = TJ->Nc;
2017   const PetscReal *basisJ    = &TJ->T[0][(r*NqJ+q)*NbJ*NcJ];
2018   const PetscReal *basisDerJ = &TJ->T[1][(r*NqJ+q)*NbJ*NcJ*dim];
2019   PetscInt         f, fc, g, gc, df, dg;
2020   PetscErrorCode   ierr;
2021 
2022   for (f = 0; f < NbI; ++f) {
2023     for (fc = 0; fc < NcI; ++fc) {
2024       const PetscInt fidx = f*NcI+fc; /* Test function basis index */
2025 
2026       tmpBasisI[fidx] = basisI[fidx];
2027       for (df = 0; df < dim; ++df) tmpBasisDerI[fidx*dim+df] = basisDerI[fidx*dim+df];
2028     }
2029   }
2030   ierr = PetscFEPushforward(feI, fegeom, NbI, NULL, tmpBasisI);CHKERRQ(ierr);
2031   ierr = PetscFEPushforwardGradient(feI, fegeom, NbI, NULL, tmpBasisDerI);CHKERRQ(ierr);
2032   for (g = 0; g < NbJ; ++g) {
2033     for (gc = 0; gc < NcJ; ++gc) {
2034       const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
2035 
2036       tmpBasisJ[gidx] = basisJ[gidx];
2037       for (dg = 0; dg < dim; ++dg) tmpBasisDerJ[gidx*dim+dg] = basisDerJ[gidx*dim+dg];
2038     }
2039   }
2040   ierr = PetscFEPushforward(feJ, fegeom, NbJ, NULL, tmpBasisJ);CHKERRQ(ierr);
2041   ierr = PetscFEPushforwardGradient(feJ, fegeom, NbJ, NULL, tmpBasisDerJ);CHKERRQ(ierr);
2042   for (f = 0; f < NbI; ++f) {
2043     for (fc = 0; fc < NcI; ++fc) {
2044       const PetscInt fidx = f*NcI+fc; /* Test function basis index */
2045       const PetscInt i    = offsetI+f; /* Element matrix row */
2046       for (g = 0; g < NbJ; ++g) {
2047         for (gc = 0; gc < NcJ; ++gc) {
2048           const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
2049           const PetscInt j    = offsetJ+g; /* Element matrix column */
2050           const PetscInt fOff = eOffset+i*totDim+j;
2051 
2052           elemMat[fOff] += tmpBasisI[fidx]*g0[fc*NcJ+gc]*tmpBasisJ[gidx];
2053           for (df = 0; df < dim; ++df) {
2054             elemMat[fOff] += tmpBasisI[fidx]*g1[(fc*NcJ+gc)*dim+df]*tmpBasisDerJ[gidx*dim+df];
2055             elemMat[fOff] += tmpBasisDerI[fidx*dim+df]*g2[(fc*NcJ+gc)*dim+df]*tmpBasisJ[gidx];
2056             for (dg = 0; dg < dim; ++dg) {
2057               elemMat[fOff] += tmpBasisDerI[fidx*dim+df]*g3[((fc*NcJ+gc)*dim+df)*dim+dg]*tmpBasisDerJ[gidx*dim+dg];
2058             }
2059           }
2060         }
2061       }
2062     }
2063   }
2064   return(0);
2065 }
2066 
2067 PetscErrorCode PetscFECreateCellGeometry(PetscFE fe, PetscQuadrature quad, PetscFEGeom *cgeom)
2068 {
2069   PetscDualSpace  dsp;
2070   DM              dm;
2071   PetscQuadrature quadDef;
2072   PetscInt        dim, cdim, Nq;
2073   PetscErrorCode  ierr;
2074 
2075   PetscFunctionBegin;
2076   ierr = PetscFEGetDualSpace(fe, &dsp);CHKERRQ(ierr);
2077   ierr = PetscDualSpaceGetDM(dsp, &dm);CHKERRQ(ierr);
2078   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2079   ierr = DMGetCoordinateDim(dm, &cdim);CHKERRQ(ierr);
2080   ierr = PetscFEGetQuadrature(fe, &quadDef);CHKERRQ(ierr);
2081   quad = quad ? quad : quadDef;
2082   ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
2083   ierr = PetscMalloc1(Nq*cdim,      &cgeom->v);CHKERRQ(ierr);
2084   ierr = PetscMalloc1(Nq*cdim*cdim, &cgeom->J);CHKERRQ(ierr);
2085   ierr = PetscMalloc1(Nq*cdim*cdim, &cgeom->invJ);CHKERRQ(ierr);
2086   ierr = PetscMalloc1(Nq,           &cgeom->detJ);CHKERRQ(ierr);
2087   cgeom->dim       = dim;
2088   cgeom->dimEmbed  = cdim;
2089   cgeom->numCells  = 1;
2090   cgeom->numPoints = Nq;
2091   ierr = DMPlexComputeCellGeometryFEM(dm, 0, quad, cgeom->v, cgeom->J, cgeom->invJ, cgeom->detJ);CHKERRQ(ierr);
2092   PetscFunctionReturn(0);
2093 }
2094 
2095 PetscErrorCode PetscFEDestroyCellGeometry(PetscFE fe, PetscFEGeom *cgeom)
2096 {
2097   PetscErrorCode ierr;
2098 
2099   PetscFunctionBegin;
2100   ierr = PetscFree(cgeom->v);CHKERRQ(ierr);
2101   ierr = PetscFree(cgeom->J);CHKERRQ(ierr);
2102   ierr = PetscFree(cgeom->invJ);CHKERRQ(ierr);
2103   ierr = PetscFree(cgeom->detJ);CHKERRQ(ierr);
2104   PetscFunctionReturn(0);
2105 }
2106