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