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