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