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