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