xref: /petsc/src/dm/dt/dualspace/impls/lagrange/dspacelagrange.c (revision df4cd43f92eaa320656440c40edb1046daee8f75)
1 #include <petsc/private/petscfeimpl.h> /*I "petscfe.h" I*/
2 #include <petscdmplex.h>
3 #include <petscblaslapack.h>
4 
5 PetscErrorCode DMPlexGetTransitiveClosure_Internal(DM, PetscInt, PetscInt, PetscBool, PetscInt *, PetscInt *[]);
6 
7 struct _n_Petsc1DNodeFamily {
8   PetscInt        refct;
9   PetscDTNodeType nodeFamily;
10   PetscReal       gaussJacobiExp;
11   PetscInt        nComputed;
12   PetscReal     **nodesets;
13   PetscBool       endpoints;
14 };
15 
16 /* users set node families for PETSCDUALSPACELAGRANGE with just the inputs to this function, but internally we create
17  * an object that can cache the computations across multiple dual spaces */
18 static PetscErrorCode Petsc1DNodeFamilyCreate(PetscDTNodeType family, PetscReal gaussJacobiExp, PetscBool endpoints, Petsc1DNodeFamily *nf)
19 {
20   Petsc1DNodeFamily f;
21 
22   PetscFunctionBegin;
23   PetscCall(PetscNew(&f));
24   switch (family) {
25   case PETSCDTNODES_GAUSSJACOBI:
26   case PETSCDTNODES_EQUISPACED:
27     f->nodeFamily = family;
28     break;
29   default:
30     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown 1D node family");
31   }
32   f->endpoints      = endpoints;
33   f->gaussJacobiExp = 0.;
34   if (family == PETSCDTNODES_GAUSSJACOBI) {
35     PetscCheck(gaussJacobiExp > -1., PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Gauss-Jacobi exponent must be > -1.");
36     f->gaussJacobiExp = gaussJacobiExp;
37   }
38   f->refct = 1;
39   *nf      = f;
40   PetscFunctionReturn(PETSC_SUCCESS);
41 }
42 
43 static PetscErrorCode Petsc1DNodeFamilyReference(Petsc1DNodeFamily nf)
44 {
45   PetscFunctionBegin;
46   if (nf) nf->refct++;
47   PetscFunctionReturn(PETSC_SUCCESS);
48 }
49 
50 static PetscErrorCode Petsc1DNodeFamilyDestroy(Petsc1DNodeFamily *nf)
51 {
52   PetscInt i, nc;
53 
54   PetscFunctionBegin;
55   if (!(*nf)) PetscFunctionReturn(PETSC_SUCCESS);
56   if (--(*nf)->refct > 0) {
57     *nf = NULL;
58     PetscFunctionReturn(PETSC_SUCCESS);
59   }
60   nc = (*nf)->nComputed;
61   for (i = 0; i < nc; i++) PetscCall(PetscFree((*nf)->nodesets[i]));
62   PetscCall(PetscFree((*nf)->nodesets));
63   PetscCall(PetscFree(*nf));
64   *nf = NULL;
65   PetscFunctionReturn(PETSC_SUCCESS);
66 }
67 
68 static PetscErrorCode Petsc1DNodeFamilyGetNodeSets(Petsc1DNodeFamily f, PetscInt degree, PetscReal ***nodesets)
69 {
70   PetscInt nc;
71 
72   PetscFunctionBegin;
73   nc = f->nComputed;
74   if (degree >= nc) {
75     PetscInt    i, j;
76     PetscReal **new_nodesets;
77     PetscReal  *w;
78 
79     PetscCall(PetscMalloc1(degree + 1, &new_nodesets));
80     PetscCall(PetscArraycpy(new_nodesets, f->nodesets, nc));
81     PetscCall(PetscFree(f->nodesets));
82     f->nodesets = new_nodesets;
83     PetscCall(PetscMalloc1(degree + 1, &w));
84     for (i = nc; i < degree + 1; i++) {
85       PetscCall(PetscMalloc1(i + 1, &(f->nodesets[i])));
86       if (!i) {
87         f->nodesets[i][0] = 0.5;
88       } else {
89         switch (f->nodeFamily) {
90         case PETSCDTNODES_EQUISPACED:
91           if (f->endpoints) {
92             for (j = 0; j <= i; j++) f->nodesets[i][j] = (PetscReal)j / (PetscReal)i;
93           } else {
94             /* these nodes are at the centroids of the small simplices created by the equispaced nodes that include
95              * the endpoints */
96             for (j = 0; j <= i; j++) f->nodesets[i][j] = ((PetscReal)j + 0.5) / ((PetscReal)i + 1.);
97           }
98           break;
99         case PETSCDTNODES_GAUSSJACOBI:
100           if (f->endpoints) {
101             PetscCall(PetscDTGaussLobattoJacobiQuadrature(i + 1, 0., 1., f->gaussJacobiExp, f->gaussJacobiExp, f->nodesets[i], w));
102           } else {
103             PetscCall(PetscDTGaussJacobiQuadrature(i + 1, 0., 1., f->gaussJacobiExp, f->gaussJacobiExp, f->nodesets[i], w));
104           }
105           break;
106         default:
107           SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown 1D node family");
108         }
109       }
110     }
111     PetscCall(PetscFree(w));
112     f->nComputed = degree + 1;
113   }
114   *nodesets = f->nodesets;
115   PetscFunctionReturn(PETSC_SUCCESS);
116 }
117 
118 /* http://arxiv.org/abs/2002.09421 for details */
119 static PetscErrorCode PetscNodeRecursive_Internal(PetscInt dim, PetscInt degree, PetscReal **nodesets, PetscInt tup[], PetscReal node[])
120 {
121   PetscReal w;
122   PetscInt  i, j;
123 
124   PetscFunctionBeginHot;
125   w = 0.;
126   if (dim == 1) {
127     node[0] = nodesets[degree][tup[0]];
128     node[1] = nodesets[degree][tup[1]];
129   } else {
130     for (i = 0; i < dim + 1; i++) node[i] = 0.;
131     for (i = 0; i < dim + 1; i++) {
132       PetscReal wi = nodesets[degree][degree - tup[i]];
133 
134       for (j = 0; j < dim + 1; j++) tup[dim + 1 + j] = tup[j + (j >= i)];
135       PetscCall(PetscNodeRecursive_Internal(dim - 1, degree - tup[i], nodesets, &tup[dim + 1], &node[dim + 1]));
136       for (j = 0; j < dim + 1; j++) node[j + (j >= i)] += wi * node[dim + 1 + j];
137       w += wi;
138     }
139     for (i = 0; i < dim + 1; i++) node[i] /= w;
140   }
141   PetscFunctionReturn(PETSC_SUCCESS);
142 }
143 
144 /* compute simplex nodes for the biunit simplex from the 1D node family */
145 static PetscErrorCode Petsc1DNodeFamilyComputeSimplexNodes(Petsc1DNodeFamily f, PetscInt dim, PetscInt degree, PetscReal points[])
146 {
147   PetscInt   *tup;
148   PetscInt    k;
149   PetscInt    npoints;
150   PetscReal **nodesets = NULL;
151   PetscInt    worksize;
152   PetscReal  *nodework;
153   PetscInt   *tupwork;
154 
155   PetscFunctionBegin;
156   PetscCheck(dim >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Must have non-negative dimension");
157   PetscCheck(degree >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Must have non-negative degree");
158   if (!dim) PetscFunctionReturn(PETSC_SUCCESS);
159   PetscCall(PetscCalloc1(dim + 2, &tup));
160   k = 0;
161   PetscCall(PetscDTBinomialInt(degree + dim, dim, &npoints));
162   PetscCall(Petsc1DNodeFamilyGetNodeSets(f, degree, &nodesets));
163   worksize = ((dim + 2) * (dim + 3)) / 2;
164   PetscCall(PetscMalloc2(worksize, &nodework, worksize, &tupwork));
165   /* loop over the tuples of length dim with sum at most degree */
166   for (k = 0; k < npoints; k++) {
167     PetscInt i;
168 
169     /* turn thm into tuples of length dim + 1 with sum equal to degree (barycentric indice) */
170     tup[0] = degree;
171     for (i = 0; i < dim; i++) tup[0] -= tup[i + 1];
172     switch (f->nodeFamily) {
173     case PETSCDTNODES_EQUISPACED:
174       /* compute equispaces nodes on the unit reference triangle */
175       if (f->endpoints) {
176         for (i = 0; i < dim; i++) points[dim * k + i] = (PetscReal)tup[i + 1] / (PetscReal)degree;
177       } else {
178         for (i = 0; i < dim; i++) {
179           /* these nodes are at the centroids of the small simplices created by the equispaced nodes that include
180            * the endpoints */
181           points[dim * k + i] = ((PetscReal)tup[i + 1] + 1. / (dim + 1.)) / (PetscReal)(degree + 1.);
182         }
183       }
184       break;
185     default:
186       /* compute equispaces nodes on the barycentric reference triangle (the trace on the first dim dimensions are the
187        * unit reference triangle nodes */
188       for (i = 0; i < dim + 1; i++) tupwork[i] = tup[i];
189       PetscCall(PetscNodeRecursive_Internal(dim, degree, nodesets, tupwork, nodework));
190       for (i = 0; i < dim; i++) points[dim * k + i] = nodework[i + 1];
191       break;
192     }
193     PetscCall(PetscDualSpaceLatticePointLexicographic_Internal(dim, degree, &tup[1]));
194   }
195   /* map from unit simplex to biunit simplex */
196   for (k = 0; k < npoints * dim; k++) points[k] = points[k] * 2. - 1.;
197   PetscCall(PetscFree2(nodework, tupwork));
198   PetscCall(PetscFree(tup));
199   PetscFunctionReturn(PETSC_SUCCESS);
200 }
201 
202 /* If we need to get the dofs from a mesh point, or add values into dofs at a mesh point, and there is more than one dof
203  * on that mesh point, we have to be careful about getting/adding everything in the right place.
204  *
205  * With nodal dofs like PETSCDUALSPACELAGRANGE makes, the general approach to calculate the value of dofs associate
206  * with a node A is
207  * - transform the node locations x(A) by the map that takes the mesh point to its reorientation, x' = phi(x(A))
208  * - figure out which node was originally at the location of the transformed point, A' = idx(x')
209  * - if the dofs are not scalars, figure out how to represent the transformed dofs in terms of the basis
210  *   of dofs at A' (using pushforward/pullback rules)
211  *
212  * The one sticky point with this approach is the "A' = idx(x')" step: trying to go from real valued coordinates
213  * back to indices.  I don't want to rely on floating point tolerances.  Additionally, PETSCDUALSPACELAGRANGE may
214  * eventually support quasi-Lagrangian dofs, which could involve quadrature at multiple points, so the location "x(A)"
215  * would be ambiguous.
216  *
217  * So each dof gets an integer value coordinate (nodeIdx in the structure below).  The choice of integer coordinates
218  * is somewhat arbitrary, as long as all of the relevant symmetries of the mesh point correspond to *permutations* of
219  * the integer coordinates, which do not depend on numerical precision.
220  *
221  * So
222  *
223  * - DMPlexGetTransitiveClosure_Internal() tells me how an orientation turns into a permutation of the vertices of a
224  *   mesh point
225  * - The permutation of the vertices, and the nodeIdx values assigned to them, tells what permutation in index space
226  *   is associated with the orientation
227  * - I uses that permutation to get xi' = phi(xi(A)), the integer coordinate of the transformed dof
228  * - I can without numerical issues compute A' = idx(xi')
229  *
230  * Here are some examples of how the process works
231  *
232  * - With a triangle:
233  *
234  *   The triangle has the following integer coordinates for vertices, taken from the barycentric triangle
235  *
236  *     closure order 2
237  *     nodeIdx (0,0,1)
238  *      \
239  *       +
240  *       |\
241  *       | \
242  *       |  \
243  *       |   \    closure order 1
244  *       |    \ / nodeIdx (0,1,0)
245  *       +-----+
246  *        \
247  *      closure order 0
248  *      nodeIdx (1,0,0)
249  *
250  *   If I do DMPlexGetTransitiveClosure_Internal() with orientation 1, the vertices would appear
251  *   in the order (1, 2, 0)
252  *
253  *   If I list the nodeIdx of each vertex in closure order for orientation 0 (0, 1, 2) and orientation 1 (1, 2, 0), I
254  *   see
255  *
256  *   orientation 0  | orientation 1
257  *
258  *   [0] (1,0,0)      [1] (0,1,0)
259  *   [1] (0,1,0)      [2] (0,0,1)
260  *   [2] (0,0,1)      [0] (1,0,0)
261  *          A                B
262  *
263  *   In other words, B is the result of a row permutation of A.  But, there is also
264  *   a column permutation that accomplishes the same result, (2,0,1).
265  *
266  *   So if a dof has nodeIdx coordinate (a,b,c), after the transformation its nodeIdx coordinate
267  *   is (c,a,b), and the transformed degree of freedom will be a linear combination of dofs
268  *   that originally had coordinate (c,a,b).
269  *
270  * - With a quadrilateral:
271  *
272  *   The quadrilateral has the following integer coordinates for vertices, taken from concatenating barycentric
273  *   coordinates for two segments:
274  *
275  *     closure order 3      closure order 2
276  *     nodeIdx (1,0,0,1)    nodeIdx (0,1,0,1)
277  *                   \      /
278  *                    +----+
279  *                    |    |
280  *                    |    |
281  *                    +----+
282  *                   /      \
283  *     closure order 0      closure order 1
284  *     nodeIdx (1,0,1,0)    nodeIdx (0,1,1,0)
285  *
286  *   If I do DMPlexGetTransitiveClosure_Internal() with orientation 1, the vertices would appear
287  *   in the order (1, 2, 3, 0)
288  *
289  *   If I list the nodeIdx of each vertex in closure order for orientation 0 (0, 1, 2, 3) and
290  *   orientation 1 (1, 2, 3, 0), I see
291  *
292  *   orientation 0  | orientation 1
293  *
294  *   [0] (1,0,1,0)    [1] (0,1,1,0)
295  *   [1] (0,1,1,0)    [2] (0,1,0,1)
296  *   [2] (0,1,0,1)    [3] (1,0,0,1)
297  *   [3] (1,0,0,1)    [0] (1,0,1,0)
298  *          A                B
299  *
300  *   The column permutation that accomplishes the same result is (3,2,0,1).
301  *
302  *   So if a dof has nodeIdx coordinate (a,b,c,d), after the transformation its nodeIdx coordinate
303  *   is (d,c,a,b), and the transformed degree of freedom will be a linear combination of dofs
304  *   that originally had coordinate (d,c,a,b).
305  *
306  * Previously PETSCDUALSPACELAGRANGE had hardcoded symmetries for the triangle and quadrilateral,
307  * but this approach will work for any polytope, such as the wedge (triangular prism).
308  */
309 struct _n_PetscLagNodeIndices {
310   PetscInt   refct;
311   PetscInt   nodeIdxDim;
312   PetscInt   nodeVecDim;
313   PetscInt   nNodes;
314   PetscInt  *nodeIdx; /* for each node an index of size nodeIdxDim */
315   PetscReal *nodeVec; /* for each node a vector of size nodeVecDim */
316   PetscInt  *perm;    /* if these are vertices, perm takes DMPlex point index to closure order;
317                               if these are nodes, perm lists nodes in index revlex order */
318 };
319 
320 /* this is just here so I can access the values in tests/ex1.c outside the library */
321 PetscErrorCode PetscLagNodeIndicesGetData_Internal(PetscLagNodeIndices ni, PetscInt *nodeIdxDim, PetscInt *nodeVecDim, PetscInt *nNodes, const PetscInt *nodeIdx[], const PetscReal *nodeVec[])
322 {
323   PetscFunctionBegin;
324   *nodeIdxDim = ni->nodeIdxDim;
325   *nodeVecDim = ni->nodeVecDim;
326   *nNodes     = ni->nNodes;
327   *nodeIdx    = ni->nodeIdx;
328   *nodeVec    = ni->nodeVec;
329   PetscFunctionReturn(PETSC_SUCCESS);
330 }
331 
332 static PetscErrorCode PetscLagNodeIndicesReference(PetscLagNodeIndices ni)
333 {
334   PetscFunctionBegin;
335   if (ni) ni->refct++;
336   PetscFunctionReturn(PETSC_SUCCESS);
337 }
338 
339 static PetscErrorCode PetscLagNodeIndicesDuplicate(PetscLagNodeIndices ni, PetscLagNodeIndices *niNew)
340 {
341   PetscFunctionBegin;
342   PetscCall(PetscNew(niNew));
343   (*niNew)->refct      = 1;
344   (*niNew)->nodeIdxDim = ni->nodeIdxDim;
345   (*niNew)->nodeVecDim = ni->nodeVecDim;
346   (*niNew)->nNodes     = ni->nNodes;
347   PetscCall(PetscMalloc1(ni->nNodes * ni->nodeIdxDim, &((*niNew)->nodeIdx)));
348   PetscCall(PetscArraycpy((*niNew)->nodeIdx, ni->nodeIdx, ni->nNodes * ni->nodeIdxDim));
349   PetscCall(PetscMalloc1(ni->nNodes * ni->nodeVecDim, &((*niNew)->nodeVec)));
350   PetscCall(PetscArraycpy((*niNew)->nodeVec, ni->nodeVec, ni->nNodes * ni->nodeVecDim));
351   (*niNew)->perm = NULL;
352   PetscFunctionReturn(PETSC_SUCCESS);
353 }
354 
355 static PetscErrorCode PetscLagNodeIndicesDestroy(PetscLagNodeIndices *ni)
356 {
357   PetscFunctionBegin;
358   if (!(*ni)) PetscFunctionReturn(PETSC_SUCCESS);
359   if (--(*ni)->refct > 0) {
360     *ni = NULL;
361     PetscFunctionReturn(PETSC_SUCCESS);
362   }
363   PetscCall(PetscFree((*ni)->nodeIdx));
364   PetscCall(PetscFree((*ni)->nodeVec));
365   PetscCall(PetscFree((*ni)->perm));
366   PetscCall(PetscFree(*ni));
367   *ni = NULL;
368   PetscFunctionReturn(PETSC_SUCCESS);
369 }
370 
371 /* The vertices are given nodeIdx coordinates (e.g. the corners of the barycentric triangle).  Those coordinates are
372  * in some other order, and to understand the effect of different symmetries, we need them to be in closure order.
373  *
374  * If sortIdx is PETSC_FALSE, the coordinates are already in revlex order, otherwise we must sort them
375  * to that order before we do the real work of this function, which is
376  *
377  * - mark the vertices in closure order
378  * - sort them in revlex order
379  * - use the resulting permutation to list the vertex coordinates in closure order
380  */
381 static PetscErrorCode PetscLagNodeIndicesComputeVertexOrder(DM dm, PetscLagNodeIndices ni, PetscBool sortIdx)
382 {
383   PetscInt           v, w, vStart, vEnd, c, d;
384   PetscInt           nVerts;
385   PetscInt           closureSize = 0;
386   PetscInt          *closure     = NULL;
387   PetscInt          *closureOrder;
388   PetscInt          *invClosureOrder;
389   PetscInt          *revlexOrder;
390   PetscInt          *newNodeIdx;
391   PetscInt           dim;
392   Vec                coordVec;
393   const PetscScalar *coords;
394 
395   PetscFunctionBegin;
396   PetscCall(DMGetDimension(dm, &dim));
397   PetscCall(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd));
398   nVerts = vEnd - vStart;
399   PetscCall(PetscMalloc1(nVerts, &closureOrder));
400   PetscCall(PetscMalloc1(nVerts, &invClosureOrder));
401   PetscCall(PetscMalloc1(nVerts, &revlexOrder));
402   if (sortIdx) { /* bubble sort nodeIdx into revlex order */
403     PetscInt  nodeIdxDim = ni->nodeIdxDim;
404     PetscInt *idxOrder;
405 
406     PetscCall(PetscMalloc1(nVerts * nodeIdxDim, &newNodeIdx));
407     PetscCall(PetscMalloc1(nVerts, &idxOrder));
408     for (v = 0; v < nVerts; v++) idxOrder[v] = v;
409     for (v = 0; v < nVerts; v++) {
410       for (w = v + 1; w < nVerts; w++) {
411         const PetscInt *iv   = &(ni->nodeIdx[idxOrder[v] * nodeIdxDim]);
412         const PetscInt *iw   = &(ni->nodeIdx[idxOrder[w] * nodeIdxDim]);
413         PetscInt        diff = 0;
414 
415         for (d = nodeIdxDim - 1; d >= 0; d--)
416           if ((diff = (iv[d] - iw[d]))) break;
417         if (diff > 0) {
418           PetscInt swap = idxOrder[v];
419 
420           idxOrder[v] = idxOrder[w];
421           idxOrder[w] = swap;
422         }
423       }
424     }
425     for (v = 0; v < nVerts; v++) {
426       for (d = 0; d < nodeIdxDim; d++) newNodeIdx[v * ni->nodeIdxDim + d] = ni->nodeIdx[idxOrder[v] * nodeIdxDim + d];
427     }
428     PetscCall(PetscFree(ni->nodeIdx));
429     ni->nodeIdx = newNodeIdx;
430     newNodeIdx  = NULL;
431     PetscCall(PetscFree(idxOrder));
432   }
433   PetscCall(DMPlexGetTransitiveClosure(dm, 0, PETSC_TRUE, &closureSize, &closure));
434   c = closureSize - nVerts;
435   for (v = 0; v < nVerts; v++) closureOrder[v] = closure[2 * (c + v)] - vStart;
436   for (v = 0; v < nVerts; v++) invClosureOrder[closureOrder[v]] = v;
437   PetscCall(DMPlexRestoreTransitiveClosure(dm, 0, PETSC_TRUE, &closureSize, &closure));
438   PetscCall(DMGetCoordinatesLocal(dm, &coordVec));
439   PetscCall(VecGetArrayRead(coordVec, &coords));
440   /* bubble sort closure vertices by coordinates in revlex order */
441   for (v = 0; v < nVerts; v++) revlexOrder[v] = v;
442   for (v = 0; v < nVerts; v++) {
443     for (w = v + 1; w < nVerts; w++) {
444       const PetscScalar *cv   = &coords[closureOrder[revlexOrder[v]] * dim];
445       const PetscScalar *cw   = &coords[closureOrder[revlexOrder[w]] * dim];
446       PetscReal          diff = 0;
447 
448       for (d = dim - 1; d >= 0; d--)
449         if ((diff = PetscRealPart(cv[d] - cw[d])) != 0.) break;
450       if (diff > 0.) {
451         PetscInt swap = revlexOrder[v];
452 
453         revlexOrder[v] = revlexOrder[w];
454         revlexOrder[w] = swap;
455       }
456     }
457   }
458   PetscCall(VecRestoreArrayRead(coordVec, &coords));
459   PetscCall(PetscMalloc1(ni->nodeIdxDim * nVerts, &newNodeIdx));
460   /* reorder nodeIdx to be in closure order */
461   for (v = 0; v < nVerts; v++) {
462     for (d = 0; d < ni->nodeIdxDim; d++) newNodeIdx[revlexOrder[v] * ni->nodeIdxDim + d] = ni->nodeIdx[v * ni->nodeIdxDim + d];
463   }
464   PetscCall(PetscFree(ni->nodeIdx));
465   ni->nodeIdx = newNodeIdx;
466   ni->perm    = invClosureOrder;
467   PetscCall(PetscFree(revlexOrder));
468   PetscCall(PetscFree(closureOrder));
469   PetscFunctionReturn(PETSC_SUCCESS);
470 }
471 
472 /* the coordinates of the simplex vertices are the corners of the barycentric simplex.
473  * When we stack them on top of each other in revlex order, they look like the identity matrix */
474 static PetscErrorCode PetscLagNodeIndicesCreateSimplexVertices(DM dm, PetscLagNodeIndices *nodeIndices)
475 {
476   PetscLagNodeIndices ni;
477   PetscInt            dim, d;
478 
479   PetscFunctionBegin;
480   PetscCall(PetscNew(&ni));
481   PetscCall(DMGetDimension(dm, &dim));
482   ni->nodeIdxDim = dim + 1;
483   ni->nodeVecDim = 0;
484   ni->nNodes     = dim + 1;
485   ni->refct      = 1;
486   PetscCall(PetscCalloc1((dim + 1) * (dim + 1), &(ni->nodeIdx)));
487   for (d = 0; d < dim + 1; d++) ni->nodeIdx[d * (dim + 2)] = 1;
488   PetscCall(PetscLagNodeIndicesComputeVertexOrder(dm, ni, PETSC_FALSE));
489   *nodeIndices = ni;
490   PetscFunctionReturn(PETSC_SUCCESS);
491 }
492 
493 /* A polytope that is a tensor product of a facet and a segment.
494  * We take whatever coordinate system was being used for the facet
495  * and we concatenate the barycentric coordinates for the vertices
496  * at the end of the segment, (1,0) and (0,1), to get a coordinate
497  * system for the tensor product element */
498 static PetscErrorCode PetscLagNodeIndicesCreateTensorVertices(DM dm, PetscLagNodeIndices facetni, PetscLagNodeIndices *nodeIndices)
499 {
500   PetscLagNodeIndices ni;
501   PetscInt            nodeIdxDim, subNodeIdxDim = facetni->nodeIdxDim;
502   PetscInt            nVerts, nSubVerts         = facetni->nNodes;
503   PetscInt            dim, d, e, f, g;
504 
505   PetscFunctionBegin;
506   PetscCall(PetscNew(&ni));
507   PetscCall(DMGetDimension(dm, &dim));
508   ni->nodeIdxDim = nodeIdxDim = subNodeIdxDim + 2;
509   ni->nodeVecDim              = 0;
510   ni->nNodes = nVerts = 2 * nSubVerts;
511   ni->refct           = 1;
512   PetscCall(PetscCalloc1(nodeIdxDim * nVerts, &(ni->nodeIdx)));
513   for (f = 0, d = 0; d < 2; d++) {
514     for (e = 0; e < nSubVerts; e++, f++) {
515       for (g = 0; g < subNodeIdxDim; g++) ni->nodeIdx[f * nodeIdxDim + g] = facetni->nodeIdx[e * subNodeIdxDim + g];
516       ni->nodeIdx[f * nodeIdxDim + subNodeIdxDim]     = (1 - d);
517       ni->nodeIdx[f * nodeIdxDim + subNodeIdxDim + 1] = d;
518     }
519   }
520   PetscCall(PetscLagNodeIndicesComputeVertexOrder(dm, ni, PETSC_TRUE));
521   *nodeIndices = ni;
522   PetscFunctionReturn(PETSC_SUCCESS);
523 }
524 
525 /* This helps us compute symmetries, and it also helps us compute coordinates for dofs that are being pushed
526  * forward from a boundary mesh point.
527  *
528  * Input:
529  *
530  * dm - the target reference cell where we want new coordinates and dof directions to be valid
531  * vert - the vertex coordinate system for the target reference cell
532  * p - the point in the target reference cell that the dofs are coming from
533  * vertp - the vertex coordinate system for p's reference cell
534  * ornt - the resulting coordinates and dof vectors will be for p under this orientation
535  * nodep - the node coordinates and dof vectors in p's reference cell
536  * formDegree - the form degree that the dofs transform as
537  *
538  * Output:
539  *
540  * pfNodeIdx - the node coordinates for p's dofs, in the dm reference cell, from the ornt perspective
541  * pfNodeVec - the node dof vectors for p's dofs, in the dm reference cell, from the ornt perspective
542  */
543 static PetscErrorCode PetscLagNodeIndicesPushForward(DM dm, PetscLagNodeIndices vert, PetscInt p, PetscLagNodeIndices vertp, PetscLagNodeIndices nodep, PetscInt ornt, PetscInt formDegree, PetscInt pfNodeIdx[], PetscReal pfNodeVec[])
544 {
545   PetscInt          *closureVerts;
546   PetscInt           closureSize = 0;
547   PetscInt          *closure     = NULL;
548   PetscInt           dim, pdim, c, i, j, k, n, v, vStart, vEnd;
549   PetscInt           nSubVert      = vertp->nNodes;
550   PetscInt           nodeIdxDim    = vert->nodeIdxDim;
551   PetscInt           subNodeIdxDim = vertp->nodeIdxDim;
552   PetscInt           nNodes        = nodep->nNodes;
553   const PetscInt    *vertIdx       = vert->nodeIdx;
554   const PetscInt    *subVertIdx    = vertp->nodeIdx;
555   const PetscInt    *nodeIdx       = nodep->nodeIdx;
556   const PetscReal   *nodeVec       = nodep->nodeVec;
557   PetscReal         *J, *Jstar;
558   PetscReal          detJ;
559   PetscInt           depth, pdepth, Nk, pNk;
560   Vec                coordVec;
561   PetscScalar       *newCoords = NULL;
562   const PetscScalar *oldCoords = NULL;
563 
564   PetscFunctionBegin;
565   PetscCall(DMGetDimension(dm, &dim));
566   PetscCall(DMPlexGetDepth(dm, &depth));
567   PetscCall(DMGetCoordinatesLocal(dm, &coordVec));
568   PetscCall(DMPlexGetPointDepth(dm, p, &pdepth));
569   pdim = pdepth != depth ? pdepth != 0 ? pdepth : 0 : dim;
570   PetscCall(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd));
571   PetscCall(DMGetWorkArray(dm, nSubVert, MPIU_INT, &closureVerts));
572   PetscCall(DMPlexGetTransitiveClosure_Internal(dm, p, ornt, PETSC_TRUE, &closureSize, &closure));
573   c = closureSize - nSubVert;
574   /* we want which cell closure indices the closure of this point corresponds to */
575   for (v = 0; v < nSubVert; v++) closureVerts[v] = vert->perm[closure[2 * (c + v)] - vStart];
576   PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
577   /* push forward indices */
578   for (i = 0; i < nodeIdxDim; i++) { /* for every component of the target index space */
579     /* check if this is a component that all vertices around this point have in common */
580     for (j = 1; j < nSubVert; j++) {
581       if (vertIdx[closureVerts[j] * nodeIdxDim + i] != vertIdx[closureVerts[0] * nodeIdxDim + i]) break;
582     }
583     if (j == nSubVert) { /* all vertices have this component in common, directly copy to output */
584       PetscInt val = vertIdx[closureVerts[0] * nodeIdxDim + i];
585       for (n = 0; n < nNodes; n++) pfNodeIdx[n * nodeIdxDim + i] = val;
586     } else {
587       PetscInt subi = -1;
588       /* there must be a component in vertp that looks the same */
589       for (k = 0; k < subNodeIdxDim; k++) {
590         for (j = 0; j < nSubVert; j++) {
591           if (vertIdx[closureVerts[j] * nodeIdxDim + i] != subVertIdx[j * subNodeIdxDim + k]) break;
592         }
593         if (j == nSubVert) {
594           subi = k;
595           break;
596         }
597       }
598       PetscCheck(subi >= 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Did not find matching coordinate");
599       /* that component in the vertp system becomes component i in the vert system for each dof */
600       for (n = 0; n < nNodes; n++) pfNodeIdx[n * nodeIdxDim + i] = nodeIdx[n * subNodeIdxDim + subi];
601     }
602   }
603   /* push forward vectors */
604   PetscCall(DMGetWorkArray(dm, dim * dim, MPIU_REAL, &J));
605   if (ornt != 0) { /* temporarily change the coordinate vector so
606                       DMPlexComputeCellGeometryAffineFEM gives us the Jacobian we want */
607     PetscInt  closureSize2 = 0;
608     PetscInt *closure2     = NULL;
609 
610     PetscCall(DMPlexGetTransitiveClosure_Internal(dm, p, 0, PETSC_TRUE, &closureSize2, &closure2));
611     PetscCall(PetscMalloc1(dim * nSubVert, &newCoords));
612     PetscCall(VecGetArrayRead(coordVec, &oldCoords));
613     for (v = 0; v < nSubVert; v++) {
614       PetscInt d;
615       for (d = 0; d < dim; d++) newCoords[(closure2[2 * (c + v)] - vStart) * dim + d] = oldCoords[closureVerts[v] * dim + d];
616     }
617     PetscCall(VecRestoreArrayRead(coordVec, &oldCoords));
618     PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize2, &closure2));
619     PetscCall(VecPlaceArray(coordVec, newCoords));
620   }
621   PetscCall(DMPlexComputeCellGeometryAffineFEM(dm, p, NULL, J, NULL, &detJ));
622   if (ornt != 0) {
623     PetscCall(VecResetArray(coordVec));
624     PetscCall(PetscFree(newCoords));
625   }
626   PetscCall(DMRestoreWorkArray(dm, nSubVert, MPIU_INT, &closureVerts));
627   /* compactify */
628   for (i = 0; i < dim; i++)
629     for (j = 0; j < pdim; j++) J[i * pdim + j] = J[i * dim + j];
630   /* We have the Jacobian mapping the point's reference cell to this reference cell:
631    * pulling back a function to the point and applying the dof is what we want,
632    * so we get the pullback matrix and multiply the dof by that matrix on the right */
633   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk));
634   PetscCall(PetscDTBinomialInt(pdim, PetscAbsInt(formDegree), &pNk));
635   PetscCall(DMGetWorkArray(dm, pNk * Nk, MPIU_REAL, &Jstar));
636   PetscCall(PetscDTAltVPullbackMatrix(pdim, dim, J, formDegree, Jstar));
637   for (n = 0; n < nNodes; n++) {
638     for (i = 0; i < Nk; i++) {
639       PetscReal val = 0.;
640       for (j = 0; j < pNk; j++) val += nodeVec[n * pNk + j] * Jstar[j * Nk + i];
641       pfNodeVec[n * Nk + i] = val;
642     }
643   }
644   PetscCall(DMRestoreWorkArray(dm, pNk * Nk, MPIU_REAL, &Jstar));
645   PetscCall(DMRestoreWorkArray(dm, dim * dim, MPIU_REAL, &J));
646   PetscFunctionReturn(PETSC_SUCCESS);
647 }
648 
649 /* given to sets of nodes, take the tensor product, where the product of the dof indices is concatenation and the
650  * product of the dof vectors is the wedge product */
651 static PetscErrorCode PetscLagNodeIndicesTensor(PetscLagNodeIndices tracei, PetscInt dimT, PetscInt kT, PetscLagNodeIndices fiberi, PetscInt dimF, PetscInt kF, PetscLagNodeIndices *nodeIndices)
652 {
653   PetscInt            dim = dimT + dimF;
654   PetscInt            nodeIdxDim, nNodes;
655   PetscInt            formDegree = kT + kF;
656   PetscInt            Nk, NkT, NkF;
657   PetscInt            MkT, MkF;
658   PetscLagNodeIndices ni;
659   PetscInt            i, j, l;
660   PetscReal          *projF, *projT;
661   PetscReal          *projFstar, *projTstar;
662   PetscReal          *workF, *workF2, *workT, *workT2, *work, *work2;
663   PetscReal          *wedgeMat;
664   PetscReal           sign;
665 
666   PetscFunctionBegin;
667   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk));
668   PetscCall(PetscDTBinomialInt(dimT, PetscAbsInt(kT), &NkT));
669   PetscCall(PetscDTBinomialInt(dimF, PetscAbsInt(kF), &NkF));
670   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(kT), &MkT));
671   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(kF), &MkF));
672   PetscCall(PetscNew(&ni));
673   ni->nodeIdxDim = nodeIdxDim = tracei->nodeIdxDim + fiberi->nodeIdxDim;
674   ni->nodeVecDim              = Nk;
675   ni->nNodes = nNodes = tracei->nNodes * fiberi->nNodes;
676   ni->refct           = 1;
677   PetscCall(PetscMalloc1(nNodes * nodeIdxDim, &(ni->nodeIdx)));
678   /* first concatenate the indices */
679   for (l = 0, j = 0; j < fiberi->nNodes; j++) {
680     for (i = 0; i < tracei->nNodes; i++, l++) {
681       PetscInt m, n = 0;
682 
683       for (m = 0; m < tracei->nodeIdxDim; m++) ni->nodeIdx[l * nodeIdxDim + n++] = tracei->nodeIdx[i * tracei->nodeIdxDim + m];
684       for (m = 0; m < fiberi->nodeIdxDim; m++) ni->nodeIdx[l * nodeIdxDim + n++] = fiberi->nodeIdx[j * fiberi->nodeIdxDim + m];
685     }
686   }
687 
688   /* now wedge together the push-forward vectors */
689   PetscCall(PetscMalloc1(nNodes * Nk, &(ni->nodeVec)));
690   PetscCall(PetscCalloc2(dimT * dim, &projT, dimF * dim, &projF));
691   for (i = 0; i < dimT; i++) projT[i * (dim + 1)] = 1.;
692   for (i = 0; i < dimF; i++) projF[i * (dim + dimT + 1) + dimT] = 1.;
693   PetscCall(PetscMalloc2(MkT * NkT, &projTstar, MkF * NkF, &projFstar));
694   PetscCall(PetscDTAltVPullbackMatrix(dim, dimT, projT, kT, projTstar));
695   PetscCall(PetscDTAltVPullbackMatrix(dim, dimF, projF, kF, projFstar));
696   PetscCall(PetscMalloc6(MkT, &workT, MkT, &workT2, MkF, &workF, MkF, &workF2, Nk, &work, Nk, &work2));
697   PetscCall(PetscMalloc1(Nk * MkT, &wedgeMat));
698   sign = (PetscAbsInt(kT * kF) & 1) ? -1. : 1.;
699   for (l = 0, j = 0; j < fiberi->nNodes; j++) {
700     PetscInt d, e;
701 
702     /* push forward fiber k-form */
703     for (d = 0; d < MkF; d++) {
704       PetscReal val = 0.;
705       for (e = 0; e < NkF; e++) val += projFstar[d * NkF + e] * fiberi->nodeVec[j * NkF + e];
706       workF[d] = val;
707     }
708     /* Hodge star to proper form if necessary */
709     if (kF < 0) {
710       for (d = 0; d < MkF; d++) workF2[d] = workF[d];
711       PetscCall(PetscDTAltVStar(dim, PetscAbsInt(kF), 1, workF2, workF));
712     }
713     /* Compute the matrix that wedges this form with one of the trace k-form */
714     PetscCall(PetscDTAltVWedgeMatrix(dim, PetscAbsInt(kF), PetscAbsInt(kT), workF, wedgeMat));
715     for (i = 0; i < tracei->nNodes; i++, l++) {
716       /* push forward trace k-form */
717       for (d = 0; d < MkT; d++) {
718         PetscReal val = 0.;
719         for (e = 0; e < NkT; e++) val += projTstar[d * NkT + e] * tracei->nodeVec[i * NkT + e];
720         workT[d] = val;
721       }
722       /* Hodge star to proper form if necessary */
723       if (kT < 0) {
724         for (d = 0; d < MkT; d++) workT2[d] = workT[d];
725         PetscCall(PetscDTAltVStar(dim, PetscAbsInt(kT), 1, workT2, workT));
726       }
727       /* compute the wedge product of the push-forward trace form and firer forms */
728       for (d = 0; d < Nk; d++) {
729         PetscReal val = 0.;
730         for (e = 0; e < MkT; e++) val += wedgeMat[d * MkT + e] * workT[e];
731         work[d] = val;
732       }
733       /* inverse Hodge star from proper form if necessary */
734       if (formDegree < 0) {
735         for (d = 0; d < Nk; d++) work2[d] = work[d];
736         PetscCall(PetscDTAltVStar(dim, PetscAbsInt(formDegree), -1, work2, work));
737       }
738       /* insert into the array (adjusting for sign) */
739       for (d = 0; d < Nk; d++) ni->nodeVec[l * Nk + d] = sign * work[d];
740     }
741   }
742   PetscCall(PetscFree(wedgeMat));
743   PetscCall(PetscFree6(workT, workT2, workF, workF2, work, work2));
744   PetscCall(PetscFree2(projTstar, projFstar));
745   PetscCall(PetscFree2(projT, projF));
746   *nodeIndices = ni;
747   PetscFunctionReturn(PETSC_SUCCESS);
748 }
749 
750 /* simple union of two sets of nodes */
751 static PetscErrorCode PetscLagNodeIndicesMerge(PetscLagNodeIndices niA, PetscLagNodeIndices niB, PetscLagNodeIndices *nodeIndices)
752 {
753   PetscLagNodeIndices ni;
754   PetscInt            nodeIdxDim, nodeVecDim, nNodes;
755 
756   PetscFunctionBegin;
757   PetscCall(PetscNew(&ni));
758   ni->nodeIdxDim = nodeIdxDim = niA->nodeIdxDim;
759   PetscCheck(niB->nodeIdxDim == nodeIdxDim, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cannot merge PetscLagNodeIndices with different nodeIdxDim");
760   ni->nodeVecDim = nodeVecDim = niA->nodeVecDim;
761   PetscCheck(niB->nodeVecDim == nodeVecDim, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cannot merge PetscLagNodeIndices with different nodeVecDim");
762   ni->nNodes = nNodes = niA->nNodes + niB->nNodes;
763   ni->refct           = 1;
764   PetscCall(PetscMalloc1(nNodes * nodeIdxDim, &(ni->nodeIdx)));
765   PetscCall(PetscMalloc1(nNodes * nodeVecDim, &(ni->nodeVec)));
766   PetscCall(PetscArraycpy(ni->nodeIdx, niA->nodeIdx, niA->nNodes * nodeIdxDim));
767   PetscCall(PetscArraycpy(ni->nodeVec, niA->nodeVec, niA->nNodes * nodeVecDim));
768   PetscCall(PetscArraycpy(&(ni->nodeIdx[niA->nNodes * nodeIdxDim]), niB->nodeIdx, niB->nNodes * nodeIdxDim));
769   PetscCall(PetscArraycpy(&(ni->nodeVec[niA->nNodes * nodeVecDim]), niB->nodeVec, niB->nNodes * nodeVecDim));
770   *nodeIndices = ni;
771   PetscFunctionReturn(PETSC_SUCCESS);
772 }
773 
774 #define PETSCTUPINTCOMPREVLEX(N) \
775   static int PetscConcat_(PetscTupIntCompRevlex_, N)(const void *a, const void *b) \
776   { \
777     const PetscInt *A = (const PetscInt *)a; \
778     const PetscInt *B = (const PetscInt *)b; \
779     int             i; \
780     PetscInt        diff = 0; \
781     for (i = 0; i < N; i++) { \
782       diff = A[N - i] - B[N - i]; \
783       if (diff) break; \
784     } \
785     return (diff <= 0) ? (diff < 0) ? -1 : 0 : 1; \
786   }
787 
788 PETSCTUPINTCOMPREVLEX(3)
789 PETSCTUPINTCOMPREVLEX(4)
790 PETSCTUPINTCOMPREVLEX(5)
791 PETSCTUPINTCOMPREVLEX(6)
792 PETSCTUPINTCOMPREVLEX(7)
793 
794 static int PetscTupIntCompRevlex_N(const void *a, const void *b)
795 {
796   const PetscInt *A = (const PetscInt *)a;
797   const PetscInt *B = (const PetscInt *)b;
798   int             i;
799   int             N    = A[0];
800   PetscInt        diff = 0;
801   for (i = 0; i < N; i++) {
802     diff = A[N - i] - B[N - i];
803     if (diff) break;
804   }
805   return (diff <= 0) ? (diff < 0) ? -1 : 0 : 1;
806 }
807 
808 /* The nodes are not necessarily in revlex order wrt nodeIdx: get the permutation
809  * that puts them in that order */
810 static PetscErrorCode PetscLagNodeIndicesGetPermutation(PetscLagNodeIndices ni, PetscInt *perm[])
811 {
812   PetscFunctionBegin;
813   if (!(ni->perm)) {
814     PetscInt *sorter;
815     PetscInt  m          = ni->nNodes;
816     PetscInt  nodeIdxDim = ni->nodeIdxDim;
817     PetscInt  i, j, k, l;
818     PetscInt *prm;
819     int (*comp)(const void *, const void *);
820 
821     PetscCall(PetscMalloc1((nodeIdxDim + 2) * m, &sorter));
822     for (k = 0, l = 0, i = 0; i < m; i++) {
823       sorter[k++] = nodeIdxDim + 1;
824       sorter[k++] = i;
825       for (j = 0; j < nodeIdxDim; j++) sorter[k++] = ni->nodeIdx[l++];
826     }
827     switch (nodeIdxDim) {
828     case 2:
829       comp = PetscTupIntCompRevlex_3;
830       break;
831     case 3:
832       comp = PetscTupIntCompRevlex_4;
833       break;
834     case 4:
835       comp = PetscTupIntCompRevlex_5;
836       break;
837     case 5:
838       comp = PetscTupIntCompRevlex_6;
839       break;
840     case 6:
841       comp = PetscTupIntCompRevlex_7;
842       break;
843     default:
844       comp = PetscTupIntCompRevlex_N;
845       break;
846     }
847     qsort(sorter, m, (nodeIdxDim + 2) * sizeof(PetscInt), comp);
848     PetscCall(PetscMalloc1(m, &prm));
849     for (i = 0; i < m; i++) prm[i] = sorter[(nodeIdxDim + 2) * i + 1];
850     ni->perm = prm;
851     PetscCall(PetscFree(sorter));
852   }
853   *perm = ni->perm;
854   PetscFunctionReturn(PETSC_SUCCESS);
855 }
856 
857 static PetscErrorCode PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp)
858 {
859   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
860 
861   PetscFunctionBegin;
862   if (lag->symperms) {
863     PetscInt **selfSyms = lag->symperms[0];
864 
865     if (selfSyms) {
866       PetscInt i, **allocated = &selfSyms[-lag->selfSymOff];
867 
868       for (i = 0; i < lag->numSelfSym; i++) PetscCall(PetscFree(allocated[i]));
869       PetscCall(PetscFree(allocated));
870     }
871     PetscCall(PetscFree(lag->symperms));
872   }
873   if (lag->symflips) {
874     PetscScalar **selfSyms = lag->symflips[0];
875 
876     if (selfSyms) {
877       PetscInt      i;
878       PetscScalar **allocated = &selfSyms[-lag->selfSymOff];
879 
880       for (i = 0; i < lag->numSelfSym; i++) PetscCall(PetscFree(allocated[i]));
881       PetscCall(PetscFree(allocated));
882     }
883     PetscCall(PetscFree(lag->symflips));
884   }
885   PetscCall(Petsc1DNodeFamilyDestroy(&(lag->nodeFamily)));
886   PetscCall(PetscLagNodeIndicesDestroy(&(lag->vertIndices)));
887   PetscCall(PetscLagNodeIndicesDestroy(&(lag->intNodeIndices)));
888   PetscCall(PetscLagNodeIndicesDestroy(&(lag->allNodeIndices)));
889   PetscCall(PetscFree(lag));
890   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetContinuity_C", NULL));
891   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetContinuity_C", NULL));
892   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetTensor_C", NULL));
893   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetTensor_C", NULL));
894   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetTrimmed_C", NULL));
895   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetTrimmed_C", NULL));
896   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetNodeType_C", NULL));
897   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetNodeType_C", NULL));
898   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetUseMoments_C", NULL));
899   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetUseMoments_C", NULL));
900   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetMomentOrder_C", NULL));
901   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetMomentOrder_C", NULL));
902   PetscFunctionReturn(PETSC_SUCCESS);
903 }
904 
905 static PetscErrorCode PetscDualSpaceLagrangeView_Ascii(PetscDualSpace sp, PetscViewer viewer)
906 {
907   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
908 
909   PetscFunctionBegin;
910   PetscCall(PetscViewerASCIIPrintf(viewer, "%s %s%sLagrange dual space\n", lag->continuous ? "Continuous" : "Discontinuous", lag->tensorSpace ? "tensor " : "", lag->trimmed ? "trimmed " : ""));
911   PetscFunctionReturn(PETSC_SUCCESS);
912 }
913 
914 static PetscErrorCode PetscDualSpaceView_Lagrange(PetscDualSpace sp, PetscViewer viewer)
915 {
916   PetscBool iascii;
917 
918   PetscFunctionBegin;
919   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
920   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
921   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &iascii));
922   if (iascii) PetscCall(PetscDualSpaceLagrangeView_Ascii(sp, viewer));
923   PetscFunctionReturn(PETSC_SUCCESS);
924 }
925 
926 static PetscErrorCode PetscDualSpaceSetFromOptions_Lagrange(PetscDualSpace sp, PetscOptionItems *PetscOptionsObject)
927 {
928   PetscBool       continuous, tensor, trimmed, flg, flg2, flg3;
929   PetscDTNodeType nodeType;
930   PetscReal       nodeExponent;
931   PetscInt        momentOrder;
932   PetscBool       nodeEndpoints, useMoments;
933 
934   PetscFunctionBegin;
935   PetscCall(PetscDualSpaceLagrangeGetContinuity(sp, &continuous));
936   PetscCall(PetscDualSpaceLagrangeGetTensor(sp, &tensor));
937   PetscCall(PetscDualSpaceLagrangeGetTrimmed(sp, &trimmed));
938   PetscCall(PetscDualSpaceLagrangeGetNodeType(sp, &nodeType, &nodeEndpoints, &nodeExponent));
939   if (nodeType == PETSCDTNODES_DEFAULT) nodeType = PETSCDTNODES_GAUSSJACOBI;
940   PetscCall(PetscDualSpaceLagrangeGetUseMoments(sp, &useMoments));
941   PetscCall(PetscDualSpaceLagrangeGetMomentOrder(sp, &momentOrder));
942   PetscOptionsHeadBegin(PetscOptionsObject, "PetscDualSpace Lagrange Options");
943   PetscCall(PetscOptionsBool("-petscdualspace_lagrange_continuity", "Flag for continuous element", "PetscDualSpaceLagrangeSetContinuity", continuous, &continuous, &flg));
944   if (flg) PetscCall(PetscDualSpaceLagrangeSetContinuity(sp, continuous));
945   PetscCall(PetscOptionsBool("-petscdualspace_lagrange_tensor", "Flag for tensor dual space", "PetscDualSpaceLagrangeSetTensor", tensor, &tensor, &flg));
946   if (flg) PetscCall(PetscDualSpaceLagrangeSetTensor(sp, tensor));
947   PetscCall(PetscOptionsBool("-petscdualspace_lagrange_trimmed", "Flag for trimmed dual space", "PetscDualSpaceLagrangeSetTrimmed", trimmed, &trimmed, &flg));
948   if (flg) PetscCall(PetscDualSpaceLagrangeSetTrimmed(sp, trimmed));
949   PetscCall(PetscOptionsEnum("-petscdualspace_lagrange_node_type", "Lagrange node location type", "PetscDualSpaceLagrangeSetNodeType", PetscDTNodeTypes, (PetscEnum)nodeType, (PetscEnum *)&nodeType, &flg));
950   PetscCall(PetscOptionsBool("-petscdualspace_lagrange_node_endpoints", "Flag for nodes that include endpoints", "PetscDualSpaceLagrangeSetNodeType", nodeEndpoints, &nodeEndpoints, &flg2));
951   flg3 = PETSC_FALSE;
952   if (nodeType == PETSCDTNODES_GAUSSJACOBI) PetscCall(PetscOptionsReal("-petscdualspace_lagrange_node_exponent", "Gauss-Jacobi weight function exponent", "PetscDualSpaceLagrangeSetNodeType", nodeExponent, &nodeExponent, &flg3));
953   if (flg || flg2 || flg3) PetscCall(PetscDualSpaceLagrangeSetNodeType(sp, nodeType, nodeEndpoints, nodeExponent));
954   PetscCall(PetscOptionsBool("-petscdualspace_lagrange_use_moments", "Use moments (where appropriate) for functionals", "PetscDualSpaceLagrangeSetUseMoments", useMoments, &useMoments, &flg));
955   if (flg) PetscCall(PetscDualSpaceLagrangeSetUseMoments(sp, useMoments));
956   PetscCall(PetscOptionsInt("-petscdualspace_lagrange_moment_order", "Quadrature order for moment functionals", "PetscDualSpaceLagrangeSetMomentOrder", momentOrder, &momentOrder, &flg));
957   if (flg) PetscCall(PetscDualSpaceLagrangeSetMomentOrder(sp, momentOrder));
958   PetscOptionsHeadEnd();
959   PetscFunctionReturn(PETSC_SUCCESS);
960 }
961 
962 static PetscErrorCode PetscDualSpaceDuplicate_Lagrange(PetscDualSpace sp, PetscDualSpace spNew)
963 {
964   PetscBool           cont, tensor, trimmed, boundary;
965   PetscDTNodeType     nodeType;
966   PetscReal           exponent;
967   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
968 
969   PetscFunctionBegin;
970   PetscCall(PetscDualSpaceLagrangeGetContinuity(sp, &cont));
971   PetscCall(PetscDualSpaceLagrangeSetContinuity(spNew, cont));
972   PetscCall(PetscDualSpaceLagrangeGetTensor(sp, &tensor));
973   PetscCall(PetscDualSpaceLagrangeSetTensor(spNew, tensor));
974   PetscCall(PetscDualSpaceLagrangeGetTrimmed(sp, &trimmed));
975   PetscCall(PetscDualSpaceLagrangeSetTrimmed(spNew, trimmed));
976   PetscCall(PetscDualSpaceLagrangeGetNodeType(sp, &nodeType, &boundary, &exponent));
977   PetscCall(PetscDualSpaceLagrangeSetNodeType(spNew, nodeType, boundary, exponent));
978   if (lag->nodeFamily) {
979     PetscDualSpace_Lag *lagnew = (PetscDualSpace_Lag *)spNew->data;
980 
981     PetscCall(Petsc1DNodeFamilyReference(lag->nodeFamily));
982     lagnew->nodeFamily = lag->nodeFamily;
983   }
984   PetscFunctionReturn(PETSC_SUCCESS);
985 }
986 
987 /* for making tensor product spaces: take a dual space and product a segment space that has all the same
988  * specifications (trimmed, continuous, order, node set), except for the form degree */
989 static PetscErrorCode PetscDualSpaceCreateEdgeSubspace_Lagrange(PetscDualSpace sp, PetscInt order, PetscInt k, PetscInt Nc, PetscBool interiorOnly, PetscDualSpace *bdsp)
990 {
991   DM                  K;
992   PetscDualSpace_Lag *newlag;
993 
994   PetscFunctionBegin;
995   PetscCall(PetscDualSpaceDuplicate(sp, bdsp));
996   PetscCall(PetscDualSpaceSetFormDegree(*bdsp, k));
997   PetscCall(DMPlexCreateReferenceCell(PETSC_COMM_SELF, DMPolytopeTypeSimpleShape(1, PETSC_TRUE), &K));
998   PetscCall(PetscDualSpaceSetDM(*bdsp, K));
999   PetscCall(DMDestroy(&K));
1000   PetscCall(PetscDualSpaceSetOrder(*bdsp, order));
1001   PetscCall(PetscDualSpaceSetNumComponents(*bdsp, Nc));
1002   newlag               = (PetscDualSpace_Lag *)(*bdsp)->data;
1003   newlag->interiorOnly = interiorOnly;
1004   PetscCall(PetscDualSpaceSetUp(*bdsp));
1005   PetscFunctionReturn(PETSC_SUCCESS);
1006 }
1007 
1008 /* just the points, weights aren't handled */
1009 static PetscErrorCode PetscQuadratureCreateTensor(PetscQuadrature trace, PetscQuadrature fiber, PetscQuadrature *product)
1010 {
1011   PetscInt         dimTrace, dimFiber;
1012   PetscInt         numPointsTrace, numPointsFiber;
1013   PetscInt         dim, numPoints;
1014   const PetscReal *pointsTrace;
1015   const PetscReal *pointsFiber;
1016   PetscReal       *points;
1017   PetscInt         i, j, k, p;
1018 
1019   PetscFunctionBegin;
1020   PetscCall(PetscQuadratureGetData(trace, &dimTrace, NULL, &numPointsTrace, &pointsTrace, NULL));
1021   PetscCall(PetscQuadratureGetData(fiber, &dimFiber, NULL, &numPointsFiber, &pointsFiber, NULL));
1022   dim       = dimTrace + dimFiber;
1023   numPoints = numPointsFiber * numPointsTrace;
1024   PetscCall(PetscMalloc1(numPoints * dim, &points));
1025   for (p = 0, j = 0; j < numPointsFiber; j++) {
1026     for (i = 0; i < numPointsTrace; i++, p++) {
1027       for (k = 0; k < dimTrace; k++) points[p * dim + k] = pointsTrace[i * dimTrace + k];
1028       for (k = 0; k < dimFiber; k++) points[p * dim + dimTrace + k] = pointsFiber[j * dimFiber + k];
1029     }
1030   }
1031   PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, product));
1032   PetscCall(PetscQuadratureSetData(*product, dim, 0, numPoints, points, NULL));
1033   PetscFunctionReturn(PETSC_SUCCESS);
1034 }
1035 
1036 /* Kronecker tensor product where matrix is considered a matrix of k-forms, so that
1037  * the entries in the product matrix are wedge products of the entries in the original matrices */
1038 static PetscErrorCode MatTensorAltV(Mat trace, Mat fiber, PetscInt dimTrace, PetscInt kTrace, PetscInt dimFiber, PetscInt kFiber, Mat *product)
1039 {
1040   PetscInt     mTrace, nTrace, mFiber, nFiber, m, n, k, i, j, l;
1041   PetscInt     dim, NkTrace, NkFiber, Nk;
1042   PetscInt     dT, dF;
1043   PetscInt    *nnzTrace, *nnzFiber, *nnz;
1044   PetscInt     iT, iF, jT, jF, il, jl;
1045   PetscReal   *workT, *workT2, *workF, *workF2, *work, *workstar;
1046   PetscReal   *projT, *projF;
1047   PetscReal   *projTstar, *projFstar;
1048   PetscReal   *wedgeMat;
1049   PetscReal    sign;
1050   PetscScalar *workS;
1051   Mat          prod;
1052   /* this produces dof groups that look like the identity */
1053 
1054   PetscFunctionBegin;
1055   PetscCall(MatGetSize(trace, &mTrace, &nTrace));
1056   PetscCall(PetscDTBinomialInt(dimTrace, PetscAbsInt(kTrace), &NkTrace));
1057   PetscCheck(nTrace % NkTrace == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "point value space of trace matrix is not a multiple of k-form size");
1058   PetscCall(MatGetSize(fiber, &mFiber, &nFiber));
1059   PetscCall(PetscDTBinomialInt(dimFiber, PetscAbsInt(kFiber), &NkFiber));
1060   PetscCheck(nFiber % NkFiber == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "point value space of fiber matrix is not a multiple of k-form size");
1061   PetscCall(PetscMalloc2(mTrace, &nnzTrace, mFiber, &nnzFiber));
1062   for (i = 0; i < mTrace; i++) {
1063     PetscCall(MatGetRow(trace, i, &(nnzTrace[i]), NULL, NULL));
1064     PetscCheck(nnzTrace[i] % NkTrace == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in trace matrix are not in k-form size blocks");
1065   }
1066   for (i = 0; i < mFiber; i++) {
1067     PetscCall(MatGetRow(fiber, i, &(nnzFiber[i]), NULL, NULL));
1068     PetscCheck(nnzFiber[i] % NkFiber == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in fiber matrix are not in k-form size blocks");
1069   }
1070   dim = dimTrace + dimFiber;
1071   k   = kFiber + kTrace;
1072   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk));
1073   m = mTrace * mFiber;
1074   PetscCall(PetscMalloc1(m, &nnz));
1075   for (l = 0, j = 0; j < mFiber; j++)
1076     for (i = 0; i < mTrace; i++, l++) nnz[l] = (nnzTrace[i] / NkTrace) * (nnzFiber[j] / NkFiber) * Nk;
1077   n = (nTrace / NkTrace) * (nFiber / NkFiber) * Nk;
1078   PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, m, n, 0, nnz, &prod));
1079   PetscCall(PetscFree(nnz));
1080   PetscCall(PetscFree2(nnzTrace, nnzFiber));
1081   /* reasoning about which points each dof needs depends on having zeros computed at points preserved */
1082   PetscCall(MatSetOption(prod, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
1083   /* compute pullbacks */
1084   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(kTrace), &dT));
1085   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(kFiber), &dF));
1086   PetscCall(PetscMalloc4(dimTrace * dim, &projT, dimFiber * dim, &projF, dT * NkTrace, &projTstar, dF * NkFiber, &projFstar));
1087   PetscCall(PetscArrayzero(projT, dimTrace * dim));
1088   for (i = 0; i < dimTrace; i++) projT[i * (dim + 1)] = 1.;
1089   PetscCall(PetscArrayzero(projF, dimFiber * dim));
1090   for (i = 0; i < dimFiber; i++) projF[i * (dim + 1) + dimTrace] = 1.;
1091   PetscCall(PetscDTAltVPullbackMatrix(dim, dimTrace, projT, kTrace, projTstar));
1092   PetscCall(PetscDTAltVPullbackMatrix(dim, dimFiber, projF, kFiber, projFstar));
1093   PetscCall(PetscMalloc5(dT, &workT, dF, &workF, Nk, &work, Nk, &workstar, Nk, &workS));
1094   PetscCall(PetscMalloc2(dT, &workT2, dF, &workF2));
1095   PetscCall(PetscMalloc1(Nk * dT, &wedgeMat));
1096   sign = (PetscAbsInt(kTrace * kFiber) & 1) ? -1. : 1.;
1097   for (i = 0, iF = 0; iF < mFiber; iF++) {
1098     PetscInt           ncolsF, nformsF;
1099     const PetscInt    *colsF;
1100     const PetscScalar *valsF;
1101 
1102     PetscCall(MatGetRow(fiber, iF, &ncolsF, &colsF, &valsF));
1103     nformsF = ncolsF / NkFiber;
1104     for (iT = 0; iT < mTrace; iT++, i++) {
1105       PetscInt           ncolsT, nformsT;
1106       const PetscInt    *colsT;
1107       const PetscScalar *valsT;
1108 
1109       PetscCall(MatGetRow(trace, iT, &ncolsT, &colsT, &valsT));
1110       nformsT = ncolsT / NkTrace;
1111       for (j = 0, jF = 0; jF < nformsF; jF++) {
1112         PetscInt colF = colsF[jF * NkFiber] / NkFiber;
1113 
1114         for (il = 0; il < dF; il++) {
1115           PetscReal val = 0.;
1116           for (jl = 0; jl < NkFiber; jl++) val += projFstar[il * NkFiber + jl] * PetscRealPart(valsF[jF * NkFiber + jl]);
1117           workF[il] = val;
1118         }
1119         if (kFiber < 0) {
1120           for (il = 0; il < dF; il++) workF2[il] = workF[il];
1121           PetscCall(PetscDTAltVStar(dim, PetscAbsInt(kFiber), 1, workF2, workF));
1122         }
1123         PetscCall(PetscDTAltVWedgeMatrix(dim, PetscAbsInt(kFiber), PetscAbsInt(kTrace), workF, wedgeMat));
1124         for (jT = 0; jT < nformsT; jT++, j++) {
1125           PetscInt           colT = colsT[jT * NkTrace] / NkTrace;
1126           PetscInt           col  = colF * (nTrace / NkTrace) + colT;
1127           const PetscScalar *vals;
1128 
1129           for (il = 0; il < dT; il++) {
1130             PetscReal val = 0.;
1131             for (jl = 0; jl < NkTrace; jl++) val += projTstar[il * NkTrace + jl] * PetscRealPart(valsT[jT * NkTrace + jl]);
1132             workT[il] = val;
1133           }
1134           if (kTrace < 0) {
1135             for (il = 0; il < dT; il++) workT2[il] = workT[il];
1136             PetscCall(PetscDTAltVStar(dim, PetscAbsInt(kTrace), 1, workT2, workT));
1137           }
1138 
1139           for (il = 0; il < Nk; il++) {
1140             PetscReal val = 0.;
1141             for (jl = 0; jl < dT; jl++) val += sign * wedgeMat[il * dT + jl] * workT[jl];
1142             work[il] = val;
1143           }
1144           if (k < 0) {
1145             PetscCall(PetscDTAltVStar(dim, PetscAbsInt(k), -1, work, workstar));
1146 #if defined(PETSC_USE_COMPLEX)
1147             for (l = 0; l < Nk; l++) workS[l] = workstar[l];
1148             vals = &workS[0];
1149 #else
1150             vals = &workstar[0];
1151 #endif
1152           } else {
1153 #if defined(PETSC_USE_COMPLEX)
1154             for (l = 0; l < Nk; l++) workS[l] = work[l];
1155             vals = &workS[0];
1156 #else
1157             vals = &work[0];
1158 #endif
1159           }
1160           for (l = 0; l < Nk; l++) PetscCall(MatSetValue(prod, i, col * Nk + l, vals[l], INSERT_VALUES)); /* Nk */
1161         }                                                                                                 /* jT */
1162       }                                                                                                   /* jF */
1163       PetscCall(MatRestoreRow(trace, iT, &ncolsT, &colsT, &valsT));
1164     } /* iT */
1165     PetscCall(MatRestoreRow(fiber, iF, &ncolsF, &colsF, &valsF));
1166   } /* iF */
1167   PetscCall(PetscFree(wedgeMat));
1168   PetscCall(PetscFree4(projT, projF, projTstar, projFstar));
1169   PetscCall(PetscFree2(workT2, workF2));
1170   PetscCall(PetscFree5(workT, workF, work, workstar, workS));
1171   PetscCall(MatAssemblyBegin(prod, MAT_FINAL_ASSEMBLY));
1172   PetscCall(MatAssemblyEnd(prod, MAT_FINAL_ASSEMBLY));
1173   *product = prod;
1174   PetscFunctionReturn(PETSC_SUCCESS);
1175 }
1176 
1177 /* Union of quadrature points, with an attempt to identify commont points in the two sets */
1178 static PetscErrorCode PetscQuadraturePointsMerge(PetscQuadrature quadA, PetscQuadrature quadB, PetscQuadrature *quadJoint, PetscInt *aToJoint[], PetscInt *bToJoint[])
1179 {
1180   PetscInt         dimA, dimB;
1181   PetscInt         nA, nB, nJoint, i, j, d;
1182   const PetscReal *pointsA;
1183   const PetscReal *pointsB;
1184   PetscReal       *pointsJoint;
1185   PetscInt        *aToJ, *bToJ;
1186   PetscQuadrature  qJ;
1187 
1188   PetscFunctionBegin;
1189   PetscCall(PetscQuadratureGetData(quadA, &dimA, NULL, &nA, &pointsA, NULL));
1190   PetscCall(PetscQuadratureGetData(quadB, &dimB, NULL, &nB, &pointsB, NULL));
1191   PetscCheck(dimA == dimB, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Quadrature points must be in the same dimension");
1192   nJoint = nA;
1193   PetscCall(PetscMalloc1(nA, &aToJ));
1194   for (i = 0; i < nA; i++) aToJ[i] = i;
1195   PetscCall(PetscMalloc1(nB, &bToJ));
1196   for (i = 0; i < nB; i++) {
1197     for (j = 0; j < nA; j++) {
1198       bToJ[i] = -1;
1199       for (d = 0; d < dimA; d++)
1200         if (PetscAbsReal(pointsB[i * dimA + d] - pointsA[j * dimA + d]) > PETSC_SMALL) break;
1201       if (d == dimA) {
1202         bToJ[i] = j;
1203         break;
1204       }
1205     }
1206     if (bToJ[i] == -1) bToJ[i] = nJoint++;
1207   }
1208   *aToJoint = aToJ;
1209   *bToJoint = bToJ;
1210   PetscCall(PetscMalloc1(nJoint * dimA, &pointsJoint));
1211   PetscCall(PetscArraycpy(pointsJoint, pointsA, nA * dimA));
1212   for (i = 0; i < nB; i++) {
1213     if (bToJ[i] >= nA) {
1214       for (d = 0; d < dimA; d++) pointsJoint[bToJ[i] * dimA + d] = pointsB[i * dimA + d];
1215     }
1216   }
1217   PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, &qJ));
1218   PetscCall(PetscQuadratureSetData(qJ, dimA, 0, nJoint, pointsJoint, NULL));
1219   *quadJoint = qJ;
1220   PetscFunctionReturn(PETSC_SUCCESS);
1221 }
1222 
1223 /* Matrices matA and matB are both quadrature -> dof matrices: produce a matrix that is joint quadrature -> union of
1224  * dofs, where the joint quadrature was produced by PetscQuadraturePointsMerge */
1225 static PetscErrorCode MatricesMerge(Mat matA, Mat matB, PetscInt dim, PetscInt k, PetscInt numMerged, const PetscInt aToMerged[], const PetscInt bToMerged[], Mat *matMerged)
1226 {
1227   PetscInt  m, n, mA, nA, mB, nB, Nk, i, j, l;
1228   Mat       M;
1229   PetscInt *nnz;
1230   PetscInt  maxnnz;
1231   PetscInt *work;
1232 
1233   PetscFunctionBegin;
1234   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk));
1235   PetscCall(MatGetSize(matA, &mA, &nA));
1236   PetscCheck(nA % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "matA column space not a multiple of k-form size");
1237   PetscCall(MatGetSize(matB, &mB, &nB));
1238   PetscCheck(nB % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "matB column space not a multiple of k-form size");
1239   m = mA + mB;
1240   n = numMerged * Nk;
1241   PetscCall(PetscMalloc1(m, &nnz));
1242   maxnnz = 0;
1243   for (i = 0; i < mA; i++) {
1244     PetscCall(MatGetRow(matA, i, &(nnz[i]), NULL, NULL));
1245     PetscCheck(nnz[i] % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in matA are not in k-form size blocks");
1246     maxnnz = PetscMax(maxnnz, nnz[i]);
1247   }
1248   for (i = 0; i < mB; i++) {
1249     PetscCall(MatGetRow(matB, i, &(nnz[i + mA]), NULL, NULL));
1250     PetscCheck(nnz[i + mA] % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in matB are not in k-form size blocks");
1251     maxnnz = PetscMax(maxnnz, nnz[i + mA]);
1252   }
1253   PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, m, n, 0, nnz, &M));
1254   PetscCall(PetscFree(nnz));
1255   /* reasoning about which points each dof needs depends on having zeros computed at points preserved */
1256   PetscCall(MatSetOption(M, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
1257   PetscCall(PetscMalloc1(maxnnz, &work));
1258   for (i = 0; i < mA; i++) {
1259     const PetscInt    *cols;
1260     const PetscScalar *vals;
1261     PetscInt           nCols;
1262     PetscCall(MatGetRow(matA, i, &nCols, &cols, &vals));
1263     for (j = 0; j < nCols / Nk; j++) {
1264       PetscInt newCol = aToMerged[cols[j * Nk] / Nk];
1265       for (l = 0; l < Nk; l++) work[j * Nk + l] = newCol * Nk + l;
1266     }
1267     PetscCall(MatSetValuesBlocked(M, 1, &i, nCols, work, vals, INSERT_VALUES));
1268     PetscCall(MatRestoreRow(matA, i, &nCols, &cols, &vals));
1269   }
1270   for (i = 0; i < mB; i++) {
1271     const PetscInt    *cols;
1272     const PetscScalar *vals;
1273 
1274     PetscInt row = i + mA;
1275     PetscInt nCols;
1276     PetscCall(MatGetRow(matB, i, &nCols, &cols, &vals));
1277     for (j = 0; j < nCols / Nk; j++) {
1278       PetscInt newCol = bToMerged[cols[j * Nk] / Nk];
1279       for (l = 0; l < Nk; l++) work[j * Nk + l] = newCol * Nk + l;
1280     }
1281     PetscCall(MatSetValuesBlocked(M, 1, &row, nCols, work, vals, INSERT_VALUES));
1282     PetscCall(MatRestoreRow(matB, i, &nCols, &cols, &vals));
1283   }
1284   PetscCall(PetscFree(work));
1285   PetscCall(MatAssemblyBegin(M, MAT_FINAL_ASSEMBLY));
1286   PetscCall(MatAssemblyEnd(M, MAT_FINAL_ASSEMBLY));
1287   *matMerged = M;
1288   PetscFunctionReturn(PETSC_SUCCESS);
1289 }
1290 
1291 /* Take a dual space and product a segment space that has all the same specifications (trimmed, continuous, order,
1292  * node set), except for the form degree.  For computing boundary dofs and for making tensor product spaces */
1293 static PetscErrorCode PetscDualSpaceCreateFacetSubspace_Lagrange(PetscDualSpace sp, DM K, PetscInt f, PetscInt k, PetscInt Ncopies, PetscBool interiorOnly, PetscDualSpace *bdsp)
1294 {
1295   PetscInt            Nknew, Ncnew;
1296   PetscInt            dim, pointDim = -1;
1297   PetscInt            depth;
1298   DM                  dm;
1299   PetscDualSpace_Lag *newlag;
1300 
1301   PetscFunctionBegin;
1302   PetscCall(PetscDualSpaceGetDM(sp, &dm));
1303   PetscCall(DMGetDimension(dm, &dim));
1304   PetscCall(DMPlexGetDepth(dm, &depth));
1305   PetscCall(PetscDualSpaceDuplicate(sp, bdsp));
1306   PetscCall(PetscDualSpaceSetFormDegree(*bdsp, k));
1307   if (!K) {
1308     if (depth == dim) {
1309       DMPolytopeType ct;
1310 
1311       pointDim = dim - 1;
1312       PetscCall(DMPlexGetCellType(dm, f, &ct));
1313       PetscCall(DMPlexCreateReferenceCell(PETSC_COMM_SELF, ct, &K));
1314     } else if (depth == 1) {
1315       pointDim = 0;
1316       PetscCall(DMPlexCreateReferenceCell(PETSC_COMM_SELF, DM_POLYTOPE_POINT, &K));
1317     } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unsupported interpolation state of reference element");
1318   } else {
1319     PetscCall(PetscObjectReference((PetscObject)K));
1320     PetscCall(DMGetDimension(K, &pointDim));
1321   }
1322   PetscCall(PetscDualSpaceSetDM(*bdsp, K));
1323   PetscCall(DMDestroy(&K));
1324   PetscCall(PetscDTBinomialInt(pointDim, PetscAbsInt(k), &Nknew));
1325   Ncnew = Nknew * Ncopies;
1326   PetscCall(PetscDualSpaceSetNumComponents(*bdsp, Ncnew));
1327   newlag               = (PetscDualSpace_Lag *)(*bdsp)->data;
1328   newlag->interiorOnly = interiorOnly;
1329   PetscCall(PetscDualSpaceSetUp(*bdsp));
1330   PetscFunctionReturn(PETSC_SUCCESS);
1331 }
1332 
1333 /* Construct simplex nodes from a nodefamily, add Nk dof vectors of length Nk at each node.
1334  * Return the (quadrature, matrix) form of the dofs and the nodeIndices form as well.
1335  *
1336  * Sometimes we want a set of nodes to be contained in the interior of the element,
1337  * even when the node scheme puts nodes on the boundaries.  numNodeSkip tells
1338  * the routine how many "layers" of nodes need to be skipped.
1339  * */
1340 static PetscErrorCode PetscDualSpaceLagrangeCreateSimplexNodeMat(Petsc1DNodeFamily nodeFamily, PetscInt dim, PetscInt sum, PetscInt Nk, PetscInt numNodeSkip, PetscQuadrature *iNodes, Mat *iMat, PetscLagNodeIndices *nodeIndices)
1341 {
1342   PetscReal          *extraNodeCoords, *nodeCoords;
1343   PetscInt            nNodes, nExtraNodes;
1344   PetscInt            i, j, k, extraSum = sum + numNodeSkip * (1 + dim);
1345   PetscQuadrature     intNodes;
1346   Mat                 intMat;
1347   PetscLagNodeIndices ni;
1348 
1349   PetscFunctionBegin;
1350   PetscCall(PetscDTBinomialInt(dim + sum, dim, &nNodes));
1351   PetscCall(PetscDTBinomialInt(dim + extraSum, dim, &nExtraNodes));
1352 
1353   PetscCall(PetscMalloc1(dim * nExtraNodes, &extraNodeCoords));
1354   PetscCall(PetscNew(&ni));
1355   ni->nodeIdxDim = dim + 1;
1356   ni->nodeVecDim = Nk;
1357   ni->nNodes     = nNodes * Nk;
1358   ni->refct      = 1;
1359   PetscCall(PetscMalloc1(nNodes * Nk * (dim + 1), &(ni->nodeIdx)));
1360   PetscCall(PetscMalloc1(nNodes * Nk * Nk, &(ni->nodeVec)));
1361   for (i = 0; i < nNodes; i++)
1362     for (j = 0; j < Nk; j++)
1363       for (k = 0; k < Nk; k++) ni->nodeVec[(i * Nk + j) * Nk + k] = (j == k) ? 1. : 0.;
1364   PetscCall(Petsc1DNodeFamilyComputeSimplexNodes(nodeFamily, dim, extraSum, extraNodeCoords));
1365   if (numNodeSkip) {
1366     PetscInt  k;
1367     PetscInt *tup;
1368 
1369     PetscCall(PetscMalloc1(dim * nNodes, &nodeCoords));
1370     PetscCall(PetscMalloc1(dim + 1, &tup));
1371     for (k = 0; k < nNodes; k++) {
1372       PetscInt j, c;
1373       PetscInt index;
1374 
1375       PetscCall(PetscDTIndexToBary(dim + 1, sum, k, tup));
1376       for (j = 0; j < dim + 1; j++) tup[j] += numNodeSkip;
1377       for (c = 0; c < Nk; c++) {
1378         for (j = 0; j < dim + 1; j++) ni->nodeIdx[(k * Nk + c) * (dim + 1) + j] = tup[j] + 1;
1379       }
1380       PetscCall(PetscDTBaryToIndex(dim + 1, extraSum, tup, &index));
1381       for (j = 0; j < dim; j++) nodeCoords[k * dim + j] = extraNodeCoords[index * dim + j];
1382     }
1383     PetscCall(PetscFree(tup));
1384     PetscCall(PetscFree(extraNodeCoords));
1385   } else {
1386     PetscInt  k;
1387     PetscInt *tup;
1388 
1389     nodeCoords = extraNodeCoords;
1390     PetscCall(PetscMalloc1(dim + 1, &tup));
1391     for (k = 0; k < nNodes; k++) {
1392       PetscInt j, c;
1393 
1394       PetscCall(PetscDTIndexToBary(dim + 1, sum, k, tup));
1395       for (c = 0; c < Nk; c++) {
1396         for (j = 0; j < dim + 1; j++) {
1397           /* barycentric indices can have zeros, but we don't want to push forward zeros because it makes it harder to
1398            * determine which nodes correspond to which under symmetries, so we increase by 1.  This is fine
1399            * because the nodeIdx coordinates don't have any meaning other than helping to identify symmetries */
1400           ni->nodeIdx[(k * Nk + c) * (dim + 1) + j] = tup[j] + 1;
1401         }
1402       }
1403     }
1404     PetscCall(PetscFree(tup));
1405   }
1406   PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, &intNodes));
1407   PetscCall(PetscQuadratureSetData(intNodes, dim, 0, nNodes, nodeCoords, NULL));
1408   PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, nNodes * Nk, nNodes * Nk, Nk, NULL, &intMat));
1409   PetscCall(MatSetOption(intMat, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
1410   for (j = 0; j < nNodes * Nk; j++) {
1411     PetscInt rem = j % Nk;
1412     PetscInt a, aprev = j - rem;
1413     PetscInt anext = aprev + Nk;
1414 
1415     for (a = aprev; a < anext; a++) PetscCall(MatSetValue(intMat, j, a, (a == j) ? 1. : 0., INSERT_VALUES));
1416   }
1417   PetscCall(MatAssemblyBegin(intMat, MAT_FINAL_ASSEMBLY));
1418   PetscCall(MatAssemblyEnd(intMat, MAT_FINAL_ASSEMBLY));
1419   *iNodes      = intNodes;
1420   *iMat        = intMat;
1421   *nodeIndices = ni;
1422   PetscFunctionReturn(PETSC_SUCCESS);
1423 }
1424 
1425 /* once the nodeIndices have been created for the interior of the reference cell, and for all of the boundary cells,
1426  * push forward the boundary dofs and concatenate them into the full node indices for the dual space */
1427 static PetscErrorCode PetscDualSpaceLagrangeCreateAllNodeIdx(PetscDualSpace sp)
1428 {
1429   DM                  dm;
1430   PetscInt            dim, nDofs;
1431   PetscSection        section;
1432   PetscInt            pStart, pEnd, p;
1433   PetscInt            formDegree, Nk;
1434   PetscInt            nodeIdxDim, spintdim;
1435   PetscDualSpace_Lag *lag;
1436   PetscLagNodeIndices ni, verti;
1437 
1438   PetscFunctionBegin;
1439   lag   = (PetscDualSpace_Lag *)sp->data;
1440   verti = lag->vertIndices;
1441   PetscCall(PetscDualSpaceGetDM(sp, &dm));
1442   PetscCall(DMGetDimension(dm, &dim));
1443   PetscCall(PetscDualSpaceGetFormDegree(sp, &formDegree));
1444   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk));
1445   PetscCall(PetscDualSpaceGetSection(sp, &section));
1446   PetscCall(PetscSectionGetStorageSize(section, &nDofs));
1447   PetscCall(PetscNew(&ni));
1448   ni->nodeIdxDim = nodeIdxDim = verti->nodeIdxDim;
1449   ni->nodeVecDim              = Nk;
1450   ni->nNodes                  = nDofs;
1451   ni->refct                   = 1;
1452   PetscCall(PetscMalloc1(nodeIdxDim * nDofs, &(ni->nodeIdx)));
1453   PetscCall(PetscMalloc1(Nk * nDofs, &(ni->nodeVec)));
1454   PetscCall(DMPlexGetChart(dm, &pStart, &pEnd));
1455   PetscCall(PetscSectionGetDof(section, 0, &spintdim));
1456   if (spintdim) {
1457     PetscCall(PetscArraycpy(ni->nodeIdx, lag->intNodeIndices->nodeIdx, spintdim * nodeIdxDim));
1458     PetscCall(PetscArraycpy(ni->nodeVec, lag->intNodeIndices->nodeVec, spintdim * Nk));
1459   }
1460   for (p = pStart + 1; p < pEnd; p++) {
1461     PetscDualSpace      psp = sp->pointSpaces[p];
1462     PetscDualSpace_Lag *plag;
1463     PetscInt            dof, off;
1464 
1465     PetscCall(PetscSectionGetDof(section, p, &dof));
1466     if (!dof) continue;
1467     plag = (PetscDualSpace_Lag *)psp->data;
1468     PetscCall(PetscSectionGetOffset(section, p, &off));
1469     PetscCall(PetscLagNodeIndicesPushForward(dm, verti, p, plag->vertIndices, plag->intNodeIndices, 0, formDegree, &(ni->nodeIdx[off * nodeIdxDim]), &(ni->nodeVec[off * Nk])));
1470   }
1471   lag->allNodeIndices = ni;
1472   PetscFunctionReturn(PETSC_SUCCESS);
1473 }
1474 
1475 /* once the (quadrature, Matrix) forms of the dofs have been created for the interior of the
1476  * reference cell and for the boundary cells, jk
1477  * push forward the boundary data and concatenate them into the full (quadrature, matrix) data
1478  * for the dual space */
1479 static PetscErrorCode PetscDualSpaceCreateAllDataFromInteriorData(PetscDualSpace sp)
1480 {
1481   DM              dm;
1482   PetscSection    section;
1483   PetscInt        pStart, pEnd, p, k, Nk, dim, Nc;
1484   PetscInt        nNodes;
1485   PetscInt        countNodes;
1486   Mat             allMat;
1487   PetscQuadrature allNodes;
1488   PetscInt        nDofs;
1489   PetscInt        maxNzforms, j;
1490   PetscScalar    *work;
1491   PetscReal      *L, *J, *Jinv, *v0, *pv0;
1492   PetscInt       *iwork;
1493   PetscReal      *nodes;
1494 
1495   PetscFunctionBegin;
1496   PetscCall(PetscDualSpaceGetDM(sp, &dm));
1497   PetscCall(DMGetDimension(dm, &dim));
1498   PetscCall(PetscDualSpaceGetSection(sp, &section));
1499   PetscCall(PetscSectionGetStorageSize(section, &nDofs));
1500   PetscCall(DMPlexGetChart(dm, &pStart, &pEnd));
1501   PetscCall(PetscDualSpaceGetFormDegree(sp, &k));
1502   PetscCall(PetscDualSpaceGetNumComponents(sp, &Nc));
1503   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk));
1504   for (p = pStart, nNodes = 0, maxNzforms = 0; p < pEnd; p++) {
1505     PetscDualSpace  psp;
1506     DM              pdm;
1507     PetscInt        pdim, pNk;
1508     PetscQuadrature intNodes;
1509     Mat             intMat;
1510 
1511     PetscCall(PetscDualSpaceGetPointSubspace(sp, p, &psp));
1512     if (!psp) continue;
1513     PetscCall(PetscDualSpaceGetDM(psp, &pdm));
1514     PetscCall(DMGetDimension(pdm, &pdim));
1515     if (pdim < PetscAbsInt(k)) continue;
1516     PetscCall(PetscDTBinomialInt(pdim, PetscAbsInt(k), &pNk));
1517     PetscCall(PetscDualSpaceGetInteriorData(psp, &intNodes, &intMat));
1518     if (intNodes) {
1519       PetscInt nNodesp;
1520 
1521       PetscCall(PetscQuadratureGetData(intNodes, NULL, NULL, &nNodesp, NULL, NULL));
1522       nNodes += nNodesp;
1523     }
1524     if (intMat) {
1525       PetscInt maxNzsp;
1526       PetscInt maxNzformsp;
1527 
1528       PetscCall(MatSeqAIJGetMaxRowNonzeros(intMat, &maxNzsp));
1529       PetscCheck(maxNzsp % pNk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms");
1530       maxNzformsp = maxNzsp / pNk;
1531       maxNzforms  = PetscMax(maxNzforms, maxNzformsp);
1532     }
1533   }
1534   PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, nDofs, nNodes * Nc, maxNzforms * Nk, NULL, &allMat));
1535   PetscCall(MatSetOption(allMat, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
1536   PetscCall(PetscMalloc7(dim, &v0, dim, &pv0, dim * dim, &J, dim * dim, &Jinv, Nk * Nk, &L, maxNzforms * Nk, &work, maxNzforms * Nk, &iwork));
1537   for (j = 0; j < dim; j++) pv0[j] = -1.;
1538   PetscCall(PetscMalloc1(dim * nNodes, &nodes));
1539   for (p = pStart, countNodes = 0; p < pEnd; p++) {
1540     PetscDualSpace  psp;
1541     PetscQuadrature intNodes;
1542     DM              pdm;
1543     PetscInt        pdim, pNk;
1544     PetscInt        countNodesIn = countNodes;
1545     PetscReal       detJ;
1546     Mat             intMat;
1547 
1548     PetscCall(PetscDualSpaceGetPointSubspace(sp, p, &psp));
1549     if (!psp) continue;
1550     PetscCall(PetscDualSpaceGetDM(psp, &pdm));
1551     PetscCall(DMGetDimension(pdm, &pdim));
1552     if (pdim < PetscAbsInt(k)) continue;
1553     PetscCall(PetscDualSpaceGetInteriorData(psp, &intNodes, &intMat));
1554     if (intNodes == NULL && intMat == NULL) continue;
1555     PetscCall(PetscDTBinomialInt(pdim, PetscAbsInt(k), &pNk));
1556     if (p) {
1557       PetscCall(DMPlexComputeCellGeometryAffineFEM(dm, p, v0, J, Jinv, &detJ));
1558     } else { /* identity */
1559       PetscInt i, j;
1560 
1561       for (i = 0; i < dim; i++)
1562         for (j = 0; j < dim; j++) J[i * dim + j] = Jinv[i * dim + j] = 0.;
1563       for (i = 0; i < dim; i++) J[i * dim + i] = Jinv[i * dim + i] = 1.;
1564       for (i = 0; i < dim; i++) v0[i] = -1.;
1565     }
1566     if (pdim != dim) { /* compactify Jacobian */
1567       PetscInt i, j;
1568 
1569       for (i = 0; i < dim; i++)
1570         for (j = 0; j < pdim; j++) J[i * pdim + j] = J[i * dim + j];
1571     }
1572     PetscCall(PetscDTAltVPullbackMatrix(pdim, dim, J, k, L));
1573     if (intNodes) { /* push forward quadrature locations by the affine transformation */
1574       PetscInt         nNodesp;
1575       const PetscReal *nodesp;
1576       PetscInt         j;
1577 
1578       PetscCall(PetscQuadratureGetData(intNodes, NULL, NULL, &nNodesp, &nodesp, NULL));
1579       for (j = 0; j < nNodesp; j++, countNodes++) {
1580         PetscInt d, e;
1581 
1582         for (d = 0; d < dim; d++) {
1583           nodes[countNodes * dim + d] = v0[d];
1584           for (e = 0; e < pdim; e++) nodes[countNodes * dim + d] += J[d * pdim + e] * (nodesp[j * pdim + e] - pv0[e]);
1585         }
1586       }
1587     }
1588     if (intMat) {
1589       PetscInt nrows;
1590       PetscInt off;
1591 
1592       PetscCall(PetscSectionGetDof(section, p, &nrows));
1593       PetscCall(PetscSectionGetOffset(section, p, &off));
1594       for (j = 0; j < nrows; j++) {
1595         PetscInt           ncols;
1596         const PetscInt    *cols;
1597         const PetscScalar *vals;
1598         PetscInt           l, d, e;
1599         PetscInt           row = j + off;
1600 
1601         PetscCall(MatGetRow(intMat, j, &ncols, &cols, &vals));
1602         PetscCheck(ncols % pNk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms");
1603         for (l = 0; l < ncols / pNk; l++) {
1604           PetscInt blockcol;
1605 
1606           for (d = 0; d < pNk; d++) PetscCheck((cols[l * pNk + d] % pNk) == d, PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms");
1607           blockcol = cols[l * pNk] / pNk;
1608           for (d = 0; d < Nk; d++) iwork[l * Nk + d] = (blockcol + countNodesIn) * Nk + d;
1609           for (d = 0; d < Nk; d++) work[l * Nk + d] = 0.;
1610           for (d = 0; d < Nk; d++) {
1611             for (e = 0; e < pNk; e++) {
1612               /* "push forward" dof by pulling back a k-form to be evaluated on the point: multiply on the right by L */
1613               work[l * Nk + d] += vals[l * pNk + e] * L[e * Nk + d];
1614             }
1615           }
1616         }
1617         PetscCall(MatSetValues(allMat, 1, &row, (ncols / pNk) * Nk, iwork, work, INSERT_VALUES));
1618         PetscCall(MatRestoreRow(intMat, j, &ncols, &cols, &vals));
1619       }
1620     }
1621   }
1622   PetscCall(MatAssemblyBegin(allMat, MAT_FINAL_ASSEMBLY));
1623   PetscCall(MatAssemblyEnd(allMat, MAT_FINAL_ASSEMBLY));
1624   PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, &allNodes));
1625   PetscCall(PetscQuadratureSetData(allNodes, dim, 0, nNodes, nodes, NULL));
1626   PetscCall(PetscFree7(v0, pv0, J, Jinv, L, work, iwork));
1627   PetscCall(MatDestroy(&(sp->allMat)));
1628   sp->allMat = allMat;
1629   PetscCall(PetscQuadratureDestroy(&(sp->allNodes)));
1630   sp->allNodes = allNodes;
1631   PetscFunctionReturn(PETSC_SUCCESS);
1632 }
1633 
1634 /* rather than trying to get all data from the functionals, we create
1635  * the functionals from rows of the quadrature -> dof matrix.
1636  *
1637  * Ideally most of the uses of PetscDualSpace in PetscFE will switch
1638  * to using intMat and allMat, so that the individual functionals
1639  * don't need to be constructed at all */
1640 static PetscErrorCode PetscDualSpaceComputeFunctionalsFromAllData(PetscDualSpace sp)
1641 {
1642   PetscQuadrature  allNodes;
1643   Mat              allMat;
1644   PetscInt         nDofs;
1645   PetscInt         dim, k, Nk, Nc, f;
1646   DM               dm;
1647   PetscInt         nNodes, spdim;
1648   const PetscReal *nodes = NULL;
1649   PetscSection     section;
1650   PetscBool        useMoments;
1651 
1652   PetscFunctionBegin;
1653   PetscCall(PetscDualSpaceGetDM(sp, &dm));
1654   PetscCall(DMGetDimension(dm, &dim));
1655   PetscCall(PetscDualSpaceGetNumComponents(sp, &Nc));
1656   PetscCall(PetscDualSpaceGetFormDegree(sp, &k));
1657   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk));
1658   PetscCall(PetscDualSpaceGetAllData(sp, &allNodes, &allMat));
1659   nNodes = 0;
1660   if (allNodes) PetscCall(PetscQuadratureGetData(allNodes, NULL, NULL, &nNodes, &nodes, NULL));
1661   PetscCall(MatGetSize(allMat, &nDofs, NULL));
1662   PetscCall(PetscDualSpaceGetSection(sp, &section));
1663   PetscCall(PetscSectionGetStorageSize(section, &spdim));
1664   PetscCheck(spdim == nDofs, PETSC_COMM_SELF, PETSC_ERR_PLIB, "incompatible all matrix size");
1665   PetscCall(PetscMalloc1(nDofs, &(sp->functional)));
1666   PetscCall(PetscDualSpaceLagrangeGetUseMoments(sp, &useMoments));
1667   if (useMoments) {
1668     Mat              allMat;
1669     PetscInt         momentOrder, i;
1670     PetscBool        tensor;
1671     const PetscReal *weights;
1672     PetscScalar     *array;
1673 
1674     PetscCheck(nDofs == 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "We do not yet support moments beyond P0, nDofs == %" PetscInt_FMT, nDofs);
1675     PetscCall(PetscDualSpaceLagrangeGetMomentOrder(sp, &momentOrder));
1676     PetscCall(PetscDualSpaceLagrangeGetTensor(sp, &tensor));
1677     if (!tensor) PetscCall(PetscDTStroudConicalQuadrature(dim, Nc, PetscMax(momentOrder + 1, 1), -1.0, 1.0, &(sp->functional[0])));
1678     else PetscCall(PetscDTGaussTensorQuadrature(dim, Nc, PetscMax(momentOrder + 1, 1), -1.0, 1.0, &(sp->functional[0])));
1679     /* Need to replace allNodes and allMat */
1680     PetscCall(PetscObjectReference((PetscObject)sp->functional[0]));
1681     PetscCall(PetscQuadratureDestroy(&(sp->allNodes)));
1682     sp->allNodes = sp->functional[0];
1683     PetscCall(PetscQuadratureGetData(sp->allNodes, NULL, NULL, &nNodes, NULL, &weights));
1684     PetscCall(MatCreateSeqDense(PETSC_COMM_SELF, nDofs, nNodes * Nc, NULL, &allMat));
1685     PetscCall(MatDenseGetArrayWrite(allMat, &array));
1686     for (i = 0; i < nNodes * Nc; ++i) array[i] = weights[i];
1687     PetscCall(MatDenseRestoreArrayWrite(allMat, &array));
1688     PetscCall(MatAssemblyBegin(allMat, MAT_FINAL_ASSEMBLY));
1689     PetscCall(MatAssemblyEnd(allMat, MAT_FINAL_ASSEMBLY));
1690     PetscCall(MatDestroy(&(sp->allMat)));
1691     sp->allMat = allMat;
1692     PetscFunctionReturn(PETSC_SUCCESS);
1693   }
1694   for (f = 0; f < nDofs; f++) {
1695     PetscInt           ncols, c;
1696     const PetscInt    *cols;
1697     const PetscScalar *vals;
1698     PetscReal         *nodesf;
1699     PetscReal         *weightsf;
1700     PetscInt           nNodesf;
1701     PetscInt           countNodes;
1702 
1703     PetscCall(MatGetRow(allMat, f, &ncols, &cols, &vals));
1704     PetscCheck(ncols % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "all matrix is not laid out as blocks of k-forms");
1705     for (c = 1, nNodesf = 1; c < ncols; c++) {
1706       if ((cols[c] / Nc) != (cols[c - 1] / Nc)) nNodesf++;
1707     }
1708     PetscCall(PetscMalloc1(dim * nNodesf, &nodesf));
1709     PetscCall(PetscMalloc1(Nc * nNodesf, &weightsf));
1710     for (c = 0, countNodes = 0; c < ncols; c++) {
1711       if (!c || ((cols[c] / Nc) != (cols[c - 1] / Nc))) {
1712         PetscInt d;
1713 
1714         for (d = 0; d < Nc; d++) weightsf[countNodes * Nc + d] = 0.;
1715         for (d = 0; d < dim; d++) nodesf[countNodes * dim + d] = nodes[(cols[c] / Nc) * dim + d];
1716         countNodes++;
1717       }
1718       weightsf[(countNodes - 1) * Nc + (cols[c] % Nc)] = PetscRealPart(vals[c]);
1719     }
1720     PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, &(sp->functional[f])));
1721     PetscCall(PetscQuadratureSetData(sp->functional[f], dim, Nc, nNodesf, nodesf, weightsf));
1722     PetscCall(MatRestoreRow(allMat, f, &ncols, &cols, &vals));
1723   }
1724   PetscFunctionReturn(PETSC_SUCCESS);
1725 }
1726 
1727 /* take a matrix meant for k-forms and expand it to one for Ncopies */
1728 static PetscErrorCode PetscDualSpaceLagrangeMatrixCreateCopies(Mat A, PetscInt Nk, PetscInt Ncopies, Mat *Abs)
1729 {
1730   PetscInt m, n, i, j, k;
1731   PetscInt maxnnz, *nnz, *iwork;
1732   Mat      Ac;
1733 
1734   PetscFunctionBegin;
1735   PetscCall(MatGetSize(A, &m, &n));
1736   PetscCheck(n % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of columns in A %" PetscInt_FMT " is not a multiple of Nk %" PetscInt_FMT, n, Nk);
1737   PetscCall(PetscMalloc1(m * Ncopies, &nnz));
1738   for (i = 0, maxnnz = 0; i < m; i++) {
1739     PetscInt innz;
1740     PetscCall(MatGetRow(A, i, &innz, NULL, NULL));
1741     PetscCheck(innz % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "A row %" PetscInt_FMT " nnzs is not a multiple of Nk %" PetscInt_FMT, innz, Nk);
1742     for (j = 0; j < Ncopies; j++) nnz[i * Ncopies + j] = innz;
1743     maxnnz = PetscMax(maxnnz, innz);
1744   }
1745   PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, m * Ncopies, n * Ncopies, 0, nnz, &Ac));
1746   PetscCall(MatSetOption(Ac, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
1747   PetscCall(PetscFree(nnz));
1748   PetscCall(PetscMalloc1(maxnnz, &iwork));
1749   for (i = 0; i < m; i++) {
1750     PetscInt           innz;
1751     const PetscInt    *cols;
1752     const PetscScalar *vals;
1753 
1754     PetscCall(MatGetRow(A, i, &innz, &cols, &vals));
1755     for (j = 0; j < innz; j++) iwork[j] = (cols[j] / Nk) * (Nk * Ncopies) + (cols[j] % Nk);
1756     for (j = 0; j < Ncopies; j++) {
1757       PetscInt row = i * Ncopies + j;
1758 
1759       PetscCall(MatSetValues(Ac, 1, &row, innz, iwork, vals, INSERT_VALUES));
1760       for (k = 0; k < innz; k++) iwork[k] += Nk;
1761     }
1762     PetscCall(MatRestoreRow(A, i, &innz, &cols, &vals));
1763   }
1764   PetscCall(PetscFree(iwork));
1765   PetscCall(MatAssemblyBegin(Ac, MAT_FINAL_ASSEMBLY));
1766   PetscCall(MatAssemblyEnd(Ac, MAT_FINAL_ASSEMBLY));
1767   *Abs = Ac;
1768   PetscFunctionReturn(PETSC_SUCCESS);
1769 }
1770 
1771 /* check if a cell is a tensor product of the segment with a facet,
1772  * specifically checking if f and f2 can be the "endpoints" (like the triangles
1773  * at either end of a wedge) */
1774 static PetscErrorCode DMPlexPointIsTensor_Internal_Given(DM dm, PetscInt p, PetscInt f, PetscInt f2, PetscBool *isTensor)
1775 {
1776   PetscInt        coneSize, c;
1777   const PetscInt *cone;
1778   const PetscInt *fCone;
1779   const PetscInt *f2Cone;
1780   PetscInt        fs[2];
1781   PetscInt        meetSize, nmeet;
1782   const PetscInt *meet;
1783 
1784   PetscFunctionBegin;
1785   fs[0] = f;
1786   fs[1] = f2;
1787   PetscCall(DMPlexGetMeet(dm, 2, fs, &meetSize, &meet));
1788   nmeet = meetSize;
1789   PetscCall(DMPlexRestoreMeet(dm, 2, fs, &meetSize, &meet));
1790   /* two points that have a non-empty meet cannot be at opposite ends of a cell */
1791   if (nmeet) {
1792     *isTensor = PETSC_FALSE;
1793     PetscFunctionReturn(PETSC_SUCCESS);
1794   }
1795   PetscCall(DMPlexGetConeSize(dm, p, &coneSize));
1796   PetscCall(DMPlexGetCone(dm, p, &cone));
1797   PetscCall(DMPlexGetCone(dm, f, &fCone));
1798   PetscCall(DMPlexGetCone(dm, f2, &f2Cone));
1799   for (c = 0; c < coneSize; c++) {
1800     PetscInt        e, ef;
1801     PetscInt        d = -1, d2 = -1;
1802     PetscInt        dcount, d2count;
1803     PetscInt        t = cone[c];
1804     PetscInt        tConeSize;
1805     PetscBool       tIsTensor;
1806     const PetscInt *tCone;
1807 
1808     if (t == f || t == f2) continue;
1809     /* for every other facet in the cone, check that is has
1810      * one ridge in common with each end */
1811     PetscCall(DMPlexGetConeSize(dm, t, &tConeSize));
1812     PetscCall(DMPlexGetCone(dm, t, &tCone));
1813 
1814     dcount  = 0;
1815     d2count = 0;
1816     for (e = 0; e < tConeSize; e++) {
1817       PetscInt q = tCone[e];
1818       for (ef = 0; ef < coneSize - 2; ef++) {
1819         if (fCone[ef] == q) {
1820           if (dcount) {
1821             *isTensor = PETSC_FALSE;
1822             PetscFunctionReturn(PETSC_SUCCESS);
1823           }
1824           d = q;
1825           dcount++;
1826         } else if (f2Cone[ef] == q) {
1827           if (d2count) {
1828             *isTensor = PETSC_FALSE;
1829             PetscFunctionReturn(PETSC_SUCCESS);
1830           }
1831           d2 = q;
1832           d2count++;
1833         }
1834       }
1835     }
1836     /* if the whole cell is a tensor with the segment, then this
1837      * facet should be a tensor with the segment */
1838     PetscCall(DMPlexPointIsTensor_Internal_Given(dm, t, d, d2, &tIsTensor));
1839     if (!tIsTensor) {
1840       *isTensor = PETSC_FALSE;
1841       PetscFunctionReturn(PETSC_SUCCESS);
1842     }
1843   }
1844   *isTensor = PETSC_TRUE;
1845   PetscFunctionReturn(PETSC_SUCCESS);
1846 }
1847 
1848 /* determine if a cell is a tensor with a segment by looping over pairs of facets to find a pair
1849  * that could be the opposite ends */
1850 static PetscErrorCode DMPlexPointIsTensor_Internal(DM dm, PetscInt p, PetscBool *isTensor, PetscInt *endA, PetscInt *endB)
1851 {
1852   PetscInt        coneSize, c, c2;
1853   const PetscInt *cone;
1854 
1855   PetscFunctionBegin;
1856   PetscCall(DMPlexGetConeSize(dm, p, &coneSize));
1857   if (!coneSize) {
1858     if (isTensor) *isTensor = PETSC_FALSE;
1859     if (endA) *endA = -1;
1860     if (endB) *endB = -1;
1861   }
1862   PetscCall(DMPlexGetCone(dm, p, &cone));
1863   for (c = 0; c < coneSize; c++) {
1864     PetscInt f = cone[c];
1865     PetscInt fConeSize;
1866 
1867     PetscCall(DMPlexGetConeSize(dm, f, &fConeSize));
1868     if (fConeSize != coneSize - 2) continue;
1869 
1870     for (c2 = c + 1; c2 < coneSize; c2++) {
1871       PetscInt  f2 = cone[c2];
1872       PetscBool isTensorff2;
1873       PetscInt  f2ConeSize;
1874 
1875       PetscCall(DMPlexGetConeSize(dm, f2, &f2ConeSize));
1876       if (f2ConeSize != coneSize - 2) continue;
1877 
1878       PetscCall(DMPlexPointIsTensor_Internal_Given(dm, p, f, f2, &isTensorff2));
1879       if (isTensorff2) {
1880         if (isTensor) *isTensor = PETSC_TRUE;
1881         if (endA) *endA = f;
1882         if (endB) *endB = f2;
1883         PetscFunctionReturn(PETSC_SUCCESS);
1884       }
1885     }
1886   }
1887   if (isTensor) *isTensor = PETSC_FALSE;
1888   if (endA) *endA = -1;
1889   if (endB) *endB = -1;
1890   PetscFunctionReturn(PETSC_SUCCESS);
1891 }
1892 
1893 /* determine if a cell is a tensor with a segment by looping over pairs of facets to find a pair
1894  * that could be the opposite ends */
1895 static PetscErrorCode DMPlexPointIsTensor(DM dm, PetscInt p, PetscBool *isTensor, PetscInt *endA, PetscInt *endB)
1896 {
1897   DMPlexInterpolatedFlag interpolated;
1898 
1899   PetscFunctionBegin;
1900   PetscCall(DMPlexIsInterpolated(dm, &interpolated));
1901   PetscCheck(interpolated == DMPLEX_INTERPOLATED_FULL, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Only for interpolated DMPlex's");
1902   PetscCall(DMPlexPointIsTensor_Internal(dm, p, isTensor, endA, endB));
1903   PetscFunctionReturn(PETSC_SUCCESS);
1904 }
1905 
1906 /* Let k = formDegree and k' = -sign(k) * dim + k.  Transform a symmetric frame for k-forms on the biunit simplex into
1907  * a symmetric frame for k'-forms on the biunit simplex.
1908  *
1909  * A frame is "symmetric" if the pullback of every symmetry of the biunit simplex is a permutation of the frame.
1910  *
1911  * forms in the symmetric frame are used as dofs in the untrimmed simplex spaces.  This way, symmetries of the
1912  * reference cell result in permutations of dofs grouped by node.
1913  *
1914  * Use T to transform dof matrices for k'-forms into dof matrices for k-forms as a block diagonal transformation on
1915  * the right.
1916  */
1917 static PetscErrorCode BiunitSimplexSymmetricFormTransformation(PetscInt dim, PetscInt formDegree, PetscReal T[])
1918 {
1919   PetscInt   k  = formDegree;
1920   PetscInt   kd = k < 0 ? dim + k : k - dim;
1921   PetscInt   Nk;
1922   PetscReal *biToEq, *eqToBi, *biToEqStar, *eqToBiStar;
1923   PetscInt   fact;
1924 
1925   PetscFunctionBegin;
1926   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk));
1927   PetscCall(PetscCalloc4(dim * dim, &biToEq, dim * dim, &eqToBi, Nk * Nk, &biToEqStar, Nk * Nk, &eqToBiStar));
1928   /* fill in biToEq: Jacobian of the transformation from the biunit simplex to the equilateral simplex */
1929   fact = 0;
1930   for (PetscInt i = 0; i < dim; i++) {
1931     biToEq[i * dim + i] = PetscSqrtReal(((PetscReal)i + 2.) / (2. * ((PetscReal)i + 1.)));
1932     fact += 4 * (i + 1);
1933     for (PetscInt j = i + 1; j < dim; j++) biToEq[i * dim + j] = PetscSqrtReal(1. / (PetscReal)fact);
1934   }
1935   /* fill in eqToBi: Jacobian of the transformation from the equilateral simplex to the biunit simplex */
1936   fact = 0;
1937   for (PetscInt j = 0; j < dim; j++) {
1938     eqToBi[j * dim + j] = PetscSqrtReal(2. * ((PetscReal)j + 1.) / ((PetscReal)j + 2));
1939     fact += j + 1;
1940     for (PetscInt i = 0; i < j; i++) eqToBi[i * dim + j] = -PetscSqrtReal(1. / (PetscReal)fact);
1941   }
1942   PetscCall(PetscDTAltVPullbackMatrix(dim, dim, biToEq, kd, biToEqStar));
1943   PetscCall(PetscDTAltVPullbackMatrix(dim, dim, eqToBi, k, eqToBiStar));
1944   /* product of pullbacks simulates the following steps
1945    *
1946    * 1. start with frame W = [w_1, w_2, ..., w_m] of k forms that is symmetric on the biunit simplex:
1947           if J is the Jacobian of a symmetry of the biunit simplex, then J_k* W = [J_k*w_1, ..., J_k*w_m]
1948           is a permutation of W.
1949           Even though a k' form --- a (dim - k) form represented by its Hodge star --- has the same geometric
1950           content as a k form, W is not a symmetric frame of k' forms on the biunit simplex.  That's because,
1951           for general Jacobian J, J_k* != J_k'*.
1952    * 2. pullback W to the equilateral triangle using the k pullback, W_eq = eqToBi_k* W.  All symmetries of the
1953           equilateral simplex have orthonormal Jacobians.  For an orthonormal Jacobian O, J_k* = J_k'*, so W_eq is
1954           also a symmetric frame for k' forms on the equilateral simplex.
1955      3. pullback W_eq back to the biunit simplex using the k' pulback, V = biToEq_k'* W_eq = biToEq_k'* eqToBi_k* W.
1956           V is a symmetric frame for k' forms on the biunit simplex.
1957    */
1958   for (PetscInt i = 0; i < Nk; i++) {
1959     for (PetscInt j = 0; j < Nk; j++) {
1960       PetscReal val = 0.;
1961       for (PetscInt k = 0; k < Nk; k++) val += biToEqStar[i * Nk + k] * eqToBiStar[k * Nk + j];
1962       T[i * Nk + j] = val;
1963     }
1964   }
1965   PetscCall(PetscFree4(biToEq, eqToBi, biToEqStar, eqToBiStar));
1966   PetscFunctionReturn(PETSC_SUCCESS);
1967 }
1968 
1969 /* permute a quadrature -> dof matrix so that its rows are in revlex order by nodeIdx */
1970 static PetscErrorCode MatPermuteByNodeIdx(Mat A, PetscLagNodeIndices ni, Mat *Aperm)
1971 {
1972   PetscInt   m, n, i, j;
1973   PetscInt   nodeIdxDim = ni->nodeIdxDim;
1974   PetscInt   nodeVecDim = ni->nodeVecDim;
1975   PetscInt  *perm;
1976   IS         permIS;
1977   IS         id;
1978   PetscInt  *nIdxPerm;
1979   PetscReal *nVecPerm;
1980 
1981   PetscFunctionBegin;
1982   PetscCall(PetscLagNodeIndicesGetPermutation(ni, &perm));
1983   PetscCall(MatGetSize(A, &m, &n));
1984   PetscCall(PetscMalloc1(nodeIdxDim * m, &nIdxPerm));
1985   PetscCall(PetscMalloc1(nodeVecDim * m, &nVecPerm));
1986   for (i = 0; i < m; i++)
1987     for (j = 0; j < nodeIdxDim; j++) nIdxPerm[i * nodeIdxDim + j] = ni->nodeIdx[perm[i] * nodeIdxDim + j];
1988   for (i = 0; i < m; i++)
1989     for (j = 0; j < nodeVecDim; j++) nVecPerm[i * nodeVecDim + j] = ni->nodeVec[perm[i] * nodeVecDim + j];
1990   PetscCall(ISCreateGeneral(PETSC_COMM_SELF, m, perm, PETSC_USE_POINTER, &permIS));
1991   PetscCall(ISSetPermutation(permIS));
1992   PetscCall(ISCreateStride(PETSC_COMM_SELF, n, 0, 1, &id));
1993   PetscCall(ISSetPermutation(id));
1994   PetscCall(MatPermute(A, permIS, id, Aperm));
1995   PetscCall(ISDestroy(&permIS));
1996   PetscCall(ISDestroy(&id));
1997   for (i = 0; i < m; i++) perm[i] = i;
1998   PetscCall(PetscFree(ni->nodeIdx));
1999   PetscCall(PetscFree(ni->nodeVec));
2000   ni->nodeIdx = nIdxPerm;
2001   ni->nodeVec = nVecPerm;
2002   PetscFunctionReturn(PETSC_SUCCESS);
2003 }
2004 
2005 static PetscErrorCode PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp)
2006 {
2007   PetscDualSpace_Lag    *lag   = (PetscDualSpace_Lag *)sp->data;
2008   DM                     dm    = sp->dm;
2009   DM                     dmint = NULL;
2010   PetscInt               order;
2011   PetscInt               Nc = sp->Nc;
2012   MPI_Comm               comm;
2013   PetscBool              continuous;
2014   PetscSection           section;
2015   PetscInt               depth, dim, pStart, pEnd, cStart, cEnd, p, *pStratStart, *pStratEnd, d;
2016   PetscInt               formDegree, Nk, Ncopies;
2017   PetscInt               tensorf = -1, tensorf2 = -1;
2018   PetscBool              tensorCell, tensorSpace;
2019   PetscBool              uniform, trimmed;
2020   Petsc1DNodeFamily      nodeFamily;
2021   PetscInt               numNodeSkip;
2022   DMPlexInterpolatedFlag interpolated;
2023   PetscBool              isbdm;
2024 
2025   PetscFunctionBegin;
2026   /* step 1: sanitize input */
2027   PetscCall(PetscObjectGetComm((PetscObject)sp, &comm));
2028   PetscCall(DMGetDimension(dm, &dim));
2029   PetscCall(PetscObjectTypeCompare((PetscObject)sp, PETSCDUALSPACEBDM, &isbdm));
2030   if (isbdm) {
2031     sp->k = -(dim - 1); /* form degree of H-div */
2032     PetscCall(PetscObjectChangeTypeName((PetscObject)sp, PETSCDUALSPACELAGRANGE));
2033   }
2034   PetscCall(PetscDualSpaceGetFormDegree(sp, &formDegree));
2035   PetscCheck(PetscAbsInt(formDegree) <= dim, comm, PETSC_ERR_ARG_OUTOFRANGE, "Form degree must be bounded by dimension");
2036   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk));
2037   if (sp->Nc <= 0 && lag->numCopies > 0) sp->Nc = Nk * lag->numCopies;
2038   Nc = sp->Nc;
2039   PetscCheck(Nc % Nk == 0, comm, PETSC_ERR_ARG_INCOMP, "Number of components is not a multiple of form degree size");
2040   if (lag->numCopies <= 0) lag->numCopies = Nc / Nk;
2041   Ncopies = lag->numCopies;
2042   PetscCheck(Nc / Nk == Ncopies, comm, PETSC_ERR_ARG_INCOMP, "Number of copies * (dim choose k) != Nc");
2043   if (!dim) sp->order = 0;
2044   order   = sp->order;
2045   uniform = sp->uniform;
2046   PetscCheck(uniform, PETSC_COMM_SELF, PETSC_ERR_SUP, "Variable order not supported yet");
2047   if (lag->trimmed && !formDegree) lag->trimmed = PETSC_FALSE; /* trimmed spaces are the same as full spaces for 0-forms */
2048   if (lag->nodeType == PETSCDTNODES_DEFAULT) {
2049     lag->nodeType     = PETSCDTNODES_GAUSSJACOBI;
2050     lag->nodeExponent = 0.;
2051     /* trimmed spaces don't include corner vertices, so don't use end nodes by default */
2052     lag->endNodes = lag->trimmed ? PETSC_FALSE : PETSC_TRUE;
2053   }
2054   /* If a trimmed space and the user did choose nodes with endpoints, skip them by default */
2055   if (lag->numNodeSkip < 0) lag->numNodeSkip = (lag->trimmed && lag->endNodes) ? 1 : 0;
2056   numNodeSkip = lag->numNodeSkip;
2057   PetscCheck(!lag->trimmed || order, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Cannot have zeroth order trimmed elements");
2058   if (lag->trimmed && PetscAbsInt(formDegree) == dim) { /* convert trimmed n-forms to untrimmed of one polynomial order less */
2059     sp->order--;
2060     order--;
2061     lag->trimmed = PETSC_FALSE;
2062   }
2063   trimmed = lag->trimmed;
2064   if (!order || PetscAbsInt(formDegree) == dim) lag->continuous = PETSC_FALSE;
2065   continuous = lag->continuous;
2066   PetscCall(DMPlexGetDepth(dm, &depth));
2067   PetscCall(DMPlexGetChart(dm, &pStart, &pEnd));
2068   PetscCall(DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd));
2069   PetscCheck(pStart == 0 && cStart == 0, PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_WRONGSTATE, "Expect DM with chart starting at zero and cells first");
2070   PetscCheck(cEnd == 1, PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_WRONGSTATE, "Use PETSCDUALSPACEREFINED for multi-cell reference meshes");
2071   PetscCall(DMPlexIsInterpolated(dm, &interpolated));
2072   if (interpolated != DMPLEX_INTERPOLATED_FULL) {
2073     PetscCall(DMPlexInterpolate(dm, &dmint));
2074   } else {
2075     PetscCall(PetscObjectReference((PetscObject)dm));
2076     dmint = dm;
2077   }
2078   tensorCell = PETSC_FALSE;
2079   if (dim > 1) PetscCall(DMPlexPointIsTensor(dmint, 0, &tensorCell, &tensorf, &tensorf2));
2080   lag->tensorCell = tensorCell;
2081   if (dim < 2 || !lag->tensorCell) lag->tensorSpace = PETSC_FALSE;
2082   tensorSpace = lag->tensorSpace;
2083   if (!lag->nodeFamily) PetscCall(Petsc1DNodeFamilyCreate(lag->nodeType, lag->nodeExponent, lag->endNodes, &lag->nodeFamily));
2084   nodeFamily = lag->nodeFamily;
2085   PetscCheck(interpolated == DMPLEX_INTERPOLATED_FULL || !continuous || (PetscAbsInt(formDegree) <= 0 && order <= 1), PETSC_COMM_SELF, PETSC_ERR_PLIB, "Reference element won't support all boundary nodes");
2086 
2087   /* step 2: construct the boundary spaces */
2088   PetscCall(PetscMalloc2(depth + 1, &pStratStart, depth + 1, &pStratEnd));
2089   PetscCall(PetscCalloc1(pEnd, &(sp->pointSpaces)));
2090   for (d = 0; d <= depth; ++d) PetscCall(DMPlexGetDepthStratum(dm, d, &pStratStart[d], &pStratEnd[d]));
2091   PetscCall(PetscDualSpaceSectionCreate_Internal(sp, &section));
2092   sp->pointSection = section;
2093   if (continuous && !(lag->interiorOnly)) {
2094     PetscInt h;
2095 
2096     for (p = pStratStart[depth - 1]; p < pStratEnd[depth - 1]; p++) { /* calculate the facet dual spaces */
2097       PetscReal      v0[3];
2098       DMPolytopeType ptype;
2099       PetscReal      J[9], detJ;
2100       PetscInt       q;
2101 
2102       PetscCall(DMPlexComputeCellGeometryAffineFEM(dm, p, v0, J, NULL, &detJ));
2103       PetscCall(DMPlexGetCellType(dm, p, &ptype));
2104 
2105       /* compare to previous facets: if computed, reference that dualspace */
2106       for (q = pStratStart[depth - 1]; q < p; q++) {
2107         DMPolytopeType qtype;
2108 
2109         PetscCall(DMPlexGetCellType(dm, q, &qtype));
2110         if (qtype == ptype) break;
2111       }
2112       if (q < p) { /* this facet has the same dual space as that one */
2113         PetscCall(PetscObjectReference((PetscObject)sp->pointSpaces[q]));
2114         sp->pointSpaces[p] = sp->pointSpaces[q];
2115         continue;
2116       }
2117       /* if not, recursively compute this dual space */
2118       PetscCall(PetscDualSpaceCreateFacetSubspace_Lagrange(sp, NULL, p, formDegree, Ncopies, PETSC_FALSE, &sp->pointSpaces[p]));
2119     }
2120     for (h = 2; h <= depth; h++) { /* get the higher subspaces from the facet subspaces */
2121       PetscInt hd   = depth - h;
2122       PetscInt hdim = dim - h;
2123 
2124       if (hdim < PetscAbsInt(formDegree)) break;
2125       for (p = pStratStart[hd]; p < pStratEnd[hd]; p++) {
2126         PetscInt        suppSize, s;
2127         const PetscInt *supp;
2128 
2129         PetscCall(DMPlexGetSupportSize(dm, p, &suppSize));
2130         PetscCall(DMPlexGetSupport(dm, p, &supp));
2131         for (s = 0; s < suppSize; s++) {
2132           DM              qdm;
2133           PetscDualSpace  qsp, psp;
2134           PetscInt        c, coneSize, q;
2135           const PetscInt *cone;
2136           const PetscInt *refCone;
2137 
2138           q   = supp[0];
2139           qsp = sp->pointSpaces[q];
2140           PetscCall(DMPlexGetConeSize(dm, q, &coneSize));
2141           PetscCall(DMPlexGetCone(dm, q, &cone));
2142           for (c = 0; c < coneSize; c++)
2143             if (cone[c] == p) break;
2144           PetscCheck(c != coneSize, PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "cone/support mismatch");
2145           PetscCall(PetscDualSpaceGetDM(qsp, &qdm));
2146           PetscCall(DMPlexGetCone(qdm, 0, &refCone));
2147           /* get the equivalent dual space from the support dual space */
2148           PetscCall(PetscDualSpaceGetPointSubspace(qsp, refCone[c], &psp));
2149           if (!s) {
2150             PetscCall(PetscObjectReference((PetscObject)psp));
2151             sp->pointSpaces[p] = psp;
2152           }
2153         }
2154       }
2155     }
2156     for (p = 1; p < pEnd; p++) {
2157       PetscInt pspdim;
2158       if (!sp->pointSpaces[p]) continue;
2159       PetscCall(PetscDualSpaceGetInteriorDimension(sp->pointSpaces[p], &pspdim));
2160       PetscCall(PetscSectionSetDof(section, p, pspdim));
2161     }
2162   }
2163 
2164   if (Ncopies > 1) {
2165     Mat                 intMatScalar, allMatScalar;
2166     PetscDualSpace      scalarsp;
2167     PetscDualSpace_Lag *scalarlag;
2168 
2169     PetscCall(PetscDualSpaceDuplicate(sp, &scalarsp));
2170     /* Setting the number of components to Nk is a space with 1 copy of each k-form */
2171     PetscCall(PetscDualSpaceSetNumComponents(scalarsp, Nk));
2172     PetscCall(PetscDualSpaceSetUp(scalarsp));
2173     PetscCall(PetscDualSpaceGetInteriorData(scalarsp, &(sp->intNodes), &intMatScalar));
2174     PetscCall(PetscObjectReference((PetscObject)(sp->intNodes)));
2175     if (intMatScalar) PetscCall(PetscDualSpaceLagrangeMatrixCreateCopies(intMatScalar, Nk, Ncopies, &(sp->intMat)));
2176     PetscCall(PetscDualSpaceGetAllData(scalarsp, &(sp->allNodes), &allMatScalar));
2177     PetscCall(PetscObjectReference((PetscObject)(sp->allNodes)));
2178     PetscCall(PetscDualSpaceLagrangeMatrixCreateCopies(allMatScalar, Nk, Ncopies, &(sp->allMat)));
2179     sp->spdim    = scalarsp->spdim * Ncopies;
2180     sp->spintdim = scalarsp->spintdim * Ncopies;
2181     scalarlag    = (PetscDualSpace_Lag *)scalarsp->data;
2182     PetscCall(PetscLagNodeIndicesReference(scalarlag->vertIndices));
2183     lag->vertIndices = scalarlag->vertIndices;
2184     PetscCall(PetscLagNodeIndicesReference(scalarlag->intNodeIndices));
2185     lag->intNodeIndices = scalarlag->intNodeIndices;
2186     PetscCall(PetscLagNodeIndicesReference(scalarlag->allNodeIndices));
2187     lag->allNodeIndices = scalarlag->allNodeIndices;
2188     PetscCall(PetscDualSpaceDestroy(&scalarsp));
2189     PetscCall(PetscSectionSetDof(section, 0, sp->spintdim));
2190     PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section));
2191     PetscCall(PetscDualSpaceComputeFunctionalsFromAllData(sp));
2192     PetscCall(PetscFree2(pStratStart, pStratEnd));
2193     PetscCall(DMDestroy(&dmint));
2194     PetscFunctionReturn(PETSC_SUCCESS);
2195   }
2196 
2197   if (trimmed && !continuous) {
2198     /* the dofs of a trimmed space don't have a nice tensor/lattice structure:
2199      * just construct the continuous dual space and copy all of the data over,
2200      * allocating it all to the cell instead of splitting it up between the boundaries */
2201     PetscDualSpace      spcont;
2202     PetscInt            spdim, f;
2203     PetscQuadrature     allNodes;
2204     PetscDualSpace_Lag *lagc;
2205     Mat                 allMat;
2206 
2207     PetscCall(PetscDualSpaceDuplicate(sp, &spcont));
2208     PetscCall(PetscDualSpaceLagrangeSetContinuity(spcont, PETSC_TRUE));
2209     PetscCall(PetscDualSpaceSetUp(spcont));
2210     PetscCall(PetscDualSpaceGetDimension(spcont, &spdim));
2211     sp->spdim = sp->spintdim = spdim;
2212     PetscCall(PetscSectionSetDof(section, 0, spdim));
2213     PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section));
2214     PetscCall(PetscMalloc1(spdim, &(sp->functional)));
2215     for (f = 0; f < spdim; f++) {
2216       PetscQuadrature fn;
2217 
2218       PetscCall(PetscDualSpaceGetFunctional(spcont, f, &fn));
2219       PetscCall(PetscObjectReference((PetscObject)fn));
2220       sp->functional[f] = fn;
2221     }
2222     PetscCall(PetscDualSpaceGetAllData(spcont, &allNodes, &allMat));
2223     PetscCall(PetscObjectReference((PetscObject)allNodes));
2224     PetscCall(PetscObjectReference((PetscObject)allNodes));
2225     sp->allNodes = sp->intNodes = allNodes;
2226     PetscCall(PetscObjectReference((PetscObject)allMat));
2227     PetscCall(PetscObjectReference((PetscObject)allMat));
2228     sp->allMat = sp->intMat = allMat;
2229     lagc                    = (PetscDualSpace_Lag *)spcont->data;
2230     PetscCall(PetscLagNodeIndicesReference(lagc->vertIndices));
2231     lag->vertIndices = lagc->vertIndices;
2232     PetscCall(PetscLagNodeIndicesReference(lagc->allNodeIndices));
2233     PetscCall(PetscLagNodeIndicesReference(lagc->allNodeIndices));
2234     lag->intNodeIndices = lagc->allNodeIndices;
2235     lag->allNodeIndices = lagc->allNodeIndices;
2236     PetscCall(PetscDualSpaceDestroy(&spcont));
2237     PetscCall(PetscFree2(pStratStart, pStratEnd));
2238     PetscCall(DMDestroy(&dmint));
2239     PetscFunctionReturn(PETSC_SUCCESS);
2240   }
2241 
2242   /* step 3: construct intNodes, and intMat, and combine it with boundray data to make allNodes and allMat */
2243   if (!tensorSpace) {
2244     if (!tensorCell) PetscCall(PetscLagNodeIndicesCreateSimplexVertices(dm, &(lag->vertIndices)));
2245 
2246     if (trimmed) {
2247       /* there is one dof in the interior of the a trimmed element for each full polynomial of with degree at most
2248        * order + k - dim - 1 */
2249       if (order + PetscAbsInt(formDegree) > dim) {
2250         PetscInt sum = order + PetscAbsInt(formDegree) - dim - 1;
2251         PetscInt nDofs;
2252 
2253         PetscCall(PetscDualSpaceLagrangeCreateSimplexNodeMat(nodeFamily, dim, sum, Nk, numNodeSkip, &sp->intNodes, &sp->intMat, &(lag->intNodeIndices)));
2254         PetscCall(MatGetSize(sp->intMat, &nDofs, NULL));
2255         PetscCall(PetscSectionSetDof(section, 0, nDofs));
2256       }
2257       PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section));
2258       PetscCall(PetscDualSpaceCreateAllDataFromInteriorData(sp));
2259       PetscCall(PetscDualSpaceLagrangeCreateAllNodeIdx(sp));
2260     } else {
2261       if (!continuous) {
2262         /* if discontinuous just construct one node for each set of dofs (a set of dofs is a basis for the k-form
2263          * space) */
2264         PetscInt sum = order;
2265         PetscInt nDofs;
2266 
2267         PetscCall(PetscDualSpaceLagrangeCreateSimplexNodeMat(nodeFamily, dim, sum, Nk, numNodeSkip, &sp->intNodes, &sp->intMat, &(lag->intNodeIndices)));
2268         PetscCall(MatGetSize(sp->intMat, &nDofs, NULL));
2269         PetscCall(PetscSectionSetDof(section, 0, nDofs));
2270         PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section));
2271         PetscCall(PetscObjectReference((PetscObject)(sp->intNodes)));
2272         sp->allNodes = sp->intNodes;
2273         PetscCall(PetscObjectReference((PetscObject)(sp->intMat)));
2274         sp->allMat = sp->intMat;
2275         PetscCall(PetscLagNodeIndicesReference(lag->intNodeIndices));
2276         lag->allNodeIndices = lag->intNodeIndices;
2277       } else {
2278         /* there is one dof in the interior of the a full element for each trimmed polynomial of with degree at most
2279          * order + k - dim, but with complementary form degree */
2280         if (order + PetscAbsInt(formDegree) > dim) {
2281           PetscDualSpace      trimmedsp;
2282           PetscDualSpace_Lag *trimmedlag;
2283           PetscQuadrature     intNodes;
2284           PetscInt            trFormDegree = formDegree >= 0 ? formDegree - dim : dim - PetscAbsInt(formDegree);
2285           PetscInt            nDofs;
2286           Mat                 intMat;
2287 
2288           PetscCall(PetscDualSpaceDuplicate(sp, &trimmedsp));
2289           PetscCall(PetscDualSpaceLagrangeSetTrimmed(trimmedsp, PETSC_TRUE));
2290           PetscCall(PetscDualSpaceSetOrder(trimmedsp, order + PetscAbsInt(formDegree) - dim));
2291           PetscCall(PetscDualSpaceSetFormDegree(trimmedsp, trFormDegree));
2292           trimmedlag              = (PetscDualSpace_Lag *)trimmedsp->data;
2293           trimmedlag->numNodeSkip = numNodeSkip + 1;
2294           PetscCall(PetscDualSpaceSetUp(trimmedsp));
2295           PetscCall(PetscDualSpaceGetAllData(trimmedsp, &intNodes, &intMat));
2296           PetscCall(PetscObjectReference((PetscObject)intNodes));
2297           sp->intNodes = intNodes;
2298           PetscCall(PetscLagNodeIndicesReference(trimmedlag->allNodeIndices));
2299           lag->intNodeIndices = trimmedlag->allNodeIndices;
2300           PetscCall(PetscObjectReference((PetscObject)intMat));
2301           if (PetscAbsInt(formDegree) > 0 && PetscAbsInt(formDegree) < dim) {
2302             PetscReal   *T;
2303             PetscScalar *work;
2304             PetscInt     nCols, nRows;
2305             Mat          intMatT;
2306 
2307             PetscCall(MatDuplicate(intMat, MAT_COPY_VALUES, &intMatT));
2308             PetscCall(MatGetSize(intMat, &nRows, &nCols));
2309             PetscCall(PetscMalloc2(Nk * Nk, &T, nCols, &work));
2310             PetscCall(BiunitSimplexSymmetricFormTransformation(dim, formDegree, T));
2311             for (PetscInt row = 0; row < nRows; row++) {
2312               PetscInt           nrCols;
2313               const PetscInt    *rCols;
2314               const PetscScalar *rVals;
2315 
2316               PetscCall(MatGetRow(intMat, row, &nrCols, &rCols, &rVals));
2317               PetscCheck(nrCols % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in intMat matrix are not in k-form size blocks");
2318               for (PetscInt b = 0; b < nrCols; b += Nk) {
2319                 const PetscScalar *v = &rVals[b];
2320                 PetscScalar       *w = &work[b];
2321                 for (PetscInt j = 0; j < Nk; j++) {
2322                   w[j] = 0.;
2323                   for (PetscInt i = 0; i < Nk; i++) w[j] += v[i] * T[i * Nk + j];
2324                 }
2325               }
2326               PetscCall(MatSetValuesBlocked(intMatT, 1, &row, nrCols, rCols, work, INSERT_VALUES));
2327               PetscCall(MatRestoreRow(intMat, row, &nrCols, &rCols, &rVals));
2328             }
2329             PetscCall(MatAssemblyBegin(intMatT, MAT_FINAL_ASSEMBLY));
2330             PetscCall(MatAssemblyEnd(intMatT, MAT_FINAL_ASSEMBLY));
2331             PetscCall(MatDestroy(&intMat));
2332             intMat = intMatT;
2333             PetscCall(PetscLagNodeIndicesDestroy(&(lag->intNodeIndices)));
2334             PetscCall(PetscLagNodeIndicesDuplicate(trimmedlag->allNodeIndices, &(lag->intNodeIndices)));
2335             {
2336               PetscInt         nNodes     = lag->intNodeIndices->nNodes;
2337               PetscReal       *newNodeVec = lag->intNodeIndices->nodeVec;
2338               const PetscReal *oldNodeVec = trimmedlag->allNodeIndices->nodeVec;
2339 
2340               for (PetscInt n = 0; n < nNodes; n++) {
2341                 PetscReal       *w = &newNodeVec[n * Nk];
2342                 const PetscReal *v = &oldNodeVec[n * Nk];
2343 
2344                 for (PetscInt j = 0; j < Nk; j++) {
2345                   w[j] = 0.;
2346                   for (PetscInt i = 0; i < Nk; i++) w[j] += v[i] * T[i * Nk + j];
2347                 }
2348               }
2349             }
2350             PetscCall(PetscFree2(T, work));
2351           }
2352           sp->intMat = intMat;
2353           PetscCall(MatGetSize(sp->intMat, &nDofs, NULL));
2354           PetscCall(PetscDualSpaceDestroy(&trimmedsp));
2355           PetscCall(PetscSectionSetDof(section, 0, nDofs));
2356         }
2357         PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section));
2358         PetscCall(PetscDualSpaceCreateAllDataFromInteriorData(sp));
2359         PetscCall(PetscDualSpaceLagrangeCreateAllNodeIdx(sp));
2360       }
2361     }
2362   } else {
2363     PetscQuadrature     intNodesTrace  = NULL;
2364     PetscQuadrature     intNodesFiber  = NULL;
2365     PetscQuadrature     intNodes       = NULL;
2366     PetscLagNodeIndices intNodeIndices = NULL;
2367     Mat                 intMat         = NULL;
2368 
2369     if (PetscAbsInt(formDegree) < dim) { /* get the trace k-forms on the first facet, and the 0-forms on the edge,
2370                                             and wedge them together to create some of the k-form dofs */
2371       PetscDualSpace      trace, fiber;
2372       PetscDualSpace_Lag *tracel, *fiberl;
2373       Mat                 intMatTrace, intMatFiber;
2374 
2375       if (sp->pointSpaces[tensorf]) {
2376         PetscCall(PetscObjectReference((PetscObject)(sp->pointSpaces[tensorf])));
2377         trace = sp->pointSpaces[tensorf];
2378       } else {
2379         PetscCall(PetscDualSpaceCreateFacetSubspace_Lagrange(sp, NULL, tensorf, formDegree, Ncopies, PETSC_TRUE, &trace));
2380       }
2381       PetscCall(PetscDualSpaceCreateEdgeSubspace_Lagrange(sp, order, 0, 1, PETSC_TRUE, &fiber));
2382       tracel = (PetscDualSpace_Lag *)trace->data;
2383       fiberl = (PetscDualSpace_Lag *)fiber->data;
2384       PetscCall(PetscLagNodeIndicesCreateTensorVertices(dm, tracel->vertIndices, &(lag->vertIndices)));
2385       PetscCall(PetscDualSpaceGetInteriorData(trace, &intNodesTrace, &intMatTrace));
2386       PetscCall(PetscDualSpaceGetInteriorData(fiber, &intNodesFiber, &intMatFiber));
2387       if (intNodesTrace && intNodesFiber) {
2388         PetscCall(PetscQuadratureCreateTensor(intNodesTrace, intNodesFiber, &intNodes));
2389         PetscCall(MatTensorAltV(intMatTrace, intMatFiber, dim - 1, formDegree, 1, 0, &intMat));
2390         PetscCall(PetscLagNodeIndicesTensor(tracel->intNodeIndices, dim - 1, formDegree, fiberl->intNodeIndices, 1, 0, &intNodeIndices));
2391       }
2392       PetscCall(PetscObjectReference((PetscObject)intNodesTrace));
2393       PetscCall(PetscObjectReference((PetscObject)intNodesFiber));
2394       PetscCall(PetscDualSpaceDestroy(&fiber));
2395       PetscCall(PetscDualSpaceDestroy(&trace));
2396     }
2397     if (PetscAbsInt(formDegree) > 0) { /* get the trace (k-1)-forms on the first facet, and the 1-forms on the edge,
2398                                           and wedge them together to create the remaining k-form dofs */
2399       PetscDualSpace      trace, fiber;
2400       PetscDualSpace_Lag *tracel, *fiberl;
2401       PetscQuadrature     intNodesTrace2, intNodesFiber2, intNodes2;
2402       PetscLagNodeIndices intNodeIndices2;
2403       Mat                 intMatTrace, intMatFiber, intMat2;
2404       PetscInt            traceDegree = formDegree > 0 ? formDegree - 1 : formDegree + 1;
2405       PetscInt            fiberDegree = formDegree > 0 ? 1 : -1;
2406 
2407       PetscCall(PetscDualSpaceCreateFacetSubspace_Lagrange(sp, NULL, tensorf, traceDegree, Ncopies, PETSC_TRUE, &trace));
2408       PetscCall(PetscDualSpaceCreateEdgeSubspace_Lagrange(sp, order, fiberDegree, 1, PETSC_TRUE, &fiber));
2409       tracel = (PetscDualSpace_Lag *)trace->data;
2410       fiberl = (PetscDualSpace_Lag *)fiber->data;
2411       if (!lag->vertIndices) PetscCall(PetscLagNodeIndicesCreateTensorVertices(dm, tracel->vertIndices, &(lag->vertIndices)));
2412       PetscCall(PetscDualSpaceGetInteriorData(trace, &intNodesTrace2, &intMatTrace));
2413       PetscCall(PetscDualSpaceGetInteriorData(fiber, &intNodesFiber2, &intMatFiber));
2414       if (intNodesTrace2 && intNodesFiber2) {
2415         PetscCall(PetscQuadratureCreateTensor(intNodesTrace2, intNodesFiber2, &intNodes2));
2416         PetscCall(MatTensorAltV(intMatTrace, intMatFiber, dim - 1, traceDegree, 1, fiberDegree, &intMat2));
2417         PetscCall(PetscLagNodeIndicesTensor(tracel->intNodeIndices, dim - 1, traceDegree, fiberl->intNodeIndices, 1, fiberDegree, &intNodeIndices2));
2418         if (!intMat) {
2419           intMat         = intMat2;
2420           intNodes       = intNodes2;
2421           intNodeIndices = intNodeIndices2;
2422         } else {
2423           /* merge the matrices, quadrature points, and nodes */
2424           PetscInt            nM;
2425           PetscInt            nDof, nDof2;
2426           PetscInt           *toMerged = NULL, *toMerged2 = NULL;
2427           PetscQuadrature     merged               = NULL;
2428           PetscLagNodeIndices intNodeIndicesMerged = NULL;
2429           Mat                 matMerged            = NULL;
2430 
2431           PetscCall(MatGetSize(intMat, &nDof, NULL));
2432           PetscCall(MatGetSize(intMat2, &nDof2, NULL));
2433           PetscCall(PetscQuadraturePointsMerge(intNodes, intNodes2, &merged, &toMerged, &toMerged2));
2434           PetscCall(PetscQuadratureGetData(merged, NULL, NULL, &nM, NULL, NULL));
2435           PetscCall(MatricesMerge(intMat, intMat2, dim, formDegree, nM, toMerged, toMerged2, &matMerged));
2436           PetscCall(PetscLagNodeIndicesMerge(intNodeIndices, intNodeIndices2, &intNodeIndicesMerged));
2437           PetscCall(PetscFree(toMerged));
2438           PetscCall(PetscFree(toMerged2));
2439           PetscCall(MatDestroy(&intMat));
2440           PetscCall(MatDestroy(&intMat2));
2441           PetscCall(PetscQuadratureDestroy(&intNodes));
2442           PetscCall(PetscQuadratureDestroy(&intNodes2));
2443           PetscCall(PetscLagNodeIndicesDestroy(&intNodeIndices));
2444           PetscCall(PetscLagNodeIndicesDestroy(&intNodeIndices2));
2445           intNodes       = merged;
2446           intMat         = matMerged;
2447           intNodeIndices = intNodeIndicesMerged;
2448           if (!trimmed) {
2449             /* I think users expect that, when a node has a full basis for the k-forms,
2450              * they should be consecutive dofs.  That isn't the case for trimmed spaces,
2451              * but is for some of the nodes in untrimmed spaces, so in that case we
2452              * sort them to group them by node */
2453             Mat intMatPerm;
2454 
2455             PetscCall(MatPermuteByNodeIdx(intMat, intNodeIndices, &intMatPerm));
2456             PetscCall(MatDestroy(&intMat));
2457             intMat = intMatPerm;
2458           }
2459         }
2460       }
2461       PetscCall(PetscDualSpaceDestroy(&fiber));
2462       PetscCall(PetscDualSpaceDestroy(&trace));
2463     }
2464     PetscCall(PetscQuadratureDestroy(&intNodesTrace));
2465     PetscCall(PetscQuadratureDestroy(&intNodesFiber));
2466     sp->intNodes        = intNodes;
2467     sp->intMat          = intMat;
2468     lag->intNodeIndices = intNodeIndices;
2469     {
2470       PetscInt nDofs = 0;
2471 
2472       if (intMat) PetscCall(MatGetSize(intMat, &nDofs, NULL));
2473       PetscCall(PetscSectionSetDof(section, 0, nDofs));
2474     }
2475     PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section));
2476     if (continuous) {
2477       PetscCall(PetscDualSpaceCreateAllDataFromInteriorData(sp));
2478       PetscCall(PetscDualSpaceLagrangeCreateAllNodeIdx(sp));
2479     } else {
2480       PetscCall(PetscObjectReference((PetscObject)intNodes));
2481       sp->allNodes = intNodes;
2482       PetscCall(PetscObjectReference((PetscObject)intMat));
2483       sp->allMat = intMat;
2484       PetscCall(PetscLagNodeIndicesReference(intNodeIndices));
2485       lag->allNodeIndices = intNodeIndices;
2486     }
2487   }
2488   PetscCall(PetscSectionGetStorageSize(section, &sp->spdim));
2489   PetscCall(PetscSectionGetConstrainedStorageSize(section, &sp->spintdim));
2490   PetscCall(PetscDualSpaceComputeFunctionalsFromAllData(sp));
2491   PetscCall(PetscFree2(pStratStart, pStratEnd));
2492   PetscCall(DMDestroy(&dmint));
2493   PetscFunctionReturn(PETSC_SUCCESS);
2494 }
2495 
2496 /* Create a matrix that represents the transformation that DMPlexVecGetClosure() would need
2497  * to get the representation of the dofs for a mesh point if the mesh point had this orientation
2498  * relative to the cell */
2499 PetscErrorCode PetscDualSpaceCreateInteriorSymmetryMatrix_Lagrange(PetscDualSpace sp, PetscInt ornt, Mat *symMat)
2500 {
2501   PetscDualSpace_Lag *lag;
2502   DM                  dm;
2503   PetscLagNodeIndices vertIndices, intNodeIndices;
2504   PetscLagNodeIndices ni;
2505   PetscInt            nodeIdxDim, nodeVecDim, nNodes;
2506   PetscInt            formDegree;
2507   PetscInt           *perm, *permOrnt;
2508   PetscInt           *nnz;
2509   PetscInt            n;
2510   PetscInt            maxGroupSize;
2511   PetscScalar        *V, *W, *work;
2512   Mat                 A;
2513 
2514   PetscFunctionBegin;
2515   if (!sp->spintdim) {
2516     *symMat = NULL;
2517     PetscFunctionReturn(PETSC_SUCCESS);
2518   }
2519   lag            = (PetscDualSpace_Lag *)sp->data;
2520   vertIndices    = lag->vertIndices;
2521   intNodeIndices = lag->intNodeIndices;
2522   PetscCall(PetscDualSpaceGetDM(sp, &dm));
2523   PetscCall(PetscDualSpaceGetFormDegree(sp, &formDegree));
2524   PetscCall(PetscNew(&ni));
2525   ni->refct      = 1;
2526   ni->nodeIdxDim = nodeIdxDim = intNodeIndices->nodeIdxDim;
2527   ni->nodeVecDim = nodeVecDim = intNodeIndices->nodeVecDim;
2528   ni->nNodes = nNodes = intNodeIndices->nNodes;
2529   PetscCall(PetscMalloc1(nNodes * nodeIdxDim, &(ni->nodeIdx)));
2530   PetscCall(PetscMalloc1(nNodes * nodeVecDim, &(ni->nodeVec)));
2531   /* push forward the dofs by the symmetry of the reference element induced by ornt */
2532   PetscCall(PetscLagNodeIndicesPushForward(dm, vertIndices, 0, vertIndices, intNodeIndices, ornt, formDegree, ni->nodeIdx, ni->nodeVec));
2533   /* get the revlex order for both the original and transformed dofs */
2534   PetscCall(PetscLagNodeIndicesGetPermutation(intNodeIndices, &perm));
2535   PetscCall(PetscLagNodeIndicesGetPermutation(ni, &permOrnt));
2536   PetscCall(PetscMalloc1(nNodes, &nnz));
2537   for (n = 0, maxGroupSize = 0; n < nNodes;) { /* incremented in the loop */
2538     PetscInt *nind = &(ni->nodeIdx[permOrnt[n] * nodeIdxDim]);
2539     PetscInt  m, nEnd;
2540     PetscInt  groupSize;
2541     /* for each group of dofs that have the same nodeIdx coordinate */
2542     for (nEnd = n + 1; nEnd < nNodes; nEnd++) {
2543       PetscInt *mind = &(ni->nodeIdx[permOrnt[nEnd] * nodeIdxDim]);
2544       PetscInt  d;
2545 
2546       /* compare the oriented permutation indices */
2547       for (d = 0; d < nodeIdxDim; d++)
2548         if (mind[d] != nind[d]) break;
2549       if (d < nodeIdxDim) break;
2550     }
2551     /* permOrnt[[n, nEnd)] is a group of dofs that, under the symmetry are at the same location */
2552 
2553     /* the symmetry had better map the group of dofs with the same permuted nodeIdx
2554      * to a group of dofs with the same size, otherwise we messed up */
2555     if (PetscDefined(USE_DEBUG)) {
2556       PetscInt  m;
2557       PetscInt *nind = &(intNodeIndices->nodeIdx[perm[n] * nodeIdxDim]);
2558 
2559       for (m = n + 1; m < nEnd; m++) {
2560         PetscInt *mind = &(intNodeIndices->nodeIdx[perm[m] * nodeIdxDim]);
2561         PetscInt  d;
2562 
2563         /* compare the oriented permutation indices */
2564         for (d = 0; d < nodeIdxDim; d++)
2565           if (mind[d] != nind[d]) break;
2566         if (d < nodeIdxDim) break;
2567       }
2568       PetscCheck(m >= nEnd, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Dofs with same index after symmetry not same block size");
2569     }
2570     groupSize = nEnd - n;
2571     /* each pushforward dof vector will be expressed in a basis of the unpermuted dofs */
2572     for (m = n; m < nEnd; m++) nnz[permOrnt[m]] = groupSize;
2573 
2574     maxGroupSize = PetscMax(maxGroupSize, nEnd - n);
2575     n            = nEnd;
2576   }
2577   PetscCheck(maxGroupSize <= nodeVecDim, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Dofs are not in blocks that can be solved");
2578   PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, nNodes, nNodes, 0, nnz, &A));
2579   PetscCall(PetscFree(nnz));
2580   PetscCall(PetscMalloc3(maxGroupSize * nodeVecDim, &V, maxGroupSize * nodeVecDim, &W, nodeVecDim * 2, &work));
2581   for (n = 0; n < nNodes;) { /* incremented in the loop */
2582     PetscInt *nind = &(ni->nodeIdx[permOrnt[n] * nodeIdxDim]);
2583     PetscInt  nEnd;
2584     PetscInt  m;
2585     PetscInt  groupSize;
2586     for (nEnd = n + 1; nEnd < nNodes; nEnd++) {
2587       PetscInt *mind = &(ni->nodeIdx[permOrnt[nEnd] * nodeIdxDim]);
2588       PetscInt  d;
2589 
2590       /* compare the oriented permutation indices */
2591       for (d = 0; d < nodeIdxDim; d++)
2592         if (mind[d] != nind[d]) break;
2593       if (d < nodeIdxDim) break;
2594     }
2595     groupSize = nEnd - n;
2596     /* get all of the vectors from the original and all of the pushforward vectors */
2597     for (m = n; m < nEnd; m++) {
2598       PetscInt d;
2599 
2600       for (d = 0; d < nodeVecDim; d++) {
2601         V[(m - n) * nodeVecDim + d] = intNodeIndices->nodeVec[perm[m] * nodeVecDim + d];
2602         W[(m - n) * nodeVecDim + d] = ni->nodeVec[permOrnt[m] * nodeVecDim + d];
2603       }
2604     }
2605     /* now we have to solve for W in terms of V: the systems isn't always square, but the span
2606      * of V and W should always be the same, so the solution of the normal equations works */
2607     {
2608       char         transpose = 'N';
2609       PetscBLASInt bm        = nodeVecDim;
2610       PetscBLASInt bn        = groupSize;
2611       PetscBLASInt bnrhs     = groupSize;
2612       PetscBLASInt blda      = bm;
2613       PetscBLASInt bldb      = bm;
2614       PetscBLASInt blwork    = 2 * nodeVecDim;
2615       PetscBLASInt info;
2616 
2617       PetscCallBLAS("LAPACKgels", LAPACKgels_(&transpose, &bm, &bn, &bnrhs, V, &blda, W, &bldb, work, &blwork, &info));
2618       PetscCheck(info == 0, PETSC_COMM_SELF, PETSC_ERR_LIB, "Bad argument to GELS");
2619       /* repack */
2620       {
2621         PetscInt i, j;
2622 
2623         for (i = 0; i < groupSize; i++) {
2624           for (j = 0; j < groupSize; j++) {
2625             /* notice the different leading dimension */
2626             V[i * groupSize + j] = W[i * nodeVecDim + j];
2627           }
2628         }
2629       }
2630       if (PetscDefined(USE_DEBUG)) {
2631         PetscReal res;
2632 
2633         /* check that the normal error is 0 */
2634         for (m = n; m < nEnd; m++) {
2635           PetscInt d;
2636 
2637           for (d = 0; d < nodeVecDim; d++) W[(m - n) * nodeVecDim + d] = ni->nodeVec[permOrnt[m] * nodeVecDim + d];
2638         }
2639         res = 0.;
2640         for (PetscInt i = 0; i < groupSize; i++) {
2641           for (PetscInt j = 0; j < nodeVecDim; j++) {
2642             for (PetscInt k = 0; k < groupSize; k++) W[i * nodeVecDim + j] -= V[i * groupSize + k] * intNodeIndices->nodeVec[perm[n + k] * nodeVecDim + j];
2643             res += PetscAbsScalar(W[i * nodeVecDim + j]);
2644           }
2645         }
2646         PetscCheck(res <= PETSC_SMALL, PETSC_COMM_SELF, PETSC_ERR_LIB, "Dof block did not solve");
2647       }
2648     }
2649     PetscCall(MatSetValues(A, groupSize, &permOrnt[n], groupSize, &perm[n], V, INSERT_VALUES));
2650     n = nEnd;
2651   }
2652   PetscCall(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY));
2653   PetscCall(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY));
2654   *symMat = A;
2655   PetscCall(PetscFree3(V, W, work));
2656   PetscCall(PetscLagNodeIndicesDestroy(&ni));
2657   PetscFunctionReturn(PETSC_SUCCESS);
2658 }
2659 
2660 #define BaryIndex(perEdge, a, b, c) (((b) * (2 * perEdge + 1 - (b))) / 2) + (c)
2661 
2662 #define CartIndex(perEdge, a, b) (perEdge * (a) + b)
2663 
2664 /* the existing interface for symmetries is insufficient for all cases:
2665  * - it should be sufficient for form degrees that are scalar (0 and n)
2666  * - it should be sufficient for hypercube dofs
2667  * - it isn't sufficient for simplex cells with non-scalar form degrees if
2668  *   there are any dofs in the interior
2669  *
2670  * We compute the general transformation matrices, and if they fit, we return them,
2671  * otherwise we error (but we should probably change the interface to allow for
2672  * these symmetries)
2673  */
2674 static PetscErrorCode PetscDualSpaceGetSymmetries_Lagrange(PetscDualSpace sp, const PetscInt ****perms, const PetscScalar ****flips)
2675 {
2676   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2677   PetscInt            dim, order, Nc;
2678 
2679   PetscFunctionBegin;
2680   PetscCall(PetscDualSpaceGetOrder(sp, &order));
2681   PetscCall(PetscDualSpaceGetNumComponents(sp, &Nc));
2682   PetscCall(DMGetDimension(sp->dm, &dim));
2683   if (!lag->symComputed) { /* store symmetries */
2684     PetscInt       pStart, pEnd, p;
2685     PetscInt       numPoints;
2686     PetscInt       numFaces;
2687     PetscInt       spintdim;
2688     PetscInt    ***symperms;
2689     PetscScalar ***symflips;
2690 
2691     PetscCall(DMPlexGetChart(sp->dm, &pStart, &pEnd));
2692     numPoints = pEnd - pStart;
2693     {
2694       DMPolytopeType ct;
2695       /* The number of arrangements is no longer based on the number of faces */
2696       PetscCall(DMPlexGetCellType(sp->dm, 0, &ct));
2697       numFaces = DMPolytopeTypeGetNumArrangments(ct) / 2;
2698     }
2699     PetscCall(PetscCalloc1(numPoints, &symperms));
2700     PetscCall(PetscCalloc1(numPoints, &symflips));
2701     spintdim = sp->spintdim;
2702     /* The nodal symmetry behavior is not present when tensorSpace != tensorCell: someone might want this for the "S"
2703      * family of FEEC spaces.  Most used in particular are discontinuous polynomial L2 spaces in tensor cells, where
2704      * the symmetries are not necessary for FE assembly.  So for now we assume this is the case and don't return
2705      * symmetries if tensorSpace != tensorCell */
2706     if (spintdim && 0 < dim && dim < 3 && (lag->tensorSpace == lag->tensorCell)) { /* compute self symmetries */
2707       PetscInt    **cellSymperms;
2708       PetscScalar **cellSymflips;
2709       PetscInt      ornt;
2710       PetscInt      nCopies = Nc / lag->intNodeIndices->nodeVecDim;
2711       PetscInt      nNodes  = lag->intNodeIndices->nNodes;
2712 
2713       lag->numSelfSym = 2 * numFaces;
2714       lag->selfSymOff = numFaces;
2715       PetscCall(PetscCalloc1(2 * numFaces, &cellSymperms));
2716       PetscCall(PetscCalloc1(2 * numFaces, &cellSymflips));
2717       /* we want to be able to index symmetries directly with the orientations, which range from [-numFaces,numFaces) */
2718       symperms[0] = &cellSymperms[numFaces];
2719       symflips[0] = &cellSymflips[numFaces];
2720       PetscCheck(lag->intNodeIndices->nodeVecDim * nCopies == Nc, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Node indices incompatible with dofs");
2721       PetscCheck(nNodes * nCopies == spintdim, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Node indices incompatible with dofs");
2722       for (ornt = -numFaces; ornt < numFaces; ornt++) { /* for every symmetry, compute the symmetry matrix, and extract rows to see if it fits in the perm + flip framework */
2723         Mat          symMat;
2724         PetscInt    *perm;
2725         PetscScalar *flips;
2726         PetscInt     i;
2727 
2728         if (!ornt) continue;
2729         PetscCall(PetscMalloc1(spintdim, &perm));
2730         PetscCall(PetscCalloc1(spintdim, &flips));
2731         for (i = 0; i < spintdim; i++) perm[i] = -1;
2732         PetscCall(PetscDualSpaceCreateInteriorSymmetryMatrix_Lagrange(sp, ornt, &symMat));
2733         for (i = 0; i < nNodes; i++) {
2734           PetscInt           ncols;
2735           PetscInt           j, k;
2736           const PetscInt    *cols;
2737           const PetscScalar *vals;
2738           PetscBool          nz_seen = PETSC_FALSE;
2739 
2740           PetscCall(MatGetRow(symMat, i, &ncols, &cols, &vals));
2741           for (j = 0; j < ncols; j++) {
2742             if (PetscAbsScalar(vals[j]) > PETSC_SMALL) {
2743               PetscCheck(!nz_seen, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips");
2744               nz_seen = PETSC_TRUE;
2745               PetscCheck(PetscAbsReal(PetscAbsScalar(vals[j]) - PetscRealConstant(1.)) <= PETSC_SMALL, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips");
2746               PetscCheck(PetscAbsReal(PetscImaginaryPart(vals[j])) <= PETSC_SMALL, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips");
2747               PetscCheck(perm[cols[j] * nCopies] < 0, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips");
2748               for (k = 0; k < nCopies; k++) perm[cols[j] * nCopies + k] = i * nCopies + k;
2749               if (PetscRealPart(vals[j]) < 0.) {
2750                 for (k = 0; k < nCopies; k++) flips[i * nCopies + k] = -1.;
2751               } else {
2752                 for (k = 0; k < nCopies; k++) flips[i * nCopies + k] = 1.;
2753               }
2754             }
2755           }
2756           PetscCall(MatRestoreRow(symMat, i, &ncols, &cols, &vals));
2757         }
2758         PetscCall(MatDestroy(&symMat));
2759         /* if there were no sign flips, keep NULL */
2760         for (i = 0; i < spintdim; i++)
2761           if (flips[i] != 1.) break;
2762         if (i == spintdim) {
2763           PetscCall(PetscFree(flips));
2764           flips = NULL;
2765         }
2766         /* if the permutation is identity, keep NULL */
2767         for (i = 0; i < spintdim; i++)
2768           if (perm[i] != i) break;
2769         if (i == spintdim) {
2770           PetscCall(PetscFree(perm));
2771           perm = NULL;
2772         }
2773         symperms[0][ornt] = perm;
2774         symflips[0][ornt] = flips;
2775       }
2776       /* if no orientations produced non-identity permutations, keep NULL */
2777       for (ornt = -numFaces; ornt < numFaces; ornt++)
2778         if (symperms[0][ornt]) break;
2779       if (ornt == numFaces) {
2780         PetscCall(PetscFree(cellSymperms));
2781         symperms[0] = NULL;
2782       }
2783       /* if no orientations produced sign flips, keep NULL */
2784       for (ornt = -numFaces; ornt < numFaces; ornt++)
2785         if (symflips[0][ornt]) break;
2786       if (ornt == numFaces) {
2787         PetscCall(PetscFree(cellSymflips));
2788         symflips[0] = NULL;
2789       }
2790     }
2791     { /* get the symmetries of closure points */
2792       PetscInt  closureSize = 0;
2793       PetscInt *closure     = NULL;
2794       PetscInt  r;
2795 
2796       PetscCall(DMPlexGetTransitiveClosure(sp->dm, 0, PETSC_TRUE, &closureSize, &closure));
2797       for (r = 0; r < closureSize; r++) {
2798         PetscDualSpace       psp;
2799         PetscInt             point = closure[2 * r];
2800         PetscInt             pspintdim;
2801         const PetscInt    ***psymperms = NULL;
2802         const PetscScalar ***psymflips = NULL;
2803 
2804         if (!point) continue;
2805         PetscCall(PetscDualSpaceGetPointSubspace(sp, point, &psp));
2806         if (!psp) continue;
2807         PetscCall(PetscDualSpaceGetInteriorDimension(psp, &pspintdim));
2808         if (!pspintdim) continue;
2809         PetscCall(PetscDualSpaceGetSymmetries(psp, &psymperms, &psymflips));
2810         symperms[r] = (PetscInt **)(psymperms ? psymperms[0] : NULL);
2811         symflips[r] = (PetscScalar **)(psymflips ? psymflips[0] : NULL);
2812       }
2813       PetscCall(DMPlexRestoreTransitiveClosure(sp->dm, 0, PETSC_TRUE, &closureSize, &closure));
2814     }
2815     for (p = 0; p < pEnd; p++)
2816       if (symperms[p]) break;
2817     if (p == pEnd) {
2818       PetscCall(PetscFree(symperms));
2819       symperms = NULL;
2820     }
2821     for (p = 0; p < pEnd; p++)
2822       if (symflips[p]) break;
2823     if (p == pEnd) {
2824       PetscCall(PetscFree(symflips));
2825       symflips = NULL;
2826     }
2827     lag->symperms    = symperms;
2828     lag->symflips    = symflips;
2829     lag->symComputed = PETSC_TRUE;
2830   }
2831   if (perms) *perms = (const PetscInt ***)lag->symperms;
2832   if (flips) *flips = (const PetscScalar ***)lag->symflips;
2833   PetscFunctionReturn(PETSC_SUCCESS);
2834 }
2835 
2836 static PetscErrorCode PetscDualSpaceLagrangeGetContinuity_Lagrange(PetscDualSpace sp, PetscBool *continuous)
2837 {
2838   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2839 
2840   PetscFunctionBegin;
2841   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
2842   PetscValidBoolPointer(continuous, 2);
2843   *continuous = lag->continuous;
2844   PetscFunctionReturn(PETSC_SUCCESS);
2845 }
2846 
2847 static PetscErrorCode PetscDualSpaceLagrangeSetContinuity_Lagrange(PetscDualSpace sp, PetscBool continuous)
2848 {
2849   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2850 
2851   PetscFunctionBegin;
2852   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
2853   lag->continuous = continuous;
2854   PetscFunctionReturn(PETSC_SUCCESS);
2855 }
2856 
2857 /*@
2858   PetscDualSpaceLagrangeGetContinuity - Retrieves the flag for element continuity
2859 
2860   Not Collective
2861 
2862   Input Parameter:
2863 . sp         - the `PetscDualSpace`
2864 
2865   Output Parameter:
2866 . continuous - flag for element continuity
2867 
2868   Level: intermediate
2869 
2870 .seealso: `PetscDualSpace`, `PetscDualSpaceLagrangeSetContinuity()`
2871 @*/
2872 PetscErrorCode PetscDualSpaceLagrangeGetContinuity(PetscDualSpace sp, PetscBool *continuous)
2873 {
2874   PetscFunctionBegin;
2875   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
2876   PetscValidBoolPointer(continuous, 2);
2877   PetscTryMethod(sp, "PetscDualSpaceLagrangeGetContinuity_C", (PetscDualSpace, PetscBool *), (sp, continuous));
2878   PetscFunctionReturn(PETSC_SUCCESS);
2879 }
2880 
2881 /*@
2882   PetscDualSpaceLagrangeSetContinuity - Indicate whether the element is continuous
2883 
2884   Logically Collective on sp
2885 
2886   Input Parameters:
2887 + sp         - the `PetscDualSpace`
2888 - continuous - flag for element continuity
2889 
2890   Options Database:
2891 . -petscdualspace_lagrange_continuity <bool> - use a continuous element
2892 
2893   Level: intermediate
2894 
2895 .seealso: `PetscDualSpace`, `PetscDualSpaceLagrangeGetContinuity()`
2896 @*/
2897 PetscErrorCode PetscDualSpaceLagrangeSetContinuity(PetscDualSpace sp, PetscBool continuous)
2898 {
2899   PetscFunctionBegin;
2900   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
2901   PetscValidLogicalCollectiveBool(sp, continuous, 2);
2902   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetContinuity_C", (PetscDualSpace, PetscBool), (sp, continuous));
2903   PetscFunctionReturn(PETSC_SUCCESS);
2904 }
2905 
2906 static PetscErrorCode PetscDualSpaceLagrangeGetTensor_Lagrange(PetscDualSpace sp, PetscBool *tensor)
2907 {
2908   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2909 
2910   PetscFunctionBegin;
2911   *tensor = lag->tensorSpace;
2912   PetscFunctionReturn(PETSC_SUCCESS);
2913 }
2914 
2915 static PetscErrorCode PetscDualSpaceLagrangeSetTensor_Lagrange(PetscDualSpace sp, PetscBool tensor)
2916 {
2917   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2918 
2919   PetscFunctionBegin;
2920   lag->tensorSpace = tensor;
2921   PetscFunctionReturn(PETSC_SUCCESS);
2922 }
2923 
2924 static PetscErrorCode PetscDualSpaceLagrangeGetTrimmed_Lagrange(PetscDualSpace sp, PetscBool *trimmed)
2925 {
2926   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2927 
2928   PetscFunctionBegin;
2929   *trimmed = lag->trimmed;
2930   PetscFunctionReturn(PETSC_SUCCESS);
2931 }
2932 
2933 static PetscErrorCode PetscDualSpaceLagrangeSetTrimmed_Lagrange(PetscDualSpace sp, PetscBool trimmed)
2934 {
2935   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2936 
2937   PetscFunctionBegin;
2938   lag->trimmed = trimmed;
2939   PetscFunctionReturn(PETSC_SUCCESS);
2940 }
2941 
2942 static PetscErrorCode PetscDualSpaceLagrangeGetNodeType_Lagrange(PetscDualSpace sp, PetscDTNodeType *nodeType, PetscBool *boundary, PetscReal *exponent)
2943 {
2944   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2945 
2946   PetscFunctionBegin;
2947   if (nodeType) *nodeType = lag->nodeType;
2948   if (boundary) *boundary = lag->endNodes;
2949   if (exponent) *exponent = lag->nodeExponent;
2950   PetscFunctionReturn(PETSC_SUCCESS);
2951 }
2952 
2953 static PetscErrorCode PetscDualSpaceLagrangeSetNodeType_Lagrange(PetscDualSpace sp, PetscDTNodeType nodeType, PetscBool boundary, PetscReal exponent)
2954 {
2955   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2956 
2957   PetscFunctionBegin;
2958   PetscCheck(nodeType != PETSCDTNODES_GAUSSJACOBI || exponent > -1., PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_OUTOFRANGE, "Exponent must be > -1");
2959   lag->nodeType     = nodeType;
2960   lag->endNodes     = boundary;
2961   lag->nodeExponent = exponent;
2962   PetscFunctionReturn(PETSC_SUCCESS);
2963 }
2964 
2965 static PetscErrorCode PetscDualSpaceLagrangeGetUseMoments_Lagrange(PetscDualSpace sp, PetscBool *useMoments)
2966 {
2967   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2968 
2969   PetscFunctionBegin;
2970   *useMoments = lag->useMoments;
2971   PetscFunctionReturn(PETSC_SUCCESS);
2972 }
2973 
2974 static PetscErrorCode PetscDualSpaceLagrangeSetUseMoments_Lagrange(PetscDualSpace sp, PetscBool useMoments)
2975 {
2976   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2977 
2978   PetscFunctionBegin;
2979   lag->useMoments = useMoments;
2980   PetscFunctionReturn(PETSC_SUCCESS);
2981 }
2982 
2983 static PetscErrorCode PetscDualSpaceLagrangeGetMomentOrder_Lagrange(PetscDualSpace sp, PetscInt *momentOrder)
2984 {
2985   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2986 
2987   PetscFunctionBegin;
2988   *momentOrder = lag->momentOrder;
2989   PetscFunctionReturn(PETSC_SUCCESS);
2990 }
2991 
2992 static PetscErrorCode PetscDualSpaceLagrangeSetMomentOrder_Lagrange(PetscDualSpace sp, PetscInt momentOrder)
2993 {
2994   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2995 
2996   PetscFunctionBegin;
2997   lag->momentOrder = momentOrder;
2998   PetscFunctionReturn(PETSC_SUCCESS);
2999 }
3000 
3001 /*@
3002   PetscDualSpaceLagrangeGetTensor - Get the tensor nature of the dual space
3003 
3004   Not collective
3005 
3006   Input Parameter:
3007 . sp - The `PetscDualSpace`
3008 
3009   Output Parameter:
3010 . tensor - Whether the dual space has tensor layout (vs. simplicial)
3011 
3012   Level: intermediate
3013 
3014 .seealso: `PetscDualSpace`, `PetscDualSpaceLagrangeSetTensor()`, `PetscDualSpaceCreate()`
3015 @*/
3016 PetscErrorCode PetscDualSpaceLagrangeGetTensor(PetscDualSpace sp, PetscBool *tensor)
3017 {
3018   PetscFunctionBegin;
3019   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3020   PetscValidBoolPointer(tensor, 2);
3021   PetscTryMethod(sp, "PetscDualSpaceLagrangeGetTensor_C", (PetscDualSpace, PetscBool *), (sp, tensor));
3022   PetscFunctionReturn(PETSC_SUCCESS);
3023 }
3024 
3025 /*@
3026   PetscDualSpaceLagrangeSetTensor - Set the tensor nature of the dual space
3027 
3028   Not collective
3029 
3030   Input Parameters:
3031 + sp - The `PetscDualSpace`
3032 - tensor - Whether the dual space has tensor layout (vs. simplicial)
3033 
3034   Level: intermediate
3035 
3036 .seealso: `PetscDualSpace`, `PetscDualSpaceLagrangeGetTensor()`, `PetscDualSpaceCreate()`
3037 @*/
3038 PetscErrorCode PetscDualSpaceLagrangeSetTensor(PetscDualSpace sp, PetscBool tensor)
3039 {
3040   PetscFunctionBegin;
3041   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3042   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetTensor_C", (PetscDualSpace, PetscBool), (sp, tensor));
3043   PetscFunctionReturn(PETSC_SUCCESS);
3044 }
3045 
3046 /*@
3047   PetscDualSpaceLagrangeGetTrimmed - Get the trimmed nature of the dual space
3048 
3049   Not collective
3050 
3051   Input Parameter:
3052 . sp - The `PetscDualSpace`
3053 
3054   Output Parameter:
3055 . trimmed - Whether the dual space represents to dual basis of a trimmed polynomial space (e.g. Raviart-Thomas and higher order / other form degree variants)
3056 
3057   Level: intermediate
3058 
3059 .seealso: `PetscDualSpace`, `PetscDualSpaceLagrangeSetTrimmed()`, `PetscDualSpaceCreate()`
3060 @*/
3061 PetscErrorCode PetscDualSpaceLagrangeGetTrimmed(PetscDualSpace sp, PetscBool *trimmed)
3062 {
3063   PetscFunctionBegin;
3064   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3065   PetscValidBoolPointer(trimmed, 2);
3066   PetscTryMethod(sp, "PetscDualSpaceLagrangeGetTrimmed_C", (PetscDualSpace, PetscBool *), (sp, trimmed));
3067   PetscFunctionReturn(PETSC_SUCCESS);
3068 }
3069 
3070 /*@
3071   PetscDualSpaceLagrangeSetTrimmed - Set the trimmed nature of the dual space
3072 
3073   Not collective
3074 
3075   Input Parameters:
3076 + sp - The `PetscDualSpace`
3077 - trimmed - Whether the dual space represents to dual basis of a trimmed polynomial space (e.g. Raviart-Thomas and higher order / other form degree variants)
3078 
3079   Level: intermediate
3080 
3081 .seealso: `PetscDualSpace`, `PetscDualSpaceLagrangeGetTrimmed()`, `PetscDualSpaceCreate()`
3082 @*/
3083 PetscErrorCode PetscDualSpaceLagrangeSetTrimmed(PetscDualSpace sp, PetscBool trimmed)
3084 {
3085   PetscFunctionBegin;
3086   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3087   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetTrimmed_C", (PetscDualSpace, PetscBool), (sp, trimmed));
3088   PetscFunctionReturn(PETSC_SUCCESS);
3089 }
3090 
3091 /*@
3092   PetscDualSpaceLagrangeGetNodeType - Get a description of how nodes are laid out for Lagrange polynomials in this
3093   dual space
3094 
3095   Not collective
3096 
3097   Input Parameter:
3098 . sp - The `PetscDualSpace`
3099 
3100   Output Parameters:
3101 + nodeType - The type of nodes
3102 . boundary - Whether the node type is one that includes endpoints (if nodeType is `PETSCDTNODES_GAUSSJACOBI`, nodes that
3103              include the boundary are Gauss-Lobatto-Jacobi nodes)
3104 - exponent - If nodeType is `PETSCDTNODES_GAUSJACOBI`, indicates the exponent used for both ends of the 1D Jacobi weight function
3105              '0' is Gauss-Legendre, '-0.5' is Gauss-Chebyshev of the first type, '0.5' is Gauss-Chebyshev of the second type
3106 
3107   Level: advanced
3108 
3109 .seealso: `PetscDualSpace`, `PetscDTNodeType`, `PetscDualSpaceLagrangeSetNodeType()`
3110 @*/
3111 PetscErrorCode PetscDualSpaceLagrangeGetNodeType(PetscDualSpace sp, PetscDTNodeType *nodeType, PetscBool *boundary, PetscReal *exponent)
3112 {
3113   PetscFunctionBegin;
3114   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3115   if (nodeType) PetscValidPointer(nodeType, 2);
3116   if (boundary) PetscValidBoolPointer(boundary, 3);
3117   if (exponent) PetscValidRealPointer(exponent, 4);
3118   PetscTryMethod(sp, "PetscDualSpaceLagrangeGetNodeType_C", (PetscDualSpace, PetscDTNodeType *, PetscBool *, PetscReal *), (sp, nodeType, boundary, exponent));
3119   PetscFunctionReturn(PETSC_SUCCESS);
3120 }
3121 
3122 /*@
3123   PetscDualSpaceLagrangeSetNodeType - Set a description of how nodes are laid out for Lagrange polynomials in this
3124   dual space
3125 
3126   Logically collective
3127 
3128   Input Parameters:
3129 + sp - The `PetscDualSpace`
3130 . nodeType - The type of nodes
3131 . boundary - Whether the node type is one that includes endpoints (if nodeType is `PETSCDTNODES_GAUSSJACOBI`, nodes that
3132              include the boundary are Gauss-Lobatto-Jacobi nodes)
3133 - exponent - If nodeType is `PETSCDTNODES_GAUSJACOBI`, indicates the exponent used for both ends of the 1D Jacobi weight function
3134              '0' is Gauss-Legendre, '-0.5' is Gauss-Chebyshev of the first type, '0.5' is Gauss-Chebyshev of the second type
3135 
3136   Level: advanced
3137 
3138 .seealso: `PetscDualSpace`, `PetscDTNodeType`, `PetscDualSpaceLagrangeGetNodeType()`
3139 @*/
3140 PetscErrorCode PetscDualSpaceLagrangeSetNodeType(PetscDualSpace sp, PetscDTNodeType nodeType, PetscBool boundary, PetscReal exponent)
3141 {
3142   PetscFunctionBegin;
3143   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3144   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetNodeType_C", (PetscDualSpace, PetscDTNodeType, PetscBool, PetscReal), (sp, nodeType, boundary, exponent));
3145   PetscFunctionReturn(PETSC_SUCCESS);
3146 }
3147 
3148 /*@
3149   PetscDualSpaceLagrangeGetUseMoments - Get the flag for using moment functionals
3150 
3151   Not collective
3152 
3153   Input Parameter:
3154 . sp - The `PetscDualSpace`
3155 
3156   Output Parameter:
3157 . useMoments - Moment flag
3158 
3159   Level: advanced
3160 
3161 .seealso: `PetscDualSpace`, `PetscDualSpaceLagrangeSetUseMoments()`
3162 @*/
3163 PetscErrorCode PetscDualSpaceLagrangeGetUseMoments(PetscDualSpace sp, PetscBool *useMoments)
3164 {
3165   PetscFunctionBegin;
3166   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3167   PetscValidBoolPointer(useMoments, 2);
3168   PetscUseMethod(sp, "PetscDualSpaceLagrangeGetUseMoments_C", (PetscDualSpace, PetscBool *), (sp, useMoments));
3169   PetscFunctionReturn(PETSC_SUCCESS);
3170 }
3171 
3172 /*@
3173   PetscDualSpaceLagrangeSetUseMoments - Set the flag for moment functionals
3174 
3175   Logically collective
3176 
3177   Input Parameters:
3178 + sp - The `PetscDualSpace`
3179 - useMoments - The flag for moment functionals
3180 
3181   Level: advanced
3182 
3183 .seealso: `PetscDualSpace`, `PetscDualSpaceLagrangeGetUseMoments()`
3184 @*/
3185 PetscErrorCode PetscDualSpaceLagrangeSetUseMoments(PetscDualSpace sp, PetscBool useMoments)
3186 {
3187   PetscFunctionBegin;
3188   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3189   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetUseMoments_C", (PetscDualSpace, PetscBool), (sp, useMoments));
3190   PetscFunctionReturn(PETSC_SUCCESS);
3191 }
3192 
3193 /*@
3194   PetscDualSpaceLagrangeGetMomentOrder - Get the order for moment integration
3195 
3196   Not collective
3197 
3198   Input Parameter:
3199 . sp - The `PetscDualSpace`
3200 
3201   Output Parameter:
3202 . order - Moment integration order
3203 
3204   Level: advanced
3205 
3206 .seealso: `PetscDualSpace`, `PetscDualSpaceLagrangeSetMomentOrder()`
3207 @*/
3208 PetscErrorCode PetscDualSpaceLagrangeGetMomentOrder(PetscDualSpace sp, PetscInt *order)
3209 {
3210   PetscFunctionBegin;
3211   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3212   PetscValidIntPointer(order, 2);
3213   PetscUseMethod(sp, "PetscDualSpaceLagrangeGetMomentOrder_C", (PetscDualSpace, PetscInt *), (sp, order));
3214   PetscFunctionReturn(PETSC_SUCCESS);
3215 }
3216 
3217 /*@
3218   PetscDualSpaceLagrangeSetMomentOrder - Set the order for moment integration
3219 
3220   Logically collective
3221 
3222   Input Parameters:
3223 + sp - The `PetscDualSpace`
3224 - order - The order for moment integration
3225 
3226   Level: advanced
3227 
3228 .seealso: `PetscDualSpace`, `PetscDualSpaceLagrangeGetMomentOrder()`
3229 @*/
3230 PetscErrorCode PetscDualSpaceLagrangeSetMomentOrder(PetscDualSpace sp, PetscInt order)
3231 {
3232   PetscFunctionBegin;
3233   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3234   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetMomentOrder_C", (PetscDualSpace, PetscInt), (sp, order));
3235   PetscFunctionReturn(PETSC_SUCCESS);
3236 }
3237 
3238 static PetscErrorCode PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp)
3239 {
3240   PetscFunctionBegin;
3241   sp->ops->destroy              = PetscDualSpaceDestroy_Lagrange;
3242   sp->ops->view                 = PetscDualSpaceView_Lagrange;
3243   sp->ops->setfromoptions       = PetscDualSpaceSetFromOptions_Lagrange;
3244   sp->ops->duplicate            = PetscDualSpaceDuplicate_Lagrange;
3245   sp->ops->setup                = PetscDualSpaceSetUp_Lagrange;
3246   sp->ops->createheightsubspace = NULL;
3247   sp->ops->createpointsubspace  = NULL;
3248   sp->ops->getsymmetries        = PetscDualSpaceGetSymmetries_Lagrange;
3249   sp->ops->apply                = PetscDualSpaceApplyDefault;
3250   sp->ops->applyall             = PetscDualSpaceApplyAllDefault;
3251   sp->ops->applyint             = PetscDualSpaceApplyInteriorDefault;
3252   sp->ops->createalldata        = PetscDualSpaceCreateAllDataDefault;
3253   sp->ops->createintdata        = PetscDualSpaceCreateInteriorDataDefault;
3254   PetscFunctionReturn(PETSC_SUCCESS);
3255 }
3256 
3257 /*MC
3258   PETSCDUALSPACELAGRANGE = "lagrange" - A `PetscDualSpaceType` that encapsulates a dual space of pointwise evaluation functionals
3259 
3260   Level: intermediate
3261 
3262 .seealso: `PetscDualSpace`, `PetscDualSpaceType`, `PetscDualSpaceCreate()`, `PetscDualSpaceSetType()`
3263 M*/
3264 PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Lagrange(PetscDualSpace sp)
3265 {
3266   PetscDualSpace_Lag *lag;
3267 
3268   PetscFunctionBegin;
3269   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3270   PetscCall(PetscNew(&lag));
3271   sp->data = lag;
3272 
3273   lag->tensorCell  = PETSC_FALSE;
3274   lag->tensorSpace = PETSC_FALSE;
3275   lag->continuous  = PETSC_TRUE;
3276   lag->numCopies   = PETSC_DEFAULT;
3277   lag->numNodeSkip = PETSC_DEFAULT;
3278   lag->nodeType    = PETSCDTNODES_DEFAULT;
3279   lag->useMoments  = PETSC_FALSE;
3280   lag->momentOrder = 0;
3281 
3282   PetscCall(PetscDualSpaceInitialize_Lagrange(sp));
3283   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetContinuity_C", PetscDualSpaceLagrangeGetContinuity_Lagrange));
3284   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetContinuity_C", PetscDualSpaceLagrangeSetContinuity_Lagrange));
3285   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetTensor_C", PetscDualSpaceLagrangeGetTensor_Lagrange));
3286   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetTensor_C", PetscDualSpaceLagrangeSetTensor_Lagrange));
3287   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetTrimmed_C", PetscDualSpaceLagrangeGetTrimmed_Lagrange));
3288   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetTrimmed_C", PetscDualSpaceLagrangeSetTrimmed_Lagrange));
3289   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetNodeType_C", PetscDualSpaceLagrangeGetNodeType_Lagrange));
3290   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetNodeType_C", PetscDualSpaceLagrangeSetNodeType_Lagrange));
3291   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetUseMoments_C", PetscDualSpaceLagrangeGetUseMoments_Lagrange));
3292   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetUseMoments_C", PetscDualSpaceLagrangeSetUseMoments_Lagrange));
3293   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetMomentOrder_C", PetscDualSpaceLagrangeGetMomentOrder_Lagrange));
3294   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetMomentOrder_C", PetscDualSpaceLagrangeSetMomentOrder_Lagrange));
3295   PetscFunctionReturn(PETSC_SUCCESS);
3296 }
3297