xref: /petsc/src/dm/dt/dualspace/impls/lagrange/dspacelagrange.c (revision 3f27d89970ea7eca446883c23db92691e281cd4c)
120cf1dd8SToby Isaac #include <petsc/private/petscfeimpl.h> /*I "petscfe.h" I*/
220cf1dd8SToby Isaac #include <petscdmplex.h>
3*3f27d899SToby Isaac #include <petscblaslapack.h>
4*3f27d899SToby Isaac 
5*3f27d899SToby Isaac PetscErrorCode DMPlexGetTransitiveClosure_Internal(DM, PetscInt, PetscInt, PetscBool, PetscInt *, PetscInt *[]);
6*3f27d899SToby Isaac 
7*3f27d899SToby Isaac struct _n_Petsc1DNodeFamily
8*3f27d899SToby Isaac {
9*3f27d899SToby Isaac   PetscInt         refct;
10*3f27d899SToby Isaac   PetscDTNodeType  nodeFamily;
11*3f27d899SToby Isaac   PetscReal        gaussJacobiExp;
12*3f27d899SToby Isaac   PetscInt         nComputed;
13*3f27d899SToby Isaac   PetscReal      **nodesets;
14*3f27d899SToby Isaac   PetscBool        endpoints;
15*3f27d899SToby Isaac };
16*3f27d899SToby Isaac 
17*3f27d899SToby Isaac static PetscErrorCode Petsc1DNodeFamilyCreate(PetscDTNodeType family, PetscReal gaussJacobiExp, PetscBool endpoints, Petsc1DNodeFamily *nf)
18*3f27d899SToby Isaac {
19*3f27d899SToby Isaac   Petsc1DNodeFamily f;
20*3f27d899SToby Isaac   PetscErrorCode ierr;
21*3f27d899SToby Isaac 
22*3f27d899SToby Isaac   PetscFunctionBegin;
23*3f27d899SToby Isaac   ierr = PetscNew(&f);CHKERRQ(ierr);
24*3f27d899SToby Isaac   switch (family) {
25*3f27d899SToby Isaac   case PETSCDTNODES_GAUSSJACOBI:
26*3f27d899SToby Isaac   case PETSCDTNODES_EQUISPACED:
27*3f27d899SToby Isaac     f->nodeFamily = family;
28*3f27d899SToby Isaac     break;
29*3f27d899SToby Isaac   default: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown 1D node family");
30*3f27d899SToby Isaac   }
31*3f27d899SToby Isaac   f->endpoints = endpoints;
32*3f27d899SToby Isaac   f->gaussJacobiExp = 0.;
33*3f27d899SToby Isaac   if (family == PETSCDTNODES_GAUSSJACOBI) {
34*3f27d899SToby Isaac     if (gaussJacobiExp <= -1.) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Gauss-Jacobi exponent must be > -1.\n");
35*3f27d899SToby Isaac     f->gaussJacobiExp = gaussJacobiExp;
36*3f27d899SToby Isaac   }
37*3f27d899SToby Isaac   f->refct = 1;
38*3f27d899SToby Isaac   *nf = f;
39*3f27d899SToby Isaac   PetscFunctionReturn(0);
40*3f27d899SToby Isaac }
41*3f27d899SToby Isaac 
42*3f27d899SToby Isaac static PetscErrorCode Petsc1DNodeFamilyReference(Petsc1DNodeFamily nf)
43*3f27d899SToby Isaac {
44*3f27d899SToby Isaac   PetscFunctionBegin;
45*3f27d899SToby Isaac   if (nf) nf->refct++;
46*3f27d899SToby Isaac   PetscFunctionReturn(0);
47*3f27d899SToby Isaac }
48*3f27d899SToby Isaac 
49*3f27d899SToby Isaac static PetscErrorCode Petsc1DNodeFamilyDestroy(Petsc1DNodeFamily *nf) {
50*3f27d899SToby Isaac   PetscInt       i, nc;
51*3f27d899SToby Isaac   PetscErrorCode ierr;
52*3f27d899SToby Isaac 
53*3f27d899SToby Isaac   PetscFunctionBegin;
54*3f27d899SToby Isaac   if (!(*nf)) PetscFunctionReturn(0);
55*3f27d899SToby Isaac   if (--(*nf)->refct > 0) {
56*3f27d899SToby Isaac     *nf = NULL;
57*3f27d899SToby Isaac     PetscFunctionReturn(0);
58*3f27d899SToby Isaac   }
59*3f27d899SToby Isaac   nc = (*nf)->nComputed;
60*3f27d899SToby Isaac   for (i = 0; i < nc; i++) {
61*3f27d899SToby Isaac     ierr = PetscFree((*nf)->nodesets[i]);CHKERRQ(ierr);
62*3f27d899SToby Isaac   }
63*3f27d899SToby Isaac   ierr = PetscFree((*nf)->nodesets);CHKERRQ(ierr);
64*3f27d899SToby Isaac   ierr = PetscFree(*nf);CHKERRQ(ierr);
65*3f27d899SToby Isaac   *nf = NULL;
66*3f27d899SToby Isaac   PetscFunctionReturn(0);
67*3f27d899SToby Isaac }
68*3f27d899SToby Isaac 
69*3f27d899SToby Isaac static PetscErrorCode Petsc1DNodeFamilyGetNodeSets(Petsc1DNodeFamily f, PetscInt degree, PetscReal ***nodesets)
70*3f27d899SToby Isaac {
71*3f27d899SToby Isaac   PetscInt       nc;
72*3f27d899SToby Isaac   PetscErrorCode ierr;
73*3f27d899SToby Isaac 
74*3f27d899SToby Isaac   PetscFunctionBegin;
75*3f27d899SToby Isaac   nc = f->nComputed;
76*3f27d899SToby Isaac   if (degree >= nc) {
77*3f27d899SToby Isaac     PetscInt    i, j;
78*3f27d899SToby Isaac     PetscReal **new_nodesets;
79*3f27d899SToby Isaac     PetscReal  *w;
80*3f27d899SToby Isaac 
81*3f27d899SToby Isaac     ierr = PetscMalloc1(degree + 1, &new_nodesets);CHKERRQ(ierr);
82*3f27d899SToby Isaac     ierr = PetscArraycpy(new_nodesets, f->nodesets, nc);CHKERRQ(ierr);
83*3f27d899SToby Isaac     ierr = PetscFree(f->nodesets);CHKERRQ(ierr);
84*3f27d899SToby Isaac     f->nodesets = new_nodesets;
85*3f27d899SToby Isaac     ierr = PetscMalloc1(degree + 1, &w);CHKERRQ(ierr);
86*3f27d899SToby Isaac     for (i = nc; i < degree + 1; i++) {
87*3f27d899SToby Isaac       ierr = PetscMalloc1(i + 1, &(f->nodesets[i]));CHKERRQ(ierr);
88*3f27d899SToby Isaac       if (!i) {
89*3f27d899SToby Isaac         f->nodesets[i][0] = 0.5;
90*3f27d899SToby Isaac       } else {
91*3f27d899SToby Isaac         switch (f->nodeFamily) {
92*3f27d899SToby Isaac         case PETSCDTNODES_EQUISPACED:
93*3f27d899SToby Isaac           if (f->endpoints) {
94*3f27d899SToby Isaac             for (j = 0; j <= i; j++) f->nodesets[i][j] = (PetscReal) j / (PetscReal) i;
95*3f27d899SToby Isaac           } else {
96*3f27d899SToby Isaac             for (j = 0; j <= i; j++) f->nodesets[i][j] = ((PetscReal) j + 0.5) / ((PetscReal) i + 1.);
97*3f27d899SToby Isaac           }
98*3f27d899SToby Isaac           break;
99*3f27d899SToby Isaac         case PETSCDTNODES_GAUSSJACOBI:
100*3f27d899SToby Isaac           if (f->endpoints) {
101*3f27d899SToby Isaac             ierr = PetscDTGaussLobattoJacobiQuadrature(i + 1, 0., 1., f->gaussJacobiExp, f->gaussJacobiExp, f->nodesets[i], w);CHKERRQ(ierr);
102*3f27d899SToby Isaac           } else {
103*3f27d899SToby Isaac             ierr = PetscDTGaussJacobiQuadrature(i + 1, 0., 1., f->gaussJacobiExp, f->gaussJacobiExp, f->nodesets[i], w);CHKERRQ(ierr);
104*3f27d899SToby Isaac           }
105*3f27d899SToby Isaac           break;
106*3f27d899SToby Isaac         default: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown 1D node family");
107*3f27d899SToby Isaac         }
108*3f27d899SToby Isaac       }
109*3f27d899SToby Isaac     }
110*3f27d899SToby Isaac     ierr = PetscFree(w);CHKERRQ(ierr);
111*3f27d899SToby Isaac     f->nComputed = degree + 1;
112*3f27d899SToby Isaac   }
113*3f27d899SToby Isaac   *nodesets = f->nodesets;
114*3f27d899SToby Isaac   PetscFunctionReturn(0);
115*3f27d899SToby Isaac }
116*3f27d899SToby Isaac 
117*3f27d899SToby Isaac static PetscErrorCode PetscNodeRecursive_Internal(PetscInt dim, PetscInt degree, PetscReal **nodesets, PetscInt tup[], PetscReal node[])
118*3f27d899SToby Isaac {
119*3f27d899SToby Isaac   PetscReal w;
120*3f27d899SToby Isaac   PetscInt i, j;
121*3f27d899SToby Isaac   PetscErrorCode ierr;
122*3f27d899SToby Isaac 
123*3f27d899SToby Isaac   PetscFunctionBeginHot;
124*3f27d899SToby Isaac   w = 0.;
125*3f27d899SToby Isaac   if (dim == 1) {
126*3f27d899SToby Isaac     node[0] = nodesets[degree][tup[0]];
127*3f27d899SToby Isaac     node[1] = nodesets[degree][tup[1]];
128*3f27d899SToby Isaac   } else {
129*3f27d899SToby Isaac     for (i = 0; i < dim + 1; i++) node[i] = 0.;
130*3f27d899SToby Isaac     for (i = 0; i < dim + 1; i++) {
131*3f27d899SToby Isaac       PetscReal wi = nodesets[degree][degree-tup[i]];
132*3f27d899SToby Isaac 
133*3f27d899SToby Isaac       for (j = 0; j < dim+1; j++) tup[dim+1+j] = tup[j+(j>=i)];
134*3f27d899SToby Isaac       ierr = PetscNodeRecursive_Internal(dim-1,degree-tup[i],nodesets,&tup[dim+1],&node[dim+1]);CHKERRQ(ierr);
135*3f27d899SToby Isaac       for (j = 0; j < dim+1; j++) node[j+(j>=i)] += wi * node[dim+1+j];
136*3f27d899SToby Isaac       w += wi;
137*3f27d899SToby Isaac     }
138*3f27d899SToby Isaac     for (i = 0; i < dim+1; i++) node[i] /= w;
139*3f27d899SToby Isaac   }
140*3f27d899SToby Isaac   PetscFunctionReturn(0);
141*3f27d899SToby Isaac }
142*3f27d899SToby Isaac 
143*3f27d899SToby Isaac /* compute simplex nodes for the biunit simplex from the 1D node family */
144*3f27d899SToby Isaac static PetscErrorCode Petsc1DNodeFamilyComputeSimplexNodes(Petsc1DNodeFamily f, PetscInt dim, PetscInt degree, PetscReal points[])
145*3f27d899SToby Isaac {
146*3f27d899SToby Isaac   PetscInt      *tup;
147*3f27d899SToby Isaac   PetscInt       k;
148*3f27d899SToby Isaac   PetscInt       npoints;
149*3f27d899SToby Isaac   PetscReal    **nodesets = NULL;
150*3f27d899SToby Isaac   PetscInt       worksize;
151*3f27d899SToby Isaac   PetscReal     *nodework;
152*3f27d899SToby Isaac   PetscInt      *tupwork;
153*3f27d899SToby Isaac   PetscErrorCode ierr;
154*3f27d899SToby Isaac 
155*3f27d899SToby Isaac   PetscFunctionBegin;
156*3f27d899SToby Isaac   if (dim < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Must have non-negative dimension\n");
157*3f27d899SToby Isaac   if (degree < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Must have non-negative degree\n");
158*3f27d899SToby Isaac   if (!dim) PetscFunctionReturn(0);
159*3f27d899SToby Isaac   ierr = PetscCalloc1(dim+2, &tup);CHKERRQ(ierr);
160*3f27d899SToby Isaac   k = 0;
161*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(degree + dim, dim, &npoints);CHKERRQ(ierr);
162*3f27d899SToby Isaac   ierr = Petsc1DNodeFamilyGetNodeSets(f, degree, &nodesets);CHKERRQ(ierr);
163*3f27d899SToby Isaac   worksize = ((dim + 2) * (dim + 3)) / 2;
164*3f27d899SToby Isaac   ierr = PetscMalloc2(worksize, &nodework, worksize, &tupwork);CHKERRQ(ierr);
165*3f27d899SToby Isaac   for (k = 0; k < npoints; k++) {
166*3f27d899SToby Isaac     PetscInt i;
167*3f27d899SToby Isaac 
168*3f27d899SToby Isaac     tup[0] = degree;
169*3f27d899SToby Isaac     for (i = 0; i < dim; i++) {
170*3f27d899SToby Isaac       tup[0] -= tup[i+1];
171*3f27d899SToby Isaac     }
172*3f27d899SToby Isaac     switch(f->nodeFamily) {
173*3f27d899SToby Isaac     case PETSCDTNODES_EQUISPACED:
174*3f27d899SToby Isaac       if (f->endpoints) {
175*3f27d899SToby Isaac         for (i = 0; i < dim; i++) {
176*3f27d899SToby Isaac           points[dim*k + i] = (PetscReal) tup[i+1] / (PetscReal) degree;
177*3f27d899SToby Isaac         }
178*3f27d899SToby Isaac       } else {
179*3f27d899SToby Isaac         for (i = 0; i < dim; i++) {
180*3f27d899SToby Isaac           points[dim*k + i] = ((PetscReal) tup[i+1] + 1./(dim+1.)) / (PetscReal) (degree + 1.);
181*3f27d899SToby Isaac         }
182*3f27d899SToby Isaac       }
183*3f27d899SToby Isaac       break;
184*3f27d899SToby Isaac     default:
185*3f27d899SToby Isaac       for (i = 0; i < dim + 1; i++) tupwork[i] = tup[i];
186*3f27d899SToby Isaac       ierr = PetscNodeRecursive_Internal(dim, degree, nodesets, tupwork, nodework);CHKERRQ(ierr);
187*3f27d899SToby Isaac       for (i = 0; i < dim; i++) points[dim*k + i] = nodework[i + 1];
188*3f27d899SToby Isaac       break;
189*3f27d899SToby Isaac     }
190*3f27d899SToby Isaac     ierr = PetscDualSpaceLatticePointLexicographic_Internal(dim, degree, &tup[1]);CHKERRQ(ierr);
191*3f27d899SToby Isaac   }
192*3f27d899SToby Isaac   /* map from unit simplex to biunit simplex */
193*3f27d899SToby Isaac   for (k = 0; k < npoints * dim; k++) points[k] = points[k] * 2. - 1.;
194*3f27d899SToby Isaac   ierr = PetscFree2(nodework, tupwork);CHKERRQ(ierr);
195*3f27d899SToby Isaac   ierr = PetscFree(tup);
196*3f27d899SToby Isaac   PetscFunctionReturn(0);
197*3f27d899SToby Isaac }
198*3f27d899SToby Isaac 
199*3f27d899SToby Isaac struct _n_PetscLagNodeIndices
200*3f27d899SToby Isaac {
201*3f27d899SToby Isaac   PetscInt   refct;
202*3f27d899SToby Isaac   PetscInt   nodeIdxDim;
203*3f27d899SToby Isaac   PetscInt   nodeVecDim;
204*3f27d899SToby Isaac   PetscInt   nNodes;
205*3f27d899SToby Isaac   PetscInt  *nodeIdx;      /* for each node an index of size nodeIdxDim */
206*3f27d899SToby Isaac   PetscReal *nodeVec;      /* for each node a vector of size nodeVecDim */
207*3f27d899SToby Isaac   PetscInt  *perm;         /* if these are vertices, perm takes DMPlex point index to closure order;
208*3f27d899SToby Isaac                               if these are nodes, perm lists nodes in index revlex order */
209*3f27d899SToby Isaac };
210*3f27d899SToby Isaac 
211*3f27d899SToby Isaac PetscErrorCode PetscLagNodeIndicesGetData_Internal(PetscLagNodeIndices ni, PetscInt *nodeIdxDim, PetscInt *nodeVecDim, PetscInt *nNodes, const PetscInt *nodeIdx[], const PetscReal *nodeVec[])
212*3f27d899SToby Isaac {
213*3f27d899SToby Isaac   PetscFunctionBegin;
214*3f27d899SToby Isaac   *nodeIdxDim = ni->nodeIdxDim;
215*3f27d899SToby Isaac   *nodeVecDim = ni->nodeVecDim;
216*3f27d899SToby Isaac   *nNodes = ni->nNodes;
217*3f27d899SToby Isaac   *nodeIdx = ni->nodeIdx;
218*3f27d899SToby Isaac   *nodeVec = ni->nodeVec;
219*3f27d899SToby Isaac   PetscFunctionReturn(0);
220*3f27d899SToby Isaac }
221*3f27d899SToby Isaac 
222*3f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesReference(PetscLagNodeIndices ni)
223*3f27d899SToby Isaac {
224*3f27d899SToby Isaac   PetscFunctionBegin;
225*3f27d899SToby Isaac   if (ni) ni->refct++;
226*3f27d899SToby Isaac   PetscFunctionReturn(0);
227*3f27d899SToby Isaac }
228*3f27d899SToby Isaac 
229*3f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesDestroy(PetscLagNodeIndices *ni) {
230*3f27d899SToby Isaac   PetscErrorCode ierr;
231*3f27d899SToby Isaac 
232*3f27d899SToby Isaac   PetscFunctionBegin;
233*3f27d899SToby Isaac   if (!(*ni)) PetscFunctionReturn(0);
234*3f27d899SToby Isaac   if (--(*ni)->refct > 0) {
235*3f27d899SToby Isaac     *ni = NULL;
236*3f27d899SToby Isaac     PetscFunctionReturn(0);
237*3f27d899SToby Isaac   }
238*3f27d899SToby Isaac   ierr = PetscFree((*ni)->nodeIdx);CHKERRQ(ierr);
239*3f27d899SToby Isaac   ierr = PetscFree((*ni)->nodeVec);CHKERRQ(ierr);
240*3f27d899SToby Isaac   ierr = PetscFree((*ni)->perm);CHKERRQ(ierr);
241*3f27d899SToby Isaac   ierr = PetscFree(*ni);CHKERRQ(ierr);
242*3f27d899SToby Isaac   *ni = NULL;
243*3f27d899SToby Isaac   PetscFunctionReturn(0);
244*3f27d899SToby Isaac }
245*3f27d899SToby Isaac 
246*3f27d899SToby Isaac /* The vertex indices were written as though the vertices were in revlex order
247*3f27d899SToby Isaac  * wrt coordinates.  To understand the effect of different symmetries, we need
248*3f27d899SToby Isaac  * them to be in closure order.  We also need a permutation that takes point index
249*3f27d899SToby Isaac  * to closure number */
250*3f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesComputeVertexOrder(DM dm, PetscLagNodeIndices ni, PetscBool sortIdx)
251*3f27d899SToby Isaac {
252*3f27d899SToby Isaac   PetscInt        v, w, vStart, vEnd, c, d;
253*3f27d899SToby Isaac   PetscInt        nVerts;
254*3f27d899SToby Isaac   PetscInt        closureSize = 0;
255*3f27d899SToby Isaac   PetscInt       *closure = NULL;
256*3f27d899SToby Isaac   PetscInt       *closureOrder;
257*3f27d899SToby Isaac   PetscInt       *invClosureOrder;
258*3f27d899SToby Isaac   PetscInt       *revlexOrder;
259*3f27d899SToby Isaac   PetscInt       *newNodeIdx;
260*3f27d899SToby Isaac   PetscInt        dim;
261*3f27d899SToby Isaac   Vec             coordVec;
262*3f27d899SToby Isaac   const PetscScalar *coords;
263*3f27d899SToby Isaac   PetscErrorCode  ierr;
264*3f27d899SToby Isaac 
265*3f27d899SToby Isaac   PetscFunctionBegin;
266*3f27d899SToby Isaac   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
267*3f27d899SToby Isaac   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
268*3f27d899SToby Isaac   nVerts = vEnd - vStart;
269*3f27d899SToby Isaac   ierr = PetscMalloc1(nVerts, &closureOrder);CHKERRQ(ierr);
270*3f27d899SToby Isaac   ierr = PetscMalloc1(nVerts, &invClosureOrder);CHKERRQ(ierr);
271*3f27d899SToby Isaac   ierr = PetscMalloc1(nVerts, &revlexOrder);CHKERRQ(ierr);
272*3f27d899SToby Isaac   if (sortIdx) {
273*3f27d899SToby Isaac     PetscInt nodeIdxDim = ni->nodeIdxDim;
274*3f27d899SToby Isaac     PetscInt *idxOrder;
275*3f27d899SToby Isaac 
276*3f27d899SToby Isaac     ierr = PetscMalloc1(nVerts * nodeIdxDim, &newNodeIdx);CHKERRQ(ierr);
277*3f27d899SToby Isaac     ierr = PetscMalloc1(nVerts, &idxOrder);CHKERRQ(ierr);
278*3f27d899SToby Isaac     for (v = 0; v < nVerts; v++) idxOrder[v] = v;
279*3f27d899SToby Isaac     for (v = 0; v < nVerts; v++) {
280*3f27d899SToby Isaac       for (w = v + 1; w < nVerts; w++) {
281*3f27d899SToby Isaac         const PetscInt *iv = &(ni->nodeIdx[idxOrder[v] * nodeIdxDim]);
282*3f27d899SToby Isaac         const PetscInt *iw = &(ni->nodeIdx[idxOrder[w] * nodeIdxDim]);
283*3f27d899SToby Isaac         PetscInt diff = 0;
284*3f27d899SToby Isaac 
285*3f27d899SToby Isaac         for (d = nodeIdxDim - 1; d >= 0; d--) if ((diff = (iv[d] - iw[d]))) break;
286*3f27d899SToby Isaac         if (diff > 0) {
287*3f27d899SToby Isaac           PetscInt swap = idxOrder[v];
288*3f27d899SToby Isaac 
289*3f27d899SToby Isaac           idxOrder[v] = idxOrder[w];
290*3f27d899SToby Isaac           idxOrder[w] = swap;
291*3f27d899SToby Isaac         }
292*3f27d899SToby Isaac       }
293*3f27d899SToby Isaac     }
294*3f27d899SToby Isaac     for (v = 0; v < nVerts; v++) {
295*3f27d899SToby Isaac       for (d = 0; d < nodeIdxDim; d++) {
296*3f27d899SToby Isaac         newNodeIdx[v * ni->nodeIdxDim + d] = ni->nodeIdx[idxOrder[v] * nodeIdxDim + d];
297*3f27d899SToby Isaac       }
298*3f27d899SToby Isaac     }
299*3f27d899SToby Isaac     ierr = PetscFree(ni->nodeIdx);CHKERRQ(ierr);
300*3f27d899SToby Isaac     ni->nodeIdx = newNodeIdx;
301*3f27d899SToby Isaac     newNodeIdx = NULL;
302*3f27d899SToby Isaac     ierr = PetscFree(idxOrder);CHKERRQ(ierr);
303*3f27d899SToby Isaac   }
304*3f27d899SToby Isaac   ierr = DMPlexGetTransitiveClosure(dm, 0, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
305*3f27d899SToby Isaac   c = closureSize - nVerts;
306*3f27d899SToby Isaac   for (v = 0; v < nVerts; v++) closureOrder[v] = closure[2 * (c + v)] - vStart;
307*3f27d899SToby Isaac   for (v = 0; v < nVerts; v++) invClosureOrder[closureOrder[v]] = v;
308*3f27d899SToby Isaac   ierr = DMPlexRestoreTransitiveClosure(dm, 0, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
309*3f27d899SToby Isaac   ierr = DMGetCoordinatesLocal(dm, &coordVec);CHKERRQ(ierr);
310*3f27d899SToby Isaac   ierr = VecGetArrayRead(coordVec, &coords);CHKERRQ(ierr);
311*3f27d899SToby Isaac   /* bubble sort closure vertices by coordinates in revlex order */
312*3f27d899SToby Isaac   for (v = 0; v < nVerts; v++) revlexOrder[v] = v;
313*3f27d899SToby Isaac   for (v = 0; v < nVerts; v++) {
314*3f27d899SToby Isaac     for (w = v + 1; w < nVerts; w++) {
315*3f27d899SToby Isaac       const PetscScalar *cv = &coords[closureOrder[revlexOrder[v]] * dim];
316*3f27d899SToby Isaac       const PetscScalar *cw = &coords[closureOrder[revlexOrder[w]] * dim];
317*3f27d899SToby Isaac       PetscReal diff = 0;
318*3f27d899SToby Isaac 
319*3f27d899SToby Isaac       for (d = dim - 1; d >= 0; d--) if ((diff = PetscRealPart(cv[d] - cw[d])) != 0.) break;
320*3f27d899SToby Isaac       if (diff > 0.) {
321*3f27d899SToby Isaac         PetscInt swap = revlexOrder[v];
322*3f27d899SToby Isaac 
323*3f27d899SToby Isaac         revlexOrder[v] = revlexOrder[w];
324*3f27d899SToby Isaac         revlexOrder[w] = swap;
325*3f27d899SToby Isaac       }
326*3f27d899SToby Isaac     }
327*3f27d899SToby Isaac   }
328*3f27d899SToby Isaac   ierr = VecRestoreArrayRead(coordVec, &coords);CHKERRQ(ierr);
329*3f27d899SToby Isaac   ierr = PetscMalloc1(ni->nodeIdxDim * nVerts, &newNodeIdx);CHKERRQ(ierr);
330*3f27d899SToby Isaac   /* reorder nodeIdx to be in closure order */
331*3f27d899SToby Isaac   for (v = 0; v < nVerts; v++) {
332*3f27d899SToby Isaac     for (d = 0; d < ni->nodeIdxDim; d++) {
333*3f27d899SToby Isaac       newNodeIdx[revlexOrder[v] * ni->nodeIdxDim + d] = ni->nodeIdx[v * ni->nodeIdxDim + d];
334*3f27d899SToby Isaac     }
335*3f27d899SToby Isaac   }
336*3f27d899SToby Isaac   ierr = PetscFree(ni->nodeIdx);CHKERRQ(ierr);
337*3f27d899SToby Isaac   ni->nodeIdx = newNodeIdx;
338*3f27d899SToby Isaac   ni->perm = invClosureOrder;
339*3f27d899SToby Isaac   ierr = PetscFree(revlexOrder);CHKERRQ(ierr);
340*3f27d899SToby Isaac   ierr = PetscFree(closureOrder);CHKERRQ(ierr);
341*3f27d899SToby Isaac   PetscFunctionReturn(0);
342*3f27d899SToby Isaac }
343*3f27d899SToby Isaac 
344*3f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesCreateSimplexVertices(DM dm, PetscLagNodeIndices *nodeIndices)
345*3f27d899SToby Isaac {
346*3f27d899SToby Isaac   PetscLagNodeIndices ni;
347*3f27d899SToby Isaac   PetscInt       dim, d;
348*3f27d899SToby Isaac 
349*3f27d899SToby Isaac   PetscErrorCode ierr;
350*3f27d899SToby Isaac 
351*3f27d899SToby Isaac   PetscFunctionBegin;
352*3f27d899SToby Isaac   ierr = PetscNew(&ni);CHKERRQ(ierr);
353*3f27d899SToby Isaac   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
354*3f27d899SToby Isaac   ni->nodeIdxDim = dim + 1;
355*3f27d899SToby Isaac   ni->nodeVecDim = 0;
356*3f27d899SToby Isaac   ni->nNodes = dim + 1;
357*3f27d899SToby Isaac   ni->refct = 1;
358*3f27d899SToby Isaac   ierr = PetscCalloc1((dim + 1)*(dim + 1), &(ni->nodeIdx));CHKERRQ(ierr);
359*3f27d899SToby Isaac   for (d = 0; d < dim + 1; d++) ni->nodeIdx[d*(dim + 2)] = 1;
360*3f27d899SToby Isaac   ierr = PetscLagNodeIndicesComputeVertexOrder(dm, ni, PETSC_FALSE);CHKERRQ(ierr);
361*3f27d899SToby Isaac   *nodeIndices = ni;
362*3f27d899SToby Isaac   PetscFunctionReturn(0);
363*3f27d899SToby Isaac }
364*3f27d899SToby Isaac 
365*3f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesCreateTensorVertices(DM dm, PetscLagNodeIndices facetni, PetscLagNodeIndices *nodeIndices)
366*3f27d899SToby Isaac {
367*3f27d899SToby Isaac   PetscLagNodeIndices ni;
368*3f27d899SToby Isaac   PetscInt       nodeIdxDim, subNodeIdxDim = facetni->nodeIdxDim;
369*3f27d899SToby Isaac   PetscInt       nVerts, nSubVerts = facetni->nNodes;
370*3f27d899SToby Isaac   PetscInt       dim, d, e, f, g;
371*3f27d899SToby Isaac 
372*3f27d899SToby Isaac   PetscErrorCode ierr;
373*3f27d899SToby Isaac 
374*3f27d899SToby Isaac   PetscFunctionBegin;
375*3f27d899SToby Isaac   ierr = PetscNew(&ni);CHKERRQ(ierr);
376*3f27d899SToby Isaac   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
377*3f27d899SToby Isaac   ni->nodeIdxDim = nodeIdxDim = subNodeIdxDim + 2;
378*3f27d899SToby Isaac   ni->nodeVecDim = 0;
379*3f27d899SToby Isaac   ni->nNodes = nVerts = 2 * nSubVerts;
380*3f27d899SToby Isaac   ni->refct = 1;
381*3f27d899SToby Isaac   ierr = PetscCalloc1(nodeIdxDim * nVerts, &(ni->nodeIdx));CHKERRQ(ierr);
382*3f27d899SToby Isaac   for (f = 0, d = 0; d < 2; d++) {
383*3f27d899SToby Isaac     for (e = 0; e < nSubVerts; e++, f++) {
384*3f27d899SToby Isaac       for (g = 0; g < subNodeIdxDim; g++) {
385*3f27d899SToby Isaac         ni->nodeIdx[f * nodeIdxDim + g] = facetni->nodeIdx[e * subNodeIdxDim + g];
386*3f27d899SToby Isaac       }
387*3f27d899SToby Isaac       ni->nodeIdx[f * nodeIdxDim + subNodeIdxDim] = (1 - d);
388*3f27d899SToby Isaac       ni->nodeIdx[f * nodeIdxDim + subNodeIdxDim + 1] = d;
389*3f27d899SToby Isaac     }
390*3f27d899SToby Isaac   }
391*3f27d899SToby Isaac   ierr = PetscLagNodeIndicesComputeVertexOrder(dm, ni, PETSC_TRUE);CHKERRQ(ierr);
392*3f27d899SToby Isaac   *nodeIndices = ni;
393*3f27d899SToby Isaac   PetscFunctionReturn(0);
394*3f27d899SToby Isaac }
395*3f27d899SToby Isaac 
396*3f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesPushForward(DM dm, PetscLagNodeIndices vert, PetscInt p, PetscLagNodeIndices vertp, PetscLagNodeIndices nodep, PetscInt ornt, PetscInt formDegree, PetscInt pfNodeIdx[], PetscReal pfNodeVec[])
397*3f27d899SToby Isaac {
398*3f27d899SToby Isaac   PetscInt       *closureVerts;
399*3f27d899SToby Isaac   PetscInt        closureSize = 0;
400*3f27d899SToby Isaac   PetscInt       *closure = NULL;
401*3f27d899SToby Isaac   PetscInt        dim, pdim, c, i, j, k, n, v, vStart, vEnd;
402*3f27d899SToby Isaac   PetscInt        nSubVert = vertp->nNodes;
403*3f27d899SToby Isaac   PetscInt        nodeIdxDim = vert->nodeIdxDim;
404*3f27d899SToby Isaac   PetscInt        subNodeIdxDim = vertp->nodeIdxDim;
405*3f27d899SToby Isaac   PetscInt        nNodes = nodep->nNodes;
406*3f27d899SToby Isaac   const PetscInt  *vertIdx = vert->nodeIdx;
407*3f27d899SToby Isaac   const PetscInt  *subVertIdx = vertp->nodeIdx;
408*3f27d899SToby Isaac   const PetscInt  *nodeIdx = nodep->nodeIdx;
409*3f27d899SToby Isaac   const PetscReal *nodeVec = nodep->nodeVec;
410*3f27d899SToby Isaac   PetscReal       *J, *Jstar;
411*3f27d899SToby Isaac   PetscReal       detJ;
412*3f27d899SToby Isaac   PetscInt        depth, pdepth, Nk, pNk;
413*3f27d899SToby Isaac   Vec             coordVec;
414*3f27d899SToby Isaac   PetscScalar      *newCoords = NULL;
415*3f27d899SToby Isaac   const PetscScalar *oldCoords = NULL;
416*3f27d899SToby Isaac   PetscErrorCode  ierr;
417*3f27d899SToby Isaac 
418*3f27d899SToby Isaac   PetscFunctionBegin;
419*3f27d899SToby Isaac   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
420*3f27d899SToby Isaac   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
421*3f27d899SToby Isaac   ierr = DMGetCoordinatesLocal(dm, &coordVec);CHKERRQ(ierr);
422*3f27d899SToby Isaac   ierr = DMPlexGetPointDepth(dm, p, &pdepth);CHKERRQ(ierr);
423*3f27d899SToby Isaac   pdim = pdepth != depth ? pdepth != 0 ? pdepth : 0 : dim;
424*3f27d899SToby Isaac   ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
425*3f27d899SToby Isaac   ierr = DMGetWorkArray(dm, nSubVert, MPIU_INT, &closureVerts);CHKERRQ(ierr);
426*3f27d899SToby Isaac   ierr = DMPlexGetTransitiveClosure_Internal(dm, p, ornt, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
427*3f27d899SToby Isaac   c = closureSize - nSubVert;
428*3f27d899SToby Isaac   /* we want which cell closure indices the closure of this point corresponds to */
429*3f27d899SToby Isaac   for (v = 0; v < nSubVert; v++) closureVerts[v] = vert->perm[closure[2 * (c + v)] - vStart];
430*3f27d899SToby Isaac   ierr = DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
431*3f27d899SToby Isaac   /* push forward indices */
432*3f27d899SToby Isaac   for (i = 0; i < nodeIdxDim; i++) { /* for every component of the target index space */
433*3f27d899SToby Isaac     /* check if this is a component that all vertices around this point have in common */
434*3f27d899SToby Isaac     for (j = 1; j < nSubVert; j++) {
435*3f27d899SToby Isaac       if (vertIdx[closureVerts[j] * nodeIdxDim + i] != vertIdx[closureVerts[0] * nodeIdxDim + i]) break;
436*3f27d899SToby Isaac     }
437*3f27d899SToby Isaac     if (j == nSubVert) { /* all vertices have this component in common, directly copy to output */
438*3f27d899SToby Isaac       PetscInt val = vertIdx[closureVerts[0] * nodeIdxDim + i];
439*3f27d899SToby Isaac       for (n = 0; n < nNodes; n++) pfNodeIdx[n * nodeIdxDim + i] = val;
440*3f27d899SToby Isaac     } else {
441*3f27d899SToby Isaac       PetscInt subi = -1;
442*3f27d899SToby Isaac       /* there must be a component in vertp that looks the same */
443*3f27d899SToby Isaac       for (k = 0; k < subNodeIdxDim; k++) {
444*3f27d899SToby Isaac         for (j = 0; j < nSubVert; j++) {
445*3f27d899SToby Isaac           if (vertIdx[closureVerts[j] * nodeIdxDim + i] != subVertIdx[j * subNodeIdxDim + k]) break;
446*3f27d899SToby Isaac         }
447*3f27d899SToby Isaac         if (j == nSubVert) {
448*3f27d899SToby Isaac           subi = k;
449*3f27d899SToby Isaac           break;
450*3f27d899SToby Isaac         }
451*3f27d899SToby Isaac       }
452*3f27d899SToby Isaac       if (subi < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Did not find matching coordinate\n");
453*3f27d899SToby Isaac       for (n = 0; n < nNodes; n++) pfNodeIdx[n * nodeIdxDim + i] = nodeIdx[n * subNodeIdxDim + subi];
454*3f27d899SToby Isaac     }
455*3f27d899SToby Isaac   }
456*3f27d899SToby Isaac   /* push forward vectors */
457*3f27d899SToby Isaac   ierr = DMGetWorkArray(dm, dim * dim, MPIU_REAL, &J);CHKERRQ(ierr);
458*3f27d899SToby Isaac   if (ornt != 0) {
459*3f27d899SToby Isaac     PetscInt        closureSize2 = 0;
460*3f27d899SToby Isaac     PetscInt       *closure2 = NULL;
461*3f27d899SToby Isaac 
462*3f27d899SToby Isaac     ierr = DMPlexGetTransitiveClosure_Internal(dm, p, 0, PETSC_TRUE, &closureSize2, &closure2);CHKERRQ(ierr);
463*3f27d899SToby Isaac     ierr = PetscMalloc1(dim * nSubVert, &newCoords);CHKERRQ(ierr);
464*3f27d899SToby Isaac     ierr = VecGetArrayRead(coordVec, &oldCoords);CHKERRQ(ierr);
465*3f27d899SToby Isaac     for (v = 0; v < nSubVert; v++) {
466*3f27d899SToby Isaac       PetscInt d;
467*3f27d899SToby Isaac       for (d = 0; d < dim; d++) {
468*3f27d899SToby Isaac         newCoords[(closure2[2 * (c + v)] - vStart) * dim + d] = oldCoords[closureVerts[v] * dim + d];
469*3f27d899SToby Isaac       }
470*3f27d899SToby Isaac     }
471*3f27d899SToby Isaac     ierr = VecRestoreArrayRead(coordVec, &oldCoords);CHKERRQ(ierr);
472*3f27d899SToby Isaac     ierr = DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize2, &closure2);CHKERRQ(ierr);
473*3f27d899SToby Isaac     ierr = VecPlaceArray(coordVec, newCoords);CHKERRQ(ierr);
474*3f27d899SToby Isaac   }
475*3f27d899SToby Isaac   ierr = DMPlexComputeCellGeometryAffineFEM(dm, p, NULL, J, NULL, &detJ);CHKERRQ(ierr);
476*3f27d899SToby Isaac   if (ornt != 0) {
477*3f27d899SToby Isaac     ierr = VecResetArray(coordVec);CHKERRQ(ierr);
478*3f27d899SToby Isaac     ierr = PetscFree(newCoords);CHKERRQ(ierr);
479*3f27d899SToby Isaac   }
480*3f27d899SToby Isaac   ierr = DMRestoreWorkArray(dm, nSubVert, MPIU_INT, &closureVerts);CHKERRQ(ierr);
481*3f27d899SToby Isaac   /* compactify */
482*3f27d899SToby Isaac   for (i = 0; i < dim; i++) for (j = 0; j < pdim; j++) J[i * pdim + j] = J[i * dim + j];
483*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk);CHKERRQ(ierr);
484*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(pdim, PetscAbsInt(formDegree), &pNk);CHKERRQ(ierr);
485*3f27d899SToby Isaac   ierr = DMGetWorkArray(dm, pNk * Nk, MPIU_REAL, &Jstar);CHKERRQ(ierr);
486*3f27d899SToby Isaac   ierr = PetscDTAltVPullbackMatrix(pdim, dim, J, formDegree, Jstar);CHKERRQ(ierr);
487*3f27d899SToby Isaac   for (n = 0; n < nNodes; n++) {
488*3f27d899SToby Isaac     for (i = 0; i < Nk; i++) {
489*3f27d899SToby Isaac       PetscReal val = 0.;
490*3f27d899SToby Isaac       for (j = 0; j < pNk; j++) val += nodeVec[n * pNk + j] * Jstar[j * pNk + i];
491*3f27d899SToby Isaac       pfNodeVec[n * Nk + i] = val;
492*3f27d899SToby Isaac     }
493*3f27d899SToby Isaac   }
494*3f27d899SToby Isaac   ierr = DMRestoreWorkArray(dm, pNk * Nk, MPIU_REAL, &Jstar);CHKERRQ(ierr);
495*3f27d899SToby Isaac   ierr = DMRestoreWorkArray(dm, dim * dim, MPIU_REAL, &J);CHKERRQ(ierr);
496*3f27d899SToby Isaac   PetscFunctionReturn(0);
497*3f27d899SToby Isaac }
498*3f27d899SToby Isaac 
499*3f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesTensor(PetscLagNodeIndices tracei, PetscInt dimT, PetscInt kT, PetscLagNodeIndices fiberi, PetscInt dimF, PetscInt kF, PetscLagNodeIndices *nodeIndices)
500*3f27d899SToby Isaac {
501*3f27d899SToby Isaac   PetscInt       dim = dimT + dimF;
502*3f27d899SToby Isaac   PetscInt       nodeIdxDim, nNodes;
503*3f27d899SToby Isaac   PetscInt       formDegree = kT + kF;
504*3f27d899SToby Isaac   PetscInt       Nk, NkT, NkF;
505*3f27d899SToby Isaac   PetscInt       MkT, MkF;
506*3f27d899SToby Isaac   PetscLagNodeIndices ni;
507*3f27d899SToby Isaac   PetscInt       i, j, l;
508*3f27d899SToby Isaac   PetscReal      *projF, *projT;
509*3f27d899SToby Isaac   PetscReal      *projFstar, *projTstar;
510*3f27d899SToby Isaac   PetscReal      *workF, *workF2, *workT, *workT2, *work, *work2;
511*3f27d899SToby Isaac   PetscReal      *wedgeMat;
512*3f27d899SToby Isaac   PetscReal      sign;
513*3f27d899SToby Isaac   PetscErrorCode ierr;
514*3f27d899SToby Isaac 
515*3f27d899SToby Isaac   PetscFunctionBegin;
516*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk);CHKERRQ(ierr);
517*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dimT, PetscAbsInt(kT), &NkT);CHKERRQ(ierr);
518*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dimF, PetscAbsInt(kF), &NkF);CHKERRQ(ierr);
519*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim, PetscAbsInt(kT), &MkT);CHKERRQ(ierr);
520*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim, PetscAbsInt(kF), &MkF);CHKERRQ(ierr);
521*3f27d899SToby Isaac   ierr = PetscNew(&ni);CHKERRQ(ierr);
522*3f27d899SToby Isaac   ni->nodeIdxDim = nodeIdxDim = tracei->nodeIdxDim + fiberi->nodeIdxDim;
523*3f27d899SToby Isaac   ni->nodeVecDim = Nk;
524*3f27d899SToby Isaac   ni->nNodes = nNodes = tracei->nNodes * fiberi->nNodes;
525*3f27d899SToby Isaac   ni->refct = 1;
526*3f27d899SToby Isaac   ierr = PetscMalloc1(nNodes * nodeIdxDim, &(ni->nodeIdx));CHKERRQ(ierr);
527*3f27d899SToby Isaac   /* first concatenate the indices */
528*3f27d899SToby Isaac   for (l = 0, j = 0; j < fiberi->nNodes; j++) {
529*3f27d899SToby Isaac     for (i = 0; i < tracei->nNodes; i++, l++) {
530*3f27d899SToby Isaac       PetscInt m, n = 0;
531*3f27d899SToby Isaac 
532*3f27d899SToby Isaac       for (m = 0; m < tracei->nodeIdxDim; m++) ni->nodeIdx[l * nodeIdxDim + n++] = tracei->nodeIdx[i * tracei->nodeIdxDim + m];
533*3f27d899SToby Isaac       for (m = 0; m < fiberi->nodeIdxDim; m++) ni->nodeIdx[l * nodeIdxDim + n++] = fiberi->nodeIdx[j * fiberi->nodeIdxDim + m];
534*3f27d899SToby Isaac     }
535*3f27d899SToby Isaac   }
536*3f27d899SToby Isaac 
537*3f27d899SToby Isaac   /* now wedge together the push-forward vectors */
538*3f27d899SToby Isaac   ierr = PetscMalloc1(nNodes * Nk, &(ni->nodeVec));CHKERRQ(ierr);
539*3f27d899SToby Isaac   ierr = PetscCalloc2(dimT*dim, &projT, dimF*dim, &projF);CHKERRQ(ierr);
540*3f27d899SToby Isaac   for (i = 0; i < dimT; i++) projT[i * (dim + 1)] = 1.;
541*3f27d899SToby Isaac   for (i = 0; i < dimF; i++) projF[i * (dim + dimT + 1) + dimT] = 1.;
542*3f27d899SToby Isaac   ierr = PetscMalloc2(MkT*NkT, &projTstar, MkF*NkF, &projFstar);CHKERRQ(ierr);
543*3f27d899SToby Isaac   ierr = PetscDTAltVPullbackMatrix(dim, dimT, projT, kT, projTstar);CHKERRQ(ierr);
544*3f27d899SToby Isaac   ierr = PetscDTAltVPullbackMatrix(dim, dimF, projF, kF, projFstar);CHKERRQ(ierr);
545*3f27d899SToby Isaac   ierr = PetscMalloc6(MkT, &workT, MkT, &workT2, MkF, &workF, MkF, &workF2, Nk, &work, Nk, &work2);CHKERRQ(ierr);
546*3f27d899SToby Isaac   ierr = PetscMalloc1(Nk * MkT, &wedgeMat);CHKERRQ(ierr);
547*3f27d899SToby Isaac   sign = (PetscAbsInt(kT * kF) & 1) ? -1. : 1.;
548*3f27d899SToby Isaac   for (l = 0, j = 0; j < fiberi->nNodes; j++) {
549*3f27d899SToby Isaac     PetscInt d, e;
550*3f27d899SToby Isaac 
551*3f27d899SToby Isaac     /* push forward fiber k-form */
552*3f27d899SToby Isaac     for (d = 0; d < MkF; d++) {
553*3f27d899SToby Isaac       PetscReal val = 0.;
554*3f27d899SToby Isaac       for (e = 0; e < NkF; e++) val += projFstar[d * NkF + e] * fiberi->nodeVec[j * NkF + e];
555*3f27d899SToby Isaac       workF[d] = val;
556*3f27d899SToby Isaac     }
557*3f27d899SToby Isaac     /* Hodge star to proper form if necessary */
558*3f27d899SToby Isaac     if (kF < 0) {
559*3f27d899SToby Isaac       for (d = 0; d < MkF; d++) workF2[d] = workF[d];
560*3f27d899SToby Isaac       ierr = PetscDTAltVStar(dim, PetscAbsInt(kF), 1, workF2, workF);CHKERRQ(ierr);
561*3f27d899SToby Isaac     }
562*3f27d899SToby Isaac     /* Compute the matrix that wedges this form with one of the trace k-form */
563*3f27d899SToby Isaac     ierr = PetscDTAltVWedgeMatrix(dim, PetscAbsInt(kF), PetscAbsInt(kT), workF, wedgeMat);CHKERRQ(ierr);
564*3f27d899SToby Isaac     for (i = 0; i < tracei->nNodes; i++, l++) {
565*3f27d899SToby Isaac       /* push forward trace k-form */
566*3f27d899SToby Isaac       for (d = 0; d < MkT; d++) {
567*3f27d899SToby Isaac         PetscReal val = 0.;
568*3f27d899SToby Isaac         for (e = 0; e < NkT; e++) val += projTstar[d * NkT + e] * tracei->nodeVec[i * NkT + e];
569*3f27d899SToby Isaac         workT[d] = val;
570*3f27d899SToby Isaac       }
571*3f27d899SToby Isaac       /* Hodge star to proper form if necessary */
572*3f27d899SToby Isaac       if (kT < 0) {
573*3f27d899SToby Isaac         for (d = 0; d < MkT; d++) workT2[d] = workT[d];
574*3f27d899SToby Isaac         ierr = PetscDTAltVStar(dim, PetscAbsInt(kT), 1, workT2, workT);CHKERRQ(ierr);
575*3f27d899SToby Isaac       }
576*3f27d899SToby Isaac       /* compute the wedge product of the push-forward trace form and firer forms */
577*3f27d899SToby Isaac       for (d = 0; d < Nk; d++) {
578*3f27d899SToby Isaac         PetscReal val = 0.;
579*3f27d899SToby Isaac         for (e = 0; e < MkT; e++) val += wedgeMat[d * MkT + e] * workT[e];
580*3f27d899SToby Isaac         work[d] = val;
581*3f27d899SToby Isaac       }
582*3f27d899SToby Isaac       /* inverse Hodge star from proper form if necessary */
583*3f27d899SToby Isaac       if (formDegree < 0) {
584*3f27d899SToby Isaac         for (d = 0; d < Nk; d++) work2[d] = work[d];
585*3f27d899SToby Isaac         ierr = PetscDTAltVStar(dim, PetscAbsInt(formDegree), -1, work2, work);CHKERRQ(ierr);
586*3f27d899SToby Isaac       }
587*3f27d899SToby Isaac       /* insert into the array (adjusting for sign) */
588*3f27d899SToby Isaac       for (d = 0; d < Nk; d++) ni->nodeVec[l * Nk + d] = sign * work[d];
589*3f27d899SToby Isaac     }
590*3f27d899SToby Isaac   }
591*3f27d899SToby Isaac   ierr = PetscFree(wedgeMat);CHKERRQ(ierr);
592*3f27d899SToby Isaac   ierr = PetscFree6(workT, workT2, workF, workF2, work, work2);CHKERRQ(ierr);
593*3f27d899SToby Isaac   ierr = PetscFree2(projTstar, projFstar);CHKERRQ(ierr);
594*3f27d899SToby Isaac   ierr = PetscFree2(projT, projF);CHKERRQ(ierr);
595*3f27d899SToby Isaac   *nodeIndices = ni;
596*3f27d899SToby Isaac   PetscFunctionReturn(0);
597*3f27d899SToby Isaac }
598*3f27d899SToby Isaac 
599*3f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesMerge(PetscLagNodeIndices niA, PetscLagNodeIndices niB, PetscLagNodeIndices *nodeIndices)
600*3f27d899SToby Isaac {
601*3f27d899SToby Isaac   PetscLagNodeIndices ni;
602*3f27d899SToby Isaac   PetscInt            nodeIdxDim, nodeVecDim, nNodes;
603*3f27d899SToby Isaac   PetscErrorCode      ierr;
604*3f27d899SToby Isaac 
605*3f27d899SToby Isaac   PetscFunctionBegin;
606*3f27d899SToby Isaac   ierr = PetscNew(&ni);CHKERRQ(ierr);
607*3f27d899SToby Isaac   ni->nodeIdxDim = nodeIdxDim = niA->nodeIdxDim;
608*3f27d899SToby Isaac   if (niB->nodeIdxDim != nodeIdxDim) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cannot merge PetscLagNodeIndices with different nodeIdxDim");
609*3f27d899SToby Isaac   ni->nodeVecDim = nodeVecDim = niA->nodeVecDim;
610*3f27d899SToby Isaac   if (niB->nodeVecDim != nodeVecDim) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cannot merge PetscLagNodeIndices with different nodeVecDim");
611*3f27d899SToby Isaac   ni->nNodes = nNodes = niA->nNodes + niB->nNodes;
612*3f27d899SToby Isaac   ni->refct = 1;
613*3f27d899SToby Isaac   ierr = PetscMalloc1(nNodes * nodeIdxDim, &(ni->nodeIdx));CHKERRQ(ierr);
614*3f27d899SToby Isaac   ierr = PetscMalloc1(nNodes * nodeVecDim, &(ni->nodeVec));CHKERRQ(ierr);
615*3f27d899SToby Isaac   ierr = PetscArraycpy(ni->nodeIdx, niA->nodeIdx, niA->nNodes * nodeIdxDim);CHKERRQ(ierr);
616*3f27d899SToby Isaac   ierr = PetscArraycpy(ni->nodeVec, niA->nodeVec, niA->nNodes * nodeVecDim);CHKERRQ(ierr);
617*3f27d899SToby Isaac   ierr = PetscArraycpy(&(ni->nodeIdx[niA->nNodes * nodeIdxDim]), niB->nodeIdx, niB->nNodes * nodeIdxDim);CHKERRQ(ierr);
618*3f27d899SToby Isaac   ierr = PetscArraycpy(&(ni->nodeVec[niA->nNodes * nodeVecDim]), niB->nodeVec, niB->nNodes * nodeVecDim);CHKERRQ(ierr);
619*3f27d899SToby Isaac   *nodeIndices = ni;
620*3f27d899SToby Isaac   PetscFunctionReturn(0);
621*3f27d899SToby Isaac }
622*3f27d899SToby Isaac 
623*3f27d899SToby Isaac #define PETSCTUPINTCOMPREVLEX(N)                                   \
624*3f27d899SToby Isaac static int PetscTupIntCompRevlex_##N(const void *a, const void *b) \
625*3f27d899SToby Isaac {                                                                  \
626*3f27d899SToby Isaac   const PetscInt *A = (const PetscInt *) a;                        \
627*3f27d899SToby Isaac   const PetscInt *B = (const PetscInt *) b;                        \
628*3f27d899SToby Isaac   int i;                                                           \
629*3f27d899SToby Isaac   PetscInt diff = 0;                                               \
630*3f27d899SToby Isaac   for (i = 0; i < N; i++) {                                        \
631*3f27d899SToby Isaac     diff = A[N - i] - B[N - i];                                    \
632*3f27d899SToby Isaac     if (diff) break;                                               \
633*3f27d899SToby Isaac   }                                                                \
634*3f27d899SToby Isaac   return (diff <= 0) ? (diff < 0) ? -1 : 0 : 1;                    \
635*3f27d899SToby Isaac }
636*3f27d899SToby Isaac 
637*3f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(3)
638*3f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(4)
639*3f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(5)
640*3f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(6)
641*3f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(7)
642*3f27d899SToby Isaac 
643*3f27d899SToby Isaac static int PetscTupIntCompRevlex_N(const void *a, const void *b)
644*3f27d899SToby Isaac {
645*3f27d899SToby Isaac   const PetscInt *A = (const PetscInt *) a;
646*3f27d899SToby Isaac   const PetscInt *B = (const PetscInt *) b;
647*3f27d899SToby Isaac   int i;
648*3f27d899SToby Isaac   int N = A[0];
649*3f27d899SToby Isaac   PetscInt diff = 0;
650*3f27d899SToby Isaac   for (i = 0; i < N; i++) {
651*3f27d899SToby Isaac     diff = A[N - i] - B[N - i];
652*3f27d899SToby Isaac     if (diff) break;
653*3f27d899SToby Isaac   }
654*3f27d899SToby Isaac   return (diff <= 0) ? (diff < 0) ? -1 : 0 : 1;
655*3f27d899SToby Isaac }
656*3f27d899SToby Isaac 
657*3f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesGetPermutation(PetscLagNodeIndices ni, PetscInt *perm[])
658*3f27d899SToby Isaac {
659*3f27d899SToby Isaac   PetscErrorCode ierr;
660*3f27d899SToby Isaac 
661*3f27d899SToby Isaac   PetscFunctionBegin;
662*3f27d899SToby Isaac   if (!(ni->perm)) {
663*3f27d899SToby Isaac     PetscInt *sorter;
664*3f27d899SToby Isaac     PetscInt m = ni->nNodes;
665*3f27d899SToby Isaac     PetscInt nodeIdxDim = ni->nodeIdxDim;
666*3f27d899SToby Isaac     PetscInt i, j, k, l;
667*3f27d899SToby Isaac     PetscInt *prm;
668*3f27d899SToby Isaac     int (*comp) (const void *, const void *);
669*3f27d899SToby Isaac 
670*3f27d899SToby Isaac     ierr = PetscMalloc1((nodeIdxDim + 2) * m, &sorter);CHKERRQ(ierr);
671*3f27d899SToby Isaac     for (k = 0, l = 0, i = 0; i < m; i++) {
672*3f27d899SToby Isaac       sorter[k++] = nodeIdxDim + 1;
673*3f27d899SToby Isaac       sorter[k++] = i;
674*3f27d899SToby Isaac       for (j = 0; j < nodeIdxDim; j++) sorter[k++] = ni->nodeIdx[l++];
675*3f27d899SToby Isaac     }
676*3f27d899SToby Isaac     switch (nodeIdxDim) {
677*3f27d899SToby Isaac     case 2:
678*3f27d899SToby Isaac       comp = PetscTupIntCompRevlex_3;
679*3f27d899SToby Isaac       break;
680*3f27d899SToby Isaac     case 3:
681*3f27d899SToby Isaac       comp = PetscTupIntCompRevlex_4;
682*3f27d899SToby Isaac       break;
683*3f27d899SToby Isaac     case 4:
684*3f27d899SToby Isaac       comp = PetscTupIntCompRevlex_5;
685*3f27d899SToby Isaac       break;
686*3f27d899SToby Isaac     case 5:
687*3f27d899SToby Isaac       comp = PetscTupIntCompRevlex_6;
688*3f27d899SToby Isaac       break;
689*3f27d899SToby Isaac     case 6:
690*3f27d899SToby Isaac       comp = PetscTupIntCompRevlex_7;
691*3f27d899SToby Isaac       break;
692*3f27d899SToby Isaac     default:
693*3f27d899SToby Isaac       comp = PetscTupIntCompRevlex_N;
694*3f27d899SToby Isaac       break;
695*3f27d899SToby Isaac     }
696*3f27d899SToby Isaac     qsort(sorter, m, (nodeIdxDim + 2) * sizeof(PetscInt), comp);
697*3f27d899SToby Isaac     ierr = PetscMalloc1(m, &prm);CHKERRQ(ierr);
698*3f27d899SToby Isaac     for (i = 0; i < m; i++) prm[i] = sorter[(nodeIdxDim + 2) * i + 1];
699*3f27d899SToby Isaac     ni->perm = prm;
700*3f27d899SToby Isaac     ierr = PetscFree(sorter);
701*3f27d899SToby Isaac   }
702*3f27d899SToby Isaac   *perm = ni->perm;
703*3f27d899SToby Isaac   PetscFunctionReturn(0);
704*3f27d899SToby Isaac }
70520cf1dd8SToby Isaac 
7066f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp)
70720cf1dd8SToby Isaac {
70820cf1dd8SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
7096f905325SMatthew G. Knepley   PetscErrorCode      ierr;
71020cf1dd8SToby Isaac 
71120cf1dd8SToby Isaac   PetscFunctionBegin;
712*3f27d899SToby Isaac   if (lag->symperms) {
713*3f27d899SToby Isaac     PetscInt **selfSyms = lag->symperms[0];
7146f905325SMatthew G. Knepley 
7156f905325SMatthew G. Knepley     if (selfSyms) {
7166f905325SMatthew G. Knepley       PetscInt i, **allocated = &selfSyms[-lag->selfSymOff];
7176f905325SMatthew G. Knepley 
7186f905325SMatthew G. Knepley       for (i = 0; i < lag->numSelfSym; i++) {
7196f905325SMatthew G. Knepley         ierr = PetscFree(allocated[i]);CHKERRQ(ierr);
7206f905325SMatthew G. Knepley       }
7216f905325SMatthew G. Knepley       ierr = PetscFree(allocated);CHKERRQ(ierr);
7226f905325SMatthew G. Knepley     }
723*3f27d899SToby Isaac     ierr = PetscFree(lag->symperms);CHKERRQ(ierr);
7246f905325SMatthew G. Knepley   }
725*3f27d899SToby Isaac   if (lag->symflips) {
726*3f27d899SToby Isaac     PetscScalar **selfSyms = lag->symflips[0];
727*3f27d899SToby Isaac 
728*3f27d899SToby Isaac     if (selfSyms) {
729*3f27d899SToby Isaac       PetscInt i;
730*3f27d899SToby Isaac       PetscScalar **allocated = &selfSyms[-lag->selfSymOff];
731*3f27d899SToby Isaac 
732*3f27d899SToby Isaac       for (i = 0; i < lag->numSelfSym; i++) {
733*3f27d899SToby Isaac         ierr = PetscFree(allocated[i]);CHKERRQ(ierr);
7346f905325SMatthew G. Knepley       }
735*3f27d899SToby Isaac       ierr = PetscFree(allocated);CHKERRQ(ierr);
736*3f27d899SToby Isaac     }
737*3f27d899SToby Isaac     ierr = PetscFree(lag->symflips);CHKERRQ(ierr);
738*3f27d899SToby Isaac   }
739*3f27d899SToby Isaac   ierr = Petsc1DNodeFamilyDestroy(&(lag->nodeFamily));CHKERRQ(ierr);
740*3f27d899SToby Isaac   ierr = PetscLagNodeIndicesDestroy(&(lag->vertIndices));CHKERRQ(ierr);
741*3f27d899SToby Isaac   ierr = PetscLagNodeIndicesDestroy(&(lag->intNodeIndices));CHKERRQ(ierr);
742*3f27d899SToby Isaac   ierr = PetscLagNodeIndicesDestroy(&(lag->allNodeIndices));CHKERRQ(ierr);
7436f905325SMatthew G. Knepley   ierr = PetscFree(lag);CHKERRQ(ierr);
7446f905325SMatthew G. Knepley   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", NULL);CHKERRQ(ierr);
7456f905325SMatthew G. Knepley   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", NULL);CHKERRQ(ierr);
7466f905325SMatthew G. Knepley   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", NULL);CHKERRQ(ierr);
7476f905325SMatthew G. Knepley   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", NULL);CHKERRQ(ierr);
748*3f27d899SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTrimmed_C", NULL);CHKERRQ(ierr);
749*3f27d899SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTrimmed_C", NULL);CHKERRQ(ierr);
750*3f27d899SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetNodeType_C", NULL);CHKERRQ(ierr);
751*3f27d899SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetNodeType_C", NULL);CHKERRQ(ierr);
75220cf1dd8SToby Isaac   PetscFunctionReturn(0);
75320cf1dd8SToby Isaac }
75420cf1dd8SToby Isaac 
7556f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceLagrangeView_Ascii(PetscDualSpace sp, PetscViewer viewer)
75620cf1dd8SToby Isaac {
75720cf1dd8SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
7586f905325SMatthew G. Knepley   PetscErrorCode      ierr;
75920cf1dd8SToby Isaac 
76020cf1dd8SToby Isaac   PetscFunctionBegin;
761*3f27d899SToby Isaac   ierr = PetscViewerASCIIPrintf(viewer, "%s %s%sLagrange dual space\n", lag->continuous ? "Continuous" : "Discontinuous", lag->tensorSpace ? "tensor " : "", lag->trimmed ? "trimmed " : "");CHKERRQ(ierr);
76220cf1dd8SToby Isaac   PetscFunctionReturn(0);
76320cf1dd8SToby Isaac }
76420cf1dd8SToby Isaac 
7656f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceView_Lagrange(PetscDualSpace sp, PetscViewer viewer)
76620cf1dd8SToby Isaac {
7676f905325SMatthew G. Knepley   PetscBool      iascii;
7686f905325SMatthew G. Knepley   PetscErrorCode ierr;
7696f905325SMatthew G. Knepley 
77020cf1dd8SToby Isaac   PetscFunctionBegin;
7716f905325SMatthew G. Knepley   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
7726f905325SMatthew G. Knepley   PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2);
7736f905325SMatthew G. Knepley   ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr);
7746f905325SMatthew G. Knepley   if (iascii) {ierr = PetscDualSpaceLagrangeView_Ascii(sp, viewer);CHKERRQ(ierr);}
77520cf1dd8SToby Isaac   PetscFunctionReturn(0);
77620cf1dd8SToby Isaac }
77720cf1dd8SToby Isaac 
7786f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceSetFromOptions_Lagrange(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp)
77920cf1dd8SToby Isaac {
780*3f27d899SToby Isaac   PetscBool      continuous, tensor, trimmed, flg, flg2, flg3;
781*3f27d899SToby Isaac   PetscDTNodeType nodeType;
782*3f27d899SToby Isaac   PetscReal      nodeExponent;
783*3f27d899SToby Isaac   PetscBool      nodeEndpoints;
7846f905325SMatthew G. Knepley   PetscErrorCode ierr;
7856f905325SMatthew G. Knepley 
7866f905325SMatthew G. Knepley   PetscFunctionBegin;
7876f905325SMatthew G. Knepley   ierr = PetscDualSpaceLagrangeGetContinuity(sp, &continuous);CHKERRQ(ierr);
7886f905325SMatthew G. Knepley   ierr = PetscDualSpaceLagrangeGetTensor(sp, &tensor);CHKERRQ(ierr);
789*3f27d899SToby Isaac   ierr = PetscDualSpaceLagrangeGetTrimmed(sp, &trimmed);CHKERRQ(ierr);
790*3f27d899SToby Isaac   ierr = PetscDualSpaceLagrangeGetNodeType(sp, &nodeType, &nodeEndpoints, &nodeExponent);CHKERRQ(ierr);
791*3f27d899SToby Isaac   if (nodeType == PETSCDTNODES_DEFAULT) nodeType = PETSCDTNODES_GAUSSJACOBI;
7926f905325SMatthew G. Knepley   ierr = PetscOptionsHead(PetscOptionsObject,"PetscDualSpace Lagrange Options");CHKERRQ(ierr);
7936f905325SMatthew G. Knepley   ierr = PetscOptionsBool("-petscdualspace_lagrange_continuity", "Flag for continuous element", "PetscDualSpaceLagrangeSetContinuity", continuous, &continuous, &flg);CHKERRQ(ierr);
7946f905325SMatthew G. Knepley   if (flg) {ierr = PetscDualSpaceLagrangeSetContinuity(sp, continuous);CHKERRQ(ierr);}
795*3f27d899SToby Isaac   ierr = PetscOptionsBool("-petscdualspace_lagrange_tensor", "Flag for tensor dual space", "PetscDualSpaceLagrangeSetTensor", tensor, &tensor, &flg);CHKERRQ(ierr);
7966f905325SMatthew G. Knepley   if (flg) {ierr = PetscDualSpaceLagrangeSetTensor(sp, tensor);CHKERRQ(ierr);}
797*3f27d899SToby Isaac   ierr = PetscOptionsBool("-petscdualspace_lagrange_trimmed", "Flag for trimmed dual space", "PetscDualSpaceLagrangeSetTrimmed", trimmed, &trimmed, &flg);CHKERRQ(ierr);
798*3f27d899SToby Isaac   if (flg) {ierr = PetscDualSpaceLagrangeSetTrimmed(sp, trimmed);CHKERRQ(ierr);}
799*3f27d899SToby Isaac   ierr = PetscOptionsEnum("-petscdualspace_lagrange_node_type", "Lagrange node location type", "PetscDualSpaceLagrangeSetNodeType", PetscDTNodeTypes, (PetscEnum)nodeType, (PetscEnum *)&nodeType, &flg);CHKERRQ(ierr);
800*3f27d899SToby Isaac   ierr = PetscOptionsBool("-petscdualspace_lagrange_node_endpoints", "Flag for nodes that include endpoints", "PetscDualSpaceLagrangeSetNodeType", nodeEndpoints, &nodeEndpoints, &flg2);CHKERRQ(ierr);
801*3f27d899SToby Isaac   flg3 = PETSC_FALSE;
802*3f27d899SToby Isaac   if (nodeType == PETSCDTNODES_GAUSSJACOBI) {
803*3f27d899SToby Isaac     ierr = PetscOptionsReal("-petscdualspace_lagrange_node_exponent", "Gauss-Jacobi weight function exponent", "PetscDualSpaceLagrangeSetNodeType", nodeExponent, &nodeExponent, &flg3);CHKERRQ(ierr);
804*3f27d899SToby Isaac   }
805*3f27d899SToby Isaac   if (flg || flg2 || flg3) {ierr = PetscDualSpaceLagrangeSetNodeType(sp, nodeType, nodeEndpoints, nodeExponent);CHKERRQ(ierr);}
8066f905325SMatthew G. Knepley   ierr = PetscOptionsTail();CHKERRQ(ierr);
8076f905325SMatthew G. Knepley   PetscFunctionReturn(0);
8086f905325SMatthew G. Knepley }
8096f905325SMatthew G. Knepley 
810b4457527SToby Isaac static PetscErrorCode PetscDualSpaceDuplicate_Lagrange(PetscDualSpace sp, PetscDualSpace spNew)
8116f905325SMatthew G. Knepley {
812*3f27d899SToby Isaac   PetscBool           cont, tensor, trimmed, boundary;
813*3f27d899SToby Isaac   PetscDTNodeType     nodeType;
814*3f27d899SToby Isaac   PetscReal           exponent;
815*3f27d899SToby Isaac   PetscDualSpace_Lag *lag    = (PetscDualSpace_Lag *) sp->data;
8166f905325SMatthew G. Knepley   PetscErrorCode      ierr;
8176f905325SMatthew G. Knepley 
8186f905325SMatthew G. Knepley   PetscFunctionBegin;
8196f905325SMatthew G. Knepley   ierr = PetscDualSpaceLagrangeGetContinuity(sp, &cont);CHKERRQ(ierr);
820b4457527SToby Isaac   ierr = PetscDualSpaceLagrangeSetContinuity(spNew, cont);CHKERRQ(ierr);
8216f905325SMatthew G. Knepley   ierr = PetscDualSpaceLagrangeGetTensor(sp, &tensor);CHKERRQ(ierr);
822b4457527SToby Isaac   ierr = PetscDualSpaceLagrangeSetTensor(spNew, tensor);CHKERRQ(ierr);
823*3f27d899SToby Isaac   ierr = PetscDualSpaceLagrangeGetTrimmed(sp, &trimmed);CHKERRQ(ierr);
824*3f27d899SToby Isaac   ierr = PetscDualSpaceLagrangeSetTrimmed(spNew, trimmed);CHKERRQ(ierr);
825*3f27d899SToby Isaac   ierr = PetscDualSpaceLagrangeGetNodeType(sp, &nodeType, &boundary, &exponent);CHKERRQ(ierr);
826*3f27d899SToby Isaac   ierr = PetscDualSpaceLagrangeSetNodeType(spNew, nodeType, boundary, exponent);CHKERRQ(ierr);
827*3f27d899SToby Isaac   if (lag->nodeFamily) {
828*3f27d899SToby Isaac     PetscDualSpace_Lag *lagnew = (PetscDualSpace_Lag *) spNew->data;
829*3f27d899SToby Isaac 
830*3f27d899SToby Isaac     ierr = Petsc1DNodeFamilyReference(lag->nodeFamily);CHKERRQ(ierr);
831*3f27d899SToby Isaac     lagnew->nodeFamily = lag->nodeFamily;
832*3f27d899SToby Isaac   }
8336f905325SMatthew G. Knepley   PetscFunctionReturn(0);
8346f905325SMatthew G. Knepley }
8356f905325SMatthew G. Knepley 
836*3f27d899SToby Isaac static PetscErrorCode PetscDualSpaceCreateEdgeSubspace_Lagrange(PetscDualSpace sp, PetscInt order, PetscInt k, PetscInt Nc, PetscBool interiorOnly, PetscDualSpace *bdsp)
8376f905325SMatthew G. Knepley {
838*3f27d899SToby Isaac   DM                 K;
839*3f27d899SToby Isaac   PetscDualSpace_Lag *newlag;
8406f905325SMatthew G. Knepley   PetscErrorCode     ierr;
8416f905325SMatthew G. Knepley 
8426f905325SMatthew G. Knepley   PetscFunctionBegin;
8436f905325SMatthew G. Knepley   ierr = PetscDualSpaceDuplicate(sp,bdsp);CHKERRQ(ierr);
844*3f27d899SToby Isaac   ierr = PetscDualSpaceSetFormDegree(*bdsp, k);CHKERRQ(ierr);
845*3f27d899SToby Isaac   ierr = PetscDualSpaceCreateReferenceCell(*bdsp, 1, PETSC_TRUE, &K);CHKERRQ(ierr);
8466f905325SMatthew G. Knepley   ierr = PetscDualSpaceSetDM(*bdsp, K);CHKERRQ(ierr);
8476f905325SMatthew G. Knepley   ierr = DMDestroy(&K);CHKERRQ(ierr);
848*3f27d899SToby Isaac   ierr = PetscDualSpaceSetOrder(*bdsp, order);CHKERRQ(ierr);
849*3f27d899SToby Isaac   ierr = PetscDualSpaceSetNumComponents(*bdsp, Nc);CHKERRQ(ierr);
850*3f27d899SToby Isaac   newlag = (PetscDualSpace_Lag *) (*bdsp)->data;
851*3f27d899SToby Isaac   newlag->interiorOnly = interiorOnly;
8526f905325SMatthew G. Knepley   ierr = PetscDualSpaceSetUp(*bdsp);CHKERRQ(ierr);
853*3f27d899SToby Isaac   PetscFunctionReturn(0);
8546f905325SMatthew G. Knepley }
855*3f27d899SToby Isaac 
856*3f27d899SToby Isaac /* just the points, weights aren't handled */
857*3f27d899SToby Isaac static PetscErrorCode PetscQuadratureCreateTensor(PetscQuadrature trace, PetscQuadrature fiber, PetscQuadrature *product)
858*3f27d899SToby Isaac {
859*3f27d899SToby Isaac   PetscInt         dimTrace, dimFiber;
860*3f27d899SToby Isaac   PetscInt         numPointsTrace, numPointsFiber;
861*3f27d899SToby Isaac   PetscInt         dim, numPoints;
862*3f27d899SToby Isaac   const PetscReal *pointsTrace;
863*3f27d899SToby Isaac   const PetscReal *pointsFiber;
864*3f27d899SToby Isaac   PetscReal       *points;
865*3f27d899SToby Isaac   PetscInt         i, j, k, p;
866*3f27d899SToby Isaac   PetscErrorCode   ierr;
867*3f27d899SToby Isaac 
868*3f27d899SToby Isaac   PetscFunctionBegin;
869*3f27d899SToby Isaac   ierr = PetscQuadratureGetData(trace, &dimTrace, NULL, &numPointsTrace, &pointsTrace, NULL);CHKERRQ(ierr);
870*3f27d899SToby Isaac   ierr = PetscQuadratureGetData(fiber, &dimFiber, NULL, &numPointsFiber, &pointsFiber, NULL);CHKERRQ(ierr);
871*3f27d899SToby Isaac   dim = dimTrace + dimFiber;
872*3f27d899SToby Isaac   numPoints = numPointsFiber * numPointsTrace;
873*3f27d899SToby Isaac   ierr = PetscMalloc1(numPoints * dim, &points);CHKERRQ(ierr);
874*3f27d899SToby Isaac   for (p = 0, j = 0; j < numPointsFiber; j++) {
875*3f27d899SToby Isaac     for (i = 0; i < numPointsTrace; i++, p++) {
876*3f27d899SToby Isaac       for (k = 0; k < dimTrace; k++) points[p * dim +            k] = pointsTrace[i * dimTrace + k];
877*3f27d899SToby Isaac       for (k = 0; k < dimFiber; k++) points[p * dim + dimTrace + k] = pointsFiber[j * dimFiber + k];
878*3f27d899SToby Isaac     }
879*3f27d899SToby Isaac   }
880*3f27d899SToby Isaac   ierr = PetscQuadratureCreate(PETSC_COMM_SELF, product);CHKERRQ(ierr);
881*3f27d899SToby Isaac   ierr = PetscQuadratureSetData(*product, dim, 0, numPoints, points, NULL);CHKERRQ(ierr);
882*3f27d899SToby Isaac   PetscFunctionReturn(0);
883*3f27d899SToby Isaac }
884*3f27d899SToby Isaac 
885*3f27d899SToby Isaac static PetscErrorCode MatTensorAltV(Mat trace, Mat fiber, PetscInt dimTrace, PetscInt kTrace, PetscInt dimFiber, PetscInt kFiber, Mat *product)
886*3f27d899SToby Isaac {
887*3f27d899SToby Isaac   PetscInt mTrace, nTrace, mFiber, nFiber, m, n, k, i, j, l;
888*3f27d899SToby Isaac   PetscInt dim, NkTrace, NkFiber, Nk;
889*3f27d899SToby Isaac   PetscInt dT, dF;
890*3f27d899SToby Isaac   PetscInt *nnzTrace, *nnzFiber, *nnz;
891*3f27d899SToby Isaac   PetscInt iT, iF, jT, jF, il, jl;
892*3f27d899SToby Isaac   PetscReal *workT, *workT2, *workF, *workF2, *work, *workstar;
893*3f27d899SToby Isaac   PetscReal *projT, *projF;
894*3f27d899SToby Isaac   PetscReal *projTstar, *projFstar;
895*3f27d899SToby Isaac   PetscReal *wedgeMat;
896*3f27d899SToby Isaac   PetscReal sign;
897*3f27d899SToby Isaac   PetscScalar *workS;
898*3f27d899SToby Isaac   Mat prod;
899*3f27d899SToby Isaac   /* this produces dof groups that look like the identity */
900*3f27d899SToby Isaac   PetscErrorCode ierr;
901*3f27d899SToby Isaac 
902*3f27d899SToby Isaac   PetscFunctionBegin;
903*3f27d899SToby Isaac   ierr = MatGetSize(trace, &mTrace, &nTrace);CHKERRQ(ierr);
904*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dimTrace, PetscAbsInt(kTrace), &NkTrace);CHKERRQ(ierr);
905*3f27d899SToby Isaac   if (nTrace % NkTrace) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "point value space of trace matrix is not a multiple of k-form size");
906*3f27d899SToby Isaac   ierr = MatGetSize(fiber, &mFiber, &nFiber);CHKERRQ(ierr);
907*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dimFiber, PetscAbsInt(kFiber), &NkFiber);CHKERRQ(ierr);
908*3f27d899SToby Isaac   if (nFiber % NkFiber) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "point value space of fiber matrix is not a multiple of k-form size");
909*3f27d899SToby Isaac   ierr = PetscMalloc2(mTrace, &nnzTrace, mFiber, &nnzFiber);CHKERRQ(ierr);
910*3f27d899SToby Isaac   for (i = 0; i < mTrace; i++) {
911*3f27d899SToby Isaac     ierr = MatGetRow(trace, i, &(nnzTrace[i]), NULL, NULL);CHKERRQ(ierr);
912*3f27d899SToby Isaac     if (nnzTrace[i] % NkTrace) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in trace matrix are not in k-form size blocks");
913*3f27d899SToby Isaac   }
914*3f27d899SToby Isaac   for (i = 0; i < mFiber; i++) {
915*3f27d899SToby Isaac     ierr = MatGetRow(fiber, i, &(nnzFiber[i]), NULL, NULL);CHKERRQ(ierr);
916*3f27d899SToby Isaac     if (nnzFiber[i] % NkFiber) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in fiber matrix are not in k-form size blocks");
917*3f27d899SToby Isaac   }
918*3f27d899SToby Isaac   dim = dimTrace + dimFiber;
919*3f27d899SToby Isaac   k = kFiber + kTrace;
920*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk);CHKERRQ(ierr);
921*3f27d899SToby Isaac   m = mTrace * mFiber;
922*3f27d899SToby Isaac   ierr = PetscMalloc1(m, &nnz);CHKERRQ(ierr);
923*3f27d899SToby Isaac   for (l = 0, j = 0; j < mFiber; j++) for (i = 0; i < mTrace; i++, l++) nnz[l] = (nnzTrace[i] / NkTrace) * (nnzFiber[j] / NkFiber) * Nk;
924*3f27d899SToby Isaac   n = (nTrace / NkTrace) * (nFiber / NkFiber) * Nk;
925*3f27d899SToby Isaac   ierr = MatCreateSeqAIJ(PETSC_COMM_SELF, m, n, 0, nnz, &prod);CHKERRQ(ierr);
926*3f27d899SToby Isaac   ierr = PetscFree(nnz);CHKERRQ(ierr);
927*3f27d899SToby Isaac   ierr = PetscFree2(nnzTrace,nnzFiber);CHKERRQ(ierr);
928*3f27d899SToby Isaac   /* reasoning about which points each dof needs depends on having zeros computed at points preserved */
929*3f27d899SToby Isaac   ierr = MatSetOption(prod, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);
930*3f27d899SToby Isaac   /* compute pullbacks */
931*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim, PetscAbsInt(kTrace), &dT);CHKERRQ(ierr);
932*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim, PetscAbsInt(kFiber), &dF);CHKERRQ(ierr);
933*3f27d899SToby Isaac   ierr = PetscMalloc4(dimTrace * dim, &projT, dimFiber * dim, &projF, dT * NkTrace, &projTstar, dF * NkFiber, &projFstar);CHKERRQ(ierr);
934*3f27d899SToby Isaac   ierr = PetscArrayzero(projT, dimTrace * dim);CHKERRQ(ierr);
935*3f27d899SToby Isaac   for (i = 0; i < dimTrace; i++) projT[i * (dim + 1)] = 1.;
936*3f27d899SToby Isaac   ierr = PetscArrayzero(projF, dimFiber * dim);CHKERRQ(ierr);
937*3f27d899SToby Isaac   for (i = 0; i < dimFiber; i++) projF[i * (dim + 1) + dimTrace] = 1.;
938*3f27d899SToby Isaac   ierr = PetscDTAltVPullbackMatrix(dim, dimTrace, projT, kTrace, projTstar);CHKERRQ(ierr);
939*3f27d899SToby Isaac   ierr = PetscDTAltVPullbackMatrix(dim, dimFiber, projF, kFiber, projFstar);CHKERRQ(ierr);
940*3f27d899SToby Isaac   ierr = PetscMalloc5(dT, &workT, dF, &workF, Nk, &work, Nk, &workstar, Nk, &workS);CHKERRQ(ierr);
941*3f27d899SToby Isaac   ierr = PetscMalloc2(dT, &workT2, dF, &workF2);CHKERRQ(ierr);
942*3f27d899SToby Isaac   ierr = PetscMalloc1(Nk * dT, &wedgeMat);CHKERRQ(ierr);
943*3f27d899SToby Isaac   sign = (PetscAbsInt(kTrace * kFiber) & 1) ? -1. : 1.;
944*3f27d899SToby Isaac   for (i = 0, iF = 0; iF < mFiber; iF++) {
945*3f27d899SToby Isaac     PetscInt           ncolsF, nformsF;
946*3f27d899SToby Isaac     const PetscInt    *colsF;
947*3f27d899SToby Isaac     const PetscScalar *valsF;
948*3f27d899SToby Isaac 
949*3f27d899SToby Isaac     ierr = MatGetRow(fiber, iF, &ncolsF, &colsF, &valsF);CHKERRQ(ierr);
950*3f27d899SToby Isaac     nformsF = ncolsF / NkFiber;
951*3f27d899SToby Isaac     for (iT = 0; iT < mTrace; iT++, i++) {
952*3f27d899SToby Isaac       PetscInt           ncolsT, nformsT;
953*3f27d899SToby Isaac       const PetscInt    *colsT;
954*3f27d899SToby Isaac       const PetscScalar *valsT;
955*3f27d899SToby Isaac 
956*3f27d899SToby Isaac       ierr = MatGetRow(trace, iT, &ncolsT, &colsT, &valsT);CHKERRQ(ierr);
957*3f27d899SToby Isaac       nformsT = ncolsT / NkTrace;
958*3f27d899SToby Isaac       for (j = 0, jF = 0; jF < nformsF; jF++) {
959*3f27d899SToby Isaac         PetscInt colF = colsF[jF * NkFiber] / NkFiber;
960*3f27d899SToby Isaac 
961*3f27d899SToby Isaac         for (il = 0; il < dF; il++) {
962*3f27d899SToby Isaac           PetscReal val = 0.;
963*3f27d899SToby Isaac           for (jl = 0; jl < NkFiber; jl++) val += projFstar[il * NkFiber + jl] * PetscRealPart(valsF[jF * NkFiber + jl]);
964*3f27d899SToby Isaac           workF[il] = val;
965*3f27d899SToby Isaac         }
966*3f27d899SToby Isaac         if (kFiber < 0) {
967*3f27d899SToby Isaac           for (il = 0; il < dF; il++) workF2[il] = workF[il];
968*3f27d899SToby Isaac           ierr = PetscDTAltVStar(dim, PetscAbsInt(kFiber), 1, workF2, workF);CHKERRQ(ierr);
969*3f27d899SToby Isaac         }
970*3f27d899SToby Isaac         ierr = PetscDTAltVWedgeMatrix(dim, PetscAbsInt(kFiber), PetscAbsInt(kTrace), workF, wedgeMat);CHKERRQ(ierr);
971*3f27d899SToby Isaac         for (jT = 0; jT < nformsT; jT++, j++) {
972*3f27d899SToby Isaac           PetscInt colT = colsT[jT * NkTrace] / NkTrace;
973*3f27d899SToby Isaac           PetscInt col = colF * (nTrace / NkTrace) + colT;
974*3f27d899SToby Isaac           const PetscScalar *vals;
975*3f27d899SToby Isaac 
976*3f27d899SToby Isaac           for (il = 0; il < dT; il++) {
977*3f27d899SToby Isaac             PetscReal val = 0.;
978*3f27d899SToby Isaac             for (jl = 0; jl < NkTrace; jl++) val += projTstar[il * NkTrace + jl] * PetscRealPart(valsT[jT * NkTrace + jl]);
979*3f27d899SToby Isaac             workT[il] = val;
980*3f27d899SToby Isaac           }
981*3f27d899SToby Isaac           if (kTrace < 0) {
982*3f27d899SToby Isaac             for (il = 0; il < dT; il++) workT2[il] = workT[il];
983*3f27d899SToby Isaac             ierr = PetscDTAltVStar(dim, PetscAbsInt(kTrace), 1, workT2, workT);CHKERRQ(ierr);
984*3f27d899SToby Isaac           }
985*3f27d899SToby Isaac 
986*3f27d899SToby Isaac           for (il = 0; il < Nk; il++) {
987*3f27d899SToby Isaac             PetscReal val = 0.;
988*3f27d899SToby Isaac             for (jl = 0; jl < dT; jl++) val += sign * wedgeMat[il * dT + jl] * workT[jl];
989*3f27d899SToby Isaac             work[il] = val;
990*3f27d899SToby Isaac           }
991*3f27d899SToby Isaac           if (k < 0) {
992*3f27d899SToby Isaac             ierr = PetscDTAltVStar(dim, PetscAbsInt(k), -1, work, workstar);CHKERRQ(ierr);
993*3f27d899SToby Isaac #if defined(PETSC_USE_COMPLEX)
994*3f27d899SToby Isaac             for (l = 0; l < Nk; l++) workS[l] = workstar[l];
995*3f27d899SToby Isaac             vals = &workS[0];
996*3f27d899SToby Isaac #else
997*3f27d899SToby Isaac             vals = &workstar[0];
998*3f27d899SToby Isaac #endif
999*3f27d899SToby Isaac           } else {
1000*3f27d899SToby Isaac #if defined(PETSC_USE_COMPLEX)
1001*3f27d899SToby Isaac             for (l = 0; l < Nk; l++) workS[l] = work[l];
1002*3f27d899SToby Isaac             vals = &workS[0];
1003*3f27d899SToby Isaac #else
1004*3f27d899SToby Isaac             vals = &work[0];
1005*3f27d899SToby Isaac #endif
1006*3f27d899SToby Isaac           }
1007*3f27d899SToby Isaac           for (l = 0; l < Nk; l++) {
1008*3f27d899SToby Isaac             ierr = MatSetValue(prod, i, col * Nk + l, vals[l], INSERT_VALUES);CHKERRQ(ierr);
1009*3f27d899SToby Isaac           } /* Nk */
1010*3f27d899SToby Isaac         } /* jT */
1011*3f27d899SToby Isaac       } /* jF */
1012*3f27d899SToby Isaac       ierr = MatRestoreRow(trace, iT, &ncolsT, &colsT, &valsT);CHKERRQ(ierr);
1013*3f27d899SToby Isaac     } /* iT */
1014*3f27d899SToby Isaac     ierr = MatRestoreRow(fiber, iF, &ncolsF, &colsF, &valsF);CHKERRQ(ierr);
1015*3f27d899SToby Isaac   } /* iF */
1016*3f27d899SToby Isaac   ierr = PetscFree(wedgeMat);CHKERRQ(ierr);
1017*3f27d899SToby Isaac   ierr = PetscFree4(projT, projF, projTstar, projFstar);CHKERRQ(ierr);
1018*3f27d899SToby Isaac   ierr = PetscFree2(workT2, workF2);CHKERRQ(ierr);
1019*3f27d899SToby Isaac   ierr = PetscFree5(workT, workF, work, workstar, workS);CHKERRQ(ierr);
1020*3f27d899SToby Isaac   ierr = MatAssemblyBegin(prod, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1021*3f27d899SToby Isaac   ierr = MatAssemblyEnd(prod, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1022*3f27d899SToby Isaac   *product = prod;
1023*3f27d899SToby Isaac   PetscFunctionReturn(0);
1024*3f27d899SToby Isaac }
1025*3f27d899SToby Isaac 
1026*3f27d899SToby Isaac static PetscErrorCode PetscQuadraturePointsMerge(PetscQuadrature quadA, PetscQuadrature quadB, PetscQuadrature *quadJoint, PetscInt *aToJoint[], PetscInt *bToJoint[])
1027*3f27d899SToby Isaac {
1028*3f27d899SToby Isaac   PetscInt         dimA, dimB;
1029*3f27d899SToby Isaac   PetscInt         nA, nB, nJoint, i, j, d;
1030*3f27d899SToby Isaac   const PetscReal *pointsA;
1031*3f27d899SToby Isaac   const PetscReal *pointsB;
1032*3f27d899SToby Isaac   PetscReal       *pointsJoint;
1033*3f27d899SToby Isaac   PetscInt        *aToJ, *bToJ;
1034*3f27d899SToby Isaac   PetscQuadrature  qJ;
1035*3f27d899SToby Isaac   PetscErrorCode   ierr;
1036*3f27d899SToby Isaac 
1037*3f27d899SToby Isaac   PetscFunctionBegin;
1038*3f27d899SToby Isaac   ierr = PetscQuadratureGetData(quadA, &dimA, NULL, &nA, &pointsA, NULL);CHKERRQ(ierr);
1039*3f27d899SToby Isaac   ierr = PetscQuadratureGetData(quadB, &dimB, NULL, &nB, &pointsB, NULL);CHKERRQ(ierr);
1040*3f27d899SToby Isaac   if (dimA != dimB) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Quadrature points must be in the same dimension");
1041*3f27d899SToby Isaac   nJoint = nA;
1042*3f27d899SToby Isaac   ierr = PetscMalloc1(nA, &aToJ);CHKERRQ(ierr);
1043*3f27d899SToby Isaac   for (i = 0; i < nA; i++) aToJ[i] = i;
1044*3f27d899SToby Isaac   ierr = PetscMalloc1(nB, &bToJ);CHKERRQ(ierr);
1045*3f27d899SToby Isaac   for (i = 0; i < nB; i++) {
1046*3f27d899SToby Isaac     for (j = 0; j < nA; j++) {
1047*3f27d899SToby Isaac       bToJ[i] = -1;
1048*3f27d899SToby Isaac       for (d = 0; d < dimA; d++) if (pointsB[i * dimA + d] != pointsA[j * dimA + d]) break;
1049*3f27d899SToby Isaac       if (d == dimA) {
1050*3f27d899SToby Isaac         bToJ[i] = j;
1051*3f27d899SToby Isaac         break;
1052*3f27d899SToby Isaac       }
1053*3f27d899SToby Isaac     }
1054*3f27d899SToby Isaac     if (bToJ[i] == -1) {
1055*3f27d899SToby Isaac       bToJ[i] = nJoint++;
1056*3f27d899SToby Isaac     }
1057*3f27d899SToby Isaac   }
1058*3f27d899SToby Isaac   *aToJoint = aToJ;
1059*3f27d899SToby Isaac   *bToJoint = bToJ;
1060*3f27d899SToby Isaac   ierr = PetscMalloc1(nJoint * dimA, &pointsJoint);CHKERRQ(ierr);
1061*3f27d899SToby Isaac   ierr = PetscArraycpy(pointsJoint, pointsA, nA * dimA);CHKERRQ(ierr);
1062*3f27d899SToby Isaac   for (i = 0; i < nB; i++) {
1063*3f27d899SToby Isaac     if (bToJ[i] >= nA) {
1064*3f27d899SToby Isaac       for (d = 0; d < dimA; d++) pointsJoint[bToJ[i] * dimA + d] = pointsB[i * dimA + d];
1065*3f27d899SToby Isaac     }
1066*3f27d899SToby Isaac   }
1067*3f27d899SToby Isaac   ierr = PetscQuadratureCreate(PETSC_COMM_SELF, &qJ);CHKERRQ(ierr);
1068*3f27d899SToby Isaac   ierr = PetscQuadratureSetData(qJ, dimA, 0, nJoint, pointsJoint, NULL);CHKERRQ(ierr);
1069*3f27d899SToby Isaac   *quadJoint = qJ;
1070*3f27d899SToby Isaac   PetscFunctionReturn(0);
1071*3f27d899SToby Isaac }
1072*3f27d899SToby Isaac 
1073*3f27d899SToby Isaac static PetscErrorCode MatricesMerge(Mat matA, Mat matB, PetscInt dim, PetscInt k, PetscInt numMerged, const PetscInt aToMerged[], const PetscInt bToMerged[], Mat *matMerged)
1074*3f27d899SToby Isaac {
1075*3f27d899SToby Isaac   PetscInt m, n, mA, nA, mB, nB, Nk, i, j, l;
1076*3f27d899SToby Isaac   Mat      M;
1077*3f27d899SToby Isaac   PetscInt *nnz;
1078*3f27d899SToby Isaac   PetscInt maxnnz;
1079*3f27d899SToby Isaac   PetscInt *work;
1080*3f27d899SToby Isaac   PetscErrorCode ierr;
1081*3f27d899SToby Isaac 
1082*3f27d899SToby Isaac   PetscFunctionBegin;
1083*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk);CHKERRQ(ierr);
1084*3f27d899SToby Isaac   ierr = MatGetSize(matA, &mA, &nA);CHKERRQ(ierr);
1085*3f27d899SToby Isaac   if (nA % Nk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "matA column space not a multiple of k-form size");
1086*3f27d899SToby Isaac   ierr = MatGetSize(matB, &mB, &nB);CHKERRQ(ierr);
1087*3f27d899SToby Isaac   if (nB % Nk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "matB column space not a multiple of k-form size");
1088*3f27d899SToby Isaac   m = mA + mB;
1089*3f27d899SToby Isaac   n = numMerged * Nk;
1090*3f27d899SToby Isaac   ierr = PetscMalloc1(m, &nnz);CHKERRQ(ierr);
1091*3f27d899SToby Isaac   maxnnz = 0;
1092*3f27d899SToby Isaac   for (i = 0; i < mA; i++) {
1093*3f27d899SToby Isaac     ierr = MatGetRow(matA, i, &(nnz[i]), NULL, NULL);CHKERRQ(ierr);
1094*3f27d899SToby Isaac     if (nnz[i] % Nk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in matA are not in k-form size blocks");
1095*3f27d899SToby Isaac     maxnnz = PetscMax(maxnnz, nnz[i]);
1096*3f27d899SToby Isaac   }
1097*3f27d899SToby Isaac   for (i = 0; i < mB; i++) {
1098*3f27d899SToby Isaac     ierr = MatGetRow(matB, i, &(nnz[i+mA]), NULL, NULL);CHKERRQ(ierr);
1099*3f27d899SToby Isaac     if (nnz[i+mA] % Nk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in matB are not in k-form size blocks");
1100*3f27d899SToby Isaac     maxnnz = PetscMax(maxnnz, nnz[i+mA]);
1101*3f27d899SToby Isaac   }
1102*3f27d899SToby Isaac   ierr = MatCreateSeqAIJ(PETSC_COMM_SELF, m, n, 0, nnz, &M);CHKERRQ(ierr);
1103*3f27d899SToby Isaac   ierr = PetscFree(nnz);CHKERRQ(ierr);
1104*3f27d899SToby Isaac   /* reasoning about which points each dof needs depends on having zeros computed at points preserved */
1105*3f27d899SToby Isaac   ierr = MatSetOption(M, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);
1106*3f27d899SToby Isaac   ierr = PetscMalloc1(maxnnz, &work);CHKERRQ(ierr);
1107*3f27d899SToby Isaac   for (i = 0; i < mA; i++) {
1108*3f27d899SToby Isaac     const PetscInt *cols;
1109*3f27d899SToby Isaac     const PetscScalar *vals;
1110*3f27d899SToby Isaac     PetscInt nCols;
1111*3f27d899SToby Isaac     ierr = MatGetRow(matA, i, &nCols, &cols, &vals);CHKERRQ(ierr);
1112*3f27d899SToby Isaac     for (j = 0; j < nCols / Nk; j++) {
1113*3f27d899SToby Isaac       PetscInt newCol = aToMerged[cols[j * Nk] / Nk];
1114*3f27d899SToby Isaac       for (l = 0; l < Nk; l++) work[j * Nk + l] = newCol * Nk + l;
1115*3f27d899SToby Isaac     }
1116*3f27d899SToby Isaac     ierr = MatSetValuesBlocked(M, 1, &i, nCols, work, vals, INSERT_VALUES);CHKERRQ(ierr);
1117*3f27d899SToby Isaac     ierr = MatRestoreRow(matA, i, &nCols, &cols, &vals);CHKERRQ(ierr);
1118*3f27d899SToby Isaac   }
1119*3f27d899SToby Isaac   for (i = 0; i < mB; i++) {
1120*3f27d899SToby Isaac     const PetscInt *cols;
1121*3f27d899SToby Isaac     const PetscScalar *vals;
1122*3f27d899SToby Isaac 
1123*3f27d899SToby Isaac     PetscInt row = i + mA;
1124*3f27d899SToby Isaac     PetscInt nCols;
1125*3f27d899SToby Isaac     ierr = MatGetRow(matB, i, &nCols, &cols, &vals);CHKERRQ(ierr);
1126*3f27d899SToby Isaac     for (j = 0; j < nCols / Nk; j++) {
1127*3f27d899SToby Isaac       PetscInt newCol = bToMerged[cols[j * Nk] / Nk];
1128*3f27d899SToby Isaac       for (l = 0; l < Nk; l++) work[j * Nk + l] = newCol * Nk + l;
1129*3f27d899SToby Isaac     }
1130*3f27d899SToby Isaac     ierr = MatSetValuesBlocked(M, 1, &row, nCols, work, vals, INSERT_VALUES);CHKERRQ(ierr);
1131*3f27d899SToby Isaac     ierr = MatRestoreRow(matB, i, &nCols, &cols, &vals);CHKERRQ(ierr);
1132*3f27d899SToby Isaac   }
1133*3f27d899SToby Isaac   ierr = PetscFree(work);CHKERRQ(ierr);
1134*3f27d899SToby Isaac   ierr = MatAssemblyBegin(M, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1135*3f27d899SToby Isaac   ierr = MatAssemblyEnd(M, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1136*3f27d899SToby Isaac   *matMerged = M;
1137*3f27d899SToby Isaac   PetscFunctionReturn(0);
1138*3f27d899SToby Isaac }
1139*3f27d899SToby Isaac 
1140*3f27d899SToby Isaac static PetscErrorCode PetscDualSpaceCreateFacetSubspace_Lagrange(PetscDualSpace sp, DM K, PetscInt f, PetscInt k, PetscInt Ncopies, PetscBool interiorOnly, PetscDualSpace *bdsp)
1141*3f27d899SToby Isaac {
1142*3f27d899SToby Isaac   PetscInt           Nknew, Ncnew;
1143*3f27d899SToby Isaac   PetscInt           dim, pointDim = -1;
1144*3f27d899SToby Isaac   PetscInt           depth;
1145*3f27d899SToby Isaac   DM                 dm;
1146*3f27d899SToby Isaac   PetscDualSpace_Lag *newlag;
1147*3f27d899SToby Isaac   PetscErrorCode     ierr;
1148*3f27d899SToby Isaac 
1149*3f27d899SToby Isaac   PetscFunctionBegin;
1150*3f27d899SToby Isaac   ierr = PetscDualSpaceGetDM(sp,&dm);CHKERRQ(ierr);
1151*3f27d899SToby Isaac   ierr = DMGetDimension(dm,&dim);CHKERRQ(ierr);
1152*3f27d899SToby Isaac   ierr = DMPlexGetDepth(dm,&depth);CHKERRQ(ierr);
1153*3f27d899SToby Isaac   ierr = PetscDualSpaceDuplicate(sp,bdsp);CHKERRQ(ierr);
1154*3f27d899SToby Isaac   ierr = PetscDualSpaceSetFormDegree(*bdsp,k);CHKERRQ(ierr);
1155*3f27d899SToby Isaac   if (!K) {
1156*3f27d899SToby Isaac     PetscBool isSimplex;
1157*3f27d899SToby Isaac 
1158*3f27d899SToby Isaac 
1159*3f27d899SToby Isaac     if (depth == dim) {
1160*3f27d899SToby Isaac       pointDim = dim - 1;
1161*3f27d899SToby Isaac       PetscInt coneSize;
1162*3f27d899SToby Isaac 
1163*3f27d899SToby Isaac       ierr = DMPlexGetConeSize(dm,f,&coneSize);CHKERRQ(ierr);
1164*3f27d899SToby Isaac       isSimplex = (PetscBool) (coneSize == dim);
1165*3f27d899SToby Isaac       ierr = PetscDualSpaceCreateReferenceCell(*bdsp, dim-1, isSimplex, &K);CHKERRQ(ierr);
1166*3f27d899SToby Isaac     } else if (depth == 1) {
1167*3f27d899SToby Isaac       pointDim = 0;
1168*3f27d899SToby Isaac       ierr = PetscDualSpaceCreateReferenceCell(*bdsp, 0, PETSC_TRUE, &K);CHKERRQ(ierr);
1169*3f27d899SToby Isaac     } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unsupported interpolation state of reference element");
1170*3f27d899SToby Isaac   } else {
1171*3f27d899SToby Isaac     ierr = PetscObjectReference((PetscObject)K);CHKERRQ(ierr);
1172*3f27d899SToby Isaac     ierr = DMGetDimension(K, &pointDim);CHKERRQ(ierr);
1173*3f27d899SToby Isaac   }
1174*3f27d899SToby Isaac   ierr = PetscDualSpaceSetDM(*bdsp, K);CHKERRQ(ierr);
1175*3f27d899SToby Isaac   ierr = DMDestroy(&K);CHKERRQ(ierr);
1176*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(pointDim, PetscAbsInt(k), &Nknew);CHKERRQ(ierr);
1177*3f27d899SToby Isaac   Ncnew = Nknew * Ncopies;
1178*3f27d899SToby Isaac   ierr = PetscDualSpaceSetNumComponents(*bdsp, Ncnew);CHKERRQ(ierr);
1179*3f27d899SToby Isaac   newlag = (PetscDualSpace_Lag *) (*bdsp)->data;
1180*3f27d899SToby Isaac   newlag->interiorOnly = interiorOnly;
1181*3f27d899SToby Isaac   ierr = PetscDualSpaceSetUp(*bdsp);CHKERRQ(ierr);
1182*3f27d899SToby Isaac   PetscFunctionReturn(0);
1183*3f27d899SToby Isaac }
1184*3f27d899SToby Isaac 
1185*3f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeCreateSimplexNodeMat(Petsc1DNodeFamily nodeFamily, PetscInt dim, PetscInt sum, PetscInt Nk, PetscInt numNodeSkip, PetscQuadrature *iNodes, Mat *iMat, PetscLagNodeIndices *nodeIndices)
1186*3f27d899SToby Isaac {
1187*3f27d899SToby Isaac   PetscReal *extraNodeCoords, *nodeCoords;
1188*3f27d899SToby Isaac   PetscInt nNodes, nExtraNodes;
1189*3f27d899SToby Isaac   PetscInt i, j, k, extraSum = sum + numNodeSkip * (1 + dim);
1190*3f27d899SToby Isaac   PetscQuadrature intNodes;
1191*3f27d899SToby Isaac   Mat intMat;
1192*3f27d899SToby Isaac   PetscLagNodeIndices ni;
1193*3f27d899SToby Isaac   PetscErrorCode ierr;
1194*3f27d899SToby Isaac 
1195*3f27d899SToby Isaac   PetscFunctionBegin;
1196*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim + sum, dim, &nNodes);CHKERRQ(ierr);
1197*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim + extraSum, dim, &nExtraNodes);CHKERRQ(ierr);
1198*3f27d899SToby Isaac 
1199*3f27d899SToby Isaac   ierr = PetscMalloc1(dim * nExtraNodes, &extraNodeCoords);CHKERRQ(ierr);
1200*3f27d899SToby Isaac   ierr = PetscNew(&ni);CHKERRQ(ierr);
1201*3f27d899SToby Isaac   ni->nodeIdxDim = dim + 1;
1202*3f27d899SToby Isaac   ni->nodeVecDim = Nk;
1203*3f27d899SToby Isaac   ni->nNodes = nNodes * Nk;
1204*3f27d899SToby Isaac   ni->refct = 1;
1205*3f27d899SToby Isaac   ierr = PetscMalloc1(nNodes * Nk * (dim + 1), &(ni->nodeIdx));CHKERRQ(ierr);
1206*3f27d899SToby Isaac   ierr = PetscMalloc1(nNodes * Nk * Nk, &(ni->nodeVec));CHKERRQ(ierr);
1207*3f27d899SToby Isaac   for (i = 0; i < nNodes; i++) for (j = 0; j < Nk; j++) for (k = 0; k < Nk; k++) ni->nodeVec[(i * Nk + j) * Nk + k] = (j == k) ? 1. : 0.;
1208*3f27d899SToby Isaac   ierr = Petsc1DNodeFamilyComputeSimplexNodes(nodeFamily, dim, extraSum, extraNodeCoords);CHKERRQ(ierr);
1209*3f27d899SToby Isaac   if (numNodeSkip) {
1210*3f27d899SToby Isaac     PetscInt k;
1211*3f27d899SToby Isaac     PetscInt *tup;
1212*3f27d899SToby Isaac 
1213*3f27d899SToby Isaac     ierr = PetscMalloc1(dim * nNodes, &nodeCoords);CHKERRQ(ierr);
1214*3f27d899SToby Isaac     ierr = PetscMalloc1(dim + 1, &tup);CHKERRQ(ierr);
1215*3f27d899SToby Isaac     for (k = 0; k < nNodes; k++) {
1216*3f27d899SToby Isaac       PetscInt j, c;
1217*3f27d899SToby Isaac       PetscInt index;
1218*3f27d899SToby Isaac 
1219*3f27d899SToby Isaac       ierr = PetscDTIndexToBary(dim + 1, sum, k, tup);CHKERRQ(ierr);
1220*3f27d899SToby Isaac       for (j = 0; j < dim + 1; j++) tup[j] += numNodeSkip;
1221*3f27d899SToby Isaac       for (c = 0; c < Nk; c++) {
1222*3f27d899SToby Isaac         for (j = 0; j < dim + 1; j++) {
1223*3f27d899SToby Isaac           ni->nodeIdx[(k * Nk + c) * (dim + 1) + j] = tup[j] + 1;
1224*3f27d899SToby Isaac         }
1225*3f27d899SToby Isaac       }
1226*3f27d899SToby Isaac       ierr = PetscDTBaryToIndex(dim + 1, extraSum, tup, &index);CHKERRQ(ierr);
1227*3f27d899SToby Isaac       for (j = 0; j < dim; j++) nodeCoords[k * dim + j] = extraNodeCoords[index * dim + j];
1228*3f27d899SToby Isaac     }
1229*3f27d899SToby Isaac     ierr = PetscFree(tup);CHKERRQ(ierr);
1230*3f27d899SToby Isaac     ierr = PetscFree(extraNodeCoords);CHKERRQ(ierr);
1231*3f27d899SToby Isaac   } else {
1232*3f27d899SToby Isaac     PetscInt k;
1233*3f27d899SToby Isaac     PetscInt *tup;
1234*3f27d899SToby Isaac 
1235*3f27d899SToby Isaac     nodeCoords = extraNodeCoords;
1236*3f27d899SToby Isaac     ierr = PetscMalloc1(dim + 1, &tup);CHKERRQ(ierr);
1237*3f27d899SToby Isaac     for (k = 0; k < nNodes; k++) {
1238*3f27d899SToby Isaac       PetscInt j, c;
1239*3f27d899SToby Isaac 
1240*3f27d899SToby Isaac       ierr = PetscDTIndexToBary(dim + 1, sum, k, tup);CHKERRQ(ierr);
1241*3f27d899SToby Isaac       for (c = 0; c < Nk; c++) {
1242*3f27d899SToby Isaac         for (j = 0; j < dim + 1; j++) {
1243*3f27d899SToby Isaac           /* barycentric indices can have zeros, but we don't want to push forward zeros because it makes it harder to
1244*3f27d899SToby Isaac            * determine which nodes correspond to which under symmetries, so we increase by 1 */
1245*3f27d899SToby Isaac           ni->nodeIdx[(k * Nk + c) * (dim + 1) + j] = tup[j] + 1;
1246*3f27d899SToby Isaac         }
1247*3f27d899SToby Isaac       }
1248*3f27d899SToby Isaac     }
1249*3f27d899SToby Isaac     ierr = PetscFree(tup);CHKERRQ(ierr);
1250*3f27d899SToby Isaac   }
1251*3f27d899SToby Isaac   ierr = PetscQuadratureCreate(PETSC_COMM_SELF, &intNodes);CHKERRQ(ierr);
1252*3f27d899SToby Isaac   ierr = PetscQuadratureSetData(intNodes, dim, 0, nNodes, nodeCoords, NULL);CHKERRQ(ierr);
1253*3f27d899SToby Isaac   ierr = MatCreateSeqAIJ(PETSC_COMM_SELF, nNodes * Nk, nNodes * Nk, Nk, NULL, &intMat);CHKERRQ(ierr);
1254*3f27d899SToby Isaac   ierr = MatSetOption(intMat,MAT_IGNORE_ZERO_ENTRIES,PETSC_FALSE);CHKERRQ(ierr);
1255*3f27d899SToby Isaac   for (j = 0; j < nNodes * Nk; j++) {
1256*3f27d899SToby Isaac     PetscInt rem = j % Nk;
1257*3f27d899SToby Isaac     PetscInt a, aprev = j - rem;
1258*3f27d899SToby Isaac     PetscInt anext = aprev + Nk;
1259*3f27d899SToby Isaac 
1260*3f27d899SToby Isaac     for (a = aprev; a < anext; a++) {
1261*3f27d899SToby Isaac       ierr = MatSetValue(intMat, j, a, (a == j) ? 1. : 0., INSERT_VALUES);CHKERRQ(ierr);
1262*3f27d899SToby Isaac     }
1263*3f27d899SToby Isaac   }
1264*3f27d899SToby Isaac   ierr = MatAssemblyBegin(intMat, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1265*3f27d899SToby Isaac   ierr = MatAssemblyEnd(intMat, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1266*3f27d899SToby Isaac   *iNodes = intNodes;
1267*3f27d899SToby Isaac   *iMat = intMat;
1268*3f27d899SToby Isaac   *nodeIndices = ni;
1269*3f27d899SToby Isaac   PetscFunctionReturn(0);
1270*3f27d899SToby Isaac }
1271*3f27d899SToby Isaac 
1272*3f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeCreateAllNodeIdx(PetscDualSpace sp)
1273*3f27d899SToby Isaac {
1274*3f27d899SToby Isaac   DM             dm;
1275*3f27d899SToby Isaac   PetscInt       dim, nDofs;
1276*3f27d899SToby Isaac   PetscSection   section;
1277*3f27d899SToby Isaac   PetscInt       pStart, pEnd, p;
1278*3f27d899SToby Isaac   PetscInt       formDegree, Nk;
1279*3f27d899SToby Isaac   PetscInt       nodeIdxDim, spintdim;
1280*3f27d899SToby Isaac   PetscDualSpace_Lag *lag;
1281*3f27d899SToby Isaac   PetscLagNodeIndices ni, verti;
1282*3f27d899SToby Isaac   PetscErrorCode ierr;
1283*3f27d899SToby Isaac 
1284*3f27d899SToby Isaac   PetscFunctionBegin;
1285*3f27d899SToby Isaac   lag = (PetscDualSpace_Lag *) sp->data;
1286*3f27d899SToby Isaac   verti = lag->vertIndices;
1287*3f27d899SToby Isaac   ierr = PetscDualSpaceGetDM(sp, &dm);CHKERRQ(ierr);
1288*3f27d899SToby Isaac   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1289*3f27d899SToby Isaac   ierr = PetscDualSpaceGetFormDegree(sp, &formDegree);CHKERRQ(ierr);
1290*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk);CHKERRQ(ierr);
1291*3f27d899SToby Isaac   ierr = PetscDualSpaceGetSection(sp, &section);CHKERRQ(ierr);
1292*3f27d899SToby Isaac   ierr = PetscSectionGetStorageSize(section, &nDofs);CHKERRQ(ierr);
1293*3f27d899SToby Isaac   ierr = PetscNew(&ni);CHKERRQ(ierr);
1294*3f27d899SToby Isaac   ni->nodeIdxDim = nodeIdxDim = verti->nodeIdxDim;
1295*3f27d899SToby Isaac   ni->nodeVecDim = Nk;
1296*3f27d899SToby Isaac   ni->nNodes = nDofs;
1297*3f27d899SToby Isaac   ni->refct = 1;
1298*3f27d899SToby Isaac   ierr = PetscMalloc1(nodeIdxDim * nDofs, &(ni->nodeIdx));CHKERRQ(ierr);
1299*3f27d899SToby Isaac   ierr = PetscMalloc1(Nk * nDofs, &(ni->nodeVec));CHKERRQ(ierr);
1300*3f27d899SToby Isaac   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
1301*3f27d899SToby Isaac   ierr = PetscSectionGetDof(section, 0, &spintdim);CHKERRQ(ierr);
1302*3f27d899SToby Isaac   if (spintdim) {
1303*3f27d899SToby Isaac     ierr = PetscArraycpy(ni->nodeIdx, lag->intNodeIndices->nodeIdx, spintdim * nodeIdxDim);CHKERRQ(ierr);
1304*3f27d899SToby Isaac     ierr = PetscArraycpy(ni->nodeVec, lag->intNodeIndices->nodeVec, spintdim * Nk);CHKERRQ(ierr);
1305*3f27d899SToby Isaac   }
1306*3f27d899SToby Isaac   for (p = pStart + 1; p < pEnd; p++) {
1307*3f27d899SToby Isaac     PetscDualSpace psp = sp->pointSpaces[p];
1308*3f27d899SToby Isaac     PetscDualSpace_Lag *plag;
1309*3f27d899SToby Isaac     PetscInt dof, off;
1310*3f27d899SToby Isaac 
1311*3f27d899SToby Isaac     ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr);
1312*3f27d899SToby Isaac     if (!dof) continue;
1313*3f27d899SToby Isaac     plag = (PetscDualSpace_Lag *) psp->data;
1314*3f27d899SToby Isaac     ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr);
1315*3f27d899SToby Isaac     ierr = PetscLagNodeIndicesPushForward(dm, verti, p, plag->vertIndices, plag->intNodeIndices, 0, formDegree, &(ni->nodeIdx[off * nodeIdxDim]), &(ni->nodeVec[off * Nk]));CHKERRQ(ierr);
1316*3f27d899SToby Isaac   }
1317*3f27d899SToby Isaac   lag->allNodeIndices = ni;
1318*3f27d899SToby Isaac   PetscFunctionReturn(0);
1319*3f27d899SToby Isaac }
1320*3f27d899SToby Isaac 
1321*3f27d899SToby Isaac static PetscErrorCode PetscDualSpaceCreateAllDataFromInteriorData(PetscDualSpace sp)
1322*3f27d899SToby Isaac {
1323*3f27d899SToby Isaac   DM               dm;
1324*3f27d899SToby Isaac   PetscSection     section;
1325*3f27d899SToby Isaac   PetscInt         pStart, pEnd, p, k, Nk, dim, Nc;
1326*3f27d899SToby Isaac   PetscInt         nNodes;
1327*3f27d899SToby Isaac   PetscInt         countNodes;
1328*3f27d899SToby Isaac   Mat              allMat;
1329*3f27d899SToby Isaac   PetscQuadrature  allNodes;
1330*3f27d899SToby Isaac   PetscInt         nDofs;
1331*3f27d899SToby Isaac   PetscInt         maxNzforms, j;
1332*3f27d899SToby Isaac   PetscScalar      *work;
1333*3f27d899SToby Isaac   PetscReal        *L, *J, *Jinv, *v0, *pv0;
1334*3f27d899SToby Isaac   PetscInt         *iwork;
1335*3f27d899SToby Isaac   PetscReal        *nodes;
1336*3f27d899SToby Isaac   PetscErrorCode   ierr;
1337*3f27d899SToby Isaac 
1338*3f27d899SToby Isaac   PetscFunctionBegin;
1339*3f27d899SToby Isaac   ierr = PetscDualSpaceGetDM(sp, &dm);CHKERRQ(ierr);
1340*3f27d899SToby Isaac   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1341*3f27d899SToby Isaac   ierr = PetscDualSpaceGetSection(sp, &section);CHKERRQ(ierr);
1342*3f27d899SToby Isaac   ierr = PetscSectionGetStorageSize(section, &nDofs);CHKERRQ(ierr);
1343*3f27d899SToby Isaac   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
1344*3f27d899SToby Isaac   ierr = PetscDualSpaceGetFormDegree(sp, &k);CHKERRQ(ierr);
1345*3f27d899SToby Isaac   ierr = PetscDualSpaceGetNumComponents(sp, &Nc);CHKERRQ(ierr);
1346*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk);CHKERRQ(ierr);
1347*3f27d899SToby Isaac   for (p = pStart, nNodes = 0, maxNzforms = 0; p < pEnd; p++) {
1348*3f27d899SToby Isaac     PetscDualSpace  psp;
1349*3f27d899SToby Isaac     DM              pdm;
1350*3f27d899SToby Isaac     PetscInt        pdim, pNk;
1351*3f27d899SToby Isaac     PetscQuadrature intNodes;
1352*3f27d899SToby Isaac     Mat intMat;
1353*3f27d899SToby Isaac 
1354*3f27d899SToby Isaac     ierr = PetscDualSpaceGetPointSubspace(sp, p, &psp);CHKERRQ(ierr);
1355*3f27d899SToby Isaac     if (!psp) continue;
1356*3f27d899SToby Isaac     ierr = PetscDualSpaceGetDM(psp, &pdm);CHKERRQ(ierr);
1357*3f27d899SToby Isaac     ierr = DMGetDimension(pdm, &pdim);CHKERRQ(ierr);
1358*3f27d899SToby Isaac     if (pdim < PetscAbsInt(k)) continue;
1359*3f27d899SToby Isaac     ierr = PetscDTBinomialInt(pdim, PetscAbsInt(k), &pNk);CHKERRQ(ierr);
1360*3f27d899SToby Isaac     ierr = PetscDualSpaceGetInteriorData(psp, &intNodes, &intMat);CHKERRQ(ierr);
1361*3f27d899SToby Isaac     if (intNodes) {
1362*3f27d899SToby Isaac       PetscInt nNodesp;
1363*3f27d899SToby Isaac 
1364*3f27d899SToby Isaac       ierr = PetscQuadratureGetData(intNodes, NULL, NULL, &nNodesp, NULL, NULL);CHKERRQ(ierr);
1365*3f27d899SToby Isaac       nNodes += nNodesp;
1366*3f27d899SToby Isaac     }
1367*3f27d899SToby Isaac     if (intMat) {
1368*3f27d899SToby Isaac       PetscInt maxNzsp;
1369*3f27d899SToby Isaac       PetscInt maxNzformsp;
1370*3f27d899SToby Isaac 
1371*3f27d899SToby Isaac       ierr = MatSeqAIJGetMaxRowNonzeros(intMat, &maxNzsp);CHKERRQ(ierr);
1372*3f27d899SToby Isaac       if (maxNzsp % pNk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms");
1373*3f27d899SToby Isaac       maxNzformsp = maxNzsp / pNk;
1374*3f27d899SToby Isaac       maxNzforms = PetscMax(maxNzforms, maxNzformsp);
1375*3f27d899SToby Isaac     }
1376*3f27d899SToby Isaac   }
1377*3f27d899SToby Isaac   ierr = MatCreateSeqAIJ(PETSC_COMM_SELF, nDofs, nNodes * Nc, maxNzforms * Nk, NULL, &allMat);CHKERRQ(ierr);
1378*3f27d899SToby Isaac   ierr = MatSetOption(allMat,MAT_IGNORE_ZERO_ENTRIES,PETSC_FALSE);CHKERRQ(ierr);
1379*3f27d899SToby Isaac   ierr = PetscMalloc7(dim, &v0, dim, &pv0, dim * dim, &J, dim * dim, &Jinv, Nk * Nk, &L, maxNzforms * Nk, &work, maxNzforms * Nk, &iwork);CHKERRQ(ierr);
1380*3f27d899SToby Isaac   for (j = 0; j < dim; j++) pv0[j] = -1.;
1381*3f27d899SToby Isaac   ierr = PetscMalloc1(dim * nNodes, &nodes);CHKERRQ(ierr);
1382*3f27d899SToby Isaac   for (p = pStart, countNodes = 0; p < pEnd; p++) {
1383*3f27d899SToby Isaac     PetscDualSpace  psp;
1384*3f27d899SToby Isaac     PetscQuadrature intNodes;
1385*3f27d899SToby Isaac     DM pdm;
1386*3f27d899SToby Isaac     PetscInt pdim, pNk;
1387*3f27d899SToby Isaac     PetscInt countNodesIn = countNodes;
1388*3f27d899SToby Isaac     PetscReal detJ;
1389*3f27d899SToby Isaac     Mat intMat;
1390*3f27d899SToby Isaac 
1391*3f27d899SToby Isaac     ierr = PetscDualSpaceGetPointSubspace(sp, p, &psp);CHKERRQ(ierr);
1392*3f27d899SToby Isaac     if (!psp) continue;
1393*3f27d899SToby Isaac     ierr = PetscDualSpaceGetDM(psp, &pdm);CHKERRQ(ierr);
1394*3f27d899SToby Isaac     ierr = DMGetDimension(pdm, &pdim);CHKERRQ(ierr);
1395*3f27d899SToby Isaac     if (pdim < PetscAbsInt(k)) continue;
1396*3f27d899SToby Isaac     ierr = PetscDualSpaceGetInteriorData(psp, &intNodes, &intMat);CHKERRQ(ierr);
1397*3f27d899SToby Isaac     if (intNodes == NULL && intMat == NULL) continue;
1398*3f27d899SToby Isaac     ierr = PetscDTBinomialInt(pdim, PetscAbsInt(k), &pNk);CHKERRQ(ierr);
1399*3f27d899SToby Isaac     if (p) {
1400*3f27d899SToby Isaac       ierr = DMPlexComputeCellGeometryAffineFEM(dm, p, v0, J, Jinv, &detJ);CHKERRQ(ierr);
1401*3f27d899SToby Isaac     } else { /* identity */
1402*3f27d899SToby Isaac       PetscInt i,j;
1403*3f27d899SToby Isaac 
1404*3f27d899SToby Isaac       for (i = 0; i < dim; i++) for (j = 0; j < dim; j++) J[i * dim + j] = Jinv[i * dim + j] = 0.;
1405*3f27d899SToby Isaac       for (i = 0; i < dim; i++) J[i * dim + i] = Jinv[i * dim + i] = 1.;
1406*3f27d899SToby Isaac       for (i = 0; i < dim; i++) v0[i] = -1.;
1407*3f27d899SToby Isaac     }
1408*3f27d899SToby Isaac     if (pdim != dim) { /* compactify Jacobian */
1409*3f27d899SToby Isaac       PetscInt i, j;
1410*3f27d899SToby Isaac 
1411*3f27d899SToby Isaac       for (i = 0; i < dim; i++) for (j = 0; j < pdim; j++) J[i * pdim + j] = J[i * dim + j];
1412*3f27d899SToby Isaac     }
1413*3f27d899SToby Isaac     ierr = PetscDTAltVPullbackMatrix(pdim, dim, J, k, L);CHKERRQ(ierr);
1414*3f27d899SToby Isaac     if (intNodes) { /* "push forward" dof by pulling back a k-form to be evaluated on the point: multiply on the right by L^T */
1415*3f27d899SToby Isaac       PetscInt nNodesp;
1416*3f27d899SToby Isaac       const PetscReal *nodesp;
1417*3f27d899SToby Isaac       PetscInt j;
1418*3f27d899SToby Isaac 
1419*3f27d899SToby Isaac       ierr = PetscQuadratureGetData(intNodes, NULL, NULL, &nNodesp, &nodesp, NULL);CHKERRQ(ierr);
1420*3f27d899SToby Isaac       for (j = 0; j < nNodesp; j++, countNodes++) {
1421*3f27d899SToby Isaac         PetscInt d, e;
1422*3f27d899SToby Isaac 
1423*3f27d899SToby Isaac         for (d = 0; d < dim; d++) {
1424*3f27d899SToby Isaac           nodes[countNodes * dim + d] = v0[d];
1425*3f27d899SToby Isaac           for (e = 0; e < pdim; e++) {
1426*3f27d899SToby Isaac             nodes[countNodes * dim + d] += J[d * pdim + e] * (nodesp[j * pdim + e] - pv0[e]);
1427*3f27d899SToby Isaac           }
1428*3f27d899SToby Isaac         }
1429*3f27d899SToby Isaac       }
1430*3f27d899SToby Isaac     }
1431*3f27d899SToby Isaac     if (intMat) {
1432*3f27d899SToby Isaac       PetscInt nrows;
1433*3f27d899SToby Isaac       PetscInt off;
1434*3f27d899SToby Isaac 
1435*3f27d899SToby Isaac       ierr = PetscSectionGetDof(section, p, &nrows);CHKERRQ(ierr);
1436*3f27d899SToby Isaac       ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr);
1437*3f27d899SToby Isaac       for (j = 0; j < nrows; j++) {
1438*3f27d899SToby Isaac         PetscInt ncols;
1439*3f27d899SToby Isaac         const PetscInt *cols;
1440*3f27d899SToby Isaac         const PetscScalar *vals;
1441*3f27d899SToby Isaac         PetscInt l, d, e;
1442*3f27d899SToby Isaac         PetscInt row = j + off;
1443*3f27d899SToby Isaac 
1444*3f27d899SToby Isaac         ierr = MatGetRow(intMat, j, &ncols, &cols, &vals);CHKERRQ(ierr);
1445*3f27d899SToby Isaac         if (ncols % pNk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms");
1446*3f27d899SToby Isaac         for (l = 0; l < ncols / pNk; l++) {
1447*3f27d899SToby Isaac           PetscInt blockcol;
1448*3f27d899SToby Isaac 
1449*3f27d899SToby Isaac           for (d = 0; d < pNk; d++) {
1450*3f27d899SToby Isaac             if ((cols[l * pNk + d] % pNk) != d) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms");
1451*3f27d899SToby Isaac           }
1452*3f27d899SToby Isaac           blockcol = cols[l * pNk] / pNk;
1453*3f27d899SToby Isaac           for (d = 0; d < Nk; d++) {
1454*3f27d899SToby Isaac             iwork[l * Nk + d] = (blockcol + countNodesIn) * Nk + d;
1455*3f27d899SToby Isaac           }
1456*3f27d899SToby Isaac           for (d = 0; d < Nk; d++) work[l * Nk + d] = 0.;
1457*3f27d899SToby Isaac           for (d = 0; d < Nk; d++) {
1458*3f27d899SToby Isaac             for (e = 0; e < pNk; e++) {
1459*3f27d899SToby Isaac               /* "push forward" dof by pulling back a k-form to be evaluated on the point: multiply on the right by L */
1460*3f27d899SToby Isaac               work[l * Nk + d] += vals[l * pNk + e] * L[e * pNk + d];
1461*3f27d899SToby Isaac             }
1462*3f27d899SToby Isaac           }
1463*3f27d899SToby Isaac         }
1464*3f27d899SToby Isaac         ierr = MatSetValues(allMat, 1, &row, (ncols / pNk) * Nk, iwork, work, INSERT_VALUES);CHKERRQ(ierr);
1465*3f27d899SToby Isaac         ierr = MatRestoreRow(intMat, j, &ncols, &cols, &vals);CHKERRQ(ierr);
1466*3f27d899SToby Isaac       }
1467*3f27d899SToby Isaac     }
1468*3f27d899SToby Isaac   }
1469*3f27d899SToby Isaac   ierr = MatAssemblyBegin(allMat, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1470*3f27d899SToby Isaac   ierr = MatAssemblyEnd(allMat, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1471*3f27d899SToby Isaac   ierr = PetscQuadratureCreate(PETSC_COMM_SELF, &allNodes);CHKERRQ(ierr);
1472*3f27d899SToby Isaac   ierr = PetscQuadratureSetData(allNodes, dim, 0, nNodes, nodes, NULL);CHKERRQ(ierr);
1473*3f27d899SToby Isaac   ierr = PetscFree7(v0, pv0, J, Jinv, L, work, iwork);CHKERRQ(ierr);
1474*3f27d899SToby Isaac   ierr = MatDestroy(&(sp->allMat));CHKERRQ(ierr);
1475*3f27d899SToby Isaac   sp->allMat = allMat;
1476*3f27d899SToby Isaac   ierr = PetscQuadratureDestroy(&(sp->allNodes));CHKERRQ(ierr);
1477*3f27d899SToby Isaac   sp->allNodes = allNodes;
1478*3f27d899SToby Isaac   PetscFunctionReturn(0);
1479*3f27d899SToby Isaac }
1480*3f27d899SToby Isaac 
1481*3f27d899SToby Isaac static PetscErrorCode PetscDualSpaceComputeFunctionalsFromAllData(PetscDualSpace sp)
1482*3f27d899SToby Isaac {
1483*3f27d899SToby Isaac   PetscQuadrature allNodes;
1484*3f27d899SToby Isaac   Mat             allMat;
1485*3f27d899SToby Isaac   PetscInt        nDofs;
1486*3f27d899SToby Isaac   PetscInt        dim, k, Nk, Nc, f;
1487*3f27d899SToby Isaac   DM              dm;
1488*3f27d899SToby Isaac   PetscInt        nNodes, spdim;
1489*3f27d899SToby Isaac   const PetscReal *nodes = NULL;
1490*3f27d899SToby Isaac   PetscSection    section;
1491*3f27d899SToby Isaac   PetscErrorCode  ierr;
1492*3f27d899SToby Isaac 
1493*3f27d899SToby Isaac   PetscFunctionBegin;
1494*3f27d899SToby Isaac   ierr = PetscDualSpaceGetDM(sp, &dm);CHKERRQ(ierr);
1495*3f27d899SToby Isaac   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1496*3f27d899SToby Isaac   ierr = PetscDualSpaceGetNumComponents(sp, &Nc);CHKERRQ(ierr);
1497*3f27d899SToby Isaac   ierr = PetscDualSpaceGetFormDegree(sp, &k);CHKERRQ(ierr);
1498*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk);CHKERRQ(ierr);
1499*3f27d899SToby Isaac   ierr = PetscDualSpaceGetAllData(sp, &allNodes, &allMat);CHKERRQ(ierr);
1500*3f27d899SToby Isaac   nNodes = 0;
1501*3f27d899SToby Isaac   if (allNodes) {
1502*3f27d899SToby Isaac     ierr = PetscQuadratureGetData(allNodes, NULL, NULL, &nNodes, &nodes, NULL);CHKERRQ(ierr);
1503*3f27d899SToby Isaac   }
1504*3f27d899SToby Isaac   ierr = MatGetSize(allMat, &nDofs, NULL);CHKERRQ(ierr);
1505*3f27d899SToby Isaac   ierr = PetscDualSpaceGetSection(sp, &section);CHKERRQ(ierr);
1506*3f27d899SToby Isaac   ierr = PetscSectionGetStorageSize(section, &spdim);CHKERRQ(ierr);
1507*3f27d899SToby Isaac   if (spdim != nDofs) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "incompatible all matrix size");
1508*3f27d899SToby Isaac   ierr = PetscMalloc1(nDofs, &(sp->functional));CHKERRQ(ierr);
1509*3f27d899SToby Isaac   for (f = 0; f < nDofs; f++) {
1510*3f27d899SToby Isaac     PetscInt ncols, c;
1511*3f27d899SToby Isaac     const PetscInt *cols;
1512*3f27d899SToby Isaac     const PetscScalar *vals;
1513*3f27d899SToby Isaac     PetscReal *nodesf;
1514*3f27d899SToby Isaac     PetscReal *weightsf;
1515*3f27d899SToby Isaac     PetscInt nNodesf;
1516*3f27d899SToby Isaac     PetscInt countNodes;
1517*3f27d899SToby Isaac 
1518*3f27d899SToby Isaac     ierr = MatGetRow(allMat, f, &ncols, &cols, &vals);CHKERRQ(ierr);
1519*3f27d899SToby Isaac     if (ncols % Nk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "all matrix is not laid out as blocks of k-forms");
1520*3f27d899SToby Isaac     for (c = 1, nNodesf = 1; c < ncols; c++) {
1521*3f27d899SToby Isaac       if ((cols[c] / Nc) != (cols[c-1] / Nc)) nNodesf++;
1522*3f27d899SToby Isaac     }
1523*3f27d899SToby Isaac     ierr = PetscMalloc1(dim * nNodesf, &nodesf);CHKERRQ(ierr);
1524*3f27d899SToby Isaac     ierr = PetscMalloc1(Nc * nNodesf, &weightsf);CHKERRQ(ierr);
1525*3f27d899SToby Isaac     for (c = 0, countNodes = 0; c < ncols; c++) {
1526*3f27d899SToby Isaac       if (!c || ((cols[c] / Nc) != (cols[c-1] / Nc))) {
1527*3f27d899SToby Isaac         PetscInt d;
1528*3f27d899SToby Isaac 
1529*3f27d899SToby Isaac         for (d = 0; d < Nc; d++) {
1530*3f27d899SToby Isaac           weightsf[countNodes * Nc + d] = 0.;
1531*3f27d899SToby Isaac         }
1532*3f27d899SToby Isaac         for (d = 0; d < dim; d++) {
1533*3f27d899SToby Isaac           nodesf[countNodes * dim + d] = nodes[(cols[c] / Nc) * dim + d];
1534*3f27d899SToby Isaac         }
1535*3f27d899SToby Isaac         countNodes++;
1536*3f27d899SToby Isaac       }
1537*3f27d899SToby Isaac       weightsf[(countNodes - 1) * Nc + (cols[c] % Nc)] = PetscRealPart(vals[c]);
1538*3f27d899SToby Isaac     }
1539*3f27d899SToby Isaac     ierr = PetscQuadratureCreate(PETSC_COMM_SELF, &(sp->functional[f]));CHKERRQ(ierr);
1540*3f27d899SToby Isaac     ierr = PetscQuadratureSetData(sp->functional[f], dim, Nc, nNodesf, nodesf, weightsf);CHKERRQ(ierr);
1541*3f27d899SToby Isaac     ierr = MatRestoreRow(allMat, f, &ncols, &cols, &vals);CHKERRQ(ierr);
1542*3f27d899SToby Isaac   }
1543*3f27d899SToby Isaac   PetscFunctionReturn(0);
1544*3f27d899SToby Isaac }
1545*3f27d899SToby Isaac 
1546*3f27d899SToby Isaac /* take a matrix meant for k-forms and expand it to one for Ncopies */
1547*3f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeMatrixCreateCopies(Mat A, PetscInt Nk, PetscInt Ncopies, Mat *Abs)
1548*3f27d899SToby Isaac {
1549*3f27d899SToby Isaac   PetscInt       m, n, i, j, k;
1550*3f27d899SToby Isaac   PetscInt       maxnnz, *nnz, *iwork;
1551*3f27d899SToby Isaac   Mat            Ac;
1552*3f27d899SToby Isaac   PetscErrorCode ierr;
1553*3f27d899SToby Isaac 
1554*3f27d899SToby Isaac   PetscFunctionBegin;
1555*3f27d899SToby Isaac   ierr = MatGetSize(A, &m, &n);CHKERRQ(ierr);
1556*3f27d899SToby Isaac   if (n % Nk) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of columns in A %D is not a multiple of Nk %D", n, Nk);
1557*3f27d899SToby Isaac   ierr = PetscMalloc1(m * Ncopies, &nnz);CHKERRQ(ierr);
1558*3f27d899SToby Isaac   for (i = 0, maxnnz = 0; i < m; i++) {
1559*3f27d899SToby Isaac     PetscInt innz;
1560*3f27d899SToby Isaac     ierr = MatGetRow(A, i, &innz, NULL, NULL);CHKERRQ(ierr);
1561*3f27d899SToby Isaac     if (innz % Nk) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "A row %D nnzs is not a multiple of Nk %D", innz, Nk);
1562*3f27d899SToby Isaac     for (j = 0; j < Ncopies; j++) nnz[i * Ncopies + j] = innz;
1563*3f27d899SToby Isaac     maxnnz = PetscMax(maxnnz, innz);
1564*3f27d899SToby Isaac   }
1565*3f27d899SToby Isaac   ierr = MatCreateSeqAIJ(PETSC_COMM_SELF, m * Ncopies, n * Ncopies, 0, nnz, &Ac);CHKERRQ(ierr);
1566*3f27d899SToby Isaac   ierr = MatSetOption(Ac, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);
1567*3f27d899SToby Isaac   ierr = PetscFree(nnz);CHKERRQ(ierr);
1568*3f27d899SToby Isaac   ierr = PetscMalloc1(maxnnz, &iwork);CHKERRQ(ierr);
1569*3f27d899SToby Isaac   for (i = 0; i < m; i++) {
1570*3f27d899SToby Isaac     PetscInt innz;
1571*3f27d899SToby Isaac     const PetscInt    *cols;
1572*3f27d899SToby Isaac     const PetscScalar *vals;
1573*3f27d899SToby Isaac 
1574*3f27d899SToby Isaac     ierr = MatGetRow(A, i, &innz, &cols, &vals);CHKERRQ(ierr);
1575*3f27d899SToby Isaac     for (j = 0; j < innz; j++) iwork[j] = (cols[j] / Nk) * (Nk * Ncopies) + (cols[j] % Nk);
1576*3f27d899SToby Isaac     for (j = 0; j < Ncopies; j++) {
1577*3f27d899SToby Isaac       PetscInt row = i * Ncopies + j;
1578*3f27d899SToby Isaac 
1579*3f27d899SToby Isaac       ierr = MatSetValues(Ac, 1, &row, innz, iwork, vals, INSERT_VALUES);CHKERRQ(ierr);
1580*3f27d899SToby Isaac       for (k = 0; k < innz; k++) iwork[k] += Nk;
1581*3f27d899SToby Isaac     }
1582*3f27d899SToby Isaac     ierr = MatRestoreRow(A, i, &innz, &cols, &vals);CHKERRQ(ierr);
1583*3f27d899SToby Isaac   }
1584*3f27d899SToby Isaac   ierr = PetscFree(iwork);CHKERRQ(ierr);
1585*3f27d899SToby Isaac   ierr = MatAssemblyBegin(Ac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1586*3f27d899SToby Isaac   ierr = MatAssemblyEnd(Ac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1587*3f27d899SToby Isaac   *Abs = Ac;
1588*3f27d899SToby Isaac   PetscFunctionReturn(0);
1589*3f27d899SToby Isaac }
1590*3f27d899SToby Isaac 
1591*3f27d899SToby Isaac static PetscErrorCode DMPlexPointIsTensor_Internal_Given(DM dm, PetscInt p, PetscInt f, PetscInt f2, PetscBool *isTensor)
1592*3f27d899SToby Isaac {
1593*3f27d899SToby Isaac   PetscInt        coneSize, c;
1594*3f27d899SToby Isaac   const PetscInt *cone;
1595*3f27d899SToby Isaac   const PetscInt *fCone;
1596*3f27d899SToby Isaac   const PetscInt *f2Cone;
1597*3f27d899SToby Isaac   PetscInt        fs[2];
1598*3f27d899SToby Isaac   PetscInt        meetSize, nmeet;
1599*3f27d899SToby Isaac   const PetscInt *meet;
1600*3f27d899SToby Isaac   PetscErrorCode  ierr;
1601*3f27d899SToby Isaac 
1602*3f27d899SToby Isaac   PetscFunctionBegin;
1603*3f27d899SToby Isaac   fs[0] = f;
1604*3f27d899SToby Isaac   fs[1] = f2;
1605*3f27d899SToby Isaac   ierr = DMPlexGetMeet(dm, 2, fs, &meetSize, &meet);CHKERRQ(ierr);
1606*3f27d899SToby Isaac   nmeet = meetSize;
1607*3f27d899SToby Isaac   ierr = DMPlexRestoreMeet(dm, 2, fs, &meetSize, &meet);CHKERRQ(ierr);
1608*3f27d899SToby Isaac   if (nmeet) {
1609*3f27d899SToby Isaac     *isTensor = PETSC_FALSE;
1610*3f27d899SToby Isaac     PetscFunctionReturn(0);
1611*3f27d899SToby Isaac   }
1612*3f27d899SToby Isaac   ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
1613*3f27d899SToby Isaac   ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
1614*3f27d899SToby Isaac   ierr = DMPlexGetCone(dm, f, &fCone);CHKERRQ(ierr);
1615*3f27d899SToby Isaac   ierr = DMPlexGetCone(dm, f2, &f2Cone);CHKERRQ(ierr);
1616*3f27d899SToby Isaac   for (c = 0; c < coneSize; c++) {
1617*3f27d899SToby Isaac     PetscInt e, ef;
1618*3f27d899SToby Isaac     PetscInt d = -1, d2 = -1;
1619*3f27d899SToby Isaac     PetscInt dcount, d2count;
1620*3f27d899SToby Isaac     PetscInt t = cone[c];
1621*3f27d899SToby Isaac     PetscInt tConeSize;
1622*3f27d899SToby Isaac     PetscBool tIsTensor;
1623*3f27d899SToby Isaac     const PetscInt *tCone;
1624*3f27d899SToby Isaac 
1625*3f27d899SToby Isaac     if (t == f || t == f2) continue;
1626*3f27d899SToby Isaac     ierr = DMPlexGetConeSize(dm, t, &tConeSize);CHKERRQ(ierr);
1627*3f27d899SToby Isaac     ierr = DMPlexGetCone(dm, t, &tCone);CHKERRQ(ierr);
1628*3f27d899SToby Isaac 
1629*3f27d899SToby Isaac     dcount = 0;
1630*3f27d899SToby Isaac     d2count = 0;
1631*3f27d899SToby Isaac     for (e = 0; e < tConeSize; e++) {
1632*3f27d899SToby Isaac       PetscInt q = tCone[e];
1633*3f27d899SToby Isaac       for (ef = 0; ef < coneSize - 2; ef++) {
1634*3f27d899SToby Isaac         if (fCone[ef] == q) {
1635*3f27d899SToby Isaac           if (dcount) {
1636*3f27d899SToby Isaac             *isTensor = PETSC_FALSE;
1637*3f27d899SToby Isaac             PetscFunctionReturn(0);
1638*3f27d899SToby Isaac           }
1639*3f27d899SToby Isaac           d = q;
1640*3f27d899SToby Isaac           dcount++;
1641*3f27d899SToby Isaac         } else if (f2Cone[ef] == q) {
1642*3f27d899SToby Isaac           if (d2count) {
1643*3f27d899SToby Isaac             *isTensor = PETSC_FALSE;
1644*3f27d899SToby Isaac             PetscFunctionReturn(0);
1645*3f27d899SToby Isaac           }
1646*3f27d899SToby Isaac           d2 = q;
1647*3f27d899SToby Isaac           d2count++;
1648*3f27d899SToby Isaac         }
1649*3f27d899SToby Isaac       }
1650*3f27d899SToby Isaac     }
1651*3f27d899SToby Isaac     ierr = DMPlexPointIsTensor_Internal_Given(dm, t, d, d2, &tIsTensor);CHKERRQ(ierr);
1652*3f27d899SToby Isaac     if (!tIsTensor) {
1653*3f27d899SToby Isaac       *isTensor = PETSC_FALSE;
1654*3f27d899SToby Isaac       PetscFunctionReturn(0);
1655*3f27d899SToby Isaac     }
1656*3f27d899SToby Isaac   }
1657*3f27d899SToby Isaac   *isTensor = PETSC_TRUE;
1658*3f27d899SToby Isaac   PetscFunctionReturn(0);
1659*3f27d899SToby Isaac }
1660*3f27d899SToby Isaac 
1661*3f27d899SToby Isaac static PetscErrorCode DMPlexPointIsTensor_Internal(DM dm, PetscInt p, PetscBool *isTensor, PetscInt *endA, PetscInt *endB)
1662*3f27d899SToby Isaac {
1663*3f27d899SToby Isaac   PetscInt        coneSize, c, c2;
1664*3f27d899SToby Isaac   const PetscInt *cone;
1665*3f27d899SToby Isaac   PetscErrorCode  ierr;
1666*3f27d899SToby Isaac 
1667*3f27d899SToby Isaac   PetscFunctionBegin;
1668*3f27d899SToby Isaac   ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
1669*3f27d899SToby Isaac   if (!coneSize) {
1670*3f27d899SToby Isaac     if (isTensor) *isTensor = PETSC_FALSE;
1671*3f27d899SToby Isaac     if (endA) *endA = -1;
1672*3f27d899SToby Isaac     if (endB) *endB = -1;
1673*3f27d899SToby Isaac   }
1674*3f27d899SToby Isaac   ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
1675*3f27d899SToby Isaac   for (c = 0; c < coneSize; c++) {
1676*3f27d899SToby Isaac     PetscInt f = cone[c];
1677*3f27d899SToby Isaac     PetscInt fConeSize;
1678*3f27d899SToby Isaac 
1679*3f27d899SToby Isaac     ierr = DMPlexGetConeSize(dm, f, &fConeSize);CHKERRQ(ierr);
1680*3f27d899SToby Isaac     if (fConeSize != coneSize - 2) continue;
1681*3f27d899SToby Isaac 
1682*3f27d899SToby Isaac     for (c2 = c + 1; c2 < coneSize; c2++) {
1683*3f27d899SToby Isaac       PetscInt  f2 = cone[c2];
1684*3f27d899SToby Isaac       PetscBool isTensorff2;
1685*3f27d899SToby Isaac       PetscInt f2ConeSize;
1686*3f27d899SToby Isaac 
1687*3f27d899SToby Isaac       ierr = DMPlexGetConeSize(dm, f2, &f2ConeSize);CHKERRQ(ierr);
1688*3f27d899SToby Isaac       if (f2ConeSize != coneSize - 2) continue;
1689*3f27d899SToby Isaac 
1690*3f27d899SToby Isaac       ierr = DMPlexPointIsTensor_Internal_Given(dm, p, f, f2, &isTensorff2);CHKERRQ(ierr);
1691*3f27d899SToby Isaac       if (isTensorff2) {
1692*3f27d899SToby Isaac         if (isTensor) *isTensor = PETSC_TRUE;
1693*3f27d899SToby Isaac         if (endA) *endA = f;
1694*3f27d899SToby Isaac         if (endB) *endB = f2;
1695*3f27d899SToby Isaac         PetscFunctionReturn(0);
1696*3f27d899SToby Isaac       }
1697*3f27d899SToby Isaac     }
1698*3f27d899SToby Isaac   }
1699*3f27d899SToby Isaac   if (isTensor) *isTensor = PETSC_FALSE;
1700*3f27d899SToby Isaac   if (endA) *endA = -1;
1701*3f27d899SToby Isaac   if (endB) *endB = -1;
1702*3f27d899SToby Isaac   PetscFunctionReturn(0);
1703*3f27d899SToby Isaac }
1704*3f27d899SToby Isaac 
1705*3f27d899SToby Isaac static PetscErrorCode DMPlexPointIsTensor(DM dm, PetscInt p, PetscBool *isTensor, PetscInt *endA, PetscInt *endB)
1706*3f27d899SToby Isaac {
1707*3f27d899SToby Isaac   DMPlexInterpolatedFlag interpolated;
1708*3f27d899SToby Isaac   PetscErrorCode ierr;
1709*3f27d899SToby Isaac 
1710*3f27d899SToby Isaac   PetscFunctionBegin;
1711*3f27d899SToby Isaac   ierr = DMPlexIsInterpolated(dm, &interpolated);CHKERRQ(ierr);
1712*3f27d899SToby Isaac   if (interpolated != DMPLEX_INTERPOLATED_FULL) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Only for interpolated DMPlex's");
1713*3f27d899SToby Isaac   ierr = DMPlexPointIsTensor_Internal(dm, p, isTensor, endA, endB);CHKERRQ(ierr);
1714*3f27d899SToby Isaac   PetscFunctionReturn(0);
1715*3f27d899SToby Isaac }
1716*3f27d899SToby Isaac 
1717*3f27d899SToby Isaac static PetscErrorCode MatPermuteByNodeIdx(Mat A, PetscLagNodeIndices ni, Mat *Aperm)
1718*3f27d899SToby Isaac {
1719*3f27d899SToby Isaac   PetscInt       m, n, i, j;
1720*3f27d899SToby Isaac   PetscInt       nodeIdxDim = ni->nodeIdxDim;
1721*3f27d899SToby Isaac   PetscInt       nodeVecDim = ni->nodeVecDim;
1722*3f27d899SToby Isaac   PetscInt       *perm;
1723*3f27d899SToby Isaac   IS             permIS;
1724*3f27d899SToby Isaac   IS             id;
1725*3f27d899SToby Isaac   PetscInt       *nIdxPerm;
1726*3f27d899SToby Isaac   PetscReal      *nVecPerm;
1727*3f27d899SToby Isaac   PetscErrorCode ierr;
1728*3f27d899SToby Isaac 
1729*3f27d899SToby Isaac   PetscFunctionBegin;
1730*3f27d899SToby Isaac   ierr = PetscLagNodeIndicesGetPermutation(ni, &perm);CHKERRQ(ierr);
1731*3f27d899SToby Isaac   ierr = MatGetSize(A, &m, &n);CHKERRQ(ierr);
1732*3f27d899SToby Isaac   ierr = PetscMalloc1(nodeIdxDim * m, &nIdxPerm);CHKERRQ(ierr);
1733*3f27d899SToby Isaac   ierr = PetscMalloc1(nodeVecDim * m, &nVecPerm);CHKERRQ(ierr);
1734*3f27d899SToby Isaac   for (i = 0; i < m; i++) for (j = 0; j < nodeIdxDim; j++) nIdxPerm[i * nodeIdxDim + j] = ni->nodeIdx[perm[i] * nodeIdxDim + j];
1735*3f27d899SToby Isaac   for (i = 0; i < m; i++) for (j = 0; j < nodeVecDim; j++) nVecPerm[i * nodeVecDim + j] = ni->nodeVec[perm[i] * nodeVecDim + j];
1736*3f27d899SToby Isaac   ierr = ISCreateGeneral(PETSC_COMM_SELF, m, perm, PETSC_USE_POINTER, &permIS);CHKERRQ(ierr);
1737*3f27d899SToby Isaac   ierr = ISSetPermutation(permIS);CHKERRQ(ierr);
1738*3f27d899SToby Isaac   ierr = ISCreateStride(PETSC_COMM_SELF, n, 0, 1, &id);CHKERRQ(ierr);
1739*3f27d899SToby Isaac   ierr = ISSetPermutation(id);CHKERRQ(ierr);
1740*3f27d899SToby Isaac   ierr = MatPermute(A, permIS, id, Aperm);CHKERRQ(ierr);
1741*3f27d899SToby Isaac   ierr = ISDestroy(&permIS);CHKERRQ(ierr);
1742*3f27d899SToby Isaac   ierr = ISDestroy(&id);CHKERRQ(ierr);
1743*3f27d899SToby Isaac   for (i = 0; i < m; i++) perm[i] = i;
1744*3f27d899SToby Isaac   ierr = PetscFree(ni->nodeIdx);CHKERRQ(ierr);
1745*3f27d899SToby Isaac   ierr = PetscFree(ni->nodeVec);CHKERRQ(ierr);
1746*3f27d899SToby Isaac   ni->nodeIdx = nIdxPerm;
1747*3f27d899SToby Isaac   ni->nodeVec = nVecPerm;
17486f905325SMatthew G. Knepley   PetscFunctionReturn(0);
17496f905325SMatthew G. Knepley }
17506f905325SMatthew G. Knepley 
17516f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp)
17526f905325SMatthew G. Knepley {
17536f905325SMatthew G. Knepley   PetscDualSpace_Lag *lag   = (PetscDualSpace_Lag *) sp->data;
17546f905325SMatthew G. Knepley   DM                  dm    = sp->dm;
1755*3f27d899SToby Isaac   DM                  dmint = NULL;
1756*3f27d899SToby Isaac   PetscInt            order;
17576f905325SMatthew G. Knepley   PetscInt            Nc    = sp->Nc;
17586f905325SMatthew G. Knepley   MPI_Comm            comm;
17596f905325SMatthew G. Knepley   PetscBool           continuous;
1760*3f27d899SToby Isaac   PetscSection        section;
1761*3f27d899SToby Isaac   PetscInt            depth, dim, pStart, pEnd, cStart, cEnd, p, *pStratStart, *pStratEnd, d;
1762*3f27d899SToby Isaac   PetscInt            formDegree, Nk, Ncopies;
1763*3f27d899SToby Isaac   PetscInt            tensorf = -1, tensorf2 = -1;
1764*3f27d899SToby Isaac   PetscBool           tensorCell, tensorSpace;
1765*3f27d899SToby Isaac   PetscBool           uniform, trimmed;
1766*3f27d899SToby Isaac   Petsc1DNodeFamily   nodeFamily;
1767*3f27d899SToby Isaac   PetscInt            numNodeSkip;
1768*3f27d899SToby Isaac   DMPlexInterpolatedFlag interpolated;
1769*3f27d899SToby Isaac   PetscBool           isbdm;
17706f905325SMatthew G. Knepley   PetscErrorCode      ierr;
17716f905325SMatthew G. Knepley 
17726f905325SMatthew G. Knepley   PetscFunctionBegin;
1773*3f27d899SToby Isaac   /* step 1: sanitize input */
17746f905325SMatthew G. Knepley   ierr = PetscObjectGetComm((PetscObject) sp, &comm);CHKERRQ(ierr);
17756f905325SMatthew G. Knepley   ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1776*3f27d899SToby Isaac   ierr = PetscObjectTypeCompare((PetscObject)sp, "bdm", &isbdm);CHKERRQ(ierr);
1777*3f27d899SToby Isaac   if (isbdm) {
1778*3f27d899SToby Isaac     sp->k = -(dim-1); /* form degree of H-div */
1779*3f27d899SToby Isaac     ierr = PetscObjectChangeTypeName((PetscObject)sp, PETSCDUALSPACELAGRANGE);CHKERRQ(ierr);
1780*3f27d899SToby Isaac   }
1781*3f27d899SToby Isaac   ierr = PetscDualSpaceGetFormDegree(sp, &formDegree);CHKERRQ(ierr);
1782*3f27d899SToby Isaac   if (PetscAbsInt(formDegree) > dim) SETERRQ(comm, PETSC_ERR_ARG_OUTOFRANGE, "Form degree must be bounded by dimension");
1783*3f27d899SToby Isaac   ierr = PetscDTBinomialInt(dim,PetscAbsInt(formDegree),&Nk);CHKERRQ(ierr);
1784*3f27d899SToby Isaac   if (sp->Nc <= 0 && lag->numCopies > 0) sp->Nc = Nk * lag->numCopies;
1785*3f27d899SToby Isaac   Nc = sp->Nc;
1786*3f27d899SToby Isaac   if (Nc % Nk) SETERRQ(comm, PETSC_ERR_ARG_INCOMP, "Number of components is not a multiple of form degree size");
1787*3f27d899SToby Isaac   if (lag->numCopies <= 0) lag->numCopies = Nc / Nk;
1788*3f27d899SToby Isaac   Ncopies = lag->numCopies;
1789*3f27d899SToby Isaac   if (Nc / Nk != Ncopies) SETERRQ(comm, PETSC_ERR_ARG_INCOMP, "Number of copies * (dim choose k) != Nc");
1790*3f27d899SToby Isaac   if (!dim) sp->order = 0;
1791*3f27d899SToby Isaac   order = sp->order;
1792*3f27d899SToby Isaac   uniform = sp->uniform;
1793*3f27d899SToby Isaac   if (!uniform) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Variable order not supported yet");
1794*3f27d899SToby Isaac   if (lag->trimmed && !formDegree) lag->trimmed = PETSC_FALSE; /* trimmed spaces are the same as full spaces for 0-forms */
1795*3f27d899SToby Isaac   if (lag->nodeType == PETSCDTNODES_DEFAULT) {
1796*3f27d899SToby Isaac     lag->nodeType = PETSCDTNODES_GAUSSJACOBI;
1797*3f27d899SToby Isaac     lag->nodeExponent = 0.;
1798*3f27d899SToby Isaac     /* trimmed spaces don't include corner vertices, so don't use end nodes by default */
1799*3f27d899SToby Isaac     lag->endNodes = lag->trimmed ? PETSC_FALSE : PETSC_TRUE;
1800*3f27d899SToby Isaac   }
1801*3f27d899SToby Isaac   /* If a trimmed space and the user did choose nodes with endpoints, skip them by default */
1802*3f27d899SToby Isaac   if (lag->numNodeSkip < 0) lag->numNodeSkip = (lag->trimmed && lag->endNodes) ? 1 : 0;
1803*3f27d899SToby Isaac   numNodeSkip = lag->numNodeSkip;
1804*3f27d899SToby Isaac   if (lag->trimmed && !order) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Cannot have zeroth order trimmed elements");
1805*3f27d899SToby Isaac   if (lag->trimmed && PetscAbsInt(formDegree) == dim) { /* convert trimmed n-forms to untrimmed of one polynomial order less */
1806*3f27d899SToby Isaac     sp->order--;
1807*3f27d899SToby Isaac     order--;
1808*3f27d899SToby Isaac     lag->trimmed = PETSC_FALSE;
1809*3f27d899SToby Isaac   }
1810*3f27d899SToby Isaac   trimmed = lag->trimmed;
1811*3f27d899SToby Isaac   if (!order || PetscAbsInt(formDegree) == dim) lag->continuous = PETSC_FALSE;
1812*3f27d899SToby Isaac   continuous = lag->continuous;
18136f905325SMatthew G. Knepley   ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
18146f905325SMatthew G. Knepley   ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
1815*3f27d899SToby Isaac   ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1816*3f27d899SToby Isaac   if (pStart != 0 || cStart != 0) SETERRQ(PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_WRONGSTATE, "Expect DM with chart starting at zero and cells first");
1817*3f27d899SToby Isaac   if (cEnd != 1) SETERRQ(PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_WRONGSTATE, "Use PETSCDUALSPACEREFINED for multi-cell reference meshes");
1818*3f27d899SToby Isaac   ierr = DMPlexIsInterpolated(dm, &interpolated);CHKERRQ(ierr);
1819*3f27d899SToby Isaac   if (interpolated != DMPLEX_INTERPOLATED_FULL) {
1820*3f27d899SToby Isaac     ierr = DMPlexInterpolate(dm, &dmint);CHKERRQ(ierr);
1821*3f27d899SToby Isaac   } else {
1822*3f27d899SToby Isaac     ierr = PetscObjectReference((PetscObject)dm);CHKERRQ(ierr);
1823*3f27d899SToby Isaac     dmint = dm;
1824*3f27d899SToby Isaac   }
1825*3f27d899SToby Isaac   tensorCell = PETSC_FALSE;
1826*3f27d899SToby Isaac   if (dim > 1) {
1827*3f27d899SToby Isaac     ierr = DMPlexPointIsTensor(dmint, 0, &tensorCell, &tensorf, &tensorf2);CHKERRQ(ierr);
1828*3f27d899SToby Isaac   }
1829*3f27d899SToby Isaac   lag->tensorCell = tensorCell;
1830*3f27d899SToby Isaac   if (dim < 2 || !lag->tensorCell) lag->tensorSpace = PETSC_FALSE;
18316f905325SMatthew G. Knepley   tensorSpace = lag->tensorSpace;
1832*3f27d899SToby Isaac   if (!lag->nodeFamily) {
1833*3f27d899SToby Isaac     ierr = Petsc1DNodeFamilyCreate(lag->nodeType, lag->nodeExponent, lag->endNodes, &lag->nodeFamily);CHKERRQ(ierr);
1834*3f27d899SToby Isaac   }
1835*3f27d899SToby Isaac   nodeFamily = lag->nodeFamily;
1836*3f27d899SToby Isaac   if (interpolated != DMPLEX_INTERPOLATED_FULL && continuous && (PetscAbsInt(formDegree) > 0 || order > 1)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Reference element won't support all boundary nodes");
183720cf1dd8SToby Isaac 
1838*3f27d899SToby Isaac   /* step 2: construct the boundary spaces */
1839*3f27d899SToby Isaac   ierr = PetscMalloc2(depth+1,&pStratStart,depth+1,&pStratEnd);CHKERRQ(ierr);
1840*3f27d899SToby Isaac   ierr = PetscCalloc1(pEnd,&(sp->pointSpaces));CHKERRQ(ierr);
1841*3f27d899SToby Isaac   for (d = 0; d <= depth; ++d) {ierr = DMPlexGetDepthStratum(dm, d, &pStratStart[d], &pStratEnd[d]);CHKERRQ(ierr);}
1842*3f27d899SToby Isaac   ierr = PetscDualSpaceSectionCreate_Internal(sp, &section);CHKERRQ(ierr);
1843*3f27d899SToby Isaac   sp->pointSection = section;
1844*3f27d899SToby Isaac   if (continuous && !(lag->interiorOnly)) {
1845*3f27d899SToby Isaac     PetscInt h;
18466f905325SMatthew G. Knepley 
1847*3f27d899SToby Isaac     for (p = pStratStart[depth - 1]; p < pStratEnd[depth - 1]; p++) { /* calculate the facet dual spaces */
1848*3f27d899SToby Isaac       PetscReal v0[3];
1849*3f27d899SToby Isaac       DMPolytopeType ptype;
1850*3f27d899SToby Isaac       PetscReal J[9], detJ;
18516f905325SMatthew G. Knepley       PetscInt  q;
18526f905325SMatthew G. Knepley 
1853*3f27d899SToby Isaac       ierr = DMPlexComputeCellGeometryAffineFEM(dm, p, v0, J, NULL, &detJ);CHKERRQ(ierr);
1854*3f27d899SToby Isaac       ierr = DMPlexGetCellType(dm, p, &ptype);CHKERRQ(ierr);
18556f905325SMatthew G. Knepley 
1856*3f27d899SToby Isaac       /* compare orders to previous facets: if computed, reference that dualspace */
1857*3f27d899SToby Isaac       for (q = pStratStart[depth - 1]; q < p; q++) {
1858*3f27d899SToby Isaac         DMPolytopeType qtype;
18596f905325SMatthew G. Knepley 
1860*3f27d899SToby Isaac         ierr = DMPlexGetCellType(dm, q, &qtype);CHKERRQ(ierr);
1861*3f27d899SToby Isaac         if (qtype == ptype) break;
18626f905325SMatthew G. Knepley       }
1863*3f27d899SToby Isaac       if (q < p) { /* this facet has the same dual space as that one */
1864*3f27d899SToby Isaac         ierr = PetscObjectReference((PetscObject)sp->pointSpaces[q]);CHKERRQ(ierr);
1865*3f27d899SToby Isaac         sp->pointSpaces[p] = sp->pointSpaces[q];
1866*3f27d899SToby Isaac         continue;
18676f905325SMatthew G. Knepley       }
1868*3f27d899SToby Isaac       /* if not, recursively compute this dual space */
1869*3f27d899SToby Isaac       ierr = PetscDualSpaceCreateFacetSubspace_Lagrange(sp,NULL,p,formDegree,Ncopies,PETSC_FALSE,&sp->pointSpaces[p]);CHKERRQ(ierr);
18706f905325SMatthew G. Knepley     }
1871*3f27d899SToby Isaac     for (h = 2; h <= depth; h++) { /* get the higher subspaces from the facet subspaces */
1872*3f27d899SToby Isaac       PetscInt hd = depth - h;
1873*3f27d899SToby Isaac       PetscInt hdim = dim - h;
18746f905325SMatthew G. Knepley 
1875*3f27d899SToby Isaac       if (hdim < PetscAbsInt(formDegree)) break;
1876*3f27d899SToby Isaac       for (p = pStratStart[hd]; p < pStratEnd[hd]; p++) {
1877*3f27d899SToby Isaac         PetscInt suppSize, s;
1878*3f27d899SToby Isaac         const PetscInt *supp;
18796f905325SMatthew G. Knepley 
1880*3f27d899SToby Isaac         ierr = DMPlexGetSupportSize(dm, p, &suppSize);CHKERRQ(ierr);
1881*3f27d899SToby Isaac         ierr = DMPlexGetSupport(dm, p, &supp);CHKERRQ(ierr);
1882*3f27d899SToby Isaac         for (s = 0; s < suppSize; s++) {
1883*3f27d899SToby Isaac           DM             qdm;
1884*3f27d899SToby Isaac           PetscDualSpace qsp, psp;
1885*3f27d899SToby Isaac           PetscInt c, coneSize, q;
1886*3f27d899SToby Isaac           const PetscInt *cone;
1887*3f27d899SToby Isaac           const PetscInt *refCone;
18886f905325SMatthew G. Knepley 
1889*3f27d899SToby Isaac           q = supp[0];
1890*3f27d899SToby Isaac           qsp = sp->pointSpaces[q];
1891*3f27d899SToby Isaac           ierr = DMPlexGetConeSize(dm, q, &coneSize);CHKERRQ(ierr);
1892*3f27d899SToby Isaac           ierr = DMPlexGetCone(dm, q, &cone);CHKERRQ(ierr);
1893*3f27d899SToby Isaac           for (c = 0; c < coneSize; c++) if (cone[c] == p) break;
1894*3f27d899SToby Isaac           if (c == coneSize) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "cone/suppport mismatch");
1895*3f27d899SToby Isaac           ierr = PetscDualSpaceGetDM(qsp, &qdm);CHKERRQ(ierr);
1896*3f27d899SToby Isaac           ierr = DMPlexGetCone(qdm, 0, &refCone);CHKERRQ(ierr);
1897*3f27d899SToby Isaac           /* get the equivalent dual space from the support dual space */
1898*3f27d899SToby Isaac           ierr = PetscDualSpaceGetPointSubspace(qsp, refCone[c], &psp);CHKERRQ(ierr);
1899*3f27d899SToby Isaac           if (!s) {
1900*3f27d899SToby Isaac             ierr = PetscObjectReference((PetscObject)psp);CHKERRQ(ierr);
1901*3f27d899SToby Isaac             sp->pointSpaces[p] = psp;
1902*3f27d899SToby Isaac           }
1903*3f27d899SToby Isaac         }
1904*3f27d899SToby Isaac       }
1905*3f27d899SToby Isaac     }
1906*3f27d899SToby Isaac     for (p = 1; p < pEnd; p++) {
1907*3f27d899SToby Isaac       PetscInt pspdim;
1908*3f27d899SToby Isaac       if (!sp->pointSpaces[p]) continue;
1909*3f27d899SToby Isaac       ierr = PetscDualSpaceGetInteriorDimension(sp->pointSpaces[p], &pspdim);CHKERRQ(ierr);
1910*3f27d899SToby Isaac       ierr = PetscSectionSetDof(section, p, pspdim);CHKERRQ(ierr);
1911*3f27d899SToby Isaac     }
1912*3f27d899SToby Isaac   }
19136f905325SMatthew G. Knepley 
1914*3f27d899SToby Isaac   if (Ncopies > 1) {
1915*3f27d899SToby Isaac     Mat intMatScalar, allMatScalar;
1916*3f27d899SToby Isaac     PetscDualSpace scalarsp;
1917*3f27d899SToby Isaac     PetscDualSpace_Lag *scalarlag;
1918*3f27d899SToby Isaac 
1919*3f27d899SToby Isaac     ierr = PetscDualSpaceDuplicate(sp, &scalarsp);CHKERRQ(ierr);
1920*3f27d899SToby Isaac     ierr = PetscDualSpaceSetNumComponents(scalarsp, Nk);CHKERRQ(ierr);
1921*3f27d899SToby Isaac     ierr = PetscDualSpaceSetUp(scalarsp);CHKERRQ(ierr);
1922*3f27d899SToby Isaac     ierr = PetscDualSpaceGetInteriorData(scalarsp, &(sp->intNodes), &intMatScalar);CHKERRQ(ierr);
1923*3f27d899SToby Isaac     ierr = PetscObjectReference((PetscObject)(sp->intNodes));CHKERRQ(ierr);
1924*3f27d899SToby Isaac     if (intMatScalar) {ierr = PetscDualSpaceLagrangeMatrixCreateCopies(intMatScalar, Nk, Ncopies, &(sp->intMat));CHKERRQ(ierr);}
1925*3f27d899SToby Isaac     ierr = PetscDualSpaceGetAllData(scalarsp, &(sp->allNodes), &allMatScalar);CHKERRQ(ierr);
1926*3f27d899SToby Isaac     ierr = PetscObjectReference((PetscObject)(sp->allNodes));CHKERRQ(ierr);
1927*3f27d899SToby Isaac     ierr = PetscDualSpaceLagrangeMatrixCreateCopies(allMatScalar, Nk, Ncopies, &(sp->allMat));CHKERRQ(ierr);
1928*3f27d899SToby Isaac     sp->spdim = scalarsp->spdim * Ncopies;
1929*3f27d899SToby Isaac     sp->spintdim = scalarsp->spintdim * Ncopies;
1930*3f27d899SToby Isaac     scalarlag = (PetscDualSpace_Lag *) scalarsp->data;
1931*3f27d899SToby Isaac     ierr = PetscLagNodeIndicesReference(scalarlag->vertIndices);CHKERRQ(ierr);
1932*3f27d899SToby Isaac     lag->vertIndices = scalarlag->vertIndices;
1933*3f27d899SToby Isaac     ierr = PetscLagNodeIndicesReference(scalarlag->intNodeIndices);CHKERRQ(ierr);
1934*3f27d899SToby Isaac     lag->intNodeIndices = scalarlag->intNodeIndices;
1935*3f27d899SToby Isaac     ierr = PetscLagNodeIndicesReference(scalarlag->allNodeIndices);CHKERRQ(ierr);
1936*3f27d899SToby Isaac     lag->allNodeIndices = scalarlag->allNodeIndices;
1937*3f27d899SToby Isaac     ierr = PetscDualSpaceDestroy(&scalarsp);CHKERRQ(ierr);
1938*3f27d899SToby Isaac     ierr = PetscSectionSetDof(section, 0, sp->spintdim);CHKERRQ(ierr);
1939*3f27d899SToby Isaac     ierr = PetscDualSpaceSectionSetUp_Internal(sp, section);CHKERRQ(ierr);
1940*3f27d899SToby Isaac     ierr = PetscDualSpaceComputeFunctionalsFromAllData(sp);CHKERRQ(ierr);
19416f905325SMatthew G. Knepley     ierr = PetscFree2(pStratStart, pStratEnd);CHKERRQ(ierr);
1942*3f27d899SToby Isaac     ierr = DMDestroy(&dmint);CHKERRQ(ierr);
194320cf1dd8SToby Isaac     PetscFunctionReturn(0);
194420cf1dd8SToby Isaac   }
194520cf1dd8SToby Isaac 
1946*3f27d899SToby Isaac   if (trimmed && !continuous) {
1947*3f27d899SToby Isaac     /* the dofs of a trimmed space don't have a nice tensor/lattice structure:
1948*3f27d899SToby Isaac      * just construct the continuous dual space and copy all of the data over,
1949*3f27d899SToby Isaac      * allocating it all to the cell instead of splitting it up between the boundaries */
1950*3f27d899SToby Isaac     PetscDualSpace  spcont;
1951*3f27d899SToby Isaac     PetscInt        spdim, f;
1952*3f27d899SToby Isaac     PetscQuadrature allNodes;
1953*3f27d899SToby Isaac     PetscDualSpace_Lag *lagc;
1954*3f27d899SToby Isaac     Mat             allMat;
1955*3f27d899SToby Isaac 
1956*3f27d899SToby Isaac     ierr = PetscDualSpaceDuplicate(sp, &spcont);CHKERRQ(ierr);
1957*3f27d899SToby Isaac     ierr = PetscDualSpaceLagrangeSetContinuity(spcont, PETSC_TRUE);CHKERRQ(ierr);
1958*3f27d899SToby Isaac     ierr = PetscDualSpaceSetUp(spcont);CHKERRQ(ierr);
1959*3f27d899SToby Isaac     ierr = PetscDualSpaceGetDimension(spcont, &spdim);CHKERRQ(ierr);
1960*3f27d899SToby Isaac     sp->spdim = sp->spintdim = spdim;
1961*3f27d899SToby Isaac     ierr = PetscSectionSetDof(section, 0, spdim);CHKERRQ(ierr);
1962*3f27d899SToby Isaac     ierr = PetscDualSpaceSectionSetUp_Internal(sp, section);CHKERRQ(ierr);
1963*3f27d899SToby Isaac     ierr = PetscMalloc1(spdim, &(sp->functional));CHKERRQ(ierr);
1964*3f27d899SToby Isaac     for (f = 0; f < spdim; f++) {
1965*3f27d899SToby Isaac       PetscQuadrature fn;
1966*3f27d899SToby Isaac 
1967*3f27d899SToby Isaac       ierr = PetscDualSpaceGetFunctional(spcont, f, &fn);CHKERRQ(ierr);
1968*3f27d899SToby Isaac       ierr = PetscObjectReference((PetscObject)fn);CHKERRQ(ierr);
1969*3f27d899SToby Isaac       sp->functional[f] = fn;
1970*3f27d899SToby Isaac     }
1971*3f27d899SToby Isaac     ierr = PetscDualSpaceGetAllData(spcont, &allNodes, &allMat);CHKERRQ(ierr);
1972*3f27d899SToby Isaac     ierr = PetscObjectReference((PetscObject) allNodes);CHKERRQ(ierr);
1973*3f27d899SToby Isaac     ierr = PetscObjectReference((PetscObject) allNodes);CHKERRQ(ierr);
1974*3f27d899SToby Isaac     sp->allNodes = sp->intNodes = allNodes;
1975*3f27d899SToby Isaac     ierr = PetscObjectReference((PetscObject) allMat);CHKERRQ(ierr);
1976*3f27d899SToby Isaac     ierr = PetscObjectReference((PetscObject) allMat);CHKERRQ(ierr);
1977*3f27d899SToby Isaac     sp->allMat = sp->intMat = allMat;
1978*3f27d899SToby Isaac     /* TODO: copy over symmetries */
1979*3f27d899SToby Isaac     lagc = (PetscDualSpace_Lag *) spcont->data;
1980*3f27d899SToby Isaac     ierr = PetscLagNodeIndicesReference(lagc->vertIndices);CHKERRQ(ierr);
1981*3f27d899SToby Isaac     lag->vertIndices = lagc->vertIndices;
1982*3f27d899SToby Isaac     ierr = PetscLagNodeIndicesReference(lagc->allNodeIndices);CHKERRQ(ierr);
1983*3f27d899SToby Isaac     ierr = PetscLagNodeIndicesReference(lagc->allNodeIndices);CHKERRQ(ierr);
1984*3f27d899SToby Isaac     lag->intNodeIndices = lagc->allNodeIndices;
1985*3f27d899SToby Isaac     lag->allNodeIndices = lagc->allNodeIndices;
1986*3f27d899SToby Isaac     ierr = PetscDualSpaceDestroy(&spcont);CHKERRQ(ierr);
1987*3f27d899SToby Isaac     ierr = PetscFree2(pStratStart, pStratEnd);CHKERRQ(ierr);
1988*3f27d899SToby Isaac     ierr = DMDestroy(&dmint);CHKERRQ(ierr);
1989*3f27d899SToby Isaac     PetscFunctionReturn(0);
1990*3f27d899SToby Isaac   }
1991*3f27d899SToby Isaac 
1992*3f27d899SToby Isaac   /* step 3: construct intNodes, and intMat, and combine it with boundray data to make allNodes and allMat */
1993*3f27d899SToby Isaac   if (!tensorSpace) {
1994*3f27d899SToby Isaac     ierr = PetscLagNodeIndicesCreateSimplexVertices(dm, &(lag->vertIndices));CHKERRQ(ierr);
1995*3f27d899SToby Isaac 
1996*3f27d899SToby Isaac     if (trimmed) {
1997*3f27d899SToby Isaac       if (order + PetscAbsInt(formDegree) > dim) {
1998*3f27d899SToby Isaac         PetscInt sum = order + PetscAbsInt(formDegree) - dim - 1;
1999*3f27d899SToby Isaac         PetscInt nDofs;
2000*3f27d899SToby Isaac 
2001*3f27d899SToby Isaac         ierr = PetscDualSpaceLagrangeCreateSimplexNodeMat(nodeFamily, dim, sum, Nk, numNodeSkip, &sp->intNodes, &sp->intMat, &(lag->intNodeIndices));CHKERRQ(ierr);
2002*3f27d899SToby Isaac         ierr = MatGetSize(sp->intMat, &nDofs, NULL);CHKERRQ(ierr);
2003*3f27d899SToby Isaac         ierr = PetscSectionSetDof(section, 0, nDofs);CHKERRQ(ierr);
2004*3f27d899SToby Isaac       }
2005*3f27d899SToby Isaac       ierr = PetscDualSpaceSectionSetUp_Internal(sp, section);CHKERRQ(ierr);
2006*3f27d899SToby Isaac       ierr = PetscDualSpaceCreateAllDataFromInteriorData(sp);CHKERRQ(ierr);
2007*3f27d899SToby Isaac       ierr = PetscDualSpaceLagrangeCreateAllNodeIdx(sp);CHKERRQ(ierr);
2008*3f27d899SToby Isaac     } else {
2009*3f27d899SToby Isaac       if (!continuous) {
2010*3f27d899SToby Isaac         PetscInt sum = order;
2011*3f27d899SToby Isaac         PetscInt nDofs;
2012*3f27d899SToby Isaac 
2013*3f27d899SToby Isaac         ierr = PetscDualSpaceLagrangeCreateSimplexNodeMat(nodeFamily, dim, sum, Nk, numNodeSkip, &sp->intNodes, &sp->intMat, &(lag->intNodeIndices));CHKERRQ(ierr);
2014*3f27d899SToby Isaac         ierr = MatGetSize(sp->intMat, &nDofs, NULL);CHKERRQ(ierr);
2015*3f27d899SToby Isaac         ierr = PetscSectionSetDof(section, 0, nDofs);CHKERRQ(ierr);
2016*3f27d899SToby Isaac         ierr = PetscDualSpaceSectionSetUp_Internal(sp, section);CHKERRQ(ierr);
2017*3f27d899SToby Isaac         ierr = PetscObjectReference((PetscObject)(sp->intNodes));CHKERRQ(ierr);
2018*3f27d899SToby Isaac         sp->allNodes = sp->intNodes;
2019*3f27d899SToby Isaac         ierr = PetscObjectReference((PetscObject)(sp->intMat));CHKERRQ(ierr);
2020*3f27d899SToby Isaac         sp->allMat = sp->intMat;
2021*3f27d899SToby Isaac         ierr = PetscLagNodeIndicesReference(lag->intNodeIndices);CHKERRQ(ierr);
2022*3f27d899SToby Isaac         lag->allNodeIndices = lag->intNodeIndices;
2023*3f27d899SToby Isaac       } else {
2024*3f27d899SToby Isaac         if (order + PetscAbsInt(formDegree) > dim) {
2025*3f27d899SToby Isaac           PetscDualSpace trimmedsp;
2026*3f27d899SToby Isaac           PetscDualSpace_Lag *trimmedlag;
2027*3f27d899SToby Isaac           PetscQuadrature intNodes;
2028*3f27d899SToby Isaac           PetscInt trFormDegree = formDegree >= 0 ? formDegree - dim : dim - PetscAbsInt(formDegree);
2029*3f27d899SToby Isaac           PetscInt nDofs;
2030*3f27d899SToby Isaac           Mat intMat;
2031*3f27d899SToby Isaac 
2032*3f27d899SToby Isaac           ierr = PetscDualSpaceDuplicate(sp, &trimmedsp);CHKERRQ(ierr);
2033*3f27d899SToby Isaac           ierr = PetscDualSpaceLagrangeSetTrimmed(trimmedsp, PETSC_TRUE);CHKERRQ(ierr);
2034*3f27d899SToby Isaac           ierr = PetscDualSpaceSetOrder(trimmedsp, order + PetscAbsInt(formDegree) - dim);CHKERRQ(ierr);
2035*3f27d899SToby Isaac           ierr = PetscDualSpaceSetFormDegree(trimmedsp, trFormDegree);CHKERRQ(ierr);
2036*3f27d899SToby Isaac           trimmedlag = (PetscDualSpace_Lag *) trimmedsp->data;
2037*3f27d899SToby Isaac           trimmedlag->numNodeSkip = numNodeSkip + 1;
2038*3f27d899SToby Isaac           ierr = PetscDualSpaceSetUp(trimmedsp);CHKERRQ(ierr);
2039*3f27d899SToby Isaac           ierr = PetscDualSpaceGetAllData(trimmedsp, &intNodes, &intMat);CHKERRQ(ierr);
2040*3f27d899SToby Isaac           ierr = PetscObjectReference((PetscObject)intNodes);CHKERRQ(ierr);
2041*3f27d899SToby Isaac           sp->intNodes = intNodes;
2042*3f27d899SToby Isaac           ierr = PetscObjectReference((PetscObject)intMat);CHKERRQ(ierr);
2043*3f27d899SToby Isaac           sp->intMat = intMat;
2044*3f27d899SToby Isaac           ierr = MatGetSize(sp->intMat, &nDofs, NULL);CHKERRQ(ierr);
2045*3f27d899SToby Isaac           ierr = PetscLagNodeIndicesReference(trimmedlag->allNodeIndices);CHKERRQ(ierr);
2046*3f27d899SToby Isaac           lag->intNodeIndices = trimmedlag->allNodeIndices;
2047*3f27d899SToby Isaac           ierr = PetscDualSpaceDestroy(&trimmedsp);CHKERRQ(ierr);
2048*3f27d899SToby Isaac           ierr = PetscSectionSetDof(section, 0, nDofs);CHKERRQ(ierr);
2049*3f27d899SToby Isaac         }
2050*3f27d899SToby Isaac         ierr = PetscDualSpaceSectionSetUp_Internal(sp, section);CHKERRQ(ierr);
2051*3f27d899SToby Isaac         ierr = PetscDualSpaceCreateAllDataFromInteriorData(sp);CHKERRQ(ierr);
2052*3f27d899SToby Isaac         ierr = PetscDualSpaceLagrangeCreateAllNodeIdx(sp);CHKERRQ(ierr);
2053*3f27d899SToby Isaac       }
2054*3f27d899SToby Isaac     }
2055*3f27d899SToby Isaac   } else {
2056*3f27d899SToby Isaac     /* assume the tensor element has the first facet being the cross-section, having its normal
2057*3f27d899SToby Isaac      * pointing in the last coordinate direction */
2058*3f27d899SToby Isaac     PetscQuadrature intNodesTrace = NULL;
2059*3f27d899SToby Isaac     PetscQuadrature intNodesFiber = NULL;
2060*3f27d899SToby Isaac     PetscQuadrature intNodes = NULL;
2061*3f27d899SToby Isaac     PetscLagNodeIndices intNodeIndices = NULL;
2062*3f27d899SToby Isaac     Mat             intMat = NULL;
2063*3f27d899SToby Isaac 
2064*3f27d899SToby Isaac     if (PetscAbsInt(formDegree) < dim) { /* get the trace k-forms on the first facet, and the 0-forms on the edge */
2065*3f27d899SToby Isaac       PetscDualSpace  trace, fiber;
2066*3f27d899SToby Isaac       PetscDualSpace_Lag *tracel, *fiberl;
2067*3f27d899SToby Isaac       Mat             intMatTrace, intMatFiber;
2068*3f27d899SToby Isaac 
2069*3f27d899SToby Isaac       if (sp->pointSpaces[tensorf]) {
2070*3f27d899SToby Isaac         ierr = PetscObjectReference((PetscObject)(sp->pointSpaces[tensorf]));CHKERRQ(ierr);
2071*3f27d899SToby Isaac         trace = sp->pointSpaces[tensorf];
2072*3f27d899SToby Isaac       } else {
2073*3f27d899SToby Isaac         ierr = PetscDualSpaceCreateFacetSubspace_Lagrange(sp,NULL,tensorf,formDegree,Ncopies,PETSC_TRUE,&trace);CHKERRQ(ierr);
2074*3f27d899SToby Isaac       }
2075*3f27d899SToby Isaac       ierr = PetscDualSpaceCreateEdgeSubspace_Lagrange(sp,order,0,1,PETSC_TRUE,&fiber);CHKERRQ(ierr);
2076*3f27d899SToby Isaac       tracel = (PetscDualSpace_Lag *) trace->data;
2077*3f27d899SToby Isaac       fiberl = (PetscDualSpace_Lag *) fiber->data;
2078*3f27d899SToby Isaac       ierr = PetscLagNodeIndicesCreateTensorVertices(dm, tracel->vertIndices, &(lag->vertIndices));CHKERRQ(ierr);
2079*3f27d899SToby Isaac       ierr = PetscDualSpaceGetInteriorData(trace, &intNodesTrace, &intMatTrace);CHKERRQ(ierr);
2080*3f27d899SToby Isaac       ierr = PetscDualSpaceGetInteriorData(fiber, &intNodesFiber, &intMatFiber);CHKERRQ(ierr);
2081*3f27d899SToby Isaac       if (intNodesTrace && intNodesFiber) {
2082*3f27d899SToby Isaac         ierr = PetscQuadratureCreateTensor(intNodesTrace, intNodesFiber, &intNodes);CHKERRQ(ierr);
2083*3f27d899SToby Isaac         ierr = MatTensorAltV(intMatTrace, intMatFiber, dim-1, formDegree, 1, 0, &intMat);CHKERRQ(ierr);
2084*3f27d899SToby Isaac         ierr = PetscLagNodeIndicesTensor(tracel->intNodeIndices, dim - 1, formDegree, fiberl->intNodeIndices, 1, 0, &intNodeIndices);CHKERRQ(ierr);
2085*3f27d899SToby Isaac       }
2086*3f27d899SToby Isaac       ierr = PetscObjectReference((PetscObject) intNodesTrace);CHKERRQ(ierr);
2087*3f27d899SToby Isaac       ierr = PetscObjectReference((PetscObject) intNodesFiber);CHKERRQ(ierr);
2088*3f27d899SToby Isaac       ierr = PetscDualSpaceDestroy(&fiber);CHKERRQ(ierr);
2089*3f27d899SToby Isaac       ierr = PetscDualSpaceDestroy(&trace);CHKERRQ(ierr);
2090*3f27d899SToby Isaac     }
2091*3f27d899SToby Isaac     if (PetscAbsInt(formDegree) > 0) { /* get the trace (k-1)-forms on the first facet, and the 1-forms on the edge */
2092*3f27d899SToby Isaac       PetscDualSpace  trace, fiber;
2093*3f27d899SToby Isaac       PetscDualSpace_Lag *tracel, *fiberl;
2094*3f27d899SToby Isaac       PetscQuadrature intNodesTrace2, intNodesFiber2, intNodes2;
2095*3f27d899SToby Isaac       PetscLagNodeIndices intNodeIndices2;
2096*3f27d899SToby Isaac       Mat             intMatTrace, intMatFiber, intMat2;
2097*3f27d899SToby Isaac       PetscInt        traceDegree = formDegree > 0 ? formDegree - 1 : formDegree + 1;
2098*3f27d899SToby Isaac       PetscInt        fiberDegree = formDegree > 0 ? 1 : -1;
2099*3f27d899SToby Isaac 
2100*3f27d899SToby Isaac       ierr = PetscDualSpaceCreateFacetSubspace_Lagrange(sp,NULL,tensorf,traceDegree,Ncopies,PETSC_TRUE,&trace);CHKERRQ(ierr);
2101*3f27d899SToby Isaac       ierr = PetscDualSpaceCreateEdgeSubspace_Lagrange(sp,order,fiberDegree,1,PETSC_TRUE,&fiber);CHKERRQ(ierr);
2102*3f27d899SToby Isaac       tracel = (PetscDualSpace_Lag *) trace->data;
2103*3f27d899SToby Isaac       fiberl = (PetscDualSpace_Lag *) fiber->data;
2104*3f27d899SToby Isaac       if (!lag->vertIndices) {
2105*3f27d899SToby Isaac         ierr = PetscLagNodeIndicesCreateTensorVertices(dm, tracel->vertIndices, &(lag->vertIndices));CHKERRQ(ierr);
2106*3f27d899SToby Isaac       }
2107*3f27d899SToby Isaac       ierr = PetscDualSpaceGetInteriorData(trace, &intNodesTrace2, &intMatTrace);CHKERRQ(ierr);
2108*3f27d899SToby Isaac       ierr = PetscDualSpaceGetInteriorData(fiber, &intNodesFiber2, &intMatFiber);CHKERRQ(ierr);
2109*3f27d899SToby Isaac       if (intNodesTrace2 && intNodesFiber2) {
2110*3f27d899SToby Isaac         ierr = PetscQuadratureCreateTensor(intNodesTrace2, intNodesFiber2, &intNodes2);CHKERRQ(ierr);
2111*3f27d899SToby Isaac         ierr = MatTensorAltV(intMatTrace, intMatFiber, dim-1, traceDegree, 1, fiberDegree, &intMat2);CHKERRQ(ierr);
2112*3f27d899SToby Isaac         ierr = PetscLagNodeIndicesTensor(tracel->intNodeIndices, dim - 1, traceDegree, fiberl->intNodeIndices, 1, fiberDegree, &intNodeIndices2);CHKERRQ(ierr);
2113*3f27d899SToby Isaac         if (!intMat) {
2114*3f27d899SToby Isaac           intMat = intMat2;
2115*3f27d899SToby Isaac           intNodes = intNodes2;
2116*3f27d899SToby Isaac           intNodeIndices = intNodeIndices2;
2117*3f27d899SToby Isaac         } else {
2118*3f27d899SToby Isaac           /* merge the two matrices and the two sets of points */
2119*3f27d899SToby Isaac           PetscInt        *toMerged, *toMerged2;
2120*3f27d899SToby Isaac           PetscInt         nM;
2121*3f27d899SToby Isaac           PetscQuadrature  merged = NULL;
2122*3f27d899SToby Isaac           PetscInt         nDof, nDof2;
2123*3f27d899SToby Isaac           PetscLagNodeIndices intNodeIndicesMerged = NULL;
2124*3f27d899SToby Isaac           Mat              matMerged = NULL;
2125*3f27d899SToby Isaac 
2126*3f27d899SToby Isaac           ierr = MatGetSize(intMat, &nDof, 0);CHKERRQ(ierr);
2127*3f27d899SToby Isaac           ierr = MatGetSize(intMat2, &nDof2, 0);CHKERRQ(ierr);
2128*3f27d899SToby Isaac           ierr = PetscQuadraturePointsMerge(intNodes, intNodes2, &merged, &toMerged, &toMerged2);CHKERRQ(ierr);
2129*3f27d899SToby Isaac           ierr = PetscQuadratureGetData(merged, NULL, NULL, &nM, NULL, NULL);CHKERRQ(ierr);
2130*3f27d899SToby Isaac           ierr = MatricesMerge(intMat, intMat2, dim, formDegree, nM, toMerged, toMerged2, &matMerged);CHKERRQ(ierr);
2131*3f27d899SToby Isaac           ierr = PetscLagNodeIndicesMerge(intNodeIndices, intNodeIndices2, &intNodeIndicesMerged);CHKERRQ(ierr);
2132*3f27d899SToby Isaac           ierr = PetscFree2(toMerged,toMerged2);CHKERRQ(ierr);
2133*3f27d899SToby Isaac           ierr = MatDestroy(&intMat);CHKERRQ(ierr);
2134*3f27d899SToby Isaac           ierr = MatDestroy(&intMat2);CHKERRQ(ierr);
2135*3f27d899SToby Isaac           ierr = PetscQuadratureDestroy(&intNodes);CHKERRQ(ierr);
2136*3f27d899SToby Isaac           ierr = PetscQuadratureDestroy(&intNodes2);CHKERRQ(ierr);
2137*3f27d899SToby Isaac           ierr = PetscLagNodeIndicesDestroy(&intNodeIndices);CHKERRQ(ierr);
2138*3f27d899SToby Isaac           ierr = PetscLagNodeIndicesDestroy(&intNodeIndices2);CHKERRQ(ierr);
2139*3f27d899SToby Isaac           intNodes = merged;
2140*3f27d899SToby Isaac           intMat = matMerged;
2141*3f27d899SToby Isaac           intNodeIndices = intNodeIndicesMerged;
2142*3f27d899SToby Isaac           if (!trimmed) {
2143*3f27d899SToby Isaac             Mat intMatPerm;
2144*3f27d899SToby Isaac 
2145*3f27d899SToby Isaac             ierr = MatPermuteByNodeIdx(intMat, intNodeIndices, &intMatPerm);CHKERRQ(ierr);
2146*3f27d899SToby Isaac             ierr = MatDestroy(&intMat);CHKERRQ(ierr);
2147*3f27d899SToby Isaac             intMat = intMatPerm;
2148*3f27d899SToby Isaac           }
2149*3f27d899SToby Isaac         }
2150*3f27d899SToby Isaac       }
2151*3f27d899SToby Isaac       ierr = PetscDualSpaceDestroy(&fiber);CHKERRQ(ierr);
2152*3f27d899SToby Isaac       ierr = PetscDualSpaceDestroy(&trace);CHKERRQ(ierr);
2153*3f27d899SToby Isaac     }
2154*3f27d899SToby Isaac     ierr = PetscQuadratureDestroy(&intNodesTrace);CHKERRQ(ierr);
2155*3f27d899SToby Isaac     ierr = PetscQuadratureDestroy(&intNodesFiber);CHKERRQ(ierr);
2156*3f27d899SToby Isaac     sp->intNodes = intNodes;
2157*3f27d899SToby Isaac     sp->intMat = intMat;
2158*3f27d899SToby Isaac     lag->intNodeIndices = intNodeIndices;
21596f905325SMatthew G. Knepley     {
2160*3f27d899SToby Isaac       PetscInt nDofs = 0;
2161*3f27d899SToby Isaac 
2162*3f27d899SToby Isaac       if (intMat) {
2163*3f27d899SToby Isaac         ierr = MatGetSize(intMat, &nDofs, NULL);CHKERRQ(ierr);
2164*3f27d899SToby Isaac       }
2165*3f27d899SToby Isaac       ierr = PetscSectionSetDof(section, 0, nDofs);CHKERRQ(ierr);
2166*3f27d899SToby Isaac     }
2167*3f27d899SToby Isaac     ierr = PetscDualSpaceSectionSetUp_Internal(sp, section);CHKERRQ(ierr);
2168*3f27d899SToby Isaac     if (continuous) {
2169*3f27d899SToby Isaac       ierr = PetscDualSpaceCreateAllDataFromInteriorData(sp);CHKERRQ(ierr);
2170*3f27d899SToby Isaac       ierr = PetscDualSpaceLagrangeCreateAllNodeIdx(sp);CHKERRQ(ierr);
2171*3f27d899SToby Isaac     } else {
2172*3f27d899SToby Isaac       ierr = PetscObjectReference((PetscObject) intNodes);CHKERRQ(ierr);
2173*3f27d899SToby Isaac       sp->allNodes = intNodes;
2174*3f27d899SToby Isaac       ierr = PetscObjectReference((PetscObject) intMat);CHKERRQ(ierr);
2175*3f27d899SToby Isaac       sp->allMat = intMat;
2176*3f27d899SToby Isaac       ierr = PetscLagNodeIndicesReference(intNodeIndices);CHKERRQ(ierr);
2177*3f27d899SToby Isaac       lag->allNodeIndices = intNodeIndices;
2178*3f27d899SToby Isaac     }
2179*3f27d899SToby Isaac   }
2180*3f27d899SToby Isaac   ierr = PetscSectionGetStorageSize(section, &sp->spdim);CHKERRQ(ierr);
2181*3f27d899SToby Isaac   ierr = PetscSectionGetConstrainedStorageSize(section, &sp->spintdim);CHKERRQ(ierr);
2182*3f27d899SToby Isaac   ierr = PetscDualSpaceComputeFunctionalsFromAllData(sp);CHKERRQ(ierr);
2183*3f27d899SToby Isaac   ierr = PetscFree2(pStratStart, pStratEnd);CHKERRQ(ierr);
2184*3f27d899SToby Isaac   ierr = DMDestroy(&dmint);CHKERRQ(ierr);
2185*3f27d899SToby Isaac   PetscFunctionReturn(0);
2186*3f27d899SToby Isaac }
2187*3f27d899SToby Isaac 
2188*3f27d899SToby Isaac PetscErrorCode PetscDualSpaceCreateInteriorSymmetryMatrix_Lagrange(PetscDualSpace sp, PetscInt ornt, Mat *symMat)
2189*3f27d899SToby Isaac {
2190*3f27d899SToby Isaac   PetscDualSpace_Lag *lag;
2191*3f27d899SToby Isaac   DM dm;
2192*3f27d899SToby Isaac   PetscLagNodeIndices vertIndices, intNodeIndices;
2193*3f27d899SToby Isaac   PetscLagNodeIndices ni;
2194*3f27d899SToby Isaac   PetscInt nodeIdxDim, nodeVecDim, nNodes;
2195*3f27d899SToby Isaac   PetscInt formDegree;
2196*3f27d899SToby Isaac   PetscInt *perm, *permOrnt;
2197*3f27d899SToby Isaac   PetscInt *nnz;
2198*3f27d899SToby Isaac   PetscInt n;
2199*3f27d899SToby Isaac   PetscInt maxGroupSize;
2200*3f27d899SToby Isaac   PetscScalar *V, *W, *work;
2201*3f27d899SToby Isaac   Mat A;
22026f905325SMatthew G. Knepley   PetscErrorCode ierr;
22036f905325SMatthew G. Knepley 
22046f905325SMatthew G. Knepley   PetscFunctionBegin;
2205*3f27d899SToby Isaac   if (!sp->spintdim) {
2206*3f27d899SToby Isaac     *symMat = NULL;
2207*3f27d899SToby Isaac     PetscFunctionReturn(0);
22086f905325SMatthew G. Knepley   }
2209*3f27d899SToby Isaac   lag = (PetscDualSpace_Lag *) sp->data;
2210*3f27d899SToby Isaac   vertIndices = lag->vertIndices;
2211*3f27d899SToby Isaac   intNodeIndices = lag->intNodeIndices;
2212*3f27d899SToby Isaac   ierr = PetscDualSpaceGetDM(sp, &dm);CHKERRQ(ierr);
2213*3f27d899SToby Isaac   ierr = PetscDualSpaceGetFormDegree(sp, &formDegree);CHKERRQ(ierr);
2214*3f27d899SToby Isaac   ierr = PetscNew(&ni);CHKERRQ(ierr);
2215*3f27d899SToby Isaac   ni->refct = 1;
2216*3f27d899SToby Isaac   ni->nodeIdxDim = nodeIdxDim = intNodeIndices->nodeIdxDim;
2217*3f27d899SToby Isaac   ni->nodeVecDim = nodeVecDim = intNodeIndices->nodeVecDim;
2218*3f27d899SToby Isaac   ni->nNodes = nNodes = intNodeIndices->nNodes;
2219*3f27d899SToby Isaac   ierr = PetscMalloc1(nNodes * nodeIdxDim, &(ni->nodeIdx));CHKERRQ(ierr);
2220*3f27d899SToby Isaac   ierr = PetscMalloc1(nNodes * nodeVecDim, &(ni->nodeVec));CHKERRQ(ierr);
2221*3f27d899SToby Isaac   ierr = PetscLagNodeIndicesPushForward(dm, vertIndices, 0, vertIndices, intNodeIndices, ornt, formDegree, ni->nodeIdx, ni->nodeVec);CHKERRQ(ierr);
2222*3f27d899SToby Isaac   ierr = PetscLagNodeIndicesGetPermutation(intNodeIndices, &perm);CHKERRQ(ierr);
2223*3f27d899SToby Isaac   ierr = PetscLagNodeIndicesGetPermutation(ni, &permOrnt);CHKERRQ(ierr);
2224*3f27d899SToby Isaac   ierr = PetscMalloc1(nNodes, &nnz);CHKERRQ(ierr);
2225*3f27d899SToby Isaac   for (n = 0, maxGroupSize = 0; n < nNodes;) { /* incremented in the loop */
2226*3f27d899SToby Isaac     PetscInt *nind = &(ni->nodeIdx[permOrnt[n] * nodeIdxDim]);
2227*3f27d899SToby Isaac     PetscInt m, nEnd;
2228*3f27d899SToby Isaac     PetscInt groupSize;
2229*3f27d899SToby Isaac     for (nEnd = n + 1; nEnd < nNodes; nEnd++) {
2230*3f27d899SToby Isaac       PetscInt *mind = &(ni->nodeIdx[permOrnt[nEnd] * nodeIdxDim]);
2231*3f27d899SToby Isaac       PetscInt d;
2232*3f27d899SToby Isaac 
2233*3f27d899SToby Isaac       /* compare the oriented permutation indices */
2234*3f27d899SToby Isaac       for (d = 0; d < nodeIdxDim; d++) if (mind[d] != nind[d]) break;
2235*3f27d899SToby Isaac       if (d < nodeIdxDim) break;
2236*3f27d899SToby Isaac     }
2237*3f27d899SToby Isaac #if defined(PETSC_USE_DEBUG)
2238*3f27d899SToby Isaac     {
2239*3f27d899SToby Isaac       PetscInt m;
2240*3f27d899SToby Isaac       PetscInt *nind = &(intNodeIndices->nodeIdx[perm[n] * nodeIdxDim]);
2241*3f27d899SToby Isaac 
2242*3f27d899SToby Isaac       for (m = n + 1; m < nEnd; m++) {
2243*3f27d899SToby Isaac         PetscInt *mind = &(intNodeIndices->nodeIdx[perm[m] * nodeIdxDim]);
2244*3f27d899SToby Isaac         PetscInt d;
2245*3f27d899SToby Isaac 
2246*3f27d899SToby Isaac         /* compare the oriented permutation indices */
2247*3f27d899SToby Isaac         for (d = 0; d < nodeIdxDim; d++) if (mind[d] != nind[d]) break;
2248*3f27d899SToby Isaac         if (d < nodeIdxDim) break;
2249*3f27d899SToby Isaac       }
2250*3f27d899SToby Isaac       if (m < nEnd) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Dofs with same index after symmetry not same block size");
2251*3f27d899SToby Isaac     }
2252*3f27d899SToby Isaac #endif
2253*3f27d899SToby Isaac     groupSize = nEnd - n;
2254*3f27d899SToby Isaac     for (m = n; m < nEnd; m++) nnz[permOrnt[m]] = groupSize;
2255*3f27d899SToby Isaac 
2256*3f27d899SToby Isaac     maxGroupSize = PetscMax(maxGroupSize, nEnd - n);
2257*3f27d899SToby Isaac     /* permOrnt[[n, nEnd)] is a group of dofs that, under the symmetry are at the same location */
2258*3f27d899SToby Isaac     n = nEnd;
2259*3f27d899SToby Isaac   }
2260*3f27d899SToby Isaac   if (maxGroupSize > nodeVecDim) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Dofs are not in blocks that can be solved");
2261*3f27d899SToby Isaac   ierr = MatCreateSeqAIJ(PETSC_COMM_SELF, nNodes, nNodes, 0, nnz, &A);CHKERRQ(ierr);
2262*3f27d899SToby Isaac   ierr = PetscFree(nnz);CHKERRQ(ierr);
2263*3f27d899SToby Isaac   ierr = PetscMalloc3(maxGroupSize * nodeVecDim, &V, maxGroupSize * nodeVecDim, &W, nodeVecDim * 2, &work);CHKERRQ(ierr);
2264*3f27d899SToby Isaac   for (n = 0; n < nNodes;) { /* incremented in the loop */
2265*3f27d899SToby Isaac     PetscInt *nind = &(ni->nodeIdx[permOrnt[n] * nodeIdxDim]);
2266*3f27d899SToby Isaac     PetscInt nEnd;
2267*3f27d899SToby Isaac     PetscInt m;
2268*3f27d899SToby Isaac     PetscInt groupSize;
2269*3f27d899SToby Isaac     for (nEnd = n + 1; nEnd < nNodes; nEnd++) {
2270*3f27d899SToby Isaac       PetscInt *mind = &(ni->nodeIdx[permOrnt[nEnd] * nodeIdxDim]);
2271*3f27d899SToby Isaac       PetscInt d;
2272*3f27d899SToby Isaac 
2273*3f27d899SToby Isaac       /* compare the oriented permutation indices */
2274*3f27d899SToby Isaac       for (d = 0; d < nodeIdxDim; d++) if (mind[d] != nind[d]) break;
2275*3f27d899SToby Isaac       if (d < nodeIdxDim) break;
2276*3f27d899SToby Isaac     }
2277*3f27d899SToby Isaac     groupSize = nEnd - n;
2278*3f27d899SToby Isaac     /* get all of the vectors from the original */
2279*3f27d899SToby Isaac     for (m = n; m < nEnd; m++) {
2280*3f27d899SToby Isaac       PetscInt d;
2281*3f27d899SToby Isaac 
2282*3f27d899SToby Isaac       for (d = 0; d < nodeVecDim; d++) {
2283*3f27d899SToby Isaac         V[(m - n) * nodeVecDim + d] = intNodeIndices->nodeVec[perm[m] * nodeVecDim + d];
2284*3f27d899SToby Isaac         W[(m - n) * nodeVecDim + d] = ni->nodeVec[permOrnt[m] * nodeVecDim + d];
2285*3f27d899SToby Isaac       }
2286*3f27d899SToby Isaac     }
2287*3f27d899SToby Isaac     /* now we have to solve for W in terms of V */
2288*3f27d899SToby Isaac     {
2289*3f27d899SToby Isaac       char transpose = 'N';
2290*3f27d899SToby Isaac       PetscBLASInt bm = nodeVecDim;
2291*3f27d899SToby Isaac       PetscBLASInt bn = groupSize;
2292*3f27d899SToby Isaac       PetscBLASInt bnrhs = groupSize;
2293*3f27d899SToby Isaac       PetscBLASInt blda = bm;
2294*3f27d899SToby Isaac       PetscBLASInt bldb = bm;
2295*3f27d899SToby Isaac       PetscBLASInt blwork = 2 * nodeVecDim;
2296*3f27d899SToby Isaac       PetscBLASInt info;
2297*3f27d899SToby Isaac 
2298*3f27d899SToby Isaac       PetscStackCallBLAS("LAPACKgels",LAPACKgels_(&transpose,&bm,&bn,&bnrhs,V,&blda,W,&bldb,work,&blwork, &info));
2299*3f27d899SToby Isaac       if (info != 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad argument to GELS");
2300*3f27d899SToby Isaac       /* repack */
2301*3f27d899SToby Isaac       {
2302*3f27d899SToby Isaac         PetscInt i, j;
2303*3f27d899SToby Isaac 
2304*3f27d899SToby Isaac         for (i = 0; i < groupSize; i++) {
2305*3f27d899SToby Isaac           for (j = 0; j < groupSize; j++) {
2306*3f27d899SToby Isaac             V[i * groupSize + j] = W[i * nodeVecDim + j];
2307*3f27d899SToby Isaac           }
2308*3f27d899SToby Isaac         }
2309*3f27d899SToby Isaac       }
2310*3f27d899SToby Isaac     }
2311*3f27d899SToby Isaac     ierr = MatSetValues(A, groupSize, &permOrnt[n], groupSize, &perm[n], V, INSERT_VALUES);CHKERRQ(ierr);
2312*3f27d899SToby Isaac     /* permOrnt[[n, nEnd)] is a group of dofs that, under the symmetry are at the same location */
2313*3f27d899SToby Isaac     n = nEnd;
2314*3f27d899SToby Isaac   }
2315*3f27d899SToby Isaac   ierr = MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2316*3f27d899SToby Isaac   ierr = MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2317*3f27d899SToby Isaac   *symMat = A;
2318*3f27d899SToby Isaac   ierr = PetscFree3(V,W,work);CHKERRQ(ierr);
2319*3f27d899SToby Isaac   ierr = PetscLagNodeIndicesDestroy(&ni);CHKERRQ(ierr);
23206f905325SMatthew G. Knepley   PetscFunctionReturn(0);
23216f905325SMatthew G. Knepley }
232220cf1dd8SToby Isaac 
232320cf1dd8SToby Isaac #define BaryIndex(perEdge,a,b,c) (((b)*(2*perEdge+1-(b)))/2)+(c)
232420cf1dd8SToby Isaac 
232520cf1dd8SToby Isaac #define CartIndex(perEdge,a,b) (perEdge*(a)+b)
232620cf1dd8SToby Isaac 
232720cf1dd8SToby Isaac static PetscErrorCode PetscDualSpaceGetSymmetries_Lagrange(PetscDualSpace sp, const PetscInt ****perms, const PetscScalar ****flips)
232820cf1dd8SToby Isaac {
232920cf1dd8SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2330*3f27d899SToby Isaac   PetscInt           dim, order, Nc;
233120cf1dd8SToby Isaac   PetscErrorCode     ierr;
233220cf1dd8SToby Isaac 
233320cf1dd8SToby Isaac   PetscFunctionBegin;
233420cf1dd8SToby Isaac   ierr = PetscDualSpaceGetOrder(sp,&order);CHKERRQ(ierr);
233520cf1dd8SToby Isaac   ierr = PetscDualSpaceGetNumComponents(sp,&Nc);CHKERRQ(ierr);
233620cf1dd8SToby Isaac   ierr = DMGetDimension(sp->dm,&dim);CHKERRQ(ierr);
2337*3f27d899SToby Isaac   if (!lag->symComputed) { /* store symmetries */
2338*3f27d899SToby Isaac     PetscInt       pStart, pEnd, p;
2339*3f27d899SToby Isaac     PetscInt       numPoints;
234020cf1dd8SToby Isaac     PetscInt       numFaces;
2341*3f27d899SToby Isaac     PetscInt       spintdim;
2342*3f27d899SToby Isaac     PetscInt       ***symperms;
2343*3f27d899SToby Isaac     PetscScalar    ***symflips;
234420cf1dd8SToby Isaac 
2345*3f27d899SToby Isaac     ierr = DMPlexGetChart(sp->dm, &pStart, &pEnd);CHKERRQ(ierr);
2346*3f27d899SToby Isaac     numPoints = pEnd - pStart;
2347*3f27d899SToby Isaac     ierr = DMPlexGetConeSize(sp->dm, 0, &numFaces);CHKERRQ(ierr);
2348*3f27d899SToby Isaac     ierr = PetscCalloc1(numPoints,&symperms);CHKERRQ(ierr);
2349*3f27d899SToby Isaac     ierr = PetscCalloc1(numPoints,&symflips);CHKERRQ(ierr);
2350*3f27d899SToby Isaac     spintdim = sp->spintdim;
2351*3f27d899SToby Isaac     /* The nodal symmetry behavior is not present when tensorSpace != tensorCell: someone might want this for the "S"
2352*3f27d899SToby Isaac      * family of FEEC spaces.  Most used in particular are discontinuous polynomial L2 spaces in tensor cells, where
2353*3f27d899SToby Isaac      * the symmetries are not necessary for FE assembly.  So for now we assume this is the case and don't return
2354*3f27d899SToby Isaac      * symmetries if tensorSpace != tensorCell */
2355*3f27d899SToby Isaac     if (spintdim && 0 < dim && dim < 3 && (lag->tensorSpace == lag->tensorCell)) { /* compute self symmetries */
2356*3f27d899SToby Isaac       PetscInt **cellSymperms;
2357*3f27d899SToby Isaac       PetscScalar **cellSymflips;
2358*3f27d899SToby Isaac       PetscInt ornt;
2359*3f27d899SToby Isaac       PetscInt nCopies = Nc / lag->intNodeIndices->nodeVecDim;
2360*3f27d899SToby Isaac       PetscInt nNodes = lag->intNodeIndices->nNodes;
236120cf1dd8SToby Isaac 
236220cf1dd8SToby Isaac       lag->numSelfSym = 2 * numFaces;
236320cf1dd8SToby Isaac       lag->selfSymOff = numFaces;
2364*3f27d899SToby Isaac       ierr = PetscCalloc1(2*numFaces,&cellSymperms);CHKERRQ(ierr);
2365*3f27d899SToby Isaac       ierr = PetscCalloc1(2*numFaces,&cellSymflips);CHKERRQ(ierr);
236620cf1dd8SToby Isaac       /* we want to be able to index symmetries directly with the orientations, which range from [-numFaces,numFaces) */
2367*3f27d899SToby Isaac       symperms[0] = &cellSymperms[numFaces];
2368*3f27d899SToby Isaac       symflips[0] = &cellSymflips[numFaces];
2369*3f27d899SToby Isaac       if (lag->intNodeIndices->nodeVecDim * nCopies != Nc) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Node indices incompatible with dofs");
2370*3f27d899SToby Isaac       if (nNodes * nCopies != spintdim) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Node indices incompatible with dofs");
2371*3f27d899SToby 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 */
2372*3f27d899SToby Isaac         Mat symMat;
2373*3f27d899SToby Isaac         PetscInt *perm;
2374*3f27d899SToby Isaac         PetscScalar *flips;
2375*3f27d899SToby Isaac         PetscInt i;
237620cf1dd8SToby Isaac 
2377*3f27d899SToby Isaac         if (!ornt) continue;
2378*3f27d899SToby Isaac         ierr = PetscMalloc1(spintdim, &perm);CHKERRQ(ierr);
2379*3f27d899SToby Isaac         ierr = PetscCalloc1(spintdim, &flips);CHKERRQ(ierr);
2380*3f27d899SToby Isaac         for (i = 0; i < spintdim; i++) perm[i] = -1;
2381*3f27d899SToby Isaac         ierr = PetscDualSpaceCreateInteriorSymmetryMatrix_Lagrange(sp, ornt, &symMat);CHKERRQ(ierr);
2382*3f27d899SToby Isaac         for (i = 0; i < nNodes; i++) {
2383*3f27d899SToby Isaac           PetscInt ncols;
2384*3f27d899SToby Isaac           PetscInt j, k;
2385*3f27d899SToby Isaac           const PetscInt *cols;
2386*3f27d899SToby Isaac           const PetscScalar *vals;
2387*3f27d899SToby Isaac           PetscBool nz_seen = PETSC_FALSE;
238820cf1dd8SToby Isaac 
2389*3f27d899SToby Isaac           ierr = MatGetRow(symMat, i, &ncols, &cols, &vals);CHKERRQ(ierr);
2390*3f27d899SToby Isaac           for (j = 0; j < ncols; j++) {
2391*3f27d899SToby Isaac             if (PetscAbsScalar(vals[j]) > PETSC_SMALL) {
2392*3f27d899SToby Isaac               if (nz_seen) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips");
2393*3f27d899SToby Isaac               nz_seen = PETSC_TRUE;
2394*3f27d899SToby Isaac               if (PetscAbsScalar(PetscAbsScalar(vals[j]) - 1.) > PETSC_SMALL) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips");
2395*3f27d899SToby Isaac               if (PetscAbsReal(PetscImaginaryPart(vals[j])) > PETSC_SMALL) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips");
2396*3f27d899SToby Isaac               if (perm[cols[j] * nCopies] >= 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips");
2397*3f27d899SToby Isaac               for (k = 0; k < nCopies; k++) {
2398*3f27d899SToby Isaac                 perm[cols[j] * nCopies + k] = i * nCopies + k;
239920cf1dd8SToby Isaac               }
2400*3f27d899SToby Isaac               if (PetscRealPart(vals[j]) < 0.) {
2401*3f27d899SToby Isaac                 for (k = 0; k < nCopies; k++) {
2402*3f27d899SToby Isaac                   flips[i * nCopies + k] = -1.;
240320cf1dd8SToby Isaac                 }
240420cf1dd8SToby Isaac               } else {
2405*3f27d899SToby Isaac                 for (k = 0; k < nCopies; k++) {
2406*3f27d899SToby Isaac                   flips[i * nCopies + k] = 1.;
2407*3f27d899SToby Isaac                 }
2408*3f27d899SToby Isaac               }
2409*3f27d899SToby Isaac             }
2410*3f27d899SToby Isaac           }
2411*3f27d899SToby Isaac           ierr = MatRestoreRow(symMat, i, &ncols, &cols, &vals);CHKERRQ(ierr);
2412*3f27d899SToby Isaac         }
2413*3f27d899SToby Isaac         ierr = MatDestroy(&symMat);CHKERRQ(ierr);
2414*3f27d899SToby Isaac         /* if there were no sign flips, keep NULL */
2415*3f27d899SToby Isaac         for (i = 0; i < spintdim; i++) if (flips[i] != 1.) break;
2416*3f27d899SToby Isaac         if (i == spintdim) {
2417*3f27d899SToby Isaac           ierr = PetscFree(flips);CHKERRQ(ierr);
2418*3f27d899SToby Isaac           flips = NULL;
2419*3f27d899SToby Isaac         }
2420*3f27d899SToby Isaac         /* if the permutation is identity, keep NULL */
2421*3f27d899SToby Isaac         for (i = 0; i < spintdim; i++) if (perm[i] != i) break;
2422*3f27d899SToby Isaac         if (i == spintdim) {
2423*3f27d899SToby Isaac           ierr = PetscFree(perm);CHKERRQ(ierr);
2424*3f27d899SToby Isaac           perm = NULL;
2425*3f27d899SToby Isaac         }
2426*3f27d899SToby Isaac         symperms[0][ornt] = perm;
2427*3f27d899SToby Isaac         symflips[0][ornt] = flips;
2428*3f27d899SToby Isaac       }
2429*3f27d899SToby Isaac       /* if no orientations produced non-identity permutations, keep NULL */
2430*3f27d899SToby Isaac       for (ornt = -numFaces; ornt < numFaces; ornt++) if (symperms[0][ornt]) break;
2431*3f27d899SToby Isaac       if (ornt == numFaces) {
2432*3f27d899SToby Isaac         ierr = PetscFree(cellSymperms);CHKERRQ(ierr);
2433*3f27d899SToby Isaac         symperms[0] = NULL;
2434*3f27d899SToby Isaac       }
2435*3f27d899SToby Isaac       /* if no orientations produced sign flips, keep NULL */
2436*3f27d899SToby Isaac       for (ornt = -numFaces; ornt < numFaces; ornt++) if (symflips[0][ornt]) break;
2437*3f27d899SToby Isaac       if (ornt == numFaces) {
2438*3f27d899SToby Isaac         ierr = PetscFree(cellSymflips);CHKERRQ(ierr);
2439*3f27d899SToby Isaac         symflips[0] = NULL;
2440*3f27d899SToby Isaac       }
2441*3f27d899SToby Isaac     }
2442*3f27d899SToby Isaac     {
2443*3f27d899SToby Isaac       PetscInt closureSize = 0;
2444*3f27d899SToby Isaac       PetscInt *closure = NULL;
2445*3f27d899SToby Isaac       PetscInt r;
244620cf1dd8SToby Isaac 
2447*3f27d899SToby Isaac       ierr = DMPlexGetTransitiveClosure(sp->dm,0,PETSC_TRUE,&closureSize,&closure);CHKERRQ(ierr);
2448*3f27d899SToby Isaac       for (r = 0; r < closureSize; r++) {
2449*3f27d899SToby Isaac         PetscDualSpace psp;
2450*3f27d899SToby Isaac         PetscInt point = closure[2 * r];
2451*3f27d899SToby Isaac         PetscInt pspintdim;
2452*3f27d899SToby Isaac         const PetscInt ***psymperms = NULL;
2453*3f27d899SToby Isaac         const PetscScalar ***psymflips = NULL;
245420cf1dd8SToby Isaac 
2455*3f27d899SToby Isaac         if (!point) continue;
2456*3f27d899SToby Isaac         ierr = PetscDualSpaceGetPointSubspace(sp, point, &psp);CHKERRQ(ierr);
2457*3f27d899SToby Isaac         if (!psp) continue;
2458*3f27d899SToby Isaac         ierr = PetscDualSpaceGetInteriorDimension(psp, &pspintdim);CHKERRQ(ierr);
2459*3f27d899SToby Isaac         if (!pspintdim) continue;
2460*3f27d899SToby Isaac         ierr = PetscDualSpaceGetSymmetries(psp,&psymperms,&psymflips);CHKERRQ(ierr);
2461*3f27d899SToby Isaac         symperms[r] = (PetscInt **) (psymperms ? psymperms[0] : NULL);
2462*3f27d899SToby Isaac         symflips[r] = (PetscScalar **) (psymflips ? psymflips[0] : NULL);
246320cf1dd8SToby Isaac       }
2464*3f27d899SToby Isaac       ierr = DMPlexRestoreTransitiveClosure(sp->dm,0,PETSC_TRUE,&closureSize,&closure);CHKERRQ(ierr);
246520cf1dd8SToby Isaac     }
2466*3f27d899SToby Isaac     for (p = 0; p < pEnd; p++) if (symperms[p]) break;
2467*3f27d899SToby Isaac     if (p == pEnd) {
2468*3f27d899SToby Isaac       ierr = PetscFree(symperms);CHKERRQ(ierr);
2469*3f27d899SToby Isaac       symperms = NULL;
247020cf1dd8SToby Isaac     }
2471*3f27d899SToby Isaac     for (p = 0; p < pEnd; p++) if (symflips[p]) break;
2472*3f27d899SToby Isaac     if (p == pEnd) {
2473*3f27d899SToby Isaac       ierr = PetscFree(symflips);CHKERRQ(ierr);
2474*3f27d899SToby Isaac       symflips = NULL;
247520cf1dd8SToby Isaac     }
2476*3f27d899SToby Isaac     lag->symperms = symperms;
2477*3f27d899SToby Isaac     lag->symflips = symflips;
2478*3f27d899SToby Isaac     lag->symComputed = PETSC_TRUE;
247920cf1dd8SToby Isaac   }
2480*3f27d899SToby Isaac   if (perms) *perms = (const PetscInt ***) lag->symperms;
2481*3f27d899SToby Isaac   if (flips) *flips = (const PetscScalar ***) lag->symflips;
248220cf1dd8SToby Isaac   PetscFunctionReturn(0);
248320cf1dd8SToby Isaac }
248420cf1dd8SToby Isaac 
248520cf1dd8SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeGetContinuity_Lagrange(PetscDualSpace sp, PetscBool *continuous)
248620cf1dd8SToby Isaac {
248720cf1dd8SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
248820cf1dd8SToby Isaac 
248920cf1dd8SToby Isaac   PetscFunctionBegin;
249020cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
249120cf1dd8SToby Isaac   PetscValidPointer(continuous, 2);
249220cf1dd8SToby Isaac   *continuous = lag->continuous;
249320cf1dd8SToby Isaac   PetscFunctionReturn(0);
249420cf1dd8SToby Isaac }
249520cf1dd8SToby Isaac 
249620cf1dd8SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeSetContinuity_Lagrange(PetscDualSpace sp, PetscBool continuous)
249720cf1dd8SToby Isaac {
249820cf1dd8SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
249920cf1dd8SToby Isaac 
250020cf1dd8SToby Isaac   PetscFunctionBegin;
250120cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
250220cf1dd8SToby Isaac   lag->continuous = continuous;
250320cf1dd8SToby Isaac   PetscFunctionReturn(0);
250420cf1dd8SToby Isaac }
250520cf1dd8SToby Isaac 
250620cf1dd8SToby Isaac /*@
250720cf1dd8SToby Isaac   PetscDualSpaceLagrangeGetContinuity - Retrieves the flag for element continuity
250820cf1dd8SToby Isaac 
250920cf1dd8SToby Isaac   Not Collective
251020cf1dd8SToby Isaac 
251120cf1dd8SToby Isaac   Input Parameter:
251220cf1dd8SToby Isaac . sp         - the PetscDualSpace
251320cf1dd8SToby Isaac 
251420cf1dd8SToby Isaac   Output Parameter:
251520cf1dd8SToby Isaac . continuous - flag for element continuity
251620cf1dd8SToby Isaac 
251720cf1dd8SToby Isaac   Level: intermediate
251820cf1dd8SToby Isaac 
251920cf1dd8SToby Isaac .seealso: PetscDualSpaceLagrangeSetContinuity()
252020cf1dd8SToby Isaac @*/
252120cf1dd8SToby Isaac PetscErrorCode PetscDualSpaceLagrangeGetContinuity(PetscDualSpace sp, PetscBool *continuous)
252220cf1dd8SToby Isaac {
252320cf1dd8SToby Isaac   PetscErrorCode ierr;
252420cf1dd8SToby Isaac 
252520cf1dd8SToby Isaac   PetscFunctionBegin;
252620cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
252720cf1dd8SToby Isaac   PetscValidPointer(continuous, 2);
252820cf1dd8SToby Isaac   ierr = PetscTryMethod(sp, "PetscDualSpaceLagrangeGetContinuity_C", (PetscDualSpace,PetscBool*),(sp,continuous));CHKERRQ(ierr);
252920cf1dd8SToby Isaac   PetscFunctionReturn(0);
253020cf1dd8SToby Isaac }
253120cf1dd8SToby Isaac 
253220cf1dd8SToby Isaac /*@
253320cf1dd8SToby Isaac   PetscDualSpaceLagrangeSetContinuity - Indicate whether the element is continuous
253420cf1dd8SToby Isaac 
2535d083f849SBarry Smith   Logically Collective on sp
253620cf1dd8SToby Isaac 
253720cf1dd8SToby Isaac   Input Parameters:
253820cf1dd8SToby Isaac + sp         - the PetscDualSpace
253920cf1dd8SToby Isaac - continuous - flag for element continuity
254020cf1dd8SToby Isaac 
254120cf1dd8SToby Isaac   Options Database:
254220cf1dd8SToby Isaac . -petscdualspace_lagrange_continuity <bool>
254320cf1dd8SToby Isaac 
254420cf1dd8SToby Isaac   Level: intermediate
254520cf1dd8SToby Isaac 
254620cf1dd8SToby Isaac .seealso: PetscDualSpaceLagrangeGetContinuity()
254720cf1dd8SToby Isaac @*/
254820cf1dd8SToby Isaac PetscErrorCode PetscDualSpaceLagrangeSetContinuity(PetscDualSpace sp, PetscBool continuous)
254920cf1dd8SToby Isaac {
255020cf1dd8SToby Isaac   PetscErrorCode ierr;
255120cf1dd8SToby Isaac 
255220cf1dd8SToby Isaac   PetscFunctionBegin;
255320cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
255420cf1dd8SToby Isaac   PetscValidLogicalCollectiveBool(sp, continuous, 2);
255520cf1dd8SToby Isaac   ierr = PetscTryMethod(sp, "PetscDualSpaceLagrangeSetContinuity_C", (PetscDualSpace,PetscBool),(sp,continuous));CHKERRQ(ierr);
255620cf1dd8SToby Isaac   PetscFunctionReturn(0);
255720cf1dd8SToby Isaac }
255820cf1dd8SToby Isaac 
25596f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceLagrangeGetTensor_Lagrange(PetscDualSpace sp, PetscBool *tensor)
256020cf1dd8SToby Isaac {
256120cf1dd8SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
25626f905325SMatthew G. Knepley 
25636f905325SMatthew G. Knepley   PetscFunctionBegin;
25646f905325SMatthew G. Knepley   *tensor = lag->tensorSpace;
25656f905325SMatthew G. Knepley   PetscFunctionReturn(0);
25666f905325SMatthew G. Knepley }
25676f905325SMatthew G. Knepley 
25686f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceLagrangeSetTensor_Lagrange(PetscDualSpace sp, PetscBool tensor)
25696f905325SMatthew G. Knepley {
25706f905325SMatthew G. Knepley   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
25716f905325SMatthew G. Knepley 
25726f905325SMatthew G. Knepley   PetscFunctionBegin;
25736f905325SMatthew G. Knepley   lag->tensorSpace = tensor;
25746f905325SMatthew G. Knepley   PetscFunctionReturn(0);
25756f905325SMatthew G. Knepley }
25766f905325SMatthew G. Knepley 
2577*3f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeGetTrimmed_Lagrange(PetscDualSpace sp, PetscBool *trimmed)
2578*3f27d899SToby Isaac {
2579*3f27d899SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2580*3f27d899SToby Isaac 
2581*3f27d899SToby Isaac   PetscFunctionBegin;
2582*3f27d899SToby Isaac   *trimmed = lag->trimmed;
2583*3f27d899SToby Isaac   PetscFunctionReturn(0);
2584*3f27d899SToby Isaac }
2585*3f27d899SToby Isaac 
2586*3f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeSetTrimmed_Lagrange(PetscDualSpace sp, PetscBool trimmed)
2587*3f27d899SToby Isaac {
2588*3f27d899SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2589*3f27d899SToby Isaac 
2590*3f27d899SToby Isaac   PetscFunctionBegin;
2591*3f27d899SToby Isaac   lag->trimmed = trimmed;
2592*3f27d899SToby Isaac   PetscFunctionReturn(0);
2593*3f27d899SToby Isaac }
2594*3f27d899SToby Isaac 
2595*3f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeGetNodeType_Lagrange(PetscDualSpace sp, PetscDTNodeType *nodeType, PetscBool *boundary, PetscReal *exponent)
2596*3f27d899SToby Isaac {
2597*3f27d899SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2598*3f27d899SToby Isaac 
2599*3f27d899SToby Isaac   PetscFunctionBegin;
2600*3f27d899SToby Isaac   if (nodeType) *nodeType = lag->nodeType;
2601*3f27d899SToby Isaac   if (boundary) *boundary = lag->endNodes;
2602*3f27d899SToby Isaac   if (exponent) *exponent = lag->nodeExponent;
2603*3f27d899SToby Isaac   PetscFunctionReturn(0);
2604*3f27d899SToby Isaac }
2605*3f27d899SToby Isaac 
2606*3f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeSetNodeType_Lagrange(PetscDualSpace sp, PetscDTNodeType nodeType, PetscBool boundary, PetscReal exponent)
2607*3f27d899SToby Isaac {
2608*3f27d899SToby Isaac   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2609*3f27d899SToby Isaac 
2610*3f27d899SToby Isaac   PetscFunctionBegin;
2611*3f27d899SToby Isaac   if (nodeType == PETSCDTNODES_GAUSSJACOBI && exponent <= -1.) SETERRQ(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_OUTOFRANGE, "Exponent must be > -1");
2612*3f27d899SToby Isaac   lag->nodeType = nodeType;
2613*3f27d899SToby Isaac   lag->endNodes = boundary;
2614*3f27d899SToby Isaac   lag->nodeExponent = exponent;
2615*3f27d899SToby Isaac   PetscFunctionReturn(0);
2616*3f27d899SToby Isaac }
2617*3f27d899SToby Isaac 
26186f905325SMatthew G. Knepley /*@
26196f905325SMatthew G. Knepley   PetscDualSpaceLagrangeGetTensor - Get the tensor nature of the dual space
26206f905325SMatthew G. Knepley 
26216f905325SMatthew G. Knepley   Not collective
26226f905325SMatthew G. Knepley 
26236f905325SMatthew G. Knepley   Input Parameter:
26246f905325SMatthew G. Knepley . sp - The PetscDualSpace
26256f905325SMatthew G. Knepley 
26266f905325SMatthew G. Knepley   Output Parameter:
26276f905325SMatthew G. Knepley . tensor - Whether the dual space has tensor layout (vs. simplicial)
26286f905325SMatthew G. Knepley 
26296f905325SMatthew G. Knepley   Level: intermediate
26306f905325SMatthew G. Knepley 
26316f905325SMatthew G. Knepley .seealso: PetscDualSpaceLagrangeSetTensor(), PetscDualSpaceCreate()
26326f905325SMatthew G. Knepley @*/
26336f905325SMatthew G. Knepley PetscErrorCode PetscDualSpaceLagrangeGetTensor(PetscDualSpace sp, PetscBool *tensor)
26346f905325SMatthew G. Knepley {
263520cf1dd8SToby Isaac   PetscErrorCode ierr;
263620cf1dd8SToby Isaac 
263720cf1dd8SToby Isaac   PetscFunctionBegin;
263820cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
26396f905325SMatthew G. Knepley   PetscValidPointer(tensor, 2);
26406f905325SMatthew G. Knepley   ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeGetTensor_C",(PetscDualSpace,PetscBool *),(sp,tensor));CHKERRQ(ierr);
264120cf1dd8SToby Isaac   PetscFunctionReturn(0);
264220cf1dd8SToby Isaac }
264320cf1dd8SToby Isaac 
26446f905325SMatthew G. Knepley /*@
26456f905325SMatthew G. Knepley   PetscDualSpaceLagrangeSetTensor - Set the tensor nature of the dual space
26466f905325SMatthew G. Knepley 
26476f905325SMatthew G. Knepley   Not collective
26486f905325SMatthew G. Knepley 
26496f905325SMatthew G. Knepley   Input Parameters:
26506f905325SMatthew G. Knepley + sp - The PetscDualSpace
26516f905325SMatthew G. Knepley - tensor - Whether the dual space has tensor layout (vs. simplicial)
26526f905325SMatthew G. Knepley 
26536f905325SMatthew G. Knepley   Level: intermediate
26546f905325SMatthew G. Knepley 
26556f905325SMatthew G. Knepley .seealso: PetscDualSpaceLagrangeGetTensor(), PetscDualSpaceCreate()
26566f905325SMatthew G. Knepley @*/
26576f905325SMatthew G. Knepley PetscErrorCode PetscDualSpaceLagrangeSetTensor(PetscDualSpace sp, PetscBool tensor)
26586f905325SMatthew G. Knepley {
26596f905325SMatthew G. Knepley   PetscErrorCode ierr;
26606f905325SMatthew G. Knepley 
26616f905325SMatthew G. Knepley   PetscFunctionBegin;
26626f905325SMatthew G. Knepley   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
26636f905325SMatthew G. Knepley   ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeSetTensor_C",(PetscDualSpace,PetscBool),(sp,tensor));CHKERRQ(ierr);
26646f905325SMatthew G. Knepley   PetscFunctionReturn(0);
26656f905325SMatthew G. Knepley }
26666f905325SMatthew G. Knepley 
2667*3f27d899SToby Isaac /*@
2668*3f27d899SToby Isaac   PetscDualSpaceLagrangeGetTrimmed - Get the trimmed nature of the dual space
2669*3f27d899SToby Isaac 
2670*3f27d899SToby Isaac   Not collective
2671*3f27d899SToby Isaac 
2672*3f27d899SToby Isaac   Input Parameter:
2673*3f27d899SToby Isaac . sp - The PetscDualSpace
2674*3f27d899SToby Isaac 
2675*3f27d899SToby Isaac   Output Parameter:
2676*3f27d899SToby 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)
2677*3f27d899SToby Isaac 
2678*3f27d899SToby Isaac   Level: intermediate
2679*3f27d899SToby Isaac 
2680*3f27d899SToby Isaac .seealso: PetscDualSpaceLagrangeSetTrimmed(), PetscDualSpaceCreate()
2681*3f27d899SToby Isaac @*/
2682*3f27d899SToby Isaac PetscErrorCode PetscDualSpaceLagrangeGetTrimmed(PetscDualSpace sp, PetscBool *trimmed)
2683*3f27d899SToby Isaac {
2684*3f27d899SToby Isaac   PetscErrorCode ierr;
2685*3f27d899SToby Isaac 
2686*3f27d899SToby Isaac   PetscFunctionBegin;
2687*3f27d899SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
2688*3f27d899SToby Isaac   PetscValidPointer(trimmed, 2);
2689*3f27d899SToby Isaac   ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeGetTrimmed_C",(PetscDualSpace,PetscBool *),(sp,trimmed));CHKERRQ(ierr);
2690*3f27d899SToby Isaac   PetscFunctionReturn(0);
2691*3f27d899SToby Isaac }
2692*3f27d899SToby Isaac 
2693*3f27d899SToby Isaac /*@
2694*3f27d899SToby Isaac   PetscDualSpaceLagrangeSetTrimmed - Set the trimmed nature of the dual space
2695*3f27d899SToby Isaac 
2696*3f27d899SToby Isaac   Not collective
2697*3f27d899SToby Isaac 
2698*3f27d899SToby Isaac   Input Parameters:
2699*3f27d899SToby Isaac + sp - The PetscDualSpace
2700*3f27d899SToby 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)
2701*3f27d899SToby Isaac 
2702*3f27d899SToby Isaac   Level: intermediate
2703*3f27d899SToby Isaac 
2704*3f27d899SToby Isaac .seealso: PetscDualSpaceLagrangeGetTrimmed(), PetscDualSpaceCreate()
2705*3f27d899SToby Isaac @*/
2706*3f27d899SToby Isaac PetscErrorCode PetscDualSpaceLagrangeSetTrimmed(PetscDualSpace sp, PetscBool trimmed)
2707*3f27d899SToby Isaac {
2708*3f27d899SToby Isaac   PetscErrorCode ierr;
2709*3f27d899SToby Isaac 
2710*3f27d899SToby Isaac   PetscFunctionBegin;
2711*3f27d899SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
2712*3f27d899SToby Isaac   ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeSetTrimmed_C",(PetscDualSpace,PetscBool),(sp,trimmed));CHKERRQ(ierr);
2713*3f27d899SToby Isaac   PetscFunctionReturn(0);
2714*3f27d899SToby Isaac }
2715*3f27d899SToby Isaac 
2716*3f27d899SToby Isaac /*@
2717*3f27d899SToby Isaac   PetscDualSpaceLagrangeGetNodeType - Get a description of how nodes are laid out for Lagrange polynomials in this
2718*3f27d899SToby Isaac   dual space
2719*3f27d899SToby Isaac 
2720*3f27d899SToby Isaac   Not collective
2721*3f27d899SToby Isaac 
2722*3f27d899SToby Isaac   Input Parameter:
2723*3f27d899SToby Isaac . sp - The PetscDualSpace
2724*3f27d899SToby Isaac 
2725*3f27d899SToby Isaac   Output Parameters:
2726*3f27d899SToby Isaac + nodeType - The type of nodes
2727*3f27d899SToby Isaac . boundary - Whether the node type is one that includes endpoints (if nodeType is PETSCDTNODES_GAUSSJACOBI, nodes that
2728*3f27d899SToby Isaac              include the boundary are Gauss-Lobatto-Jacobi nodes)
2729*3f27d899SToby Isaac - exponent - If nodeType is PETSCDTNODES_GAUSJACOBI, indicates the exponent used for both ends of the 1D Jacobi weight function
2730*3f27d899SToby Isaac              '0' is Gauss-Legendre, '-0.5' is Gauss-Chebyshev of the first type, '0.5' is Gauss-Chebyshev of the second type
2731*3f27d899SToby Isaac 
2732*3f27d899SToby Isaac   Level: advanced
2733*3f27d899SToby Isaac 
2734*3f27d899SToby Isaac .seealso: PetscDTNodeType, PetscDualSpaceLagrangeSetNodeType()
2735*3f27d899SToby Isaac @*/
2736*3f27d899SToby Isaac PetscErrorCode PetscDualSpaceLagrangeGetNodeType(PetscDualSpace sp, PetscDTNodeType *nodeType, PetscBool *boundary, PetscReal *exponent)
2737*3f27d899SToby Isaac {
2738*3f27d899SToby Isaac   PetscErrorCode ierr;
2739*3f27d899SToby Isaac 
2740*3f27d899SToby Isaac   PetscFunctionBegin;
2741*3f27d899SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
2742*3f27d899SToby Isaac   if (nodeType) PetscValidPointer(nodeType, 2);
2743*3f27d899SToby Isaac   if (boundary) PetscValidPointer(boundary, 3);
2744*3f27d899SToby Isaac   if (exponent) PetscValidPointer(exponent, 4);
2745*3f27d899SToby Isaac   ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeGetNodeType_C",(PetscDualSpace,PetscDTNodeType *,PetscBool *,PetscReal *),(sp,nodeType,boundary,exponent));CHKERRQ(ierr);
2746*3f27d899SToby Isaac   PetscFunctionReturn(0);
2747*3f27d899SToby Isaac }
2748*3f27d899SToby Isaac 
2749*3f27d899SToby Isaac /*@
2750*3f27d899SToby Isaac   PetscDualSpaceLagrangeSetNodeType - Set a description of how nodes are laid out for Lagrange polynomials in this
2751*3f27d899SToby Isaac   dual space
2752*3f27d899SToby Isaac 
2753*3f27d899SToby Isaac   Logically collective
2754*3f27d899SToby Isaac 
2755*3f27d899SToby Isaac   Input Parameters:
2756*3f27d899SToby Isaac + sp - The PetscDualSpace
2757*3f27d899SToby Isaac . nodeType - The type of nodes
2758*3f27d899SToby Isaac . boundary - Whether the node type is one that includes endpoints (if nodeType is PETSCDTNODES_GAUSSJACOBI, nodes that
2759*3f27d899SToby Isaac              include the boundary are Gauss-Lobatto-Jacobi nodes)
2760*3f27d899SToby Isaac - exponent - If nodeType is PETSCDTNODES_GAUSJACOBI, indicates the exponent used for both ends of the 1D Jacobi weight function
2761*3f27d899SToby Isaac              '0' is Gauss-Legendre, '-0.5' is Gauss-Chebyshev of the first type, '0.5' is Gauss-Chebyshev of the second type
2762*3f27d899SToby Isaac 
2763*3f27d899SToby Isaac   Level: advanced
2764*3f27d899SToby Isaac 
2765*3f27d899SToby Isaac .seealso: PetscDTNodeType, PetscDualSpaceLagrangeGetNodeType()
2766*3f27d899SToby Isaac @*/
2767*3f27d899SToby Isaac PetscErrorCode PetscDualSpaceLagrangeSetNodeType(PetscDualSpace sp, PetscDTNodeType nodeType, PetscBool boundary, PetscReal exponent)
2768*3f27d899SToby Isaac {
2769*3f27d899SToby Isaac   PetscErrorCode ierr;
2770*3f27d899SToby Isaac 
2771*3f27d899SToby Isaac   PetscFunctionBegin;
2772*3f27d899SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
2773*3f27d899SToby Isaac   ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeSetNodeType_C",(PetscDualSpace,PetscDTNodeType,PetscBool,PetscReal),(sp,nodeType,boundary,exponent));CHKERRQ(ierr);
2774*3f27d899SToby Isaac   PetscFunctionReturn(0);
2775*3f27d899SToby Isaac }
2776*3f27d899SToby Isaac 
2777*3f27d899SToby Isaac 
27786f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp)
277920cf1dd8SToby Isaac {
278020cf1dd8SToby Isaac   PetscFunctionBegin;
278120cf1dd8SToby Isaac   sp->ops->destroy              = PetscDualSpaceDestroy_Lagrange;
27826f905325SMatthew G. Knepley   sp->ops->view                 = PetscDualSpaceView_Lagrange;
27836f905325SMatthew G. Knepley   sp->ops->setfromoptions       = PetscDualSpaceSetFromOptions_Lagrange;
278420cf1dd8SToby Isaac   sp->ops->duplicate            = PetscDualSpaceDuplicate_Lagrange;
27856f905325SMatthew G. Knepley   sp->ops->setup                = PetscDualSpaceSetUp_Lagrange;
2786*3f27d899SToby Isaac   sp->ops->createheightsubspace = NULL;
2787*3f27d899SToby Isaac   sp->ops->createpointsubspace  = NULL;
278820cf1dd8SToby Isaac   sp->ops->getsymmetries        = PetscDualSpaceGetSymmetries_Lagrange;
278920cf1dd8SToby Isaac   sp->ops->apply                = PetscDualSpaceApplyDefault;
279020cf1dd8SToby Isaac   sp->ops->applyall             = PetscDualSpaceApplyAllDefault;
2791b4457527SToby Isaac   sp->ops->applyint             = PetscDualSpaceApplyInteriorDefault;
2792*3f27d899SToby Isaac   sp->ops->createalldata        = PetscDualSpaceCreateAllDataDefault;
2793b4457527SToby Isaac   sp->ops->createintdata        = PetscDualSpaceCreateInteriorDataDefault;
279420cf1dd8SToby Isaac   PetscFunctionReturn(0);
279520cf1dd8SToby Isaac }
279620cf1dd8SToby Isaac 
279720cf1dd8SToby Isaac /*MC
279820cf1dd8SToby Isaac   PETSCDUALSPACELAGRANGE = "lagrange" - A PetscDualSpace object that encapsulates a dual space of pointwise evaluation functionals
279920cf1dd8SToby Isaac 
280020cf1dd8SToby Isaac   Level: intermediate
280120cf1dd8SToby Isaac 
280220cf1dd8SToby Isaac .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
280320cf1dd8SToby Isaac M*/
280420cf1dd8SToby Isaac PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Lagrange(PetscDualSpace sp)
280520cf1dd8SToby Isaac {
280620cf1dd8SToby Isaac   PetscDualSpace_Lag *lag;
280720cf1dd8SToby Isaac   PetscErrorCode      ierr;
280820cf1dd8SToby Isaac 
280920cf1dd8SToby Isaac   PetscFunctionBegin;
281020cf1dd8SToby Isaac   PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1);
281120cf1dd8SToby Isaac   ierr     = PetscNewLog(sp,&lag);CHKERRQ(ierr);
281220cf1dd8SToby Isaac   sp->data = lag;
281320cf1dd8SToby Isaac 
2814*3f27d899SToby Isaac   lag->tensorCell  = PETSC_FALSE;
281520cf1dd8SToby Isaac   lag->tensorSpace = PETSC_FALSE;
281620cf1dd8SToby Isaac   lag->continuous  = PETSC_TRUE;
2817*3f27d899SToby Isaac   lag->numCopies   = PETSC_DEFAULT;
2818*3f27d899SToby Isaac   lag->numNodeSkip = PETSC_DEFAULT;
2819*3f27d899SToby Isaac   lag->nodeType    = PETSCDTNODES_DEFAULT;
282020cf1dd8SToby Isaac 
282120cf1dd8SToby Isaac   ierr = PetscDualSpaceInitialize_Lagrange(sp);CHKERRQ(ierr);
282220cf1dd8SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", PetscDualSpaceLagrangeGetContinuity_Lagrange);CHKERRQ(ierr);
282320cf1dd8SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", PetscDualSpaceLagrangeSetContinuity_Lagrange);CHKERRQ(ierr);
282420cf1dd8SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", PetscDualSpaceLagrangeGetTensor_Lagrange);CHKERRQ(ierr);
282520cf1dd8SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", PetscDualSpaceLagrangeSetTensor_Lagrange);CHKERRQ(ierr);
2826*3f27d899SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTrimmed_C", PetscDualSpaceLagrangeGetTrimmed_Lagrange);CHKERRQ(ierr);
2827*3f27d899SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTrimmed_C", PetscDualSpaceLagrangeSetTrimmed_Lagrange);CHKERRQ(ierr);
2828*3f27d899SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetNodeType_C", PetscDualSpaceLagrangeGetNodeType_Lagrange);CHKERRQ(ierr);
2829*3f27d899SToby Isaac   ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetNodeType_C", PetscDualSpaceLagrangeSetNodeType_Lagrange);CHKERRQ(ierr);
283020cf1dd8SToby Isaac   PetscFunctionReturn(0);
283120cf1dd8SToby Isaac }
283220cf1dd8SToby Isaac 
2833