xref: /petsc/src/dm/dt/dualspace/impls/lagrange/dspacelagrange.c (revision bcda9346efad4e5ba2d553af84eb238771ba1e25)
120cf1dd8SToby Isaac #include <petsc/private/petscfeimpl.h> /*I "petscfe.h" I*/
220cf1dd8SToby Isaac #include <petscdmplex.h>
33f27d899SToby Isaac #include <petscblaslapack.h>
43f27d899SToby Isaac 
53f27d899SToby Isaac PetscErrorCode DMPlexGetTransitiveClosure_Internal(DM, PetscInt, PetscInt, PetscBool, PetscInt *, PetscInt *[]);
63f27d899SToby Isaac 
79371c9d4SSatish Balay struct _n_Petsc1DNodeFamily {
83f27d899SToby Isaac   PetscInt        refct;
93f27d899SToby Isaac   PetscDTNodeType nodeFamily;
103f27d899SToby Isaac   PetscReal       gaussJacobiExp;
113f27d899SToby Isaac   PetscInt        nComputed;
123f27d899SToby Isaac   PetscReal     **nodesets;
133f27d899SToby Isaac   PetscBool       endpoints;
143f27d899SToby Isaac };
153f27d899SToby Isaac 
1677f1a120SToby Isaac /* users set node families for PETSCDUALSPACELAGRANGE with just the inputs to this function, but internally we create
1777f1a120SToby Isaac  * an object that can cache the computations across multiple dual spaces */
Petsc1DNodeFamilyCreate(PetscDTNodeType family,PetscReal gaussJacobiExp,PetscBool endpoints,Petsc1DNodeFamily * nf)18d71ae5a4SJacob Faibussowitsch static PetscErrorCode Petsc1DNodeFamilyCreate(PetscDTNodeType family, PetscReal gaussJacobiExp, PetscBool endpoints, Petsc1DNodeFamily *nf)
19d71ae5a4SJacob Faibussowitsch {
203f27d899SToby Isaac   Petsc1DNodeFamily f;
213f27d899SToby Isaac 
223f27d899SToby Isaac   PetscFunctionBegin;
239566063dSJacob Faibussowitsch   PetscCall(PetscNew(&f));
243f27d899SToby Isaac   switch (family) {
253f27d899SToby Isaac   case PETSCDTNODES_GAUSSJACOBI:
26d71ae5a4SJacob Faibussowitsch   case PETSCDTNODES_EQUISPACED:
27d71ae5a4SJacob Faibussowitsch     f->nodeFamily = family;
28d71ae5a4SJacob Faibussowitsch     break;
29d71ae5a4SJacob Faibussowitsch   default:
30d71ae5a4SJacob Faibussowitsch     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown 1D node family");
313f27d899SToby Isaac   }
323f27d899SToby Isaac   f->endpoints      = endpoints;
333f27d899SToby Isaac   f->gaussJacobiExp = 0.;
343f27d899SToby Isaac   if (family == PETSCDTNODES_GAUSSJACOBI) {
3508401ef6SPierre Jolivet     PetscCheck(gaussJacobiExp > -1., PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Gauss-Jacobi exponent must be > -1.");
363f27d899SToby Isaac     f->gaussJacobiExp = gaussJacobiExp;
373f27d899SToby Isaac   }
383f27d899SToby Isaac   f->refct = 1;
393f27d899SToby Isaac   *nf      = f;
403ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
413f27d899SToby Isaac }
423f27d899SToby Isaac 
Petsc1DNodeFamilyReference(Petsc1DNodeFamily nf)43d71ae5a4SJacob Faibussowitsch static PetscErrorCode Petsc1DNodeFamilyReference(Petsc1DNodeFamily nf)
44d71ae5a4SJacob Faibussowitsch {
453f27d899SToby Isaac   PetscFunctionBegin;
463f27d899SToby Isaac   if (nf) nf->refct++;
473ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
483f27d899SToby Isaac }
493f27d899SToby Isaac 
Petsc1DNodeFamilyDestroy(Petsc1DNodeFamily * nf)50d71ae5a4SJacob Faibussowitsch static PetscErrorCode Petsc1DNodeFamilyDestroy(Petsc1DNodeFamily *nf)
51d71ae5a4SJacob Faibussowitsch {
523f27d899SToby Isaac   PetscInt i, nc;
533f27d899SToby Isaac 
543f27d899SToby Isaac   PetscFunctionBegin;
554ad8454bSPierre Jolivet   if (!*nf) PetscFunctionReturn(PETSC_SUCCESS);
563f27d899SToby Isaac   if (--(*nf)->refct > 0) {
573f27d899SToby Isaac     *nf = NULL;
583ba16761SJacob Faibussowitsch     PetscFunctionReturn(PETSC_SUCCESS);
593f27d899SToby Isaac   }
603f27d899SToby Isaac   nc = (*nf)->nComputed;
6148a46eb9SPierre Jolivet   for (i = 0; i < nc; i++) PetscCall(PetscFree((*nf)->nodesets[i]));
629566063dSJacob Faibussowitsch   PetscCall(PetscFree((*nf)->nodesets));
639566063dSJacob Faibussowitsch   PetscCall(PetscFree(*nf));
643f27d899SToby Isaac   *nf = NULL;
653ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
663f27d899SToby Isaac }
673f27d899SToby Isaac 
Petsc1DNodeFamilyGetNodeSets(Petsc1DNodeFamily f,PetscInt degree,PetscReal *** nodesets)68d71ae5a4SJacob Faibussowitsch static PetscErrorCode Petsc1DNodeFamilyGetNodeSets(Petsc1DNodeFamily f, PetscInt degree, PetscReal ***nodesets)
69d71ae5a4SJacob Faibussowitsch {
703f27d899SToby Isaac   PetscInt nc;
713f27d899SToby Isaac 
723f27d899SToby Isaac   PetscFunctionBegin;
733f27d899SToby Isaac   nc = f->nComputed;
743f27d899SToby Isaac   if (degree >= nc) {
753f27d899SToby Isaac     PetscInt    i, j;
763f27d899SToby Isaac     PetscReal **new_nodesets;
773f27d899SToby Isaac     PetscReal  *w;
783f27d899SToby Isaac 
799566063dSJacob Faibussowitsch     PetscCall(PetscMalloc1(degree + 1, &new_nodesets));
809566063dSJacob Faibussowitsch     PetscCall(PetscArraycpy(new_nodesets, f->nodesets, nc));
819566063dSJacob Faibussowitsch     PetscCall(PetscFree(f->nodesets));
823f27d899SToby Isaac     f->nodesets = new_nodesets;
839566063dSJacob Faibussowitsch     PetscCall(PetscMalloc1(degree + 1, &w));
843f27d899SToby Isaac     for (i = nc; i < degree + 1; i++) {
85f4f49eeaSPierre Jolivet       PetscCall(PetscMalloc1(i + 1, &f->nodesets[i]));
863f27d899SToby Isaac       if (!i) {
873f27d899SToby Isaac         f->nodesets[i][0] = 0.5;
883f27d899SToby Isaac       } else {
893f27d899SToby Isaac         switch (f->nodeFamily) {
903f27d899SToby Isaac         case PETSCDTNODES_EQUISPACED:
913f27d899SToby Isaac           if (f->endpoints) {
923f27d899SToby Isaac             for (j = 0; j <= i; j++) f->nodesets[i][j] = (PetscReal)j / (PetscReal)i;
933f27d899SToby Isaac           } else {
9477f1a120SToby Isaac             /* these nodes are at the centroids of the small simplices created by the equispaced nodes that include
9577f1a120SToby Isaac              * the endpoints */
963f27d899SToby Isaac             for (j = 0; j <= i; j++) f->nodesets[i][j] = ((PetscReal)j + 0.5) / ((PetscReal)i + 1.);
973f27d899SToby Isaac           }
983f27d899SToby Isaac           break;
993f27d899SToby Isaac         case PETSCDTNODES_GAUSSJACOBI:
1003f27d899SToby Isaac           if (f->endpoints) {
1019566063dSJacob Faibussowitsch             PetscCall(PetscDTGaussLobattoJacobiQuadrature(i + 1, 0., 1., f->gaussJacobiExp, f->gaussJacobiExp, f->nodesets[i], w));
1023f27d899SToby Isaac           } else {
1039566063dSJacob Faibussowitsch             PetscCall(PetscDTGaussJacobiQuadrature(i + 1, 0., 1., f->gaussJacobiExp, f->gaussJacobiExp, f->nodesets[i], w));
1043f27d899SToby Isaac           }
1053f27d899SToby Isaac           break;
106d71ae5a4SJacob Faibussowitsch         default:
107d71ae5a4SJacob Faibussowitsch           SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown 1D node family");
1083f27d899SToby Isaac         }
1093f27d899SToby Isaac       }
1103f27d899SToby Isaac     }
1119566063dSJacob Faibussowitsch     PetscCall(PetscFree(w));
1123f27d899SToby Isaac     f->nComputed = degree + 1;
1133f27d899SToby Isaac   }
1143f27d899SToby Isaac   *nodesets = f->nodesets;
1153ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
1163f27d899SToby Isaac }
1173f27d899SToby Isaac 
11877f1a120SToby Isaac /* http://arxiv.org/abs/2002.09421 for details */
PetscNodeRecursive_Internal(PetscInt dim,PetscInt degree,PetscReal ** nodesets,PetscInt tup[],PetscReal node[])119d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscNodeRecursive_Internal(PetscInt dim, PetscInt degree, PetscReal **nodesets, PetscInt tup[], PetscReal node[])
120d71ae5a4SJacob Faibussowitsch {
1213f27d899SToby Isaac   PetscReal w;
1223f27d899SToby Isaac   PetscInt  i, j;
1233f27d899SToby Isaac 
1243f27d899SToby Isaac   PetscFunctionBeginHot;
1253f27d899SToby Isaac   w = 0.;
1263f27d899SToby Isaac   if (dim == 1) {
1273f27d899SToby Isaac     node[0] = nodesets[degree][tup[0]];
1283f27d899SToby Isaac     node[1] = nodesets[degree][tup[1]];
1293f27d899SToby Isaac   } else {
1303f27d899SToby Isaac     for (i = 0; i < dim + 1; i++) node[i] = 0.;
1313f27d899SToby Isaac     for (i = 0; i < dim + 1; i++) {
1323f27d899SToby Isaac       PetscReal wi = nodesets[degree][degree - tup[i]];
1333f27d899SToby Isaac 
1343f27d899SToby Isaac       for (j = 0; j < dim + 1; j++) tup[dim + 1 + j] = tup[j + (j >= i)];
1359566063dSJacob Faibussowitsch       PetscCall(PetscNodeRecursive_Internal(dim - 1, degree - tup[i], nodesets, &tup[dim + 1], &node[dim + 1]));
1363f27d899SToby Isaac       for (j = 0; j < dim + 1; j++) node[j + (j >= i)] += wi * node[dim + 1 + j];
1373f27d899SToby Isaac       w += wi;
1383f27d899SToby Isaac     }
1393f27d899SToby Isaac     for (i = 0; i < dim + 1; i++) node[i] /= w;
1403f27d899SToby Isaac   }
1413ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
1423f27d899SToby Isaac }
1433f27d899SToby Isaac 
1443f27d899SToby Isaac /* compute simplex nodes for the biunit simplex from the 1D node family */
Petsc1DNodeFamilyComputeSimplexNodes(Petsc1DNodeFamily f,PetscInt dim,PetscInt degree,PetscReal points[])145d71ae5a4SJacob Faibussowitsch static PetscErrorCode Petsc1DNodeFamilyComputeSimplexNodes(Petsc1DNodeFamily f, PetscInt dim, PetscInt degree, PetscReal points[])
146d71ae5a4SJacob Faibussowitsch {
1473f27d899SToby Isaac   PetscInt   *tup;
1483f27d899SToby Isaac   PetscInt    npoints;
1493f27d899SToby Isaac   PetscReal **nodesets = NULL;
1503f27d899SToby Isaac   PetscInt    worksize;
1513f27d899SToby Isaac   PetscReal  *nodework;
1523f27d899SToby Isaac   PetscInt   *tupwork;
1533f27d899SToby Isaac 
1543f27d899SToby Isaac   PetscFunctionBegin;
15508401ef6SPierre Jolivet   PetscCheck(dim >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Must have non-negative dimension");
15608401ef6SPierre Jolivet   PetscCheck(degree >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Must have non-negative degree");
1573ba16761SJacob Faibussowitsch   if (!dim) PetscFunctionReturn(PETSC_SUCCESS);
1589566063dSJacob Faibussowitsch   PetscCall(PetscCalloc1(dim + 2, &tup));
1599566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(degree + dim, dim, &npoints));
1609566063dSJacob Faibussowitsch   PetscCall(Petsc1DNodeFamilyGetNodeSets(f, degree, &nodesets));
1613f27d899SToby Isaac   worksize = ((dim + 2) * (dim + 3)) / 2;
162e06b9cbaSStefano Zampini   PetscCall(PetscCalloc2(worksize, &nodework, worksize, &tupwork));
16377f1a120SToby Isaac   /* loop over the tuples of length dim with sum at most degree */
164dd460d27SBarry Smith   for (PetscInt k = 0; k < npoints; k++) {
1653f27d899SToby Isaac     PetscInt i;
1663f27d899SToby Isaac 
16777f1a120SToby Isaac     /* turn thm into tuples of length dim + 1 with sum equal to degree (barycentric indice) */
1683f27d899SToby Isaac     tup[0] = degree;
169ad540459SPierre Jolivet     for (i = 0; i < dim; i++) tup[0] -= tup[i + 1];
1703f27d899SToby Isaac     switch (f->nodeFamily) {
1713f27d899SToby Isaac     case PETSCDTNODES_EQUISPACED:
17277f1a120SToby Isaac       /* compute equispaces nodes on the unit reference triangle */
1733f27d899SToby Isaac       if (f->endpoints) {
1742b6f951bSStefano Zampini         PetscCheck(degree > 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Must have positive degree");
175ad540459SPierre Jolivet         for (i = 0; i < dim; i++) points[dim * k + i] = (PetscReal)tup[i + 1] / (PetscReal)degree;
1763f27d899SToby Isaac       } else {
1773f27d899SToby Isaac         for (i = 0; i < dim; i++) {
17877f1a120SToby Isaac           /* these nodes are at the centroids of the small simplices created by the equispaced nodes that include
17977f1a120SToby Isaac            * the endpoints */
1803f27d899SToby Isaac           points[dim * k + i] = ((PetscReal)tup[i + 1] + 1. / (dim + 1.)) / (PetscReal)(degree + 1.);
1813f27d899SToby Isaac         }
1823f27d899SToby Isaac       }
1833f27d899SToby Isaac       break;
1843f27d899SToby Isaac     default:
185e06b9cbaSStefano Zampini       /* compute equispaced nodes on the barycentric reference triangle (the trace on the first dim dimensions are the
18677f1a120SToby Isaac        * unit reference triangle nodes */
1873f27d899SToby Isaac       for (i = 0; i < dim + 1; i++) tupwork[i] = tup[i];
1889566063dSJacob Faibussowitsch       PetscCall(PetscNodeRecursive_Internal(dim, degree, nodesets, tupwork, nodework));
1893f27d899SToby Isaac       for (i = 0; i < dim; i++) points[dim * k + i] = nodework[i + 1];
1903f27d899SToby Isaac       break;
1913f27d899SToby Isaac     }
1929566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceLatticePointLexicographic_Internal(dim, degree, &tup[1]));
1933f27d899SToby Isaac   }
1943f27d899SToby Isaac   /* map from unit simplex to biunit simplex */
195dd460d27SBarry Smith   for (PetscInt k = 0; k < npoints * dim; k++) points[k] = points[k] * 2. - 1.;
1969566063dSJacob Faibussowitsch   PetscCall(PetscFree2(nodework, tupwork));
1979566063dSJacob Faibussowitsch   PetscCall(PetscFree(tup));
1983ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
1993f27d899SToby Isaac }
2003f27d899SToby Isaac 
20177f1a120SToby Isaac /* 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
20277f1a120SToby Isaac  * on that mesh point, we have to be careful about getting/adding everything in the right place.
20377f1a120SToby Isaac  *
20477f1a120SToby Isaac  * With nodal dofs like PETSCDUALSPACELAGRANGE makes, the general approach to calculate the value of dofs associate
20577f1a120SToby Isaac  * with a node A is
20677f1a120SToby Isaac  * - transform the node locations x(A) by the map that takes the mesh point to its reorientation, x' = phi(x(A))
20777f1a120SToby Isaac  * - figure out which node was originally at the location of the transformed point, A' = idx(x')
20877f1a120SToby Isaac  * - if the dofs are not scalars, figure out how to represent the transformed dofs in terms of the basis
20977f1a120SToby Isaac  *   of dofs at A' (using pushforward/pullback rules)
21077f1a120SToby Isaac  *
21177f1a120SToby Isaac  * The one sticky point with this approach is the "A' = idx(x')" step: trying to go from real valued coordinates
21277f1a120SToby Isaac  * back to indices.  I don't want to rely on floating point tolerances.  Additionally, PETSCDUALSPACELAGRANGE may
21377f1a120SToby Isaac  * eventually support quasi-Lagrangian dofs, which could involve quadrature at multiple points, so the location "x(A)"
21477f1a120SToby Isaac  * would be ambiguous.
21577f1a120SToby Isaac  *
21677f1a120SToby Isaac  * So each dof gets an integer value coordinate (nodeIdx in the structure below).  The choice of integer coordinates
21777f1a120SToby Isaac  * is somewhat arbitrary, as long as all of the relevant symmetries of the mesh point correspond to *permutations* of
21877f1a120SToby Isaac  * the integer coordinates, which do not depend on numerical precision.
21977f1a120SToby Isaac  *
22077f1a120SToby Isaac  * So
22177f1a120SToby Isaac  *
22277f1a120SToby Isaac  * - DMPlexGetTransitiveClosure_Internal() tells me how an orientation turns into a permutation of the vertices of a
22377f1a120SToby Isaac  *   mesh point
22477f1a120SToby Isaac  * - The permutation of the vertices, and the nodeIdx values assigned to them, tells what permutation in index space
22577f1a120SToby Isaac  *   is associated with the orientation
22677f1a120SToby Isaac  * - I uses that permutation to get xi' = phi(xi(A)), the integer coordinate of the transformed dof
22777f1a120SToby Isaac  * - I can without numerical issues compute A' = idx(xi')
22877f1a120SToby Isaac  *
22977f1a120SToby Isaac  * Here are some examples of how the process works
23077f1a120SToby Isaac  *
23177f1a120SToby Isaac  * - With a triangle:
23277f1a120SToby Isaac  *
23377f1a120SToby Isaac  *   The triangle has the following integer coordinates for vertices, taken from the barycentric triangle
23477f1a120SToby Isaac  *
23577f1a120SToby Isaac  *     closure order 2
23677f1a120SToby Isaac  *     nodeIdx (0,0,1)
23777f1a120SToby Isaac  *      \
23877f1a120SToby Isaac  *       +
23977f1a120SToby Isaac  *       |\
24077f1a120SToby Isaac  *       | \
24177f1a120SToby Isaac  *       |  \
24277f1a120SToby Isaac  *       |   \    closure order 1
24377f1a120SToby Isaac  *       |    \ / nodeIdx (0,1,0)
24477f1a120SToby Isaac  *       +-----+
24577f1a120SToby Isaac  *        \
24677f1a120SToby Isaac  *      closure order 0
24777f1a120SToby Isaac  *      nodeIdx (1,0,0)
24877f1a120SToby Isaac  *
24977f1a120SToby Isaac  *   If I do DMPlexGetTransitiveClosure_Internal() with orientation 1, the vertices would appear
25077f1a120SToby Isaac  *   in the order (1, 2, 0)
25177f1a120SToby Isaac  *
25277f1a120SToby Isaac  *   If I list the nodeIdx of each vertex in closure order for orientation 0 (0, 1, 2) and orientation 1 (1, 2, 0), I
25377f1a120SToby Isaac  *   see
25477f1a120SToby Isaac  *
25577f1a120SToby Isaac  *   orientation 0  | orientation 1
25677f1a120SToby Isaac  *
25777f1a120SToby Isaac  *   [0] (1,0,0)      [1] (0,1,0)
25877f1a120SToby Isaac  *   [1] (0,1,0)      [2] (0,0,1)
25977f1a120SToby Isaac  *   [2] (0,0,1)      [0] (1,0,0)
26077f1a120SToby Isaac  *          A                B
26177f1a120SToby Isaac  *
26277f1a120SToby Isaac  *   In other words, B is the result of a row permutation of A.  But, there is also
26377f1a120SToby Isaac  *   a column permutation that accomplishes the same result, (2,0,1).
26477f1a120SToby Isaac  *
26577f1a120SToby Isaac  *   So if a dof has nodeIdx coordinate (a,b,c), after the transformation its nodeIdx coordinate
26677f1a120SToby Isaac  *   is (c,a,b), and the transformed degree of freedom will be a linear combination of dofs
26777f1a120SToby Isaac  *   that originally had coordinate (c,a,b).
26877f1a120SToby Isaac  *
26977f1a120SToby Isaac  * - With a quadrilateral:
27077f1a120SToby Isaac  *
27177f1a120SToby Isaac  *   The quadrilateral has the following integer coordinates for vertices, taken from concatenating barycentric
27277f1a120SToby Isaac  *   coordinates for two segments:
27377f1a120SToby Isaac  *
27477f1a120SToby Isaac  *     closure order 3      closure order 2
27577f1a120SToby Isaac  *     nodeIdx (1,0,0,1)    nodeIdx (0,1,0,1)
27677f1a120SToby Isaac  *                   \      /
27777f1a120SToby Isaac  *                    +----+
27877f1a120SToby Isaac  *                    |    |
27977f1a120SToby Isaac  *                    |    |
28077f1a120SToby Isaac  *                    +----+
28177f1a120SToby Isaac  *                   /      \
28277f1a120SToby Isaac  *     closure order 0      closure order 1
28377f1a120SToby Isaac  *     nodeIdx (1,0,1,0)    nodeIdx (0,1,1,0)
28477f1a120SToby Isaac  *
28577f1a120SToby Isaac  *   If I do DMPlexGetTransitiveClosure_Internal() with orientation 1, the vertices would appear
28677f1a120SToby Isaac  *   in the order (1, 2, 3, 0)
28777f1a120SToby Isaac  *
28877f1a120SToby Isaac  *   If I list the nodeIdx of each vertex in closure order for orientation 0 (0, 1, 2, 3) and
28977f1a120SToby Isaac  *   orientation 1 (1, 2, 3, 0), I see
29077f1a120SToby Isaac  *
29177f1a120SToby Isaac  *   orientation 0  | orientation 1
29277f1a120SToby Isaac  *
29377f1a120SToby Isaac  *   [0] (1,0,1,0)    [1] (0,1,1,0)
29477f1a120SToby Isaac  *   [1] (0,1,1,0)    [2] (0,1,0,1)
29577f1a120SToby Isaac  *   [2] (0,1,0,1)    [3] (1,0,0,1)
29677f1a120SToby Isaac  *   [3] (1,0,0,1)    [0] (1,0,1,0)
29777f1a120SToby Isaac  *          A                B
29877f1a120SToby Isaac  *
29977f1a120SToby Isaac  *   The column permutation that accomplishes the same result is (3,2,0,1).
30077f1a120SToby Isaac  *
30177f1a120SToby Isaac  *   So if a dof has nodeIdx coordinate (a,b,c,d), after the transformation its nodeIdx coordinate
30277f1a120SToby Isaac  *   is (d,c,a,b), and the transformed degree of freedom will be a linear combination of dofs
30377f1a120SToby Isaac  *   that originally had coordinate (d,c,a,b).
30477f1a120SToby Isaac  *
30577f1a120SToby Isaac  * Previously PETSCDUALSPACELAGRANGE had hardcoded symmetries for the triangle and quadrilateral,
30677f1a120SToby Isaac  * but this approach will work for any polytope, such as the wedge (triangular prism).
30777f1a120SToby Isaac  */
3089371c9d4SSatish Balay struct _n_PetscLagNodeIndices {
3093f27d899SToby Isaac   PetscInt   refct;
3103f27d899SToby Isaac   PetscInt   nodeIdxDim;
3113f27d899SToby Isaac   PetscInt   nodeVecDim;
3123f27d899SToby Isaac   PetscInt   nNodes;
3133f27d899SToby Isaac   PetscInt  *nodeIdx; /* for each node an index of size nodeIdxDim */
3143f27d899SToby Isaac   PetscReal *nodeVec; /* for each node a vector of size nodeVecDim */
3153f27d899SToby Isaac   PetscInt  *perm;    /* if these are vertices, perm takes DMPlex point index to closure order;
3163f27d899SToby Isaac                               if these are nodes, perm lists nodes in index revlex order */
3173f27d899SToby Isaac };
3183f27d899SToby Isaac 
31977f1a120SToby Isaac /* 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[])320d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscLagNodeIndicesGetData_Internal(PetscLagNodeIndices ni, PetscInt *nodeIdxDim, PetscInt *nodeVecDim, PetscInt *nNodes, const PetscInt *nodeIdx[], const PetscReal *nodeVec[])
321d71ae5a4SJacob Faibussowitsch {
3223f27d899SToby Isaac   PetscFunctionBegin;
3233f27d899SToby Isaac   *nodeIdxDim = ni->nodeIdxDim;
3243f27d899SToby Isaac   *nodeVecDim = ni->nodeVecDim;
3253f27d899SToby Isaac   *nNodes     = ni->nNodes;
3263f27d899SToby Isaac   *nodeIdx    = ni->nodeIdx;
3273f27d899SToby Isaac   *nodeVec    = ni->nodeVec;
3283ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
3293f27d899SToby Isaac }
3303f27d899SToby Isaac 
PetscLagNodeIndicesReference(PetscLagNodeIndices ni)331d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesReference(PetscLagNodeIndices ni)
332d71ae5a4SJacob Faibussowitsch {
3333f27d899SToby Isaac   PetscFunctionBegin;
3343f27d899SToby Isaac   if (ni) ni->refct++;
3353ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
3363f27d899SToby Isaac }
3373f27d899SToby Isaac 
PetscLagNodeIndicesDuplicate(PetscLagNodeIndices ni,PetscLagNodeIndices * niNew)338d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesDuplicate(PetscLagNodeIndices ni, PetscLagNodeIndices *niNew)
339d71ae5a4SJacob Faibussowitsch {
3401f440fbeSToby Isaac   PetscFunctionBegin;
3419566063dSJacob Faibussowitsch   PetscCall(PetscNew(niNew));
3421f440fbeSToby Isaac   (*niNew)->refct      = 1;
3431f440fbeSToby Isaac   (*niNew)->nodeIdxDim = ni->nodeIdxDim;
3441f440fbeSToby Isaac   (*niNew)->nodeVecDim = ni->nodeVecDim;
3451f440fbeSToby Isaac   (*niNew)->nNodes     = ni->nNodes;
3469566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(ni->nNodes * ni->nodeIdxDim, &((*niNew)->nodeIdx)));
3479566063dSJacob Faibussowitsch   PetscCall(PetscArraycpy((*niNew)->nodeIdx, ni->nodeIdx, ni->nNodes * ni->nodeIdxDim));
3489566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(ni->nNodes * ni->nodeVecDim, &((*niNew)->nodeVec)));
3499566063dSJacob Faibussowitsch   PetscCall(PetscArraycpy((*niNew)->nodeVec, ni->nodeVec, ni->nNodes * ni->nodeVecDim));
3501f440fbeSToby Isaac   (*niNew)->perm = NULL;
3513ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
3521f440fbeSToby Isaac }
3531f440fbeSToby Isaac 
PetscLagNodeIndicesDestroy(PetscLagNodeIndices * ni)354d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesDestroy(PetscLagNodeIndices *ni)
355d71ae5a4SJacob Faibussowitsch {
3563f27d899SToby Isaac   PetscFunctionBegin;
3574ad8454bSPierre Jolivet   if (!*ni) PetscFunctionReturn(PETSC_SUCCESS);
3583f27d899SToby Isaac   if (--(*ni)->refct > 0) {
3593f27d899SToby Isaac     *ni = NULL;
3603ba16761SJacob Faibussowitsch     PetscFunctionReturn(PETSC_SUCCESS);
3613f27d899SToby Isaac   }
3629566063dSJacob Faibussowitsch   PetscCall(PetscFree((*ni)->nodeIdx));
3639566063dSJacob Faibussowitsch   PetscCall(PetscFree((*ni)->nodeVec));
3649566063dSJacob Faibussowitsch   PetscCall(PetscFree((*ni)->perm));
3659566063dSJacob Faibussowitsch   PetscCall(PetscFree(*ni));
3663f27d899SToby Isaac   *ni = NULL;
3673ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
3683f27d899SToby Isaac }
3693f27d899SToby Isaac 
37077f1a120SToby Isaac /* The vertices are given nodeIdx coordinates (e.g. the corners of the barycentric triangle).  Those coordinates are
37177f1a120SToby Isaac  * in some other order, and to understand the effect of different symmetries, we need them to be in closure order.
37277f1a120SToby Isaac  *
37377f1a120SToby Isaac  * If sortIdx is PETSC_FALSE, the coordinates are already in revlex order, otherwise we must sort them
37477f1a120SToby Isaac  * to that order before we do the real work of this function, which is
37577f1a120SToby Isaac  *
37677f1a120SToby Isaac  * - mark the vertices in closure order
37777f1a120SToby Isaac  * - sort them in revlex order
37877f1a120SToby Isaac  * - use the resulting permutation to list the vertex coordinates in closure order
37977f1a120SToby Isaac  */
PetscLagNodeIndicesComputeVertexOrder(DM dm,PetscLagNodeIndices ni,PetscBool sortIdx)380d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesComputeVertexOrder(DM dm, PetscLagNodeIndices ni, PetscBool sortIdx)
381d71ae5a4SJacob Faibussowitsch {
3823f27d899SToby Isaac   PetscInt           v, w, vStart, vEnd, c, d;
3833f27d899SToby Isaac   PetscInt           nVerts;
3843f27d899SToby Isaac   PetscInt           closureSize = 0;
3853f27d899SToby Isaac   PetscInt          *closure     = NULL;
3863f27d899SToby Isaac   PetscInt          *closureOrder;
3873f27d899SToby Isaac   PetscInt          *invClosureOrder;
3883f27d899SToby Isaac   PetscInt          *revlexOrder;
3893f27d899SToby Isaac   PetscInt          *newNodeIdx;
3903f27d899SToby Isaac   PetscInt           dim;
3913f27d899SToby Isaac   Vec                coordVec;
3923f27d899SToby Isaac   const PetscScalar *coords;
3933f27d899SToby Isaac 
3943f27d899SToby Isaac   PetscFunctionBegin;
3959566063dSJacob Faibussowitsch   PetscCall(DMGetDimension(dm, &dim));
3969566063dSJacob Faibussowitsch   PetscCall(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd));
3973f27d899SToby Isaac   nVerts = vEnd - vStart;
3989566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(nVerts, &closureOrder));
3999566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(nVerts, &invClosureOrder));
4009566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(nVerts, &revlexOrder));
40177f1a120SToby Isaac   if (sortIdx) { /* bubble sort nodeIdx into revlex order */
4023f27d899SToby Isaac     PetscInt  nodeIdxDim = ni->nodeIdxDim;
4033f27d899SToby Isaac     PetscInt *idxOrder;
4043f27d899SToby Isaac 
4059566063dSJacob Faibussowitsch     PetscCall(PetscMalloc1(nVerts * nodeIdxDim, &newNodeIdx));
4069566063dSJacob Faibussowitsch     PetscCall(PetscMalloc1(nVerts, &idxOrder));
4073f27d899SToby Isaac     for (v = 0; v < nVerts; v++) idxOrder[v] = v;
4083f27d899SToby Isaac     for (v = 0; v < nVerts; v++) {
4093f27d899SToby Isaac       for (w = v + 1; w < nVerts; w++) {
4103f27d899SToby Isaac         const PetscInt *iv   = &(ni->nodeIdx[idxOrder[v] * nodeIdxDim]);
4113f27d899SToby Isaac         const PetscInt *iw   = &(ni->nodeIdx[idxOrder[w] * nodeIdxDim]);
4123f27d899SToby Isaac         PetscInt        diff = 0;
4133f27d899SToby Isaac 
4149371c9d4SSatish Balay         for (d = nodeIdxDim - 1; d >= 0; d--)
4159371c9d4SSatish Balay           if ((diff = (iv[d] - iw[d]))) break;
4163f27d899SToby Isaac         if (diff > 0) {
4173f27d899SToby Isaac           PetscInt swap = idxOrder[v];
4183f27d899SToby Isaac 
4193f27d899SToby Isaac           idxOrder[v] = idxOrder[w];
4203f27d899SToby Isaac           idxOrder[w] = swap;
4213f27d899SToby Isaac         }
4223f27d899SToby Isaac       }
4233f27d899SToby Isaac     }
4243f27d899SToby Isaac     for (v = 0; v < nVerts; v++) {
425ad540459SPierre Jolivet       for (d = 0; d < nodeIdxDim; d++) newNodeIdx[v * ni->nodeIdxDim + d] = ni->nodeIdx[idxOrder[v] * nodeIdxDim + d];
4263f27d899SToby Isaac     }
4279566063dSJacob Faibussowitsch     PetscCall(PetscFree(ni->nodeIdx));
4283f27d899SToby Isaac     ni->nodeIdx = newNodeIdx;
4293f27d899SToby Isaac     newNodeIdx  = NULL;
4309566063dSJacob Faibussowitsch     PetscCall(PetscFree(idxOrder));
4313f27d899SToby Isaac   }
4329566063dSJacob Faibussowitsch   PetscCall(DMPlexGetTransitiveClosure(dm, 0, PETSC_TRUE, &closureSize, &closure));
4333f27d899SToby Isaac   c = closureSize - nVerts;
4343f27d899SToby Isaac   for (v = 0; v < nVerts; v++) closureOrder[v] = closure[2 * (c + v)] - vStart;
4353f27d899SToby Isaac   for (v = 0; v < nVerts; v++) invClosureOrder[closureOrder[v]] = v;
4369566063dSJacob Faibussowitsch   PetscCall(DMPlexRestoreTransitiveClosure(dm, 0, PETSC_TRUE, &closureSize, &closure));
4379566063dSJacob Faibussowitsch   PetscCall(DMGetCoordinatesLocal(dm, &coordVec));
4389566063dSJacob Faibussowitsch   PetscCall(VecGetArrayRead(coordVec, &coords));
4393f27d899SToby Isaac   /* bubble sort closure vertices by coordinates in revlex order */
4403f27d899SToby Isaac   for (v = 0; v < nVerts; v++) revlexOrder[v] = v;
4413f27d899SToby Isaac   for (v = 0; v < nVerts; v++) {
4423f27d899SToby Isaac     for (w = v + 1; w < nVerts; w++) {
4433f27d899SToby Isaac       const PetscScalar *cv   = &coords[closureOrder[revlexOrder[v]] * dim];
4443f27d899SToby Isaac       const PetscScalar *cw   = &coords[closureOrder[revlexOrder[w]] * dim];
4453f27d899SToby Isaac       PetscReal          diff = 0;
4463f27d899SToby Isaac 
4479371c9d4SSatish Balay       for (d = dim - 1; d >= 0; d--)
4489371c9d4SSatish Balay         if ((diff = PetscRealPart(cv[d] - cw[d])) != 0.) break;
4493f27d899SToby Isaac       if (diff > 0.) {
4503f27d899SToby Isaac         PetscInt swap = revlexOrder[v];
4513f27d899SToby Isaac 
4523f27d899SToby Isaac         revlexOrder[v] = revlexOrder[w];
4533f27d899SToby Isaac         revlexOrder[w] = swap;
4543f27d899SToby Isaac       }
4553f27d899SToby Isaac     }
4563f27d899SToby Isaac   }
4579566063dSJacob Faibussowitsch   PetscCall(VecRestoreArrayRead(coordVec, &coords));
4589566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(ni->nodeIdxDim * nVerts, &newNodeIdx));
4593f27d899SToby Isaac   /* reorder nodeIdx to be in closure order */
4603f27d899SToby Isaac   for (v = 0; v < nVerts; v++) {
461ad540459SPierre Jolivet     for (d = 0; d < ni->nodeIdxDim; d++) newNodeIdx[revlexOrder[v] * ni->nodeIdxDim + d] = ni->nodeIdx[v * ni->nodeIdxDim + d];
4623f27d899SToby Isaac   }
4639566063dSJacob Faibussowitsch   PetscCall(PetscFree(ni->nodeIdx));
4643f27d899SToby Isaac   ni->nodeIdx = newNodeIdx;
4653f27d899SToby Isaac   ni->perm    = invClosureOrder;
4669566063dSJacob Faibussowitsch   PetscCall(PetscFree(revlexOrder));
4679566063dSJacob Faibussowitsch   PetscCall(PetscFree(closureOrder));
4683ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
4693f27d899SToby Isaac }
4703f27d899SToby Isaac 
47177f1a120SToby Isaac /* the coordinates of the simplex vertices are the corners of the barycentric simplex.
47277f1a120SToby Isaac  * When we stack them on top of each other in revlex order, they look like the identity matrix */
PetscLagNodeIndicesCreateSimplexVertices(DM dm,PetscLagNodeIndices * nodeIndices)473d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesCreateSimplexVertices(DM dm, PetscLagNodeIndices *nodeIndices)
474d71ae5a4SJacob Faibussowitsch {
4753f27d899SToby Isaac   PetscLagNodeIndices ni;
4763f27d899SToby Isaac   PetscInt            dim, d;
4773f27d899SToby Isaac 
4783f27d899SToby Isaac   PetscFunctionBegin;
4799566063dSJacob Faibussowitsch   PetscCall(PetscNew(&ni));
4809566063dSJacob Faibussowitsch   PetscCall(DMGetDimension(dm, &dim));
4813f27d899SToby Isaac   ni->nodeIdxDim = dim + 1;
4823f27d899SToby Isaac   ni->nodeVecDim = 0;
4833f27d899SToby Isaac   ni->nNodes     = dim + 1;
4843f27d899SToby Isaac   ni->refct      = 1;
485f4f49eeaSPierre Jolivet   PetscCall(PetscCalloc1((dim + 1) * (dim + 1), &ni->nodeIdx));
4863f27d899SToby Isaac   for (d = 0; d < dim + 1; d++) ni->nodeIdx[d * (dim + 2)] = 1;
4879566063dSJacob Faibussowitsch   PetscCall(PetscLagNodeIndicesComputeVertexOrder(dm, ni, PETSC_FALSE));
4883f27d899SToby Isaac   *nodeIndices = ni;
4893ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
4903f27d899SToby Isaac }
4913f27d899SToby Isaac 
49277f1a120SToby Isaac /* A polytope that is a tensor product of a facet and a segment.
49377f1a120SToby Isaac  * We take whatever coordinate system was being used for the facet
4941f440fbeSToby Isaac  * and we concatenate the barycentric coordinates for the vertices
49577f1a120SToby Isaac  * at the end of the segment, (1,0) and (0,1), to get a coordinate
49677f1a120SToby Isaac  * system for the tensor product element */
PetscLagNodeIndicesCreateTensorVertices(DM dm,PetscLagNodeIndices facetni,PetscLagNodeIndices * nodeIndices)497d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesCreateTensorVertices(DM dm, PetscLagNodeIndices facetni, PetscLagNodeIndices *nodeIndices)
498d71ae5a4SJacob Faibussowitsch {
4993f27d899SToby Isaac   PetscLagNodeIndices ni;
5003f27d899SToby Isaac   PetscInt            nodeIdxDim, subNodeIdxDim = facetni->nodeIdxDim;
5013f27d899SToby Isaac   PetscInt            nVerts, nSubVerts         = facetni->nNodes;
5023f27d899SToby Isaac   PetscInt            dim, d, e, f, g;
5033f27d899SToby Isaac 
5043f27d899SToby Isaac   PetscFunctionBegin;
5059566063dSJacob Faibussowitsch   PetscCall(PetscNew(&ni));
5069566063dSJacob Faibussowitsch   PetscCall(DMGetDimension(dm, &dim));
5073f27d899SToby Isaac   ni->nodeIdxDim = nodeIdxDim = subNodeIdxDim + 2;
5083f27d899SToby Isaac   ni->nodeVecDim              = 0;
5093f27d899SToby Isaac   ni->nNodes = nVerts = 2 * nSubVerts;
5103f27d899SToby Isaac   ni->refct           = 1;
511f4f49eeaSPierre Jolivet   PetscCall(PetscCalloc1(nodeIdxDim * nVerts, &ni->nodeIdx));
5123f27d899SToby Isaac   for (f = 0, d = 0; d < 2; d++) {
5133f27d899SToby Isaac     for (e = 0; e < nSubVerts; e++, f++) {
514ad540459SPierre Jolivet       for (g = 0; g < subNodeIdxDim; g++) ni->nodeIdx[f * nodeIdxDim + g] = facetni->nodeIdx[e * subNodeIdxDim + g];
5153f27d899SToby Isaac       ni->nodeIdx[f * nodeIdxDim + subNodeIdxDim]     = (1 - d);
5163f27d899SToby Isaac       ni->nodeIdx[f * nodeIdxDim + subNodeIdxDim + 1] = d;
5173f27d899SToby Isaac     }
5183f27d899SToby Isaac   }
5199566063dSJacob Faibussowitsch   PetscCall(PetscLagNodeIndicesComputeVertexOrder(dm, ni, PETSC_TRUE));
5203f27d899SToby Isaac   *nodeIndices = ni;
5213ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
5223f27d899SToby Isaac }
5233f27d899SToby Isaac 
52477f1a120SToby Isaac /* This helps us compute symmetries, and it also helps us compute coordinates for dofs that are being pushed
52577f1a120SToby Isaac  * forward from a boundary mesh point.
52677f1a120SToby Isaac  *
52777f1a120SToby Isaac  * Input:
52877f1a120SToby Isaac  *
52977f1a120SToby Isaac  * dm - the target reference cell where we want new coordinates and dof directions to be valid
53077f1a120SToby Isaac  * vert - the vertex coordinate system for the target reference cell
53177f1a120SToby Isaac  * p - the point in the target reference cell that the dofs are coming from
53277f1a120SToby Isaac  * vertp - the vertex coordinate system for p's reference cell
53377f1a120SToby Isaac  * ornt - the resulting coordinates and dof vectors will be for p under this orientation
53477f1a120SToby Isaac  * nodep - the node coordinates and dof vectors in p's reference cell
53577f1a120SToby Isaac  * formDegree - the form degree that the dofs transform as
53677f1a120SToby Isaac  *
53777f1a120SToby Isaac  * Output:
53877f1a120SToby Isaac  *
53977f1a120SToby Isaac  * pfNodeIdx - the node coordinates for p's dofs, in the dm reference cell, from the ornt perspective
54077f1a120SToby Isaac  * pfNodeVec - the node dof vectors for p's dofs, in the dm reference cell, from the ornt perspective
54177f1a120SToby Isaac  */
PetscLagNodeIndicesPushForward(DM dm,PetscLagNodeIndices vert,PetscInt p,PetscLagNodeIndices vertp,PetscLagNodeIndices nodep,PetscInt ornt,PetscInt formDegree,PetscInt pfNodeIdx[],PetscReal pfNodeVec[])542d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesPushForward(DM dm, PetscLagNodeIndices vert, PetscInt p, PetscLagNodeIndices vertp, PetscLagNodeIndices nodep, PetscInt ornt, PetscInt formDegree, PetscInt pfNodeIdx[], PetscReal pfNodeVec[])
543d71ae5a4SJacob Faibussowitsch {
5443f27d899SToby Isaac   PetscInt          *closureVerts;
5453f27d899SToby Isaac   PetscInt           closureSize = 0;
5463f27d899SToby Isaac   PetscInt          *closure     = NULL;
5473f27d899SToby Isaac   PetscInt           dim, pdim, c, i, j, k, n, v, vStart, vEnd;
5483f27d899SToby Isaac   PetscInt           nSubVert      = vertp->nNodes;
5493f27d899SToby Isaac   PetscInt           nodeIdxDim    = vert->nodeIdxDim;
5503f27d899SToby Isaac   PetscInt           subNodeIdxDim = vertp->nodeIdxDim;
5513f27d899SToby Isaac   PetscInt           nNodes        = nodep->nNodes;
5523f27d899SToby Isaac   const PetscInt    *vertIdx       = vert->nodeIdx;
5533f27d899SToby Isaac   const PetscInt    *subVertIdx    = vertp->nodeIdx;
5543f27d899SToby Isaac   const PetscInt    *nodeIdx       = nodep->nodeIdx;
5553f27d899SToby Isaac   const PetscReal   *nodeVec       = nodep->nodeVec;
5563f27d899SToby Isaac   PetscReal         *J, *Jstar;
5573f27d899SToby Isaac   PetscReal          detJ;
5583f27d899SToby Isaac   PetscInt           depth, pdepth, Nk, pNk;
5593f27d899SToby Isaac   Vec                coordVec;
5603f27d899SToby Isaac   PetscScalar       *newCoords = NULL;
5613f27d899SToby Isaac   const PetscScalar *oldCoords = NULL;
5623f27d899SToby Isaac 
5633f27d899SToby Isaac   PetscFunctionBegin;
5649566063dSJacob Faibussowitsch   PetscCall(DMGetDimension(dm, &dim));
5659566063dSJacob Faibussowitsch   PetscCall(DMPlexGetDepth(dm, &depth));
5669566063dSJacob Faibussowitsch   PetscCall(DMGetCoordinatesLocal(dm, &coordVec));
5679566063dSJacob Faibussowitsch   PetscCall(DMPlexGetPointDepth(dm, p, &pdepth));
5683f27d899SToby Isaac   pdim = pdepth != depth ? pdepth != 0 ? pdepth : 0 : dim;
5699566063dSJacob Faibussowitsch   PetscCall(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd));
5709566063dSJacob Faibussowitsch   PetscCall(DMGetWorkArray(dm, nSubVert, MPIU_INT, &closureVerts));
5719566063dSJacob Faibussowitsch   PetscCall(DMPlexGetTransitiveClosure_Internal(dm, p, ornt, PETSC_TRUE, &closureSize, &closure));
5723f27d899SToby Isaac   c = closureSize - nSubVert;
5733f27d899SToby Isaac   /* we want which cell closure indices the closure of this point corresponds to */
5743f27d899SToby Isaac   for (v = 0; v < nSubVert; v++) closureVerts[v] = vert->perm[closure[2 * (c + v)] - vStart];
5759566063dSJacob Faibussowitsch   PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure));
5763f27d899SToby Isaac   /* push forward indices */
5773f27d899SToby Isaac   for (i = 0; i < nodeIdxDim; i++) { /* for every component of the target index space */
5783f27d899SToby Isaac     /* check if this is a component that all vertices around this point have in common */
5793f27d899SToby Isaac     for (j = 1; j < nSubVert; j++) {
5803f27d899SToby Isaac       if (vertIdx[closureVerts[j] * nodeIdxDim + i] != vertIdx[closureVerts[0] * nodeIdxDim + i]) break;
5813f27d899SToby Isaac     }
5823f27d899SToby Isaac     if (j == nSubVert) { /* all vertices have this component in common, directly copy to output */
5833f27d899SToby Isaac       PetscInt val = vertIdx[closureVerts[0] * nodeIdxDim + i];
5843f27d899SToby Isaac       for (n = 0; n < nNodes; n++) pfNodeIdx[n * nodeIdxDim + i] = val;
5853f27d899SToby Isaac     } else {
5863f27d899SToby Isaac       PetscInt subi = -1;
5873f27d899SToby Isaac       /* there must be a component in vertp that looks the same */
5883f27d899SToby Isaac       for (k = 0; k < subNodeIdxDim; k++) {
5893f27d899SToby Isaac         for (j = 0; j < nSubVert; j++) {
5903f27d899SToby Isaac           if (vertIdx[closureVerts[j] * nodeIdxDim + i] != subVertIdx[j * subNodeIdxDim + k]) break;
5913f27d899SToby Isaac         }
5923f27d899SToby Isaac         if (j == nSubVert) {
5933f27d899SToby Isaac           subi = k;
5943f27d899SToby Isaac           break;
5953f27d899SToby Isaac         }
5963f27d899SToby Isaac       }
59708401ef6SPierre Jolivet       PetscCheck(subi >= 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Did not find matching coordinate");
59877f1a120SToby Isaac       /* that component in the vertp system becomes component i in the vert system for each dof */
5993f27d899SToby Isaac       for (n = 0; n < nNodes; n++) pfNodeIdx[n * nodeIdxDim + i] = nodeIdx[n * subNodeIdxDim + subi];
6003f27d899SToby Isaac     }
6013f27d899SToby Isaac   }
6023f27d899SToby Isaac   /* push forward vectors */
6039566063dSJacob Faibussowitsch   PetscCall(DMGetWorkArray(dm, dim * dim, MPIU_REAL, &J));
60477f1a120SToby Isaac   if (ornt != 0) { /* temporarily change the coordinate vector so
60577f1a120SToby Isaac                       DMPlexComputeCellGeometryAffineFEM gives us the Jacobian we want */
6063f27d899SToby Isaac     PetscInt  closureSize2 = 0;
6073f27d899SToby Isaac     PetscInt *closure2     = NULL;
6083f27d899SToby Isaac 
6099566063dSJacob Faibussowitsch     PetscCall(DMPlexGetTransitiveClosure_Internal(dm, p, 0, PETSC_TRUE, &closureSize2, &closure2));
6109566063dSJacob Faibussowitsch     PetscCall(PetscMalloc1(dim * nSubVert, &newCoords));
6119566063dSJacob Faibussowitsch     PetscCall(VecGetArrayRead(coordVec, &oldCoords));
6123f27d899SToby Isaac     for (v = 0; v < nSubVert; v++) {
6133f27d899SToby Isaac       PetscInt d;
614ad540459SPierre Jolivet       for (d = 0; d < dim; d++) newCoords[(closure2[2 * (c + v)] - vStart) * dim + d] = oldCoords[closureVerts[v] * dim + d];
6153f27d899SToby Isaac     }
6169566063dSJacob Faibussowitsch     PetscCall(VecRestoreArrayRead(coordVec, &oldCoords));
6179566063dSJacob Faibussowitsch     PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize2, &closure2));
6189566063dSJacob Faibussowitsch     PetscCall(VecPlaceArray(coordVec, newCoords));
6193f27d899SToby Isaac   }
6209566063dSJacob Faibussowitsch   PetscCall(DMPlexComputeCellGeometryAffineFEM(dm, p, NULL, J, NULL, &detJ));
6213f27d899SToby Isaac   if (ornt != 0) {
6229566063dSJacob Faibussowitsch     PetscCall(VecResetArray(coordVec));
6239566063dSJacob Faibussowitsch     PetscCall(PetscFree(newCoords));
6243f27d899SToby Isaac   }
6259566063dSJacob Faibussowitsch   PetscCall(DMRestoreWorkArray(dm, nSubVert, MPIU_INT, &closureVerts));
6263f27d899SToby Isaac   /* compactify */
6279371c9d4SSatish Balay   for (i = 0; i < dim; i++)
6289371c9d4SSatish Balay     for (j = 0; j < pdim; j++) J[i * pdim + j] = J[i * dim + j];
62977f1a120SToby Isaac   /* We have the Jacobian mapping the point's reference cell to this reference cell:
63077f1a120SToby Isaac    * pulling back a function to the point and applying the dof is what we want,
63177f1a120SToby Isaac    * so we get the pullback matrix and multiply the dof by that matrix on the right */
6329566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk));
6339566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(pdim, PetscAbsInt(formDegree), &pNk));
6349566063dSJacob Faibussowitsch   PetscCall(DMGetWorkArray(dm, pNk * Nk, MPIU_REAL, &Jstar));
6359566063dSJacob Faibussowitsch   PetscCall(PetscDTAltVPullbackMatrix(pdim, dim, J, formDegree, Jstar));
6363f27d899SToby Isaac   for (n = 0; n < nNodes; n++) {
6373f27d899SToby Isaac     for (i = 0; i < Nk; i++) {
6383f27d899SToby Isaac       PetscReal val = 0.;
6395efe5503SToby Isaac       for (j = 0; j < pNk; j++) val += nodeVec[n * pNk + j] * Jstar[j * Nk + i];
6403f27d899SToby Isaac       pfNodeVec[n * Nk + i] = val;
6413f27d899SToby Isaac     }
6423f27d899SToby Isaac   }
6439566063dSJacob Faibussowitsch   PetscCall(DMRestoreWorkArray(dm, pNk * Nk, MPIU_REAL, &Jstar));
6449566063dSJacob Faibussowitsch   PetscCall(DMRestoreWorkArray(dm, dim * dim, MPIU_REAL, &J));
6453ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
6463f27d899SToby Isaac }
6473f27d899SToby Isaac 
64877f1a120SToby Isaac /* given to sets of nodes, take the tensor product, where the product of the dof indices is concatenation and the
64977f1a120SToby Isaac  * product of the dof vectors is the wedge product */
PetscLagNodeIndicesTensor(PetscLagNodeIndices tracei,PetscInt dimT,PetscInt kT,PetscLagNodeIndices fiberi,PetscInt dimF,PetscInt kF,PetscLagNodeIndices * nodeIndices)650d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesTensor(PetscLagNodeIndices tracei, PetscInt dimT, PetscInt kT, PetscLagNodeIndices fiberi, PetscInt dimF, PetscInt kF, PetscLagNodeIndices *nodeIndices)
651d71ae5a4SJacob Faibussowitsch {
6523f27d899SToby Isaac   PetscInt            dim = dimT + dimF;
6533f27d899SToby Isaac   PetscInt            nodeIdxDim, nNodes;
6543f27d899SToby Isaac   PetscInt            formDegree = kT + kF;
6553f27d899SToby Isaac   PetscInt            Nk, NkT, NkF;
6563f27d899SToby Isaac   PetscInt            MkT, MkF;
6573f27d899SToby Isaac   PetscLagNodeIndices ni;
6583f27d899SToby Isaac   PetscInt            i, j, l;
6593f27d899SToby Isaac   PetscReal          *projF, *projT;
6603f27d899SToby Isaac   PetscReal          *projFstar, *projTstar;
6613f27d899SToby Isaac   PetscReal          *workF, *workF2, *workT, *workT2, *work, *work2;
6623f27d899SToby Isaac   PetscReal          *wedgeMat;
6633f27d899SToby Isaac   PetscReal           sign;
6643f27d899SToby Isaac 
6653f27d899SToby Isaac   PetscFunctionBegin;
6669566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk));
6679566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dimT, PetscAbsInt(kT), &NkT));
6689566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dimF, PetscAbsInt(kF), &NkF));
6699566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(kT), &MkT));
6709566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(kF), &MkF));
6719566063dSJacob Faibussowitsch   PetscCall(PetscNew(&ni));
6723f27d899SToby Isaac   ni->nodeIdxDim = nodeIdxDim = tracei->nodeIdxDim + fiberi->nodeIdxDim;
6733f27d899SToby Isaac   ni->nodeVecDim              = Nk;
6743f27d899SToby Isaac   ni->nNodes = nNodes = tracei->nNodes * fiberi->nNodes;
6753f27d899SToby Isaac   ni->refct           = 1;
676f4f49eeaSPierre Jolivet   PetscCall(PetscMalloc1(nNodes * nodeIdxDim, &ni->nodeIdx));
6773f27d899SToby Isaac   /* first concatenate the indices */
6783f27d899SToby Isaac   for (l = 0, j = 0; j < fiberi->nNodes; j++) {
6793f27d899SToby Isaac     for (i = 0; i < tracei->nNodes; i++, l++) {
6803f27d899SToby Isaac       PetscInt m, n = 0;
6813f27d899SToby Isaac 
6823f27d899SToby Isaac       for (m = 0; m < tracei->nodeIdxDim; m++) ni->nodeIdx[l * nodeIdxDim + n++] = tracei->nodeIdx[i * tracei->nodeIdxDim + m];
6833f27d899SToby Isaac       for (m = 0; m < fiberi->nodeIdxDim; m++) ni->nodeIdx[l * nodeIdxDim + n++] = fiberi->nodeIdx[j * fiberi->nodeIdxDim + m];
6843f27d899SToby Isaac     }
6853f27d899SToby Isaac   }
6863f27d899SToby Isaac 
6873f27d899SToby Isaac   /* now wedge together the push-forward vectors */
688f4f49eeaSPierre Jolivet   PetscCall(PetscMalloc1(nNodes * Nk, &ni->nodeVec));
6899566063dSJacob Faibussowitsch   PetscCall(PetscCalloc2(dimT * dim, &projT, dimF * dim, &projF));
6903f27d899SToby Isaac   for (i = 0; i < dimT; i++) projT[i * (dim + 1)] = 1.;
6913f27d899SToby Isaac   for (i = 0; i < dimF; i++) projF[i * (dim + dimT + 1) + dimT] = 1.;
6929566063dSJacob Faibussowitsch   PetscCall(PetscMalloc2(MkT * NkT, &projTstar, MkF * NkF, &projFstar));
6939566063dSJacob Faibussowitsch   PetscCall(PetscDTAltVPullbackMatrix(dim, dimT, projT, kT, projTstar));
6949566063dSJacob Faibussowitsch   PetscCall(PetscDTAltVPullbackMatrix(dim, dimF, projF, kF, projFstar));
6959566063dSJacob Faibussowitsch   PetscCall(PetscMalloc6(MkT, &workT, MkT, &workT2, MkF, &workF, MkF, &workF2, Nk, &work, Nk, &work2));
6969566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(Nk * MkT, &wedgeMat));
6973f27d899SToby Isaac   sign = (PetscAbsInt(kT * kF) & 1) ? -1. : 1.;
6983f27d899SToby Isaac   for (l = 0, j = 0; j < fiberi->nNodes; j++) {
6993f27d899SToby Isaac     PetscInt d, e;
7003f27d899SToby Isaac 
7013f27d899SToby Isaac     /* push forward fiber k-form */
7023f27d899SToby Isaac     for (d = 0; d < MkF; d++) {
7033f27d899SToby Isaac       PetscReal val = 0.;
7043f27d899SToby Isaac       for (e = 0; e < NkF; e++) val += projFstar[d * NkF + e] * fiberi->nodeVec[j * NkF + e];
7053f27d899SToby Isaac       workF[d] = val;
7063f27d899SToby Isaac     }
7073f27d899SToby Isaac     /* Hodge star to proper form if necessary */
7083f27d899SToby Isaac     if (kF < 0) {
7093f27d899SToby Isaac       for (d = 0; d < MkF; d++) workF2[d] = workF[d];
7109566063dSJacob Faibussowitsch       PetscCall(PetscDTAltVStar(dim, PetscAbsInt(kF), 1, workF2, workF));
7113f27d899SToby Isaac     }
7123f27d899SToby Isaac     /* Compute the matrix that wedges this form with one of the trace k-form */
7139566063dSJacob Faibussowitsch     PetscCall(PetscDTAltVWedgeMatrix(dim, PetscAbsInt(kF), PetscAbsInt(kT), workF, wedgeMat));
7143f27d899SToby Isaac     for (i = 0; i < tracei->nNodes; i++, l++) {
7153f27d899SToby Isaac       /* push forward trace k-form */
7163f27d899SToby Isaac       for (d = 0; d < MkT; d++) {
7173f27d899SToby Isaac         PetscReal val = 0.;
7183f27d899SToby Isaac         for (e = 0; e < NkT; e++) val += projTstar[d * NkT + e] * tracei->nodeVec[i * NkT + e];
7193f27d899SToby Isaac         workT[d] = val;
7203f27d899SToby Isaac       }
7213f27d899SToby Isaac       /* Hodge star to proper form if necessary */
7223f27d899SToby Isaac       if (kT < 0) {
7233f27d899SToby Isaac         for (d = 0; d < MkT; d++) workT2[d] = workT[d];
7249566063dSJacob Faibussowitsch         PetscCall(PetscDTAltVStar(dim, PetscAbsInt(kT), 1, workT2, workT));
7253f27d899SToby Isaac       }
7263f27d899SToby Isaac       /* compute the wedge product of the push-forward trace form and firer forms */
7273f27d899SToby Isaac       for (d = 0; d < Nk; d++) {
7283f27d899SToby Isaac         PetscReal val = 0.;
7293f27d899SToby Isaac         for (e = 0; e < MkT; e++) val += wedgeMat[d * MkT + e] * workT[e];
7303f27d899SToby Isaac         work[d] = val;
7313f27d899SToby Isaac       }
7323f27d899SToby Isaac       /* inverse Hodge star from proper form if necessary */
7333f27d899SToby Isaac       if (formDegree < 0) {
7343f27d899SToby Isaac         for (d = 0; d < Nk; d++) work2[d] = work[d];
7359566063dSJacob Faibussowitsch         PetscCall(PetscDTAltVStar(dim, PetscAbsInt(formDegree), -1, work2, work));
7363f27d899SToby Isaac       }
7373f27d899SToby Isaac       /* insert into the array (adjusting for sign) */
7383f27d899SToby Isaac       for (d = 0; d < Nk; d++) ni->nodeVec[l * Nk + d] = sign * work[d];
7393f27d899SToby Isaac     }
7403f27d899SToby Isaac   }
7419566063dSJacob Faibussowitsch   PetscCall(PetscFree(wedgeMat));
7429566063dSJacob Faibussowitsch   PetscCall(PetscFree6(workT, workT2, workF, workF2, work, work2));
7439566063dSJacob Faibussowitsch   PetscCall(PetscFree2(projTstar, projFstar));
7449566063dSJacob Faibussowitsch   PetscCall(PetscFree2(projT, projF));
7453f27d899SToby Isaac   *nodeIndices = ni;
7463ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
7473f27d899SToby Isaac }
7483f27d899SToby Isaac 
74977f1a120SToby Isaac /* simple union of two sets of nodes */
PetscLagNodeIndicesMerge(PetscLagNodeIndices niA,PetscLagNodeIndices niB,PetscLagNodeIndices * nodeIndices)750d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesMerge(PetscLagNodeIndices niA, PetscLagNodeIndices niB, PetscLagNodeIndices *nodeIndices)
751d71ae5a4SJacob Faibussowitsch {
7523f27d899SToby Isaac   PetscLagNodeIndices ni;
7533f27d899SToby Isaac   PetscInt            nodeIdxDim, nodeVecDim, nNodes;
7543f27d899SToby Isaac 
7553f27d899SToby Isaac   PetscFunctionBegin;
7569566063dSJacob Faibussowitsch   PetscCall(PetscNew(&ni));
7573f27d899SToby Isaac   ni->nodeIdxDim = nodeIdxDim = niA->nodeIdxDim;
75808401ef6SPierre Jolivet   PetscCheck(niB->nodeIdxDim == nodeIdxDim, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cannot merge PetscLagNodeIndices with different nodeIdxDim");
7593f27d899SToby Isaac   ni->nodeVecDim = nodeVecDim = niA->nodeVecDim;
76008401ef6SPierre Jolivet   PetscCheck(niB->nodeVecDim == nodeVecDim, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cannot merge PetscLagNodeIndices with different nodeVecDim");
7613f27d899SToby Isaac   ni->nNodes = nNodes = niA->nNodes + niB->nNodes;
7623f27d899SToby Isaac   ni->refct           = 1;
763f4f49eeaSPierre Jolivet   PetscCall(PetscMalloc1(nNodes * nodeIdxDim, &ni->nodeIdx));
764f4f49eeaSPierre Jolivet   PetscCall(PetscMalloc1(nNodes * nodeVecDim, &ni->nodeVec));
7659566063dSJacob Faibussowitsch   PetscCall(PetscArraycpy(ni->nodeIdx, niA->nodeIdx, niA->nNodes * nodeIdxDim));
7669566063dSJacob Faibussowitsch   PetscCall(PetscArraycpy(ni->nodeVec, niA->nodeVec, niA->nNodes * nodeVecDim));
76757508eceSPierre Jolivet   PetscCall(PetscArraycpy(&ni->nodeIdx[niA->nNodes * nodeIdxDim], niB->nodeIdx, niB->nNodes * nodeIdxDim));
76857508eceSPierre Jolivet   PetscCall(PetscArraycpy(&ni->nodeVec[niA->nNodes * nodeVecDim], niB->nodeVec, niB->nNodes * nodeVecDim));
7693f27d899SToby Isaac   *nodeIndices = ni;
7703ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
7713f27d899SToby Isaac }
7723f27d899SToby Isaac 
7733f27d899SToby Isaac #define PETSCTUPINTCOMPREVLEX(N) \
774d71ae5a4SJacob Faibussowitsch   static int PetscConcat_(PetscTupIntCompRevlex_, N)(const void *a, const void *b) \
775d71ae5a4SJacob Faibussowitsch   { \
7763f27d899SToby Isaac     const PetscInt *A = (const PetscInt *)a; \
7773f27d899SToby Isaac     const PetscInt *B = (const PetscInt *)b; \
7783f27d899SToby Isaac     int             i; \
7793f27d899SToby Isaac     PetscInt        diff = 0; \
7803f27d899SToby Isaac     for (i = 0; i < N; i++) { \
7813f27d899SToby Isaac       diff = A[N - i] - B[N - i]; \
7823f27d899SToby Isaac       if (diff) break; \
7833f27d899SToby Isaac     } \
7843f27d899SToby Isaac     return (diff <= 0) ? (diff < 0) ? -1 : 0 : 1; \
7853f27d899SToby Isaac   }
7863f27d899SToby Isaac 
7873f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(3)
7883f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(4)
7893f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(5)
7903f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(6)
7913f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(7)
7923f27d899SToby Isaac 
PetscTupIntCompRevlex_N(const void * a,const void * b)793d71ae5a4SJacob Faibussowitsch static int PetscTupIntCompRevlex_N(const void *a, const void *b)
794d71ae5a4SJacob Faibussowitsch {
7953f27d899SToby Isaac   const PetscInt *A = (const PetscInt *)a;
7963f27d899SToby Isaac   const PetscInt *B = (const PetscInt *)b;
7976497c311SBarry Smith   PetscInt        i;
7986497c311SBarry Smith   PetscInt        N    = A[0];
7993f27d899SToby Isaac   PetscInt        diff = 0;
8003f27d899SToby Isaac   for (i = 0; i < N; i++) {
8013f27d899SToby Isaac     diff = A[N - i] - B[N - i];
8023f27d899SToby Isaac     if (diff) break;
8033f27d899SToby Isaac   }
8043f27d899SToby Isaac   return (diff <= 0) ? (diff < 0) ? -1 : 0 : 1;
8053f27d899SToby Isaac }
8063f27d899SToby Isaac 
80777f1a120SToby Isaac /* The nodes are not necessarily in revlex order wrt nodeIdx: get the permutation
80877f1a120SToby Isaac  * that puts them in that order */
PetscLagNodeIndicesGetPermutation(PetscLagNodeIndices ni,PetscInt * perm[])809d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesGetPermutation(PetscLagNodeIndices ni, PetscInt *perm[])
810d71ae5a4SJacob Faibussowitsch {
8113f27d899SToby Isaac   PetscFunctionBegin;
812f4f49eeaSPierre Jolivet   if (!ni->perm) {
8133f27d899SToby Isaac     PetscInt *sorter;
8143f27d899SToby Isaac     PetscInt  m          = ni->nNodes;
8153f27d899SToby Isaac     PetscInt  nodeIdxDim = ni->nodeIdxDim;
8163f27d899SToby Isaac     PetscInt  i, j, k, l;
8173f27d899SToby Isaac     PetscInt *prm;
8183f27d899SToby Isaac     int (*comp)(const void *, const void *);
8193f27d899SToby Isaac 
8209566063dSJacob Faibussowitsch     PetscCall(PetscMalloc1((nodeIdxDim + 2) * m, &sorter));
8213f27d899SToby Isaac     for (k = 0, l = 0, i = 0; i < m; i++) {
8223f27d899SToby Isaac       sorter[k++] = nodeIdxDim + 1;
8233f27d899SToby Isaac       sorter[k++] = i;
8243f27d899SToby Isaac       for (j = 0; j < nodeIdxDim; j++) sorter[k++] = ni->nodeIdx[l++];
8253f27d899SToby Isaac     }
8263f27d899SToby Isaac     switch (nodeIdxDim) {
827d71ae5a4SJacob Faibussowitsch     case 2:
828d71ae5a4SJacob Faibussowitsch       comp = PetscTupIntCompRevlex_3;
829d71ae5a4SJacob Faibussowitsch       break;
830d71ae5a4SJacob Faibussowitsch     case 3:
831d71ae5a4SJacob Faibussowitsch       comp = PetscTupIntCompRevlex_4;
832d71ae5a4SJacob Faibussowitsch       break;
833d71ae5a4SJacob Faibussowitsch     case 4:
834d71ae5a4SJacob Faibussowitsch       comp = PetscTupIntCompRevlex_5;
835d71ae5a4SJacob Faibussowitsch       break;
836d71ae5a4SJacob Faibussowitsch     case 5:
837d71ae5a4SJacob Faibussowitsch       comp = PetscTupIntCompRevlex_6;
838d71ae5a4SJacob Faibussowitsch       break;
839d71ae5a4SJacob Faibussowitsch     case 6:
840d71ae5a4SJacob Faibussowitsch       comp = PetscTupIntCompRevlex_7;
841d71ae5a4SJacob Faibussowitsch       break;
842d71ae5a4SJacob Faibussowitsch     default:
843d71ae5a4SJacob Faibussowitsch       comp = PetscTupIntCompRevlex_N;
844d71ae5a4SJacob Faibussowitsch       break;
8453f27d899SToby Isaac     }
8463f27d899SToby Isaac     qsort(sorter, m, (nodeIdxDim + 2) * sizeof(PetscInt), comp);
8479566063dSJacob Faibussowitsch     PetscCall(PetscMalloc1(m, &prm));
8483f27d899SToby Isaac     for (i = 0; i < m; i++) prm[i] = sorter[(nodeIdxDim + 2) * i + 1];
8493f27d899SToby Isaac     ni->perm = prm;
8509566063dSJacob Faibussowitsch     PetscCall(PetscFree(sorter));
8513f27d899SToby Isaac   }
8523f27d899SToby Isaac   *perm = ni->perm;
8533ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
8543f27d899SToby Isaac }
85520cf1dd8SToby Isaac 
PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp)856d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp)
857d71ae5a4SJacob Faibussowitsch {
85820cf1dd8SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
85920cf1dd8SToby Isaac 
86020cf1dd8SToby Isaac   PetscFunctionBegin;
8613f27d899SToby Isaac   if (lag->symperms) {
8623f27d899SToby Isaac     PetscInt **selfSyms = lag->symperms[0];
8636f905325SMatthew G. Knepley 
8646f905325SMatthew G. Knepley     if (selfSyms) {
8656f905325SMatthew G. Knepley       PetscInt i, **allocated = &selfSyms[-lag->selfSymOff];
8666f905325SMatthew G. Knepley 
86748a46eb9SPierre Jolivet       for (i = 0; i < lag->numSelfSym; i++) PetscCall(PetscFree(allocated[i]));
8689566063dSJacob Faibussowitsch       PetscCall(PetscFree(allocated));
8696f905325SMatthew G. Knepley     }
8709566063dSJacob Faibussowitsch     PetscCall(PetscFree(lag->symperms));
8716f905325SMatthew G. Knepley   }
8723f27d899SToby Isaac   if (lag->symflips) {
8733f27d899SToby Isaac     PetscScalar **selfSyms = lag->symflips[0];
8743f27d899SToby Isaac 
8753f27d899SToby Isaac     if (selfSyms) {
8763f27d899SToby Isaac       PetscInt      i;
8773f27d899SToby Isaac       PetscScalar **allocated = &selfSyms[-lag->selfSymOff];
8783f27d899SToby Isaac 
87948a46eb9SPierre Jolivet       for (i = 0; i < lag->numSelfSym; i++) PetscCall(PetscFree(allocated[i]));
8809566063dSJacob Faibussowitsch       PetscCall(PetscFree(allocated));
8813f27d899SToby Isaac     }
8829566063dSJacob Faibussowitsch     PetscCall(PetscFree(lag->symflips));
8833f27d899SToby Isaac   }
884f4f49eeaSPierre Jolivet   PetscCall(Petsc1DNodeFamilyDestroy(&lag->nodeFamily));
885f4f49eeaSPierre Jolivet   PetscCall(PetscLagNodeIndicesDestroy(&lag->vertIndices));
886f4f49eeaSPierre Jolivet   PetscCall(PetscLagNodeIndicesDestroy(&lag->intNodeIndices));
887f4f49eeaSPierre Jolivet   PetscCall(PetscLagNodeIndicesDestroy(&lag->allNodeIndices));
8889566063dSJacob Faibussowitsch   PetscCall(PetscFree(lag));
8899566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetContinuity_C", NULL));
8909566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetContinuity_C", NULL));
8919566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetTensor_C", NULL));
8929566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetTensor_C", NULL));
8939566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetTrimmed_C", NULL));
8949566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetTrimmed_C", NULL));
8959566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetNodeType_C", NULL));
8969566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetNodeType_C", NULL));
8979566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetUseMoments_C", NULL));
8989566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetUseMoments_C", NULL));
8999566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetMomentOrder_C", NULL));
9009566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetMomentOrder_C", NULL));
9013ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
90220cf1dd8SToby Isaac }
90320cf1dd8SToby Isaac 
PetscDualSpaceLagrangeView_Ascii(PetscDualSpace sp,PetscViewer viewer)904d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeView_Ascii(PetscDualSpace sp, PetscViewer viewer)
905d71ae5a4SJacob Faibussowitsch {
90620cf1dd8SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
90720cf1dd8SToby Isaac 
90820cf1dd8SToby Isaac   PetscFunctionBegin;
9099566063dSJacob Faibussowitsch   PetscCall(PetscViewerASCIIPrintf(viewer, "%s %s%sLagrange dual space\n", lag->continuous ? "Continuous" : "Discontinuous", lag->tensorSpace ? "tensor " : "", lag->trimmed ? "trimmed " : ""));
9103ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
91120cf1dd8SToby Isaac }
91220cf1dd8SToby Isaac 
PetscDualSpaceView_Lagrange(PetscDualSpace sp,PetscViewer viewer)913d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceView_Lagrange(PetscDualSpace sp, PetscViewer viewer)
914d71ae5a4SJacob Faibussowitsch {
915*9f196a02SMartin Diehl   PetscBool isascii;
9166f905325SMatthew G. Knepley 
91720cf1dd8SToby Isaac   PetscFunctionBegin;
9186f905325SMatthew G. Knepley   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
9196f905325SMatthew G. Knepley   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
920*9f196a02SMartin Diehl   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &isascii));
921*9f196a02SMartin Diehl   if (isascii) PetscCall(PetscDualSpaceLagrangeView_Ascii(sp, viewer));
9223ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
92320cf1dd8SToby Isaac }
92420cf1dd8SToby Isaac 
PetscDualSpaceSetFromOptions_Lagrange(PetscDualSpace sp,PetscOptionItems PetscOptionsObject)925ce78bad3SBarry Smith static PetscErrorCode PetscDualSpaceSetFromOptions_Lagrange(PetscDualSpace sp, PetscOptionItems PetscOptionsObject)
926d71ae5a4SJacob Faibussowitsch {
9273f27d899SToby Isaac   PetscBool       continuous, tensor, trimmed, flg, flg2, flg3;
9283f27d899SToby Isaac   PetscDTNodeType nodeType;
9293f27d899SToby Isaac   PetscReal       nodeExponent;
93066a6c23cSMatthew G. Knepley   PetscInt        momentOrder;
93166a6c23cSMatthew G. Knepley   PetscBool       nodeEndpoints, useMoments;
9326f905325SMatthew G. Knepley 
9336f905325SMatthew G. Knepley   PetscFunctionBegin;
9349566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeGetContinuity(sp, &continuous));
9359566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeGetTensor(sp, &tensor));
9369566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeGetTrimmed(sp, &trimmed));
9379566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeGetNodeType(sp, &nodeType, &nodeEndpoints, &nodeExponent));
9383f27d899SToby Isaac   if (nodeType == PETSCDTNODES_DEFAULT) nodeType = PETSCDTNODES_GAUSSJACOBI;
9399566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeGetUseMoments(sp, &useMoments));
9409566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeGetMomentOrder(sp, &momentOrder));
941d0609cedSBarry Smith   PetscOptionsHeadBegin(PetscOptionsObject, "PetscDualSpace Lagrange Options");
9429566063dSJacob Faibussowitsch   PetscCall(PetscOptionsBool("-petscdualspace_lagrange_continuity", "Flag for continuous element", "PetscDualSpaceLagrangeSetContinuity", continuous, &continuous, &flg));
9439566063dSJacob Faibussowitsch   if (flg) PetscCall(PetscDualSpaceLagrangeSetContinuity(sp, continuous));
9449566063dSJacob Faibussowitsch   PetscCall(PetscOptionsBool("-petscdualspace_lagrange_tensor", "Flag for tensor dual space", "PetscDualSpaceLagrangeSetTensor", tensor, &tensor, &flg));
9459566063dSJacob Faibussowitsch   if (flg) PetscCall(PetscDualSpaceLagrangeSetTensor(sp, tensor));
9469566063dSJacob Faibussowitsch   PetscCall(PetscOptionsBool("-petscdualspace_lagrange_trimmed", "Flag for trimmed dual space", "PetscDualSpaceLagrangeSetTrimmed", trimmed, &trimmed, &flg));
9479566063dSJacob Faibussowitsch   if (flg) PetscCall(PetscDualSpaceLagrangeSetTrimmed(sp, trimmed));
9489566063dSJacob Faibussowitsch   PetscCall(PetscOptionsEnum("-petscdualspace_lagrange_node_type", "Lagrange node location type", "PetscDualSpaceLagrangeSetNodeType", PetscDTNodeTypes, (PetscEnum)nodeType, (PetscEnum *)&nodeType, &flg));
9499566063dSJacob Faibussowitsch   PetscCall(PetscOptionsBool("-petscdualspace_lagrange_node_endpoints", "Flag for nodes that include endpoints", "PetscDualSpaceLagrangeSetNodeType", nodeEndpoints, &nodeEndpoints, &flg2));
9503f27d899SToby Isaac   flg3 = PETSC_FALSE;
95148a46eb9SPierre Jolivet   if (nodeType == PETSCDTNODES_GAUSSJACOBI) PetscCall(PetscOptionsReal("-petscdualspace_lagrange_node_exponent", "Gauss-Jacobi weight function exponent", "PetscDualSpaceLagrangeSetNodeType", nodeExponent, &nodeExponent, &flg3));
9529566063dSJacob Faibussowitsch   if (flg || flg2 || flg3) PetscCall(PetscDualSpaceLagrangeSetNodeType(sp, nodeType, nodeEndpoints, nodeExponent));
9539566063dSJacob Faibussowitsch   PetscCall(PetscOptionsBool("-petscdualspace_lagrange_use_moments", "Use moments (where appropriate) for functionals", "PetscDualSpaceLagrangeSetUseMoments", useMoments, &useMoments, &flg));
9549566063dSJacob Faibussowitsch   if (flg) PetscCall(PetscDualSpaceLagrangeSetUseMoments(sp, useMoments));
9559566063dSJacob Faibussowitsch   PetscCall(PetscOptionsInt("-petscdualspace_lagrange_moment_order", "Quadrature order for moment functionals", "PetscDualSpaceLagrangeSetMomentOrder", momentOrder, &momentOrder, &flg));
9569566063dSJacob Faibussowitsch   if (flg) PetscCall(PetscDualSpaceLagrangeSetMomentOrder(sp, momentOrder));
957d0609cedSBarry Smith   PetscOptionsHeadEnd();
9583ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
9596f905325SMatthew G. Knepley }
9606f905325SMatthew G. Knepley 
PetscDualSpaceDuplicate_Lagrange(PetscDualSpace sp,PetscDualSpace spNew)961d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceDuplicate_Lagrange(PetscDualSpace sp, PetscDualSpace spNew)
962d71ae5a4SJacob Faibussowitsch {
9633797e9adSStefano Zampini   PetscBool           cont, tensor, trimmed, boundary, mom;
9643f27d899SToby Isaac   PetscDTNodeType     nodeType;
9653f27d899SToby Isaac   PetscReal           exponent;
9663797e9adSStefano Zampini   PetscInt            n;
9673f27d899SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
9686f905325SMatthew G. Knepley 
9696f905325SMatthew G. Knepley   PetscFunctionBegin;
9709566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeGetContinuity(sp, &cont));
9719566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeSetContinuity(spNew, cont));
9729566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeGetTensor(sp, &tensor));
9739566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeSetTensor(spNew, tensor));
9749566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeGetTrimmed(sp, &trimmed));
9759566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeSetTrimmed(spNew, trimmed));
9769566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeGetNodeType(sp, &nodeType, &boundary, &exponent));
9779566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeSetNodeType(spNew, nodeType, boundary, exponent));
9783f27d899SToby Isaac   if (lag->nodeFamily) {
9793f27d899SToby Isaac     PetscDualSpace_Lag *lagnew = (PetscDualSpace_Lag *)spNew->data;
9803f27d899SToby Isaac 
9819566063dSJacob Faibussowitsch     PetscCall(Petsc1DNodeFamilyReference(lag->nodeFamily));
9823f27d899SToby Isaac     lagnew->nodeFamily = lag->nodeFamily;
9833f27d899SToby Isaac   }
9843797e9adSStefano Zampini   PetscCall(PetscDualSpaceLagrangeGetUseMoments(sp, &mom));
9853797e9adSStefano Zampini   PetscCall(PetscDualSpaceLagrangeSetUseMoments(spNew, mom));
9863797e9adSStefano Zampini   PetscCall(PetscDualSpaceLagrangeGetMomentOrder(sp, &n));
9873797e9adSStefano Zampini   PetscCall(PetscDualSpaceLagrangeSetMomentOrder(spNew, n));
9883ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
9896f905325SMatthew G. Knepley }
9906f905325SMatthew G. Knepley 
99177f1a120SToby Isaac /* for making tensor product spaces: take a dual space and product a segment space that has all the same
99277f1a120SToby Isaac  * 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)993d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceCreateEdgeSubspace_Lagrange(PetscDualSpace sp, PetscInt order, PetscInt k, PetscInt Nc, PetscBool interiorOnly, PetscDualSpace *bdsp)
994d71ae5a4SJacob Faibussowitsch {
9953f27d899SToby Isaac   DM                  K;
9963f27d899SToby Isaac   PetscDualSpace_Lag *newlag;
9976f905325SMatthew G. Knepley 
9986f905325SMatthew G. Knepley   PetscFunctionBegin;
9999566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceDuplicate(sp, bdsp));
10009566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceSetFormDegree(*bdsp, k));
10019566063dSJacob Faibussowitsch   PetscCall(DMPlexCreateReferenceCell(PETSC_COMM_SELF, DMPolytopeTypeSimpleShape(1, PETSC_TRUE), &K));
10029566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceSetDM(*bdsp, K));
10039566063dSJacob Faibussowitsch   PetscCall(DMDestroy(&K));
10049566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceSetOrder(*bdsp, order));
10059566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceSetNumComponents(*bdsp, Nc));
10063f27d899SToby Isaac   newlag               = (PetscDualSpace_Lag *)(*bdsp)->data;
10073f27d899SToby Isaac   newlag->interiorOnly = interiorOnly;
10089566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceSetUp(*bdsp));
10093ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
10106f905325SMatthew G. Knepley }
10113f27d899SToby Isaac 
10123f27d899SToby Isaac /* just the points, weights aren't handled */
PetscQuadratureCreateTensor(PetscQuadrature trace,PetscQuadrature fiber,PetscQuadrature * product)1013d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscQuadratureCreateTensor(PetscQuadrature trace, PetscQuadrature fiber, PetscQuadrature *product)
1014d71ae5a4SJacob Faibussowitsch {
10153f27d899SToby Isaac   PetscInt         dimTrace, dimFiber;
10163f27d899SToby Isaac   PetscInt         numPointsTrace, numPointsFiber;
10173f27d899SToby Isaac   PetscInt         dim, numPoints;
10183f27d899SToby Isaac   const PetscReal *pointsTrace;
10193f27d899SToby Isaac   const PetscReal *pointsFiber;
10203f27d899SToby Isaac   PetscReal       *points;
10213f27d899SToby Isaac   PetscInt         i, j, k, p;
10223f27d899SToby Isaac 
10233f27d899SToby Isaac   PetscFunctionBegin;
10249566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureGetData(trace, &dimTrace, NULL, &numPointsTrace, &pointsTrace, NULL));
10259566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureGetData(fiber, &dimFiber, NULL, &numPointsFiber, &pointsFiber, NULL));
10263f27d899SToby Isaac   dim       = dimTrace + dimFiber;
10273f27d899SToby Isaac   numPoints = numPointsFiber * numPointsTrace;
10289566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(numPoints * dim, &points));
10293f27d899SToby Isaac   for (p = 0, j = 0; j < numPointsFiber; j++) {
10303f27d899SToby Isaac     for (i = 0; i < numPointsTrace; i++, p++) {
10313f27d899SToby Isaac       for (k = 0; k < dimTrace; k++) points[p * dim + k] = pointsTrace[i * dimTrace + k];
10323f27d899SToby Isaac       for (k = 0; k < dimFiber; k++) points[p * dim + dimTrace + k] = pointsFiber[j * dimFiber + k];
10333f27d899SToby Isaac     }
10343f27d899SToby Isaac   }
10359566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, product));
10369566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureSetData(*product, dim, 0, numPoints, points, NULL));
10373ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
10383f27d899SToby Isaac }
10393f27d899SToby Isaac 
104077f1a120SToby Isaac /* Kronecker tensor product where matrix is considered a matrix of k-forms, so that
104177f1a120SToby Isaac  * 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)1042d71ae5a4SJacob Faibussowitsch static PetscErrorCode MatTensorAltV(Mat trace, Mat fiber, PetscInt dimTrace, PetscInt kTrace, PetscInt dimFiber, PetscInt kFiber, Mat *product)
1043d71ae5a4SJacob Faibussowitsch {
10443f27d899SToby Isaac   PetscInt     mTrace, nTrace, mFiber, nFiber, m, n, k, i, j, l;
10453f27d899SToby Isaac   PetscInt     dim, NkTrace, NkFiber, Nk;
10463f27d899SToby Isaac   PetscInt     dT, dF;
10473f27d899SToby Isaac   PetscInt    *nnzTrace, *nnzFiber, *nnz;
10483f27d899SToby Isaac   PetscInt     iT, iF, jT, jF, il, jl;
10493f27d899SToby Isaac   PetscReal   *workT, *workT2, *workF, *workF2, *work, *workstar;
10503f27d899SToby Isaac   PetscReal   *projT, *projF;
10513f27d899SToby Isaac   PetscReal   *projTstar, *projFstar;
10523f27d899SToby Isaac   PetscReal   *wedgeMat;
10533f27d899SToby Isaac   PetscReal    sign;
10543f27d899SToby Isaac   PetscScalar *workS;
10553f27d899SToby Isaac   Mat          prod;
10563f27d899SToby Isaac   /* this produces dof groups that look like the identity */
10573f27d899SToby Isaac 
10583f27d899SToby Isaac   PetscFunctionBegin;
10599566063dSJacob Faibussowitsch   PetscCall(MatGetSize(trace, &mTrace, &nTrace));
10609566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dimTrace, PetscAbsInt(kTrace), &NkTrace));
106108401ef6SPierre Jolivet   PetscCheck(nTrace % NkTrace == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "point value space of trace matrix is not a multiple of k-form size");
10629566063dSJacob Faibussowitsch   PetscCall(MatGetSize(fiber, &mFiber, &nFiber));
10639566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dimFiber, PetscAbsInt(kFiber), &NkFiber));
106408401ef6SPierre Jolivet   PetscCheck(nFiber % NkFiber == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "point value space of fiber matrix is not a multiple of k-form size");
10659566063dSJacob Faibussowitsch   PetscCall(PetscMalloc2(mTrace, &nnzTrace, mFiber, &nnzFiber));
10663f27d899SToby Isaac   for (i = 0; i < mTrace; i++) {
1067f4f49eeaSPierre Jolivet     PetscCall(MatGetRow(trace, i, &nnzTrace[i], NULL, NULL));
106808401ef6SPierre Jolivet     PetscCheck(nnzTrace[i] % NkTrace == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in trace matrix are not in k-form size blocks");
10693f27d899SToby Isaac   }
10703f27d899SToby Isaac   for (i = 0; i < mFiber; i++) {
1071f4f49eeaSPierre Jolivet     PetscCall(MatGetRow(fiber, i, &nnzFiber[i], NULL, NULL));
107208401ef6SPierre Jolivet     PetscCheck(nnzFiber[i] % NkFiber == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in fiber matrix are not in k-form size blocks");
10733f27d899SToby Isaac   }
10743f27d899SToby Isaac   dim = dimTrace + dimFiber;
10753f27d899SToby Isaac   k   = kFiber + kTrace;
10769566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk));
10773f27d899SToby Isaac   m = mTrace * mFiber;
10789566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(m, &nnz));
10799371c9d4SSatish Balay   for (l = 0, j = 0; j < mFiber; j++)
10809371c9d4SSatish Balay     for (i = 0; i < mTrace; i++, l++) nnz[l] = (nnzTrace[i] / NkTrace) * (nnzFiber[j] / NkFiber) * Nk;
10813f27d899SToby Isaac   n = (nTrace / NkTrace) * (nFiber / NkFiber) * Nk;
10829566063dSJacob Faibussowitsch   PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, m, n, 0, nnz, &prod));
1083a243090dSMatthew G. Knepley   PetscCall(PetscObjectSetOptionsPrefix((PetscObject)prod, "altv_"));
10849566063dSJacob Faibussowitsch   PetscCall(PetscFree(nnz));
10859566063dSJacob Faibussowitsch   PetscCall(PetscFree2(nnzTrace, nnzFiber));
10863f27d899SToby Isaac   /* reasoning about which points each dof needs depends on having zeros computed at points preserved */
10879566063dSJacob Faibussowitsch   PetscCall(MatSetOption(prod, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
10883f27d899SToby Isaac   /* compute pullbacks */
10899566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(kTrace), &dT));
10909566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(kFiber), &dF));
10919566063dSJacob Faibussowitsch   PetscCall(PetscMalloc4(dimTrace * dim, &projT, dimFiber * dim, &projF, dT * NkTrace, &projTstar, dF * NkFiber, &projFstar));
10929566063dSJacob Faibussowitsch   PetscCall(PetscArrayzero(projT, dimTrace * dim));
10933f27d899SToby Isaac   for (i = 0; i < dimTrace; i++) projT[i * (dim + 1)] = 1.;
10949566063dSJacob Faibussowitsch   PetscCall(PetscArrayzero(projF, dimFiber * dim));
10953f27d899SToby Isaac   for (i = 0; i < dimFiber; i++) projF[i * (dim + 1) + dimTrace] = 1.;
10969566063dSJacob Faibussowitsch   PetscCall(PetscDTAltVPullbackMatrix(dim, dimTrace, projT, kTrace, projTstar));
10979566063dSJacob Faibussowitsch   PetscCall(PetscDTAltVPullbackMatrix(dim, dimFiber, projF, kFiber, projFstar));
10989566063dSJacob Faibussowitsch   PetscCall(PetscMalloc5(dT, &workT, dF, &workF, Nk, &work, Nk, &workstar, Nk, &workS));
10999566063dSJacob Faibussowitsch   PetscCall(PetscMalloc2(dT, &workT2, dF, &workF2));
11009566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(Nk * dT, &wedgeMat));
11013f27d899SToby Isaac   sign = (PetscAbsInt(kTrace * kFiber) & 1) ? -1. : 1.;
11023f27d899SToby Isaac   for (i = 0, iF = 0; iF < mFiber; iF++) {
11033f27d899SToby Isaac     PetscInt           ncolsF, nformsF;
11043f27d899SToby Isaac     const PetscInt    *colsF;
11053f27d899SToby Isaac     const PetscScalar *valsF;
11063f27d899SToby Isaac 
11079566063dSJacob Faibussowitsch     PetscCall(MatGetRow(fiber, iF, &ncolsF, &colsF, &valsF));
11083f27d899SToby Isaac     nformsF = ncolsF / NkFiber;
11093f27d899SToby Isaac     for (iT = 0; iT < mTrace; iT++, i++) {
11103f27d899SToby Isaac       PetscInt           ncolsT, nformsT;
11113f27d899SToby Isaac       const PetscInt    *colsT;
11123f27d899SToby Isaac       const PetscScalar *valsT;
11133f27d899SToby Isaac 
11149566063dSJacob Faibussowitsch       PetscCall(MatGetRow(trace, iT, &ncolsT, &colsT, &valsT));
11153f27d899SToby Isaac       nformsT = ncolsT / NkTrace;
11163f27d899SToby Isaac       for (j = 0, jF = 0; jF < nformsF; jF++) {
11173f27d899SToby Isaac         PetscInt colF = colsF[jF * NkFiber] / NkFiber;
11183f27d899SToby Isaac 
11193f27d899SToby Isaac         for (il = 0; il < dF; il++) {
11203f27d899SToby Isaac           PetscReal val = 0.;
11213f27d899SToby Isaac           for (jl = 0; jl < NkFiber; jl++) val += projFstar[il * NkFiber + jl] * PetscRealPart(valsF[jF * NkFiber + jl]);
11223f27d899SToby Isaac           workF[il] = val;
11233f27d899SToby Isaac         }
11243f27d899SToby Isaac         if (kFiber < 0) {
11253f27d899SToby Isaac           for (il = 0; il < dF; il++) workF2[il] = workF[il];
11269566063dSJacob Faibussowitsch           PetscCall(PetscDTAltVStar(dim, PetscAbsInt(kFiber), 1, workF2, workF));
11273f27d899SToby Isaac         }
11289566063dSJacob Faibussowitsch         PetscCall(PetscDTAltVWedgeMatrix(dim, PetscAbsInt(kFiber), PetscAbsInt(kTrace), workF, wedgeMat));
11293f27d899SToby Isaac         for (jT = 0; jT < nformsT; jT++, j++) {
11303f27d899SToby Isaac           PetscInt           colT = colsT[jT * NkTrace] / NkTrace;
11313f27d899SToby Isaac           PetscInt           col  = colF * (nTrace / NkTrace) + colT;
11323f27d899SToby Isaac           const PetscScalar *vals;
11333f27d899SToby Isaac 
11343f27d899SToby Isaac           for (il = 0; il < dT; il++) {
11353f27d899SToby Isaac             PetscReal val = 0.;
11363f27d899SToby Isaac             for (jl = 0; jl < NkTrace; jl++) val += projTstar[il * NkTrace + jl] * PetscRealPart(valsT[jT * NkTrace + jl]);
11373f27d899SToby Isaac             workT[il] = val;
11383f27d899SToby Isaac           }
11393f27d899SToby Isaac           if (kTrace < 0) {
11403f27d899SToby Isaac             for (il = 0; il < dT; il++) workT2[il] = workT[il];
11419566063dSJacob Faibussowitsch             PetscCall(PetscDTAltVStar(dim, PetscAbsInt(kTrace), 1, workT2, workT));
11423f27d899SToby Isaac           }
11433f27d899SToby Isaac 
11443f27d899SToby Isaac           for (il = 0; il < Nk; il++) {
11453f27d899SToby Isaac             PetscReal val = 0.;
11463f27d899SToby Isaac             for (jl = 0; jl < dT; jl++) val += sign * wedgeMat[il * dT + jl] * workT[jl];
11473f27d899SToby Isaac             work[il] = val;
11483f27d899SToby Isaac           }
11493f27d899SToby Isaac           if (k < 0) {
11509566063dSJacob Faibussowitsch             PetscCall(PetscDTAltVStar(dim, PetscAbsInt(k), -1, work, workstar));
11513f27d899SToby Isaac #if defined(PETSC_USE_COMPLEX)
11523f27d899SToby Isaac             for (l = 0; l < Nk; l++) workS[l] = workstar[l];
11533f27d899SToby Isaac             vals = &workS[0];
11543f27d899SToby Isaac #else
11553f27d899SToby Isaac             vals = &workstar[0];
11563f27d899SToby Isaac #endif
11573f27d899SToby Isaac           } else {
11583f27d899SToby Isaac #if defined(PETSC_USE_COMPLEX)
11593f27d899SToby Isaac             for (l = 0; l < Nk; l++) workS[l] = work[l];
11603f27d899SToby Isaac             vals = &workS[0];
11613f27d899SToby Isaac #else
11623f27d899SToby Isaac             vals = &work[0];
11633f27d899SToby Isaac #endif
11643f27d899SToby Isaac           }
116548a46eb9SPierre Jolivet           for (l = 0; l < Nk; l++) PetscCall(MatSetValue(prod, i, col * Nk + l, vals[l], INSERT_VALUES)); /* Nk */
11663f27d899SToby Isaac         } /* jT */
11673f27d899SToby Isaac       } /* jF */
11689566063dSJacob Faibussowitsch       PetscCall(MatRestoreRow(trace, iT, &ncolsT, &colsT, &valsT));
11693f27d899SToby Isaac     } /* iT */
11709566063dSJacob Faibussowitsch     PetscCall(MatRestoreRow(fiber, iF, &ncolsF, &colsF, &valsF));
11713f27d899SToby Isaac   } /* iF */
11729566063dSJacob Faibussowitsch   PetscCall(PetscFree(wedgeMat));
11739566063dSJacob Faibussowitsch   PetscCall(PetscFree4(projT, projF, projTstar, projFstar));
11749566063dSJacob Faibussowitsch   PetscCall(PetscFree2(workT2, workF2));
11759566063dSJacob Faibussowitsch   PetscCall(PetscFree5(workT, workF, work, workstar, workS));
11769566063dSJacob Faibussowitsch   PetscCall(MatAssemblyBegin(prod, MAT_FINAL_ASSEMBLY));
11779566063dSJacob Faibussowitsch   PetscCall(MatAssemblyEnd(prod, MAT_FINAL_ASSEMBLY));
11783f27d899SToby Isaac   *product = prod;
11793ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
11803f27d899SToby Isaac }
11813f27d899SToby Isaac 
1182aaa8cc7dSPierre Jolivet /* 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[])1183d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscQuadraturePointsMerge(PetscQuadrature quadA, PetscQuadrature quadB, PetscQuadrature *quadJoint, PetscInt *aToJoint[], PetscInt *bToJoint[])
1184d71ae5a4SJacob Faibussowitsch {
11853f27d899SToby Isaac   PetscInt         dimA, dimB;
11863f27d899SToby Isaac   PetscInt         nA, nB, nJoint, i, j, d;
11873f27d899SToby Isaac   const PetscReal *pointsA;
11883f27d899SToby Isaac   const PetscReal *pointsB;
11893f27d899SToby Isaac   PetscReal       *pointsJoint;
11903f27d899SToby Isaac   PetscInt        *aToJ, *bToJ;
11913f27d899SToby Isaac   PetscQuadrature  qJ;
11923f27d899SToby Isaac 
11933f27d899SToby Isaac   PetscFunctionBegin;
11949566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureGetData(quadA, &dimA, NULL, &nA, &pointsA, NULL));
11959566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureGetData(quadB, &dimB, NULL, &nB, &pointsB, NULL));
119608401ef6SPierre Jolivet   PetscCheck(dimA == dimB, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Quadrature points must be in the same dimension");
11973f27d899SToby Isaac   nJoint = nA;
11989566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(nA, &aToJ));
11993f27d899SToby Isaac   for (i = 0; i < nA; i++) aToJ[i] = i;
12009566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(nB, &bToJ));
12013f27d899SToby Isaac   for (i = 0; i < nB; i++) {
12023f27d899SToby Isaac     for (j = 0; j < nA; j++) {
12033f27d899SToby Isaac       bToJ[i] = -1;
12049371c9d4SSatish Balay       for (d = 0; d < dimA; d++)
12059371c9d4SSatish Balay         if (PetscAbsReal(pointsB[i * dimA + d] - pointsA[j * dimA + d]) > PETSC_SMALL) break;
12063f27d899SToby Isaac       if (d == dimA) {
12073f27d899SToby Isaac         bToJ[i] = j;
12083f27d899SToby Isaac         break;
12093f27d899SToby Isaac       }
12103f27d899SToby Isaac     }
1211ad540459SPierre Jolivet     if (bToJ[i] == -1) bToJ[i] = nJoint++;
12123f27d899SToby Isaac   }
12133f27d899SToby Isaac   *aToJoint = aToJ;
12143f27d899SToby Isaac   *bToJoint = bToJ;
12159566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(nJoint * dimA, &pointsJoint));
12169566063dSJacob Faibussowitsch   PetscCall(PetscArraycpy(pointsJoint, pointsA, nA * dimA));
12173f27d899SToby Isaac   for (i = 0; i < nB; i++) {
12183f27d899SToby Isaac     if (bToJ[i] >= nA) {
12193f27d899SToby Isaac       for (d = 0; d < dimA; d++) pointsJoint[bToJ[i] * dimA + d] = pointsB[i * dimA + d];
12203f27d899SToby Isaac     }
12213f27d899SToby Isaac   }
12229566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, &qJ));
12239566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureSetData(qJ, dimA, 0, nJoint, pointsJoint, NULL));
12243f27d899SToby Isaac   *quadJoint = qJ;
12253ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
12263f27d899SToby Isaac }
12273f27d899SToby Isaac 
122877f1a120SToby Isaac /* Matrices matA and matB are both quadrature -> dof matrices: produce a matrix that is joint quadrature -> union of
122977f1a120SToby Isaac  * 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)1230d71ae5a4SJacob Faibussowitsch static PetscErrorCode MatricesMerge(Mat matA, Mat matB, PetscInt dim, PetscInt k, PetscInt numMerged, const PetscInt aToMerged[], const PetscInt bToMerged[], Mat *matMerged)
1231d71ae5a4SJacob Faibussowitsch {
12323f27d899SToby Isaac   PetscInt  m, n, mA, nA, mB, nB, Nk, i, j, l;
12333f27d899SToby Isaac   Mat       M;
12343f27d899SToby Isaac   PetscInt *nnz;
12353f27d899SToby Isaac   PetscInt  maxnnz;
12363f27d899SToby Isaac   PetscInt *work;
12373f27d899SToby Isaac 
12383f27d899SToby Isaac   PetscFunctionBegin;
12399566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk));
12409566063dSJacob Faibussowitsch   PetscCall(MatGetSize(matA, &mA, &nA));
124108401ef6SPierre Jolivet   PetscCheck(nA % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "matA column space not a multiple of k-form size");
12429566063dSJacob Faibussowitsch   PetscCall(MatGetSize(matB, &mB, &nB));
124308401ef6SPierre Jolivet   PetscCheck(nB % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "matB column space not a multiple of k-form size");
12443f27d899SToby Isaac   m = mA + mB;
12453f27d899SToby Isaac   n = numMerged * Nk;
12469566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(m, &nnz));
12473f27d899SToby Isaac   maxnnz = 0;
12483f27d899SToby Isaac   for (i = 0; i < mA; i++) {
1249f4f49eeaSPierre Jolivet     PetscCall(MatGetRow(matA, i, &nnz[i], NULL, NULL));
125008401ef6SPierre Jolivet     PetscCheck(nnz[i] % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in matA are not in k-form size blocks");
12513f27d899SToby Isaac     maxnnz = PetscMax(maxnnz, nnz[i]);
12523f27d899SToby Isaac   }
12533f27d899SToby Isaac   for (i = 0; i < mB; i++) {
1254f4f49eeaSPierre Jolivet     PetscCall(MatGetRow(matB, i, &nnz[i + mA], NULL, NULL));
125508401ef6SPierre Jolivet     PetscCheck(nnz[i + mA] % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in matB are not in k-form size blocks");
12563f27d899SToby Isaac     maxnnz = PetscMax(maxnnz, nnz[i + mA]);
12573f27d899SToby Isaac   }
12589566063dSJacob Faibussowitsch   PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, m, n, 0, nnz, &M));
1259a243090dSMatthew G. Knepley   PetscCall(PetscObjectSetOptionsPrefix((PetscObject)M, "altv_"));
12609566063dSJacob Faibussowitsch   PetscCall(PetscFree(nnz));
12613f27d899SToby Isaac   /* reasoning about which points each dof needs depends on having zeros computed at points preserved */
12629566063dSJacob Faibussowitsch   PetscCall(MatSetOption(M, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
12639566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(maxnnz, &work));
12643f27d899SToby Isaac   for (i = 0; i < mA; i++) {
12653f27d899SToby Isaac     const PetscInt    *cols;
12663f27d899SToby Isaac     const PetscScalar *vals;
12673f27d899SToby Isaac     PetscInt           nCols;
12689566063dSJacob Faibussowitsch     PetscCall(MatGetRow(matA, i, &nCols, &cols, &vals));
12693f27d899SToby Isaac     for (j = 0; j < nCols / Nk; j++) {
12703f27d899SToby Isaac       PetscInt newCol = aToMerged[cols[j * Nk] / Nk];
12713f27d899SToby Isaac       for (l = 0; l < Nk; l++) work[j * Nk + l] = newCol * Nk + l;
12723f27d899SToby Isaac     }
12739566063dSJacob Faibussowitsch     PetscCall(MatSetValuesBlocked(M, 1, &i, nCols, work, vals, INSERT_VALUES));
12749566063dSJacob Faibussowitsch     PetscCall(MatRestoreRow(matA, i, &nCols, &cols, &vals));
12753f27d899SToby Isaac   }
12763f27d899SToby Isaac   for (i = 0; i < mB; i++) {
12773f27d899SToby Isaac     const PetscInt    *cols;
12783f27d899SToby Isaac     const PetscScalar *vals;
12793f27d899SToby Isaac 
12803f27d899SToby Isaac     PetscInt row = i + mA;
12813f27d899SToby Isaac     PetscInt nCols;
12829566063dSJacob Faibussowitsch     PetscCall(MatGetRow(matB, i, &nCols, &cols, &vals));
12833f27d899SToby Isaac     for (j = 0; j < nCols / Nk; j++) {
12843f27d899SToby Isaac       PetscInt newCol = bToMerged[cols[j * Nk] / Nk];
12853f27d899SToby Isaac       for (l = 0; l < Nk; l++) work[j * Nk + l] = newCol * Nk + l;
12863f27d899SToby Isaac     }
12879566063dSJacob Faibussowitsch     PetscCall(MatSetValuesBlocked(M, 1, &row, nCols, work, vals, INSERT_VALUES));
12889566063dSJacob Faibussowitsch     PetscCall(MatRestoreRow(matB, i, &nCols, &cols, &vals));
12893f27d899SToby Isaac   }
12909566063dSJacob Faibussowitsch   PetscCall(PetscFree(work));
12919566063dSJacob Faibussowitsch   PetscCall(MatAssemblyBegin(M, MAT_FINAL_ASSEMBLY));
12929566063dSJacob Faibussowitsch   PetscCall(MatAssemblyEnd(M, MAT_FINAL_ASSEMBLY));
12933f27d899SToby Isaac   *matMerged = M;
12943ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
12953f27d899SToby Isaac }
12963f27d899SToby Isaac 
129777f1a120SToby Isaac /* Take a dual space and product a segment space that has all the same specifications (trimmed, continuous, order,
129877f1a120SToby Isaac  * 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)1299d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceCreateFacetSubspace_Lagrange(PetscDualSpace sp, DM K, PetscInt f, PetscInt k, PetscInt Ncopies, PetscBool interiorOnly, PetscDualSpace *bdsp)
1300d71ae5a4SJacob Faibussowitsch {
13013f27d899SToby Isaac   PetscInt            Nknew, Ncnew;
13023f27d899SToby Isaac   PetscInt            dim, pointDim = -1;
13033f27d899SToby Isaac   PetscInt            depth;
13043f27d899SToby Isaac   DM                  dm;
13053f27d899SToby Isaac   PetscDualSpace_Lag *newlag;
13063f27d899SToby Isaac 
13073f27d899SToby Isaac   PetscFunctionBegin;
13089566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetDM(sp, &dm));
13099566063dSJacob Faibussowitsch   PetscCall(DMGetDimension(dm, &dim));
13109566063dSJacob Faibussowitsch   PetscCall(DMPlexGetDepth(dm, &depth));
13119566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceDuplicate(sp, bdsp));
13129566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceSetFormDegree(*bdsp, k));
13133f27d899SToby Isaac   if (!K) {
13143f27d899SToby Isaac     if (depth == dim) {
1315f783ec47SMatthew G. Knepley       DMPolytopeType ct;
13163f27d899SToby Isaac 
13176ff15688SToby Isaac       pointDim = dim - 1;
13189566063dSJacob Faibussowitsch       PetscCall(DMPlexGetCellType(dm, f, &ct));
13199566063dSJacob Faibussowitsch       PetscCall(DMPlexCreateReferenceCell(PETSC_COMM_SELF, ct, &K));
13203f27d899SToby Isaac     } else if (depth == 1) {
13213f27d899SToby Isaac       pointDim = 0;
13229566063dSJacob Faibussowitsch       PetscCall(DMPlexCreateReferenceCell(PETSC_COMM_SELF, DM_POLYTOPE_POINT, &K));
13233f27d899SToby Isaac     } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unsupported interpolation state of reference element");
13243f27d899SToby Isaac   } else {
13259566063dSJacob Faibussowitsch     PetscCall(PetscObjectReference((PetscObject)K));
13269566063dSJacob Faibussowitsch     PetscCall(DMGetDimension(K, &pointDim));
13273f27d899SToby Isaac   }
13289566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceSetDM(*bdsp, K));
13299566063dSJacob Faibussowitsch   PetscCall(DMDestroy(&K));
13309566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(pointDim, PetscAbsInt(k), &Nknew));
13313f27d899SToby Isaac   Ncnew = Nknew * Ncopies;
13329566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceSetNumComponents(*bdsp, Ncnew));
13333f27d899SToby Isaac   newlag               = (PetscDualSpace_Lag *)(*bdsp)->data;
13343f27d899SToby Isaac   newlag->interiorOnly = interiorOnly;
13359566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceSetUp(*bdsp));
13363ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
13373f27d899SToby Isaac }
13383f27d899SToby Isaac 
133977f1a120SToby Isaac /* Construct simplex nodes from a nodefamily, add Nk dof vectors of length Nk at each node.
134077f1a120SToby Isaac  * Return the (quadrature, matrix) form of the dofs and the nodeIndices form as well.
134177f1a120SToby Isaac  *
134277f1a120SToby Isaac  * Sometimes we want a set of nodes to be contained in the interior of the element,
134377f1a120SToby Isaac  * even when the node scheme puts nodes on the boundaries.  numNodeSkip tells
134477f1a120SToby Isaac  * the routine how many "layers" of nodes need to be skipped.
134577f1a120SToby Isaac  * */
PetscDualSpaceLagrangeCreateSimplexNodeMat(Petsc1DNodeFamily nodeFamily,PetscInt dim,PetscInt sum,PetscInt Nk,PetscInt numNodeSkip,PetscQuadrature * iNodes,Mat * iMat,PetscLagNodeIndices * nodeIndices)1346d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeCreateSimplexNodeMat(Petsc1DNodeFamily nodeFamily, PetscInt dim, PetscInt sum, PetscInt Nk, PetscInt numNodeSkip, PetscQuadrature *iNodes, Mat *iMat, PetscLagNodeIndices *nodeIndices)
1347d71ae5a4SJacob Faibussowitsch {
13483f27d899SToby Isaac   PetscReal          *extraNodeCoords, *nodeCoords;
13493f27d899SToby Isaac   PetscInt            nNodes, nExtraNodes;
13503f27d899SToby Isaac   PetscInt            i, j, k, extraSum = sum + numNodeSkip * (1 + dim);
13513f27d899SToby Isaac   PetscQuadrature     intNodes;
13523f27d899SToby Isaac   Mat                 intMat;
13533f27d899SToby Isaac   PetscLagNodeIndices ni;
13543f27d899SToby Isaac 
13553f27d899SToby Isaac   PetscFunctionBegin;
13569566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim + sum, dim, &nNodes));
13579566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim + extraSum, dim, &nExtraNodes));
13583f27d899SToby Isaac 
13599566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(dim * nExtraNodes, &extraNodeCoords));
13609566063dSJacob Faibussowitsch   PetscCall(PetscNew(&ni));
13613f27d899SToby Isaac   ni->nodeIdxDim = dim + 1;
13623f27d899SToby Isaac   ni->nodeVecDim = Nk;
13633f27d899SToby Isaac   ni->nNodes     = nNodes * Nk;
13643f27d899SToby Isaac   ni->refct      = 1;
1365f4f49eeaSPierre Jolivet   PetscCall(PetscMalloc1(nNodes * Nk * (dim + 1), &ni->nodeIdx));
1366f4f49eeaSPierre Jolivet   PetscCall(PetscMalloc1(nNodes * Nk * Nk, &ni->nodeVec));
13679371c9d4SSatish Balay   for (i = 0; i < nNodes; i++)
13689371c9d4SSatish Balay     for (j = 0; j < Nk; j++)
13699371c9d4SSatish Balay       for (k = 0; k < Nk; k++) ni->nodeVec[(i * Nk + j) * Nk + k] = (j == k) ? 1. : 0.;
13709566063dSJacob Faibussowitsch   PetscCall(Petsc1DNodeFamilyComputeSimplexNodes(nodeFamily, dim, extraSum, extraNodeCoords));
13713f27d899SToby Isaac   if (numNodeSkip) {
13723f27d899SToby Isaac     PetscInt  k;
13733f27d899SToby Isaac     PetscInt *tup;
13743f27d899SToby Isaac 
13759566063dSJacob Faibussowitsch     PetscCall(PetscMalloc1(dim * nNodes, &nodeCoords));
13769566063dSJacob Faibussowitsch     PetscCall(PetscMalloc1(dim + 1, &tup));
13773f27d899SToby Isaac     for (k = 0; k < nNodes; k++) {
13783f27d899SToby Isaac       PetscInt j, c;
13793f27d899SToby Isaac       PetscInt index;
13803f27d899SToby Isaac 
13819566063dSJacob Faibussowitsch       PetscCall(PetscDTIndexToBary(dim + 1, sum, k, tup));
13823f27d899SToby Isaac       for (j = 0; j < dim + 1; j++) tup[j] += numNodeSkip;
13833f27d899SToby Isaac       for (c = 0; c < Nk; c++) {
1384ad540459SPierre Jolivet         for (j = 0; j < dim + 1; j++) ni->nodeIdx[(k * Nk + c) * (dim + 1) + j] = tup[j] + 1;
13853f27d899SToby Isaac       }
13869566063dSJacob Faibussowitsch       PetscCall(PetscDTBaryToIndex(dim + 1, extraSum, tup, &index));
13873f27d899SToby Isaac       for (j = 0; j < dim; j++) nodeCoords[k * dim + j] = extraNodeCoords[index * dim + j];
13883f27d899SToby Isaac     }
13899566063dSJacob Faibussowitsch     PetscCall(PetscFree(tup));
13909566063dSJacob Faibussowitsch     PetscCall(PetscFree(extraNodeCoords));
13913f27d899SToby Isaac   } else {
13923f27d899SToby Isaac     PetscInt  k;
13933f27d899SToby Isaac     PetscInt *tup;
13943f27d899SToby Isaac 
13953f27d899SToby Isaac     nodeCoords = extraNodeCoords;
13969566063dSJacob Faibussowitsch     PetscCall(PetscMalloc1(dim + 1, &tup));
13973f27d899SToby Isaac     for (k = 0; k < nNodes; k++) {
13983f27d899SToby Isaac       PetscInt j, c;
13993f27d899SToby Isaac 
14009566063dSJacob Faibussowitsch       PetscCall(PetscDTIndexToBary(dim + 1, sum, k, tup));
14013f27d899SToby Isaac       for (c = 0; c < Nk; c++) {
14023f27d899SToby Isaac         for (j = 0; j < dim + 1; j++) {
14033f27d899SToby Isaac           /* barycentric indices can have zeros, but we don't want to push forward zeros because it makes it harder to
140477f1a120SToby Isaac            * determine which nodes correspond to which under symmetries, so we increase by 1.  This is fine
140577f1a120SToby Isaac            * because the nodeIdx coordinates don't have any meaning other than helping to identify symmetries */
14063f27d899SToby Isaac           ni->nodeIdx[(k * Nk + c) * (dim + 1) + j] = tup[j] + 1;
14073f27d899SToby Isaac         }
14083f27d899SToby Isaac       }
14093f27d899SToby Isaac     }
14109566063dSJacob Faibussowitsch     PetscCall(PetscFree(tup));
14113f27d899SToby Isaac   }
14129566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, &intNodes));
14139566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureSetData(intNodes, dim, 0, nNodes, nodeCoords, NULL));
14149566063dSJacob Faibussowitsch   PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, nNodes * Nk, nNodes * Nk, Nk, NULL, &intMat));
1415a243090dSMatthew G. Knepley   PetscCall(PetscObjectSetOptionsPrefix((PetscObject)intMat, "lag_"));
14169566063dSJacob Faibussowitsch   PetscCall(MatSetOption(intMat, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
14173f27d899SToby Isaac   for (j = 0; j < nNodes * Nk; j++) {
14183f27d899SToby Isaac     PetscInt rem = j % Nk;
14193f27d899SToby Isaac     PetscInt a, aprev = j - rem;
14203f27d899SToby Isaac     PetscInt anext = aprev + Nk;
14213f27d899SToby Isaac 
142248a46eb9SPierre Jolivet     for (a = aprev; a < anext; a++) PetscCall(MatSetValue(intMat, j, a, (a == j) ? 1. : 0., INSERT_VALUES));
14233f27d899SToby Isaac   }
14249566063dSJacob Faibussowitsch   PetscCall(MatAssemblyBegin(intMat, MAT_FINAL_ASSEMBLY));
14259566063dSJacob Faibussowitsch   PetscCall(MatAssemblyEnd(intMat, MAT_FINAL_ASSEMBLY));
14263f27d899SToby Isaac   *iNodes      = intNodes;
14273f27d899SToby Isaac   *iMat        = intMat;
14283f27d899SToby Isaac   *nodeIndices = ni;
14293ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
14303f27d899SToby Isaac }
14313f27d899SToby Isaac 
143277f1a120SToby Isaac /* once the nodeIndices have been created for the interior of the reference cell, and for all of the boundary cells,
1433a5b23f4aSJose E. Roman  * push forward the boundary dofs and concatenate them into the full node indices for the dual space */
PetscDualSpaceLagrangeCreateAllNodeIdx(PetscDualSpace sp)1434d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeCreateAllNodeIdx(PetscDualSpace sp)
1435d71ae5a4SJacob Faibussowitsch {
14363f27d899SToby Isaac   DM                  dm;
14373f27d899SToby Isaac   PetscInt            dim, nDofs;
14383f27d899SToby Isaac   PetscSection        section;
14393f27d899SToby Isaac   PetscInt            pStart, pEnd, p;
14403f27d899SToby Isaac   PetscInt            formDegree, Nk;
14413f27d899SToby Isaac   PetscInt            nodeIdxDim, spintdim;
14423f27d899SToby Isaac   PetscDualSpace_Lag *lag;
14433f27d899SToby Isaac   PetscLagNodeIndices ni, verti;
14443f27d899SToby Isaac 
14453f27d899SToby Isaac   PetscFunctionBegin;
14463f27d899SToby Isaac   lag   = (PetscDualSpace_Lag *)sp->data;
14473f27d899SToby Isaac   verti = lag->vertIndices;
14489566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetDM(sp, &dm));
14499566063dSJacob Faibussowitsch   PetscCall(DMGetDimension(dm, &dim));
14509566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetFormDegree(sp, &formDegree));
14519566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk));
14529566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetSection(sp, &section));
14539566063dSJacob Faibussowitsch   PetscCall(PetscSectionGetStorageSize(section, &nDofs));
14549566063dSJacob Faibussowitsch   PetscCall(PetscNew(&ni));
14553f27d899SToby Isaac   ni->nodeIdxDim = nodeIdxDim = verti->nodeIdxDim;
14563f27d899SToby Isaac   ni->nodeVecDim              = Nk;
14573f27d899SToby Isaac   ni->nNodes                  = nDofs;
14583f27d899SToby Isaac   ni->refct                   = 1;
1459f4f49eeaSPierre Jolivet   PetscCall(PetscMalloc1(nodeIdxDim * nDofs, &ni->nodeIdx));
1460f4f49eeaSPierre Jolivet   PetscCall(PetscMalloc1(Nk * nDofs, &ni->nodeVec));
14619566063dSJacob Faibussowitsch   PetscCall(DMPlexGetChart(dm, &pStart, &pEnd));
14629566063dSJacob Faibussowitsch   PetscCall(PetscSectionGetDof(section, 0, &spintdim));
14633f27d899SToby Isaac   if (spintdim) {
14649566063dSJacob Faibussowitsch     PetscCall(PetscArraycpy(ni->nodeIdx, lag->intNodeIndices->nodeIdx, spintdim * nodeIdxDim));
14659566063dSJacob Faibussowitsch     PetscCall(PetscArraycpy(ni->nodeVec, lag->intNodeIndices->nodeVec, spintdim * Nk));
14663f27d899SToby Isaac   }
14673f27d899SToby Isaac   for (p = pStart + 1; p < pEnd; p++) {
14683f27d899SToby Isaac     PetscDualSpace      psp = sp->pointSpaces[p];
14693f27d899SToby Isaac     PetscDualSpace_Lag *plag;
14703f27d899SToby Isaac     PetscInt            dof, off;
14713f27d899SToby Isaac 
14729566063dSJacob Faibussowitsch     PetscCall(PetscSectionGetDof(section, p, &dof));
14733f27d899SToby Isaac     if (!dof) continue;
14743f27d899SToby Isaac     plag = (PetscDualSpace_Lag *)psp->data;
14759566063dSJacob Faibussowitsch     PetscCall(PetscSectionGetOffset(section, p, &off));
1476f4f49eeaSPierre Jolivet     PetscCall(PetscLagNodeIndicesPushForward(dm, verti, p, plag->vertIndices, plag->intNodeIndices, 0, formDegree, &ni->nodeIdx[off * nodeIdxDim], &ni->nodeVec[off * Nk]));
14773f27d899SToby Isaac   }
14783f27d899SToby Isaac   lag->allNodeIndices = ni;
14793ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
14803f27d899SToby Isaac }
14813f27d899SToby Isaac 
148277f1a120SToby Isaac /* once the (quadrature, Matrix) forms of the dofs have been created for the interior of the
148377f1a120SToby Isaac  * reference cell and for the boundary cells, jk
148477f1a120SToby Isaac  * push forward the boundary data and concatenate them into the full (quadrature, matrix) data
148577f1a120SToby Isaac  * for the dual space */
PetscDualSpaceCreateAllDataFromInteriorData(PetscDualSpace sp)1486d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceCreateAllDataFromInteriorData(PetscDualSpace sp)
1487d71ae5a4SJacob Faibussowitsch {
14883f27d899SToby Isaac   DM              dm;
14893f27d899SToby Isaac   PetscSection    section;
14903f27d899SToby Isaac   PetscInt        pStart, pEnd, p, k, Nk, dim, Nc;
14913f27d899SToby Isaac   PetscInt        nNodes;
14923f27d899SToby Isaac   PetscInt        countNodes;
14933f27d899SToby Isaac   Mat             allMat;
14943f27d899SToby Isaac   PetscQuadrature allNodes;
14953f27d899SToby Isaac   PetscInt        nDofs;
14963f27d899SToby Isaac   PetscInt        maxNzforms, j;
14973f27d899SToby Isaac   PetscScalar    *work;
14983f27d899SToby Isaac   PetscReal      *L, *J, *Jinv, *v0, *pv0;
14993f27d899SToby Isaac   PetscInt       *iwork;
15003f27d899SToby Isaac   PetscReal      *nodes;
15013f27d899SToby Isaac 
15023f27d899SToby Isaac   PetscFunctionBegin;
15039566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetDM(sp, &dm));
15049566063dSJacob Faibussowitsch   PetscCall(DMGetDimension(dm, &dim));
15059566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetSection(sp, &section));
15069566063dSJacob Faibussowitsch   PetscCall(PetscSectionGetStorageSize(section, &nDofs));
15079566063dSJacob Faibussowitsch   PetscCall(DMPlexGetChart(dm, &pStart, &pEnd));
15089566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetFormDegree(sp, &k));
15099566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetNumComponents(sp, &Nc));
15109566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk));
15113f27d899SToby Isaac   for (p = pStart, nNodes = 0, maxNzforms = 0; p < pEnd; p++) {
15123f27d899SToby Isaac     PetscDualSpace  psp;
15133f27d899SToby Isaac     DM              pdm;
15143f27d899SToby Isaac     PetscInt        pdim, pNk;
15153f27d899SToby Isaac     PetscQuadrature intNodes;
15163f27d899SToby Isaac     Mat             intMat;
15173f27d899SToby Isaac 
15189566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceGetPointSubspace(sp, p, &psp));
15193f27d899SToby Isaac     if (!psp) continue;
15209566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceGetDM(psp, &pdm));
15219566063dSJacob Faibussowitsch     PetscCall(DMGetDimension(pdm, &pdim));
15223f27d899SToby Isaac     if (pdim < PetscAbsInt(k)) continue;
15239566063dSJacob Faibussowitsch     PetscCall(PetscDTBinomialInt(pdim, PetscAbsInt(k), &pNk));
15249566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceGetInteriorData(psp, &intNodes, &intMat));
15253f27d899SToby Isaac     if (intNodes) {
15263f27d899SToby Isaac       PetscInt nNodesp;
15273f27d899SToby Isaac 
15289566063dSJacob Faibussowitsch       PetscCall(PetscQuadratureGetData(intNodes, NULL, NULL, &nNodesp, NULL, NULL));
15293f27d899SToby Isaac       nNodes += nNodesp;
15303f27d899SToby Isaac     }
15313f27d899SToby Isaac     if (intMat) {
15323f27d899SToby Isaac       PetscInt maxNzsp;
15333f27d899SToby Isaac       PetscInt maxNzformsp;
15343f27d899SToby Isaac 
15359566063dSJacob Faibussowitsch       PetscCall(MatSeqAIJGetMaxRowNonzeros(intMat, &maxNzsp));
153608401ef6SPierre Jolivet       PetscCheck(maxNzsp % pNk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms");
15373f27d899SToby Isaac       maxNzformsp = maxNzsp / pNk;
15383f27d899SToby Isaac       maxNzforms  = PetscMax(maxNzforms, maxNzformsp);
15393f27d899SToby Isaac     }
15403f27d899SToby Isaac   }
15419566063dSJacob Faibussowitsch   PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, nDofs, nNodes * Nc, maxNzforms * Nk, NULL, &allMat));
1542a243090dSMatthew G. Knepley   PetscCall(PetscObjectSetOptionsPrefix((PetscObject)allMat, "ds_"));
15439566063dSJacob Faibussowitsch   PetscCall(MatSetOption(allMat, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE));
15449566063dSJacob Faibussowitsch   PetscCall(PetscMalloc7(dim, &v0, dim, &pv0, dim * dim, &J, dim * dim, &Jinv, Nk * Nk, &L, maxNzforms * Nk, &work, maxNzforms * Nk, &iwork));
15453f27d899SToby Isaac   for (j = 0; j < dim; j++) pv0[j] = -1.;
15469566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(dim * nNodes, &nodes));
15473f27d899SToby Isaac   for (p = pStart, countNodes = 0; p < pEnd; p++) {
15483f27d899SToby Isaac     PetscDualSpace  psp;
15493f27d899SToby Isaac     PetscQuadrature intNodes;
15503f27d899SToby Isaac     DM              pdm;
15513f27d899SToby Isaac     PetscInt        pdim, pNk;
15523f27d899SToby Isaac     PetscInt        countNodesIn = countNodes;
15533f27d899SToby Isaac     PetscReal       detJ;
15543f27d899SToby Isaac     Mat             intMat;
15553f27d899SToby Isaac 
15569566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceGetPointSubspace(sp, p, &psp));
15573f27d899SToby Isaac     if (!psp) continue;
15589566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceGetDM(psp, &pdm));
15599566063dSJacob Faibussowitsch     PetscCall(DMGetDimension(pdm, &pdim));
15603f27d899SToby Isaac     if (pdim < PetscAbsInt(k)) continue;
15619566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceGetInteriorData(psp, &intNodes, &intMat));
15623f27d899SToby Isaac     if (intNodes == NULL && intMat == NULL) continue;
15639566063dSJacob Faibussowitsch     PetscCall(PetscDTBinomialInt(pdim, PetscAbsInt(k), &pNk));
15643f27d899SToby Isaac     if (p) {
15659566063dSJacob Faibussowitsch       PetscCall(DMPlexComputeCellGeometryAffineFEM(dm, p, v0, J, Jinv, &detJ));
15663f27d899SToby Isaac     } else { /* identity */
15673f27d899SToby Isaac       PetscInt i, j;
15683f27d899SToby Isaac 
15699371c9d4SSatish Balay       for (i = 0; i < dim; i++)
15709371c9d4SSatish Balay         for (j = 0; j < dim; j++) J[i * dim + j] = Jinv[i * dim + j] = 0.;
15713f27d899SToby Isaac       for (i = 0; i < dim; i++) J[i * dim + i] = Jinv[i * dim + i] = 1.;
15723f27d899SToby Isaac       for (i = 0; i < dim; i++) v0[i] = -1.;
15733f27d899SToby Isaac     }
15743f27d899SToby Isaac     if (pdim != dim) { /* compactify Jacobian */
15753f27d899SToby Isaac       PetscInt i, j;
15763f27d899SToby Isaac 
15779371c9d4SSatish Balay       for (i = 0; i < dim; i++)
15789371c9d4SSatish Balay         for (j = 0; j < pdim; j++) J[i * pdim + j] = J[i * dim + j];
15793f27d899SToby Isaac     }
15809566063dSJacob Faibussowitsch     PetscCall(PetscDTAltVPullbackMatrix(pdim, dim, J, k, L));
158177f1a120SToby Isaac     if (intNodes) { /* push forward quadrature locations by the affine transformation */
15823f27d899SToby Isaac       PetscInt         nNodesp;
15833f27d899SToby Isaac       const PetscReal *nodesp;
15843f27d899SToby Isaac       PetscInt         j;
15853f27d899SToby Isaac 
15869566063dSJacob Faibussowitsch       PetscCall(PetscQuadratureGetData(intNodes, NULL, NULL, &nNodesp, &nodesp, NULL));
15873f27d899SToby Isaac       for (j = 0; j < nNodesp; j++, countNodes++) {
15883f27d899SToby Isaac         PetscInt d, e;
15893f27d899SToby Isaac 
15903f27d899SToby Isaac         for (d = 0; d < dim; d++) {
15913f27d899SToby Isaac           nodes[countNodes * dim + d] = v0[d];
1592ad540459SPierre Jolivet           for (e = 0; e < pdim; e++) nodes[countNodes * dim + d] += J[d * pdim + e] * (nodesp[j * pdim + e] - pv0[e]);
15933f27d899SToby Isaac         }
15943f27d899SToby Isaac       }
15953f27d899SToby Isaac     }
15963f27d899SToby Isaac     if (intMat) {
15973f27d899SToby Isaac       PetscInt nrows;
15983f27d899SToby Isaac       PetscInt off;
15993f27d899SToby Isaac 
16009566063dSJacob Faibussowitsch       PetscCall(PetscSectionGetDof(section, p, &nrows));
16019566063dSJacob Faibussowitsch       PetscCall(PetscSectionGetOffset(section, p, &off));
16023f27d899SToby Isaac       for (j = 0; j < nrows; j++) {
16033f27d899SToby Isaac         PetscInt           ncols;
16043f27d899SToby Isaac         const PetscInt    *cols;
16053f27d899SToby Isaac         const PetscScalar *vals;
16063f27d899SToby Isaac         PetscInt           l, d, e;
16073f27d899SToby Isaac         PetscInt           row = j + off;
16083f27d899SToby Isaac 
16099566063dSJacob Faibussowitsch         PetscCall(MatGetRow(intMat, j, &ncols, &cols, &vals));
161008401ef6SPierre Jolivet         PetscCheck(ncols % pNk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms");
16113f27d899SToby Isaac         for (l = 0; l < ncols / pNk; l++) {
16123f27d899SToby Isaac           PetscInt blockcol;
16133f27d899SToby Isaac 
1614ad540459SPierre Jolivet           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");
16153f27d899SToby Isaac           blockcol = cols[l * pNk] / pNk;
1616ad540459SPierre Jolivet           for (d = 0; d < Nk; d++) iwork[l * Nk + d] = (blockcol + countNodesIn) * Nk + d;
16173f27d899SToby Isaac           for (d = 0; d < Nk; d++) work[l * Nk + d] = 0.;
16183f27d899SToby Isaac           for (d = 0; d < Nk; d++) {
16193f27d899SToby Isaac             for (e = 0; e < pNk; e++) {
16203f27d899SToby Isaac               /* "push forward" dof by pulling back a k-form to be evaluated on the point: multiply on the right by L */
16215efe5503SToby Isaac               work[l * Nk + d] += vals[l * pNk + e] * L[e * Nk + d];
16223f27d899SToby Isaac             }
16233f27d899SToby Isaac           }
16243f27d899SToby Isaac         }
16259566063dSJacob Faibussowitsch         PetscCall(MatSetValues(allMat, 1, &row, (ncols / pNk) * Nk, iwork, work, INSERT_VALUES));
16269566063dSJacob Faibussowitsch         PetscCall(MatRestoreRow(intMat, j, &ncols, &cols, &vals));
16273f27d899SToby Isaac       }
16283f27d899SToby Isaac     }
16293f27d899SToby Isaac   }
16309566063dSJacob Faibussowitsch   PetscCall(MatAssemblyBegin(allMat, MAT_FINAL_ASSEMBLY));
16319566063dSJacob Faibussowitsch   PetscCall(MatAssemblyEnd(allMat, MAT_FINAL_ASSEMBLY));
16329566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, &allNodes));
16339566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureSetData(allNodes, dim, 0, nNodes, nodes, NULL));
16349566063dSJacob Faibussowitsch   PetscCall(PetscFree7(v0, pv0, J, Jinv, L, work, iwork));
1635f4f49eeaSPierre Jolivet   PetscCall(MatDestroy(&sp->allMat));
16363f27d899SToby Isaac   sp->allMat = allMat;
1637f4f49eeaSPierre Jolivet   PetscCall(PetscQuadratureDestroy(&sp->allNodes));
16383f27d899SToby Isaac   sp->allNodes = allNodes;
16393ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
16403f27d899SToby Isaac }
16413f27d899SToby Isaac 
PetscDualSpaceComputeFunctionalsFromAllData_Moments(PetscDualSpace sp)16422dce792eSToby Isaac static PetscErrorCode PetscDualSpaceComputeFunctionalsFromAllData_Moments(PetscDualSpace sp)
1643d71ae5a4SJacob Faibussowitsch {
164466a6c23cSMatthew G. Knepley   Mat              allMat;
164566a6c23cSMatthew G. Knepley   PetscInt         momentOrder, i;
1646eae3dc7dSJacob Faibussowitsch   PetscBool        tensor = PETSC_FALSE;
164766a6c23cSMatthew G. Knepley   const PetscReal *weights;
164866a6c23cSMatthew G. Knepley   PetscScalar     *array;
16492dce792eSToby Isaac   PetscInt         nDofs;
16502dce792eSToby Isaac   PetscInt         dim, Nc;
16512dce792eSToby Isaac   DM               dm;
16522dce792eSToby Isaac   PetscQuadrature  allNodes;
16532dce792eSToby Isaac   PetscInt         nNodes;
165466a6c23cSMatthew G. Knepley 
16552dce792eSToby Isaac   PetscFunctionBegin;
16562dce792eSToby Isaac   PetscCall(PetscDualSpaceGetDM(sp, &dm));
16572dce792eSToby Isaac   PetscCall(DMGetDimension(dm, &dim));
16582dce792eSToby Isaac   PetscCall(PetscDualSpaceGetNumComponents(sp, &Nc));
16592dce792eSToby Isaac   PetscCall(PetscDualSpaceGetAllData(sp, &allNodes, &allMat));
16602dce792eSToby Isaac   PetscCall(MatGetSize(allMat, &nDofs, NULL));
166163a3b9bcSJacob Faibussowitsch   PetscCheck(nDofs == 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "We do not yet support moments beyond P0, nDofs == %" PetscInt_FMT, nDofs);
1662f4f49eeaSPierre Jolivet   PetscCall(PetscMalloc1(nDofs, &sp->functional));
16639566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeGetMomentOrder(sp, &momentOrder));
16649566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceLagrangeGetTensor(sp, &tensor));
1665f4f49eeaSPierre Jolivet   if (!tensor) PetscCall(PetscDTStroudConicalQuadrature(dim, Nc, PetscMax(momentOrder + 1, 1), -1.0, 1.0, &sp->functional[0]));
1666f4f49eeaSPierre Jolivet   else PetscCall(PetscDTGaussTensorQuadrature(dim, Nc, PetscMax(momentOrder + 1, 1), -1.0, 1.0, &sp->functional[0]));
166766a6c23cSMatthew G. Knepley   /* Need to replace allNodes and allMat */
16689566063dSJacob Faibussowitsch   PetscCall(PetscObjectReference((PetscObject)sp->functional[0]));
1669f4f49eeaSPierre Jolivet   PetscCall(PetscQuadratureDestroy(&sp->allNodes));
167066a6c23cSMatthew G. Knepley   sp->allNodes = sp->functional[0];
16719566063dSJacob Faibussowitsch   PetscCall(PetscQuadratureGetData(sp->allNodes, NULL, NULL, &nNodes, NULL, &weights));
16729566063dSJacob Faibussowitsch   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF, nDofs, nNodes * Nc, NULL, &allMat));
1673a243090dSMatthew G. Knepley   PetscCall(PetscObjectSetOptionsPrefix((PetscObject)allMat, "ds_"));
16749566063dSJacob Faibussowitsch   PetscCall(MatDenseGetArrayWrite(allMat, &array));
167566a6c23cSMatthew G. Knepley   for (i = 0; i < nNodes * Nc; ++i) array[i] = weights[i];
16769566063dSJacob Faibussowitsch   PetscCall(MatDenseRestoreArrayWrite(allMat, &array));
16779566063dSJacob Faibussowitsch   PetscCall(MatAssemblyBegin(allMat, MAT_FINAL_ASSEMBLY));
16789566063dSJacob Faibussowitsch   PetscCall(MatAssemblyEnd(allMat, MAT_FINAL_ASSEMBLY));
1679f4f49eeaSPierre Jolivet   PetscCall(MatDestroy(&sp->allMat));
168066a6c23cSMatthew G. Knepley   sp->allMat = allMat;
16813ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
168266a6c23cSMatthew G. Knepley }
16832dce792eSToby Isaac 
16842dce792eSToby Isaac /* rather than trying to get all data from the functionals, we create
16852dce792eSToby Isaac  * the functionals from rows of the quadrature -> dof matrix.
16862dce792eSToby Isaac  *
16872dce792eSToby Isaac  * Ideally most of the uses of PetscDualSpace in PetscFE will switch
16882dce792eSToby Isaac  * to using intMat and allMat, so that the individual functionals
16892dce792eSToby Isaac  * don't need to be constructed at all */
PetscDualSpaceComputeFunctionalsFromAllData(PetscDualSpace sp)16902dce792eSToby Isaac PETSC_INTERN PetscErrorCode PetscDualSpaceComputeFunctionalsFromAllData(PetscDualSpace sp)
16912dce792eSToby Isaac {
16922dce792eSToby Isaac   PetscQuadrature  allNodes;
16932dce792eSToby Isaac   Mat              allMat;
16942dce792eSToby Isaac   PetscInt         nDofs;
16952dce792eSToby Isaac   PetscInt         dim, Nc, f;
16962dce792eSToby Isaac   DM               dm;
16972dce792eSToby Isaac   PetscInt         nNodes, spdim;
16982dce792eSToby Isaac   const PetscReal *nodes = NULL;
16992dce792eSToby Isaac   PetscSection     section;
17002dce792eSToby Isaac 
17012dce792eSToby Isaac   PetscFunctionBegin;
17022dce792eSToby Isaac   PetscCall(PetscDualSpaceGetDM(sp, &dm));
17032dce792eSToby Isaac   PetscCall(DMGetDimension(dm, &dim));
17042dce792eSToby Isaac   PetscCall(PetscDualSpaceGetNumComponents(sp, &Nc));
17052dce792eSToby Isaac   PetscCall(PetscDualSpaceGetAllData(sp, &allNodes, &allMat));
17062dce792eSToby Isaac   nNodes = 0;
17072dce792eSToby Isaac   if (allNodes) PetscCall(PetscQuadratureGetData(allNodes, NULL, NULL, &nNodes, &nodes, NULL));
17082dce792eSToby Isaac   PetscCall(MatGetSize(allMat, &nDofs, NULL));
17092dce792eSToby Isaac   PetscCall(PetscDualSpaceGetSection(sp, &section));
17102dce792eSToby Isaac   PetscCall(PetscSectionGetStorageSize(section, &spdim));
17112dce792eSToby Isaac   PetscCheck(spdim == nDofs, PETSC_COMM_SELF, PETSC_ERR_PLIB, "incompatible all matrix size");
1712f4f49eeaSPierre Jolivet   PetscCall(PetscMalloc1(nDofs, &sp->functional));
17133f27d899SToby Isaac   for (f = 0; f < nDofs; f++) {
17143f27d899SToby Isaac     PetscInt           ncols, c;
17153f27d899SToby Isaac     const PetscInt    *cols;
17163f27d899SToby Isaac     const PetscScalar *vals;
17173f27d899SToby Isaac     PetscReal         *nodesf;
17183f27d899SToby Isaac     PetscReal         *weightsf;
17193f27d899SToby Isaac     PetscInt           nNodesf;
17203f27d899SToby Isaac     PetscInt           countNodes;
17213f27d899SToby Isaac 
17229566063dSJacob Faibussowitsch     PetscCall(MatGetRow(allMat, f, &ncols, &cols, &vals));
17233f27d899SToby Isaac     for (c = 1, nNodesf = 1; c < ncols; c++) {
17243f27d899SToby Isaac       if ((cols[c] / Nc) != (cols[c - 1] / Nc)) nNodesf++;
17253f27d899SToby Isaac     }
17269566063dSJacob Faibussowitsch     PetscCall(PetscMalloc1(dim * nNodesf, &nodesf));
17279566063dSJacob Faibussowitsch     PetscCall(PetscMalloc1(Nc * nNodesf, &weightsf));
17283f27d899SToby Isaac     for (c = 0, countNodes = 0; c < ncols; c++) {
17293f27d899SToby Isaac       if (!c || ((cols[c] / Nc) != (cols[c - 1] / Nc))) {
17303f27d899SToby Isaac         PetscInt d;
17313f27d899SToby Isaac 
1732ad540459SPierre Jolivet         for (d = 0; d < Nc; d++) weightsf[countNodes * Nc + d] = 0.;
1733ad540459SPierre Jolivet         for (d = 0; d < dim; d++) nodesf[countNodes * dim + d] = nodes[(cols[c] / Nc) * dim + d];
17343f27d899SToby Isaac         countNodes++;
17353f27d899SToby Isaac       }
17363f27d899SToby Isaac       weightsf[(countNodes - 1) * Nc + (cols[c] % Nc)] = PetscRealPart(vals[c]);
17373f27d899SToby Isaac     }
1738f4f49eeaSPierre Jolivet     PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]));
17399566063dSJacob Faibussowitsch     PetscCall(PetscQuadratureSetData(sp->functional[f], dim, Nc, nNodesf, nodesf, weightsf));
17409566063dSJacob Faibussowitsch     PetscCall(MatRestoreRow(allMat, f, &ncols, &cols, &vals));
17413f27d899SToby Isaac   }
17423ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
17433f27d899SToby Isaac }
17443f27d899SToby Isaac 
174577f1a120SToby Isaac /* check if a cell is a tensor product of the segment with a facet,
174677f1a120SToby Isaac  * specifically checking if f and f2 can be the "endpoints" (like the triangles
174777f1a120SToby Isaac  * at either end of a wedge) */
DMPlexPointIsTensor_Internal_Given(DM dm,PetscInt p,PetscInt f,PetscInt f2,PetscBool * isTensor)1748d71ae5a4SJacob Faibussowitsch static PetscErrorCode DMPlexPointIsTensor_Internal_Given(DM dm, PetscInt p, PetscInt f, PetscInt f2, PetscBool *isTensor)
1749d71ae5a4SJacob Faibussowitsch {
17503f27d899SToby Isaac   PetscInt        coneSize, c;
17513f27d899SToby Isaac   const PetscInt *cone;
17523f27d899SToby Isaac   const PetscInt *fCone;
17533f27d899SToby Isaac   const PetscInt *f2Cone;
17543f27d899SToby Isaac   PetscInt        fs[2];
17553f27d899SToby Isaac   PetscInt        meetSize, nmeet;
17563f27d899SToby Isaac   const PetscInt *meet;
17573f27d899SToby Isaac 
17583f27d899SToby Isaac   PetscFunctionBegin;
17593f27d899SToby Isaac   fs[0] = f;
17603f27d899SToby Isaac   fs[1] = f2;
17619566063dSJacob Faibussowitsch   PetscCall(DMPlexGetMeet(dm, 2, fs, &meetSize, &meet));
17623f27d899SToby Isaac   nmeet = meetSize;
17639566063dSJacob Faibussowitsch   PetscCall(DMPlexRestoreMeet(dm, 2, fs, &meetSize, &meet));
176477f1a120SToby Isaac   /* two points that have a non-empty meet cannot be at opposite ends of a cell */
17653f27d899SToby Isaac   if (nmeet) {
17663f27d899SToby Isaac     *isTensor = PETSC_FALSE;
17673ba16761SJacob Faibussowitsch     PetscFunctionReturn(PETSC_SUCCESS);
17683f27d899SToby Isaac   }
17699566063dSJacob Faibussowitsch   PetscCall(DMPlexGetConeSize(dm, p, &coneSize));
17709566063dSJacob Faibussowitsch   PetscCall(DMPlexGetCone(dm, p, &cone));
17719566063dSJacob Faibussowitsch   PetscCall(DMPlexGetCone(dm, f, &fCone));
17729566063dSJacob Faibussowitsch   PetscCall(DMPlexGetCone(dm, f2, &f2Cone));
17733f27d899SToby Isaac   for (c = 0; c < coneSize; c++) {
17743f27d899SToby Isaac     PetscInt        e, ef;
17753f27d899SToby Isaac     PetscInt        d = -1, d2 = -1;
17763f27d899SToby Isaac     PetscInt        dcount, d2count;
17773f27d899SToby Isaac     PetscInt        t = cone[c];
17783f27d899SToby Isaac     PetscInt        tConeSize;
17793f27d899SToby Isaac     PetscBool       tIsTensor;
17803f27d899SToby Isaac     const PetscInt *tCone;
17813f27d899SToby Isaac 
17823f27d899SToby Isaac     if (t == f || t == f2) continue;
178377f1a120SToby Isaac     /* for every other facet in the cone, check that is has
178477f1a120SToby Isaac      * one ridge in common with each end */
17859566063dSJacob Faibussowitsch     PetscCall(DMPlexGetConeSize(dm, t, &tConeSize));
17869566063dSJacob Faibussowitsch     PetscCall(DMPlexGetCone(dm, t, &tCone));
17873f27d899SToby Isaac 
17883f27d899SToby Isaac     dcount  = 0;
17893f27d899SToby Isaac     d2count = 0;
17903f27d899SToby Isaac     for (e = 0; e < tConeSize; e++) {
17913f27d899SToby Isaac       PetscInt q = tCone[e];
17923f27d899SToby Isaac       for (ef = 0; ef < coneSize - 2; ef++) {
17933f27d899SToby Isaac         if (fCone[ef] == q) {
17943f27d899SToby Isaac           if (dcount) {
17953f27d899SToby Isaac             *isTensor = PETSC_FALSE;
17963ba16761SJacob Faibussowitsch             PetscFunctionReturn(PETSC_SUCCESS);
17973f27d899SToby Isaac           }
17983f27d899SToby Isaac           d = q;
17993f27d899SToby Isaac           dcount++;
18003f27d899SToby Isaac         } else if (f2Cone[ef] == q) {
18013f27d899SToby Isaac           if (d2count) {
18023f27d899SToby Isaac             *isTensor = PETSC_FALSE;
18033ba16761SJacob Faibussowitsch             PetscFunctionReturn(PETSC_SUCCESS);
18043f27d899SToby Isaac           }
18053f27d899SToby Isaac           d2 = q;
18063f27d899SToby Isaac           d2count++;
18073f27d899SToby Isaac         }
18083f27d899SToby Isaac       }
18093f27d899SToby Isaac     }
181077f1a120SToby Isaac     /* if the whole cell is a tensor with the segment, then this
181177f1a120SToby Isaac      * facet should be a tensor with the segment */
18129566063dSJacob Faibussowitsch     PetscCall(DMPlexPointIsTensor_Internal_Given(dm, t, d, d2, &tIsTensor));
18133f27d899SToby Isaac     if (!tIsTensor) {
18143f27d899SToby Isaac       *isTensor = PETSC_FALSE;
18153ba16761SJacob Faibussowitsch       PetscFunctionReturn(PETSC_SUCCESS);
18163f27d899SToby Isaac     }
18173f27d899SToby Isaac   }
18183f27d899SToby Isaac   *isTensor = PETSC_TRUE;
18193ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
18203f27d899SToby Isaac }
18213f27d899SToby Isaac 
182277f1a120SToby Isaac /* determine if a cell is a tensor with a segment by looping over pairs of facets to find a pair
182377f1a120SToby Isaac  * that could be the opposite ends */
DMPlexPointIsTensor_Internal(DM dm,PetscInt p,PetscBool * isTensor,PetscInt * endA,PetscInt * endB)1824d71ae5a4SJacob Faibussowitsch static PetscErrorCode DMPlexPointIsTensor_Internal(DM dm, PetscInt p, PetscBool *isTensor, PetscInt *endA, PetscInt *endB)
1825d71ae5a4SJacob Faibussowitsch {
18263f27d899SToby Isaac   PetscInt        coneSize, c, c2;
18273f27d899SToby Isaac   const PetscInt *cone;
18283f27d899SToby Isaac 
18293f27d899SToby Isaac   PetscFunctionBegin;
18309566063dSJacob Faibussowitsch   PetscCall(DMPlexGetConeSize(dm, p, &coneSize));
18313f27d899SToby Isaac   if (!coneSize) {
18323f27d899SToby Isaac     if (isTensor) *isTensor = PETSC_FALSE;
18333f27d899SToby Isaac     if (endA) *endA = -1;
18343f27d899SToby Isaac     if (endB) *endB = -1;
18353f27d899SToby Isaac   }
18369566063dSJacob Faibussowitsch   PetscCall(DMPlexGetCone(dm, p, &cone));
18373f27d899SToby Isaac   for (c = 0; c < coneSize; c++) {
18383f27d899SToby Isaac     PetscInt f = cone[c];
18393f27d899SToby Isaac     PetscInt fConeSize;
18403f27d899SToby Isaac 
18419566063dSJacob Faibussowitsch     PetscCall(DMPlexGetConeSize(dm, f, &fConeSize));
18423f27d899SToby Isaac     if (fConeSize != coneSize - 2) continue;
18433f27d899SToby Isaac 
18443f27d899SToby Isaac     for (c2 = c + 1; c2 < coneSize; c2++) {
18453f27d899SToby Isaac       PetscInt  f2 = cone[c2];
18463f27d899SToby Isaac       PetscBool isTensorff2;
18473f27d899SToby Isaac       PetscInt  f2ConeSize;
18483f27d899SToby Isaac 
18499566063dSJacob Faibussowitsch       PetscCall(DMPlexGetConeSize(dm, f2, &f2ConeSize));
18503f27d899SToby Isaac       if (f2ConeSize != coneSize - 2) continue;
18513f27d899SToby Isaac 
18529566063dSJacob Faibussowitsch       PetscCall(DMPlexPointIsTensor_Internal_Given(dm, p, f, f2, &isTensorff2));
18533f27d899SToby Isaac       if (isTensorff2) {
18543f27d899SToby Isaac         if (isTensor) *isTensor = PETSC_TRUE;
18553f27d899SToby Isaac         if (endA) *endA = f;
18563f27d899SToby Isaac         if (endB) *endB = f2;
18573ba16761SJacob Faibussowitsch         PetscFunctionReturn(PETSC_SUCCESS);
18583f27d899SToby Isaac       }
18593f27d899SToby Isaac     }
18603f27d899SToby Isaac   }
18613f27d899SToby Isaac   if (isTensor) *isTensor = PETSC_FALSE;
18623f27d899SToby Isaac   if (endA) *endA = -1;
18633f27d899SToby Isaac   if (endB) *endB = -1;
18643ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
18653f27d899SToby Isaac }
18663f27d899SToby Isaac 
186777f1a120SToby Isaac /* determine if a cell is a tensor with a segment by looping over pairs of facets to find a pair
186877f1a120SToby Isaac  * that could be the opposite ends */
DMPlexPointIsTensor(DM dm,PetscInt p,PetscBool * isTensor,PetscInt * endA,PetscInt * endB)1869d71ae5a4SJacob Faibussowitsch static PetscErrorCode DMPlexPointIsTensor(DM dm, PetscInt p, PetscBool *isTensor, PetscInt *endA, PetscInt *endB)
1870d71ae5a4SJacob Faibussowitsch {
18713f27d899SToby Isaac   DMPlexInterpolatedFlag interpolated;
18723f27d899SToby Isaac 
18733f27d899SToby Isaac   PetscFunctionBegin;
18749566063dSJacob Faibussowitsch   PetscCall(DMPlexIsInterpolated(dm, &interpolated));
187508401ef6SPierre Jolivet   PetscCheck(interpolated == DMPLEX_INTERPOLATED_FULL, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Only for interpolated DMPlex's");
18769566063dSJacob Faibussowitsch   PetscCall(DMPlexPointIsTensor_Internal(dm, p, isTensor, endA, endB));
18773ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
18783f27d899SToby Isaac }
18793f27d899SToby Isaac 
18808f28b7bfSToby Isaac /* Let k = formDegree and k' = -sign(k) * dim + k.  Transform a symmetric frame for k-forms on the biunit simplex into
18818f28b7bfSToby Isaac  * a symmetric frame for k'-forms on the biunit simplex.
18821f440fbeSToby Isaac  *
18838f28b7bfSToby Isaac  * A frame is "symmetric" if the pullback of every symmetry of the biunit simplex is a permutation of the frame.
18841f440fbeSToby Isaac  *
18858f28b7bfSToby Isaac  * forms in the symmetric frame are used as dofs in the untrimmed simplex spaces.  This way, symmetries of the
18868f28b7bfSToby Isaac  * reference cell result in permutations of dofs grouped by node.
18871f440fbeSToby Isaac  *
18888f28b7bfSToby Isaac  * Use T to transform dof matrices for k'-forms into dof matrices for k-forms as a block diagonal transformation on
18898f28b7bfSToby Isaac  * the right.
18901f440fbeSToby Isaac  */
BiunitSimplexSymmetricFormTransformation(PetscInt dim,PetscInt formDegree,PetscReal T[])1891d71ae5a4SJacob Faibussowitsch static PetscErrorCode BiunitSimplexSymmetricFormTransformation(PetscInt dim, PetscInt formDegree, PetscReal T[])
1892d71ae5a4SJacob Faibussowitsch {
18931f440fbeSToby Isaac   PetscInt   k  = formDegree;
18941f440fbeSToby Isaac   PetscInt   kd = k < 0 ? dim + k : k - dim;
18951f440fbeSToby Isaac   PetscInt   Nk;
18961f440fbeSToby Isaac   PetscReal *biToEq, *eqToBi, *biToEqStar, *eqToBiStar;
18971f440fbeSToby Isaac   PetscInt   fact;
18981f440fbeSToby Isaac 
18991f440fbeSToby Isaac   PetscFunctionBegin;
19009566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk));
19019566063dSJacob Faibussowitsch   PetscCall(PetscCalloc4(dim * dim, &biToEq, dim * dim, &eqToBi, Nk * Nk, &biToEqStar, Nk * Nk, &eqToBiStar));
19021f440fbeSToby Isaac   /* fill in biToEq: Jacobian of the transformation from the biunit simplex to the equilateral simplex */
19031f440fbeSToby Isaac   fact = 0;
19041f440fbeSToby Isaac   for (PetscInt i = 0; i < dim; i++) {
19051f440fbeSToby Isaac     biToEq[i * dim + i] = PetscSqrtReal(((PetscReal)i + 2.) / (2. * ((PetscReal)i + 1.)));
19061f440fbeSToby Isaac     fact += 4 * (i + 1);
1907ad540459SPierre Jolivet     for (PetscInt j = i + 1; j < dim; j++) biToEq[i * dim + j] = PetscSqrtReal(1. / (PetscReal)fact);
19081f440fbeSToby Isaac   }
19098f28b7bfSToby Isaac   /* fill in eqToBi: Jacobian of the transformation from the equilateral simplex to the biunit simplex */
19101f440fbeSToby Isaac   fact = 0;
19111f440fbeSToby Isaac   for (PetscInt j = 0; j < dim; j++) {
19121f440fbeSToby Isaac     eqToBi[j * dim + j] = PetscSqrtReal(2. * ((PetscReal)j + 1.) / ((PetscReal)j + 2));
19131f440fbeSToby Isaac     fact += j + 1;
1914ad540459SPierre Jolivet     for (PetscInt i = 0; i < j; i++) eqToBi[i * dim + j] = -PetscSqrtReal(1. / (PetscReal)fact);
19151f440fbeSToby Isaac   }
19169566063dSJacob Faibussowitsch   PetscCall(PetscDTAltVPullbackMatrix(dim, dim, biToEq, kd, biToEqStar));
19179566063dSJacob Faibussowitsch   PetscCall(PetscDTAltVPullbackMatrix(dim, dim, eqToBi, k, eqToBiStar));
19188f28b7bfSToby Isaac   /* product of pullbacks simulates the following steps
19198f28b7bfSToby Isaac    *
19208f28b7bfSToby Isaac    * 1. start with frame W = [w_1, w_2, ..., w_m] of k forms that is symmetric on the biunit simplex:
19218f28b7bfSToby Isaac           if J is the Jacobian of a symmetry of the biunit simplex, then J_k* W = [J_k*w_1, ..., J_k*w_m]
19228f28b7bfSToby Isaac           is a permutation of W.
19238f28b7bfSToby Isaac           Even though a k' form --- a (dim - k) form represented by its Hodge star --- has the same geometric
19248f28b7bfSToby Isaac           content as a k form, W is not a symmetric frame of k' forms on the biunit simplex.  That's because,
19258f28b7bfSToby Isaac           for general Jacobian J, J_k* != J_k'*.
19268f28b7bfSToby Isaac    * 2. pullback W to the equilateral triangle using the k pullback, W_eq = eqToBi_k* W.  All symmetries of the
19278f28b7bfSToby Isaac           equilateral simplex have orthonormal Jacobians.  For an orthonormal Jacobian O, J_k* = J_k'*, so W_eq is
19288f28b7bfSToby Isaac           also a symmetric frame for k' forms on the equilateral simplex.
19298f28b7bfSToby Isaac      3. pullback W_eq back to the biunit simplex using the k' pulback, V = biToEq_k'* W_eq = biToEq_k'* eqToBi_k* W.
19308f28b7bfSToby Isaac           V is a symmetric frame for k' forms on the biunit simplex.
19318f28b7bfSToby Isaac    */
19321f440fbeSToby Isaac   for (PetscInt i = 0; i < Nk; i++) {
19331f440fbeSToby Isaac     for (PetscInt j = 0; j < Nk; j++) {
19341f440fbeSToby Isaac       PetscReal val = 0.;
19351f440fbeSToby Isaac       for (PetscInt k = 0; k < Nk; k++) val += biToEqStar[i * Nk + k] * eqToBiStar[k * Nk + j];
19361f440fbeSToby Isaac       T[i * Nk + j] = val;
19371f440fbeSToby Isaac     }
19381f440fbeSToby Isaac   }
19399566063dSJacob Faibussowitsch   PetscCall(PetscFree4(biToEq, eqToBi, biToEqStar, eqToBiStar));
19403ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
19411f440fbeSToby Isaac }
19421f440fbeSToby Isaac 
194377f1a120SToby Isaac /* permute a quadrature -> dof matrix so that its rows are in revlex order by nodeIdx */
MatPermuteByNodeIdx(Mat A,PetscLagNodeIndices ni,Mat * Aperm)1944d71ae5a4SJacob Faibussowitsch static PetscErrorCode MatPermuteByNodeIdx(Mat A, PetscLagNodeIndices ni, Mat *Aperm)
1945d71ae5a4SJacob Faibussowitsch {
19463f27d899SToby Isaac   PetscInt   m, n, i, j;
19473f27d899SToby Isaac   PetscInt   nodeIdxDim = ni->nodeIdxDim;
19483f27d899SToby Isaac   PetscInt   nodeVecDim = ni->nodeVecDim;
19493f27d899SToby Isaac   PetscInt  *perm;
19503f27d899SToby Isaac   IS         permIS;
19513f27d899SToby Isaac   IS         id;
19523f27d899SToby Isaac   PetscInt  *nIdxPerm;
19533f27d899SToby Isaac   PetscReal *nVecPerm;
19543f27d899SToby Isaac 
19553f27d899SToby Isaac   PetscFunctionBegin;
19569566063dSJacob Faibussowitsch   PetscCall(PetscLagNodeIndicesGetPermutation(ni, &perm));
19579566063dSJacob Faibussowitsch   PetscCall(MatGetSize(A, &m, &n));
19589566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(nodeIdxDim * m, &nIdxPerm));
19599566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(nodeVecDim * m, &nVecPerm));
19609371c9d4SSatish Balay   for (i = 0; i < m; i++)
19619371c9d4SSatish Balay     for (j = 0; j < nodeIdxDim; j++) nIdxPerm[i * nodeIdxDim + j] = ni->nodeIdx[perm[i] * nodeIdxDim + j];
19629371c9d4SSatish Balay   for (i = 0; i < m; i++)
19639371c9d4SSatish Balay     for (j = 0; j < nodeVecDim; j++) nVecPerm[i * nodeVecDim + j] = ni->nodeVec[perm[i] * nodeVecDim + j];
19649566063dSJacob Faibussowitsch   PetscCall(ISCreateGeneral(PETSC_COMM_SELF, m, perm, PETSC_USE_POINTER, &permIS));
19659566063dSJacob Faibussowitsch   PetscCall(ISSetPermutation(permIS));
19669566063dSJacob Faibussowitsch   PetscCall(ISCreateStride(PETSC_COMM_SELF, n, 0, 1, &id));
19679566063dSJacob Faibussowitsch   PetscCall(ISSetPermutation(id));
19689566063dSJacob Faibussowitsch   PetscCall(MatPermute(A, permIS, id, Aperm));
19699566063dSJacob Faibussowitsch   PetscCall(ISDestroy(&permIS));
19709566063dSJacob Faibussowitsch   PetscCall(ISDestroy(&id));
19713f27d899SToby Isaac   for (i = 0; i < m; i++) perm[i] = i;
19729566063dSJacob Faibussowitsch   PetscCall(PetscFree(ni->nodeIdx));
19739566063dSJacob Faibussowitsch   PetscCall(PetscFree(ni->nodeVec));
19743f27d899SToby Isaac   ni->nodeIdx = nIdxPerm;
19753f27d899SToby Isaac   ni->nodeVec = nVecPerm;
19763ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
19776f905325SMatthew G. Knepley }
19786f905325SMatthew G. Knepley 
PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp)1979d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp)
1980d71ae5a4SJacob Faibussowitsch {
19816f905325SMatthew G. Knepley   PetscDualSpace_Lag    *lag   = (PetscDualSpace_Lag *)sp->data;
19826f905325SMatthew G. Knepley   DM                     dm    = sp->dm;
19833f27d899SToby Isaac   DM                     dmint = NULL;
19843f27d899SToby Isaac   PetscInt               order;
1985dd460d27SBarry Smith   PetscInt               Nc;
19866f905325SMatthew G. Knepley   MPI_Comm               comm;
19876f905325SMatthew G. Knepley   PetscBool              continuous;
19883f27d899SToby Isaac   PetscSection           section;
19893f27d899SToby Isaac   PetscInt               depth, dim, pStart, pEnd, cStart, cEnd, p, *pStratStart, *pStratEnd, d;
19903f27d899SToby Isaac   PetscInt               formDegree, Nk, Ncopies;
19913f27d899SToby Isaac   PetscInt               tensorf = -1, tensorf2 = -1;
19923f27d899SToby Isaac   PetscBool              tensorCell, tensorSpace;
19933f27d899SToby Isaac   PetscBool              uniform, trimmed;
19943f27d899SToby Isaac   Petsc1DNodeFamily      nodeFamily;
19953f27d899SToby Isaac   PetscInt               numNodeSkip;
19963f27d899SToby Isaac   DMPlexInterpolatedFlag interpolated;
19973f27d899SToby Isaac   PetscBool              isbdm;
19986f905325SMatthew G. Knepley 
19996f905325SMatthew G. Knepley   PetscFunctionBegin;
20003f27d899SToby Isaac   /* step 1: sanitize input */
20019566063dSJacob Faibussowitsch   PetscCall(PetscObjectGetComm((PetscObject)sp, &comm));
20029566063dSJacob Faibussowitsch   PetscCall(DMGetDimension(dm, &dim));
20039566063dSJacob Faibussowitsch   PetscCall(PetscObjectTypeCompare((PetscObject)sp, PETSCDUALSPACEBDM, &isbdm));
20043f27d899SToby Isaac   if (isbdm) {
20053f27d899SToby Isaac     sp->k = -(dim - 1); /* form degree of H-div */
20069566063dSJacob Faibussowitsch     PetscCall(PetscObjectChangeTypeName((PetscObject)sp, PETSCDUALSPACELAGRANGE));
20073f27d899SToby Isaac   }
20089566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetFormDegree(sp, &formDegree));
200908401ef6SPierre Jolivet   PetscCheck(PetscAbsInt(formDegree) <= dim, comm, PETSC_ERR_ARG_OUTOFRANGE, "Form degree must be bounded by dimension");
20109566063dSJacob Faibussowitsch   PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk));
20113f27d899SToby Isaac   if (sp->Nc <= 0 && lag->numCopies > 0) sp->Nc = Nk * lag->numCopies;
20123f27d899SToby Isaac   Nc = sp->Nc;
201308401ef6SPierre Jolivet   PetscCheck(Nc % Nk == 0, comm, PETSC_ERR_ARG_INCOMP, "Number of components is not a multiple of form degree size");
20143f27d899SToby Isaac   if (lag->numCopies <= 0) lag->numCopies = Nc / Nk;
20153f27d899SToby Isaac   Ncopies = lag->numCopies;
20161dca8a05SBarry Smith   PetscCheck(Nc / Nk == Ncopies, comm, PETSC_ERR_ARG_INCOMP, "Number of copies * (dim choose k) != Nc");
20173f27d899SToby Isaac   if (!dim) sp->order = 0;
20183f27d899SToby Isaac   order   = sp->order;
20193f27d899SToby Isaac   uniform = sp->uniform;
202028b400f6SJacob Faibussowitsch   PetscCheck(uniform, PETSC_COMM_SELF, PETSC_ERR_SUP, "Variable order not supported yet");
20213f27d899SToby Isaac   if (lag->trimmed && !formDegree) lag->trimmed = PETSC_FALSE; /* trimmed spaces are the same as full spaces for 0-forms */
20223f27d899SToby Isaac   if (lag->nodeType == PETSCDTNODES_DEFAULT) {
20233f27d899SToby Isaac     lag->nodeType     = PETSCDTNODES_GAUSSJACOBI;
20243f27d899SToby Isaac     lag->nodeExponent = 0.;
20253f27d899SToby Isaac     /* trimmed spaces don't include corner vertices, so don't use end nodes by default */
20263f27d899SToby Isaac     lag->endNodes = lag->trimmed ? PETSC_FALSE : PETSC_TRUE;
20273f27d899SToby Isaac   }
20283f27d899SToby Isaac   /* If a trimmed space and the user did choose nodes with endpoints, skip them by default */
20293f27d899SToby Isaac   if (lag->numNodeSkip < 0) lag->numNodeSkip = (lag->trimmed && lag->endNodes) ? 1 : 0;
20303f27d899SToby Isaac   numNodeSkip = lag->numNodeSkip;
203108401ef6SPierre Jolivet   PetscCheck(!lag->trimmed || order, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Cannot have zeroth order trimmed elements");
20323f27d899SToby Isaac   if (lag->trimmed && PetscAbsInt(formDegree) == dim) { /* convert trimmed n-forms to untrimmed of one polynomial order less */
20333f27d899SToby Isaac     sp->order--;
20343f27d899SToby Isaac     order--;
20353f27d899SToby Isaac     lag->trimmed = PETSC_FALSE;
20363f27d899SToby Isaac   }
20373f27d899SToby Isaac   trimmed = lag->trimmed;
20383f27d899SToby Isaac   if (!order || PetscAbsInt(formDegree) == dim) lag->continuous = PETSC_FALSE;
20393f27d899SToby Isaac   continuous = lag->continuous;
20409566063dSJacob Faibussowitsch   PetscCall(DMPlexGetDepth(dm, &depth));
20419566063dSJacob Faibussowitsch   PetscCall(DMPlexGetChart(dm, &pStart, &pEnd));
20429566063dSJacob Faibussowitsch   PetscCall(DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd));
20431dca8a05SBarry Smith   PetscCheck(pStart == 0 && cStart == 0, PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_WRONGSTATE, "Expect DM with chart starting at zero and cells first");
204408401ef6SPierre Jolivet   PetscCheck(cEnd == 1, PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_WRONGSTATE, "Use PETSCDUALSPACEREFINED for multi-cell reference meshes");
20459566063dSJacob Faibussowitsch   PetscCall(DMPlexIsInterpolated(dm, &interpolated));
20463f27d899SToby Isaac   if (interpolated != DMPLEX_INTERPOLATED_FULL) {
20479566063dSJacob Faibussowitsch     PetscCall(DMPlexInterpolate(dm, &dmint));
20483f27d899SToby Isaac   } else {
20499566063dSJacob Faibussowitsch     PetscCall(PetscObjectReference((PetscObject)dm));
20503f27d899SToby Isaac     dmint = dm;
20513f27d899SToby Isaac   }
20523f27d899SToby Isaac   tensorCell = PETSC_FALSE;
205348a46eb9SPierre Jolivet   if (dim > 1) PetscCall(DMPlexPointIsTensor(dmint, 0, &tensorCell, &tensorf, &tensorf2));
20543f27d899SToby Isaac   lag->tensorCell = tensorCell;
20553f27d899SToby Isaac   if (dim < 2 || !lag->tensorCell) lag->tensorSpace = PETSC_FALSE;
20566f905325SMatthew G. Knepley   tensorSpace = lag->tensorSpace;
205748a46eb9SPierre Jolivet   if (!lag->nodeFamily) PetscCall(Petsc1DNodeFamilyCreate(lag->nodeType, lag->nodeExponent, lag->endNodes, &lag->nodeFamily));
20583f27d899SToby Isaac   nodeFamily = lag->nodeFamily;
20591dca8a05SBarry Smith   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");
206020cf1dd8SToby Isaac 
20612dce792eSToby Isaac   if (Ncopies > 1) {
20622dce792eSToby Isaac     PetscDualSpace scalarsp;
20632dce792eSToby Isaac 
20642dce792eSToby Isaac     PetscCall(PetscDualSpaceDuplicate(sp, &scalarsp));
20652dce792eSToby Isaac     /* Setting the number of components to Nk is a space with 1 copy of each k-form */
20662dce792eSToby Isaac     sp->setupcalled = PETSC_FALSE;
20672dce792eSToby Isaac     PetscCall(PetscDualSpaceSetNumComponents(scalarsp, Nk));
20682dce792eSToby Isaac     PetscCall(PetscDualSpaceSetUp(scalarsp));
20692dce792eSToby Isaac     PetscCall(PetscDualSpaceSetType(sp, PETSCDUALSPACESUM));
20702dce792eSToby Isaac     PetscCall(PetscDualSpaceSumSetNumSubspaces(sp, Ncopies));
20712dce792eSToby Isaac     PetscCall(PetscDualSpaceSumSetConcatenate(sp, PETSC_TRUE));
20722dce792eSToby Isaac     PetscCall(PetscDualSpaceSumSetInterleave(sp, PETSC_TRUE, PETSC_FALSE));
20732dce792eSToby Isaac     for (PetscInt i = 0; i < Ncopies; i++) PetscCall(PetscDualSpaceSumSetSubspace(sp, i, scalarsp));
20742dce792eSToby Isaac     PetscCall(PetscDualSpaceSetUp(sp));
20752dce792eSToby Isaac     PetscCall(PetscDualSpaceDestroy(&scalarsp));
20762dce792eSToby Isaac     PetscCall(DMDestroy(&dmint));
20772dce792eSToby Isaac     PetscFunctionReturn(PETSC_SUCCESS);
20782dce792eSToby Isaac   }
20792dce792eSToby Isaac 
20803f27d899SToby Isaac   /* step 2: construct the boundary spaces */
20819566063dSJacob Faibussowitsch   PetscCall(PetscMalloc2(depth + 1, &pStratStart, depth + 1, &pStratEnd));
2082f4f49eeaSPierre Jolivet   PetscCall(PetscCalloc1(pEnd, &sp->pointSpaces));
20839566063dSJacob Faibussowitsch   for (d = 0; d <= depth; ++d) PetscCall(DMPlexGetDepthStratum(dm, d, &pStratStart[d], &pStratEnd[d]));
20849566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceSectionCreate_Internal(sp, &section));
20853f27d899SToby Isaac   sp->pointSection = section;
2086f4f49eeaSPierre Jolivet   if (continuous && !lag->interiorOnly) {
20873f27d899SToby Isaac     PetscInt h;
20886f905325SMatthew G. Knepley 
20893f27d899SToby Isaac     for (p = pStratStart[depth - 1]; p < pStratEnd[depth - 1]; p++) { /* calculate the facet dual spaces */
20903f27d899SToby Isaac       PetscReal      v0[3];
20913f27d899SToby Isaac       DMPolytopeType ptype;
20923f27d899SToby Isaac       PetscReal      J[9], detJ;
20936f905325SMatthew G. Knepley       PetscInt       q;
20946f905325SMatthew G. Knepley 
20959566063dSJacob Faibussowitsch       PetscCall(DMPlexComputeCellGeometryAffineFEM(dm, p, v0, J, NULL, &detJ));
20969566063dSJacob Faibussowitsch       PetscCall(DMPlexGetCellType(dm, p, &ptype));
20976f905325SMatthew G. Knepley 
209877f1a120SToby Isaac       /* compare to previous facets: if computed, reference that dualspace */
20993f27d899SToby Isaac       for (q = pStratStart[depth - 1]; q < p; q++) {
21003f27d899SToby Isaac         DMPolytopeType qtype;
21016f905325SMatthew G. Knepley 
21029566063dSJacob Faibussowitsch         PetscCall(DMPlexGetCellType(dm, q, &qtype));
21033f27d899SToby Isaac         if (qtype == ptype) break;
21046f905325SMatthew G. Knepley       }
21053f27d899SToby Isaac       if (q < p) { /* this facet has the same dual space as that one */
21069566063dSJacob Faibussowitsch         PetscCall(PetscObjectReference((PetscObject)sp->pointSpaces[q]));
21073f27d899SToby Isaac         sp->pointSpaces[p] = sp->pointSpaces[q];
21083f27d899SToby Isaac         continue;
21096f905325SMatthew G. Knepley       }
21103f27d899SToby Isaac       /* if not, recursively compute this dual space */
21119566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceCreateFacetSubspace_Lagrange(sp, NULL, p, formDegree, Ncopies, PETSC_FALSE, &sp->pointSpaces[p]));
21126f905325SMatthew G. Knepley     }
21133f27d899SToby Isaac     for (h = 2; h <= depth; h++) { /* get the higher subspaces from the facet subspaces */
21143f27d899SToby Isaac       PetscInt hd   = depth - h;
21153f27d899SToby Isaac       PetscInt hdim = dim - h;
21166f905325SMatthew G. Knepley 
21173f27d899SToby Isaac       if (hdim < PetscAbsInt(formDegree)) break;
21183f27d899SToby Isaac       for (p = pStratStart[hd]; p < pStratEnd[hd]; p++) {
21193f27d899SToby Isaac         PetscInt        suppSize, s;
21203f27d899SToby Isaac         const PetscInt *supp;
21216f905325SMatthew G. Knepley 
21229566063dSJacob Faibussowitsch         PetscCall(DMPlexGetSupportSize(dm, p, &suppSize));
21239566063dSJacob Faibussowitsch         PetscCall(DMPlexGetSupport(dm, p, &supp));
21243f27d899SToby Isaac         for (s = 0; s < suppSize; s++) {
21253f27d899SToby Isaac           DM              qdm;
21263f27d899SToby Isaac           PetscDualSpace  qsp, psp;
21273f27d899SToby Isaac           PetscInt        c, coneSize, q;
21283f27d899SToby Isaac           const PetscInt *cone;
21293f27d899SToby Isaac           const PetscInt *refCone;
21306f905325SMatthew G. Knepley 
21312dce792eSToby Isaac           q   = supp[s];
21323f27d899SToby Isaac           qsp = sp->pointSpaces[q];
21339566063dSJacob Faibussowitsch           PetscCall(DMPlexGetConeSize(dm, q, &coneSize));
21349566063dSJacob Faibussowitsch           PetscCall(DMPlexGetCone(dm, q, &cone));
21359371c9d4SSatish Balay           for (c = 0; c < coneSize; c++)
21369371c9d4SSatish Balay             if (cone[c] == p) break;
213708401ef6SPierre Jolivet           PetscCheck(c != coneSize, PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "cone/support mismatch");
21389566063dSJacob Faibussowitsch           PetscCall(PetscDualSpaceGetDM(qsp, &qdm));
21399566063dSJacob Faibussowitsch           PetscCall(DMPlexGetCone(qdm, 0, &refCone));
21403f27d899SToby Isaac           /* get the equivalent dual space from the support dual space */
21419566063dSJacob Faibussowitsch           PetscCall(PetscDualSpaceGetPointSubspace(qsp, refCone[c], &psp));
21423f27d899SToby Isaac           if (!s) {
21439566063dSJacob Faibussowitsch             PetscCall(PetscObjectReference((PetscObject)psp));
21443f27d899SToby Isaac             sp->pointSpaces[p] = psp;
21453f27d899SToby Isaac           }
21463f27d899SToby Isaac         }
21473f27d899SToby Isaac       }
21483f27d899SToby Isaac     }
21493f27d899SToby Isaac     for (p = 1; p < pEnd; p++) {
21503f27d899SToby Isaac       PetscInt pspdim;
21513f27d899SToby Isaac       if (!sp->pointSpaces[p]) continue;
21529566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceGetInteriorDimension(sp->pointSpaces[p], &pspdim));
21539566063dSJacob Faibussowitsch       PetscCall(PetscSectionSetDof(section, p, pspdim));
21543f27d899SToby Isaac     }
21553f27d899SToby Isaac   }
21566f905325SMatthew G. Knepley 
21573f27d899SToby Isaac   if (trimmed && !continuous) {
21583f27d899SToby Isaac     /* the dofs of a trimmed space don't have a nice tensor/lattice structure:
21593f27d899SToby Isaac      * just construct the continuous dual space and copy all of the data over,
21603f27d899SToby Isaac      * allocating it all to the cell instead of splitting it up between the boundaries */
21613f27d899SToby Isaac     PetscDualSpace      spcont;
21623f27d899SToby Isaac     PetscInt            spdim, f;
21633f27d899SToby Isaac     PetscQuadrature     allNodes;
21643f27d899SToby Isaac     PetscDualSpace_Lag *lagc;
21653f27d899SToby Isaac     Mat                 allMat;
21663f27d899SToby Isaac 
21679566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceDuplicate(sp, &spcont));
21689566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceLagrangeSetContinuity(spcont, PETSC_TRUE));
21699566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceSetUp(spcont));
21709566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceGetDimension(spcont, &spdim));
21713f27d899SToby Isaac     sp->spdim = sp->spintdim = spdim;
21729566063dSJacob Faibussowitsch     PetscCall(PetscSectionSetDof(section, 0, spdim));
21739566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section));
2174f4f49eeaSPierre Jolivet     PetscCall(PetscMalloc1(spdim, &sp->functional));
21753f27d899SToby Isaac     for (f = 0; f < spdim; f++) {
21763f27d899SToby Isaac       PetscQuadrature fn;
21773f27d899SToby Isaac 
21789566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceGetFunctional(spcont, f, &fn));
21799566063dSJacob Faibussowitsch       PetscCall(PetscObjectReference((PetscObject)fn));
21803f27d899SToby Isaac       sp->functional[f] = fn;
21813f27d899SToby Isaac     }
21829566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceGetAllData(spcont, &allNodes, &allMat));
21839566063dSJacob Faibussowitsch     PetscCall(PetscObjectReference((PetscObject)allNodes));
21849566063dSJacob Faibussowitsch     PetscCall(PetscObjectReference((PetscObject)allNodes));
21853f27d899SToby Isaac     sp->allNodes = sp->intNodes = allNodes;
21869566063dSJacob Faibussowitsch     PetscCall(PetscObjectReference((PetscObject)allMat));
21879566063dSJacob Faibussowitsch     PetscCall(PetscObjectReference((PetscObject)allMat));
21883f27d899SToby Isaac     sp->allMat = sp->intMat = allMat;
21893f27d899SToby Isaac     lagc                    = (PetscDualSpace_Lag *)spcont->data;
21909566063dSJacob Faibussowitsch     PetscCall(PetscLagNodeIndicesReference(lagc->vertIndices));
21913f27d899SToby Isaac     lag->vertIndices = lagc->vertIndices;
21929566063dSJacob Faibussowitsch     PetscCall(PetscLagNodeIndicesReference(lagc->allNodeIndices));
21939566063dSJacob Faibussowitsch     PetscCall(PetscLagNodeIndicesReference(lagc->allNodeIndices));
21943f27d899SToby Isaac     lag->intNodeIndices = lagc->allNodeIndices;
21953f27d899SToby Isaac     lag->allNodeIndices = lagc->allNodeIndices;
21969566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceDestroy(&spcont));
21979566063dSJacob Faibussowitsch     PetscCall(PetscFree2(pStratStart, pStratEnd));
21989566063dSJacob Faibussowitsch     PetscCall(DMDestroy(&dmint));
21993ba16761SJacob Faibussowitsch     PetscFunctionReturn(PETSC_SUCCESS);
22003f27d899SToby Isaac   }
22013f27d899SToby Isaac 
22023f27d899SToby Isaac   /* step 3: construct intNodes, and intMat, and combine it with boundray data to make allNodes and allMat */
22033f27d899SToby Isaac   if (!tensorSpace) {
2204f4f49eeaSPierre Jolivet     if (!tensorCell) PetscCall(PetscLagNodeIndicesCreateSimplexVertices(dm, &lag->vertIndices));
22053f27d899SToby Isaac 
22063f27d899SToby Isaac     if (trimmed) {
220777f1a120SToby Isaac       /* there is one dof in the interior of the a trimmed element for each full polynomial of with degree at most
220877f1a120SToby Isaac        * order + k - dim - 1 */
22093f27d899SToby Isaac       if (order + PetscAbsInt(formDegree) > dim) {
22103f27d899SToby Isaac         PetscInt sum = order + PetscAbsInt(formDegree) - dim - 1;
22113f27d899SToby Isaac         PetscInt nDofs;
22123f27d899SToby Isaac 
2213f4f49eeaSPierre Jolivet         PetscCall(PetscDualSpaceLagrangeCreateSimplexNodeMat(nodeFamily, dim, sum, Nk, numNodeSkip, &sp->intNodes, &sp->intMat, &lag->intNodeIndices));
22149566063dSJacob Faibussowitsch         PetscCall(MatGetSize(sp->intMat, &nDofs, NULL));
22159566063dSJacob Faibussowitsch         PetscCall(PetscSectionSetDof(section, 0, nDofs));
22163f27d899SToby Isaac       }
22179566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section));
22189566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceCreateAllDataFromInteriorData(sp));
22199566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceLagrangeCreateAllNodeIdx(sp));
22203f27d899SToby Isaac     } else {
22213f27d899SToby Isaac       if (!continuous) {
222277f1a120SToby Isaac         /* if discontinuous just construct one node for each set of dofs (a set of dofs is a basis for the k-form
222377f1a120SToby Isaac          * space) */
22243f27d899SToby Isaac         PetscInt sum = order;
22253f27d899SToby Isaac         PetscInt nDofs;
22263f27d899SToby Isaac 
2227f4f49eeaSPierre Jolivet         PetscCall(PetscDualSpaceLagrangeCreateSimplexNodeMat(nodeFamily, dim, sum, Nk, numNodeSkip, &sp->intNodes, &sp->intMat, &lag->intNodeIndices));
22289566063dSJacob Faibussowitsch         PetscCall(MatGetSize(sp->intMat, &nDofs, NULL));
22299566063dSJacob Faibussowitsch         PetscCall(PetscSectionSetDof(section, 0, nDofs));
22309566063dSJacob Faibussowitsch         PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section));
2231f4f49eeaSPierre Jolivet         PetscCall(PetscObjectReference((PetscObject)sp->intNodes));
22323f27d899SToby Isaac         sp->allNodes = sp->intNodes;
2233f4f49eeaSPierre Jolivet         PetscCall(PetscObjectReference((PetscObject)sp->intMat));
22343f27d899SToby Isaac         sp->allMat = sp->intMat;
22359566063dSJacob Faibussowitsch         PetscCall(PetscLagNodeIndicesReference(lag->intNodeIndices));
22363f27d899SToby Isaac         lag->allNodeIndices = lag->intNodeIndices;
22373f27d899SToby Isaac       } else {
223877f1a120SToby Isaac         /* there is one dof in the interior of the a full element for each trimmed polynomial of with degree at most
223977f1a120SToby Isaac          * order + k - dim, but with complementary form degree */
22403f27d899SToby Isaac         if (order + PetscAbsInt(formDegree) > dim) {
22413f27d899SToby Isaac           PetscDualSpace      trimmedsp;
22423f27d899SToby Isaac           PetscDualSpace_Lag *trimmedlag;
22433f27d899SToby Isaac           PetscQuadrature     intNodes;
22443f27d899SToby Isaac           PetscInt            trFormDegree = formDegree >= 0 ? formDegree - dim : dim - PetscAbsInt(formDegree);
22453f27d899SToby Isaac           PetscInt            nDofs;
22463f27d899SToby Isaac           Mat                 intMat;
22473f27d899SToby Isaac 
22489566063dSJacob Faibussowitsch           PetscCall(PetscDualSpaceDuplicate(sp, &trimmedsp));
22499566063dSJacob Faibussowitsch           PetscCall(PetscDualSpaceLagrangeSetTrimmed(trimmedsp, PETSC_TRUE));
22509566063dSJacob Faibussowitsch           PetscCall(PetscDualSpaceSetOrder(trimmedsp, order + PetscAbsInt(formDegree) - dim));
22519566063dSJacob Faibussowitsch           PetscCall(PetscDualSpaceSetFormDegree(trimmedsp, trFormDegree));
22523f27d899SToby Isaac           trimmedlag              = (PetscDualSpace_Lag *)trimmedsp->data;
22533f27d899SToby Isaac           trimmedlag->numNodeSkip = numNodeSkip + 1;
22549566063dSJacob Faibussowitsch           PetscCall(PetscDualSpaceSetUp(trimmedsp));
22559566063dSJacob Faibussowitsch           PetscCall(PetscDualSpaceGetAllData(trimmedsp, &intNodes, &intMat));
22569566063dSJacob Faibussowitsch           PetscCall(PetscObjectReference((PetscObject)intNodes));
22573f27d899SToby Isaac           sp->intNodes = intNodes;
22589566063dSJacob Faibussowitsch           PetscCall(PetscLagNodeIndicesReference(trimmedlag->allNodeIndices));
22593f27d899SToby Isaac           lag->intNodeIndices = trimmedlag->allNodeIndices;
22609566063dSJacob Faibussowitsch           PetscCall(PetscObjectReference((PetscObject)intMat));
22611f440fbeSToby Isaac           if (PetscAbsInt(formDegree) > 0 && PetscAbsInt(formDegree) < dim) {
22621f440fbeSToby Isaac             PetscReal   *T;
22631f440fbeSToby Isaac             PetscScalar *work;
22641f440fbeSToby Isaac             PetscInt     nCols, nRows;
22651f440fbeSToby Isaac             Mat          intMatT;
22661f440fbeSToby Isaac 
22679566063dSJacob Faibussowitsch             PetscCall(MatDuplicate(intMat, MAT_COPY_VALUES, &intMatT));
22689566063dSJacob Faibussowitsch             PetscCall(MatGetSize(intMat, &nRows, &nCols));
22699566063dSJacob Faibussowitsch             PetscCall(PetscMalloc2(Nk * Nk, &T, nCols, &work));
22709566063dSJacob Faibussowitsch             PetscCall(BiunitSimplexSymmetricFormTransformation(dim, formDegree, T));
22711f440fbeSToby Isaac             for (PetscInt row = 0; row < nRows; row++) {
22721f440fbeSToby Isaac               PetscInt           nrCols;
22731f440fbeSToby Isaac               const PetscInt    *rCols;
22741f440fbeSToby Isaac               const PetscScalar *rVals;
22751f440fbeSToby Isaac 
22769566063dSJacob Faibussowitsch               PetscCall(MatGetRow(intMat, row, &nrCols, &rCols, &rVals));
227708401ef6SPierre Jolivet               PetscCheck(nrCols % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in intMat matrix are not in k-form size blocks");
22781f440fbeSToby Isaac               for (PetscInt b = 0; b < nrCols; b += Nk) {
22791f440fbeSToby Isaac                 const PetscScalar *v = &rVals[b];
22801f440fbeSToby Isaac                 PetscScalar       *w = &work[b];
22811f440fbeSToby Isaac                 for (PetscInt j = 0; j < Nk; j++) {
22821f440fbeSToby Isaac                   w[j] = 0.;
2283ad540459SPierre Jolivet                   for (PetscInt i = 0; i < Nk; i++) w[j] += v[i] * T[i * Nk + j];
22841f440fbeSToby Isaac                 }
22851f440fbeSToby Isaac               }
22869566063dSJacob Faibussowitsch               PetscCall(MatSetValuesBlocked(intMatT, 1, &row, nrCols, rCols, work, INSERT_VALUES));
22879566063dSJacob Faibussowitsch               PetscCall(MatRestoreRow(intMat, row, &nrCols, &rCols, &rVals));
22881f440fbeSToby Isaac             }
22899566063dSJacob Faibussowitsch             PetscCall(MatAssemblyBegin(intMatT, MAT_FINAL_ASSEMBLY));
22909566063dSJacob Faibussowitsch             PetscCall(MatAssemblyEnd(intMatT, MAT_FINAL_ASSEMBLY));
22919566063dSJacob Faibussowitsch             PetscCall(MatDestroy(&intMat));
22921f440fbeSToby Isaac             intMat = intMatT;
2293f4f49eeaSPierre Jolivet             PetscCall(PetscLagNodeIndicesDestroy(&lag->intNodeIndices));
2294f4f49eeaSPierre Jolivet             PetscCall(PetscLagNodeIndicesDuplicate(trimmedlag->allNodeIndices, &lag->intNodeIndices));
22951f440fbeSToby Isaac             {
22961f440fbeSToby Isaac               PetscInt         nNodes     = lag->intNodeIndices->nNodes;
22971f440fbeSToby Isaac               PetscReal       *newNodeVec = lag->intNodeIndices->nodeVec;
22981f440fbeSToby Isaac               const PetscReal *oldNodeVec = trimmedlag->allNodeIndices->nodeVec;
22991f440fbeSToby Isaac 
23001f440fbeSToby Isaac               for (PetscInt n = 0; n < nNodes; n++) {
23011f440fbeSToby Isaac                 PetscReal       *w = &newNodeVec[n * Nk];
23021f440fbeSToby Isaac                 const PetscReal *v = &oldNodeVec[n * Nk];
23031f440fbeSToby Isaac 
23041f440fbeSToby Isaac                 for (PetscInt j = 0; j < Nk; j++) {
23051f440fbeSToby Isaac                   w[j] = 0.;
2306ad540459SPierre Jolivet                   for (PetscInt i = 0; i < Nk; i++) w[j] += v[i] * T[i * Nk + j];
23071f440fbeSToby Isaac                 }
23081f440fbeSToby Isaac               }
23091f440fbeSToby Isaac             }
23109566063dSJacob Faibussowitsch             PetscCall(PetscFree2(T, work));
23111f440fbeSToby Isaac           }
23121f440fbeSToby Isaac           sp->intMat = intMat;
23139566063dSJacob Faibussowitsch           PetscCall(MatGetSize(sp->intMat, &nDofs, NULL));
23149566063dSJacob Faibussowitsch           PetscCall(PetscDualSpaceDestroy(&trimmedsp));
23159566063dSJacob Faibussowitsch           PetscCall(PetscSectionSetDof(section, 0, nDofs));
23163f27d899SToby Isaac         }
23179566063dSJacob Faibussowitsch         PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section));
23189566063dSJacob Faibussowitsch         PetscCall(PetscDualSpaceCreateAllDataFromInteriorData(sp));
23199566063dSJacob Faibussowitsch         PetscCall(PetscDualSpaceLagrangeCreateAllNodeIdx(sp));
23203f27d899SToby Isaac       }
23213f27d899SToby Isaac     }
23223f27d899SToby Isaac   } else {
23233f27d899SToby Isaac     PetscQuadrature     intNodesTrace  = NULL;
23243f27d899SToby Isaac     PetscQuadrature     intNodesFiber  = NULL;
23253f27d899SToby Isaac     PetscQuadrature     intNodes       = NULL;
23263f27d899SToby Isaac     PetscLagNodeIndices intNodeIndices = NULL;
23273f27d899SToby Isaac     Mat                 intMat         = NULL;
23283f27d899SToby Isaac 
232977f1a120SToby Isaac     if (PetscAbsInt(formDegree) < dim) { /* get the trace k-forms on the first facet, and the 0-forms on the edge,
233077f1a120SToby Isaac                                             and wedge them together to create some of the k-form dofs */
23313f27d899SToby Isaac       PetscDualSpace      trace, fiber;
23323f27d899SToby Isaac       PetscDualSpace_Lag *tracel, *fiberl;
23333f27d899SToby Isaac       Mat                 intMatTrace, intMatFiber;
23343f27d899SToby Isaac 
23353f27d899SToby Isaac       if (sp->pointSpaces[tensorf]) {
2336f4f49eeaSPierre Jolivet         PetscCall(PetscObjectReference((PetscObject)sp->pointSpaces[tensorf]));
23373f27d899SToby Isaac         trace = sp->pointSpaces[tensorf];
23383f27d899SToby Isaac       } else {
23399566063dSJacob Faibussowitsch         PetscCall(PetscDualSpaceCreateFacetSubspace_Lagrange(sp, NULL, tensorf, formDegree, Ncopies, PETSC_TRUE, &trace));
23403f27d899SToby Isaac       }
23419566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceCreateEdgeSubspace_Lagrange(sp, order, 0, 1, PETSC_TRUE, &fiber));
23423f27d899SToby Isaac       tracel = (PetscDualSpace_Lag *)trace->data;
23433f27d899SToby Isaac       fiberl = (PetscDualSpace_Lag *)fiber->data;
2344f4f49eeaSPierre Jolivet       PetscCall(PetscLagNodeIndicesCreateTensorVertices(dm, tracel->vertIndices, &lag->vertIndices));
23459566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceGetInteriorData(trace, &intNodesTrace, &intMatTrace));
23469566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceGetInteriorData(fiber, &intNodesFiber, &intMatFiber));
23473f27d899SToby Isaac       if (intNodesTrace && intNodesFiber) {
23489566063dSJacob Faibussowitsch         PetscCall(PetscQuadratureCreateTensor(intNodesTrace, intNodesFiber, &intNodes));
23499566063dSJacob Faibussowitsch         PetscCall(MatTensorAltV(intMatTrace, intMatFiber, dim - 1, formDegree, 1, 0, &intMat));
23509566063dSJacob Faibussowitsch         PetscCall(PetscLagNodeIndicesTensor(tracel->intNodeIndices, dim - 1, formDegree, fiberl->intNodeIndices, 1, 0, &intNodeIndices));
23513f27d899SToby Isaac       }
23529566063dSJacob Faibussowitsch       PetscCall(PetscObjectReference((PetscObject)intNodesTrace));
23539566063dSJacob Faibussowitsch       PetscCall(PetscObjectReference((PetscObject)intNodesFiber));
23549566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceDestroy(&fiber));
23559566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceDestroy(&trace));
23563f27d899SToby Isaac     }
235777f1a120SToby Isaac     if (PetscAbsInt(formDegree) > 0) { /* get the trace (k-1)-forms on the first facet, and the 1-forms on the edge,
235877f1a120SToby Isaac                                           and wedge them together to create the remaining k-form dofs */
23593f27d899SToby Isaac       PetscDualSpace      trace, fiber;
23603f27d899SToby Isaac       PetscDualSpace_Lag *tracel, *fiberl;
23613f27d899SToby Isaac       PetscQuadrature     intNodesTrace2, intNodesFiber2, intNodes2;
23623f27d899SToby Isaac       PetscLagNodeIndices intNodeIndices2;
23633f27d899SToby Isaac       Mat                 intMatTrace, intMatFiber, intMat2;
23643f27d899SToby Isaac       PetscInt            traceDegree = formDegree > 0 ? formDegree - 1 : formDegree + 1;
23653f27d899SToby Isaac       PetscInt            fiberDegree = formDegree > 0 ? 1 : -1;
23663f27d899SToby Isaac 
23679566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceCreateFacetSubspace_Lagrange(sp, NULL, tensorf, traceDegree, Ncopies, PETSC_TRUE, &trace));
23689566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceCreateEdgeSubspace_Lagrange(sp, order, fiberDegree, 1, PETSC_TRUE, &fiber));
23693f27d899SToby Isaac       tracel = (PetscDualSpace_Lag *)trace->data;
23703f27d899SToby Isaac       fiberl = (PetscDualSpace_Lag *)fiber->data;
2371f4f49eeaSPierre Jolivet       if (!lag->vertIndices) PetscCall(PetscLagNodeIndicesCreateTensorVertices(dm, tracel->vertIndices, &lag->vertIndices));
23729566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceGetInteriorData(trace, &intNodesTrace2, &intMatTrace));
23739566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceGetInteriorData(fiber, &intNodesFiber2, &intMatFiber));
23743f27d899SToby Isaac       if (intNodesTrace2 && intNodesFiber2) {
23759566063dSJacob Faibussowitsch         PetscCall(PetscQuadratureCreateTensor(intNodesTrace2, intNodesFiber2, &intNodes2));
23769566063dSJacob Faibussowitsch         PetscCall(MatTensorAltV(intMatTrace, intMatFiber, dim - 1, traceDegree, 1, fiberDegree, &intMat2));
23779566063dSJacob Faibussowitsch         PetscCall(PetscLagNodeIndicesTensor(tracel->intNodeIndices, dim - 1, traceDegree, fiberl->intNodeIndices, 1, fiberDegree, &intNodeIndices2));
23783f27d899SToby Isaac         if (!intMat) {
23793f27d899SToby Isaac           intMat         = intMat2;
23803f27d899SToby Isaac           intNodes       = intNodes2;
23813f27d899SToby Isaac           intNodeIndices = intNodeIndices2;
23823f27d899SToby Isaac         } else {
238377f1a120SToby Isaac           /* merge the matrices, quadrature points, and nodes */
23843f27d899SToby Isaac           PetscInt            nM;
23853f27d899SToby Isaac           PetscInt            nDof, nDof2;
23866ff15688SToby Isaac           PetscInt           *toMerged = NULL, *toMerged2 = NULL;
23876ff15688SToby Isaac           PetscQuadrature     merged               = NULL;
23883f27d899SToby Isaac           PetscLagNodeIndices intNodeIndicesMerged = NULL;
23893f27d899SToby Isaac           Mat                 matMerged            = NULL;
23903f27d899SToby Isaac 
23919566063dSJacob Faibussowitsch           PetscCall(MatGetSize(intMat, &nDof, NULL));
23929566063dSJacob Faibussowitsch           PetscCall(MatGetSize(intMat2, &nDof2, NULL));
23939566063dSJacob Faibussowitsch           PetscCall(PetscQuadraturePointsMerge(intNodes, intNodes2, &merged, &toMerged, &toMerged2));
23949566063dSJacob Faibussowitsch           PetscCall(PetscQuadratureGetData(merged, NULL, NULL, &nM, NULL, NULL));
23959566063dSJacob Faibussowitsch           PetscCall(MatricesMerge(intMat, intMat2, dim, formDegree, nM, toMerged, toMerged2, &matMerged));
23969566063dSJacob Faibussowitsch           PetscCall(PetscLagNodeIndicesMerge(intNodeIndices, intNodeIndices2, &intNodeIndicesMerged));
23979566063dSJacob Faibussowitsch           PetscCall(PetscFree(toMerged));
23989566063dSJacob Faibussowitsch           PetscCall(PetscFree(toMerged2));
23999566063dSJacob Faibussowitsch           PetscCall(MatDestroy(&intMat));
24009566063dSJacob Faibussowitsch           PetscCall(MatDestroy(&intMat2));
24019566063dSJacob Faibussowitsch           PetscCall(PetscQuadratureDestroy(&intNodes));
24029566063dSJacob Faibussowitsch           PetscCall(PetscQuadratureDestroy(&intNodes2));
24039566063dSJacob Faibussowitsch           PetscCall(PetscLagNodeIndicesDestroy(&intNodeIndices));
24049566063dSJacob Faibussowitsch           PetscCall(PetscLagNodeIndicesDestroy(&intNodeIndices2));
24053f27d899SToby Isaac           intNodes       = merged;
24063f27d899SToby Isaac           intMat         = matMerged;
24073f27d899SToby Isaac           intNodeIndices = intNodeIndicesMerged;
24083f27d899SToby Isaac           if (!trimmed) {
240977f1a120SToby Isaac             /* I think users expect that, when a node has a full basis for the k-forms,
241077f1a120SToby Isaac              * they should be consecutive dofs.  That isn't the case for trimmed spaces,
241177f1a120SToby Isaac              * but is for some of the nodes in untrimmed spaces, so in that case we
241277f1a120SToby Isaac              * sort them to group them by node */
24133f27d899SToby Isaac             Mat intMatPerm;
24143f27d899SToby Isaac 
24159566063dSJacob Faibussowitsch             PetscCall(MatPermuteByNodeIdx(intMat, intNodeIndices, &intMatPerm));
24169566063dSJacob Faibussowitsch             PetscCall(MatDestroy(&intMat));
24173f27d899SToby Isaac             intMat = intMatPerm;
24183f27d899SToby Isaac           }
24193f27d899SToby Isaac         }
24203f27d899SToby Isaac       }
24219566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceDestroy(&fiber));
24229566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceDestroy(&trace));
24233f27d899SToby Isaac     }
24249566063dSJacob Faibussowitsch     PetscCall(PetscQuadratureDestroy(&intNodesTrace));
24259566063dSJacob Faibussowitsch     PetscCall(PetscQuadratureDestroy(&intNodesFiber));
24263f27d899SToby Isaac     sp->intNodes        = intNodes;
24273f27d899SToby Isaac     sp->intMat          = intMat;
24283f27d899SToby Isaac     lag->intNodeIndices = intNodeIndices;
24296f905325SMatthew G. Knepley     {
24303f27d899SToby Isaac       PetscInt nDofs = 0;
24313f27d899SToby Isaac 
243248a46eb9SPierre Jolivet       if (intMat) PetscCall(MatGetSize(intMat, &nDofs, NULL));
24339566063dSJacob Faibussowitsch       PetscCall(PetscSectionSetDof(section, 0, nDofs));
24343f27d899SToby Isaac     }
24359566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section));
24363f27d899SToby Isaac     if (continuous) {
24379566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceCreateAllDataFromInteriorData(sp));
24389566063dSJacob Faibussowitsch       PetscCall(PetscDualSpaceLagrangeCreateAllNodeIdx(sp));
24393f27d899SToby Isaac     } else {
24409566063dSJacob Faibussowitsch       PetscCall(PetscObjectReference((PetscObject)intNodes));
24413f27d899SToby Isaac       sp->allNodes = intNodes;
24429566063dSJacob Faibussowitsch       PetscCall(PetscObjectReference((PetscObject)intMat));
24433f27d899SToby Isaac       sp->allMat = intMat;
24449566063dSJacob Faibussowitsch       PetscCall(PetscLagNodeIndicesReference(intNodeIndices));
24453f27d899SToby Isaac       lag->allNodeIndices = intNodeIndices;
24463f27d899SToby Isaac     }
24473f27d899SToby Isaac   }
24489566063dSJacob Faibussowitsch   PetscCall(PetscSectionGetStorageSize(section, &sp->spdim));
24499566063dSJacob Faibussowitsch   PetscCall(PetscSectionGetConstrainedStorageSize(section, &sp->spintdim));
24502dce792eSToby Isaac   // TODO: fix this, computing functionals from moments should be no different for nodal vs modal
24512dce792eSToby Isaac   if (lag->useMoments) {
24522dce792eSToby Isaac     PetscCall(PetscDualSpaceComputeFunctionalsFromAllData_Moments(sp));
24532dce792eSToby Isaac   } else {
24549566063dSJacob Faibussowitsch     PetscCall(PetscDualSpaceComputeFunctionalsFromAllData(sp));
24552dce792eSToby Isaac   }
24569566063dSJacob Faibussowitsch   PetscCall(PetscFree2(pStratStart, pStratEnd));
24579566063dSJacob Faibussowitsch   PetscCall(DMDestroy(&dmint));
24583ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
24593f27d899SToby Isaac }
24603f27d899SToby Isaac 
246177f1a120SToby Isaac /* Create a matrix that represents the transformation that DMPlexVecGetClosure() would need
246277f1a120SToby Isaac  * to get the representation of the dofs for a mesh point if the mesh point had this orientation
246377f1a120SToby Isaac  * relative to the cell */
PetscDualSpaceCreateInteriorSymmetryMatrix_Lagrange(PetscDualSpace sp,PetscInt ornt,Mat * symMat)2464d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceCreateInteriorSymmetryMatrix_Lagrange(PetscDualSpace sp, PetscInt ornt, Mat *symMat)
2465d71ae5a4SJacob Faibussowitsch {
24663f27d899SToby Isaac   PetscDualSpace_Lag *lag;
24673f27d899SToby Isaac   DM                  dm;
24683f27d899SToby Isaac   PetscLagNodeIndices vertIndices, intNodeIndices;
24693f27d899SToby Isaac   PetscLagNodeIndices ni;
24703f27d899SToby Isaac   PetscInt            nodeIdxDim, nodeVecDim, nNodes;
24713f27d899SToby Isaac   PetscInt            formDegree;
24723f27d899SToby Isaac   PetscInt           *perm, *permOrnt;
24733f27d899SToby Isaac   PetscInt           *nnz;
24743f27d899SToby Isaac   PetscInt            n;
24753f27d899SToby Isaac   PetscInt            maxGroupSize;
24763f27d899SToby Isaac   PetscScalar        *V, *W, *work;
24773f27d899SToby Isaac   Mat                 A;
24786f905325SMatthew G. Knepley 
24796f905325SMatthew G. Knepley   PetscFunctionBegin;
24803f27d899SToby Isaac   if (!sp->spintdim) {
24813f27d899SToby Isaac     *symMat = NULL;
24823ba16761SJacob Faibussowitsch     PetscFunctionReturn(PETSC_SUCCESS);
24836f905325SMatthew G. Knepley   }
24843f27d899SToby Isaac   lag            = (PetscDualSpace_Lag *)sp->data;
24853f27d899SToby Isaac   vertIndices    = lag->vertIndices;
24863f27d899SToby Isaac   intNodeIndices = lag->intNodeIndices;
24879566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetDM(sp, &dm));
24889566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetFormDegree(sp, &formDegree));
24899566063dSJacob Faibussowitsch   PetscCall(PetscNew(&ni));
24903f27d899SToby Isaac   ni->refct      = 1;
24913f27d899SToby Isaac   ni->nodeIdxDim = nodeIdxDim = intNodeIndices->nodeIdxDim;
24923f27d899SToby Isaac   ni->nodeVecDim = nodeVecDim = intNodeIndices->nodeVecDim;
24933f27d899SToby Isaac   ni->nNodes = nNodes = intNodeIndices->nNodes;
2494f4f49eeaSPierre Jolivet   PetscCall(PetscMalloc1(nNodes * nodeIdxDim, &ni->nodeIdx));
2495f4f49eeaSPierre Jolivet   PetscCall(PetscMalloc1(nNodes * nodeVecDim, &ni->nodeVec));
249677f1a120SToby Isaac   /* push forward the dofs by the symmetry of the reference element induced by ornt */
24979566063dSJacob Faibussowitsch   PetscCall(PetscLagNodeIndicesPushForward(dm, vertIndices, 0, vertIndices, intNodeIndices, ornt, formDegree, ni->nodeIdx, ni->nodeVec));
249877f1a120SToby Isaac   /* get the revlex order for both the original and transformed dofs */
24999566063dSJacob Faibussowitsch   PetscCall(PetscLagNodeIndicesGetPermutation(intNodeIndices, &perm));
25009566063dSJacob Faibussowitsch   PetscCall(PetscLagNodeIndicesGetPermutation(ni, &permOrnt));
25019566063dSJacob Faibussowitsch   PetscCall(PetscMalloc1(nNodes, &nnz));
25023f27d899SToby Isaac   for (n = 0, maxGroupSize = 0; n < nNodes;) { /* incremented in the loop */
25033f27d899SToby Isaac     PetscInt *nind = &(ni->nodeIdx[permOrnt[n] * nodeIdxDim]);
25043f27d899SToby Isaac     PetscInt  m, nEnd;
25053f27d899SToby Isaac     PetscInt  groupSize;
250677f1a120SToby Isaac     /* for each group of dofs that have the same nodeIdx coordinate */
25073f27d899SToby Isaac     for (nEnd = n + 1; nEnd < nNodes; nEnd++) {
25083f27d899SToby Isaac       PetscInt *mind = &(ni->nodeIdx[permOrnt[nEnd] * nodeIdxDim]);
25093f27d899SToby Isaac       PetscInt  d;
25103f27d899SToby Isaac 
25113f27d899SToby Isaac       /* compare the oriented permutation indices */
25129371c9d4SSatish Balay       for (d = 0; d < nodeIdxDim; d++)
25139371c9d4SSatish Balay         if (mind[d] != nind[d]) break;
25143f27d899SToby Isaac       if (d < nodeIdxDim) break;
25153f27d899SToby Isaac     }
251677f1a120SToby Isaac     /* permOrnt[[n, nEnd)] is a group of dofs that, under the symmetry are at the same location */
251776bd3646SJed Brown 
251877f1a120SToby Isaac     /* the symmetry had better map the group of dofs with the same permuted nodeIdx
251977f1a120SToby Isaac      * to a group of dofs with the same size, otherwise we messed up */
252076bd3646SJed Brown     if (PetscDefined(USE_DEBUG)) {
25213f27d899SToby Isaac       PetscInt  m;
25223f27d899SToby Isaac       PetscInt *nind = &(intNodeIndices->nodeIdx[perm[n] * nodeIdxDim]);
25233f27d899SToby Isaac 
25243f27d899SToby Isaac       for (m = n + 1; m < nEnd; m++) {
25253f27d899SToby Isaac         PetscInt *mind = &(intNodeIndices->nodeIdx[perm[m] * nodeIdxDim]);
25263f27d899SToby Isaac         PetscInt  d;
25273f27d899SToby Isaac 
25283f27d899SToby Isaac         /* compare the oriented permutation indices */
25299371c9d4SSatish Balay         for (d = 0; d < nodeIdxDim; d++)
25309371c9d4SSatish Balay           if (mind[d] != nind[d]) break;
25313f27d899SToby Isaac         if (d < nodeIdxDim) break;
25323f27d899SToby Isaac       }
253308401ef6SPierre Jolivet       PetscCheck(m >= nEnd, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Dofs with same index after symmetry not same block size");
25343f27d899SToby Isaac     }
25353f27d899SToby Isaac     groupSize = nEnd - n;
253677f1a120SToby Isaac     /* each pushforward dof vector will be expressed in a basis of the unpermuted dofs */
25373f27d899SToby Isaac     for (m = n; m < nEnd; m++) nnz[permOrnt[m]] = groupSize;
25383f27d899SToby Isaac 
25393f27d899SToby Isaac     maxGroupSize = PetscMax(maxGroupSize, nEnd - n);
25403f27d899SToby Isaac     n            = nEnd;
25413f27d899SToby Isaac   }
254208401ef6SPierre Jolivet   PetscCheck(maxGroupSize <= nodeVecDim, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Dofs are not in blocks that can be solved");
25439566063dSJacob Faibussowitsch   PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, nNodes, nNodes, 0, nnz, &A));
2544a243090dSMatthew G. Knepley   PetscCall(PetscObjectSetOptionsPrefix((PetscObject)A, "lag_"));
25459566063dSJacob Faibussowitsch   PetscCall(PetscFree(nnz));
25469566063dSJacob Faibussowitsch   PetscCall(PetscMalloc3(maxGroupSize * nodeVecDim, &V, maxGroupSize * nodeVecDim, &W, nodeVecDim * 2, &work));
25473f27d899SToby Isaac   for (n = 0; n < nNodes;) { /* incremented in the loop */
25483f27d899SToby Isaac     PetscInt *nind = &(ni->nodeIdx[permOrnt[n] * nodeIdxDim]);
25493f27d899SToby Isaac     PetscInt  nEnd;
25503f27d899SToby Isaac     PetscInt  m;
25513f27d899SToby Isaac     PetscInt  groupSize;
25523f27d899SToby Isaac     for (nEnd = n + 1; nEnd < nNodes; nEnd++) {
25533f27d899SToby Isaac       PetscInt *mind = &(ni->nodeIdx[permOrnt[nEnd] * nodeIdxDim]);
25543f27d899SToby Isaac       PetscInt  d;
25553f27d899SToby Isaac 
25563f27d899SToby Isaac       /* compare the oriented permutation indices */
25579371c9d4SSatish Balay       for (d = 0; d < nodeIdxDim; d++)
25589371c9d4SSatish Balay         if (mind[d] != nind[d]) break;
25593f27d899SToby Isaac       if (d < nodeIdxDim) break;
25603f27d899SToby Isaac     }
25613f27d899SToby Isaac     groupSize = nEnd - n;
256277f1a120SToby Isaac     /* get all of the vectors from the original and all of the pushforward vectors */
25633f27d899SToby Isaac     for (m = n; m < nEnd; m++) {
25643f27d899SToby Isaac       PetscInt d;
25653f27d899SToby Isaac 
25663f27d899SToby Isaac       for (d = 0; d < nodeVecDim; d++) {
25673f27d899SToby Isaac         V[(m - n) * nodeVecDim + d] = intNodeIndices->nodeVec[perm[m] * nodeVecDim + d];
25683f27d899SToby Isaac         W[(m - n) * nodeVecDim + d] = ni->nodeVec[permOrnt[m] * nodeVecDim + d];
25693f27d899SToby Isaac       }
25703f27d899SToby Isaac     }
257177f1a120SToby Isaac     /* now we have to solve for W in terms of V: the systems isn't always square, but the span
257277f1a120SToby Isaac      * of V and W should always be the same, so the solution of the normal equations works */
25733f27d899SToby Isaac     {
25743f27d899SToby Isaac       char         transpose = 'N';
25756497c311SBarry Smith       PetscBLASInt bm, bn, bnrhs, blda, bldb, blwork, info;
25763f27d899SToby Isaac 
25776497c311SBarry Smith       PetscCall(PetscBLASIntCast(nodeVecDim, &bm));
25786497c311SBarry Smith       PetscCall(PetscBLASIntCast(groupSize, &bn));
25796497c311SBarry Smith       PetscCall(PetscBLASIntCast(groupSize, &bnrhs));
25806497c311SBarry Smith       PetscCall(PetscBLASIntCast(bm, &blda));
25816497c311SBarry Smith       PetscCall(PetscBLASIntCast(bm, &bldb));
25826497c311SBarry Smith       PetscCall(PetscBLASIntCast(2 * nodeVecDim, &blwork));
2583792fecdfSBarry Smith       PetscCallBLAS("LAPACKgels", LAPACKgels_(&transpose, &bm, &bn, &bnrhs, V, &blda, W, &bldb, work, &blwork, &info));
258408401ef6SPierre Jolivet       PetscCheck(info == 0, PETSC_COMM_SELF, PETSC_ERR_LIB, "Bad argument to GELS");
25853f27d899SToby Isaac       /* repack */
25863f27d899SToby Isaac       {
25873f27d899SToby Isaac         PetscInt i, j;
25883f27d899SToby Isaac 
25893f27d899SToby Isaac         for (i = 0; i < groupSize; i++) {
25903f27d899SToby Isaac           for (j = 0; j < groupSize; j++) {
259177f1a120SToby Isaac             /* notice the different leading dimension */
25923f27d899SToby Isaac             V[i * groupSize + j] = W[i * nodeVecDim + j];
25933f27d899SToby Isaac           }
25943f27d899SToby Isaac         }
25953f27d899SToby Isaac       }
2596c5c386beSToby Isaac       if (PetscDefined(USE_DEBUG)) {
2597c5c386beSToby Isaac         PetscReal res;
2598c5c386beSToby Isaac 
2599c5c386beSToby Isaac         /* check that the normal error is 0 */
2600c5c386beSToby Isaac         for (m = n; m < nEnd; m++) {
2601c5c386beSToby Isaac           PetscInt d;
2602c5c386beSToby Isaac 
2603ad540459SPierre Jolivet           for (d = 0; d < nodeVecDim; d++) W[(m - n) * nodeVecDim + d] = ni->nodeVec[permOrnt[m] * nodeVecDim + d];
2604c5c386beSToby Isaac         }
2605c5c386beSToby Isaac         res = 0.;
2606c5c386beSToby Isaac         for (PetscInt i = 0; i < groupSize; i++) {
2607c5c386beSToby Isaac           for (PetscInt j = 0; j < nodeVecDim; j++) {
2608ad540459SPierre Jolivet             for (PetscInt k = 0; k < groupSize; k++) W[i * nodeVecDim + j] -= V[i * groupSize + k] * intNodeIndices->nodeVec[perm[n + k] * nodeVecDim + j];
2609c5c386beSToby Isaac             res += PetscAbsScalar(W[i * nodeVecDim + j]);
2610c5c386beSToby Isaac           }
2611c5c386beSToby Isaac         }
261208401ef6SPierre Jolivet         PetscCheck(res <= PETSC_SMALL, PETSC_COMM_SELF, PETSC_ERR_LIB, "Dof block did not solve");
2613c5c386beSToby Isaac       }
26143f27d899SToby Isaac     }
26159566063dSJacob Faibussowitsch     PetscCall(MatSetValues(A, groupSize, &permOrnt[n], groupSize, &perm[n], V, INSERT_VALUES));
26163f27d899SToby Isaac     n = nEnd;
26173f27d899SToby Isaac   }
26189566063dSJacob Faibussowitsch   PetscCall(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY));
26199566063dSJacob Faibussowitsch   PetscCall(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY));
26203f27d899SToby Isaac   *symMat = A;
26219566063dSJacob Faibussowitsch   PetscCall(PetscFree3(V, W, work));
26229566063dSJacob Faibussowitsch   PetscCall(PetscLagNodeIndicesDestroy(&ni));
26233ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
26246f905325SMatthew G. Knepley }
262520cf1dd8SToby Isaac 
26262dce792eSToby Isaac // get the symmetries of closure points
PetscDualSpaceGetBoundarySymmetries_Internal(PetscDualSpace sp,PetscInt *** symperms,PetscScalar *** symflips)26272dce792eSToby Isaac PETSC_INTERN PetscErrorCode PetscDualSpaceGetBoundarySymmetries_Internal(PetscDualSpace sp, PetscInt ***symperms, PetscScalar ***symflips)
26282dce792eSToby Isaac {
26292dce792eSToby Isaac   PetscInt  closureSize = 0;
26302dce792eSToby Isaac   PetscInt *closure     = NULL;
26312dce792eSToby Isaac   PetscInt  r;
26322dce792eSToby Isaac 
26332dce792eSToby Isaac   PetscFunctionBegin;
26342dce792eSToby Isaac   PetscCall(DMPlexGetTransitiveClosure(sp->dm, 0, PETSC_TRUE, &closureSize, &closure));
26352dce792eSToby Isaac   for (r = 0; r < closureSize; r++) {
26362dce792eSToby Isaac     PetscDualSpace       psp;
26372dce792eSToby Isaac     PetscInt             point = closure[2 * r];
26382dce792eSToby Isaac     PetscInt             pspintdim;
26392dce792eSToby Isaac     const PetscInt    ***psymperms = NULL;
26402dce792eSToby Isaac     const PetscScalar ***psymflips = NULL;
26412dce792eSToby Isaac 
26422dce792eSToby Isaac     if (!point) continue;
26432dce792eSToby Isaac     PetscCall(PetscDualSpaceGetPointSubspace(sp, point, &psp));
26442dce792eSToby Isaac     if (!psp) continue;
26452dce792eSToby Isaac     PetscCall(PetscDualSpaceGetInteriorDimension(psp, &pspintdim));
26462dce792eSToby Isaac     if (!pspintdim) continue;
26472dce792eSToby Isaac     PetscCall(PetscDualSpaceGetSymmetries(psp, &psymperms, &psymflips));
26482dce792eSToby Isaac     symperms[r] = (PetscInt **)(psymperms ? psymperms[0] : NULL);
26492dce792eSToby Isaac     symflips[r] = (PetscScalar **)(psymflips ? psymflips[0] : NULL);
26502dce792eSToby Isaac   }
26512dce792eSToby Isaac   PetscCall(DMPlexRestoreTransitiveClosure(sp->dm, 0, PETSC_TRUE, &closureSize, &closure));
26522dce792eSToby Isaac   PetscFunctionReturn(PETSC_SUCCESS);
26532dce792eSToby Isaac }
26542dce792eSToby Isaac 
265520cf1dd8SToby Isaac #define BaryIndex(perEdge, a, b, c) (((b) * (2 * perEdge + 1 - (b))) / 2) + (c)
265620cf1dd8SToby Isaac 
265720cf1dd8SToby Isaac #define CartIndex(perEdge, a, b) (perEdge * (a) + b)
265820cf1dd8SToby Isaac 
265977f1a120SToby Isaac /* the existing interface for symmetries is insufficient for all cases:
266077f1a120SToby Isaac  * - it should be sufficient for form degrees that are scalar (0 and n)
266177f1a120SToby Isaac  * - it should be sufficient for hypercube dofs
266277f1a120SToby Isaac  * - it isn't sufficient for simplex cells with non-scalar form degrees if
266377f1a120SToby Isaac  *   there are any dofs in the interior
266477f1a120SToby Isaac  *
266577f1a120SToby Isaac  * We compute the general transformation matrices, and if they fit, we return them,
266677f1a120SToby Isaac  * otherwise we error (but we should probably change the interface to allow for
266777f1a120SToby Isaac  * these symmetries)
266877f1a120SToby Isaac  */
PetscDualSpaceGetSymmetries_Lagrange(PetscDualSpace sp,const PetscInt **** perms,const PetscScalar **** flips)2669d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceGetSymmetries_Lagrange(PetscDualSpace sp, const PetscInt ****perms, const PetscScalar ****flips)
2670d71ae5a4SJacob Faibussowitsch {
267120cf1dd8SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
26723f27d899SToby Isaac   PetscInt            dim, order, Nc;
267320cf1dd8SToby Isaac 
267420cf1dd8SToby Isaac   PetscFunctionBegin;
26759566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetOrder(sp, &order));
26769566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceGetNumComponents(sp, &Nc));
26779566063dSJacob Faibussowitsch   PetscCall(DMGetDimension(sp->dm, &dim));
26783f27d899SToby Isaac   if (!lag->symComputed) { /* store symmetries */
26793f27d899SToby Isaac     PetscInt       pStart, pEnd, p;
26803f27d899SToby Isaac     PetscInt       numPoints;
268120cf1dd8SToby Isaac     PetscInt       numFaces;
26823f27d899SToby Isaac     PetscInt       spintdim;
26833f27d899SToby Isaac     PetscInt    ***symperms;
26843f27d899SToby Isaac     PetscScalar ***symflips;
268520cf1dd8SToby Isaac 
26869566063dSJacob Faibussowitsch     PetscCall(DMPlexGetChart(sp->dm, &pStart, &pEnd));
26873f27d899SToby Isaac     numPoints = pEnd - pStart;
2688b5a892a1SMatthew G. Knepley     {
2689b5a892a1SMatthew G. Knepley       DMPolytopeType ct;
2690b5a892a1SMatthew G. Knepley       /* The number of arrangements is no longer based on the number of faces */
26919566063dSJacob Faibussowitsch       PetscCall(DMPlexGetCellType(sp->dm, 0, &ct));
269285036b15SMatthew G. Knepley       numFaces = DMPolytopeTypeGetNumArrangements(ct) / 2;
2693b5a892a1SMatthew G. Knepley     }
26949566063dSJacob Faibussowitsch     PetscCall(PetscCalloc1(numPoints, &symperms));
26959566063dSJacob Faibussowitsch     PetscCall(PetscCalloc1(numPoints, &symflips));
26963f27d899SToby Isaac     spintdim = sp->spintdim;
26973f27d899SToby Isaac     /* The nodal symmetry behavior is not present when tensorSpace != tensorCell: someone might want this for the "S"
26983f27d899SToby Isaac      * family of FEEC spaces.  Most used in particular are discontinuous polynomial L2 spaces in tensor cells, where
26993f27d899SToby Isaac      * the symmetries are not necessary for FE assembly.  So for now we assume this is the case and don't return
27003f27d899SToby Isaac      * symmetries if tensorSpace != tensorCell */
27013f27d899SToby Isaac     if (spintdim && 0 < dim && dim < 3 && (lag->tensorSpace == lag->tensorCell)) { /* compute self symmetries */
27023f27d899SToby Isaac       PetscInt    **cellSymperms;
27033f27d899SToby Isaac       PetscScalar **cellSymflips;
27043f27d899SToby Isaac       PetscInt      ornt;
27053f27d899SToby Isaac       PetscInt      nCopies = Nc / lag->intNodeIndices->nodeVecDim;
27063f27d899SToby Isaac       PetscInt      nNodes  = lag->intNodeIndices->nNodes;
270720cf1dd8SToby Isaac 
270820cf1dd8SToby Isaac       lag->numSelfSym = 2 * numFaces;
270920cf1dd8SToby Isaac       lag->selfSymOff = numFaces;
27109566063dSJacob Faibussowitsch       PetscCall(PetscCalloc1(2 * numFaces, &cellSymperms));
27119566063dSJacob Faibussowitsch       PetscCall(PetscCalloc1(2 * numFaces, &cellSymflips));
271220cf1dd8SToby Isaac       /* we want to be able to index symmetries directly with the orientations, which range from [-numFaces,numFaces) */
27133f27d899SToby Isaac       symperms[0] = &cellSymperms[numFaces];
27143f27d899SToby Isaac       symflips[0] = &cellSymflips[numFaces];
27151dca8a05SBarry Smith       PetscCheck(lag->intNodeIndices->nodeVecDim * nCopies == Nc, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Node indices incompatible with dofs");
27161dca8a05SBarry Smith       PetscCheck(nNodes * nCopies == spintdim, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Node indices incompatible with dofs");
27173f27d899SToby Isaac       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 */
27183f27d899SToby Isaac         Mat          symMat;
27193f27d899SToby Isaac         PetscInt    *perm;
27203f27d899SToby Isaac         PetscScalar *flips;
27213f27d899SToby Isaac         PetscInt     i;
272220cf1dd8SToby Isaac 
27233f27d899SToby Isaac         if (!ornt) continue;
27249566063dSJacob Faibussowitsch         PetscCall(PetscMalloc1(spintdim, &perm));
27259566063dSJacob Faibussowitsch         PetscCall(PetscCalloc1(spintdim, &flips));
27263f27d899SToby Isaac         for (i = 0; i < spintdim; i++) perm[i] = -1;
27279566063dSJacob Faibussowitsch         PetscCall(PetscDualSpaceCreateInteriorSymmetryMatrix_Lagrange(sp, ornt, &symMat));
27283f27d899SToby Isaac         for (i = 0; i < nNodes; i++) {
27293f27d899SToby Isaac           PetscInt           ncols;
27303f27d899SToby Isaac           PetscInt           j, k;
27313f27d899SToby Isaac           const PetscInt    *cols;
27323f27d899SToby Isaac           const PetscScalar *vals;
27333f27d899SToby Isaac           PetscBool          nz_seen = PETSC_FALSE;
273420cf1dd8SToby Isaac 
27359566063dSJacob Faibussowitsch           PetscCall(MatGetRow(symMat, i, &ncols, &cols, &vals));
27363f27d899SToby Isaac           for (j = 0; j < ncols; j++) {
27373f27d899SToby Isaac             if (PetscAbsScalar(vals[j]) > PETSC_SMALL) {
273828b400f6SJacob Faibussowitsch               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");
27393f27d899SToby Isaac               nz_seen = PETSC_TRUE;
27401dca8a05SBarry Smith               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");
27411dca8a05SBarry Smith               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");
27421dca8a05SBarry Smith               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");
2743ad540459SPierre Jolivet               for (k = 0; k < nCopies; k++) perm[cols[j] * nCopies + k] = i * nCopies + k;
27443f27d899SToby Isaac               if (PetscRealPart(vals[j]) < 0.) {
2745ad540459SPierre Jolivet                 for (k = 0; k < nCopies; k++) flips[i * nCopies + k] = -1.;
274620cf1dd8SToby Isaac               } else {
2747ad540459SPierre Jolivet                 for (k = 0; k < nCopies; k++) flips[i * nCopies + k] = 1.;
27483f27d899SToby Isaac               }
27493f27d899SToby Isaac             }
27503f27d899SToby Isaac           }
27519566063dSJacob Faibussowitsch           PetscCall(MatRestoreRow(symMat, i, &ncols, &cols, &vals));
27523f27d899SToby Isaac         }
27539566063dSJacob Faibussowitsch         PetscCall(MatDestroy(&symMat));
27543f27d899SToby Isaac         /* if there were no sign flips, keep NULL */
27559371c9d4SSatish Balay         for (i = 0; i < spintdim; i++)
27569371c9d4SSatish Balay           if (flips[i] != 1.) break;
27573f27d899SToby Isaac         if (i == spintdim) {
27589566063dSJacob Faibussowitsch           PetscCall(PetscFree(flips));
27593f27d899SToby Isaac           flips = NULL;
27603f27d899SToby Isaac         }
27613f27d899SToby Isaac         /* if the permutation is identity, keep NULL */
27629371c9d4SSatish Balay         for (i = 0; i < spintdim; i++)
27639371c9d4SSatish Balay           if (perm[i] != i) break;
27643f27d899SToby Isaac         if (i == spintdim) {
27659566063dSJacob Faibussowitsch           PetscCall(PetscFree(perm));
27663f27d899SToby Isaac           perm = NULL;
27673f27d899SToby Isaac         }
27683f27d899SToby Isaac         symperms[0][ornt] = perm;
27693f27d899SToby Isaac         symflips[0][ornt] = flips;
27703f27d899SToby Isaac       }
27713f27d899SToby Isaac       /* if no orientations produced non-identity permutations, keep NULL */
27729371c9d4SSatish Balay       for (ornt = -numFaces; ornt < numFaces; ornt++)
27739371c9d4SSatish Balay         if (symperms[0][ornt]) break;
27743f27d899SToby Isaac       if (ornt == numFaces) {
27759566063dSJacob Faibussowitsch         PetscCall(PetscFree(cellSymperms));
27763f27d899SToby Isaac         symperms[0] = NULL;
27773f27d899SToby Isaac       }
27783f27d899SToby Isaac       /* if no orientations produced sign flips, keep NULL */
27799371c9d4SSatish Balay       for (ornt = -numFaces; ornt < numFaces; ornt++)
27809371c9d4SSatish Balay         if (symflips[0][ornt]) break;
27813f27d899SToby Isaac       if (ornt == numFaces) {
27829566063dSJacob Faibussowitsch         PetscCall(PetscFree(cellSymflips));
27833f27d899SToby Isaac         symflips[0] = NULL;
27843f27d899SToby Isaac       }
27853f27d899SToby Isaac     }
27862dce792eSToby Isaac     PetscCall(PetscDualSpaceGetBoundarySymmetries_Internal(sp, symperms, symflips));
27879371c9d4SSatish Balay     for (p = 0; p < pEnd; p++)
27889371c9d4SSatish Balay       if (symperms[p]) break;
27893f27d899SToby Isaac     if (p == pEnd) {
27909566063dSJacob Faibussowitsch       PetscCall(PetscFree(symperms));
27913f27d899SToby Isaac       symperms = NULL;
279220cf1dd8SToby Isaac     }
27939371c9d4SSatish Balay     for (p = 0; p < pEnd; p++)
27949371c9d4SSatish Balay       if (symflips[p]) break;
27953f27d899SToby Isaac     if (p == pEnd) {
27969566063dSJacob Faibussowitsch       PetscCall(PetscFree(symflips));
27973f27d899SToby Isaac       symflips = NULL;
279820cf1dd8SToby Isaac     }
27993f27d899SToby Isaac     lag->symperms    = symperms;
28003f27d899SToby Isaac     lag->symflips    = symflips;
28013f27d899SToby Isaac     lag->symComputed = PETSC_TRUE;
280220cf1dd8SToby Isaac   }
28033f27d899SToby Isaac   if (perms) *perms = (const PetscInt ***)lag->symperms;
28043f27d899SToby Isaac   if (flips) *flips = (const PetscScalar ***)lag->symflips;
28053ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
280620cf1dd8SToby Isaac }
280720cf1dd8SToby Isaac 
PetscDualSpaceLagrangeGetContinuity_Lagrange(PetscDualSpace sp,PetscBool * continuous)2808d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeGetContinuity_Lagrange(PetscDualSpace sp, PetscBool *continuous)
2809d71ae5a4SJacob Faibussowitsch {
281020cf1dd8SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
281120cf1dd8SToby Isaac 
281220cf1dd8SToby Isaac   PetscFunctionBegin;
281320cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
28144f572ea9SToby Isaac   PetscAssertPointer(continuous, 2);
281520cf1dd8SToby Isaac   *continuous = lag->continuous;
28163ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
281720cf1dd8SToby Isaac }
281820cf1dd8SToby Isaac 
PetscDualSpaceLagrangeSetContinuity_Lagrange(PetscDualSpace sp,PetscBool continuous)2819d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeSetContinuity_Lagrange(PetscDualSpace sp, PetscBool continuous)
2820d71ae5a4SJacob Faibussowitsch {
282120cf1dd8SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
282220cf1dd8SToby Isaac 
282320cf1dd8SToby Isaac   PetscFunctionBegin;
282420cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
282520cf1dd8SToby Isaac   lag->continuous = continuous;
28263ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
282720cf1dd8SToby Isaac }
282820cf1dd8SToby Isaac 
282920cf1dd8SToby Isaac /*@
283020cf1dd8SToby Isaac   PetscDualSpaceLagrangeGetContinuity - Retrieves the flag for element continuity
283120cf1dd8SToby Isaac 
283220cf1dd8SToby Isaac   Not Collective
283320cf1dd8SToby Isaac 
283420cf1dd8SToby Isaac   Input Parameter:
2835dce8aebaSBarry Smith . sp - the `PetscDualSpace`
283620cf1dd8SToby Isaac 
283720cf1dd8SToby Isaac   Output Parameter:
283820cf1dd8SToby Isaac . continuous - flag for element continuity
283920cf1dd8SToby Isaac 
284020cf1dd8SToby Isaac   Level: intermediate
284120cf1dd8SToby Isaac 
2842b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeSetContinuity()`
284320cf1dd8SToby Isaac @*/
PetscDualSpaceLagrangeGetContinuity(PetscDualSpace sp,PetscBool * continuous)2844d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeGetContinuity(PetscDualSpace sp, PetscBool *continuous)
2845d71ae5a4SJacob Faibussowitsch {
284620cf1dd8SToby Isaac   PetscFunctionBegin;
284720cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
28484f572ea9SToby Isaac   PetscAssertPointer(continuous, 2);
2849cac4c232SBarry Smith   PetscTryMethod(sp, "PetscDualSpaceLagrangeGetContinuity_C", (PetscDualSpace, PetscBool *), (sp, continuous));
28503ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
285120cf1dd8SToby Isaac }
285220cf1dd8SToby Isaac 
285320cf1dd8SToby Isaac /*@
285420cf1dd8SToby Isaac   PetscDualSpaceLagrangeSetContinuity - Indicate whether the element is continuous
285520cf1dd8SToby Isaac 
285620f4b53cSBarry Smith   Logically Collective
285720cf1dd8SToby Isaac 
285820cf1dd8SToby Isaac   Input Parameters:
2859dce8aebaSBarry Smith + sp         - the `PetscDualSpace`
286020cf1dd8SToby Isaac - continuous - flag for element continuity
286120cf1dd8SToby Isaac 
286220f4b53cSBarry Smith   Options Database Key:
2863147403d9SBarry Smith . -petscdualspace_lagrange_continuity <bool> - use a continuous element
286420cf1dd8SToby Isaac 
286520cf1dd8SToby Isaac   Level: intermediate
286620cf1dd8SToby Isaac 
2867b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeGetContinuity()`
286820cf1dd8SToby Isaac @*/
PetscDualSpaceLagrangeSetContinuity(PetscDualSpace sp,PetscBool continuous)2869d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeSetContinuity(PetscDualSpace sp, PetscBool continuous)
2870d71ae5a4SJacob Faibussowitsch {
287120cf1dd8SToby Isaac   PetscFunctionBegin;
287220cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
287320cf1dd8SToby Isaac   PetscValidLogicalCollectiveBool(sp, continuous, 2);
2874cac4c232SBarry Smith   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetContinuity_C", (PetscDualSpace, PetscBool), (sp, continuous));
28753ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
287620cf1dd8SToby Isaac }
287720cf1dd8SToby Isaac 
PetscDualSpaceLagrangeGetTensor_Lagrange(PetscDualSpace sp,PetscBool * tensor)2878d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeGetTensor_Lagrange(PetscDualSpace sp, PetscBool *tensor)
2879d71ae5a4SJacob Faibussowitsch {
288020cf1dd8SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
28816f905325SMatthew G. Knepley 
28826f905325SMatthew G. Knepley   PetscFunctionBegin;
28836f905325SMatthew G. Knepley   *tensor = lag->tensorSpace;
28843ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
28856f905325SMatthew G. Knepley }
28866f905325SMatthew G. Knepley 
PetscDualSpaceLagrangeSetTensor_Lagrange(PetscDualSpace sp,PetscBool tensor)2887d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeSetTensor_Lagrange(PetscDualSpace sp, PetscBool tensor)
2888d71ae5a4SJacob Faibussowitsch {
28896f905325SMatthew G. Knepley   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
28906f905325SMatthew G. Knepley 
28916f905325SMatthew G. Knepley   PetscFunctionBegin;
28926f905325SMatthew G. Knepley   lag->tensorSpace = tensor;
28933ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
28946f905325SMatthew G. Knepley }
28956f905325SMatthew G. Knepley 
PetscDualSpaceLagrangeGetTrimmed_Lagrange(PetscDualSpace sp,PetscBool * trimmed)2896d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeGetTrimmed_Lagrange(PetscDualSpace sp, PetscBool *trimmed)
2897d71ae5a4SJacob Faibussowitsch {
28983f27d899SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
28993f27d899SToby Isaac 
29003f27d899SToby Isaac   PetscFunctionBegin;
29013f27d899SToby Isaac   *trimmed = lag->trimmed;
29023ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
29033f27d899SToby Isaac }
29043f27d899SToby Isaac 
PetscDualSpaceLagrangeSetTrimmed_Lagrange(PetscDualSpace sp,PetscBool trimmed)2905d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeSetTrimmed_Lagrange(PetscDualSpace sp, PetscBool trimmed)
2906d71ae5a4SJacob Faibussowitsch {
29073f27d899SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
29083f27d899SToby Isaac 
29093f27d899SToby Isaac   PetscFunctionBegin;
29103f27d899SToby Isaac   lag->trimmed = trimmed;
29113ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
29123f27d899SToby Isaac }
29133f27d899SToby Isaac 
PetscDualSpaceLagrangeGetNodeType_Lagrange(PetscDualSpace sp,PetscDTNodeType * nodeType,PetscBool * boundary,PetscReal * exponent)2914d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeGetNodeType_Lagrange(PetscDualSpace sp, PetscDTNodeType *nodeType, PetscBool *boundary, PetscReal *exponent)
2915d71ae5a4SJacob Faibussowitsch {
29163f27d899SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
29173f27d899SToby Isaac 
29183f27d899SToby Isaac   PetscFunctionBegin;
29193f27d899SToby Isaac   if (nodeType) *nodeType = lag->nodeType;
29203f27d899SToby Isaac   if (boundary) *boundary = lag->endNodes;
29213f27d899SToby Isaac   if (exponent) *exponent = lag->nodeExponent;
29223ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
29233f27d899SToby Isaac }
29243f27d899SToby Isaac 
PetscDualSpaceLagrangeSetNodeType_Lagrange(PetscDualSpace sp,PetscDTNodeType nodeType,PetscBool boundary,PetscReal exponent)2925d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeSetNodeType_Lagrange(PetscDualSpace sp, PetscDTNodeType nodeType, PetscBool boundary, PetscReal exponent)
2926d71ae5a4SJacob Faibussowitsch {
29273f27d899SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
29283f27d899SToby Isaac 
29293f27d899SToby Isaac   PetscFunctionBegin;
29301dca8a05SBarry Smith   PetscCheck(nodeType != PETSCDTNODES_GAUSSJACOBI || exponent > -1., PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_OUTOFRANGE, "Exponent must be > -1");
29313f27d899SToby Isaac   lag->nodeType     = nodeType;
29323f27d899SToby Isaac   lag->endNodes     = boundary;
29333f27d899SToby Isaac   lag->nodeExponent = exponent;
29343ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
29353f27d899SToby Isaac }
29363f27d899SToby Isaac 
PetscDualSpaceLagrangeGetUseMoments_Lagrange(PetscDualSpace sp,PetscBool * useMoments)2937d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeGetUseMoments_Lagrange(PetscDualSpace sp, PetscBool *useMoments)
2938d71ae5a4SJacob Faibussowitsch {
293966a6c23cSMatthew G. Knepley   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
294066a6c23cSMatthew G. Knepley 
294166a6c23cSMatthew G. Knepley   PetscFunctionBegin;
294266a6c23cSMatthew G. Knepley   *useMoments = lag->useMoments;
29433ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
294466a6c23cSMatthew G. Knepley }
294566a6c23cSMatthew G. Knepley 
PetscDualSpaceLagrangeSetUseMoments_Lagrange(PetscDualSpace sp,PetscBool useMoments)2946d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeSetUseMoments_Lagrange(PetscDualSpace sp, PetscBool useMoments)
2947d71ae5a4SJacob Faibussowitsch {
294866a6c23cSMatthew G. Knepley   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
294966a6c23cSMatthew G. Knepley 
295066a6c23cSMatthew G. Knepley   PetscFunctionBegin;
295166a6c23cSMatthew G. Knepley   lag->useMoments = useMoments;
29523ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
295366a6c23cSMatthew G. Knepley }
295466a6c23cSMatthew G. Knepley 
PetscDualSpaceLagrangeGetMomentOrder_Lagrange(PetscDualSpace sp,PetscInt * momentOrder)2955d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeGetMomentOrder_Lagrange(PetscDualSpace sp, PetscInt *momentOrder)
2956d71ae5a4SJacob Faibussowitsch {
295766a6c23cSMatthew G. Knepley   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
295866a6c23cSMatthew G. Knepley 
295966a6c23cSMatthew G. Knepley   PetscFunctionBegin;
296066a6c23cSMatthew G. Knepley   *momentOrder = lag->momentOrder;
29613ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
296266a6c23cSMatthew G. Knepley }
296366a6c23cSMatthew G. Knepley 
PetscDualSpaceLagrangeSetMomentOrder_Lagrange(PetscDualSpace sp,PetscInt momentOrder)2964d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeSetMomentOrder_Lagrange(PetscDualSpace sp, PetscInt momentOrder)
2965d71ae5a4SJacob Faibussowitsch {
296666a6c23cSMatthew G. Knepley   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
296766a6c23cSMatthew G. Knepley 
296866a6c23cSMatthew G. Knepley   PetscFunctionBegin;
296966a6c23cSMatthew G. Knepley   lag->momentOrder = momentOrder;
29703ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
297166a6c23cSMatthew G. Knepley }
297266a6c23cSMatthew G. Knepley 
29736f905325SMatthew G. Knepley /*@
29746f905325SMatthew G. Knepley   PetscDualSpaceLagrangeGetTensor - Get the tensor nature of the dual space
29756f905325SMatthew G. Knepley 
297620f4b53cSBarry Smith   Not Collective
29776f905325SMatthew G. Knepley 
29786f905325SMatthew G. Knepley   Input Parameter:
2979dce8aebaSBarry Smith . sp - The `PetscDualSpace`
29806f905325SMatthew G. Knepley 
29816f905325SMatthew G. Knepley   Output Parameter:
29826f905325SMatthew G. Knepley . tensor - Whether the dual space has tensor layout (vs. simplicial)
29836f905325SMatthew G. Knepley 
29846f905325SMatthew G. Knepley   Level: intermediate
29856f905325SMatthew G. Knepley 
2986b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeSetTensor()`, `PetscDualSpaceCreate()`
29876f905325SMatthew G. Knepley @*/
PetscDualSpaceLagrangeGetTensor(PetscDualSpace sp,PetscBool * tensor)2988d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeGetTensor(PetscDualSpace sp, PetscBool *tensor)
2989d71ae5a4SJacob Faibussowitsch {
299020cf1dd8SToby Isaac   PetscFunctionBegin;
299120cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
29924f572ea9SToby Isaac   PetscAssertPointer(tensor, 2);
2993cac4c232SBarry Smith   PetscTryMethod(sp, "PetscDualSpaceLagrangeGetTensor_C", (PetscDualSpace, PetscBool *), (sp, tensor));
29943ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
299520cf1dd8SToby Isaac }
299620cf1dd8SToby Isaac 
29976f905325SMatthew G. Knepley /*@
29986f905325SMatthew G. Knepley   PetscDualSpaceLagrangeSetTensor - Set the tensor nature of the dual space
29996f905325SMatthew G. Knepley 
300020f4b53cSBarry Smith   Not Collective
30016f905325SMatthew G. Knepley 
30026f905325SMatthew G. Knepley   Input Parameters:
3003dce8aebaSBarry Smith + sp     - The `PetscDualSpace`
30046f905325SMatthew G. Knepley - tensor - Whether the dual space has tensor layout (vs. simplicial)
30056f905325SMatthew G. Knepley 
30066f905325SMatthew G. Knepley   Level: intermediate
30076f905325SMatthew G. Knepley 
3008b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeGetTensor()`, `PetscDualSpaceCreate()`
30096f905325SMatthew G. Knepley @*/
PetscDualSpaceLagrangeSetTensor(PetscDualSpace sp,PetscBool tensor)3010d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeSetTensor(PetscDualSpace sp, PetscBool tensor)
3011d71ae5a4SJacob Faibussowitsch {
30126f905325SMatthew G. Knepley   PetscFunctionBegin;
30136f905325SMatthew G. Knepley   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3014cac4c232SBarry Smith   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetTensor_C", (PetscDualSpace, PetscBool), (sp, tensor));
30153ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
30166f905325SMatthew G. Knepley }
30176f905325SMatthew G. Knepley 
30183f27d899SToby Isaac /*@
30193f27d899SToby Isaac   PetscDualSpaceLagrangeGetTrimmed - Get the trimmed nature of the dual space
30203f27d899SToby Isaac 
302120f4b53cSBarry Smith   Not Collective
30223f27d899SToby Isaac 
30233f27d899SToby Isaac   Input Parameter:
3024dce8aebaSBarry Smith . sp - The `PetscDualSpace`
30253f27d899SToby Isaac 
30263f27d899SToby Isaac   Output Parameter:
30273f27d899SToby Isaac . 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)
30283f27d899SToby Isaac 
30293f27d899SToby Isaac   Level: intermediate
30303f27d899SToby Isaac 
3031b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeSetTrimmed()`, `PetscDualSpaceCreate()`
30323f27d899SToby Isaac @*/
PetscDualSpaceLagrangeGetTrimmed(PetscDualSpace sp,PetscBool * trimmed)3033d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeGetTrimmed(PetscDualSpace sp, PetscBool *trimmed)
3034d71ae5a4SJacob Faibussowitsch {
30353f27d899SToby Isaac   PetscFunctionBegin;
30363f27d899SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
30374f572ea9SToby Isaac   PetscAssertPointer(trimmed, 2);
3038cac4c232SBarry Smith   PetscTryMethod(sp, "PetscDualSpaceLagrangeGetTrimmed_C", (PetscDualSpace, PetscBool *), (sp, trimmed));
30393ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
30403f27d899SToby Isaac }
30413f27d899SToby Isaac 
30423f27d899SToby Isaac /*@
30433f27d899SToby Isaac   PetscDualSpaceLagrangeSetTrimmed - Set the trimmed nature of the dual space
30443f27d899SToby Isaac 
304520f4b53cSBarry Smith   Not Collective
30463f27d899SToby Isaac 
30473f27d899SToby Isaac   Input Parameters:
3048dce8aebaSBarry Smith + sp      - The `PetscDualSpace`
30493f27d899SToby Isaac - 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)
30503f27d899SToby Isaac 
30513f27d899SToby Isaac   Level: intermediate
30523f27d899SToby Isaac 
3053b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeGetTrimmed()`, `PetscDualSpaceCreate()`
30543f27d899SToby Isaac @*/
PetscDualSpaceLagrangeSetTrimmed(PetscDualSpace sp,PetscBool trimmed)3055d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeSetTrimmed(PetscDualSpace sp, PetscBool trimmed)
3056d71ae5a4SJacob Faibussowitsch {
30573f27d899SToby Isaac   PetscFunctionBegin;
30583f27d899SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3059cac4c232SBarry Smith   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetTrimmed_C", (PetscDualSpace, PetscBool), (sp, trimmed));
30603ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
30613f27d899SToby Isaac }
30623f27d899SToby Isaac 
30633f27d899SToby Isaac /*@
30643f27d899SToby Isaac   PetscDualSpaceLagrangeGetNodeType - Get a description of how nodes are laid out for Lagrange polynomials in this
30653f27d899SToby Isaac   dual space
30663f27d899SToby Isaac 
306720f4b53cSBarry Smith   Not Collective
30683f27d899SToby Isaac 
30693f27d899SToby Isaac   Input Parameter:
3070dce8aebaSBarry Smith . sp - The `PetscDualSpace`
30713f27d899SToby Isaac 
30723f27d899SToby Isaac   Output Parameters:
30733f27d899SToby Isaac + nodeType - The type of nodes
3074dce8aebaSBarry Smith . boundary - Whether the node type is one that includes endpoints (if nodeType is `PETSCDTNODES_GAUSSJACOBI`, nodes that
30753f27d899SToby Isaac              include the boundary are Gauss-Lobatto-Jacobi nodes)
30763797e9adSStefano Zampini - exponent - If nodeType is `PETSCDTNODES_GAUSSJACOBI`, indicates the exponent used for both ends of the 1D Jacobi weight function
30773f27d899SToby Isaac              '0' is Gauss-Legendre, '-0.5' is Gauss-Chebyshev of the first type, '0.5' is Gauss-Chebyshev of the second type
30783f27d899SToby Isaac 
30793f27d899SToby Isaac   Level: advanced
30803f27d899SToby Isaac 
3081b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDTNodeType`, `PetscDualSpaceLagrangeSetNodeType()`
30823f27d899SToby Isaac @*/
PetscDualSpaceLagrangeGetNodeType(PetscDualSpace sp,PeOp PetscDTNodeType * nodeType,PeOp PetscBool * boundary,PeOp PetscReal * exponent)3083ce78bad3SBarry Smith PetscErrorCode PetscDualSpaceLagrangeGetNodeType(PetscDualSpace sp, PeOp PetscDTNodeType *nodeType, PeOp PetscBool *boundary, PeOp PetscReal *exponent)
3084d71ae5a4SJacob Faibussowitsch {
30853f27d899SToby Isaac   PetscFunctionBegin;
30863f27d899SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
30874f572ea9SToby Isaac   if (nodeType) PetscAssertPointer(nodeType, 2);
30884f572ea9SToby Isaac   if (boundary) PetscAssertPointer(boundary, 3);
30894f572ea9SToby Isaac   if (exponent) PetscAssertPointer(exponent, 4);
3090cac4c232SBarry Smith   PetscTryMethod(sp, "PetscDualSpaceLagrangeGetNodeType_C", (PetscDualSpace, PetscDTNodeType *, PetscBool *, PetscReal *), (sp, nodeType, boundary, exponent));
30913ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
30923f27d899SToby Isaac }
30933f27d899SToby Isaac 
30943f27d899SToby Isaac /*@
30953f27d899SToby Isaac   PetscDualSpaceLagrangeSetNodeType - Set a description of how nodes are laid out for Lagrange polynomials in this
30963f27d899SToby Isaac   dual space
30973f27d899SToby Isaac 
309820f4b53cSBarry Smith   Logically Collective
30993f27d899SToby Isaac 
31003f27d899SToby Isaac   Input Parameters:
3101dce8aebaSBarry Smith + sp       - The `PetscDualSpace`
31023f27d899SToby Isaac . nodeType - The type of nodes
3103dce8aebaSBarry Smith . boundary - Whether the node type is one that includes endpoints (if nodeType is `PETSCDTNODES_GAUSSJACOBI`, nodes that
31043f27d899SToby Isaac              include the boundary are Gauss-Lobatto-Jacobi nodes)
31053797e9adSStefano Zampini - exponent - If nodeType is `PETSCDTNODES_GAUSSJACOBI`, indicates the exponent used for both ends of the 1D Jacobi weight function
31063f27d899SToby Isaac              '0' is Gauss-Legendre, '-0.5' is Gauss-Chebyshev of the first type, '0.5' is Gauss-Chebyshev of the second type
31073f27d899SToby Isaac 
31083f27d899SToby Isaac   Level: advanced
31093f27d899SToby Isaac 
3110b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDTNodeType`, `PetscDualSpaceLagrangeGetNodeType()`
31113f27d899SToby Isaac @*/
PetscDualSpaceLagrangeSetNodeType(PetscDualSpace sp,PetscDTNodeType nodeType,PetscBool boundary,PetscReal exponent)3112d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeSetNodeType(PetscDualSpace sp, PetscDTNodeType nodeType, PetscBool boundary, PetscReal exponent)
3113d71ae5a4SJacob Faibussowitsch {
31143f27d899SToby Isaac   PetscFunctionBegin;
31153f27d899SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3116cac4c232SBarry Smith   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetNodeType_C", (PetscDualSpace, PetscDTNodeType, PetscBool, PetscReal), (sp, nodeType, boundary, exponent));
31173ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
31183f27d899SToby Isaac }
31193f27d899SToby Isaac 
312066a6c23cSMatthew G. Knepley /*@
312166a6c23cSMatthew G. Knepley   PetscDualSpaceLagrangeGetUseMoments - Get the flag for using moment functionals
312266a6c23cSMatthew G. Knepley 
312320f4b53cSBarry Smith   Not Collective
312466a6c23cSMatthew G. Knepley 
312566a6c23cSMatthew G. Knepley   Input Parameter:
3126dce8aebaSBarry Smith . sp - The `PetscDualSpace`
312766a6c23cSMatthew G. Knepley 
312866a6c23cSMatthew G. Knepley   Output Parameter:
312966a6c23cSMatthew G. Knepley . useMoments - Moment flag
313066a6c23cSMatthew G. Knepley 
313166a6c23cSMatthew G. Knepley   Level: advanced
313266a6c23cSMatthew G. Knepley 
3133b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeSetUseMoments()`
313466a6c23cSMatthew G. Knepley @*/
PetscDualSpaceLagrangeGetUseMoments(PetscDualSpace sp,PetscBool * useMoments)3135d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeGetUseMoments(PetscDualSpace sp, PetscBool *useMoments)
3136d71ae5a4SJacob Faibussowitsch {
313766a6c23cSMatthew G. Knepley   PetscFunctionBegin;
313866a6c23cSMatthew G. Knepley   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
31394f572ea9SToby Isaac   PetscAssertPointer(useMoments, 2);
3140cac4c232SBarry Smith   PetscUseMethod(sp, "PetscDualSpaceLagrangeGetUseMoments_C", (PetscDualSpace, PetscBool *), (sp, useMoments));
31413ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
314266a6c23cSMatthew G. Knepley }
314366a6c23cSMatthew G. Knepley 
314466a6c23cSMatthew G. Knepley /*@
314566a6c23cSMatthew G. Knepley   PetscDualSpaceLagrangeSetUseMoments - Set the flag for moment functionals
314666a6c23cSMatthew G. Knepley 
314720f4b53cSBarry Smith   Logically Collective
314866a6c23cSMatthew G. Knepley 
314966a6c23cSMatthew G. Knepley   Input Parameters:
3150dce8aebaSBarry Smith + sp         - The `PetscDualSpace`
315166a6c23cSMatthew G. Knepley - useMoments - The flag for moment functionals
315266a6c23cSMatthew G. Knepley 
315366a6c23cSMatthew G. Knepley   Level: advanced
315466a6c23cSMatthew G. Knepley 
3155b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeGetUseMoments()`
315666a6c23cSMatthew G. Knepley @*/
PetscDualSpaceLagrangeSetUseMoments(PetscDualSpace sp,PetscBool useMoments)3157d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeSetUseMoments(PetscDualSpace sp, PetscBool useMoments)
3158d71ae5a4SJacob Faibussowitsch {
315966a6c23cSMatthew G. Knepley   PetscFunctionBegin;
316066a6c23cSMatthew G. Knepley   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3161cac4c232SBarry Smith   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetUseMoments_C", (PetscDualSpace, PetscBool), (sp, useMoments));
31623ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
316366a6c23cSMatthew G. Knepley }
316466a6c23cSMatthew G. Knepley 
316566a6c23cSMatthew G. Knepley /*@
316666a6c23cSMatthew G. Knepley   PetscDualSpaceLagrangeGetMomentOrder - Get the order for moment integration
316766a6c23cSMatthew G. Knepley 
316820f4b53cSBarry Smith   Not Collective
316966a6c23cSMatthew G. Knepley 
317066a6c23cSMatthew G. Knepley   Input Parameter:
3171dce8aebaSBarry Smith . sp - The `PetscDualSpace`
317266a6c23cSMatthew G. Knepley 
317366a6c23cSMatthew G. Knepley   Output Parameter:
317466a6c23cSMatthew G. Knepley . order - Moment integration order
317566a6c23cSMatthew G. Knepley 
317666a6c23cSMatthew G. Knepley   Level: advanced
317766a6c23cSMatthew G. Knepley 
3178b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeSetMomentOrder()`
317966a6c23cSMatthew G. Knepley @*/
PetscDualSpaceLagrangeGetMomentOrder(PetscDualSpace sp,PetscInt * order)3180d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeGetMomentOrder(PetscDualSpace sp, PetscInt *order)
3181d71ae5a4SJacob Faibussowitsch {
318266a6c23cSMatthew G. Knepley   PetscFunctionBegin;
318366a6c23cSMatthew G. Knepley   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
31844f572ea9SToby Isaac   PetscAssertPointer(order, 2);
3185cac4c232SBarry Smith   PetscUseMethod(sp, "PetscDualSpaceLagrangeGetMomentOrder_C", (PetscDualSpace, PetscInt *), (sp, order));
31863ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
318766a6c23cSMatthew G. Knepley }
318866a6c23cSMatthew G. Knepley 
318966a6c23cSMatthew G. Knepley /*@
319066a6c23cSMatthew G. Knepley   PetscDualSpaceLagrangeSetMomentOrder - Set the order for moment integration
319166a6c23cSMatthew G. Knepley 
319220f4b53cSBarry Smith   Logically Collective
319366a6c23cSMatthew G. Knepley 
319466a6c23cSMatthew G. Knepley   Input Parameters:
3195dce8aebaSBarry Smith + sp    - The `PetscDualSpace`
319666a6c23cSMatthew G. Knepley - order - The order for moment integration
319766a6c23cSMatthew G. Knepley 
319866a6c23cSMatthew G. Knepley   Level: advanced
319966a6c23cSMatthew G. Knepley 
3200b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeGetMomentOrder()`
320166a6c23cSMatthew G. Knepley @*/
PetscDualSpaceLagrangeSetMomentOrder(PetscDualSpace sp,PetscInt order)3202d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeSetMomentOrder(PetscDualSpace sp, PetscInt order)
3203d71ae5a4SJacob Faibussowitsch {
320466a6c23cSMatthew G. Knepley   PetscFunctionBegin;
320566a6c23cSMatthew G. Knepley   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
3206cac4c232SBarry Smith   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetMomentOrder_C", (PetscDualSpace, PetscInt), (sp, order));
32073ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
320866a6c23cSMatthew G. Knepley }
32093f27d899SToby Isaac 
PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp)3210d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp)
3211d71ae5a4SJacob Faibussowitsch {
321220cf1dd8SToby Isaac   PetscFunctionBegin;
321320cf1dd8SToby Isaac   sp->ops->destroy              = PetscDualSpaceDestroy_Lagrange;
32146f905325SMatthew G. Knepley   sp->ops->view                 = PetscDualSpaceView_Lagrange;
32156f905325SMatthew G. Knepley   sp->ops->setfromoptions       = PetscDualSpaceSetFromOptions_Lagrange;
321620cf1dd8SToby Isaac   sp->ops->duplicate            = PetscDualSpaceDuplicate_Lagrange;
32176f905325SMatthew G. Knepley   sp->ops->setup                = PetscDualSpaceSetUp_Lagrange;
32183f27d899SToby Isaac   sp->ops->createheightsubspace = NULL;
32193f27d899SToby Isaac   sp->ops->createpointsubspace  = NULL;
322020cf1dd8SToby Isaac   sp->ops->getsymmetries        = PetscDualSpaceGetSymmetries_Lagrange;
322120cf1dd8SToby Isaac   sp->ops->apply                = PetscDualSpaceApplyDefault;
322220cf1dd8SToby Isaac   sp->ops->applyall             = PetscDualSpaceApplyAllDefault;
3223b4457527SToby Isaac   sp->ops->applyint             = PetscDualSpaceApplyInteriorDefault;
32243f27d899SToby Isaac   sp->ops->createalldata        = PetscDualSpaceCreateAllDataDefault;
3225b4457527SToby Isaac   sp->ops->createintdata        = PetscDualSpaceCreateInteriorDataDefault;
32263ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
322720cf1dd8SToby Isaac }
322820cf1dd8SToby Isaac 
322920cf1dd8SToby Isaac /*MC
3230dce8aebaSBarry Smith   PETSCDUALSPACELAGRANGE = "lagrange" - A `PetscDualSpaceType` that encapsulates a dual space of pointwise evaluation functionals
323120cf1dd8SToby Isaac 
323220cf1dd8SToby Isaac   Level: intermediate
323320cf1dd8SToby Isaac 
3234b24fb147SBarry Smith   Developer Note:
3235b24fb147SBarry Smith   This `PetscDualSpace` seems to manage directly trimmed and untrimmed polynomials as well as tensor and non-tensor polynomials while for `PetscSpace` there seems to
3236b24fb147SBarry Smith   be different `PetscSpaceType` for them.
3237b24fb147SBarry Smith 
3238b24fb147SBarry Smith .seealso: `PetscDualSpace`, `PetscDualSpaceType`, `PetscDualSpaceCreate()`, `PetscDualSpaceSetType()`,
3239b24fb147SBarry Smith           `PetscDualSpaceLagrangeSetMomentOrder()`, `PetscDualSpaceLagrangeGetMomentOrder()`, `PetscDualSpaceLagrangeSetUseMoments()`, `PetscDualSpaceLagrangeGetUseMoments()`,
3240b24fb147SBarry Smith           `PetscDualSpaceLagrangeSetNodeType, PetscDualSpaceLagrangeGetNodeType, PetscDualSpaceLagrangeGetContinuity, PetscDualSpaceLagrangeSetContinuity,
3241b24fb147SBarry Smith           `PetscDualSpaceLagrangeGetTensor()`, `PetscDualSpaceLagrangeSetTensor()`, `PetscDualSpaceLagrangeGetTrimmed()`, `PetscDualSpaceLagrangeSetTrimmed()`
324220cf1dd8SToby Isaac M*/
PetscDualSpaceCreate_Lagrange(PetscDualSpace sp)3243d71ae5a4SJacob Faibussowitsch PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Lagrange(PetscDualSpace sp)
3244d71ae5a4SJacob Faibussowitsch {
324520cf1dd8SToby Isaac   PetscDualSpace_Lag *lag;
324620cf1dd8SToby Isaac 
324720cf1dd8SToby Isaac   PetscFunctionBegin;
324820cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
32494dfa11a4SJacob Faibussowitsch   PetscCall(PetscNew(&lag));
325020cf1dd8SToby Isaac   sp->data = lag;
325120cf1dd8SToby Isaac 
32523f27d899SToby Isaac   lag->tensorCell  = PETSC_FALSE;
325320cf1dd8SToby Isaac   lag->tensorSpace = PETSC_FALSE;
325420cf1dd8SToby Isaac   lag->continuous  = PETSC_TRUE;
32553f27d899SToby Isaac   lag->numCopies   = PETSC_DEFAULT;
32563f27d899SToby Isaac   lag->numNodeSkip = PETSC_DEFAULT;
32573f27d899SToby Isaac   lag->nodeType    = PETSCDTNODES_DEFAULT;
325866a6c23cSMatthew G. Knepley   lag->useMoments  = PETSC_FALSE;
325966a6c23cSMatthew G. Knepley   lag->momentOrder = 0;
326020cf1dd8SToby Isaac 
32619566063dSJacob Faibussowitsch   PetscCall(PetscDualSpaceInitialize_Lagrange(sp));
32629566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetContinuity_C", PetscDualSpaceLagrangeGetContinuity_Lagrange));
32639566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetContinuity_C", PetscDualSpaceLagrangeSetContinuity_Lagrange));
32649566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetTensor_C", PetscDualSpaceLagrangeGetTensor_Lagrange));
32659566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetTensor_C", PetscDualSpaceLagrangeSetTensor_Lagrange));
32669566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetTrimmed_C", PetscDualSpaceLagrangeGetTrimmed_Lagrange));
32679566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetTrimmed_C", PetscDualSpaceLagrangeSetTrimmed_Lagrange));
32689566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetNodeType_C", PetscDualSpaceLagrangeGetNodeType_Lagrange));
32699566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetNodeType_C", PetscDualSpaceLagrangeSetNodeType_Lagrange));
32709566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetUseMoments_C", PetscDualSpaceLagrangeGetUseMoments_Lagrange));
32719566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetUseMoments_C", PetscDualSpaceLagrangeSetUseMoments_Lagrange));
32729566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetMomentOrder_C", PetscDualSpaceLagrangeGetMomentOrder_Lagrange));
32739566063dSJacob Faibussowitsch   PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetMomentOrder_C", PetscDualSpaceLagrangeSetMomentOrder_Lagrange));
32743ba16761SJacob Faibussowitsch   PetscFunctionReturn(PETSC_SUCCESS);
327520cf1dd8SToby Isaac }
3276