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