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