120cf1dd8SToby Isaac #include <petsc/private/petscfeimpl.h> /*I "petscfe.h" I*/ 220cf1dd8SToby Isaac #include <petscdmplex.h> 33f27d899SToby Isaac #include <petscblaslapack.h> 43f27d899SToby Isaac 53f27d899SToby Isaac PetscErrorCode DMPlexGetTransitiveClosure_Internal(DM, PetscInt, PetscInt, PetscBool, PetscInt *, PetscInt *[]); 63f27d899SToby Isaac 79371c9d4SSatish Balay struct _n_Petsc1DNodeFamily { 83f27d899SToby Isaac PetscInt refct; 93f27d899SToby Isaac PetscDTNodeType nodeFamily; 103f27d899SToby Isaac PetscReal gaussJacobiExp; 113f27d899SToby Isaac PetscInt nComputed; 123f27d899SToby Isaac PetscReal **nodesets; 133f27d899SToby Isaac PetscBool endpoints; 143f27d899SToby Isaac }; 153f27d899SToby Isaac 1677f1a120SToby Isaac /* users set node families for PETSCDUALSPACELAGRANGE with just the inputs to this function, but internally we create 1777f1a120SToby Isaac * an object that can cache the computations across multiple dual spaces */ 18d71ae5a4SJacob Faibussowitsch static PetscErrorCode Petsc1DNodeFamilyCreate(PetscDTNodeType family, PetscReal gaussJacobiExp, PetscBool endpoints, Petsc1DNodeFamily *nf) 19d71ae5a4SJacob Faibussowitsch { 203f27d899SToby Isaac Petsc1DNodeFamily f; 213f27d899SToby Isaac 223f27d899SToby Isaac PetscFunctionBegin; 239566063dSJacob Faibussowitsch PetscCall(PetscNew(&f)); 243f27d899SToby Isaac switch (family) { 253f27d899SToby Isaac case PETSCDTNODES_GAUSSJACOBI: 26d71ae5a4SJacob Faibussowitsch case PETSCDTNODES_EQUISPACED: 27d71ae5a4SJacob Faibussowitsch f->nodeFamily = family; 28d71ae5a4SJacob Faibussowitsch break; 29d71ae5a4SJacob Faibussowitsch default: 30d71ae5a4SJacob Faibussowitsch SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown 1D node family"); 313f27d899SToby Isaac } 323f27d899SToby Isaac f->endpoints = endpoints; 333f27d899SToby Isaac f->gaussJacobiExp = 0.; 343f27d899SToby Isaac if (family == PETSCDTNODES_GAUSSJACOBI) { 3508401ef6SPierre Jolivet PetscCheck(gaussJacobiExp > -1., PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Gauss-Jacobi exponent must be > -1."); 363f27d899SToby Isaac f->gaussJacobiExp = gaussJacobiExp; 373f27d899SToby Isaac } 383f27d899SToby Isaac f->refct = 1; 393f27d899SToby Isaac *nf = f; 403ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 413f27d899SToby Isaac } 423f27d899SToby Isaac 43d71ae5a4SJacob Faibussowitsch static PetscErrorCode Petsc1DNodeFamilyReference(Petsc1DNodeFamily nf) 44d71ae5a4SJacob Faibussowitsch { 453f27d899SToby Isaac PetscFunctionBegin; 463f27d899SToby Isaac if (nf) nf->refct++; 473ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 483f27d899SToby Isaac } 493f27d899SToby Isaac 50d71ae5a4SJacob Faibussowitsch static PetscErrorCode Petsc1DNodeFamilyDestroy(Petsc1DNodeFamily *nf) 51d71ae5a4SJacob Faibussowitsch { 523f27d899SToby Isaac PetscInt i, nc; 533f27d899SToby Isaac 543f27d899SToby Isaac PetscFunctionBegin; 553ba16761SJacob Faibussowitsch if (!(*nf)) PetscFunctionReturn(PETSC_SUCCESS); 563f27d899SToby Isaac if (--(*nf)->refct > 0) { 573f27d899SToby Isaac *nf = NULL; 583ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 593f27d899SToby Isaac } 603f27d899SToby Isaac nc = (*nf)->nComputed; 6148a46eb9SPierre Jolivet for (i = 0; i < nc; i++) PetscCall(PetscFree((*nf)->nodesets[i])); 629566063dSJacob Faibussowitsch PetscCall(PetscFree((*nf)->nodesets)); 639566063dSJacob Faibussowitsch PetscCall(PetscFree(*nf)); 643f27d899SToby Isaac *nf = NULL; 653ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 663f27d899SToby Isaac } 673f27d899SToby Isaac 68d71ae5a4SJacob Faibussowitsch static PetscErrorCode Petsc1DNodeFamilyGetNodeSets(Petsc1DNodeFamily f, PetscInt degree, PetscReal ***nodesets) 69d71ae5a4SJacob Faibussowitsch { 703f27d899SToby Isaac PetscInt nc; 713f27d899SToby Isaac 723f27d899SToby Isaac PetscFunctionBegin; 733f27d899SToby Isaac nc = f->nComputed; 743f27d899SToby Isaac if (degree >= nc) { 753f27d899SToby Isaac PetscInt i, j; 763f27d899SToby Isaac PetscReal **new_nodesets; 773f27d899SToby Isaac PetscReal *w; 783f27d899SToby Isaac 799566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(degree + 1, &new_nodesets)); 809566063dSJacob Faibussowitsch PetscCall(PetscArraycpy(new_nodesets, f->nodesets, nc)); 819566063dSJacob Faibussowitsch PetscCall(PetscFree(f->nodesets)); 823f27d899SToby Isaac f->nodesets = new_nodesets; 839566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(degree + 1, &w)); 843f27d899SToby Isaac for (i = nc; i < degree + 1; i++) { 859566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(i + 1, &(f->nodesets[i]))); 863f27d899SToby Isaac if (!i) { 873f27d899SToby Isaac f->nodesets[i][0] = 0.5; 883f27d899SToby Isaac } else { 893f27d899SToby Isaac switch (f->nodeFamily) { 903f27d899SToby Isaac case PETSCDTNODES_EQUISPACED: 913f27d899SToby Isaac if (f->endpoints) { 923f27d899SToby Isaac for (j = 0; j <= i; j++) f->nodesets[i][j] = (PetscReal)j / (PetscReal)i; 933f27d899SToby Isaac } else { 9477f1a120SToby Isaac /* these nodes are at the centroids of the small simplices created by the equispaced nodes that include 9577f1a120SToby Isaac * the endpoints */ 963f27d899SToby Isaac for (j = 0; j <= i; j++) f->nodesets[i][j] = ((PetscReal)j + 0.5) / ((PetscReal)i + 1.); 973f27d899SToby Isaac } 983f27d899SToby Isaac break; 993f27d899SToby Isaac case PETSCDTNODES_GAUSSJACOBI: 1003f27d899SToby Isaac if (f->endpoints) { 1019566063dSJacob Faibussowitsch PetscCall(PetscDTGaussLobattoJacobiQuadrature(i + 1, 0., 1., f->gaussJacobiExp, f->gaussJacobiExp, f->nodesets[i], w)); 1023f27d899SToby Isaac } else { 1039566063dSJacob Faibussowitsch PetscCall(PetscDTGaussJacobiQuadrature(i + 1, 0., 1., f->gaussJacobiExp, f->gaussJacobiExp, f->nodesets[i], w)); 1043f27d899SToby Isaac } 1053f27d899SToby Isaac break; 106d71ae5a4SJacob Faibussowitsch default: 107d71ae5a4SJacob Faibussowitsch SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown 1D node family"); 1083f27d899SToby Isaac } 1093f27d899SToby Isaac } 1103f27d899SToby Isaac } 1119566063dSJacob Faibussowitsch PetscCall(PetscFree(w)); 1123f27d899SToby Isaac f->nComputed = degree + 1; 1133f27d899SToby Isaac } 1143f27d899SToby Isaac *nodesets = f->nodesets; 1153ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 1163f27d899SToby Isaac } 1173f27d899SToby Isaac 11877f1a120SToby Isaac /* http://arxiv.org/abs/2002.09421 for details */ 119d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscNodeRecursive_Internal(PetscInt dim, PetscInt degree, PetscReal **nodesets, PetscInt tup[], PetscReal node[]) 120d71ae5a4SJacob Faibussowitsch { 1213f27d899SToby Isaac PetscReal w; 1223f27d899SToby Isaac PetscInt i, j; 1233f27d899SToby Isaac 1243f27d899SToby Isaac PetscFunctionBeginHot; 1253f27d899SToby Isaac w = 0.; 1263f27d899SToby Isaac if (dim == 1) { 1273f27d899SToby Isaac node[0] = nodesets[degree][tup[0]]; 1283f27d899SToby Isaac node[1] = nodesets[degree][tup[1]]; 1293f27d899SToby Isaac } else { 1303f27d899SToby Isaac for (i = 0; i < dim + 1; i++) node[i] = 0.; 1313f27d899SToby Isaac for (i = 0; i < dim + 1; i++) { 1323f27d899SToby Isaac PetscReal wi = nodesets[degree][degree - tup[i]]; 1333f27d899SToby Isaac 1343f27d899SToby Isaac for (j = 0; j < dim + 1; j++) tup[dim + 1 + j] = tup[j + (j >= i)]; 1359566063dSJacob Faibussowitsch PetscCall(PetscNodeRecursive_Internal(dim - 1, degree - tup[i], nodesets, &tup[dim + 1], &node[dim + 1])); 1363f27d899SToby Isaac for (j = 0; j < dim + 1; j++) node[j + (j >= i)] += wi * node[dim + 1 + j]; 1373f27d899SToby Isaac w += wi; 1383f27d899SToby Isaac } 1393f27d899SToby Isaac for (i = 0; i < dim + 1; i++) node[i] /= w; 1403f27d899SToby Isaac } 1413ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 1423f27d899SToby Isaac } 1433f27d899SToby Isaac 1443f27d899SToby Isaac /* compute simplex nodes for the biunit simplex from the 1D node family */ 145d71ae5a4SJacob Faibussowitsch static PetscErrorCode Petsc1DNodeFamilyComputeSimplexNodes(Petsc1DNodeFamily f, PetscInt dim, PetscInt degree, PetscReal points[]) 146d71ae5a4SJacob Faibussowitsch { 1473f27d899SToby Isaac PetscInt *tup; 1483f27d899SToby Isaac PetscInt k; 1493f27d899SToby Isaac PetscInt npoints; 1503f27d899SToby Isaac PetscReal **nodesets = NULL; 1513f27d899SToby Isaac PetscInt worksize; 1523f27d899SToby Isaac PetscReal *nodework; 1533f27d899SToby Isaac PetscInt *tupwork; 1543f27d899SToby Isaac 1553f27d899SToby Isaac PetscFunctionBegin; 15608401ef6SPierre Jolivet PetscCheck(dim >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Must have non-negative dimension"); 15708401ef6SPierre Jolivet PetscCheck(degree >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Must have non-negative degree"); 1583ba16761SJacob Faibussowitsch if (!dim) PetscFunctionReturn(PETSC_SUCCESS); 1599566063dSJacob Faibussowitsch PetscCall(PetscCalloc1(dim + 2, &tup)); 1603f27d899SToby Isaac k = 0; 1619566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(degree + dim, dim, &npoints)); 1629566063dSJacob Faibussowitsch PetscCall(Petsc1DNodeFamilyGetNodeSets(f, degree, &nodesets)); 1633f27d899SToby Isaac worksize = ((dim + 2) * (dim + 3)) / 2; 164e06b9cbaSStefano Zampini PetscCall(PetscCalloc2(worksize, &nodework, worksize, &tupwork)); 16577f1a120SToby Isaac /* loop over the tuples of length dim with sum at most degree */ 1663f27d899SToby Isaac for (k = 0; k < npoints; k++) { 1673f27d899SToby Isaac PetscInt i; 1683f27d899SToby Isaac 16977f1a120SToby Isaac /* turn thm into tuples of length dim + 1 with sum equal to degree (barycentric indice) */ 1703f27d899SToby Isaac tup[0] = degree; 171ad540459SPierre Jolivet for (i = 0; i < dim; i++) tup[0] -= tup[i + 1]; 1723f27d899SToby Isaac switch (f->nodeFamily) { 1733f27d899SToby Isaac case PETSCDTNODES_EQUISPACED: 17477f1a120SToby Isaac /* compute equispaces nodes on the unit reference triangle */ 1753f27d899SToby Isaac if (f->endpoints) { 176*2b6f951bSStefano Zampini PetscCheck(degree > 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Must have positive degree"); 177ad540459SPierre Jolivet for (i = 0; i < dim; i++) points[dim * k + i] = (PetscReal)tup[i + 1] / (PetscReal)degree; 1783f27d899SToby Isaac } else { 1793f27d899SToby Isaac for (i = 0; i < dim; i++) { 18077f1a120SToby Isaac /* these nodes are at the centroids of the small simplices created by the equispaced nodes that include 18177f1a120SToby Isaac * the endpoints */ 1823f27d899SToby Isaac points[dim * k + i] = ((PetscReal)tup[i + 1] + 1. / (dim + 1.)) / (PetscReal)(degree + 1.); 1833f27d899SToby Isaac } 1843f27d899SToby Isaac } 1853f27d899SToby Isaac break; 1863f27d899SToby Isaac default: 187e06b9cbaSStefano Zampini /* compute equispaced nodes on the barycentric reference triangle (the trace on the first dim dimensions are the 18877f1a120SToby Isaac * unit reference triangle nodes */ 1893f27d899SToby Isaac for (i = 0; i < dim + 1; i++) tupwork[i] = tup[i]; 1909566063dSJacob Faibussowitsch PetscCall(PetscNodeRecursive_Internal(dim, degree, nodesets, tupwork, nodework)); 1913f27d899SToby Isaac for (i = 0; i < dim; i++) points[dim * k + i] = nodework[i + 1]; 1923f27d899SToby Isaac break; 1933f27d899SToby Isaac } 1949566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLatticePointLexicographic_Internal(dim, degree, &tup[1])); 1953f27d899SToby Isaac } 1963f27d899SToby Isaac /* map from unit simplex to biunit simplex */ 1973f27d899SToby Isaac for (k = 0; k < npoints * dim; k++) points[k] = points[k] * 2. - 1.; 1989566063dSJacob Faibussowitsch PetscCall(PetscFree2(nodework, tupwork)); 1999566063dSJacob Faibussowitsch PetscCall(PetscFree(tup)); 2003ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 2013f27d899SToby Isaac } 2023f27d899SToby Isaac 20377f1a120SToby Isaac /* If we need to get the dofs from a mesh point, or add values into dofs at a mesh point, and there is more than one dof 20477f1a120SToby Isaac * on that mesh point, we have to be careful about getting/adding everything in the right place. 20577f1a120SToby Isaac * 20677f1a120SToby Isaac * With nodal dofs like PETSCDUALSPACELAGRANGE makes, the general approach to calculate the value of dofs associate 20777f1a120SToby Isaac * with a node A is 20877f1a120SToby Isaac * - transform the node locations x(A) by the map that takes the mesh point to its reorientation, x' = phi(x(A)) 20977f1a120SToby Isaac * - figure out which node was originally at the location of the transformed point, A' = idx(x') 21077f1a120SToby Isaac * - if the dofs are not scalars, figure out how to represent the transformed dofs in terms of the basis 21177f1a120SToby Isaac * of dofs at A' (using pushforward/pullback rules) 21277f1a120SToby Isaac * 21377f1a120SToby Isaac * The one sticky point with this approach is the "A' = idx(x')" step: trying to go from real valued coordinates 21477f1a120SToby Isaac * back to indices. I don't want to rely on floating point tolerances. Additionally, PETSCDUALSPACELAGRANGE may 21577f1a120SToby Isaac * eventually support quasi-Lagrangian dofs, which could involve quadrature at multiple points, so the location "x(A)" 21677f1a120SToby Isaac * would be ambiguous. 21777f1a120SToby Isaac * 21877f1a120SToby Isaac * So each dof gets an integer value coordinate (nodeIdx in the structure below). The choice of integer coordinates 21977f1a120SToby Isaac * is somewhat arbitrary, as long as all of the relevant symmetries of the mesh point correspond to *permutations* of 22077f1a120SToby Isaac * the integer coordinates, which do not depend on numerical precision. 22177f1a120SToby Isaac * 22277f1a120SToby Isaac * So 22377f1a120SToby Isaac * 22477f1a120SToby Isaac * - DMPlexGetTransitiveClosure_Internal() tells me how an orientation turns into a permutation of the vertices of a 22577f1a120SToby Isaac * mesh point 22677f1a120SToby Isaac * - The permutation of the vertices, and the nodeIdx values assigned to them, tells what permutation in index space 22777f1a120SToby Isaac * is associated with the orientation 22877f1a120SToby Isaac * - I uses that permutation to get xi' = phi(xi(A)), the integer coordinate of the transformed dof 22977f1a120SToby Isaac * - I can without numerical issues compute A' = idx(xi') 23077f1a120SToby Isaac * 23177f1a120SToby Isaac * Here are some examples of how the process works 23277f1a120SToby Isaac * 23377f1a120SToby Isaac * - With a triangle: 23477f1a120SToby Isaac * 23577f1a120SToby Isaac * The triangle has the following integer coordinates for vertices, taken from the barycentric triangle 23677f1a120SToby Isaac * 23777f1a120SToby Isaac * closure order 2 23877f1a120SToby Isaac * nodeIdx (0,0,1) 23977f1a120SToby Isaac * \ 24077f1a120SToby Isaac * + 24177f1a120SToby Isaac * |\ 24277f1a120SToby Isaac * | \ 24377f1a120SToby Isaac * | \ 24477f1a120SToby Isaac * | \ closure order 1 24577f1a120SToby Isaac * | \ / nodeIdx (0,1,0) 24677f1a120SToby Isaac * +-----+ 24777f1a120SToby Isaac * \ 24877f1a120SToby Isaac * closure order 0 24977f1a120SToby Isaac * nodeIdx (1,0,0) 25077f1a120SToby Isaac * 25177f1a120SToby Isaac * If I do DMPlexGetTransitiveClosure_Internal() with orientation 1, the vertices would appear 25277f1a120SToby Isaac * in the order (1, 2, 0) 25377f1a120SToby Isaac * 25477f1a120SToby Isaac * If I list the nodeIdx of each vertex in closure order for orientation 0 (0, 1, 2) and orientation 1 (1, 2, 0), I 25577f1a120SToby Isaac * see 25677f1a120SToby Isaac * 25777f1a120SToby Isaac * orientation 0 | orientation 1 25877f1a120SToby Isaac * 25977f1a120SToby Isaac * [0] (1,0,0) [1] (0,1,0) 26077f1a120SToby Isaac * [1] (0,1,0) [2] (0,0,1) 26177f1a120SToby Isaac * [2] (0,0,1) [0] (1,0,0) 26277f1a120SToby Isaac * A B 26377f1a120SToby Isaac * 26477f1a120SToby Isaac * In other words, B is the result of a row permutation of A. But, there is also 26577f1a120SToby Isaac * a column permutation that accomplishes the same result, (2,0,1). 26677f1a120SToby Isaac * 26777f1a120SToby Isaac * So if a dof has nodeIdx coordinate (a,b,c), after the transformation its nodeIdx coordinate 26877f1a120SToby Isaac * is (c,a,b), and the transformed degree of freedom will be a linear combination of dofs 26977f1a120SToby Isaac * that originally had coordinate (c,a,b). 27077f1a120SToby Isaac * 27177f1a120SToby Isaac * - With a quadrilateral: 27277f1a120SToby Isaac * 27377f1a120SToby Isaac * The quadrilateral has the following integer coordinates for vertices, taken from concatenating barycentric 27477f1a120SToby Isaac * coordinates for two segments: 27577f1a120SToby Isaac * 27677f1a120SToby Isaac * closure order 3 closure order 2 27777f1a120SToby Isaac * nodeIdx (1,0,0,1) nodeIdx (0,1,0,1) 27877f1a120SToby Isaac * \ / 27977f1a120SToby Isaac * +----+ 28077f1a120SToby Isaac * | | 28177f1a120SToby Isaac * | | 28277f1a120SToby Isaac * +----+ 28377f1a120SToby Isaac * / \ 28477f1a120SToby Isaac * closure order 0 closure order 1 28577f1a120SToby Isaac * nodeIdx (1,0,1,0) nodeIdx (0,1,1,0) 28677f1a120SToby Isaac * 28777f1a120SToby Isaac * If I do DMPlexGetTransitiveClosure_Internal() with orientation 1, the vertices would appear 28877f1a120SToby Isaac * in the order (1, 2, 3, 0) 28977f1a120SToby Isaac * 29077f1a120SToby Isaac * If I list the nodeIdx of each vertex in closure order for orientation 0 (0, 1, 2, 3) and 29177f1a120SToby Isaac * orientation 1 (1, 2, 3, 0), I see 29277f1a120SToby Isaac * 29377f1a120SToby Isaac * orientation 0 | orientation 1 29477f1a120SToby Isaac * 29577f1a120SToby Isaac * [0] (1,0,1,0) [1] (0,1,1,0) 29677f1a120SToby Isaac * [1] (0,1,1,0) [2] (0,1,0,1) 29777f1a120SToby Isaac * [2] (0,1,0,1) [3] (1,0,0,1) 29877f1a120SToby Isaac * [3] (1,0,0,1) [0] (1,0,1,0) 29977f1a120SToby Isaac * A B 30077f1a120SToby Isaac * 30177f1a120SToby Isaac * The column permutation that accomplishes the same result is (3,2,0,1). 30277f1a120SToby Isaac * 30377f1a120SToby Isaac * So if a dof has nodeIdx coordinate (a,b,c,d), after the transformation its nodeIdx coordinate 30477f1a120SToby Isaac * is (d,c,a,b), and the transformed degree of freedom will be a linear combination of dofs 30577f1a120SToby Isaac * that originally had coordinate (d,c,a,b). 30677f1a120SToby Isaac * 30777f1a120SToby Isaac * Previously PETSCDUALSPACELAGRANGE had hardcoded symmetries for the triangle and quadrilateral, 30877f1a120SToby Isaac * but this approach will work for any polytope, such as the wedge (triangular prism). 30977f1a120SToby Isaac */ 3109371c9d4SSatish Balay struct _n_PetscLagNodeIndices { 3113f27d899SToby Isaac PetscInt refct; 3123f27d899SToby Isaac PetscInt nodeIdxDim; 3133f27d899SToby Isaac PetscInt nodeVecDim; 3143f27d899SToby Isaac PetscInt nNodes; 3153f27d899SToby Isaac PetscInt *nodeIdx; /* for each node an index of size nodeIdxDim */ 3163f27d899SToby Isaac PetscReal *nodeVec; /* for each node a vector of size nodeVecDim */ 3173f27d899SToby Isaac PetscInt *perm; /* if these are vertices, perm takes DMPlex point index to closure order; 3183f27d899SToby Isaac if these are nodes, perm lists nodes in index revlex order */ 3193f27d899SToby Isaac }; 3203f27d899SToby Isaac 32177f1a120SToby Isaac /* this is just here so I can access the values in tests/ex1.c outside the library */ 322d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscLagNodeIndicesGetData_Internal(PetscLagNodeIndices ni, PetscInt *nodeIdxDim, PetscInt *nodeVecDim, PetscInt *nNodes, const PetscInt *nodeIdx[], const PetscReal *nodeVec[]) 323d71ae5a4SJacob Faibussowitsch { 3243f27d899SToby Isaac PetscFunctionBegin; 3253f27d899SToby Isaac *nodeIdxDim = ni->nodeIdxDim; 3263f27d899SToby Isaac *nodeVecDim = ni->nodeVecDim; 3273f27d899SToby Isaac *nNodes = ni->nNodes; 3283f27d899SToby Isaac *nodeIdx = ni->nodeIdx; 3293f27d899SToby Isaac *nodeVec = ni->nodeVec; 3303ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 3313f27d899SToby Isaac } 3323f27d899SToby Isaac 333d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesReference(PetscLagNodeIndices ni) 334d71ae5a4SJacob Faibussowitsch { 3353f27d899SToby Isaac PetscFunctionBegin; 3363f27d899SToby Isaac if (ni) ni->refct++; 3373ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 3383f27d899SToby Isaac } 3393f27d899SToby Isaac 340d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesDuplicate(PetscLagNodeIndices ni, PetscLagNodeIndices *niNew) 341d71ae5a4SJacob Faibussowitsch { 3421f440fbeSToby Isaac PetscFunctionBegin; 3439566063dSJacob Faibussowitsch PetscCall(PetscNew(niNew)); 3441f440fbeSToby Isaac (*niNew)->refct = 1; 3451f440fbeSToby Isaac (*niNew)->nodeIdxDim = ni->nodeIdxDim; 3461f440fbeSToby Isaac (*niNew)->nodeVecDim = ni->nodeVecDim; 3471f440fbeSToby Isaac (*niNew)->nNodes = ni->nNodes; 3489566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(ni->nNodes * ni->nodeIdxDim, &((*niNew)->nodeIdx))); 3499566063dSJacob Faibussowitsch PetscCall(PetscArraycpy((*niNew)->nodeIdx, ni->nodeIdx, ni->nNodes * ni->nodeIdxDim)); 3509566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(ni->nNodes * ni->nodeVecDim, &((*niNew)->nodeVec))); 3519566063dSJacob Faibussowitsch PetscCall(PetscArraycpy((*niNew)->nodeVec, ni->nodeVec, ni->nNodes * ni->nodeVecDim)); 3521f440fbeSToby Isaac (*niNew)->perm = NULL; 3533ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 3541f440fbeSToby Isaac } 3551f440fbeSToby Isaac 356d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesDestroy(PetscLagNodeIndices *ni) 357d71ae5a4SJacob Faibussowitsch { 3583f27d899SToby Isaac PetscFunctionBegin; 3593ba16761SJacob Faibussowitsch if (!(*ni)) PetscFunctionReturn(PETSC_SUCCESS); 3603f27d899SToby Isaac if (--(*ni)->refct > 0) { 3613f27d899SToby Isaac *ni = NULL; 3623ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 3633f27d899SToby Isaac } 3649566063dSJacob Faibussowitsch PetscCall(PetscFree((*ni)->nodeIdx)); 3659566063dSJacob Faibussowitsch PetscCall(PetscFree((*ni)->nodeVec)); 3669566063dSJacob Faibussowitsch PetscCall(PetscFree((*ni)->perm)); 3679566063dSJacob Faibussowitsch PetscCall(PetscFree(*ni)); 3683f27d899SToby Isaac *ni = NULL; 3693ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 3703f27d899SToby Isaac } 3713f27d899SToby Isaac 37277f1a120SToby Isaac /* The vertices are given nodeIdx coordinates (e.g. the corners of the barycentric triangle). Those coordinates are 37377f1a120SToby Isaac * in some other order, and to understand the effect of different symmetries, we need them to be in closure order. 37477f1a120SToby Isaac * 37577f1a120SToby Isaac * If sortIdx is PETSC_FALSE, the coordinates are already in revlex order, otherwise we must sort them 37677f1a120SToby Isaac * to that order before we do the real work of this function, which is 37777f1a120SToby Isaac * 37877f1a120SToby Isaac * - mark the vertices in closure order 37977f1a120SToby Isaac * - sort them in revlex order 38077f1a120SToby Isaac * - use the resulting permutation to list the vertex coordinates in closure order 38177f1a120SToby Isaac */ 382d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesComputeVertexOrder(DM dm, PetscLagNodeIndices ni, PetscBool sortIdx) 383d71ae5a4SJacob Faibussowitsch { 3843f27d899SToby Isaac PetscInt v, w, vStart, vEnd, c, d; 3853f27d899SToby Isaac PetscInt nVerts; 3863f27d899SToby Isaac PetscInt closureSize = 0; 3873f27d899SToby Isaac PetscInt *closure = NULL; 3883f27d899SToby Isaac PetscInt *closureOrder; 3893f27d899SToby Isaac PetscInt *invClosureOrder; 3903f27d899SToby Isaac PetscInt *revlexOrder; 3913f27d899SToby Isaac PetscInt *newNodeIdx; 3923f27d899SToby Isaac PetscInt dim; 3933f27d899SToby Isaac Vec coordVec; 3943f27d899SToby Isaac const PetscScalar *coords; 3953f27d899SToby Isaac 3963f27d899SToby Isaac PetscFunctionBegin; 3979566063dSJacob Faibussowitsch PetscCall(DMGetDimension(dm, &dim)); 3989566063dSJacob Faibussowitsch PetscCall(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd)); 3993f27d899SToby Isaac nVerts = vEnd - vStart; 4009566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nVerts, &closureOrder)); 4019566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nVerts, &invClosureOrder)); 4029566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nVerts, &revlexOrder)); 40377f1a120SToby Isaac if (sortIdx) { /* bubble sort nodeIdx into revlex order */ 4043f27d899SToby Isaac PetscInt nodeIdxDim = ni->nodeIdxDim; 4053f27d899SToby Isaac PetscInt *idxOrder; 4063f27d899SToby Isaac 4079566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nVerts * nodeIdxDim, &newNodeIdx)); 4089566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nVerts, &idxOrder)); 4093f27d899SToby Isaac for (v = 0; v < nVerts; v++) idxOrder[v] = v; 4103f27d899SToby Isaac for (v = 0; v < nVerts; v++) { 4113f27d899SToby Isaac for (w = v + 1; w < nVerts; w++) { 4123f27d899SToby Isaac const PetscInt *iv = &(ni->nodeIdx[idxOrder[v] * nodeIdxDim]); 4133f27d899SToby Isaac const PetscInt *iw = &(ni->nodeIdx[idxOrder[w] * nodeIdxDim]); 4143f27d899SToby Isaac PetscInt diff = 0; 4153f27d899SToby Isaac 4169371c9d4SSatish Balay for (d = nodeIdxDim - 1; d >= 0; d--) 4179371c9d4SSatish Balay if ((diff = (iv[d] - iw[d]))) break; 4183f27d899SToby Isaac if (diff > 0) { 4193f27d899SToby Isaac PetscInt swap = idxOrder[v]; 4203f27d899SToby Isaac 4213f27d899SToby Isaac idxOrder[v] = idxOrder[w]; 4223f27d899SToby Isaac idxOrder[w] = swap; 4233f27d899SToby Isaac } 4243f27d899SToby Isaac } 4253f27d899SToby Isaac } 4263f27d899SToby Isaac for (v = 0; v < nVerts; v++) { 427ad540459SPierre Jolivet for (d = 0; d < nodeIdxDim; d++) newNodeIdx[v * ni->nodeIdxDim + d] = ni->nodeIdx[idxOrder[v] * nodeIdxDim + d]; 4283f27d899SToby Isaac } 4299566063dSJacob Faibussowitsch PetscCall(PetscFree(ni->nodeIdx)); 4303f27d899SToby Isaac ni->nodeIdx = newNodeIdx; 4313f27d899SToby Isaac newNodeIdx = NULL; 4329566063dSJacob Faibussowitsch PetscCall(PetscFree(idxOrder)); 4333f27d899SToby Isaac } 4349566063dSJacob Faibussowitsch PetscCall(DMPlexGetTransitiveClosure(dm, 0, PETSC_TRUE, &closureSize, &closure)); 4353f27d899SToby Isaac c = closureSize - nVerts; 4363f27d899SToby Isaac for (v = 0; v < nVerts; v++) closureOrder[v] = closure[2 * (c + v)] - vStart; 4373f27d899SToby Isaac for (v = 0; v < nVerts; v++) invClosureOrder[closureOrder[v]] = v; 4389566063dSJacob Faibussowitsch PetscCall(DMPlexRestoreTransitiveClosure(dm, 0, PETSC_TRUE, &closureSize, &closure)); 4399566063dSJacob Faibussowitsch PetscCall(DMGetCoordinatesLocal(dm, &coordVec)); 4409566063dSJacob Faibussowitsch PetscCall(VecGetArrayRead(coordVec, &coords)); 4413f27d899SToby Isaac /* bubble sort closure vertices by coordinates in revlex order */ 4423f27d899SToby Isaac for (v = 0; v < nVerts; v++) revlexOrder[v] = v; 4433f27d899SToby Isaac for (v = 0; v < nVerts; v++) { 4443f27d899SToby Isaac for (w = v + 1; w < nVerts; w++) { 4453f27d899SToby Isaac const PetscScalar *cv = &coords[closureOrder[revlexOrder[v]] * dim]; 4463f27d899SToby Isaac const PetscScalar *cw = &coords[closureOrder[revlexOrder[w]] * dim]; 4473f27d899SToby Isaac PetscReal diff = 0; 4483f27d899SToby Isaac 4499371c9d4SSatish Balay for (d = dim - 1; d >= 0; d--) 4509371c9d4SSatish Balay if ((diff = PetscRealPart(cv[d] - cw[d])) != 0.) break; 4513f27d899SToby Isaac if (diff > 0.) { 4523f27d899SToby Isaac PetscInt swap = revlexOrder[v]; 4533f27d899SToby Isaac 4543f27d899SToby Isaac revlexOrder[v] = revlexOrder[w]; 4553f27d899SToby Isaac revlexOrder[w] = swap; 4563f27d899SToby Isaac } 4573f27d899SToby Isaac } 4583f27d899SToby Isaac } 4599566063dSJacob Faibussowitsch PetscCall(VecRestoreArrayRead(coordVec, &coords)); 4609566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(ni->nodeIdxDim * nVerts, &newNodeIdx)); 4613f27d899SToby Isaac /* reorder nodeIdx to be in closure order */ 4623f27d899SToby Isaac for (v = 0; v < nVerts; v++) { 463ad540459SPierre Jolivet for (d = 0; d < ni->nodeIdxDim; d++) newNodeIdx[revlexOrder[v] * ni->nodeIdxDim + d] = ni->nodeIdx[v * ni->nodeIdxDim + d]; 4643f27d899SToby Isaac } 4659566063dSJacob Faibussowitsch PetscCall(PetscFree(ni->nodeIdx)); 4663f27d899SToby Isaac ni->nodeIdx = newNodeIdx; 4673f27d899SToby Isaac ni->perm = invClosureOrder; 4689566063dSJacob Faibussowitsch PetscCall(PetscFree(revlexOrder)); 4699566063dSJacob Faibussowitsch PetscCall(PetscFree(closureOrder)); 4703ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 4713f27d899SToby Isaac } 4723f27d899SToby Isaac 47377f1a120SToby Isaac /* the coordinates of the simplex vertices are the corners of the barycentric simplex. 47477f1a120SToby Isaac * When we stack them on top of each other in revlex order, they look like the identity matrix */ 475d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesCreateSimplexVertices(DM dm, PetscLagNodeIndices *nodeIndices) 476d71ae5a4SJacob Faibussowitsch { 4773f27d899SToby Isaac PetscLagNodeIndices ni; 4783f27d899SToby Isaac PetscInt dim, d; 4793f27d899SToby Isaac 4803f27d899SToby Isaac PetscFunctionBegin; 4819566063dSJacob Faibussowitsch PetscCall(PetscNew(&ni)); 4829566063dSJacob Faibussowitsch PetscCall(DMGetDimension(dm, &dim)); 4833f27d899SToby Isaac ni->nodeIdxDim = dim + 1; 4843f27d899SToby Isaac ni->nodeVecDim = 0; 4853f27d899SToby Isaac ni->nNodes = dim + 1; 4863f27d899SToby Isaac ni->refct = 1; 4879566063dSJacob Faibussowitsch PetscCall(PetscCalloc1((dim + 1) * (dim + 1), &(ni->nodeIdx))); 4883f27d899SToby Isaac for (d = 0; d < dim + 1; d++) ni->nodeIdx[d * (dim + 2)] = 1; 4899566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesComputeVertexOrder(dm, ni, PETSC_FALSE)); 4903f27d899SToby Isaac *nodeIndices = ni; 4913ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 4923f27d899SToby Isaac } 4933f27d899SToby Isaac 49477f1a120SToby Isaac /* A polytope that is a tensor product of a facet and a segment. 49577f1a120SToby Isaac * We take whatever coordinate system was being used for the facet 4961f440fbeSToby Isaac * and we concatenate the barycentric coordinates for the vertices 49777f1a120SToby Isaac * at the end of the segment, (1,0) and (0,1), to get a coordinate 49877f1a120SToby Isaac * system for the tensor product element */ 499d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesCreateTensorVertices(DM dm, PetscLagNodeIndices facetni, PetscLagNodeIndices *nodeIndices) 500d71ae5a4SJacob Faibussowitsch { 5013f27d899SToby Isaac PetscLagNodeIndices ni; 5023f27d899SToby Isaac PetscInt nodeIdxDim, subNodeIdxDim = facetni->nodeIdxDim; 5033f27d899SToby Isaac PetscInt nVerts, nSubVerts = facetni->nNodes; 5043f27d899SToby Isaac PetscInt dim, d, e, f, g; 5053f27d899SToby Isaac 5063f27d899SToby Isaac PetscFunctionBegin; 5079566063dSJacob Faibussowitsch PetscCall(PetscNew(&ni)); 5089566063dSJacob Faibussowitsch PetscCall(DMGetDimension(dm, &dim)); 5093f27d899SToby Isaac ni->nodeIdxDim = nodeIdxDim = subNodeIdxDim + 2; 5103f27d899SToby Isaac ni->nodeVecDim = 0; 5113f27d899SToby Isaac ni->nNodes = nVerts = 2 * nSubVerts; 5123f27d899SToby Isaac ni->refct = 1; 5139566063dSJacob Faibussowitsch PetscCall(PetscCalloc1(nodeIdxDim * nVerts, &(ni->nodeIdx))); 5143f27d899SToby Isaac for (f = 0, d = 0; d < 2; d++) { 5153f27d899SToby Isaac for (e = 0; e < nSubVerts; e++, f++) { 516ad540459SPierre Jolivet for (g = 0; g < subNodeIdxDim; g++) ni->nodeIdx[f * nodeIdxDim + g] = facetni->nodeIdx[e * subNodeIdxDim + g]; 5173f27d899SToby Isaac ni->nodeIdx[f * nodeIdxDim + subNodeIdxDim] = (1 - d); 5183f27d899SToby Isaac ni->nodeIdx[f * nodeIdxDim + subNodeIdxDim + 1] = d; 5193f27d899SToby Isaac } 5203f27d899SToby Isaac } 5219566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesComputeVertexOrder(dm, ni, PETSC_TRUE)); 5223f27d899SToby Isaac *nodeIndices = ni; 5233ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 5243f27d899SToby Isaac } 5253f27d899SToby Isaac 52677f1a120SToby Isaac /* This helps us compute symmetries, and it also helps us compute coordinates for dofs that are being pushed 52777f1a120SToby Isaac * forward from a boundary mesh point. 52877f1a120SToby Isaac * 52977f1a120SToby Isaac * Input: 53077f1a120SToby Isaac * 53177f1a120SToby Isaac * dm - the target reference cell where we want new coordinates and dof directions to be valid 53277f1a120SToby Isaac * vert - the vertex coordinate system for the target reference cell 53377f1a120SToby Isaac * p - the point in the target reference cell that the dofs are coming from 53477f1a120SToby Isaac * vertp - the vertex coordinate system for p's reference cell 53577f1a120SToby Isaac * ornt - the resulting coordinates and dof vectors will be for p under this orientation 53677f1a120SToby Isaac * nodep - the node coordinates and dof vectors in p's reference cell 53777f1a120SToby Isaac * formDegree - the form degree that the dofs transform as 53877f1a120SToby Isaac * 53977f1a120SToby Isaac * Output: 54077f1a120SToby Isaac * 54177f1a120SToby Isaac * pfNodeIdx - the node coordinates for p's dofs, in the dm reference cell, from the ornt perspective 54277f1a120SToby Isaac * pfNodeVec - the node dof vectors for p's dofs, in the dm reference cell, from the ornt perspective 54377f1a120SToby Isaac */ 544d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesPushForward(DM dm, PetscLagNodeIndices vert, PetscInt p, PetscLagNodeIndices vertp, PetscLagNodeIndices nodep, PetscInt ornt, PetscInt formDegree, PetscInt pfNodeIdx[], PetscReal pfNodeVec[]) 545d71ae5a4SJacob Faibussowitsch { 5463f27d899SToby Isaac PetscInt *closureVerts; 5473f27d899SToby Isaac PetscInt closureSize = 0; 5483f27d899SToby Isaac PetscInt *closure = NULL; 5493f27d899SToby Isaac PetscInt dim, pdim, c, i, j, k, n, v, vStart, vEnd; 5503f27d899SToby Isaac PetscInt nSubVert = vertp->nNodes; 5513f27d899SToby Isaac PetscInt nodeIdxDim = vert->nodeIdxDim; 5523f27d899SToby Isaac PetscInt subNodeIdxDim = vertp->nodeIdxDim; 5533f27d899SToby Isaac PetscInt nNodes = nodep->nNodes; 5543f27d899SToby Isaac const PetscInt *vertIdx = vert->nodeIdx; 5553f27d899SToby Isaac const PetscInt *subVertIdx = vertp->nodeIdx; 5563f27d899SToby Isaac const PetscInt *nodeIdx = nodep->nodeIdx; 5573f27d899SToby Isaac const PetscReal *nodeVec = nodep->nodeVec; 5583f27d899SToby Isaac PetscReal *J, *Jstar; 5593f27d899SToby Isaac PetscReal detJ; 5603f27d899SToby Isaac PetscInt depth, pdepth, Nk, pNk; 5613f27d899SToby Isaac Vec coordVec; 5623f27d899SToby Isaac PetscScalar *newCoords = NULL; 5633f27d899SToby Isaac const PetscScalar *oldCoords = NULL; 5643f27d899SToby Isaac 5653f27d899SToby Isaac PetscFunctionBegin; 5669566063dSJacob Faibussowitsch PetscCall(DMGetDimension(dm, &dim)); 5679566063dSJacob Faibussowitsch PetscCall(DMPlexGetDepth(dm, &depth)); 5689566063dSJacob Faibussowitsch PetscCall(DMGetCoordinatesLocal(dm, &coordVec)); 5699566063dSJacob Faibussowitsch PetscCall(DMPlexGetPointDepth(dm, p, &pdepth)); 5703f27d899SToby Isaac pdim = pdepth != depth ? pdepth != 0 ? pdepth : 0 : dim; 5719566063dSJacob Faibussowitsch PetscCall(DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd)); 5729566063dSJacob Faibussowitsch PetscCall(DMGetWorkArray(dm, nSubVert, MPIU_INT, &closureVerts)); 5739566063dSJacob Faibussowitsch PetscCall(DMPlexGetTransitiveClosure_Internal(dm, p, ornt, PETSC_TRUE, &closureSize, &closure)); 5743f27d899SToby Isaac c = closureSize - nSubVert; 5753f27d899SToby Isaac /* we want which cell closure indices the closure of this point corresponds to */ 5763f27d899SToby Isaac for (v = 0; v < nSubVert; v++) closureVerts[v] = vert->perm[closure[2 * (c + v)] - vStart]; 5779566063dSJacob Faibussowitsch PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure)); 5783f27d899SToby Isaac /* push forward indices */ 5793f27d899SToby Isaac for (i = 0; i < nodeIdxDim; i++) { /* for every component of the target index space */ 5803f27d899SToby Isaac /* check if this is a component that all vertices around this point have in common */ 5813f27d899SToby Isaac for (j = 1; j < nSubVert; j++) { 5823f27d899SToby Isaac if (vertIdx[closureVerts[j] * nodeIdxDim + i] != vertIdx[closureVerts[0] * nodeIdxDim + i]) break; 5833f27d899SToby Isaac } 5843f27d899SToby Isaac if (j == nSubVert) { /* all vertices have this component in common, directly copy to output */ 5853f27d899SToby Isaac PetscInt val = vertIdx[closureVerts[0] * nodeIdxDim + i]; 5863f27d899SToby Isaac for (n = 0; n < nNodes; n++) pfNodeIdx[n * nodeIdxDim + i] = val; 5873f27d899SToby Isaac } else { 5883f27d899SToby Isaac PetscInt subi = -1; 5893f27d899SToby Isaac /* there must be a component in vertp that looks the same */ 5903f27d899SToby Isaac for (k = 0; k < subNodeIdxDim; k++) { 5913f27d899SToby Isaac for (j = 0; j < nSubVert; j++) { 5923f27d899SToby Isaac if (vertIdx[closureVerts[j] * nodeIdxDim + i] != subVertIdx[j * subNodeIdxDim + k]) break; 5933f27d899SToby Isaac } 5943f27d899SToby Isaac if (j == nSubVert) { 5953f27d899SToby Isaac subi = k; 5963f27d899SToby Isaac break; 5973f27d899SToby Isaac } 5983f27d899SToby Isaac } 59908401ef6SPierre Jolivet PetscCheck(subi >= 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Did not find matching coordinate"); 60077f1a120SToby Isaac /* that component in the vertp system becomes component i in the vert system for each dof */ 6013f27d899SToby Isaac for (n = 0; n < nNodes; n++) pfNodeIdx[n * nodeIdxDim + i] = nodeIdx[n * subNodeIdxDim + subi]; 6023f27d899SToby Isaac } 6033f27d899SToby Isaac } 6043f27d899SToby Isaac /* push forward vectors */ 6059566063dSJacob Faibussowitsch PetscCall(DMGetWorkArray(dm, dim * dim, MPIU_REAL, &J)); 60677f1a120SToby Isaac if (ornt != 0) { /* temporarily change the coordinate vector so 60777f1a120SToby Isaac DMPlexComputeCellGeometryAffineFEM gives us the Jacobian we want */ 6083f27d899SToby Isaac PetscInt closureSize2 = 0; 6093f27d899SToby Isaac PetscInt *closure2 = NULL; 6103f27d899SToby Isaac 6119566063dSJacob Faibussowitsch PetscCall(DMPlexGetTransitiveClosure_Internal(dm, p, 0, PETSC_TRUE, &closureSize2, &closure2)); 6129566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(dim * nSubVert, &newCoords)); 6139566063dSJacob Faibussowitsch PetscCall(VecGetArrayRead(coordVec, &oldCoords)); 6143f27d899SToby Isaac for (v = 0; v < nSubVert; v++) { 6153f27d899SToby Isaac PetscInt d; 616ad540459SPierre Jolivet for (d = 0; d < dim; d++) newCoords[(closure2[2 * (c + v)] - vStart) * dim + d] = oldCoords[closureVerts[v] * dim + d]; 6173f27d899SToby Isaac } 6189566063dSJacob Faibussowitsch PetscCall(VecRestoreArrayRead(coordVec, &oldCoords)); 6199566063dSJacob Faibussowitsch PetscCall(DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize2, &closure2)); 6209566063dSJacob Faibussowitsch PetscCall(VecPlaceArray(coordVec, newCoords)); 6213f27d899SToby Isaac } 6229566063dSJacob Faibussowitsch PetscCall(DMPlexComputeCellGeometryAffineFEM(dm, p, NULL, J, NULL, &detJ)); 6233f27d899SToby Isaac if (ornt != 0) { 6249566063dSJacob Faibussowitsch PetscCall(VecResetArray(coordVec)); 6259566063dSJacob Faibussowitsch PetscCall(PetscFree(newCoords)); 6263f27d899SToby Isaac } 6279566063dSJacob Faibussowitsch PetscCall(DMRestoreWorkArray(dm, nSubVert, MPIU_INT, &closureVerts)); 6283f27d899SToby Isaac /* compactify */ 6299371c9d4SSatish Balay for (i = 0; i < dim; i++) 6309371c9d4SSatish Balay for (j = 0; j < pdim; j++) J[i * pdim + j] = J[i * dim + j]; 63177f1a120SToby Isaac /* We have the Jacobian mapping the point's reference cell to this reference cell: 63277f1a120SToby Isaac * pulling back a function to the point and applying the dof is what we want, 63377f1a120SToby Isaac * so we get the pullback matrix and multiply the dof by that matrix on the right */ 6349566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk)); 6359566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(pdim, PetscAbsInt(formDegree), &pNk)); 6369566063dSJacob Faibussowitsch PetscCall(DMGetWorkArray(dm, pNk * Nk, MPIU_REAL, &Jstar)); 6379566063dSJacob Faibussowitsch PetscCall(PetscDTAltVPullbackMatrix(pdim, dim, J, formDegree, Jstar)); 6383f27d899SToby Isaac for (n = 0; n < nNodes; n++) { 6393f27d899SToby Isaac for (i = 0; i < Nk; i++) { 6403f27d899SToby Isaac PetscReal val = 0.; 6415efe5503SToby Isaac for (j = 0; j < pNk; j++) val += nodeVec[n * pNk + j] * Jstar[j * Nk + i]; 6423f27d899SToby Isaac pfNodeVec[n * Nk + i] = val; 6433f27d899SToby Isaac } 6443f27d899SToby Isaac } 6459566063dSJacob Faibussowitsch PetscCall(DMRestoreWorkArray(dm, pNk * Nk, MPIU_REAL, &Jstar)); 6469566063dSJacob Faibussowitsch PetscCall(DMRestoreWorkArray(dm, dim * dim, MPIU_REAL, &J)); 6473ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 6483f27d899SToby Isaac } 6493f27d899SToby Isaac 65077f1a120SToby Isaac /* given to sets of nodes, take the tensor product, where the product of the dof indices is concatenation and the 65177f1a120SToby Isaac * product of the dof vectors is the wedge product */ 652d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesTensor(PetscLagNodeIndices tracei, PetscInt dimT, PetscInt kT, PetscLagNodeIndices fiberi, PetscInt dimF, PetscInt kF, PetscLagNodeIndices *nodeIndices) 653d71ae5a4SJacob Faibussowitsch { 6543f27d899SToby Isaac PetscInt dim = dimT + dimF; 6553f27d899SToby Isaac PetscInt nodeIdxDim, nNodes; 6563f27d899SToby Isaac PetscInt formDegree = kT + kF; 6573f27d899SToby Isaac PetscInt Nk, NkT, NkF; 6583f27d899SToby Isaac PetscInt MkT, MkF; 6593f27d899SToby Isaac PetscLagNodeIndices ni; 6603f27d899SToby Isaac PetscInt i, j, l; 6613f27d899SToby Isaac PetscReal *projF, *projT; 6623f27d899SToby Isaac PetscReal *projFstar, *projTstar; 6633f27d899SToby Isaac PetscReal *workF, *workF2, *workT, *workT2, *work, *work2; 6643f27d899SToby Isaac PetscReal *wedgeMat; 6653f27d899SToby Isaac PetscReal sign; 6663f27d899SToby Isaac 6673f27d899SToby Isaac PetscFunctionBegin; 6689566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk)); 6699566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dimT, PetscAbsInt(kT), &NkT)); 6709566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dimF, PetscAbsInt(kF), &NkF)); 6719566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(kT), &MkT)); 6729566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(kF), &MkF)); 6739566063dSJacob Faibussowitsch PetscCall(PetscNew(&ni)); 6743f27d899SToby Isaac ni->nodeIdxDim = nodeIdxDim = tracei->nodeIdxDim + fiberi->nodeIdxDim; 6753f27d899SToby Isaac ni->nodeVecDim = Nk; 6763f27d899SToby Isaac ni->nNodes = nNodes = tracei->nNodes * fiberi->nNodes; 6773f27d899SToby Isaac ni->refct = 1; 6789566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nNodes * nodeIdxDim, &(ni->nodeIdx))); 6793f27d899SToby Isaac /* first concatenate the indices */ 6803f27d899SToby Isaac for (l = 0, j = 0; j < fiberi->nNodes; j++) { 6813f27d899SToby Isaac for (i = 0; i < tracei->nNodes; i++, l++) { 6823f27d899SToby Isaac PetscInt m, n = 0; 6833f27d899SToby Isaac 6843f27d899SToby Isaac for (m = 0; m < tracei->nodeIdxDim; m++) ni->nodeIdx[l * nodeIdxDim + n++] = tracei->nodeIdx[i * tracei->nodeIdxDim + m]; 6853f27d899SToby Isaac for (m = 0; m < fiberi->nodeIdxDim; m++) ni->nodeIdx[l * nodeIdxDim + n++] = fiberi->nodeIdx[j * fiberi->nodeIdxDim + m]; 6863f27d899SToby Isaac } 6873f27d899SToby Isaac } 6883f27d899SToby Isaac 6893f27d899SToby Isaac /* now wedge together the push-forward vectors */ 6909566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nNodes * Nk, &(ni->nodeVec))); 6919566063dSJacob Faibussowitsch PetscCall(PetscCalloc2(dimT * dim, &projT, dimF * dim, &projF)); 6923f27d899SToby Isaac for (i = 0; i < dimT; i++) projT[i * (dim + 1)] = 1.; 6933f27d899SToby Isaac for (i = 0; i < dimF; i++) projF[i * (dim + dimT + 1) + dimT] = 1.; 6949566063dSJacob Faibussowitsch PetscCall(PetscMalloc2(MkT * NkT, &projTstar, MkF * NkF, &projFstar)); 6959566063dSJacob Faibussowitsch PetscCall(PetscDTAltVPullbackMatrix(dim, dimT, projT, kT, projTstar)); 6969566063dSJacob Faibussowitsch PetscCall(PetscDTAltVPullbackMatrix(dim, dimF, projF, kF, projFstar)); 6979566063dSJacob Faibussowitsch PetscCall(PetscMalloc6(MkT, &workT, MkT, &workT2, MkF, &workF, MkF, &workF2, Nk, &work, Nk, &work2)); 6989566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(Nk * MkT, &wedgeMat)); 6993f27d899SToby Isaac sign = (PetscAbsInt(kT * kF) & 1) ? -1. : 1.; 7003f27d899SToby Isaac for (l = 0, j = 0; j < fiberi->nNodes; j++) { 7013f27d899SToby Isaac PetscInt d, e; 7023f27d899SToby Isaac 7033f27d899SToby Isaac /* push forward fiber k-form */ 7043f27d899SToby Isaac for (d = 0; d < MkF; d++) { 7053f27d899SToby Isaac PetscReal val = 0.; 7063f27d899SToby Isaac for (e = 0; e < NkF; e++) val += projFstar[d * NkF + e] * fiberi->nodeVec[j * NkF + e]; 7073f27d899SToby Isaac workF[d] = val; 7083f27d899SToby Isaac } 7093f27d899SToby Isaac /* Hodge star to proper form if necessary */ 7103f27d899SToby Isaac if (kF < 0) { 7113f27d899SToby Isaac for (d = 0; d < MkF; d++) workF2[d] = workF[d]; 7129566063dSJacob Faibussowitsch PetscCall(PetscDTAltVStar(dim, PetscAbsInt(kF), 1, workF2, workF)); 7133f27d899SToby Isaac } 7143f27d899SToby Isaac /* Compute the matrix that wedges this form with one of the trace k-form */ 7159566063dSJacob Faibussowitsch PetscCall(PetscDTAltVWedgeMatrix(dim, PetscAbsInt(kF), PetscAbsInt(kT), workF, wedgeMat)); 7163f27d899SToby Isaac for (i = 0; i < tracei->nNodes; i++, l++) { 7173f27d899SToby Isaac /* push forward trace k-form */ 7183f27d899SToby Isaac for (d = 0; d < MkT; d++) { 7193f27d899SToby Isaac PetscReal val = 0.; 7203f27d899SToby Isaac for (e = 0; e < NkT; e++) val += projTstar[d * NkT + e] * tracei->nodeVec[i * NkT + e]; 7213f27d899SToby Isaac workT[d] = val; 7223f27d899SToby Isaac } 7233f27d899SToby Isaac /* Hodge star to proper form if necessary */ 7243f27d899SToby Isaac if (kT < 0) { 7253f27d899SToby Isaac for (d = 0; d < MkT; d++) workT2[d] = workT[d]; 7269566063dSJacob Faibussowitsch PetscCall(PetscDTAltVStar(dim, PetscAbsInt(kT), 1, workT2, workT)); 7273f27d899SToby Isaac } 7283f27d899SToby Isaac /* compute the wedge product of the push-forward trace form and firer forms */ 7293f27d899SToby Isaac for (d = 0; d < Nk; d++) { 7303f27d899SToby Isaac PetscReal val = 0.; 7313f27d899SToby Isaac for (e = 0; e < MkT; e++) val += wedgeMat[d * MkT + e] * workT[e]; 7323f27d899SToby Isaac work[d] = val; 7333f27d899SToby Isaac } 7343f27d899SToby Isaac /* inverse Hodge star from proper form if necessary */ 7353f27d899SToby Isaac if (formDegree < 0) { 7363f27d899SToby Isaac for (d = 0; d < Nk; d++) work2[d] = work[d]; 7379566063dSJacob Faibussowitsch PetscCall(PetscDTAltVStar(dim, PetscAbsInt(formDegree), -1, work2, work)); 7383f27d899SToby Isaac } 7393f27d899SToby Isaac /* insert into the array (adjusting for sign) */ 7403f27d899SToby Isaac for (d = 0; d < Nk; d++) ni->nodeVec[l * Nk + d] = sign * work[d]; 7413f27d899SToby Isaac } 7423f27d899SToby Isaac } 7439566063dSJacob Faibussowitsch PetscCall(PetscFree(wedgeMat)); 7449566063dSJacob Faibussowitsch PetscCall(PetscFree6(workT, workT2, workF, workF2, work, work2)); 7459566063dSJacob Faibussowitsch PetscCall(PetscFree2(projTstar, projFstar)); 7469566063dSJacob Faibussowitsch PetscCall(PetscFree2(projT, projF)); 7473f27d899SToby Isaac *nodeIndices = ni; 7483ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 7493f27d899SToby Isaac } 7503f27d899SToby Isaac 75177f1a120SToby Isaac /* simple union of two sets of nodes */ 752d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesMerge(PetscLagNodeIndices niA, PetscLagNodeIndices niB, PetscLagNodeIndices *nodeIndices) 753d71ae5a4SJacob Faibussowitsch { 7543f27d899SToby Isaac PetscLagNodeIndices ni; 7553f27d899SToby Isaac PetscInt nodeIdxDim, nodeVecDim, nNodes; 7563f27d899SToby Isaac 7573f27d899SToby Isaac PetscFunctionBegin; 7589566063dSJacob Faibussowitsch PetscCall(PetscNew(&ni)); 7593f27d899SToby Isaac ni->nodeIdxDim = nodeIdxDim = niA->nodeIdxDim; 76008401ef6SPierre Jolivet PetscCheck(niB->nodeIdxDim == nodeIdxDim, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cannot merge PetscLagNodeIndices with different nodeIdxDim"); 7613f27d899SToby Isaac ni->nodeVecDim = nodeVecDim = niA->nodeVecDim; 76208401ef6SPierre Jolivet PetscCheck(niB->nodeVecDim == nodeVecDim, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cannot merge PetscLagNodeIndices with different nodeVecDim"); 7633f27d899SToby Isaac ni->nNodes = nNodes = niA->nNodes + niB->nNodes; 7643f27d899SToby Isaac ni->refct = 1; 7659566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nNodes * nodeIdxDim, &(ni->nodeIdx))); 7669566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nNodes * nodeVecDim, &(ni->nodeVec))); 7679566063dSJacob Faibussowitsch PetscCall(PetscArraycpy(ni->nodeIdx, niA->nodeIdx, niA->nNodes * nodeIdxDim)); 7689566063dSJacob Faibussowitsch PetscCall(PetscArraycpy(ni->nodeVec, niA->nodeVec, niA->nNodes * nodeVecDim)); 7699566063dSJacob Faibussowitsch PetscCall(PetscArraycpy(&(ni->nodeIdx[niA->nNodes * nodeIdxDim]), niB->nodeIdx, niB->nNodes * nodeIdxDim)); 7709566063dSJacob Faibussowitsch PetscCall(PetscArraycpy(&(ni->nodeVec[niA->nNodes * nodeVecDim]), niB->nodeVec, niB->nNodes * nodeVecDim)); 7713f27d899SToby Isaac *nodeIndices = ni; 7723ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 7733f27d899SToby Isaac } 7743f27d899SToby Isaac 7753f27d899SToby Isaac #define PETSCTUPINTCOMPREVLEX(N) \ 776d71ae5a4SJacob Faibussowitsch static int PetscConcat_(PetscTupIntCompRevlex_, N)(const void *a, const void *b) \ 777d71ae5a4SJacob Faibussowitsch { \ 7783f27d899SToby Isaac const PetscInt *A = (const PetscInt *)a; \ 7793f27d899SToby Isaac const PetscInt *B = (const PetscInt *)b; \ 7803f27d899SToby Isaac int i; \ 7813f27d899SToby Isaac PetscInt diff = 0; \ 7823f27d899SToby Isaac for (i = 0; i < N; i++) { \ 7833f27d899SToby Isaac diff = A[N - i] - B[N - i]; \ 7843f27d899SToby Isaac if (diff) break; \ 7853f27d899SToby Isaac } \ 7863f27d899SToby Isaac return (diff <= 0) ? (diff < 0) ? -1 : 0 : 1; \ 7873f27d899SToby Isaac } 7883f27d899SToby Isaac 7893f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(3) 7903f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(4) 7913f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(5) 7923f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(6) 7933f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(7) 7943f27d899SToby Isaac 795d71ae5a4SJacob Faibussowitsch static int PetscTupIntCompRevlex_N(const void *a, const void *b) 796d71ae5a4SJacob Faibussowitsch { 7973f27d899SToby Isaac const PetscInt *A = (const PetscInt *)a; 7983f27d899SToby Isaac const PetscInt *B = (const PetscInt *)b; 7993f27d899SToby Isaac int i; 8003f27d899SToby Isaac int N = A[0]; 8013f27d899SToby Isaac PetscInt diff = 0; 8023f27d899SToby Isaac for (i = 0; i < N; i++) { 8033f27d899SToby Isaac diff = A[N - i] - B[N - i]; 8043f27d899SToby Isaac if (diff) break; 8053f27d899SToby Isaac } 8063f27d899SToby Isaac return (diff <= 0) ? (diff < 0) ? -1 : 0 : 1; 8073f27d899SToby Isaac } 8083f27d899SToby Isaac 80977f1a120SToby Isaac /* The nodes are not necessarily in revlex order wrt nodeIdx: get the permutation 81077f1a120SToby Isaac * that puts them in that order */ 811d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscLagNodeIndicesGetPermutation(PetscLagNodeIndices ni, PetscInt *perm[]) 812d71ae5a4SJacob Faibussowitsch { 8133f27d899SToby Isaac PetscFunctionBegin; 8143f27d899SToby Isaac if (!(ni->perm)) { 8153f27d899SToby Isaac PetscInt *sorter; 8163f27d899SToby Isaac PetscInt m = ni->nNodes; 8173f27d899SToby Isaac PetscInt nodeIdxDim = ni->nodeIdxDim; 8183f27d899SToby Isaac PetscInt i, j, k, l; 8193f27d899SToby Isaac PetscInt *prm; 8203f27d899SToby Isaac int (*comp)(const void *, const void *); 8213f27d899SToby Isaac 8229566063dSJacob Faibussowitsch PetscCall(PetscMalloc1((nodeIdxDim + 2) * m, &sorter)); 8233f27d899SToby Isaac for (k = 0, l = 0, i = 0; i < m; i++) { 8243f27d899SToby Isaac sorter[k++] = nodeIdxDim + 1; 8253f27d899SToby Isaac sorter[k++] = i; 8263f27d899SToby Isaac for (j = 0; j < nodeIdxDim; j++) sorter[k++] = ni->nodeIdx[l++]; 8273f27d899SToby Isaac } 8283f27d899SToby Isaac switch (nodeIdxDim) { 829d71ae5a4SJacob Faibussowitsch case 2: 830d71ae5a4SJacob Faibussowitsch comp = PetscTupIntCompRevlex_3; 831d71ae5a4SJacob Faibussowitsch break; 832d71ae5a4SJacob Faibussowitsch case 3: 833d71ae5a4SJacob Faibussowitsch comp = PetscTupIntCompRevlex_4; 834d71ae5a4SJacob Faibussowitsch break; 835d71ae5a4SJacob Faibussowitsch case 4: 836d71ae5a4SJacob Faibussowitsch comp = PetscTupIntCompRevlex_5; 837d71ae5a4SJacob Faibussowitsch break; 838d71ae5a4SJacob Faibussowitsch case 5: 839d71ae5a4SJacob Faibussowitsch comp = PetscTupIntCompRevlex_6; 840d71ae5a4SJacob Faibussowitsch break; 841d71ae5a4SJacob Faibussowitsch case 6: 842d71ae5a4SJacob Faibussowitsch comp = PetscTupIntCompRevlex_7; 843d71ae5a4SJacob Faibussowitsch break; 844d71ae5a4SJacob Faibussowitsch default: 845d71ae5a4SJacob Faibussowitsch comp = PetscTupIntCompRevlex_N; 846d71ae5a4SJacob Faibussowitsch break; 8473f27d899SToby Isaac } 8483f27d899SToby Isaac qsort(sorter, m, (nodeIdxDim + 2) * sizeof(PetscInt), comp); 8499566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(m, &prm)); 8503f27d899SToby Isaac for (i = 0; i < m; i++) prm[i] = sorter[(nodeIdxDim + 2) * i + 1]; 8513f27d899SToby Isaac ni->perm = prm; 8529566063dSJacob Faibussowitsch PetscCall(PetscFree(sorter)); 8533f27d899SToby Isaac } 8543f27d899SToby Isaac *perm = ni->perm; 8553ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 8563f27d899SToby Isaac } 85720cf1dd8SToby Isaac 858d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp) 859d71ae5a4SJacob Faibussowitsch { 86020cf1dd8SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 86120cf1dd8SToby Isaac 86220cf1dd8SToby Isaac PetscFunctionBegin; 8633f27d899SToby Isaac if (lag->symperms) { 8643f27d899SToby Isaac PetscInt **selfSyms = lag->symperms[0]; 8656f905325SMatthew G. Knepley 8666f905325SMatthew G. Knepley if (selfSyms) { 8676f905325SMatthew G. Knepley PetscInt i, **allocated = &selfSyms[-lag->selfSymOff]; 8686f905325SMatthew G. Knepley 86948a46eb9SPierre Jolivet for (i = 0; i < lag->numSelfSym; i++) PetscCall(PetscFree(allocated[i])); 8709566063dSJacob Faibussowitsch PetscCall(PetscFree(allocated)); 8716f905325SMatthew G. Knepley } 8729566063dSJacob Faibussowitsch PetscCall(PetscFree(lag->symperms)); 8736f905325SMatthew G. Knepley } 8743f27d899SToby Isaac if (lag->symflips) { 8753f27d899SToby Isaac PetscScalar **selfSyms = lag->symflips[0]; 8763f27d899SToby Isaac 8773f27d899SToby Isaac if (selfSyms) { 8783f27d899SToby Isaac PetscInt i; 8793f27d899SToby Isaac PetscScalar **allocated = &selfSyms[-lag->selfSymOff]; 8803f27d899SToby Isaac 88148a46eb9SPierre Jolivet for (i = 0; i < lag->numSelfSym; i++) PetscCall(PetscFree(allocated[i])); 8829566063dSJacob Faibussowitsch PetscCall(PetscFree(allocated)); 8833f27d899SToby Isaac } 8849566063dSJacob Faibussowitsch PetscCall(PetscFree(lag->symflips)); 8853f27d899SToby Isaac } 8869566063dSJacob Faibussowitsch PetscCall(Petsc1DNodeFamilyDestroy(&(lag->nodeFamily))); 8879566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesDestroy(&(lag->vertIndices))); 8889566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesDestroy(&(lag->intNodeIndices))); 8899566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesDestroy(&(lag->allNodeIndices))); 8909566063dSJacob Faibussowitsch PetscCall(PetscFree(lag)); 8919566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetContinuity_C", NULL)); 8929566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetContinuity_C", NULL)); 8939566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetTensor_C", NULL)); 8949566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetTensor_C", NULL)); 8959566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetTrimmed_C", NULL)); 8969566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetTrimmed_C", NULL)); 8979566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetNodeType_C", NULL)); 8989566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetNodeType_C", NULL)); 8999566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetUseMoments_C", NULL)); 9009566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetUseMoments_C", NULL)); 9019566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetMomentOrder_C", NULL)); 9029566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetMomentOrder_C", NULL)); 9033ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 90420cf1dd8SToby Isaac } 90520cf1dd8SToby Isaac 906d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeView_Ascii(PetscDualSpace sp, PetscViewer viewer) 907d71ae5a4SJacob Faibussowitsch { 90820cf1dd8SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 90920cf1dd8SToby Isaac 91020cf1dd8SToby Isaac PetscFunctionBegin; 9119566063dSJacob Faibussowitsch PetscCall(PetscViewerASCIIPrintf(viewer, "%s %s%sLagrange dual space\n", lag->continuous ? "Continuous" : "Discontinuous", lag->tensorSpace ? "tensor " : "", lag->trimmed ? "trimmed " : "")); 9123ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 91320cf1dd8SToby Isaac } 91420cf1dd8SToby Isaac 915d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceView_Lagrange(PetscDualSpace sp, PetscViewer viewer) 916d71ae5a4SJacob Faibussowitsch { 9176f905325SMatthew G. Knepley PetscBool iascii; 9186f905325SMatthew G. Knepley 91920cf1dd8SToby Isaac PetscFunctionBegin; 9206f905325SMatthew G. Knepley PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 9216f905325SMatthew G. Knepley PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2); 9229566063dSJacob Faibussowitsch PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &iascii)); 9239566063dSJacob Faibussowitsch if (iascii) PetscCall(PetscDualSpaceLagrangeView_Ascii(sp, viewer)); 9243ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 92520cf1dd8SToby Isaac } 92620cf1dd8SToby Isaac 927d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceSetFromOptions_Lagrange(PetscDualSpace sp, PetscOptionItems *PetscOptionsObject) 928d71ae5a4SJacob Faibussowitsch { 9293f27d899SToby Isaac PetscBool continuous, tensor, trimmed, flg, flg2, flg3; 9303f27d899SToby Isaac PetscDTNodeType nodeType; 9313f27d899SToby Isaac PetscReal nodeExponent; 93266a6c23cSMatthew G. Knepley PetscInt momentOrder; 93366a6c23cSMatthew G. Knepley PetscBool nodeEndpoints, useMoments; 9346f905325SMatthew G. Knepley 9356f905325SMatthew G. Knepley PetscFunctionBegin; 9369566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetContinuity(sp, &continuous)); 9379566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetTensor(sp, &tensor)); 9389566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetTrimmed(sp, &trimmed)); 9399566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetNodeType(sp, &nodeType, &nodeEndpoints, &nodeExponent)); 9403f27d899SToby Isaac if (nodeType == PETSCDTNODES_DEFAULT) nodeType = PETSCDTNODES_GAUSSJACOBI; 9419566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetUseMoments(sp, &useMoments)); 9429566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetMomentOrder(sp, &momentOrder)); 943d0609cedSBarry Smith PetscOptionsHeadBegin(PetscOptionsObject, "PetscDualSpace Lagrange Options"); 9449566063dSJacob Faibussowitsch PetscCall(PetscOptionsBool("-petscdualspace_lagrange_continuity", "Flag for continuous element", "PetscDualSpaceLagrangeSetContinuity", continuous, &continuous, &flg)); 9459566063dSJacob Faibussowitsch if (flg) PetscCall(PetscDualSpaceLagrangeSetContinuity(sp, continuous)); 9469566063dSJacob Faibussowitsch PetscCall(PetscOptionsBool("-petscdualspace_lagrange_tensor", "Flag for tensor dual space", "PetscDualSpaceLagrangeSetTensor", tensor, &tensor, &flg)); 9479566063dSJacob Faibussowitsch if (flg) PetscCall(PetscDualSpaceLagrangeSetTensor(sp, tensor)); 9489566063dSJacob Faibussowitsch PetscCall(PetscOptionsBool("-petscdualspace_lagrange_trimmed", "Flag for trimmed dual space", "PetscDualSpaceLagrangeSetTrimmed", trimmed, &trimmed, &flg)); 9499566063dSJacob Faibussowitsch if (flg) PetscCall(PetscDualSpaceLagrangeSetTrimmed(sp, trimmed)); 9509566063dSJacob Faibussowitsch PetscCall(PetscOptionsEnum("-petscdualspace_lagrange_node_type", "Lagrange node location type", "PetscDualSpaceLagrangeSetNodeType", PetscDTNodeTypes, (PetscEnum)nodeType, (PetscEnum *)&nodeType, &flg)); 9519566063dSJacob Faibussowitsch PetscCall(PetscOptionsBool("-petscdualspace_lagrange_node_endpoints", "Flag for nodes that include endpoints", "PetscDualSpaceLagrangeSetNodeType", nodeEndpoints, &nodeEndpoints, &flg2)); 9523f27d899SToby Isaac flg3 = PETSC_FALSE; 95348a46eb9SPierre Jolivet if (nodeType == PETSCDTNODES_GAUSSJACOBI) PetscCall(PetscOptionsReal("-petscdualspace_lagrange_node_exponent", "Gauss-Jacobi weight function exponent", "PetscDualSpaceLagrangeSetNodeType", nodeExponent, &nodeExponent, &flg3)); 9549566063dSJacob Faibussowitsch if (flg || flg2 || flg3) PetscCall(PetscDualSpaceLagrangeSetNodeType(sp, nodeType, nodeEndpoints, nodeExponent)); 9559566063dSJacob Faibussowitsch PetscCall(PetscOptionsBool("-petscdualspace_lagrange_use_moments", "Use moments (where appropriate) for functionals", "PetscDualSpaceLagrangeSetUseMoments", useMoments, &useMoments, &flg)); 9569566063dSJacob Faibussowitsch if (flg) PetscCall(PetscDualSpaceLagrangeSetUseMoments(sp, useMoments)); 9579566063dSJacob Faibussowitsch PetscCall(PetscOptionsInt("-petscdualspace_lagrange_moment_order", "Quadrature order for moment functionals", "PetscDualSpaceLagrangeSetMomentOrder", momentOrder, &momentOrder, &flg)); 9589566063dSJacob Faibussowitsch if (flg) PetscCall(PetscDualSpaceLagrangeSetMomentOrder(sp, momentOrder)); 959d0609cedSBarry Smith PetscOptionsHeadEnd(); 9603ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 9616f905325SMatthew G. Knepley } 9626f905325SMatthew G. Knepley 963d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceDuplicate_Lagrange(PetscDualSpace sp, PetscDualSpace spNew) 964d71ae5a4SJacob Faibussowitsch { 9653f27d899SToby Isaac PetscBool cont, tensor, trimmed, boundary; 9663f27d899SToby Isaac PetscDTNodeType nodeType; 9673f27d899SToby Isaac PetscReal exponent; 9683f27d899SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 9696f905325SMatthew G. Knepley 9706f905325SMatthew G. Knepley PetscFunctionBegin; 9719566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetContinuity(sp, &cont)); 9729566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeSetContinuity(spNew, cont)); 9739566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetTensor(sp, &tensor)); 9749566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeSetTensor(spNew, tensor)); 9759566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetTrimmed(sp, &trimmed)); 9769566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeSetTrimmed(spNew, trimmed)); 9779566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetNodeType(sp, &nodeType, &boundary, &exponent)); 9789566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeSetNodeType(spNew, nodeType, boundary, exponent)); 9793f27d899SToby Isaac if (lag->nodeFamily) { 9803f27d899SToby Isaac PetscDualSpace_Lag *lagnew = (PetscDualSpace_Lag *)spNew->data; 9813f27d899SToby Isaac 9829566063dSJacob Faibussowitsch PetscCall(Petsc1DNodeFamilyReference(lag->nodeFamily)); 9833f27d899SToby Isaac lagnew->nodeFamily = lag->nodeFamily; 9843f27d899SToby Isaac } 9853ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 9866f905325SMatthew G. Knepley } 9876f905325SMatthew G. Knepley 98877f1a120SToby Isaac /* for making tensor product spaces: take a dual space and product a segment space that has all the same 98977f1a120SToby Isaac * specifications (trimmed, continuous, order, node set), except for the form degree */ 990d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceCreateEdgeSubspace_Lagrange(PetscDualSpace sp, PetscInt order, PetscInt k, PetscInt Nc, PetscBool interiorOnly, PetscDualSpace *bdsp) 991d71ae5a4SJacob Faibussowitsch { 9923f27d899SToby Isaac DM K; 9933f27d899SToby Isaac PetscDualSpace_Lag *newlag; 9946f905325SMatthew G. Knepley 9956f905325SMatthew G. Knepley PetscFunctionBegin; 9969566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceDuplicate(sp, bdsp)); 9979566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetFormDegree(*bdsp, k)); 9989566063dSJacob Faibussowitsch PetscCall(DMPlexCreateReferenceCell(PETSC_COMM_SELF, DMPolytopeTypeSimpleShape(1, PETSC_TRUE), &K)); 9999566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetDM(*bdsp, K)); 10009566063dSJacob Faibussowitsch PetscCall(DMDestroy(&K)); 10019566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetOrder(*bdsp, order)); 10029566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetNumComponents(*bdsp, Nc)); 10033f27d899SToby Isaac newlag = (PetscDualSpace_Lag *)(*bdsp)->data; 10043f27d899SToby Isaac newlag->interiorOnly = interiorOnly; 10059566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetUp(*bdsp)); 10063ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 10076f905325SMatthew G. Knepley } 10083f27d899SToby Isaac 10093f27d899SToby Isaac /* just the points, weights aren't handled */ 1010d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscQuadratureCreateTensor(PetscQuadrature trace, PetscQuadrature fiber, PetscQuadrature *product) 1011d71ae5a4SJacob Faibussowitsch { 10123f27d899SToby Isaac PetscInt dimTrace, dimFiber; 10133f27d899SToby Isaac PetscInt numPointsTrace, numPointsFiber; 10143f27d899SToby Isaac PetscInt dim, numPoints; 10153f27d899SToby Isaac const PetscReal *pointsTrace; 10163f27d899SToby Isaac const PetscReal *pointsFiber; 10173f27d899SToby Isaac PetscReal *points; 10183f27d899SToby Isaac PetscInt i, j, k, p; 10193f27d899SToby Isaac 10203f27d899SToby Isaac PetscFunctionBegin; 10219566063dSJacob Faibussowitsch PetscCall(PetscQuadratureGetData(trace, &dimTrace, NULL, &numPointsTrace, &pointsTrace, NULL)); 10229566063dSJacob Faibussowitsch PetscCall(PetscQuadratureGetData(fiber, &dimFiber, NULL, &numPointsFiber, &pointsFiber, NULL)); 10233f27d899SToby Isaac dim = dimTrace + dimFiber; 10243f27d899SToby Isaac numPoints = numPointsFiber * numPointsTrace; 10259566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(numPoints * dim, &points)); 10263f27d899SToby Isaac for (p = 0, j = 0; j < numPointsFiber; j++) { 10273f27d899SToby Isaac for (i = 0; i < numPointsTrace; i++, p++) { 10283f27d899SToby Isaac for (k = 0; k < dimTrace; k++) points[p * dim + k] = pointsTrace[i * dimTrace + k]; 10293f27d899SToby Isaac for (k = 0; k < dimFiber; k++) points[p * dim + dimTrace + k] = pointsFiber[j * dimFiber + k]; 10303f27d899SToby Isaac } 10313f27d899SToby Isaac } 10329566063dSJacob Faibussowitsch PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, product)); 10339566063dSJacob Faibussowitsch PetscCall(PetscQuadratureSetData(*product, dim, 0, numPoints, points, NULL)); 10343ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 10353f27d899SToby Isaac } 10363f27d899SToby Isaac 103777f1a120SToby Isaac /* Kronecker tensor product where matrix is considered a matrix of k-forms, so that 103877f1a120SToby Isaac * the entries in the product matrix are wedge products of the entries in the original matrices */ 1039d71ae5a4SJacob Faibussowitsch static PetscErrorCode MatTensorAltV(Mat trace, Mat fiber, PetscInt dimTrace, PetscInt kTrace, PetscInt dimFiber, PetscInt kFiber, Mat *product) 1040d71ae5a4SJacob Faibussowitsch { 10413f27d899SToby Isaac PetscInt mTrace, nTrace, mFiber, nFiber, m, n, k, i, j, l; 10423f27d899SToby Isaac PetscInt dim, NkTrace, NkFiber, Nk; 10433f27d899SToby Isaac PetscInt dT, dF; 10443f27d899SToby Isaac PetscInt *nnzTrace, *nnzFiber, *nnz; 10453f27d899SToby Isaac PetscInt iT, iF, jT, jF, il, jl; 10463f27d899SToby Isaac PetscReal *workT, *workT2, *workF, *workF2, *work, *workstar; 10473f27d899SToby Isaac PetscReal *projT, *projF; 10483f27d899SToby Isaac PetscReal *projTstar, *projFstar; 10493f27d899SToby Isaac PetscReal *wedgeMat; 10503f27d899SToby Isaac PetscReal sign; 10513f27d899SToby Isaac PetscScalar *workS; 10523f27d899SToby Isaac Mat prod; 10533f27d899SToby Isaac /* this produces dof groups that look like the identity */ 10543f27d899SToby Isaac 10553f27d899SToby Isaac PetscFunctionBegin; 10569566063dSJacob Faibussowitsch PetscCall(MatGetSize(trace, &mTrace, &nTrace)); 10579566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dimTrace, PetscAbsInt(kTrace), &NkTrace)); 105808401ef6SPierre Jolivet PetscCheck(nTrace % NkTrace == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "point value space of trace matrix is not a multiple of k-form size"); 10599566063dSJacob Faibussowitsch PetscCall(MatGetSize(fiber, &mFiber, &nFiber)); 10609566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dimFiber, PetscAbsInt(kFiber), &NkFiber)); 106108401ef6SPierre Jolivet PetscCheck(nFiber % NkFiber == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "point value space of fiber matrix is not a multiple of k-form size"); 10629566063dSJacob Faibussowitsch PetscCall(PetscMalloc2(mTrace, &nnzTrace, mFiber, &nnzFiber)); 10633f27d899SToby Isaac for (i = 0; i < mTrace; i++) { 10649566063dSJacob Faibussowitsch PetscCall(MatGetRow(trace, i, &(nnzTrace[i]), NULL, NULL)); 106508401ef6SPierre Jolivet PetscCheck(nnzTrace[i] % NkTrace == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in trace matrix are not in k-form size blocks"); 10663f27d899SToby Isaac } 10673f27d899SToby Isaac for (i = 0; i < mFiber; i++) { 10689566063dSJacob Faibussowitsch PetscCall(MatGetRow(fiber, i, &(nnzFiber[i]), NULL, NULL)); 106908401ef6SPierre Jolivet PetscCheck(nnzFiber[i] % NkFiber == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in fiber matrix are not in k-form size blocks"); 10703f27d899SToby Isaac } 10713f27d899SToby Isaac dim = dimTrace + dimFiber; 10723f27d899SToby Isaac k = kFiber + kTrace; 10739566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk)); 10743f27d899SToby Isaac m = mTrace * mFiber; 10759566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(m, &nnz)); 10769371c9d4SSatish Balay for (l = 0, j = 0; j < mFiber; j++) 10779371c9d4SSatish Balay for (i = 0; i < mTrace; i++, l++) nnz[l] = (nnzTrace[i] / NkTrace) * (nnzFiber[j] / NkFiber) * Nk; 10783f27d899SToby Isaac n = (nTrace / NkTrace) * (nFiber / NkFiber) * Nk; 10799566063dSJacob Faibussowitsch PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, m, n, 0, nnz, &prod)); 10809566063dSJacob Faibussowitsch PetscCall(PetscFree(nnz)); 10819566063dSJacob Faibussowitsch PetscCall(PetscFree2(nnzTrace, nnzFiber)); 10823f27d899SToby Isaac /* reasoning about which points each dof needs depends on having zeros computed at points preserved */ 10839566063dSJacob Faibussowitsch PetscCall(MatSetOption(prod, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE)); 10843f27d899SToby Isaac /* compute pullbacks */ 10859566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(kTrace), &dT)); 10869566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(kFiber), &dF)); 10879566063dSJacob Faibussowitsch PetscCall(PetscMalloc4(dimTrace * dim, &projT, dimFiber * dim, &projF, dT * NkTrace, &projTstar, dF * NkFiber, &projFstar)); 10889566063dSJacob Faibussowitsch PetscCall(PetscArrayzero(projT, dimTrace * dim)); 10893f27d899SToby Isaac for (i = 0; i < dimTrace; i++) projT[i * (dim + 1)] = 1.; 10909566063dSJacob Faibussowitsch PetscCall(PetscArrayzero(projF, dimFiber * dim)); 10913f27d899SToby Isaac for (i = 0; i < dimFiber; i++) projF[i * (dim + 1) + dimTrace] = 1.; 10929566063dSJacob Faibussowitsch PetscCall(PetscDTAltVPullbackMatrix(dim, dimTrace, projT, kTrace, projTstar)); 10939566063dSJacob Faibussowitsch PetscCall(PetscDTAltVPullbackMatrix(dim, dimFiber, projF, kFiber, projFstar)); 10949566063dSJacob Faibussowitsch PetscCall(PetscMalloc5(dT, &workT, dF, &workF, Nk, &work, Nk, &workstar, Nk, &workS)); 10959566063dSJacob Faibussowitsch PetscCall(PetscMalloc2(dT, &workT2, dF, &workF2)); 10969566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(Nk * dT, &wedgeMat)); 10973f27d899SToby Isaac sign = (PetscAbsInt(kTrace * kFiber) & 1) ? -1. : 1.; 10983f27d899SToby Isaac for (i = 0, iF = 0; iF < mFiber; iF++) { 10993f27d899SToby Isaac PetscInt ncolsF, nformsF; 11003f27d899SToby Isaac const PetscInt *colsF; 11013f27d899SToby Isaac const PetscScalar *valsF; 11023f27d899SToby Isaac 11039566063dSJacob Faibussowitsch PetscCall(MatGetRow(fiber, iF, &ncolsF, &colsF, &valsF)); 11043f27d899SToby Isaac nformsF = ncolsF / NkFiber; 11053f27d899SToby Isaac for (iT = 0; iT < mTrace; iT++, i++) { 11063f27d899SToby Isaac PetscInt ncolsT, nformsT; 11073f27d899SToby Isaac const PetscInt *colsT; 11083f27d899SToby Isaac const PetscScalar *valsT; 11093f27d899SToby Isaac 11109566063dSJacob Faibussowitsch PetscCall(MatGetRow(trace, iT, &ncolsT, &colsT, &valsT)); 11113f27d899SToby Isaac nformsT = ncolsT / NkTrace; 11123f27d899SToby Isaac for (j = 0, jF = 0; jF < nformsF; jF++) { 11133f27d899SToby Isaac PetscInt colF = colsF[jF * NkFiber] / NkFiber; 11143f27d899SToby Isaac 11153f27d899SToby Isaac for (il = 0; il < dF; il++) { 11163f27d899SToby Isaac PetscReal val = 0.; 11173f27d899SToby Isaac for (jl = 0; jl < NkFiber; jl++) val += projFstar[il * NkFiber + jl] * PetscRealPart(valsF[jF * NkFiber + jl]); 11183f27d899SToby Isaac workF[il] = val; 11193f27d899SToby Isaac } 11203f27d899SToby Isaac if (kFiber < 0) { 11213f27d899SToby Isaac for (il = 0; il < dF; il++) workF2[il] = workF[il]; 11229566063dSJacob Faibussowitsch PetscCall(PetscDTAltVStar(dim, PetscAbsInt(kFiber), 1, workF2, workF)); 11233f27d899SToby Isaac } 11249566063dSJacob Faibussowitsch PetscCall(PetscDTAltVWedgeMatrix(dim, PetscAbsInt(kFiber), PetscAbsInt(kTrace), workF, wedgeMat)); 11253f27d899SToby Isaac for (jT = 0; jT < nformsT; jT++, j++) { 11263f27d899SToby Isaac PetscInt colT = colsT[jT * NkTrace] / NkTrace; 11273f27d899SToby Isaac PetscInt col = colF * (nTrace / NkTrace) + colT; 11283f27d899SToby Isaac const PetscScalar *vals; 11293f27d899SToby Isaac 11303f27d899SToby Isaac for (il = 0; il < dT; il++) { 11313f27d899SToby Isaac PetscReal val = 0.; 11323f27d899SToby Isaac for (jl = 0; jl < NkTrace; jl++) val += projTstar[il * NkTrace + jl] * PetscRealPart(valsT[jT * NkTrace + jl]); 11333f27d899SToby Isaac workT[il] = val; 11343f27d899SToby Isaac } 11353f27d899SToby Isaac if (kTrace < 0) { 11363f27d899SToby Isaac for (il = 0; il < dT; il++) workT2[il] = workT[il]; 11379566063dSJacob Faibussowitsch PetscCall(PetscDTAltVStar(dim, PetscAbsInt(kTrace), 1, workT2, workT)); 11383f27d899SToby Isaac } 11393f27d899SToby Isaac 11403f27d899SToby Isaac for (il = 0; il < Nk; il++) { 11413f27d899SToby Isaac PetscReal val = 0.; 11423f27d899SToby Isaac for (jl = 0; jl < dT; jl++) val += sign * wedgeMat[il * dT + jl] * workT[jl]; 11433f27d899SToby Isaac work[il] = val; 11443f27d899SToby Isaac } 11453f27d899SToby Isaac if (k < 0) { 11469566063dSJacob Faibussowitsch PetscCall(PetscDTAltVStar(dim, PetscAbsInt(k), -1, work, workstar)); 11473f27d899SToby Isaac #if defined(PETSC_USE_COMPLEX) 11483f27d899SToby Isaac for (l = 0; l < Nk; l++) workS[l] = workstar[l]; 11493f27d899SToby Isaac vals = &workS[0]; 11503f27d899SToby Isaac #else 11513f27d899SToby Isaac vals = &workstar[0]; 11523f27d899SToby Isaac #endif 11533f27d899SToby Isaac } else { 11543f27d899SToby Isaac #if defined(PETSC_USE_COMPLEX) 11553f27d899SToby Isaac for (l = 0; l < Nk; l++) workS[l] = work[l]; 11563f27d899SToby Isaac vals = &workS[0]; 11573f27d899SToby Isaac #else 11583f27d899SToby Isaac vals = &work[0]; 11593f27d899SToby Isaac #endif 11603f27d899SToby Isaac } 116148a46eb9SPierre Jolivet for (l = 0; l < Nk; l++) PetscCall(MatSetValue(prod, i, col * Nk + l, vals[l], INSERT_VALUES)); /* Nk */ 11623f27d899SToby Isaac } /* jT */ 11633f27d899SToby Isaac } /* jF */ 11649566063dSJacob Faibussowitsch PetscCall(MatRestoreRow(trace, iT, &ncolsT, &colsT, &valsT)); 11653f27d899SToby Isaac } /* iT */ 11669566063dSJacob Faibussowitsch PetscCall(MatRestoreRow(fiber, iF, &ncolsF, &colsF, &valsF)); 11673f27d899SToby Isaac } /* iF */ 11689566063dSJacob Faibussowitsch PetscCall(PetscFree(wedgeMat)); 11699566063dSJacob Faibussowitsch PetscCall(PetscFree4(projT, projF, projTstar, projFstar)); 11709566063dSJacob Faibussowitsch PetscCall(PetscFree2(workT2, workF2)); 11719566063dSJacob Faibussowitsch PetscCall(PetscFree5(workT, workF, work, workstar, workS)); 11729566063dSJacob Faibussowitsch PetscCall(MatAssemblyBegin(prod, MAT_FINAL_ASSEMBLY)); 11739566063dSJacob Faibussowitsch PetscCall(MatAssemblyEnd(prod, MAT_FINAL_ASSEMBLY)); 11743f27d899SToby Isaac *product = prod; 11753ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 11763f27d899SToby Isaac } 11773f27d899SToby Isaac 1178aaa8cc7dSPierre Jolivet /* Union of quadrature points, with an attempt to identify common points in the two sets */ 1179d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscQuadraturePointsMerge(PetscQuadrature quadA, PetscQuadrature quadB, PetscQuadrature *quadJoint, PetscInt *aToJoint[], PetscInt *bToJoint[]) 1180d71ae5a4SJacob Faibussowitsch { 11813f27d899SToby Isaac PetscInt dimA, dimB; 11823f27d899SToby Isaac PetscInt nA, nB, nJoint, i, j, d; 11833f27d899SToby Isaac const PetscReal *pointsA; 11843f27d899SToby Isaac const PetscReal *pointsB; 11853f27d899SToby Isaac PetscReal *pointsJoint; 11863f27d899SToby Isaac PetscInt *aToJ, *bToJ; 11873f27d899SToby Isaac PetscQuadrature qJ; 11883f27d899SToby Isaac 11893f27d899SToby Isaac PetscFunctionBegin; 11909566063dSJacob Faibussowitsch PetscCall(PetscQuadratureGetData(quadA, &dimA, NULL, &nA, &pointsA, NULL)); 11919566063dSJacob Faibussowitsch PetscCall(PetscQuadratureGetData(quadB, &dimB, NULL, &nB, &pointsB, NULL)); 119208401ef6SPierre Jolivet PetscCheck(dimA == dimB, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Quadrature points must be in the same dimension"); 11933f27d899SToby Isaac nJoint = nA; 11949566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nA, &aToJ)); 11953f27d899SToby Isaac for (i = 0; i < nA; i++) aToJ[i] = i; 11969566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nB, &bToJ)); 11973f27d899SToby Isaac for (i = 0; i < nB; i++) { 11983f27d899SToby Isaac for (j = 0; j < nA; j++) { 11993f27d899SToby Isaac bToJ[i] = -1; 12009371c9d4SSatish Balay for (d = 0; d < dimA; d++) 12019371c9d4SSatish Balay if (PetscAbsReal(pointsB[i * dimA + d] - pointsA[j * dimA + d]) > PETSC_SMALL) break; 12023f27d899SToby Isaac if (d == dimA) { 12033f27d899SToby Isaac bToJ[i] = j; 12043f27d899SToby Isaac break; 12053f27d899SToby Isaac } 12063f27d899SToby Isaac } 1207ad540459SPierre Jolivet if (bToJ[i] == -1) bToJ[i] = nJoint++; 12083f27d899SToby Isaac } 12093f27d899SToby Isaac *aToJoint = aToJ; 12103f27d899SToby Isaac *bToJoint = bToJ; 12119566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nJoint * dimA, &pointsJoint)); 12129566063dSJacob Faibussowitsch PetscCall(PetscArraycpy(pointsJoint, pointsA, nA * dimA)); 12133f27d899SToby Isaac for (i = 0; i < nB; i++) { 12143f27d899SToby Isaac if (bToJ[i] >= nA) { 12153f27d899SToby Isaac for (d = 0; d < dimA; d++) pointsJoint[bToJ[i] * dimA + d] = pointsB[i * dimA + d]; 12163f27d899SToby Isaac } 12173f27d899SToby Isaac } 12189566063dSJacob Faibussowitsch PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, &qJ)); 12199566063dSJacob Faibussowitsch PetscCall(PetscQuadratureSetData(qJ, dimA, 0, nJoint, pointsJoint, NULL)); 12203f27d899SToby Isaac *quadJoint = qJ; 12213ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 12223f27d899SToby Isaac } 12233f27d899SToby Isaac 122477f1a120SToby Isaac /* Matrices matA and matB are both quadrature -> dof matrices: produce a matrix that is joint quadrature -> union of 122577f1a120SToby Isaac * dofs, where the joint quadrature was produced by PetscQuadraturePointsMerge */ 1226d71ae5a4SJacob Faibussowitsch static PetscErrorCode MatricesMerge(Mat matA, Mat matB, PetscInt dim, PetscInt k, PetscInt numMerged, const PetscInt aToMerged[], const PetscInt bToMerged[], Mat *matMerged) 1227d71ae5a4SJacob Faibussowitsch { 12283f27d899SToby Isaac PetscInt m, n, mA, nA, mB, nB, Nk, i, j, l; 12293f27d899SToby Isaac Mat M; 12303f27d899SToby Isaac PetscInt *nnz; 12313f27d899SToby Isaac PetscInt maxnnz; 12323f27d899SToby Isaac PetscInt *work; 12333f27d899SToby Isaac 12343f27d899SToby Isaac PetscFunctionBegin; 12359566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk)); 12369566063dSJacob Faibussowitsch PetscCall(MatGetSize(matA, &mA, &nA)); 123708401ef6SPierre Jolivet PetscCheck(nA % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "matA column space not a multiple of k-form size"); 12389566063dSJacob Faibussowitsch PetscCall(MatGetSize(matB, &mB, &nB)); 123908401ef6SPierre Jolivet PetscCheck(nB % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "matB column space not a multiple of k-form size"); 12403f27d899SToby Isaac m = mA + mB; 12413f27d899SToby Isaac n = numMerged * Nk; 12429566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(m, &nnz)); 12433f27d899SToby Isaac maxnnz = 0; 12443f27d899SToby Isaac for (i = 0; i < mA; i++) { 12459566063dSJacob Faibussowitsch PetscCall(MatGetRow(matA, i, &(nnz[i]), NULL, NULL)); 124608401ef6SPierre Jolivet PetscCheck(nnz[i] % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in matA are not in k-form size blocks"); 12473f27d899SToby Isaac maxnnz = PetscMax(maxnnz, nnz[i]); 12483f27d899SToby Isaac } 12493f27d899SToby Isaac for (i = 0; i < mB; i++) { 12509566063dSJacob Faibussowitsch PetscCall(MatGetRow(matB, i, &(nnz[i + mA]), NULL, NULL)); 125108401ef6SPierre Jolivet PetscCheck(nnz[i + mA] % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in matB are not in k-form size blocks"); 12523f27d899SToby Isaac maxnnz = PetscMax(maxnnz, nnz[i + mA]); 12533f27d899SToby Isaac } 12549566063dSJacob Faibussowitsch PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, m, n, 0, nnz, &M)); 12559566063dSJacob Faibussowitsch PetscCall(PetscFree(nnz)); 12563f27d899SToby Isaac /* reasoning about which points each dof needs depends on having zeros computed at points preserved */ 12579566063dSJacob Faibussowitsch PetscCall(MatSetOption(M, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE)); 12589566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(maxnnz, &work)); 12593f27d899SToby Isaac for (i = 0; i < mA; i++) { 12603f27d899SToby Isaac const PetscInt *cols; 12613f27d899SToby Isaac const PetscScalar *vals; 12623f27d899SToby Isaac PetscInt nCols; 12639566063dSJacob Faibussowitsch PetscCall(MatGetRow(matA, i, &nCols, &cols, &vals)); 12643f27d899SToby Isaac for (j = 0; j < nCols / Nk; j++) { 12653f27d899SToby Isaac PetscInt newCol = aToMerged[cols[j * Nk] / Nk]; 12663f27d899SToby Isaac for (l = 0; l < Nk; l++) work[j * Nk + l] = newCol * Nk + l; 12673f27d899SToby Isaac } 12689566063dSJacob Faibussowitsch PetscCall(MatSetValuesBlocked(M, 1, &i, nCols, work, vals, INSERT_VALUES)); 12699566063dSJacob Faibussowitsch PetscCall(MatRestoreRow(matA, i, &nCols, &cols, &vals)); 12703f27d899SToby Isaac } 12713f27d899SToby Isaac for (i = 0; i < mB; i++) { 12723f27d899SToby Isaac const PetscInt *cols; 12733f27d899SToby Isaac const PetscScalar *vals; 12743f27d899SToby Isaac 12753f27d899SToby Isaac PetscInt row = i + mA; 12763f27d899SToby Isaac PetscInt nCols; 12779566063dSJacob Faibussowitsch PetscCall(MatGetRow(matB, i, &nCols, &cols, &vals)); 12783f27d899SToby Isaac for (j = 0; j < nCols / Nk; j++) { 12793f27d899SToby Isaac PetscInt newCol = bToMerged[cols[j * Nk] / Nk]; 12803f27d899SToby Isaac for (l = 0; l < Nk; l++) work[j * Nk + l] = newCol * Nk + l; 12813f27d899SToby Isaac } 12829566063dSJacob Faibussowitsch PetscCall(MatSetValuesBlocked(M, 1, &row, nCols, work, vals, INSERT_VALUES)); 12839566063dSJacob Faibussowitsch PetscCall(MatRestoreRow(matB, i, &nCols, &cols, &vals)); 12843f27d899SToby Isaac } 12859566063dSJacob Faibussowitsch PetscCall(PetscFree(work)); 12869566063dSJacob Faibussowitsch PetscCall(MatAssemblyBegin(M, MAT_FINAL_ASSEMBLY)); 12879566063dSJacob Faibussowitsch PetscCall(MatAssemblyEnd(M, MAT_FINAL_ASSEMBLY)); 12883f27d899SToby Isaac *matMerged = M; 12893ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 12903f27d899SToby Isaac } 12913f27d899SToby Isaac 129277f1a120SToby Isaac /* Take a dual space and product a segment space that has all the same specifications (trimmed, continuous, order, 129377f1a120SToby Isaac * node set), except for the form degree. For computing boundary dofs and for making tensor product spaces */ 1294d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceCreateFacetSubspace_Lagrange(PetscDualSpace sp, DM K, PetscInt f, PetscInt k, PetscInt Ncopies, PetscBool interiorOnly, PetscDualSpace *bdsp) 1295d71ae5a4SJacob Faibussowitsch { 12963f27d899SToby Isaac PetscInt Nknew, Ncnew; 12973f27d899SToby Isaac PetscInt dim, pointDim = -1; 12983f27d899SToby Isaac PetscInt depth; 12993f27d899SToby Isaac DM dm; 13003f27d899SToby Isaac PetscDualSpace_Lag *newlag; 13013f27d899SToby Isaac 13023f27d899SToby Isaac PetscFunctionBegin; 13039566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetDM(sp, &dm)); 13049566063dSJacob Faibussowitsch PetscCall(DMGetDimension(dm, &dim)); 13059566063dSJacob Faibussowitsch PetscCall(DMPlexGetDepth(dm, &depth)); 13069566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceDuplicate(sp, bdsp)); 13079566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetFormDegree(*bdsp, k)); 13083f27d899SToby Isaac if (!K) { 13093f27d899SToby Isaac if (depth == dim) { 1310f783ec47SMatthew G. Knepley DMPolytopeType ct; 13113f27d899SToby Isaac 13126ff15688SToby Isaac pointDim = dim - 1; 13139566063dSJacob Faibussowitsch PetscCall(DMPlexGetCellType(dm, f, &ct)); 13149566063dSJacob Faibussowitsch PetscCall(DMPlexCreateReferenceCell(PETSC_COMM_SELF, ct, &K)); 13153f27d899SToby Isaac } else if (depth == 1) { 13163f27d899SToby Isaac pointDim = 0; 13179566063dSJacob Faibussowitsch PetscCall(DMPlexCreateReferenceCell(PETSC_COMM_SELF, DM_POLYTOPE_POINT, &K)); 13183f27d899SToby Isaac } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unsupported interpolation state of reference element"); 13193f27d899SToby Isaac } else { 13209566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)K)); 13219566063dSJacob Faibussowitsch PetscCall(DMGetDimension(K, &pointDim)); 13223f27d899SToby Isaac } 13239566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetDM(*bdsp, K)); 13249566063dSJacob Faibussowitsch PetscCall(DMDestroy(&K)); 13259566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(pointDim, PetscAbsInt(k), &Nknew)); 13263f27d899SToby Isaac Ncnew = Nknew * Ncopies; 13279566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetNumComponents(*bdsp, Ncnew)); 13283f27d899SToby Isaac newlag = (PetscDualSpace_Lag *)(*bdsp)->data; 13293f27d899SToby Isaac newlag->interiorOnly = interiorOnly; 13309566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetUp(*bdsp)); 13313ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 13323f27d899SToby Isaac } 13333f27d899SToby Isaac 133477f1a120SToby Isaac /* Construct simplex nodes from a nodefamily, add Nk dof vectors of length Nk at each node. 133577f1a120SToby Isaac * Return the (quadrature, matrix) form of the dofs and the nodeIndices form as well. 133677f1a120SToby Isaac * 133777f1a120SToby Isaac * Sometimes we want a set of nodes to be contained in the interior of the element, 133877f1a120SToby Isaac * even when the node scheme puts nodes on the boundaries. numNodeSkip tells 133977f1a120SToby Isaac * the routine how many "layers" of nodes need to be skipped. 134077f1a120SToby Isaac * */ 1341d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeCreateSimplexNodeMat(Petsc1DNodeFamily nodeFamily, PetscInt dim, PetscInt sum, PetscInt Nk, PetscInt numNodeSkip, PetscQuadrature *iNodes, Mat *iMat, PetscLagNodeIndices *nodeIndices) 1342d71ae5a4SJacob Faibussowitsch { 13433f27d899SToby Isaac PetscReal *extraNodeCoords, *nodeCoords; 13443f27d899SToby Isaac PetscInt nNodes, nExtraNodes; 13453f27d899SToby Isaac PetscInt i, j, k, extraSum = sum + numNodeSkip * (1 + dim); 13463f27d899SToby Isaac PetscQuadrature intNodes; 13473f27d899SToby Isaac Mat intMat; 13483f27d899SToby Isaac PetscLagNodeIndices ni; 13493f27d899SToby Isaac 13503f27d899SToby Isaac PetscFunctionBegin; 13519566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim + sum, dim, &nNodes)); 13529566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim + extraSum, dim, &nExtraNodes)); 13533f27d899SToby Isaac 13549566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(dim * nExtraNodes, &extraNodeCoords)); 13559566063dSJacob Faibussowitsch PetscCall(PetscNew(&ni)); 13563f27d899SToby Isaac ni->nodeIdxDim = dim + 1; 13573f27d899SToby Isaac ni->nodeVecDim = Nk; 13583f27d899SToby Isaac ni->nNodes = nNodes * Nk; 13593f27d899SToby Isaac ni->refct = 1; 13609566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nNodes * Nk * (dim + 1), &(ni->nodeIdx))); 13619566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nNodes * Nk * Nk, &(ni->nodeVec))); 13629371c9d4SSatish Balay for (i = 0; i < nNodes; i++) 13639371c9d4SSatish Balay for (j = 0; j < Nk; j++) 13649371c9d4SSatish Balay for (k = 0; k < Nk; k++) ni->nodeVec[(i * Nk + j) * Nk + k] = (j == k) ? 1. : 0.; 13659566063dSJacob Faibussowitsch PetscCall(Petsc1DNodeFamilyComputeSimplexNodes(nodeFamily, dim, extraSum, extraNodeCoords)); 13663f27d899SToby Isaac if (numNodeSkip) { 13673f27d899SToby Isaac PetscInt k; 13683f27d899SToby Isaac PetscInt *tup; 13693f27d899SToby Isaac 13709566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(dim * nNodes, &nodeCoords)); 13719566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(dim + 1, &tup)); 13723f27d899SToby Isaac for (k = 0; k < nNodes; k++) { 13733f27d899SToby Isaac PetscInt j, c; 13743f27d899SToby Isaac PetscInt index; 13753f27d899SToby Isaac 13769566063dSJacob Faibussowitsch PetscCall(PetscDTIndexToBary(dim + 1, sum, k, tup)); 13773f27d899SToby Isaac for (j = 0; j < dim + 1; j++) tup[j] += numNodeSkip; 13783f27d899SToby Isaac for (c = 0; c < Nk; c++) { 1379ad540459SPierre Jolivet for (j = 0; j < dim + 1; j++) ni->nodeIdx[(k * Nk + c) * (dim + 1) + j] = tup[j] + 1; 13803f27d899SToby Isaac } 13819566063dSJacob Faibussowitsch PetscCall(PetscDTBaryToIndex(dim + 1, extraSum, tup, &index)); 13823f27d899SToby Isaac for (j = 0; j < dim; j++) nodeCoords[k * dim + j] = extraNodeCoords[index * dim + j]; 13833f27d899SToby Isaac } 13849566063dSJacob Faibussowitsch PetscCall(PetscFree(tup)); 13859566063dSJacob Faibussowitsch PetscCall(PetscFree(extraNodeCoords)); 13863f27d899SToby Isaac } else { 13873f27d899SToby Isaac PetscInt k; 13883f27d899SToby Isaac PetscInt *tup; 13893f27d899SToby Isaac 13903f27d899SToby Isaac nodeCoords = extraNodeCoords; 13919566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(dim + 1, &tup)); 13923f27d899SToby Isaac for (k = 0; k < nNodes; k++) { 13933f27d899SToby Isaac PetscInt j, c; 13943f27d899SToby Isaac 13959566063dSJacob Faibussowitsch PetscCall(PetscDTIndexToBary(dim + 1, sum, k, tup)); 13963f27d899SToby Isaac for (c = 0; c < Nk; c++) { 13973f27d899SToby Isaac for (j = 0; j < dim + 1; j++) { 13983f27d899SToby Isaac /* barycentric indices can have zeros, but we don't want to push forward zeros because it makes it harder to 139977f1a120SToby Isaac * determine which nodes correspond to which under symmetries, so we increase by 1. This is fine 140077f1a120SToby Isaac * because the nodeIdx coordinates don't have any meaning other than helping to identify symmetries */ 14013f27d899SToby Isaac ni->nodeIdx[(k * Nk + c) * (dim + 1) + j] = tup[j] + 1; 14023f27d899SToby Isaac } 14033f27d899SToby Isaac } 14043f27d899SToby Isaac } 14059566063dSJacob Faibussowitsch PetscCall(PetscFree(tup)); 14063f27d899SToby Isaac } 14079566063dSJacob Faibussowitsch PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, &intNodes)); 14089566063dSJacob Faibussowitsch PetscCall(PetscQuadratureSetData(intNodes, dim, 0, nNodes, nodeCoords, NULL)); 14099566063dSJacob Faibussowitsch PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, nNodes * Nk, nNodes * Nk, Nk, NULL, &intMat)); 14109566063dSJacob Faibussowitsch PetscCall(MatSetOption(intMat, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE)); 14113f27d899SToby Isaac for (j = 0; j < nNodes * Nk; j++) { 14123f27d899SToby Isaac PetscInt rem = j % Nk; 14133f27d899SToby Isaac PetscInt a, aprev = j - rem; 14143f27d899SToby Isaac PetscInt anext = aprev + Nk; 14153f27d899SToby Isaac 141648a46eb9SPierre Jolivet for (a = aprev; a < anext; a++) PetscCall(MatSetValue(intMat, j, a, (a == j) ? 1. : 0., INSERT_VALUES)); 14173f27d899SToby Isaac } 14189566063dSJacob Faibussowitsch PetscCall(MatAssemblyBegin(intMat, MAT_FINAL_ASSEMBLY)); 14199566063dSJacob Faibussowitsch PetscCall(MatAssemblyEnd(intMat, MAT_FINAL_ASSEMBLY)); 14203f27d899SToby Isaac *iNodes = intNodes; 14213f27d899SToby Isaac *iMat = intMat; 14223f27d899SToby Isaac *nodeIndices = ni; 14233ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 14243f27d899SToby Isaac } 14253f27d899SToby Isaac 142677f1a120SToby Isaac /* once the nodeIndices have been created for the interior of the reference cell, and for all of the boundary cells, 1427a5b23f4aSJose E. Roman * push forward the boundary dofs and concatenate them into the full node indices for the dual space */ 1428d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeCreateAllNodeIdx(PetscDualSpace sp) 1429d71ae5a4SJacob Faibussowitsch { 14303f27d899SToby Isaac DM dm; 14313f27d899SToby Isaac PetscInt dim, nDofs; 14323f27d899SToby Isaac PetscSection section; 14333f27d899SToby Isaac PetscInt pStart, pEnd, p; 14343f27d899SToby Isaac PetscInt formDegree, Nk; 14353f27d899SToby Isaac PetscInt nodeIdxDim, spintdim; 14363f27d899SToby Isaac PetscDualSpace_Lag *lag; 14373f27d899SToby Isaac PetscLagNodeIndices ni, verti; 14383f27d899SToby Isaac 14393f27d899SToby Isaac PetscFunctionBegin; 14403f27d899SToby Isaac lag = (PetscDualSpace_Lag *)sp->data; 14413f27d899SToby Isaac verti = lag->vertIndices; 14429566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetDM(sp, &dm)); 14439566063dSJacob Faibussowitsch PetscCall(DMGetDimension(dm, &dim)); 14449566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetFormDegree(sp, &formDegree)); 14459566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk)); 14469566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetSection(sp, §ion)); 14479566063dSJacob Faibussowitsch PetscCall(PetscSectionGetStorageSize(section, &nDofs)); 14489566063dSJacob Faibussowitsch PetscCall(PetscNew(&ni)); 14493f27d899SToby Isaac ni->nodeIdxDim = nodeIdxDim = verti->nodeIdxDim; 14503f27d899SToby Isaac ni->nodeVecDim = Nk; 14513f27d899SToby Isaac ni->nNodes = nDofs; 14523f27d899SToby Isaac ni->refct = 1; 14539566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nodeIdxDim * nDofs, &(ni->nodeIdx))); 14549566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(Nk * nDofs, &(ni->nodeVec))); 14559566063dSJacob Faibussowitsch PetscCall(DMPlexGetChart(dm, &pStart, &pEnd)); 14569566063dSJacob Faibussowitsch PetscCall(PetscSectionGetDof(section, 0, &spintdim)); 14573f27d899SToby Isaac if (spintdim) { 14589566063dSJacob Faibussowitsch PetscCall(PetscArraycpy(ni->nodeIdx, lag->intNodeIndices->nodeIdx, spintdim * nodeIdxDim)); 14599566063dSJacob Faibussowitsch PetscCall(PetscArraycpy(ni->nodeVec, lag->intNodeIndices->nodeVec, spintdim * Nk)); 14603f27d899SToby Isaac } 14613f27d899SToby Isaac for (p = pStart + 1; p < pEnd; p++) { 14623f27d899SToby Isaac PetscDualSpace psp = sp->pointSpaces[p]; 14633f27d899SToby Isaac PetscDualSpace_Lag *plag; 14643f27d899SToby Isaac PetscInt dof, off; 14653f27d899SToby Isaac 14669566063dSJacob Faibussowitsch PetscCall(PetscSectionGetDof(section, p, &dof)); 14673f27d899SToby Isaac if (!dof) continue; 14683f27d899SToby Isaac plag = (PetscDualSpace_Lag *)psp->data; 14699566063dSJacob Faibussowitsch PetscCall(PetscSectionGetOffset(section, p, &off)); 14709566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesPushForward(dm, verti, p, plag->vertIndices, plag->intNodeIndices, 0, formDegree, &(ni->nodeIdx[off * nodeIdxDim]), &(ni->nodeVec[off * Nk]))); 14713f27d899SToby Isaac } 14723f27d899SToby Isaac lag->allNodeIndices = ni; 14733ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 14743f27d899SToby Isaac } 14753f27d899SToby Isaac 147677f1a120SToby Isaac /* once the (quadrature, Matrix) forms of the dofs have been created for the interior of the 147777f1a120SToby Isaac * reference cell and for the boundary cells, jk 147877f1a120SToby Isaac * push forward the boundary data and concatenate them into the full (quadrature, matrix) data 147977f1a120SToby Isaac * for the dual space */ 1480d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceCreateAllDataFromInteriorData(PetscDualSpace sp) 1481d71ae5a4SJacob Faibussowitsch { 14823f27d899SToby Isaac DM dm; 14833f27d899SToby Isaac PetscSection section; 14843f27d899SToby Isaac PetscInt pStart, pEnd, p, k, Nk, dim, Nc; 14853f27d899SToby Isaac PetscInt nNodes; 14863f27d899SToby Isaac PetscInt countNodes; 14873f27d899SToby Isaac Mat allMat; 14883f27d899SToby Isaac PetscQuadrature allNodes; 14893f27d899SToby Isaac PetscInt nDofs; 14903f27d899SToby Isaac PetscInt maxNzforms, j; 14913f27d899SToby Isaac PetscScalar *work; 14923f27d899SToby Isaac PetscReal *L, *J, *Jinv, *v0, *pv0; 14933f27d899SToby Isaac PetscInt *iwork; 14943f27d899SToby Isaac PetscReal *nodes; 14953f27d899SToby Isaac 14963f27d899SToby Isaac PetscFunctionBegin; 14979566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetDM(sp, &dm)); 14989566063dSJacob Faibussowitsch PetscCall(DMGetDimension(dm, &dim)); 14999566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetSection(sp, §ion)); 15009566063dSJacob Faibussowitsch PetscCall(PetscSectionGetStorageSize(section, &nDofs)); 15019566063dSJacob Faibussowitsch PetscCall(DMPlexGetChart(dm, &pStart, &pEnd)); 15029566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetFormDegree(sp, &k)); 15039566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetNumComponents(sp, &Nc)); 15049566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk)); 15053f27d899SToby Isaac for (p = pStart, nNodes = 0, maxNzforms = 0; p < pEnd; p++) { 15063f27d899SToby Isaac PetscDualSpace psp; 15073f27d899SToby Isaac DM pdm; 15083f27d899SToby Isaac PetscInt pdim, pNk; 15093f27d899SToby Isaac PetscQuadrature intNodes; 15103f27d899SToby Isaac Mat intMat; 15113f27d899SToby Isaac 15129566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetPointSubspace(sp, p, &psp)); 15133f27d899SToby Isaac if (!psp) continue; 15149566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetDM(psp, &pdm)); 15159566063dSJacob Faibussowitsch PetscCall(DMGetDimension(pdm, &pdim)); 15163f27d899SToby Isaac if (pdim < PetscAbsInt(k)) continue; 15179566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(pdim, PetscAbsInt(k), &pNk)); 15189566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetInteriorData(psp, &intNodes, &intMat)); 15193f27d899SToby Isaac if (intNodes) { 15203f27d899SToby Isaac PetscInt nNodesp; 15213f27d899SToby Isaac 15229566063dSJacob Faibussowitsch PetscCall(PetscQuadratureGetData(intNodes, NULL, NULL, &nNodesp, NULL, NULL)); 15233f27d899SToby Isaac nNodes += nNodesp; 15243f27d899SToby Isaac } 15253f27d899SToby Isaac if (intMat) { 15263f27d899SToby Isaac PetscInt maxNzsp; 15273f27d899SToby Isaac PetscInt maxNzformsp; 15283f27d899SToby Isaac 15299566063dSJacob Faibussowitsch PetscCall(MatSeqAIJGetMaxRowNonzeros(intMat, &maxNzsp)); 153008401ef6SPierre Jolivet PetscCheck(maxNzsp % pNk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms"); 15313f27d899SToby Isaac maxNzformsp = maxNzsp / pNk; 15323f27d899SToby Isaac maxNzforms = PetscMax(maxNzforms, maxNzformsp); 15333f27d899SToby Isaac } 15343f27d899SToby Isaac } 15359566063dSJacob Faibussowitsch PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, nDofs, nNodes * Nc, maxNzforms * Nk, NULL, &allMat)); 15369566063dSJacob Faibussowitsch PetscCall(MatSetOption(allMat, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE)); 15379566063dSJacob Faibussowitsch PetscCall(PetscMalloc7(dim, &v0, dim, &pv0, dim * dim, &J, dim * dim, &Jinv, Nk * Nk, &L, maxNzforms * Nk, &work, maxNzforms * Nk, &iwork)); 15383f27d899SToby Isaac for (j = 0; j < dim; j++) pv0[j] = -1.; 15399566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(dim * nNodes, &nodes)); 15403f27d899SToby Isaac for (p = pStart, countNodes = 0; p < pEnd; p++) { 15413f27d899SToby Isaac PetscDualSpace psp; 15423f27d899SToby Isaac PetscQuadrature intNodes; 15433f27d899SToby Isaac DM pdm; 15443f27d899SToby Isaac PetscInt pdim, pNk; 15453f27d899SToby Isaac PetscInt countNodesIn = countNodes; 15463f27d899SToby Isaac PetscReal detJ; 15473f27d899SToby Isaac Mat intMat; 15483f27d899SToby Isaac 15499566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetPointSubspace(sp, p, &psp)); 15503f27d899SToby Isaac if (!psp) continue; 15519566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetDM(psp, &pdm)); 15529566063dSJacob Faibussowitsch PetscCall(DMGetDimension(pdm, &pdim)); 15533f27d899SToby Isaac if (pdim < PetscAbsInt(k)) continue; 15549566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetInteriorData(psp, &intNodes, &intMat)); 15553f27d899SToby Isaac if (intNodes == NULL && intMat == NULL) continue; 15569566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(pdim, PetscAbsInt(k), &pNk)); 15573f27d899SToby Isaac if (p) { 15589566063dSJacob Faibussowitsch PetscCall(DMPlexComputeCellGeometryAffineFEM(dm, p, v0, J, Jinv, &detJ)); 15593f27d899SToby Isaac } else { /* identity */ 15603f27d899SToby Isaac PetscInt i, j; 15613f27d899SToby Isaac 15629371c9d4SSatish Balay for (i = 0; i < dim; i++) 15639371c9d4SSatish Balay for (j = 0; j < dim; j++) J[i * dim + j] = Jinv[i * dim + j] = 0.; 15643f27d899SToby Isaac for (i = 0; i < dim; i++) J[i * dim + i] = Jinv[i * dim + i] = 1.; 15653f27d899SToby Isaac for (i = 0; i < dim; i++) v0[i] = -1.; 15663f27d899SToby Isaac } 15673f27d899SToby Isaac if (pdim != dim) { /* compactify Jacobian */ 15683f27d899SToby Isaac PetscInt i, j; 15693f27d899SToby Isaac 15709371c9d4SSatish Balay for (i = 0; i < dim; i++) 15719371c9d4SSatish Balay for (j = 0; j < pdim; j++) J[i * pdim + j] = J[i * dim + j]; 15723f27d899SToby Isaac } 15739566063dSJacob Faibussowitsch PetscCall(PetscDTAltVPullbackMatrix(pdim, dim, J, k, L)); 157477f1a120SToby Isaac if (intNodes) { /* push forward quadrature locations by the affine transformation */ 15753f27d899SToby Isaac PetscInt nNodesp; 15763f27d899SToby Isaac const PetscReal *nodesp; 15773f27d899SToby Isaac PetscInt j; 15783f27d899SToby Isaac 15799566063dSJacob Faibussowitsch PetscCall(PetscQuadratureGetData(intNodes, NULL, NULL, &nNodesp, &nodesp, NULL)); 15803f27d899SToby Isaac for (j = 0; j < nNodesp; j++, countNodes++) { 15813f27d899SToby Isaac PetscInt d, e; 15823f27d899SToby Isaac 15833f27d899SToby Isaac for (d = 0; d < dim; d++) { 15843f27d899SToby Isaac nodes[countNodes * dim + d] = v0[d]; 1585ad540459SPierre Jolivet for (e = 0; e < pdim; e++) nodes[countNodes * dim + d] += J[d * pdim + e] * (nodesp[j * pdim + e] - pv0[e]); 15863f27d899SToby Isaac } 15873f27d899SToby Isaac } 15883f27d899SToby Isaac } 15893f27d899SToby Isaac if (intMat) { 15903f27d899SToby Isaac PetscInt nrows; 15913f27d899SToby Isaac PetscInt off; 15923f27d899SToby Isaac 15939566063dSJacob Faibussowitsch PetscCall(PetscSectionGetDof(section, p, &nrows)); 15949566063dSJacob Faibussowitsch PetscCall(PetscSectionGetOffset(section, p, &off)); 15953f27d899SToby Isaac for (j = 0; j < nrows; j++) { 15963f27d899SToby Isaac PetscInt ncols; 15973f27d899SToby Isaac const PetscInt *cols; 15983f27d899SToby Isaac const PetscScalar *vals; 15993f27d899SToby Isaac PetscInt l, d, e; 16003f27d899SToby Isaac PetscInt row = j + off; 16013f27d899SToby Isaac 16029566063dSJacob Faibussowitsch PetscCall(MatGetRow(intMat, j, &ncols, &cols, &vals)); 160308401ef6SPierre Jolivet PetscCheck(ncols % pNk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms"); 16043f27d899SToby Isaac for (l = 0; l < ncols / pNk; l++) { 16053f27d899SToby Isaac PetscInt blockcol; 16063f27d899SToby Isaac 1607ad540459SPierre Jolivet for (d = 0; d < pNk; d++) PetscCheck((cols[l * pNk + d] % pNk) == d, PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms"); 16083f27d899SToby Isaac blockcol = cols[l * pNk] / pNk; 1609ad540459SPierre Jolivet for (d = 0; d < Nk; d++) iwork[l * Nk + d] = (blockcol + countNodesIn) * Nk + d; 16103f27d899SToby Isaac for (d = 0; d < Nk; d++) work[l * Nk + d] = 0.; 16113f27d899SToby Isaac for (d = 0; d < Nk; d++) { 16123f27d899SToby Isaac for (e = 0; e < pNk; e++) { 16133f27d899SToby Isaac /* "push forward" dof by pulling back a k-form to be evaluated on the point: multiply on the right by L */ 16145efe5503SToby Isaac work[l * Nk + d] += vals[l * pNk + e] * L[e * Nk + d]; 16153f27d899SToby Isaac } 16163f27d899SToby Isaac } 16173f27d899SToby Isaac } 16189566063dSJacob Faibussowitsch PetscCall(MatSetValues(allMat, 1, &row, (ncols / pNk) * Nk, iwork, work, INSERT_VALUES)); 16199566063dSJacob Faibussowitsch PetscCall(MatRestoreRow(intMat, j, &ncols, &cols, &vals)); 16203f27d899SToby Isaac } 16213f27d899SToby Isaac } 16223f27d899SToby Isaac } 16239566063dSJacob Faibussowitsch PetscCall(MatAssemblyBegin(allMat, MAT_FINAL_ASSEMBLY)); 16249566063dSJacob Faibussowitsch PetscCall(MatAssemblyEnd(allMat, MAT_FINAL_ASSEMBLY)); 16259566063dSJacob Faibussowitsch PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, &allNodes)); 16269566063dSJacob Faibussowitsch PetscCall(PetscQuadratureSetData(allNodes, dim, 0, nNodes, nodes, NULL)); 16279566063dSJacob Faibussowitsch PetscCall(PetscFree7(v0, pv0, J, Jinv, L, work, iwork)); 16289566063dSJacob Faibussowitsch PetscCall(MatDestroy(&(sp->allMat))); 16293f27d899SToby Isaac sp->allMat = allMat; 16309566063dSJacob Faibussowitsch PetscCall(PetscQuadratureDestroy(&(sp->allNodes))); 16313f27d899SToby Isaac sp->allNodes = allNodes; 16323ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 16333f27d899SToby Isaac } 16343f27d899SToby Isaac 163577f1a120SToby Isaac /* rather than trying to get all data from the functionals, we create 163677f1a120SToby Isaac * the functionals from rows of the quadrature -> dof matrix. 163777f1a120SToby Isaac * 163877f1a120SToby Isaac * Ideally most of the uses of PetscDualSpace in PetscFE will switch 163977f1a120SToby Isaac * to using intMat and allMat, so that the individual functionals 164077f1a120SToby Isaac * don't need to be constructed at all */ 1641d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceComputeFunctionalsFromAllData(PetscDualSpace sp) 1642d71ae5a4SJacob Faibussowitsch { 16433f27d899SToby Isaac PetscQuadrature allNodes; 16443f27d899SToby Isaac Mat allMat; 16453f27d899SToby Isaac PetscInt nDofs; 16463f27d899SToby Isaac PetscInt dim, k, Nk, Nc, f; 16473f27d899SToby Isaac DM dm; 16483f27d899SToby Isaac PetscInt nNodes, spdim; 16493f27d899SToby Isaac const PetscReal *nodes = NULL; 16503f27d899SToby Isaac PetscSection section; 165166a6c23cSMatthew G. Knepley PetscBool useMoments; 16523f27d899SToby Isaac 16533f27d899SToby Isaac PetscFunctionBegin; 16549566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetDM(sp, &dm)); 16559566063dSJacob Faibussowitsch PetscCall(DMGetDimension(dm, &dim)); 16569566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetNumComponents(sp, &Nc)); 16579566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetFormDegree(sp, &k)); 16589566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk)); 16599566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetAllData(sp, &allNodes, &allMat)); 16603f27d899SToby Isaac nNodes = 0; 166148a46eb9SPierre Jolivet if (allNodes) PetscCall(PetscQuadratureGetData(allNodes, NULL, NULL, &nNodes, &nodes, NULL)); 16629566063dSJacob Faibussowitsch PetscCall(MatGetSize(allMat, &nDofs, NULL)); 16639566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetSection(sp, §ion)); 16649566063dSJacob Faibussowitsch PetscCall(PetscSectionGetStorageSize(section, &spdim)); 166508401ef6SPierre Jolivet PetscCheck(spdim == nDofs, PETSC_COMM_SELF, PETSC_ERR_PLIB, "incompatible all matrix size"); 16669566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nDofs, &(sp->functional))); 16679566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetUseMoments(sp, &useMoments)); 166866a6c23cSMatthew G. Knepley if (useMoments) { 166966a6c23cSMatthew G. Knepley Mat allMat; 167066a6c23cSMatthew G. Knepley PetscInt momentOrder, i; 1671eae3dc7dSJacob Faibussowitsch PetscBool tensor = PETSC_FALSE; 167266a6c23cSMatthew G. Knepley const PetscReal *weights; 167366a6c23cSMatthew G. Knepley PetscScalar *array; 167466a6c23cSMatthew G. Knepley 167563a3b9bcSJacob Faibussowitsch PetscCheck(nDofs == 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "We do not yet support moments beyond P0, nDofs == %" PetscInt_FMT, nDofs); 16769566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetMomentOrder(sp, &momentOrder)); 16779566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeGetTensor(sp, &tensor)); 16789566063dSJacob Faibussowitsch if (!tensor) PetscCall(PetscDTStroudConicalQuadrature(dim, Nc, PetscMax(momentOrder + 1, 1), -1.0, 1.0, &(sp->functional[0]))); 16799566063dSJacob Faibussowitsch else PetscCall(PetscDTGaussTensorQuadrature(dim, Nc, PetscMax(momentOrder + 1, 1), -1.0, 1.0, &(sp->functional[0]))); 168066a6c23cSMatthew G. Knepley /* Need to replace allNodes and allMat */ 16819566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)sp->functional[0])); 16829566063dSJacob Faibussowitsch PetscCall(PetscQuadratureDestroy(&(sp->allNodes))); 168366a6c23cSMatthew G. Knepley sp->allNodes = sp->functional[0]; 16849566063dSJacob Faibussowitsch PetscCall(PetscQuadratureGetData(sp->allNodes, NULL, NULL, &nNodes, NULL, &weights)); 16859566063dSJacob Faibussowitsch PetscCall(MatCreateSeqDense(PETSC_COMM_SELF, nDofs, nNodes * Nc, NULL, &allMat)); 16869566063dSJacob Faibussowitsch PetscCall(MatDenseGetArrayWrite(allMat, &array)); 168766a6c23cSMatthew G. Knepley for (i = 0; i < nNodes * Nc; ++i) array[i] = weights[i]; 16889566063dSJacob Faibussowitsch PetscCall(MatDenseRestoreArrayWrite(allMat, &array)); 16899566063dSJacob Faibussowitsch PetscCall(MatAssemblyBegin(allMat, MAT_FINAL_ASSEMBLY)); 16909566063dSJacob Faibussowitsch PetscCall(MatAssemblyEnd(allMat, MAT_FINAL_ASSEMBLY)); 16919566063dSJacob Faibussowitsch PetscCall(MatDestroy(&(sp->allMat))); 169266a6c23cSMatthew G. Knepley sp->allMat = allMat; 16933ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 169466a6c23cSMatthew G. Knepley } 16953f27d899SToby Isaac for (f = 0; f < nDofs; f++) { 16963f27d899SToby Isaac PetscInt ncols, c; 16973f27d899SToby Isaac const PetscInt *cols; 16983f27d899SToby Isaac const PetscScalar *vals; 16993f27d899SToby Isaac PetscReal *nodesf; 17003f27d899SToby Isaac PetscReal *weightsf; 17013f27d899SToby Isaac PetscInt nNodesf; 17023f27d899SToby Isaac PetscInt countNodes; 17033f27d899SToby Isaac 17049566063dSJacob Faibussowitsch PetscCall(MatGetRow(allMat, f, &ncols, &cols, &vals)); 170508401ef6SPierre Jolivet PetscCheck(ncols % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "all matrix is not laid out as blocks of k-forms"); 17063f27d899SToby Isaac for (c = 1, nNodesf = 1; c < ncols; c++) { 17073f27d899SToby Isaac if ((cols[c] / Nc) != (cols[c - 1] / Nc)) nNodesf++; 17083f27d899SToby Isaac } 17099566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(dim * nNodesf, &nodesf)); 17109566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(Nc * nNodesf, &weightsf)); 17113f27d899SToby Isaac for (c = 0, countNodes = 0; c < ncols; c++) { 17123f27d899SToby Isaac if (!c || ((cols[c] / Nc) != (cols[c - 1] / Nc))) { 17133f27d899SToby Isaac PetscInt d; 17143f27d899SToby Isaac 1715ad540459SPierre Jolivet for (d = 0; d < Nc; d++) weightsf[countNodes * Nc + d] = 0.; 1716ad540459SPierre Jolivet for (d = 0; d < dim; d++) nodesf[countNodes * dim + d] = nodes[(cols[c] / Nc) * dim + d]; 17173f27d899SToby Isaac countNodes++; 17183f27d899SToby Isaac } 17193f27d899SToby Isaac weightsf[(countNodes - 1) * Nc + (cols[c] % Nc)] = PetscRealPart(vals[c]); 17203f27d899SToby Isaac } 17219566063dSJacob Faibussowitsch PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, &(sp->functional[f]))); 17229566063dSJacob Faibussowitsch PetscCall(PetscQuadratureSetData(sp->functional[f], dim, Nc, nNodesf, nodesf, weightsf)); 17239566063dSJacob Faibussowitsch PetscCall(MatRestoreRow(allMat, f, &ncols, &cols, &vals)); 17243f27d899SToby Isaac } 17253ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 17263f27d899SToby Isaac } 17273f27d899SToby Isaac 17283f27d899SToby Isaac /* take a matrix meant for k-forms and expand it to one for Ncopies */ 1729d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeMatrixCreateCopies(Mat A, PetscInt Nk, PetscInt Ncopies, Mat *Abs) 1730d71ae5a4SJacob Faibussowitsch { 17313f27d899SToby Isaac PetscInt m, n, i, j, k; 17323f27d899SToby Isaac PetscInt maxnnz, *nnz, *iwork; 17333f27d899SToby Isaac Mat Ac; 17343f27d899SToby Isaac 17353f27d899SToby Isaac PetscFunctionBegin; 17369566063dSJacob Faibussowitsch PetscCall(MatGetSize(A, &m, &n)); 173763a3b9bcSJacob Faibussowitsch PetscCheck(n % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of columns in A %" PetscInt_FMT " is not a multiple of Nk %" PetscInt_FMT, n, Nk); 17389566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(m * Ncopies, &nnz)); 17393f27d899SToby Isaac for (i = 0, maxnnz = 0; i < m; i++) { 17403f27d899SToby Isaac PetscInt innz; 17419566063dSJacob Faibussowitsch PetscCall(MatGetRow(A, i, &innz, NULL, NULL)); 174263a3b9bcSJacob Faibussowitsch PetscCheck(innz % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "A row %" PetscInt_FMT " nnzs is not a multiple of Nk %" PetscInt_FMT, innz, Nk); 17433f27d899SToby Isaac for (j = 0; j < Ncopies; j++) nnz[i * Ncopies + j] = innz; 17443f27d899SToby Isaac maxnnz = PetscMax(maxnnz, innz); 17453f27d899SToby Isaac } 17469566063dSJacob Faibussowitsch PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, m * Ncopies, n * Ncopies, 0, nnz, &Ac)); 17479566063dSJacob Faibussowitsch PetscCall(MatSetOption(Ac, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE)); 17489566063dSJacob Faibussowitsch PetscCall(PetscFree(nnz)); 17499566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(maxnnz, &iwork)); 17503f27d899SToby Isaac for (i = 0; i < m; i++) { 17513f27d899SToby Isaac PetscInt innz; 17523f27d899SToby Isaac const PetscInt *cols; 17533f27d899SToby Isaac const PetscScalar *vals; 17543f27d899SToby Isaac 17559566063dSJacob Faibussowitsch PetscCall(MatGetRow(A, i, &innz, &cols, &vals)); 17563f27d899SToby Isaac for (j = 0; j < innz; j++) iwork[j] = (cols[j] / Nk) * (Nk * Ncopies) + (cols[j] % Nk); 17573f27d899SToby Isaac for (j = 0; j < Ncopies; j++) { 17583f27d899SToby Isaac PetscInt row = i * Ncopies + j; 17593f27d899SToby Isaac 17609566063dSJacob Faibussowitsch PetscCall(MatSetValues(Ac, 1, &row, innz, iwork, vals, INSERT_VALUES)); 17613f27d899SToby Isaac for (k = 0; k < innz; k++) iwork[k] += Nk; 17623f27d899SToby Isaac } 17639566063dSJacob Faibussowitsch PetscCall(MatRestoreRow(A, i, &innz, &cols, &vals)); 17643f27d899SToby Isaac } 17659566063dSJacob Faibussowitsch PetscCall(PetscFree(iwork)); 17669566063dSJacob Faibussowitsch PetscCall(MatAssemblyBegin(Ac, MAT_FINAL_ASSEMBLY)); 17679566063dSJacob Faibussowitsch PetscCall(MatAssemblyEnd(Ac, MAT_FINAL_ASSEMBLY)); 17683f27d899SToby Isaac *Abs = Ac; 17693ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 17703f27d899SToby Isaac } 17713f27d899SToby Isaac 177277f1a120SToby Isaac /* check if a cell is a tensor product of the segment with a facet, 177377f1a120SToby Isaac * specifically checking if f and f2 can be the "endpoints" (like the triangles 177477f1a120SToby Isaac * at either end of a wedge) */ 1775d71ae5a4SJacob Faibussowitsch static PetscErrorCode DMPlexPointIsTensor_Internal_Given(DM dm, PetscInt p, PetscInt f, PetscInt f2, PetscBool *isTensor) 1776d71ae5a4SJacob Faibussowitsch { 17773f27d899SToby Isaac PetscInt coneSize, c; 17783f27d899SToby Isaac const PetscInt *cone; 17793f27d899SToby Isaac const PetscInt *fCone; 17803f27d899SToby Isaac const PetscInt *f2Cone; 17813f27d899SToby Isaac PetscInt fs[2]; 17823f27d899SToby Isaac PetscInt meetSize, nmeet; 17833f27d899SToby Isaac const PetscInt *meet; 17843f27d899SToby Isaac 17853f27d899SToby Isaac PetscFunctionBegin; 17863f27d899SToby Isaac fs[0] = f; 17873f27d899SToby Isaac fs[1] = f2; 17889566063dSJacob Faibussowitsch PetscCall(DMPlexGetMeet(dm, 2, fs, &meetSize, &meet)); 17893f27d899SToby Isaac nmeet = meetSize; 17909566063dSJacob Faibussowitsch PetscCall(DMPlexRestoreMeet(dm, 2, fs, &meetSize, &meet)); 179177f1a120SToby Isaac /* two points that have a non-empty meet cannot be at opposite ends of a cell */ 17923f27d899SToby Isaac if (nmeet) { 17933f27d899SToby Isaac *isTensor = PETSC_FALSE; 17943ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 17953f27d899SToby Isaac } 17969566063dSJacob Faibussowitsch PetscCall(DMPlexGetConeSize(dm, p, &coneSize)); 17979566063dSJacob Faibussowitsch PetscCall(DMPlexGetCone(dm, p, &cone)); 17989566063dSJacob Faibussowitsch PetscCall(DMPlexGetCone(dm, f, &fCone)); 17999566063dSJacob Faibussowitsch PetscCall(DMPlexGetCone(dm, f2, &f2Cone)); 18003f27d899SToby Isaac for (c = 0; c < coneSize; c++) { 18013f27d899SToby Isaac PetscInt e, ef; 18023f27d899SToby Isaac PetscInt d = -1, d2 = -1; 18033f27d899SToby Isaac PetscInt dcount, d2count; 18043f27d899SToby Isaac PetscInt t = cone[c]; 18053f27d899SToby Isaac PetscInt tConeSize; 18063f27d899SToby Isaac PetscBool tIsTensor; 18073f27d899SToby Isaac const PetscInt *tCone; 18083f27d899SToby Isaac 18093f27d899SToby Isaac if (t == f || t == f2) continue; 181077f1a120SToby Isaac /* for every other facet in the cone, check that is has 181177f1a120SToby Isaac * one ridge in common with each end */ 18129566063dSJacob Faibussowitsch PetscCall(DMPlexGetConeSize(dm, t, &tConeSize)); 18139566063dSJacob Faibussowitsch PetscCall(DMPlexGetCone(dm, t, &tCone)); 18143f27d899SToby Isaac 18153f27d899SToby Isaac dcount = 0; 18163f27d899SToby Isaac d2count = 0; 18173f27d899SToby Isaac for (e = 0; e < tConeSize; e++) { 18183f27d899SToby Isaac PetscInt q = tCone[e]; 18193f27d899SToby Isaac for (ef = 0; ef < coneSize - 2; ef++) { 18203f27d899SToby Isaac if (fCone[ef] == q) { 18213f27d899SToby Isaac if (dcount) { 18223f27d899SToby Isaac *isTensor = PETSC_FALSE; 18233ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 18243f27d899SToby Isaac } 18253f27d899SToby Isaac d = q; 18263f27d899SToby Isaac dcount++; 18273f27d899SToby Isaac } else if (f2Cone[ef] == q) { 18283f27d899SToby Isaac if (d2count) { 18293f27d899SToby Isaac *isTensor = PETSC_FALSE; 18303ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 18313f27d899SToby Isaac } 18323f27d899SToby Isaac d2 = q; 18333f27d899SToby Isaac d2count++; 18343f27d899SToby Isaac } 18353f27d899SToby Isaac } 18363f27d899SToby Isaac } 183777f1a120SToby Isaac /* if the whole cell is a tensor with the segment, then this 183877f1a120SToby Isaac * facet should be a tensor with the segment */ 18399566063dSJacob Faibussowitsch PetscCall(DMPlexPointIsTensor_Internal_Given(dm, t, d, d2, &tIsTensor)); 18403f27d899SToby Isaac if (!tIsTensor) { 18413f27d899SToby Isaac *isTensor = PETSC_FALSE; 18423ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 18433f27d899SToby Isaac } 18443f27d899SToby Isaac } 18453f27d899SToby Isaac *isTensor = PETSC_TRUE; 18463ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 18473f27d899SToby Isaac } 18483f27d899SToby Isaac 184977f1a120SToby Isaac /* determine if a cell is a tensor with a segment by looping over pairs of facets to find a pair 185077f1a120SToby Isaac * that could be the opposite ends */ 1851d71ae5a4SJacob Faibussowitsch static PetscErrorCode DMPlexPointIsTensor_Internal(DM dm, PetscInt p, PetscBool *isTensor, PetscInt *endA, PetscInt *endB) 1852d71ae5a4SJacob Faibussowitsch { 18533f27d899SToby Isaac PetscInt coneSize, c, c2; 18543f27d899SToby Isaac const PetscInt *cone; 18553f27d899SToby Isaac 18563f27d899SToby Isaac PetscFunctionBegin; 18579566063dSJacob Faibussowitsch PetscCall(DMPlexGetConeSize(dm, p, &coneSize)); 18583f27d899SToby Isaac if (!coneSize) { 18593f27d899SToby Isaac if (isTensor) *isTensor = PETSC_FALSE; 18603f27d899SToby Isaac if (endA) *endA = -1; 18613f27d899SToby Isaac if (endB) *endB = -1; 18623f27d899SToby Isaac } 18639566063dSJacob Faibussowitsch PetscCall(DMPlexGetCone(dm, p, &cone)); 18643f27d899SToby Isaac for (c = 0; c < coneSize; c++) { 18653f27d899SToby Isaac PetscInt f = cone[c]; 18663f27d899SToby Isaac PetscInt fConeSize; 18673f27d899SToby Isaac 18689566063dSJacob Faibussowitsch PetscCall(DMPlexGetConeSize(dm, f, &fConeSize)); 18693f27d899SToby Isaac if (fConeSize != coneSize - 2) continue; 18703f27d899SToby Isaac 18713f27d899SToby Isaac for (c2 = c + 1; c2 < coneSize; c2++) { 18723f27d899SToby Isaac PetscInt f2 = cone[c2]; 18733f27d899SToby Isaac PetscBool isTensorff2; 18743f27d899SToby Isaac PetscInt f2ConeSize; 18753f27d899SToby Isaac 18769566063dSJacob Faibussowitsch PetscCall(DMPlexGetConeSize(dm, f2, &f2ConeSize)); 18773f27d899SToby Isaac if (f2ConeSize != coneSize - 2) continue; 18783f27d899SToby Isaac 18799566063dSJacob Faibussowitsch PetscCall(DMPlexPointIsTensor_Internal_Given(dm, p, f, f2, &isTensorff2)); 18803f27d899SToby Isaac if (isTensorff2) { 18813f27d899SToby Isaac if (isTensor) *isTensor = PETSC_TRUE; 18823f27d899SToby Isaac if (endA) *endA = f; 18833f27d899SToby Isaac if (endB) *endB = f2; 18843ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 18853f27d899SToby Isaac } 18863f27d899SToby Isaac } 18873f27d899SToby Isaac } 18883f27d899SToby Isaac if (isTensor) *isTensor = PETSC_FALSE; 18893f27d899SToby Isaac if (endA) *endA = -1; 18903f27d899SToby Isaac if (endB) *endB = -1; 18913ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 18923f27d899SToby Isaac } 18933f27d899SToby Isaac 189477f1a120SToby Isaac /* determine if a cell is a tensor with a segment by looping over pairs of facets to find a pair 189577f1a120SToby Isaac * that could be the opposite ends */ 1896d71ae5a4SJacob Faibussowitsch static PetscErrorCode DMPlexPointIsTensor(DM dm, PetscInt p, PetscBool *isTensor, PetscInt *endA, PetscInt *endB) 1897d71ae5a4SJacob Faibussowitsch { 18983f27d899SToby Isaac DMPlexInterpolatedFlag interpolated; 18993f27d899SToby Isaac 19003f27d899SToby Isaac PetscFunctionBegin; 19019566063dSJacob Faibussowitsch PetscCall(DMPlexIsInterpolated(dm, &interpolated)); 190208401ef6SPierre Jolivet PetscCheck(interpolated == DMPLEX_INTERPOLATED_FULL, PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Only for interpolated DMPlex's"); 19039566063dSJacob Faibussowitsch PetscCall(DMPlexPointIsTensor_Internal(dm, p, isTensor, endA, endB)); 19043ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 19053f27d899SToby Isaac } 19063f27d899SToby Isaac 19078f28b7bfSToby Isaac /* Let k = formDegree and k' = -sign(k) * dim + k. Transform a symmetric frame for k-forms on the biunit simplex into 19088f28b7bfSToby Isaac * a symmetric frame for k'-forms on the biunit simplex. 19091f440fbeSToby Isaac * 19108f28b7bfSToby Isaac * A frame is "symmetric" if the pullback of every symmetry of the biunit simplex is a permutation of the frame. 19111f440fbeSToby Isaac * 19128f28b7bfSToby Isaac * forms in the symmetric frame are used as dofs in the untrimmed simplex spaces. This way, symmetries of the 19138f28b7bfSToby Isaac * reference cell result in permutations of dofs grouped by node. 19141f440fbeSToby Isaac * 19158f28b7bfSToby Isaac * Use T to transform dof matrices for k'-forms into dof matrices for k-forms as a block diagonal transformation on 19168f28b7bfSToby Isaac * the right. 19171f440fbeSToby Isaac */ 1918d71ae5a4SJacob Faibussowitsch static PetscErrorCode BiunitSimplexSymmetricFormTransformation(PetscInt dim, PetscInt formDegree, PetscReal T[]) 1919d71ae5a4SJacob Faibussowitsch { 19201f440fbeSToby Isaac PetscInt k = formDegree; 19211f440fbeSToby Isaac PetscInt kd = k < 0 ? dim + k : k - dim; 19221f440fbeSToby Isaac PetscInt Nk; 19231f440fbeSToby Isaac PetscReal *biToEq, *eqToBi, *biToEqStar, *eqToBiStar; 19241f440fbeSToby Isaac PetscInt fact; 19251f440fbeSToby Isaac 19261f440fbeSToby Isaac PetscFunctionBegin; 19279566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk)); 19289566063dSJacob Faibussowitsch PetscCall(PetscCalloc4(dim * dim, &biToEq, dim * dim, &eqToBi, Nk * Nk, &biToEqStar, Nk * Nk, &eqToBiStar)); 19291f440fbeSToby Isaac /* fill in biToEq: Jacobian of the transformation from the biunit simplex to the equilateral simplex */ 19301f440fbeSToby Isaac fact = 0; 19311f440fbeSToby Isaac for (PetscInt i = 0; i < dim; i++) { 19321f440fbeSToby Isaac biToEq[i * dim + i] = PetscSqrtReal(((PetscReal)i + 2.) / (2. * ((PetscReal)i + 1.))); 19331f440fbeSToby Isaac fact += 4 * (i + 1); 1934ad540459SPierre Jolivet for (PetscInt j = i + 1; j < dim; j++) biToEq[i * dim + j] = PetscSqrtReal(1. / (PetscReal)fact); 19351f440fbeSToby Isaac } 19368f28b7bfSToby Isaac /* fill in eqToBi: Jacobian of the transformation from the equilateral simplex to the biunit simplex */ 19371f440fbeSToby Isaac fact = 0; 19381f440fbeSToby Isaac for (PetscInt j = 0; j < dim; j++) { 19391f440fbeSToby Isaac eqToBi[j * dim + j] = PetscSqrtReal(2. * ((PetscReal)j + 1.) / ((PetscReal)j + 2)); 19401f440fbeSToby Isaac fact += j + 1; 1941ad540459SPierre Jolivet for (PetscInt i = 0; i < j; i++) eqToBi[i * dim + j] = -PetscSqrtReal(1. / (PetscReal)fact); 19421f440fbeSToby Isaac } 19439566063dSJacob Faibussowitsch PetscCall(PetscDTAltVPullbackMatrix(dim, dim, biToEq, kd, biToEqStar)); 19449566063dSJacob Faibussowitsch PetscCall(PetscDTAltVPullbackMatrix(dim, dim, eqToBi, k, eqToBiStar)); 19458f28b7bfSToby Isaac /* product of pullbacks simulates the following steps 19468f28b7bfSToby Isaac * 19478f28b7bfSToby Isaac * 1. start with frame W = [w_1, w_2, ..., w_m] of k forms that is symmetric on the biunit simplex: 19488f28b7bfSToby Isaac if J is the Jacobian of a symmetry of the biunit simplex, then J_k* W = [J_k*w_1, ..., J_k*w_m] 19498f28b7bfSToby Isaac is a permutation of W. 19508f28b7bfSToby Isaac Even though a k' form --- a (dim - k) form represented by its Hodge star --- has the same geometric 19518f28b7bfSToby Isaac content as a k form, W is not a symmetric frame of k' forms on the biunit simplex. That's because, 19528f28b7bfSToby Isaac for general Jacobian J, J_k* != J_k'*. 19538f28b7bfSToby Isaac * 2. pullback W to the equilateral triangle using the k pullback, W_eq = eqToBi_k* W. All symmetries of the 19548f28b7bfSToby Isaac equilateral simplex have orthonormal Jacobians. For an orthonormal Jacobian O, J_k* = J_k'*, so W_eq is 19558f28b7bfSToby Isaac also a symmetric frame for k' forms on the equilateral simplex. 19568f28b7bfSToby Isaac 3. pullback W_eq back to the biunit simplex using the k' pulback, V = biToEq_k'* W_eq = biToEq_k'* eqToBi_k* W. 19578f28b7bfSToby Isaac V is a symmetric frame for k' forms on the biunit simplex. 19588f28b7bfSToby Isaac */ 19591f440fbeSToby Isaac for (PetscInt i = 0; i < Nk; i++) { 19601f440fbeSToby Isaac for (PetscInt j = 0; j < Nk; j++) { 19611f440fbeSToby Isaac PetscReal val = 0.; 19621f440fbeSToby Isaac for (PetscInt k = 0; k < Nk; k++) val += biToEqStar[i * Nk + k] * eqToBiStar[k * Nk + j]; 19631f440fbeSToby Isaac T[i * Nk + j] = val; 19641f440fbeSToby Isaac } 19651f440fbeSToby Isaac } 19669566063dSJacob Faibussowitsch PetscCall(PetscFree4(biToEq, eqToBi, biToEqStar, eqToBiStar)); 19673ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 19681f440fbeSToby Isaac } 19691f440fbeSToby Isaac 197077f1a120SToby Isaac /* permute a quadrature -> dof matrix so that its rows are in revlex order by nodeIdx */ 1971d71ae5a4SJacob Faibussowitsch static PetscErrorCode MatPermuteByNodeIdx(Mat A, PetscLagNodeIndices ni, Mat *Aperm) 1972d71ae5a4SJacob Faibussowitsch { 19733f27d899SToby Isaac PetscInt m, n, i, j; 19743f27d899SToby Isaac PetscInt nodeIdxDim = ni->nodeIdxDim; 19753f27d899SToby Isaac PetscInt nodeVecDim = ni->nodeVecDim; 19763f27d899SToby Isaac PetscInt *perm; 19773f27d899SToby Isaac IS permIS; 19783f27d899SToby Isaac IS id; 19793f27d899SToby Isaac PetscInt *nIdxPerm; 19803f27d899SToby Isaac PetscReal *nVecPerm; 19813f27d899SToby Isaac 19823f27d899SToby Isaac PetscFunctionBegin; 19839566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesGetPermutation(ni, &perm)); 19849566063dSJacob Faibussowitsch PetscCall(MatGetSize(A, &m, &n)); 19859566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nodeIdxDim * m, &nIdxPerm)); 19869566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nodeVecDim * m, &nVecPerm)); 19879371c9d4SSatish Balay for (i = 0; i < m; i++) 19889371c9d4SSatish Balay for (j = 0; j < nodeIdxDim; j++) nIdxPerm[i * nodeIdxDim + j] = ni->nodeIdx[perm[i] * nodeIdxDim + j]; 19899371c9d4SSatish Balay for (i = 0; i < m; i++) 19909371c9d4SSatish Balay for (j = 0; j < nodeVecDim; j++) nVecPerm[i * nodeVecDim + j] = ni->nodeVec[perm[i] * nodeVecDim + j]; 19919566063dSJacob Faibussowitsch PetscCall(ISCreateGeneral(PETSC_COMM_SELF, m, perm, PETSC_USE_POINTER, &permIS)); 19929566063dSJacob Faibussowitsch PetscCall(ISSetPermutation(permIS)); 19939566063dSJacob Faibussowitsch PetscCall(ISCreateStride(PETSC_COMM_SELF, n, 0, 1, &id)); 19949566063dSJacob Faibussowitsch PetscCall(ISSetPermutation(id)); 19959566063dSJacob Faibussowitsch PetscCall(MatPermute(A, permIS, id, Aperm)); 19969566063dSJacob Faibussowitsch PetscCall(ISDestroy(&permIS)); 19979566063dSJacob Faibussowitsch PetscCall(ISDestroy(&id)); 19983f27d899SToby Isaac for (i = 0; i < m; i++) perm[i] = i; 19999566063dSJacob Faibussowitsch PetscCall(PetscFree(ni->nodeIdx)); 20009566063dSJacob Faibussowitsch PetscCall(PetscFree(ni->nodeVec)); 20013f27d899SToby Isaac ni->nodeIdx = nIdxPerm; 20023f27d899SToby Isaac ni->nodeVec = nVecPerm; 20033ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 20046f905325SMatthew G. Knepley } 20056f905325SMatthew G. Knepley 2006d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp) 2007d71ae5a4SJacob Faibussowitsch { 20086f905325SMatthew G. Knepley PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 20096f905325SMatthew G. Knepley DM dm = sp->dm; 20103f27d899SToby Isaac DM dmint = NULL; 20113f27d899SToby Isaac PetscInt order; 20126f905325SMatthew G. Knepley PetscInt Nc = sp->Nc; 20136f905325SMatthew G. Knepley MPI_Comm comm; 20146f905325SMatthew G. Knepley PetscBool continuous; 20153f27d899SToby Isaac PetscSection section; 20163f27d899SToby Isaac PetscInt depth, dim, pStart, pEnd, cStart, cEnd, p, *pStratStart, *pStratEnd, d; 20173f27d899SToby Isaac PetscInt formDegree, Nk, Ncopies; 20183f27d899SToby Isaac PetscInt tensorf = -1, tensorf2 = -1; 20193f27d899SToby Isaac PetscBool tensorCell, tensorSpace; 20203f27d899SToby Isaac PetscBool uniform, trimmed; 20213f27d899SToby Isaac Petsc1DNodeFamily nodeFamily; 20223f27d899SToby Isaac PetscInt numNodeSkip; 20233f27d899SToby Isaac DMPlexInterpolatedFlag interpolated; 20243f27d899SToby Isaac PetscBool isbdm; 20256f905325SMatthew G. Knepley 20266f905325SMatthew G. Knepley PetscFunctionBegin; 20273f27d899SToby Isaac /* step 1: sanitize input */ 20289566063dSJacob Faibussowitsch PetscCall(PetscObjectGetComm((PetscObject)sp, &comm)); 20299566063dSJacob Faibussowitsch PetscCall(DMGetDimension(dm, &dim)); 20309566063dSJacob Faibussowitsch PetscCall(PetscObjectTypeCompare((PetscObject)sp, PETSCDUALSPACEBDM, &isbdm)); 20313f27d899SToby Isaac if (isbdm) { 20323f27d899SToby Isaac sp->k = -(dim - 1); /* form degree of H-div */ 20339566063dSJacob Faibussowitsch PetscCall(PetscObjectChangeTypeName((PetscObject)sp, PETSCDUALSPACELAGRANGE)); 20343f27d899SToby Isaac } 20359566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetFormDegree(sp, &formDegree)); 203608401ef6SPierre Jolivet PetscCheck(PetscAbsInt(formDegree) <= dim, comm, PETSC_ERR_ARG_OUTOFRANGE, "Form degree must be bounded by dimension"); 20379566063dSJacob Faibussowitsch PetscCall(PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk)); 20383f27d899SToby Isaac if (sp->Nc <= 0 && lag->numCopies > 0) sp->Nc = Nk * lag->numCopies; 20393f27d899SToby Isaac Nc = sp->Nc; 204008401ef6SPierre Jolivet PetscCheck(Nc % Nk == 0, comm, PETSC_ERR_ARG_INCOMP, "Number of components is not a multiple of form degree size"); 20413f27d899SToby Isaac if (lag->numCopies <= 0) lag->numCopies = Nc / Nk; 20423f27d899SToby Isaac Ncopies = lag->numCopies; 20431dca8a05SBarry Smith PetscCheck(Nc / Nk == Ncopies, comm, PETSC_ERR_ARG_INCOMP, "Number of copies * (dim choose k) != Nc"); 20443f27d899SToby Isaac if (!dim) sp->order = 0; 20453f27d899SToby Isaac order = sp->order; 20463f27d899SToby Isaac uniform = sp->uniform; 204728b400f6SJacob Faibussowitsch PetscCheck(uniform, PETSC_COMM_SELF, PETSC_ERR_SUP, "Variable order not supported yet"); 20483f27d899SToby Isaac if (lag->trimmed && !formDegree) lag->trimmed = PETSC_FALSE; /* trimmed spaces are the same as full spaces for 0-forms */ 20493f27d899SToby Isaac if (lag->nodeType == PETSCDTNODES_DEFAULT) { 20503f27d899SToby Isaac lag->nodeType = PETSCDTNODES_GAUSSJACOBI; 20513f27d899SToby Isaac lag->nodeExponent = 0.; 20523f27d899SToby Isaac /* trimmed spaces don't include corner vertices, so don't use end nodes by default */ 20533f27d899SToby Isaac lag->endNodes = lag->trimmed ? PETSC_FALSE : PETSC_TRUE; 20543f27d899SToby Isaac } 20553f27d899SToby Isaac /* If a trimmed space and the user did choose nodes with endpoints, skip them by default */ 20563f27d899SToby Isaac if (lag->numNodeSkip < 0) lag->numNodeSkip = (lag->trimmed && lag->endNodes) ? 1 : 0; 20573f27d899SToby Isaac numNodeSkip = lag->numNodeSkip; 205808401ef6SPierre Jolivet PetscCheck(!lag->trimmed || order, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Cannot have zeroth order trimmed elements"); 20593f27d899SToby Isaac if (lag->trimmed && PetscAbsInt(formDegree) == dim) { /* convert trimmed n-forms to untrimmed of one polynomial order less */ 20603f27d899SToby Isaac sp->order--; 20613f27d899SToby Isaac order--; 20623f27d899SToby Isaac lag->trimmed = PETSC_FALSE; 20633f27d899SToby Isaac } 20643f27d899SToby Isaac trimmed = lag->trimmed; 20653f27d899SToby Isaac if (!order || PetscAbsInt(formDegree) == dim) lag->continuous = PETSC_FALSE; 20663f27d899SToby Isaac continuous = lag->continuous; 20679566063dSJacob Faibussowitsch PetscCall(DMPlexGetDepth(dm, &depth)); 20689566063dSJacob Faibussowitsch PetscCall(DMPlexGetChart(dm, &pStart, &pEnd)); 20699566063dSJacob Faibussowitsch PetscCall(DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd)); 20701dca8a05SBarry Smith PetscCheck(pStart == 0 && cStart == 0, PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_WRONGSTATE, "Expect DM with chart starting at zero and cells first"); 207108401ef6SPierre Jolivet PetscCheck(cEnd == 1, PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_WRONGSTATE, "Use PETSCDUALSPACEREFINED for multi-cell reference meshes"); 20729566063dSJacob Faibussowitsch PetscCall(DMPlexIsInterpolated(dm, &interpolated)); 20733f27d899SToby Isaac if (interpolated != DMPLEX_INTERPOLATED_FULL) { 20749566063dSJacob Faibussowitsch PetscCall(DMPlexInterpolate(dm, &dmint)); 20753f27d899SToby Isaac } else { 20769566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)dm)); 20773f27d899SToby Isaac dmint = dm; 20783f27d899SToby Isaac } 20793f27d899SToby Isaac tensorCell = PETSC_FALSE; 208048a46eb9SPierre Jolivet if (dim > 1) PetscCall(DMPlexPointIsTensor(dmint, 0, &tensorCell, &tensorf, &tensorf2)); 20813f27d899SToby Isaac lag->tensorCell = tensorCell; 20823f27d899SToby Isaac if (dim < 2 || !lag->tensorCell) lag->tensorSpace = PETSC_FALSE; 20836f905325SMatthew G. Knepley tensorSpace = lag->tensorSpace; 208448a46eb9SPierre Jolivet if (!lag->nodeFamily) PetscCall(Petsc1DNodeFamilyCreate(lag->nodeType, lag->nodeExponent, lag->endNodes, &lag->nodeFamily)); 20853f27d899SToby Isaac nodeFamily = lag->nodeFamily; 20861dca8a05SBarry Smith PetscCheck(interpolated == DMPLEX_INTERPOLATED_FULL || !continuous || (PetscAbsInt(formDegree) <= 0 && order <= 1), PETSC_COMM_SELF, PETSC_ERR_PLIB, "Reference element won't support all boundary nodes"); 208720cf1dd8SToby Isaac 20883f27d899SToby Isaac /* step 2: construct the boundary spaces */ 20899566063dSJacob Faibussowitsch PetscCall(PetscMalloc2(depth + 1, &pStratStart, depth + 1, &pStratEnd)); 20909566063dSJacob Faibussowitsch PetscCall(PetscCalloc1(pEnd, &(sp->pointSpaces))); 20919566063dSJacob Faibussowitsch for (d = 0; d <= depth; ++d) PetscCall(DMPlexGetDepthStratum(dm, d, &pStratStart[d], &pStratEnd[d])); 20929566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSectionCreate_Internal(sp, §ion)); 20933f27d899SToby Isaac sp->pointSection = section; 20943f27d899SToby Isaac if (continuous && !(lag->interiorOnly)) { 20953f27d899SToby Isaac PetscInt h; 20966f905325SMatthew G. Knepley 20973f27d899SToby Isaac for (p = pStratStart[depth - 1]; p < pStratEnd[depth - 1]; p++) { /* calculate the facet dual spaces */ 20983f27d899SToby Isaac PetscReal v0[3]; 20993f27d899SToby Isaac DMPolytopeType ptype; 21003f27d899SToby Isaac PetscReal J[9], detJ; 21016f905325SMatthew G. Knepley PetscInt q; 21026f905325SMatthew G. Knepley 21039566063dSJacob Faibussowitsch PetscCall(DMPlexComputeCellGeometryAffineFEM(dm, p, v0, J, NULL, &detJ)); 21049566063dSJacob Faibussowitsch PetscCall(DMPlexGetCellType(dm, p, &ptype)); 21056f905325SMatthew G. Knepley 210677f1a120SToby Isaac /* compare to previous facets: if computed, reference that dualspace */ 21073f27d899SToby Isaac for (q = pStratStart[depth - 1]; q < p; q++) { 21083f27d899SToby Isaac DMPolytopeType qtype; 21096f905325SMatthew G. Knepley 21109566063dSJacob Faibussowitsch PetscCall(DMPlexGetCellType(dm, q, &qtype)); 21113f27d899SToby Isaac if (qtype == ptype) break; 21126f905325SMatthew G. Knepley } 21133f27d899SToby Isaac if (q < p) { /* this facet has the same dual space as that one */ 21149566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)sp->pointSpaces[q])); 21153f27d899SToby Isaac sp->pointSpaces[p] = sp->pointSpaces[q]; 21163f27d899SToby Isaac continue; 21176f905325SMatthew G. Knepley } 21183f27d899SToby Isaac /* if not, recursively compute this dual space */ 21199566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceCreateFacetSubspace_Lagrange(sp, NULL, p, formDegree, Ncopies, PETSC_FALSE, &sp->pointSpaces[p])); 21206f905325SMatthew G. Knepley } 21213f27d899SToby Isaac for (h = 2; h <= depth; h++) { /* get the higher subspaces from the facet subspaces */ 21223f27d899SToby Isaac PetscInt hd = depth - h; 21233f27d899SToby Isaac PetscInt hdim = dim - h; 21246f905325SMatthew G. Knepley 21253f27d899SToby Isaac if (hdim < PetscAbsInt(formDegree)) break; 21263f27d899SToby Isaac for (p = pStratStart[hd]; p < pStratEnd[hd]; p++) { 21273f27d899SToby Isaac PetscInt suppSize, s; 21283f27d899SToby Isaac const PetscInt *supp; 21296f905325SMatthew G. Knepley 21309566063dSJacob Faibussowitsch PetscCall(DMPlexGetSupportSize(dm, p, &suppSize)); 21319566063dSJacob Faibussowitsch PetscCall(DMPlexGetSupport(dm, p, &supp)); 21323f27d899SToby Isaac for (s = 0; s < suppSize; s++) { 21333f27d899SToby Isaac DM qdm; 21343f27d899SToby Isaac PetscDualSpace qsp, psp; 21353f27d899SToby Isaac PetscInt c, coneSize, q; 21363f27d899SToby Isaac const PetscInt *cone; 21373f27d899SToby Isaac const PetscInt *refCone; 21386f905325SMatthew G. Knepley 21393f27d899SToby Isaac q = supp[0]; 21403f27d899SToby Isaac qsp = sp->pointSpaces[q]; 21419566063dSJacob Faibussowitsch PetscCall(DMPlexGetConeSize(dm, q, &coneSize)); 21429566063dSJacob Faibussowitsch PetscCall(DMPlexGetCone(dm, q, &cone)); 21439371c9d4SSatish Balay for (c = 0; c < coneSize; c++) 21449371c9d4SSatish Balay if (cone[c] == p) break; 214508401ef6SPierre Jolivet PetscCheck(c != coneSize, PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "cone/support mismatch"); 21469566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetDM(qsp, &qdm)); 21479566063dSJacob Faibussowitsch PetscCall(DMPlexGetCone(qdm, 0, &refCone)); 21483f27d899SToby Isaac /* get the equivalent dual space from the support dual space */ 21499566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetPointSubspace(qsp, refCone[c], &psp)); 21503f27d899SToby Isaac if (!s) { 21519566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)psp)); 21523f27d899SToby Isaac sp->pointSpaces[p] = psp; 21533f27d899SToby Isaac } 21543f27d899SToby Isaac } 21553f27d899SToby Isaac } 21563f27d899SToby Isaac } 21573f27d899SToby Isaac for (p = 1; p < pEnd; p++) { 21583f27d899SToby Isaac PetscInt pspdim; 21593f27d899SToby Isaac if (!sp->pointSpaces[p]) continue; 21609566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetInteriorDimension(sp->pointSpaces[p], &pspdim)); 21619566063dSJacob Faibussowitsch PetscCall(PetscSectionSetDof(section, p, pspdim)); 21623f27d899SToby Isaac } 21633f27d899SToby Isaac } 21646f905325SMatthew G. Knepley 21653f27d899SToby Isaac if (Ncopies > 1) { 21663f27d899SToby Isaac Mat intMatScalar, allMatScalar; 21673f27d899SToby Isaac PetscDualSpace scalarsp; 21683f27d899SToby Isaac PetscDualSpace_Lag *scalarlag; 21693f27d899SToby Isaac 21709566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceDuplicate(sp, &scalarsp)); 217177f1a120SToby Isaac /* Setting the number of components to Nk is a space with 1 copy of each k-form */ 21729566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetNumComponents(scalarsp, Nk)); 21739566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetUp(scalarsp)); 21749566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetInteriorData(scalarsp, &(sp->intNodes), &intMatScalar)); 21759566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)(sp->intNodes))); 21769566063dSJacob Faibussowitsch if (intMatScalar) PetscCall(PetscDualSpaceLagrangeMatrixCreateCopies(intMatScalar, Nk, Ncopies, &(sp->intMat))); 21779566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetAllData(scalarsp, &(sp->allNodes), &allMatScalar)); 21789566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)(sp->allNodes))); 21799566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeMatrixCreateCopies(allMatScalar, Nk, Ncopies, &(sp->allMat))); 21803f27d899SToby Isaac sp->spdim = scalarsp->spdim * Ncopies; 21813f27d899SToby Isaac sp->spintdim = scalarsp->spintdim * Ncopies; 21823f27d899SToby Isaac scalarlag = (PetscDualSpace_Lag *)scalarsp->data; 21839566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesReference(scalarlag->vertIndices)); 21843f27d899SToby Isaac lag->vertIndices = scalarlag->vertIndices; 21859566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesReference(scalarlag->intNodeIndices)); 21863f27d899SToby Isaac lag->intNodeIndices = scalarlag->intNodeIndices; 21879566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesReference(scalarlag->allNodeIndices)); 21883f27d899SToby Isaac lag->allNodeIndices = scalarlag->allNodeIndices; 21899566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceDestroy(&scalarsp)); 21909566063dSJacob Faibussowitsch PetscCall(PetscSectionSetDof(section, 0, sp->spintdim)); 21919566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section)); 21929566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceComputeFunctionalsFromAllData(sp)); 21939566063dSJacob Faibussowitsch PetscCall(PetscFree2(pStratStart, pStratEnd)); 21949566063dSJacob Faibussowitsch PetscCall(DMDestroy(&dmint)); 21953ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 219620cf1dd8SToby Isaac } 219720cf1dd8SToby Isaac 21983f27d899SToby Isaac if (trimmed && !continuous) { 21993f27d899SToby Isaac /* the dofs of a trimmed space don't have a nice tensor/lattice structure: 22003f27d899SToby Isaac * just construct the continuous dual space and copy all of the data over, 22013f27d899SToby Isaac * allocating it all to the cell instead of splitting it up between the boundaries */ 22023f27d899SToby Isaac PetscDualSpace spcont; 22033f27d899SToby Isaac PetscInt spdim, f; 22043f27d899SToby Isaac PetscQuadrature allNodes; 22053f27d899SToby Isaac PetscDualSpace_Lag *lagc; 22063f27d899SToby Isaac Mat allMat; 22073f27d899SToby Isaac 22089566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceDuplicate(sp, &spcont)); 22099566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeSetContinuity(spcont, PETSC_TRUE)); 22109566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetUp(spcont)); 22119566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetDimension(spcont, &spdim)); 22123f27d899SToby Isaac sp->spdim = sp->spintdim = spdim; 22139566063dSJacob Faibussowitsch PetscCall(PetscSectionSetDof(section, 0, spdim)); 22149566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section)); 22159566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(spdim, &(sp->functional))); 22163f27d899SToby Isaac for (f = 0; f < spdim; f++) { 22173f27d899SToby Isaac PetscQuadrature fn; 22183f27d899SToby Isaac 22199566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetFunctional(spcont, f, &fn)); 22209566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)fn)); 22213f27d899SToby Isaac sp->functional[f] = fn; 22223f27d899SToby Isaac } 22239566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetAllData(spcont, &allNodes, &allMat)); 22249566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)allNodes)); 22259566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)allNodes)); 22263f27d899SToby Isaac sp->allNodes = sp->intNodes = allNodes; 22279566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)allMat)); 22289566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)allMat)); 22293f27d899SToby Isaac sp->allMat = sp->intMat = allMat; 22303f27d899SToby Isaac lagc = (PetscDualSpace_Lag *)spcont->data; 22319566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesReference(lagc->vertIndices)); 22323f27d899SToby Isaac lag->vertIndices = lagc->vertIndices; 22339566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesReference(lagc->allNodeIndices)); 22349566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesReference(lagc->allNodeIndices)); 22353f27d899SToby Isaac lag->intNodeIndices = lagc->allNodeIndices; 22363f27d899SToby Isaac lag->allNodeIndices = lagc->allNodeIndices; 22379566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceDestroy(&spcont)); 22389566063dSJacob Faibussowitsch PetscCall(PetscFree2(pStratStart, pStratEnd)); 22399566063dSJacob Faibussowitsch PetscCall(DMDestroy(&dmint)); 22403ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 22413f27d899SToby Isaac } 22423f27d899SToby Isaac 22433f27d899SToby Isaac /* step 3: construct intNodes, and intMat, and combine it with boundray data to make allNodes and allMat */ 22443f27d899SToby Isaac if (!tensorSpace) { 22459566063dSJacob Faibussowitsch if (!tensorCell) PetscCall(PetscLagNodeIndicesCreateSimplexVertices(dm, &(lag->vertIndices))); 22463f27d899SToby Isaac 22473f27d899SToby Isaac if (trimmed) { 224877f1a120SToby Isaac /* there is one dof in the interior of the a trimmed element for each full polynomial of with degree at most 224977f1a120SToby Isaac * order + k - dim - 1 */ 22503f27d899SToby Isaac if (order + PetscAbsInt(formDegree) > dim) { 22513f27d899SToby Isaac PetscInt sum = order + PetscAbsInt(formDegree) - dim - 1; 22523f27d899SToby Isaac PetscInt nDofs; 22533f27d899SToby Isaac 22549566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeCreateSimplexNodeMat(nodeFamily, dim, sum, Nk, numNodeSkip, &sp->intNodes, &sp->intMat, &(lag->intNodeIndices))); 22559566063dSJacob Faibussowitsch PetscCall(MatGetSize(sp->intMat, &nDofs, NULL)); 22569566063dSJacob Faibussowitsch PetscCall(PetscSectionSetDof(section, 0, nDofs)); 22573f27d899SToby Isaac } 22589566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section)); 22599566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceCreateAllDataFromInteriorData(sp)); 22609566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeCreateAllNodeIdx(sp)); 22613f27d899SToby Isaac } else { 22623f27d899SToby Isaac if (!continuous) { 226377f1a120SToby Isaac /* if discontinuous just construct one node for each set of dofs (a set of dofs is a basis for the k-form 226477f1a120SToby Isaac * space) */ 22653f27d899SToby Isaac PetscInt sum = order; 22663f27d899SToby Isaac PetscInt nDofs; 22673f27d899SToby Isaac 22689566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeCreateSimplexNodeMat(nodeFamily, dim, sum, Nk, numNodeSkip, &sp->intNodes, &sp->intMat, &(lag->intNodeIndices))); 22699566063dSJacob Faibussowitsch PetscCall(MatGetSize(sp->intMat, &nDofs, NULL)); 22709566063dSJacob Faibussowitsch PetscCall(PetscSectionSetDof(section, 0, nDofs)); 22719566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section)); 22729566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)(sp->intNodes))); 22733f27d899SToby Isaac sp->allNodes = sp->intNodes; 22749566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)(sp->intMat))); 22753f27d899SToby Isaac sp->allMat = sp->intMat; 22769566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesReference(lag->intNodeIndices)); 22773f27d899SToby Isaac lag->allNodeIndices = lag->intNodeIndices; 22783f27d899SToby Isaac } else { 227977f1a120SToby Isaac /* there is one dof in the interior of the a full element for each trimmed polynomial of with degree at most 228077f1a120SToby Isaac * order + k - dim, but with complementary form degree */ 22813f27d899SToby Isaac if (order + PetscAbsInt(formDegree) > dim) { 22823f27d899SToby Isaac PetscDualSpace trimmedsp; 22833f27d899SToby Isaac PetscDualSpace_Lag *trimmedlag; 22843f27d899SToby Isaac PetscQuadrature intNodes; 22853f27d899SToby Isaac PetscInt trFormDegree = formDegree >= 0 ? formDegree - dim : dim - PetscAbsInt(formDegree); 22863f27d899SToby Isaac PetscInt nDofs; 22873f27d899SToby Isaac Mat intMat; 22883f27d899SToby Isaac 22899566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceDuplicate(sp, &trimmedsp)); 22909566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeSetTrimmed(trimmedsp, PETSC_TRUE)); 22919566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetOrder(trimmedsp, order + PetscAbsInt(formDegree) - dim)); 22929566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetFormDegree(trimmedsp, trFormDegree)); 22933f27d899SToby Isaac trimmedlag = (PetscDualSpace_Lag *)trimmedsp->data; 22943f27d899SToby Isaac trimmedlag->numNodeSkip = numNodeSkip + 1; 22959566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSetUp(trimmedsp)); 22969566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetAllData(trimmedsp, &intNodes, &intMat)); 22979566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)intNodes)); 22983f27d899SToby Isaac sp->intNodes = intNodes; 22999566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesReference(trimmedlag->allNodeIndices)); 23003f27d899SToby Isaac lag->intNodeIndices = trimmedlag->allNodeIndices; 23019566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)intMat)); 23021f440fbeSToby Isaac if (PetscAbsInt(formDegree) > 0 && PetscAbsInt(formDegree) < dim) { 23031f440fbeSToby Isaac PetscReal *T; 23041f440fbeSToby Isaac PetscScalar *work; 23051f440fbeSToby Isaac PetscInt nCols, nRows; 23061f440fbeSToby Isaac Mat intMatT; 23071f440fbeSToby Isaac 23089566063dSJacob Faibussowitsch PetscCall(MatDuplicate(intMat, MAT_COPY_VALUES, &intMatT)); 23099566063dSJacob Faibussowitsch PetscCall(MatGetSize(intMat, &nRows, &nCols)); 23109566063dSJacob Faibussowitsch PetscCall(PetscMalloc2(Nk * Nk, &T, nCols, &work)); 23119566063dSJacob Faibussowitsch PetscCall(BiunitSimplexSymmetricFormTransformation(dim, formDegree, T)); 23121f440fbeSToby Isaac for (PetscInt row = 0; row < nRows; row++) { 23131f440fbeSToby Isaac PetscInt nrCols; 23141f440fbeSToby Isaac const PetscInt *rCols; 23151f440fbeSToby Isaac const PetscScalar *rVals; 23161f440fbeSToby Isaac 23179566063dSJacob Faibussowitsch PetscCall(MatGetRow(intMat, row, &nrCols, &rCols, &rVals)); 231808401ef6SPierre Jolivet PetscCheck(nrCols % Nk == 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in intMat matrix are not in k-form size blocks"); 23191f440fbeSToby Isaac for (PetscInt b = 0; b < nrCols; b += Nk) { 23201f440fbeSToby Isaac const PetscScalar *v = &rVals[b]; 23211f440fbeSToby Isaac PetscScalar *w = &work[b]; 23221f440fbeSToby Isaac for (PetscInt j = 0; j < Nk; j++) { 23231f440fbeSToby Isaac w[j] = 0.; 2324ad540459SPierre Jolivet for (PetscInt i = 0; i < Nk; i++) w[j] += v[i] * T[i * Nk + j]; 23251f440fbeSToby Isaac } 23261f440fbeSToby Isaac } 23279566063dSJacob Faibussowitsch PetscCall(MatSetValuesBlocked(intMatT, 1, &row, nrCols, rCols, work, INSERT_VALUES)); 23289566063dSJacob Faibussowitsch PetscCall(MatRestoreRow(intMat, row, &nrCols, &rCols, &rVals)); 23291f440fbeSToby Isaac } 23309566063dSJacob Faibussowitsch PetscCall(MatAssemblyBegin(intMatT, MAT_FINAL_ASSEMBLY)); 23319566063dSJacob Faibussowitsch PetscCall(MatAssemblyEnd(intMatT, MAT_FINAL_ASSEMBLY)); 23329566063dSJacob Faibussowitsch PetscCall(MatDestroy(&intMat)); 23331f440fbeSToby Isaac intMat = intMatT; 23349566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesDestroy(&(lag->intNodeIndices))); 23359566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesDuplicate(trimmedlag->allNodeIndices, &(lag->intNodeIndices))); 23361f440fbeSToby Isaac { 23371f440fbeSToby Isaac PetscInt nNodes = lag->intNodeIndices->nNodes; 23381f440fbeSToby Isaac PetscReal *newNodeVec = lag->intNodeIndices->nodeVec; 23391f440fbeSToby Isaac const PetscReal *oldNodeVec = trimmedlag->allNodeIndices->nodeVec; 23401f440fbeSToby Isaac 23411f440fbeSToby Isaac for (PetscInt n = 0; n < nNodes; n++) { 23421f440fbeSToby Isaac PetscReal *w = &newNodeVec[n * Nk]; 23431f440fbeSToby Isaac const PetscReal *v = &oldNodeVec[n * Nk]; 23441f440fbeSToby Isaac 23451f440fbeSToby Isaac for (PetscInt j = 0; j < Nk; j++) { 23461f440fbeSToby Isaac w[j] = 0.; 2347ad540459SPierre Jolivet for (PetscInt i = 0; i < Nk; i++) w[j] += v[i] * T[i * Nk + j]; 23481f440fbeSToby Isaac } 23491f440fbeSToby Isaac } 23501f440fbeSToby Isaac } 23519566063dSJacob Faibussowitsch PetscCall(PetscFree2(T, work)); 23521f440fbeSToby Isaac } 23531f440fbeSToby Isaac sp->intMat = intMat; 23549566063dSJacob Faibussowitsch PetscCall(MatGetSize(sp->intMat, &nDofs, NULL)); 23559566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceDestroy(&trimmedsp)); 23569566063dSJacob Faibussowitsch PetscCall(PetscSectionSetDof(section, 0, nDofs)); 23573f27d899SToby Isaac } 23589566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section)); 23599566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceCreateAllDataFromInteriorData(sp)); 23609566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeCreateAllNodeIdx(sp)); 23613f27d899SToby Isaac } 23623f27d899SToby Isaac } 23633f27d899SToby Isaac } else { 23643f27d899SToby Isaac PetscQuadrature intNodesTrace = NULL; 23653f27d899SToby Isaac PetscQuadrature intNodesFiber = NULL; 23663f27d899SToby Isaac PetscQuadrature intNodes = NULL; 23673f27d899SToby Isaac PetscLagNodeIndices intNodeIndices = NULL; 23683f27d899SToby Isaac Mat intMat = NULL; 23693f27d899SToby Isaac 237077f1a120SToby Isaac if (PetscAbsInt(formDegree) < dim) { /* get the trace k-forms on the first facet, and the 0-forms on the edge, 237177f1a120SToby Isaac and wedge them together to create some of the k-form dofs */ 23723f27d899SToby Isaac PetscDualSpace trace, fiber; 23733f27d899SToby Isaac PetscDualSpace_Lag *tracel, *fiberl; 23743f27d899SToby Isaac Mat intMatTrace, intMatFiber; 23753f27d899SToby Isaac 23763f27d899SToby Isaac if (sp->pointSpaces[tensorf]) { 23779566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)(sp->pointSpaces[tensorf]))); 23783f27d899SToby Isaac trace = sp->pointSpaces[tensorf]; 23793f27d899SToby Isaac } else { 23809566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceCreateFacetSubspace_Lagrange(sp, NULL, tensorf, formDegree, Ncopies, PETSC_TRUE, &trace)); 23813f27d899SToby Isaac } 23829566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceCreateEdgeSubspace_Lagrange(sp, order, 0, 1, PETSC_TRUE, &fiber)); 23833f27d899SToby Isaac tracel = (PetscDualSpace_Lag *)trace->data; 23843f27d899SToby Isaac fiberl = (PetscDualSpace_Lag *)fiber->data; 23859566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesCreateTensorVertices(dm, tracel->vertIndices, &(lag->vertIndices))); 23869566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetInteriorData(trace, &intNodesTrace, &intMatTrace)); 23879566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetInteriorData(fiber, &intNodesFiber, &intMatFiber)); 23883f27d899SToby Isaac if (intNodesTrace && intNodesFiber) { 23899566063dSJacob Faibussowitsch PetscCall(PetscQuadratureCreateTensor(intNodesTrace, intNodesFiber, &intNodes)); 23909566063dSJacob Faibussowitsch PetscCall(MatTensorAltV(intMatTrace, intMatFiber, dim - 1, formDegree, 1, 0, &intMat)); 23919566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesTensor(tracel->intNodeIndices, dim - 1, formDegree, fiberl->intNodeIndices, 1, 0, &intNodeIndices)); 23923f27d899SToby Isaac } 23939566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)intNodesTrace)); 23949566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)intNodesFiber)); 23959566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceDestroy(&fiber)); 23969566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceDestroy(&trace)); 23973f27d899SToby Isaac } 239877f1a120SToby Isaac if (PetscAbsInt(formDegree) > 0) { /* get the trace (k-1)-forms on the first facet, and the 1-forms on the edge, 239977f1a120SToby Isaac and wedge them together to create the remaining k-form dofs */ 24003f27d899SToby Isaac PetscDualSpace trace, fiber; 24013f27d899SToby Isaac PetscDualSpace_Lag *tracel, *fiberl; 24023f27d899SToby Isaac PetscQuadrature intNodesTrace2, intNodesFiber2, intNodes2; 24033f27d899SToby Isaac PetscLagNodeIndices intNodeIndices2; 24043f27d899SToby Isaac Mat intMatTrace, intMatFiber, intMat2; 24053f27d899SToby Isaac PetscInt traceDegree = formDegree > 0 ? formDegree - 1 : formDegree + 1; 24063f27d899SToby Isaac PetscInt fiberDegree = formDegree > 0 ? 1 : -1; 24073f27d899SToby Isaac 24089566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceCreateFacetSubspace_Lagrange(sp, NULL, tensorf, traceDegree, Ncopies, PETSC_TRUE, &trace)); 24099566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceCreateEdgeSubspace_Lagrange(sp, order, fiberDegree, 1, PETSC_TRUE, &fiber)); 24103f27d899SToby Isaac tracel = (PetscDualSpace_Lag *)trace->data; 24113f27d899SToby Isaac fiberl = (PetscDualSpace_Lag *)fiber->data; 241248a46eb9SPierre Jolivet if (!lag->vertIndices) PetscCall(PetscLagNodeIndicesCreateTensorVertices(dm, tracel->vertIndices, &(lag->vertIndices))); 24139566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetInteriorData(trace, &intNodesTrace2, &intMatTrace)); 24149566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetInteriorData(fiber, &intNodesFiber2, &intMatFiber)); 24153f27d899SToby Isaac if (intNodesTrace2 && intNodesFiber2) { 24169566063dSJacob Faibussowitsch PetscCall(PetscQuadratureCreateTensor(intNodesTrace2, intNodesFiber2, &intNodes2)); 24179566063dSJacob Faibussowitsch PetscCall(MatTensorAltV(intMatTrace, intMatFiber, dim - 1, traceDegree, 1, fiberDegree, &intMat2)); 24189566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesTensor(tracel->intNodeIndices, dim - 1, traceDegree, fiberl->intNodeIndices, 1, fiberDegree, &intNodeIndices2)); 24193f27d899SToby Isaac if (!intMat) { 24203f27d899SToby Isaac intMat = intMat2; 24213f27d899SToby Isaac intNodes = intNodes2; 24223f27d899SToby Isaac intNodeIndices = intNodeIndices2; 24233f27d899SToby Isaac } else { 242477f1a120SToby Isaac /* merge the matrices, quadrature points, and nodes */ 24253f27d899SToby Isaac PetscInt nM; 24263f27d899SToby Isaac PetscInt nDof, nDof2; 24276ff15688SToby Isaac PetscInt *toMerged = NULL, *toMerged2 = NULL; 24286ff15688SToby Isaac PetscQuadrature merged = NULL; 24293f27d899SToby Isaac PetscLagNodeIndices intNodeIndicesMerged = NULL; 24303f27d899SToby Isaac Mat matMerged = NULL; 24313f27d899SToby Isaac 24329566063dSJacob Faibussowitsch PetscCall(MatGetSize(intMat, &nDof, NULL)); 24339566063dSJacob Faibussowitsch PetscCall(MatGetSize(intMat2, &nDof2, NULL)); 24349566063dSJacob Faibussowitsch PetscCall(PetscQuadraturePointsMerge(intNodes, intNodes2, &merged, &toMerged, &toMerged2)); 24359566063dSJacob Faibussowitsch PetscCall(PetscQuadratureGetData(merged, NULL, NULL, &nM, NULL, NULL)); 24369566063dSJacob Faibussowitsch PetscCall(MatricesMerge(intMat, intMat2, dim, formDegree, nM, toMerged, toMerged2, &matMerged)); 24379566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesMerge(intNodeIndices, intNodeIndices2, &intNodeIndicesMerged)); 24389566063dSJacob Faibussowitsch PetscCall(PetscFree(toMerged)); 24399566063dSJacob Faibussowitsch PetscCall(PetscFree(toMerged2)); 24409566063dSJacob Faibussowitsch PetscCall(MatDestroy(&intMat)); 24419566063dSJacob Faibussowitsch PetscCall(MatDestroy(&intMat2)); 24429566063dSJacob Faibussowitsch PetscCall(PetscQuadratureDestroy(&intNodes)); 24439566063dSJacob Faibussowitsch PetscCall(PetscQuadratureDestroy(&intNodes2)); 24449566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesDestroy(&intNodeIndices)); 24459566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesDestroy(&intNodeIndices2)); 24463f27d899SToby Isaac intNodes = merged; 24473f27d899SToby Isaac intMat = matMerged; 24483f27d899SToby Isaac intNodeIndices = intNodeIndicesMerged; 24493f27d899SToby Isaac if (!trimmed) { 245077f1a120SToby Isaac /* I think users expect that, when a node has a full basis for the k-forms, 245177f1a120SToby Isaac * they should be consecutive dofs. That isn't the case for trimmed spaces, 245277f1a120SToby Isaac * but is for some of the nodes in untrimmed spaces, so in that case we 245377f1a120SToby Isaac * sort them to group them by node */ 24543f27d899SToby Isaac Mat intMatPerm; 24553f27d899SToby Isaac 24569566063dSJacob Faibussowitsch PetscCall(MatPermuteByNodeIdx(intMat, intNodeIndices, &intMatPerm)); 24579566063dSJacob Faibussowitsch PetscCall(MatDestroy(&intMat)); 24583f27d899SToby Isaac intMat = intMatPerm; 24593f27d899SToby Isaac } 24603f27d899SToby Isaac } 24613f27d899SToby Isaac } 24629566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceDestroy(&fiber)); 24639566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceDestroy(&trace)); 24643f27d899SToby Isaac } 24659566063dSJacob Faibussowitsch PetscCall(PetscQuadratureDestroy(&intNodesTrace)); 24669566063dSJacob Faibussowitsch PetscCall(PetscQuadratureDestroy(&intNodesFiber)); 24673f27d899SToby Isaac sp->intNodes = intNodes; 24683f27d899SToby Isaac sp->intMat = intMat; 24693f27d899SToby Isaac lag->intNodeIndices = intNodeIndices; 24706f905325SMatthew G. Knepley { 24713f27d899SToby Isaac PetscInt nDofs = 0; 24723f27d899SToby Isaac 247348a46eb9SPierre Jolivet if (intMat) PetscCall(MatGetSize(intMat, &nDofs, NULL)); 24749566063dSJacob Faibussowitsch PetscCall(PetscSectionSetDof(section, 0, nDofs)); 24753f27d899SToby Isaac } 24769566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceSectionSetUp_Internal(sp, section)); 24773f27d899SToby Isaac if (continuous) { 24789566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceCreateAllDataFromInteriorData(sp)); 24799566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceLagrangeCreateAllNodeIdx(sp)); 24803f27d899SToby Isaac } else { 24819566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)intNodes)); 24823f27d899SToby Isaac sp->allNodes = intNodes; 24839566063dSJacob Faibussowitsch PetscCall(PetscObjectReference((PetscObject)intMat)); 24843f27d899SToby Isaac sp->allMat = intMat; 24859566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesReference(intNodeIndices)); 24863f27d899SToby Isaac lag->allNodeIndices = intNodeIndices; 24873f27d899SToby Isaac } 24883f27d899SToby Isaac } 24899566063dSJacob Faibussowitsch PetscCall(PetscSectionGetStorageSize(section, &sp->spdim)); 24909566063dSJacob Faibussowitsch PetscCall(PetscSectionGetConstrainedStorageSize(section, &sp->spintdim)); 24919566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceComputeFunctionalsFromAllData(sp)); 24929566063dSJacob Faibussowitsch PetscCall(PetscFree2(pStratStart, pStratEnd)); 24939566063dSJacob Faibussowitsch PetscCall(DMDestroy(&dmint)); 24943ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 24953f27d899SToby Isaac } 24963f27d899SToby Isaac 249777f1a120SToby Isaac /* Create a matrix that represents the transformation that DMPlexVecGetClosure() would need 249877f1a120SToby Isaac * to get the representation of the dofs for a mesh point if the mesh point had this orientation 249977f1a120SToby Isaac * relative to the cell */ 2500d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceCreateInteriorSymmetryMatrix_Lagrange(PetscDualSpace sp, PetscInt ornt, Mat *symMat) 2501d71ae5a4SJacob Faibussowitsch { 25023f27d899SToby Isaac PetscDualSpace_Lag *lag; 25033f27d899SToby Isaac DM dm; 25043f27d899SToby Isaac PetscLagNodeIndices vertIndices, intNodeIndices; 25053f27d899SToby Isaac PetscLagNodeIndices ni; 25063f27d899SToby Isaac PetscInt nodeIdxDim, nodeVecDim, nNodes; 25073f27d899SToby Isaac PetscInt formDegree; 25083f27d899SToby Isaac PetscInt *perm, *permOrnt; 25093f27d899SToby Isaac PetscInt *nnz; 25103f27d899SToby Isaac PetscInt n; 25113f27d899SToby Isaac PetscInt maxGroupSize; 25123f27d899SToby Isaac PetscScalar *V, *W, *work; 25133f27d899SToby Isaac Mat A; 25146f905325SMatthew G. Knepley 25156f905325SMatthew G. Knepley PetscFunctionBegin; 25163f27d899SToby Isaac if (!sp->spintdim) { 25173f27d899SToby Isaac *symMat = NULL; 25183ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 25196f905325SMatthew G. Knepley } 25203f27d899SToby Isaac lag = (PetscDualSpace_Lag *)sp->data; 25213f27d899SToby Isaac vertIndices = lag->vertIndices; 25223f27d899SToby Isaac intNodeIndices = lag->intNodeIndices; 25239566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetDM(sp, &dm)); 25249566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetFormDegree(sp, &formDegree)); 25259566063dSJacob Faibussowitsch PetscCall(PetscNew(&ni)); 25263f27d899SToby Isaac ni->refct = 1; 25273f27d899SToby Isaac ni->nodeIdxDim = nodeIdxDim = intNodeIndices->nodeIdxDim; 25283f27d899SToby Isaac ni->nodeVecDim = nodeVecDim = intNodeIndices->nodeVecDim; 25293f27d899SToby Isaac ni->nNodes = nNodes = intNodeIndices->nNodes; 25309566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nNodes * nodeIdxDim, &(ni->nodeIdx))); 25319566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nNodes * nodeVecDim, &(ni->nodeVec))); 253277f1a120SToby Isaac /* push forward the dofs by the symmetry of the reference element induced by ornt */ 25339566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesPushForward(dm, vertIndices, 0, vertIndices, intNodeIndices, ornt, formDegree, ni->nodeIdx, ni->nodeVec)); 253477f1a120SToby Isaac /* get the revlex order for both the original and transformed dofs */ 25359566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesGetPermutation(intNodeIndices, &perm)); 25369566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesGetPermutation(ni, &permOrnt)); 25379566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nNodes, &nnz)); 25383f27d899SToby Isaac for (n = 0, maxGroupSize = 0; n < nNodes;) { /* incremented in the loop */ 25393f27d899SToby Isaac PetscInt *nind = &(ni->nodeIdx[permOrnt[n] * nodeIdxDim]); 25403f27d899SToby Isaac PetscInt m, nEnd; 25413f27d899SToby Isaac PetscInt groupSize; 254277f1a120SToby Isaac /* for each group of dofs that have the same nodeIdx coordinate */ 25433f27d899SToby Isaac for (nEnd = n + 1; nEnd < nNodes; nEnd++) { 25443f27d899SToby Isaac PetscInt *mind = &(ni->nodeIdx[permOrnt[nEnd] * nodeIdxDim]); 25453f27d899SToby Isaac PetscInt d; 25463f27d899SToby Isaac 25473f27d899SToby Isaac /* compare the oriented permutation indices */ 25489371c9d4SSatish Balay for (d = 0; d < nodeIdxDim; d++) 25499371c9d4SSatish Balay if (mind[d] != nind[d]) break; 25503f27d899SToby Isaac if (d < nodeIdxDim) break; 25513f27d899SToby Isaac } 255277f1a120SToby Isaac /* permOrnt[[n, nEnd)] is a group of dofs that, under the symmetry are at the same location */ 255376bd3646SJed Brown 255477f1a120SToby Isaac /* the symmetry had better map the group of dofs with the same permuted nodeIdx 255577f1a120SToby Isaac * to a group of dofs with the same size, otherwise we messed up */ 255676bd3646SJed Brown if (PetscDefined(USE_DEBUG)) { 25573f27d899SToby Isaac PetscInt m; 25583f27d899SToby Isaac PetscInt *nind = &(intNodeIndices->nodeIdx[perm[n] * nodeIdxDim]); 25593f27d899SToby Isaac 25603f27d899SToby Isaac for (m = n + 1; m < nEnd; m++) { 25613f27d899SToby Isaac PetscInt *mind = &(intNodeIndices->nodeIdx[perm[m] * nodeIdxDim]); 25623f27d899SToby Isaac PetscInt d; 25633f27d899SToby Isaac 25643f27d899SToby Isaac /* compare the oriented permutation indices */ 25659371c9d4SSatish Balay for (d = 0; d < nodeIdxDim; d++) 25669371c9d4SSatish Balay if (mind[d] != nind[d]) break; 25673f27d899SToby Isaac if (d < nodeIdxDim) break; 25683f27d899SToby Isaac } 256908401ef6SPierre Jolivet PetscCheck(m >= nEnd, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Dofs with same index after symmetry not same block size"); 25703f27d899SToby Isaac } 25713f27d899SToby Isaac groupSize = nEnd - n; 257277f1a120SToby Isaac /* each pushforward dof vector will be expressed in a basis of the unpermuted dofs */ 25733f27d899SToby Isaac for (m = n; m < nEnd; m++) nnz[permOrnt[m]] = groupSize; 25743f27d899SToby Isaac 25753f27d899SToby Isaac maxGroupSize = PetscMax(maxGroupSize, nEnd - n); 25763f27d899SToby Isaac n = nEnd; 25773f27d899SToby Isaac } 257808401ef6SPierre Jolivet PetscCheck(maxGroupSize <= nodeVecDim, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Dofs are not in blocks that can be solved"); 25799566063dSJacob Faibussowitsch PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF, nNodes, nNodes, 0, nnz, &A)); 25809566063dSJacob Faibussowitsch PetscCall(PetscFree(nnz)); 25819566063dSJacob Faibussowitsch PetscCall(PetscMalloc3(maxGroupSize * nodeVecDim, &V, maxGroupSize * nodeVecDim, &W, nodeVecDim * 2, &work)); 25823f27d899SToby Isaac for (n = 0; n < nNodes;) { /* incremented in the loop */ 25833f27d899SToby Isaac PetscInt *nind = &(ni->nodeIdx[permOrnt[n] * nodeIdxDim]); 25843f27d899SToby Isaac PetscInt nEnd; 25853f27d899SToby Isaac PetscInt m; 25863f27d899SToby Isaac PetscInt groupSize; 25873f27d899SToby Isaac for (nEnd = n + 1; nEnd < nNodes; nEnd++) { 25883f27d899SToby Isaac PetscInt *mind = &(ni->nodeIdx[permOrnt[nEnd] * nodeIdxDim]); 25893f27d899SToby Isaac PetscInt d; 25903f27d899SToby Isaac 25913f27d899SToby Isaac /* compare the oriented permutation indices */ 25929371c9d4SSatish Balay for (d = 0; d < nodeIdxDim; d++) 25939371c9d4SSatish Balay if (mind[d] != nind[d]) break; 25943f27d899SToby Isaac if (d < nodeIdxDim) break; 25953f27d899SToby Isaac } 25963f27d899SToby Isaac groupSize = nEnd - n; 259777f1a120SToby Isaac /* get all of the vectors from the original and all of the pushforward vectors */ 25983f27d899SToby Isaac for (m = n; m < nEnd; m++) { 25993f27d899SToby Isaac PetscInt d; 26003f27d899SToby Isaac 26013f27d899SToby Isaac for (d = 0; d < nodeVecDim; d++) { 26023f27d899SToby Isaac V[(m - n) * nodeVecDim + d] = intNodeIndices->nodeVec[perm[m] * nodeVecDim + d]; 26033f27d899SToby Isaac W[(m - n) * nodeVecDim + d] = ni->nodeVec[permOrnt[m] * nodeVecDim + d]; 26043f27d899SToby Isaac } 26053f27d899SToby Isaac } 260677f1a120SToby Isaac /* now we have to solve for W in terms of V: the systems isn't always square, but the span 260777f1a120SToby Isaac * of V and W should always be the same, so the solution of the normal equations works */ 26083f27d899SToby Isaac { 26093f27d899SToby Isaac char transpose = 'N'; 26103f27d899SToby Isaac PetscBLASInt bm = nodeVecDim; 26113f27d899SToby Isaac PetscBLASInt bn = groupSize; 26123f27d899SToby Isaac PetscBLASInt bnrhs = groupSize; 26133f27d899SToby Isaac PetscBLASInt blda = bm; 26143f27d899SToby Isaac PetscBLASInt bldb = bm; 26153f27d899SToby Isaac PetscBLASInt blwork = 2 * nodeVecDim; 26163f27d899SToby Isaac PetscBLASInt info; 26173f27d899SToby Isaac 2618792fecdfSBarry Smith PetscCallBLAS("LAPACKgels", LAPACKgels_(&transpose, &bm, &bn, &bnrhs, V, &blda, W, &bldb, work, &blwork, &info)); 261908401ef6SPierre Jolivet PetscCheck(info == 0, PETSC_COMM_SELF, PETSC_ERR_LIB, "Bad argument to GELS"); 26203f27d899SToby Isaac /* repack */ 26213f27d899SToby Isaac { 26223f27d899SToby Isaac PetscInt i, j; 26233f27d899SToby Isaac 26243f27d899SToby Isaac for (i = 0; i < groupSize; i++) { 26253f27d899SToby Isaac for (j = 0; j < groupSize; j++) { 262677f1a120SToby Isaac /* notice the different leading dimension */ 26273f27d899SToby Isaac V[i * groupSize + j] = W[i * nodeVecDim + j]; 26283f27d899SToby Isaac } 26293f27d899SToby Isaac } 26303f27d899SToby Isaac } 2631c5c386beSToby Isaac if (PetscDefined(USE_DEBUG)) { 2632c5c386beSToby Isaac PetscReal res; 2633c5c386beSToby Isaac 2634c5c386beSToby Isaac /* check that the normal error is 0 */ 2635c5c386beSToby Isaac for (m = n; m < nEnd; m++) { 2636c5c386beSToby Isaac PetscInt d; 2637c5c386beSToby Isaac 2638ad540459SPierre Jolivet for (d = 0; d < nodeVecDim; d++) W[(m - n) * nodeVecDim + d] = ni->nodeVec[permOrnt[m] * nodeVecDim + d]; 2639c5c386beSToby Isaac } 2640c5c386beSToby Isaac res = 0.; 2641c5c386beSToby Isaac for (PetscInt i = 0; i < groupSize; i++) { 2642c5c386beSToby Isaac for (PetscInt j = 0; j < nodeVecDim; j++) { 2643ad540459SPierre Jolivet for (PetscInt k = 0; k < groupSize; k++) W[i * nodeVecDim + j] -= V[i * groupSize + k] * intNodeIndices->nodeVec[perm[n + k] * nodeVecDim + j]; 2644c5c386beSToby Isaac res += PetscAbsScalar(W[i * nodeVecDim + j]); 2645c5c386beSToby Isaac } 2646c5c386beSToby Isaac } 264708401ef6SPierre Jolivet PetscCheck(res <= PETSC_SMALL, PETSC_COMM_SELF, PETSC_ERR_LIB, "Dof block did not solve"); 2648c5c386beSToby Isaac } 26493f27d899SToby Isaac } 26509566063dSJacob Faibussowitsch PetscCall(MatSetValues(A, groupSize, &permOrnt[n], groupSize, &perm[n], V, INSERT_VALUES)); 26513f27d899SToby Isaac n = nEnd; 26523f27d899SToby Isaac } 26539566063dSJacob Faibussowitsch PetscCall(MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY)); 26549566063dSJacob Faibussowitsch PetscCall(MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY)); 26553f27d899SToby Isaac *symMat = A; 26569566063dSJacob Faibussowitsch PetscCall(PetscFree3(V, W, work)); 26579566063dSJacob Faibussowitsch PetscCall(PetscLagNodeIndicesDestroy(&ni)); 26583ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 26596f905325SMatthew G. Knepley } 266020cf1dd8SToby Isaac 266120cf1dd8SToby Isaac #define BaryIndex(perEdge, a, b, c) (((b) * (2 * perEdge + 1 - (b))) / 2) + (c) 266220cf1dd8SToby Isaac 266320cf1dd8SToby Isaac #define CartIndex(perEdge, a, b) (perEdge * (a) + b) 266420cf1dd8SToby Isaac 266577f1a120SToby Isaac /* the existing interface for symmetries is insufficient for all cases: 266677f1a120SToby Isaac * - it should be sufficient for form degrees that are scalar (0 and n) 266777f1a120SToby Isaac * - it should be sufficient for hypercube dofs 266877f1a120SToby Isaac * - it isn't sufficient for simplex cells with non-scalar form degrees if 266977f1a120SToby Isaac * there are any dofs in the interior 267077f1a120SToby Isaac * 267177f1a120SToby Isaac * We compute the general transformation matrices, and if they fit, we return them, 267277f1a120SToby Isaac * otherwise we error (but we should probably change the interface to allow for 267377f1a120SToby Isaac * these symmetries) 267477f1a120SToby Isaac */ 2675d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceGetSymmetries_Lagrange(PetscDualSpace sp, const PetscInt ****perms, const PetscScalar ****flips) 2676d71ae5a4SJacob Faibussowitsch { 267720cf1dd8SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 26783f27d899SToby Isaac PetscInt dim, order, Nc; 267920cf1dd8SToby Isaac 268020cf1dd8SToby Isaac PetscFunctionBegin; 26819566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetOrder(sp, &order)); 26829566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetNumComponents(sp, &Nc)); 26839566063dSJacob Faibussowitsch PetscCall(DMGetDimension(sp->dm, &dim)); 26843f27d899SToby Isaac if (!lag->symComputed) { /* store symmetries */ 26853f27d899SToby Isaac PetscInt pStart, pEnd, p; 26863f27d899SToby Isaac PetscInt numPoints; 268720cf1dd8SToby Isaac PetscInt numFaces; 26883f27d899SToby Isaac PetscInt spintdim; 26893f27d899SToby Isaac PetscInt ***symperms; 26903f27d899SToby Isaac PetscScalar ***symflips; 269120cf1dd8SToby Isaac 26929566063dSJacob Faibussowitsch PetscCall(DMPlexGetChart(sp->dm, &pStart, &pEnd)); 26933f27d899SToby Isaac numPoints = pEnd - pStart; 2694b5a892a1SMatthew G. Knepley { 2695b5a892a1SMatthew G. Knepley DMPolytopeType ct; 2696b5a892a1SMatthew G. Knepley /* The number of arrangements is no longer based on the number of faces */ 26979566063dSJacob Faibussowitsch PetscCall(DMPlexGetCellType(sp->dm, 0, &ct)); 2698b5a892a1SMatthew G. Knepley numFaces = DMPolytopeTypeGetNumArrangments(ct) / 2; 2699b5a892a1SMatthew G. Knepley } 27009566063dSJacob Faibussowitsch PetscCall(PetscCalloc1(numPoints, &symperms)); 27019566063dSJacob Faibussowitsch PetscCall(PetscCalloc1(numPoints, &symflips)); 27023f27d899SToby Isaac spintdim = sp->spintdim; 27033f27d899SToby Isaac /* The nodal symmetry behavior is not present when tensorSpace != tensorCell: someone might want this for the "S" 27043f27d899SToby Isaac * family of FEEC spaces. Most used in particular are discontinuous polynomial L2 spaces in tensor cells, where 27053f27d899SToby Isaac * the symmetries are not necessary for FE assembly. So for now we assume this is the case and don't return 27063f27d899SToby Isaac * symmetries if tensorSpace != tensorCell */ 27073f27d899SToby Isaac if (spintdim && 0 < dim && dim < 3 && (lag->tensorSpace == lag->tensorCell)) { /* compute self symmetries */ 27083f27d899SToby Isaac PetscInt **cellSymperms; 27093f27d899SToby Isaac PetscScalar **cellSymflips; 27103f27d899SToby Isaac PetscInt ornt; 27113f27d899SToby Isaac PetscInt nCopies = Nc / lag->intNodeIndices->nodeVecDim; 27123f27d899SToby Isaac PetscInt nNodes = lag->intNodeIndices->nNodes; 271320cf1dd8SToby Isaac 271420cf1dd8SToby Isaac lag->numSelfSym = 2 * numFaces; 271520cf1dd8SToby Isaac lag->selfSymOff = numFaces; 27169566063dSJacob Faibussowitsch PetscCall(PetscCalloc1(2 * numFaces, &cellSymperms)); 27179566063dSJacob Faibussowitsch PetscCall(PetscCalloc1(2 * numFaces, &cellSymflips)); 271820cf1dd8SToby Isaac /* we want to be able to index symmetries directly with the orientations, which range from [-numFaces,numFaces) */ 27193f27d899SToby Isaac symperms[0] = &cellSymperms[numFaces]; 27203f27d899SToby Isaac symflips[0] = &cellSymflips[numFaces]; 27211dca8a05SBarry Smith PetscCheck(lag->intNodeIndices->nodeVecDim * nCopies == Nc, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Node indices incompatible with dofs"); 27221dca8a05SBarry Smith PetscCheck(nNodes * nCopies == spintdim, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Node indices incompatible with dofs"); 27233f27d899SToby Isaac for (ornt = -numFaces; ornt < numFaces; ornt++) { /* for every symmetry, compute the symmetry matrix, and extract rows to see if it fits in the perm + flip framework */ 27243f27d899SToby Isaac Mat symMat; 27253f27d899SToby Isaac PetscInt *perm; 27263f27d899SToby Isaac PetscScalar *flips; 27273f27d899SToby Isaac PetscInt i; 272820cf1dd8SToby Isaac 27293f27d899SToby Isaac if (!ornt) continue; 27309566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(spintdim, &perm)); 27319566063dSJacob Faibussowitsch PetscCall(PetscCalloc1(spintdim, &flips)); 27323f27d899SToby Isaac for (i = 0; i < spintdim; i++) perm[i] = -1; 27339566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceCreateInteriorSymmetryMatrix_Lagrange(sp, ornt, &symMat)); 27343f27d899SToby Isaac for (i = 0; i < nNodes; i++) { 27353f27d899SToby Isaac PetscInt ncols; 27363f27d899SToby Isaac PetscInt j, k; 27373f27d899SToby Isaac const PetscInt *cols; 27383f27d899SToby Isaac const PetscScalar *vals; 27393f27d899SToby Isaac PetscBool nz_seen = PETSC_FALSE; 274020cf1dd8SToby Isaac 27419566063dSJacob Faibussowitsch PetscCall(MatGetRow(symMat, i, &ncols, &cols, &vals)); 27423f27d899SToby Isaac for (j = 0; j < ncols; j++) { 27433f27d899SToby Isaac if (PetscAbsScalar(vals[j]) > PETSC_SMALL) { 274428b400f6SJacob Faibussowitsch PetscCheck(!nz_seen, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips"); 27453f27d899SToby Isaac nz_seen = PETSC_TRUE; 27461dca8a05SBarry Smith PetscCheck(PetscAbsReal(PetscAbsScalar(vals[j]) - PetscRealConstant(1.)) <= PETSC_SMALL, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips"); 27471dca8a05SBarry Smith PetscCheck(PetscAbsReal(PetscImaginaryPart(vals[j])) <= PETSC_SMALL, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips"); 27481dca8a05SBarry Smith PetscCheck(perm[cols[j] * nCopies] < 0, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips"); 2749ad540459SPierre Jolivet for (k = 0; k < nCopies; k++) perm[cols[j] * nCopies + k] = i * nCopies + k; 27503f27d899SToby Isaac if (PetscRealPart(vals[j]) < 0.) { 2751ad540459SPierre Jolivet for (k = 0; k < nCopies; k++) flips[i * nCopies + k] = -1.; 275220cf1dd8SToby Isaac } else { 2753ad540459SPierre Jolivet for (k = 0; k < nCopies; k++) flips[i * nCopies + k] = 1.; 27543f27d899SToby Isaac } 27553f27d899SToby Isaac } 27563f27d899SToby Isaac } 27579566063dSJacob Faibussowitsch PetscCall(MatRestoreRow(symMat, i, &ncols, &cols, &vals)); 27583f27d899SToby Isaac } 27599566063dSJacob Faibussowitsch PetscCall(MatDestroy(&symMat)); 27603f27d899SToby Isaac /* if there were no sign flips, keep NULL */ 27619371c9d4SSatish Balay for (i = 0; i < spintdim; i++) 27629371c9d4SSatish Balay if (flips[i] != 1.) break; 27633f27d899SToby Isaac if (i == spintdim) { 27649566063dSJacob Faibussowitsch PetscCall(PetscFree(flips)); 27653f27d899SToby Isaac flips = NULL; 27663f27d899SToby Isaac } 27673f27d899SToby Isaac /* if the permutation is identity, keep NULL */ 27689371c9d4SSatish Balay for (i = 0; i < spintdim; i++) 27699371c9d4SSatish Balay if (perm[i] != i) break; 27703f27d899SToby Isaac if (i == spintdim) { 27719566063dSJacob Faibussowitsch PetscCall(PetscFree(perm)); 27723f27d899SToby Isaac perm = NULL; 27733f27d899SToby Isaac } 27743f27d899SToby Isaac symperms[0][ornt] = perm; 27753f27d899SToby Isaac symflips[0][ornt] = flips; 27763f27d899SToby Isaac } 27773f27d899SToby Isaac /* if no orientations produced non-identity permutations, keep NULL */ 27789371c9d4SSatish Balay for (ornt = -numFaces; ornt < numFaces; ornt++) 27799371c9d4SSatish Balay if (symperms[0][ornt]) break; 27803f27d899SToby Isaac if (ornt == numFaces) { 27819566063dSJacob Faibussowitsch PetscCall(PetscFree(cellSymperms)); 27823f27d899SToby Isaac symperms[0] = NULL; 27833f27d899SToby Isaac } 27843f27d899SToby Isaac /* if no orientations produced sign flips, keep NULL */ 27859371c9d4SSatish Balay for (ornt = -numFaces; ornt < numFaces; ornt++) 27869371c9d4SSatish Balay if (symflips[0][ornt]) break; 27873f27d899SToby Isaac if (ornt == numFaces) { 27889566063dSJacob Faibussowitsch PetscCall(PetscFree(cellSymflips)); 27893f27d899SToby Isaac symflips[0] = NULL; 27903f27d899SToby Isaac } 27913f27d899SToby Isaac } 279277f1a120SToby Isaac { /* get the symmetries of closure points */ 27933f27d899SToby Isaac PetscInt closureSize = 0; 27943f27d899SToby Isaac PetscInt *closure = NULL; 27953f27d899SToby Isaac PetscInt r; 279620cf1dd8SToby Isaac 27979566063dSJacob Faibussowitsch PetscCall(DMPlexGetTransitiveClosure(sp->dm, 0, PETSC_TRUE, &closureSize, &closure)); 27983f27d899SToby Isaac for (r = 0; r < closureSize; r++) { 27993f27d899SToby Isaac PetscDualSpace psp; 28003f27d899SToby Isaac PetscInt point = closure[2 * r]; 28013f27d899SToby Isaac PetscInt pspintdim; 28023f27d899SToby Isaac const PetscInt ***psymperms = NULL; 28033f27d899SToby Isaac const PetscScalar ***psymflips = NULL; 280420cf1dd8SToby Isaac 28053f27d899SToby Isaac if (!point) continue; 28069566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetPointSubspace(sp, point, &psp)); 28073f27d899SToby Isaac if (!psp) continue; 28089566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetInteriorDimension(psp, &pspintdim)); 28093f27d899SToby Isaac if (!pspintdim) continue; 28109566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceGetSymmetries(psp, &psymperms, &psymflips)); 28113f27d899SToby Isaac symperms[r] = (PetscInt **)(psymperms ? psymperms[0] : NULL); 28123f27d899SToby Isaac symflips[r] = (PetscScalar **)(psymflips ? psymflips[0] : NULL); 281320cf1dd8SToby Isaac } 28149566063dSJacob Faibussowitsch PetscCall(DMPlexRestoreTransitiveClosure(sp->dm, 0, PETSC_TRUE, &closureSize, &closure)); 281520cf1dd8SToby Isaac } 28169371c9d4SSatish Balay for (p = 0; p < pEnd; p++) 28179371c9d4SSatish Balay if (symperms[p]) break; 28183f27d899SToby Isaac if (p == pEnd) { 28199566063dSJacob Faibussowitsch PetscCall(PetscFree(symperms)); 28203f27d899SToby Isaac symperms = NULL; 282120cf1dd8SToby Isaac } 28229371c9d4SSatish Balay for (p = 0; p < pEnd; p++) 28239371c9d4SSatish Balay if (symflips[p]) break; 28243f27d899SToby Isaac if (p == pEnd) { 28259566063dSJacob Faibussowitsch PetscCall(PetscFree(symflips)); 28263f27d899SToby Isaac symflips = NULL; 282720cf1dd8SToby Isaac } 28283f27d899SToby Isaac lag->symperms = symperms; 28293f27d899SToby Isaac lag->symflips = symflips; 28303f27d899SToby Isaac lag->symComputed = PETSC_TRUE; 283120cf1dd8SToby Isaac } 28323f27d899SToby Isaac if (perms) *perms = (const PetscInt ***)lag->symperms; 28333f27d899SToby Isaac if (flips) *flips = (const PetscScalar ***)lag->symflips; 28343ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 283520cf1dd8SToby Isaac } 283620cf1dd8SToby Isaac 2837d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeGetContinuity_Lagrange(PetscDualSpace sp, PetscBool *continuous) 2838d71ae5a4SJacob Faibussowitsch { 283920cf1dd8SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 284020cf1dd8SToby Isaac 284120cf1dd8SToby Isaac PetscFunctionBegin; 284220cf1dd8SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 2843dadcf809SJacob Faibussowitsch PetscValidBoolPointer(continuous, 2); 284420cf1dd8SToby Isaac *continuous = lag->continuous; 28453ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 284620cf1dd8SToby Isaac } 284720cf1dd8SToby Isaac 2848d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeSetContinuity_Lagrange(PetscDualSpace sp, PetscBool continuous) 2849d71ae5a4SJacob Faibussowitsch { 285020cf1dd8SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 285120cf1dd8SToby Isaac 285220cf1dd8SToby Isaac PetscFunctionBegin; 285320cf1dd8SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 285420cf1dd8SToby Isaac lag->continuous = continuous; 28553ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 285620cf1dd8SToby Isaac } 285720cf1dd8SToby Isaac 285820cf1dd8SToby Isaac /*@ 285920cf1dd8SToby Isaac PetscDualSpaceLagrangeGetContinuity - Retrieves the flag for element continuity 286020cf1dd8SToby Isaac 286120cf1dd8SToby Isaac Not Collective 286220cf1dd8SToby Isaac 286320cf1dd8SToby Isaac Input Parameter: 2864dce8aebaSBarry Smith . sp - the `PetscDualSpace` 286520cf1dd8SToby Isaac 286620cf1dd8SToby Isaac Output Parameter: 286720cf1dd8SToby Isaac . continuous - flag for element continuity 286820cf1dd8SToby Isaac 286920cf1dd8SToby Isaac Level: intermediate 287020cf1dd8SToby Isaac 2871b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeSetContinuity()` 287220cf1dd8SToby Isaac @*/ 2873d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeGetContinuity(PetscDualSpace sp, PetscBool *continuous) 2874d71ae5a4SJacob Faibussowitsch { 287520cf1dd8SToby Isaac PetscFunctionBegin; 287620cf1dd8SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 2877dadcf809SJacob Faibussowitsch PetscValidBoolPointer(continuous, 2); 2878cac4c232SBarry Smith PetscTryMethod(sp, "PetscDualSpaceLagrangeGetContinuity_C", (PetscDualSpace, PetscBool *), (sp, continuous)); 28793ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 288020cf1dd8SToby Isaac } 288120cf1dd8SToby Isaac 288220cf1dd8SToby Isaac /*@ 288320cf1dd8SToby Isaac PetscDualSpaceLagrangeSetContinuity - Indicate whether the element is continuous 288420cf1dd8SToby Isaac 288520f4b53cSBarry Smith Logically Collective 288620cf1dd8SToby Isaac 288720cf1dd8SToby Isaac Input Parameters: 2888dce8aebaSBarry Smith + sp - the `PetscDualSpace` 288920cf1dd8SToby Isaac - continuous - flag for element continuity 289020cf1dd8SToby Isaac 289120f4b53cSBarry Smith Options Database Key: 2892147403d9SBarry Smith . -petscdualspace_lagrange_continuity <bool> - use a continuous element 289320cf1dd8SToby Isaac 289420cf1dd8SToby Isaac Level: intermediate 289520cf1dd8SToby Isaac 2896b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeGetContinuity()` 289720cf1dd8SToby Isaac @*/ 2898d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeSetContinuity(PetscDualSpace sp, PetscBool continuous) 2899d71ae5a4SJacob Faibussowitsch { 290020cf1dd8SToby Isaac PetscFunctionBegin; 290120cf1dd8SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 290220cf1dd8SToby Isaac PetscValidLogicalCollectiveBool(sp, continuous, 2); 2903cac4c232SBarry Smith PetscTryMethod(sp, "PetscDualSpaceLagrangeSetContinuity_C", (PetscDualSpace, PetscBool), (sp, continuous)); 29043ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 290520cf1dd8SToby Isaac } 290620cf1dd8SToby Isaac 2907d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeGetTensor_Lagrange(PetscDualSpace sp, PetscBool *tensor) 2908d71ae5a4SJacob Faibussowitsch { 290920cf1dd8SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 29106f905325SMatthew G. Knepley 29116f905325SMatthew G. Knepley PetscFunctionBegin; 29126f905325SMatthew G. Knepley *tensor = lag->tensorSpace; 29133ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 29146f905325SMatthew G. Knepley } 29156f905325SMatthew G. Knepley 2916d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeSetTensor_Lagrange(PetscDualSpace sp, PetscBool tensor) 2917d71ae5a4SJacob Faibussowitsch { 29186f905325SMatthew G. Knepley PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 29196f905325SMatthew G. Knepley 29206f905325SMatthew G. Knepley PetscFunctionBegin; 29216f905325SMatthew G. Knepley lag->tensorSpace = tensor; 29223ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 29236f905325SMatthew G. Knepley } 29246f905325SMatthew G. Knepley 2925d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeGetTrimmed_Lagrange(PetscDualSpace sp, PetscBool *trimmed) 2926d71ae5a4SJacob Faibussowitsch { 29273f27d899SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 29283f27d899SToby Isaac 29293f27d899SToby Isaac PetscFunctionBegin; 29303f27d899SToby Isaac *trimmed = lag->trimmed; 29313ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 29323f27d899SToby Isaac } 29333f27d899SToby Isaac 2934d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeSetTrimmed_Lagrange(PetscDualSpace sp, PetscBool trimmed) 2935d71ae5a4SJacob Faibussowitsch { 29363f27d899SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 29373f27d899SToby Isaac 29383f27d899SToby Isaac PetscFunctionBegin; 29393f27d899SToby Isaac lag->trimmed = trimmed; 29403ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 29413f27d899SToby Isaac } 29423f27d899SToby Isaac 2943d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeGetNodeType_Lagrange(PetscDualSpace sp, PetscDTNodeType *nodeType, PetscBool *boundary, PetscReal *exponent) 2944d71ae5a4SJacob Faibussowitsch { 29453f27d899SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 29463f27d899SToby Isaac 29473f27d899SToby Isaac PetscFunctionBegin; 29483f27d899SToby Isaac if (nodeType) *nodeType = lag->nodeType; 29493f27d899SToby Isaac if (boundary) *boundary = lag->endNodes; 29503f27d899SToby Isaac if (exponent) *exponent = lag->nodeExponent; 29513ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 29523f27d899SToby Isaac } 29533f27d899SToby Isaac 2954d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeSetNodeType_Lagrange(PetscDualSpace sp, PetscDTNodeType nodeType, PetscBool boundary, PetscReal exponent) 2955d71ae5a4SJacob Faibussowitsch { 29563f27d899SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 29573f27d899SToby Isaac 29583f27d899SToby Isaac PetscFunctionBegin; 29591dca8a05SBarry Smith PetscCheck(nodeType != PETSCDTNODES_GAUSSJACOBI || exponent > -1., PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_OUTOFRANGE, "Exponent must be > -1"); 29603f27d899SToby Isaac lag->nodeType = nodeType; 29613f27d899SToby Isaac lag->endNodes = boundary; 29623f27d899SToby Isaac lag->nodeExponent = exponent; 29633ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 29643f27d899SToby Isaac } 29653f27d899SToby Isaac 2966d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeGetUseMoments_Lagrange(PetscDualSpace sp, PetscBool *useMoments) 2967d71ae5a4SJacob Faibussowitsch { 296866a6c23cSMatthew G. Knepley PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 296966a6c23cSMatthew G. Knepley 297066a6c23cSMatthew G. Knepley PetscFunctionBegin; 297166a6c23cSMatthew G. Knepley *useMoments = lag->useMoments; 29723ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 297366a6c23cSMatthew G. Knepley } 297466a6c23cSMatthew G. Knepley 2975d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeSetUseMoments_Lagrange(PetscDualSpace sp, PetscBool useMoments) 2976d71ae5a4SJacob Faibussowitsch { 297766a6c23cSMatthew G. Knepley PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 297866a6c23cSMatthew G. Knepley 297966a6c23cSMatthew G. Knepley PetscFunctionBegin; 298066a6c23cSMatthew G. Knepley lag->useMoments = useMoments; 29813ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 298266a6c23cSMatthew G. Knepley } 298366a6c23cSMatthew G. Knepley 2984d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeGetMomentOrder_Lagrange(PetscDualSpace sp, PetscInt *momentOrder) 2985d71ae5a4SJacob Faibussowitsch { 298666a6c23cSMatthew G. Knepley PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 298766a6c23cSMatthew G. Knepley 298866a6c23cSMatthew G. Knepley PetscFunctionBegin; 298966a6c23cSMatthew G. Knepley *momentOrder = lag->momentOrder; 29903ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 299166a6c23cSMatthew G. Knepley } 299266a6c23cSMatthew G. Knepley 2993d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceLagrangeSetMomentOrder_Lagrange(PetscDualSpace sp, PetscInt momentOrder) 2994d71ae5a4SJacob Faibussowitsch { 299566a6c23cSMatthew G. Knepley PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 299666a6c23cSMatthew G. Knepley 299766a6c23cSMatthew G. Knepley PetscFunctionBegin; 299866a6c23cSMatthew G. Knepley lag->momentOrder = momentOrder; 29993ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 300066a6c23cSMatthew G. Knepley } 300166a6c23cSMatthew G. Knepley 30026f905325SMatthew G. Knepley /*@ 30036f905325SMatthew G. Knepley PetscDualSpaceLagrangeGetTensor - Get the tensor nature of the dual space 30046f905325SMatthew G. Knepley 300520f4b53cSBarry Smith Not Collective 30066f905325SMatthew G. Knepley 30076f905325SMatthew G. Knepley Input Parameter: 3008dce8aebaSBarry Smith . sp - The `PetscDualSpace` 30096f905325SMatthew G. Knepley 30106f905325SMatthew G. Knepley Output Parameter: 30116f905325SMatthew G. Knepley . tensor - Whether the dual space has tensor layout (vs. simplicial) 30126f905325SMatthew G. Knepley 30136f905325SMatthew G. Knepley Level: intermediate 30146f905325SMatthew G. Knepley 3015b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeSetTensor()`, `PetscDualSpaceCreate()` 30166f905325SMatthew G. Knepley @*/ 3017d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeGetTensor(PetscDualSpace sp, PetscBool *tensor) 3018d71ae5a4SJacob Faibussowitsch { 301920cf1dd8SToby Isaac PetscFunctionBegin; 302020cf1dd8SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 3021dadcf809SJacob Faibussowitsch PetscValidBoolPointer(tensor, 2); 3022cac4c232SBarry Smith PetscTryMethod(sp, "PetscDualSpaceLagrangeGetTensor_C", (PetscDualSpace, PetscBool *), (sp, tensor)); 30233ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 302420cf1dd8SToby Isaac } 302520cf1dd8SToby Isaac 30266f905325SMatthew G. Knepley /*@ 30276f905325SMatthew G. Knepley PetscDualSpaceLagrangeSetTensor - Set the tensor nature of the dual space 30286f905325SMatthew G. Knepley 302920f4b53cSBarry Smith Not Collective 30306f905325SMatthew G. Knepley 30316f905325SMatthew G. Knepley Input Parameters: 3032dce8aebaSBarry Smith + sp - The `PetscDualSpace` 30336f905325SMatthew G. Knepley - tensor - Whether the dual space has tensor layout (vs. simplicial) 30346f905325SMatthew G. Knepley 30356f905325SMatthew G. Knepley Level: intermediate 30366f905325SMatthew G. Knepley 3037b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeGetTensor()`, `PetscDualSpaceCreate()` 30386f905325SMatthew G. Knepley @*/ 3039d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeSetTensor(PetscDualSpace sp, PetscBool tensor) 3040d71ae5a4SJacob Faibussowitsch { 30416f905325SMatthew G. Knepley PetscFunctionBegin; 30426f905325SMatthew G. Knepley PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 3043cac4c232SBarry Smith PetscTryMethod(sp, "PetscDualSpaceLagrangeSetTensor_C", (PetscDualSpace, PetscBool), (sp, tensor)); 30443ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 30456f905325SMatthew G. Knepley } 30466f905325SMatthew G. Knepley 30473f27d899SToby Isaac /*@ 30483f27d899SToby Isaac PetscDualSpaceLagrangeGetTrimmed - Get the trimmed nature of the dual space 30493f27d899SToby Isaac 305020f4b53cSBarry Smith Not Collective 30513f27d899SToby Isaac 30523f27d899SToby Isaac Input Parameter: 3053dce8aebaSBarry Smith . sp - The `PetscDualSpace` 30543f27d899SToby Isaac 30553f27d899SToby Isaac Output Parameter: 30563f27d899SToby Isaac . trimmed - Whether the dual space represents to dual basis of a trimmed polynomial space (e.g. Raviart-Thomas and higher order / other form degree variants) 30573f27d899SToby Isaac 30583f27d899SToby Isaac Level: intermediate 30593f27d899SToby Isaac 3060b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeSetTrimmed()`, `PetscDualSpaceCreate()` 30613f27d899SToby Isaac @*/ 3062d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeGetTrimmed(PetscDualSpace sp, PetscBool *trimmed) 3063d71ae5a4SJacob Faibussowitsch { 30643f27d899SToby Isaac PetscFunctionBegin; 30653f27d899SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 3066dadcf809SJacob Faibussowitsch PetscValidBoolPointer(trimmed, 2); 3067cac4c232SBarry Smith PetscTryMethod(sp, "PetscDualSpaceLagrangeGetTrimmed_C", (PetscDualSpace, PetscBool *), (sp, trimmed)); 30683ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 30693f27d899SToby Isaac } 30703f27d899SToby Isaac 30713f27d899SToby Isaac /*@ 30723f27d899SToby Isaac PetscDualSpaceLagrangeSetTrimmed - Set the trimmed nature of the dual space 30733f27d899SToby Isaac 307420f4b53cSBarry Smith Not Collective 30753f27d899SToby Isaac 30763f27d899SToby Isaac Input Parameters: 3077dce8aebaSBarry Smith + sp - The `PetscDualSpace` 30783f27d899SToby Isaac - trimmed - Whether the dual space represents to dual basis of a trimmed polynomial space (e.g. Raviart-Thomas and higher order / other form degree variants) 30793f27d899SToby Isaac 30803f27d899SToby Isaac Level: intermediate 30813f27d899SToby Isaac 3082b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeGetTrimmed()`, `PetscDualSpaceCreate()` 30833f27d899SToby Isaac @*/ 3084d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeSetTrimmed(PetscDualSpace sp, PetscBool trimmed) 3085d71ae5a4SJacob Faibussowitsch { 30863f27d899SToby Isaac PetscFunctionBegin; 30873f27d899SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 3088cac4c232SBarry Smith PetscTryMethod(sp, "PetscDualSpaceLagrangeSetTrimmed_C", (PetscDualSpace, PetscBool), (sp, trimmed)); 30893ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 30903f27d899SToby Isaac } 30913f27d899SToby Isaac 30923f27d899SToby Isaac /*@ 30933f27d899SToby Isaac PetscDualSpaceLagrangeGetNodeType - Get a description of how nodes are laid out for Lagrange polynomials in this 30943f27d899SToby Isaac dual space 30953f27d899SToby Isaac 309620f4b53cSBarry Smith Not Collective 30973f27d899SToby Isaac 30983f27d899SToby Isaac Input Parameter: 3099dce8aebaSBarry Smith . sp - The `PetscDualSpace` 31003f27d899SToby Isaac 31013f27d899SToby Isaac Output Parameters: 31023f27d899SToby Isaac + nodeType - The type of nodes 3103dce8aebaSBarry Smith . boundary - Whether the node type is one that includes endpoints (if nodeType is `PETSCDTNODES_GAUSSJACOBI`, nodes that 31043f27d899SToby Isaac include the boundary are Gauss-Lobatto-Jacobi nodes) 3105dce8aebaSBarry Smith - exponent - If nodeType is `PETSCDTNODES_GAUSJACOBI`, indicates the exponent used for both ends of the 1D Jacobi weight function 31063f27d899SToby Isaac '0' is Gauss-Legendre, '-0.5' is Gauss-Chebyshev of the first type, '0.5' is Gauss-Chebyshev of the second type 31073f27d899SToby Isaac 31083f27d899SToby Isaac Level: advanced 31093f27d899SToby Isaac 3110b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDTNodeType`, `PetscDualSpaceLagrangeSetNodeType()` 31113f27d899SToby Isaac @*/ 3112d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeGetNodeType(PetscDualSpace sp, PetscDTNodeType *nodeType, PetscBool *boundary, PetscReal *exponent) 3113d71ae5a4SJacob Faibussowitsch { 31143f27d899SToby Isaac PetscFunctionBegin; 31153f27d899SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 31163f27d899SToby Isaac if (nodeType) PetscValidPointer(nodeType, 2); 3117dadcf809SJacob Faibussowitsch if (boundary) PetscValidBoolPointer(boundary, 3); 3118dadcf809SJacob Faibussowitsch if (exponent) PetscValidRealPointer(exponent, 4); 3119cac4c232SBarry Smith PetscTryMethod(sp, "PetscDualSpaceLagrangeGetNodeType_C", (PetscDualSpace, PetscDTNodeType *, PetscBool *, PetscReal *), (sp, nodeType, boundary, exponent)); 31203ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 31213f27d899SToby Isaac } 31223f27d899SToby Isaac 31233f27d899SToby Isaac /*@ 31243f27d899SToby Isaac PetscDualSpaceLagrangeSetNodeType - Set a description of how nodes are laid out for Lagrange polynomials in this 31253f27d899SToby Isaac dual space 31263f27d899SToby Isaac 312720f4b53cSBarry Smith Logically Collective 31283f27d899SToby Isaac 31293f27d899SToby Isaac Input Parameters: 3130dce8aebaSBarry Smith + sp - The `PetscDualSpace` 31313f27d899SToby Isaac . nodeType - The type of nodes 3132dce8aebaSBarry Smith . boundary - Whether the node type is one that includes endpoints (if nodeType is `PETSCDTNODES_GAUSSJACOBI`, nodes that 31333f27d899SToby Isaac include the boundary are Gauss-Lobatto-Jacobi nodes) 3134dce8aebaSBarry Smith - exponent - If nodeType is `PETSCDTNODES_GAUSJACOBI`, indicates the exponent used for both ends of the 1D Jacobi weight function 31353f27d899SToby Isaac '0' is Gauss-Legendre, '-0.5' is Gauss-Chebyshev of the first type, '0.5' is Gauss-Chebyshev of the second type 31363f27d899SToby Isaac 31373f27d899SToby Isaac Level: advanced 31383f27d899SToby Isaac 3139b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDTNodeType`, `PetscDualSpaceLagrangeGetNodeType()` 31403f27d899SToby Isaac @*/ 3141d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeSetNodeType(PetscDualSpace sp, PetscDTNodeType nodeType, PetscBool boundary, PetscReal exponent) 3142d71ae5a4SJacob Faibussowitsch { 31433f27d899SToby Isaac PetscFunctionBegin; 31443f27d899SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 3145cac4c232SBarry Smith PetscTryMethod(sp, "PetscDualSpaceLagrangeSetNodeType_C", (PetscDualSpace, PetscDTNodeType, PetscBool, PetscReal), (sp, nodeType, boundary, exponent)); 31463ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 31473f27d899SToby Isaac } 31483f27d899SToby Isaac 314966a6c23cSMatthew G. Knepley /*@ 315066a6c23cSMatthew G. Knepley PetscDualSpaceLagrangeGetUseMoments - Get the flag for using moment functionals 315166a6c23cSMatthew G. Knepley 315220f4b53cSBarry Smith Not Collective 315366a6c23cSMatthew G. Knepley 315466a6c23cSMatthew G. Knepley Input Parameter: 3155dce8aebaSBarry Smith . sp - The `PetscDualSpace` 315666a6c23cSMatthew G. Knepley 315766a6c23cSMatthew G. Knepley Output Parameter: 315866a6c23cSMatthew G. Knepley . useMoments - Moment flag 315966a6c23cSMatthew G. Knepley 316066a6c23cSMatthew G. Knepley Level: advanced 316166a6c23cSMatthew G. Knepley 3162b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeSetUseMoments()` 316366a6c23cSMatthew G. Knepley @*/ 3164d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeGetUseMoments(PetscDualSpace sp, PetscBool *useMoments) 3165d71ae5a4SJacob Faibussowitsch { 316666a6c23cSMatthew G. Knepley PetscFunctionBegin; 316766a6c23cSMatthew G. Knepley PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 316866a6c23cSMatthew G. Knepley PetscValidBoolPointer(useMoments, 2); 3169cac4c232SBarry Smith PetscUseMethod(sp, "PetscDualSpaceLagrangeGetUseMoments_C", (PetscDualSpace, PetscBool *), (sp, useMoments)); 31703ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 317166a6c23cSMatthew G. Knepley } 317266a6c23cSMatthew G. Knepley 317366a6c23cSMatthew G. Knepley /*@ 317466a6c23cSMatthew G. Knepley PetscDualSpaceLagrangeSetUseMoments - Set the flag for moment functionals 317566a6c23cSMatthew G. Knepley 317620f4b53cSBarry Smith Logically Collective 317766a6c23cSMatthew G. Knepley 317866a6c23cSMatthew G. Knepley Input Parameters: 3179dce8aebaSBarry Smith + sp - The `PetscDualSpace` 318066a6c23cSMatthew G. Knepley - useMoments - The flag for moment functionals 318166a6c23cSMatthew G. Knepley 318266a6c23cSMatthew G. Knepley Level: advanced 318366a6c23cSMatthew G. Knepley 3184b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeGetUseMoments()` 318566a6c23cSMatthew G. Knepley @*/ 3186d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeSetUseMoments(PetscDualSpace sp, PetscBool useMoments) 3187d71ae5a4SJacob Faibussowitsch { 318866a6c23cSMatthew G. Knepley PetscFunctionBegin; 318966a6c23cSMatthew G. Knepley PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 3190cac4c232SBarry Smith PetscTryMethod(sp, "PetscDualSpaceLagrangeSetUseMoments_C", (PetscDualSpace, PetscBool), (sp, useMoments)); 31913ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 319266a6c23cSMatthew G. Knepley } 319366a6c23cSMatthew G. Knepley 319466a6c23cSMatthew G. Knepley /*@ 319566a6c23cSMatthew G. Knepley PetscDualSpaceLagrangeGetMomentOrder - Get the order for moment integration 319666a6c23cSMatthew G. Knepley 319720f4b53cSBarry Smith Not Collective 319866a6c23cSMatthew G. Knepley 319966a6c23cSMatthew G. Knepley Input Parameter: 3200dce8aebaSBarry Smith . sp - The `PetscDualSpace` 320166a6c23cSMatthew G. Knepley 320266a6c23cSMatthew G. Knepley Output Parameter: 320366a6c23cSMatthew G. Knepley . order - Moment integration order 320466a6c23cSMatthew G. Knepley 320566a6c23cSMatthew G. Knepley Level: advanced 320666a6c23cSMatthew G. Knepley 3207b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeSetMomentOrder()` 320866a6c23cSMatthew G. Knepley @*/ 3209d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeGetMomentOrder(PetscDualSpace sp, PetscInt *order) 3210d71ae5a4SJacob Faibussowitsch { 321166a6c23cSMatthew G. Knepley PetscFunctionBegin; 321266a6c23cSMatthew G. Knepley PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 321366a6c23cSMatthew G. Knepley PetscValidIntPointer(order, 2); 3214cac4c232SBarry Smith PetscUseMethod(sp, "PetscDualSpaceLagrangeGetMomentOrder_C", (PetscDualSpace, PetscInt *), (sp, order)); 32153ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 321666a6c23cSMatthew G. Knepley } 321766a6c23cSMatthew G. Knepley 321866a6c23cSMatthew G. Knepley /*@ 321966a6c23cSMatthew G. Knepley PetscDualSpaceLagrangeSetMomentOrder - Set the order for moment integration 322066a6c23cSMatthew G. Knepley 322120f4b53cSBarry Smith Logically Collective 322266a6c23cSMatthew G. Knepley 322366a6c23cSMatthew G. Knepley Input Parameters: 3224dce8aebaSBarry Smith + sp - The `PetscDualSpace` 322566a6c23cSMatthew G. Knepley - order - The order for moment integration 322666a6c23cSMatthew G. Knepley 322766a6c23cSMatthew G. Knepley Level: advanced 322866a6c23cSMatthew G. Knepley 3229b24fb147SBarry Smith .seealso: `PETSCDUALSPACELAGRANGE`, `PetscDualSpace`, `PetscDualSpaceLagrangeGetMomentOrder()` 323066a6c23cSMatthew G. Knepley @*/ 3231d71ae5a4SJacob Faibussowitsch PetscErrorCode PetscDualSpaceLagrangeSetMomentOrder(PetscDualSpace sp, PetscInt order) 3232d71ae5a4SJacob Faibussowitsch { 323366a6c23cSMatthew G. Knepley PetscFunctionBegin; 323466a6c23cSMatthew G. Knepley PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 3235cac4c232SBarry Smith PetscTryMethod(sp, "PetscDualSpaceLagrangeSetMomentOrder_C", (PetscDualSpace, PetscInt), (sp, order)); 32363ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 323766a6c23cSMatthew G. Knepley } 32383f27d899SToby Isaac 3239d71ae5a4SJacob Faibussowitsch static PetscErrorCode PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp) 3240d71ae5a4SJacob Faibussowitsch { 324120cf1dd8SToby Isaac PetscFunctionBegin; 324220cf1dd8SToby Isaac sp->ops->destroy = PetscDualSpaceDestroy_Lagrange; 32436f905325SMatthew G. Knepley sp->ops->view = PetscDualSpaceView_Lagrange; 32446f905325SMatthew G. Knepley sp->ops->setfromoptions = PetscDualSpaceSetFromOptions_Lagrange; 324520cf1dd8SToby Isaac sp->ops->duplicate = PetscDualSpaceDuplicate_Lagrange; 32466f905325SMatthew G. Knepley sp->ops->setup = PetscDualSpaceSetUp_Lagrange; 32473f27d899SToby Isaac sp->ops->createheightsubspace = NULL; 32483f27d899SToby Isaac sp->ops->createpointsubspace = NULL; 324920cf1dd8SToby Isaac sp->ops->getsymmetries = PetscDualSpaceGetSymmetries_Lagrange; 325020cf1dd8SToby Isaac sp->ops->apply = PetscDualSpaceApplyDefault; 325120cf1dd8SToby Isaac sp->ops->applyall = PetscDualSpaceApplyAllDefault; 3252b4457527SToby Isaac sp->ops->applyint = PetscDualSpaceApplyInteriorDefault; 32533f27d899SToby Isaac sp->ops->createalldata = PetscDualSpaceCreateAllDataDefault; 3254b4457527SToby Isaac sp->ops->createintdata = PetscDualSpaceCreateInteriorDataDefault; 32553ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 325620cf1dd8SToby Isaac } 325720cf1dd8SToby Isaac 325820cf1dd8SToby Isaac /*MC 3259dce8aebaSBarry Smith PETSCDUALSPACELAGRANGE = "lagrange" - A `PetscDualSpaceType` that encapsulates a dual space of pointwise evaluation functionals 326020cf1dd8SToby Isaac 326120cf1dd8SToby Isaac Level: intermediate 326220cf1dd8SToby Isaac 3263b24fb147SBarry Smith Developer Note: 3264b24fb147SBarry Smith This `PetscDualSpace` seems to manage directly trimmed and untrimmed polynomials as well as tensor and non-tensor polynomials while for `PetscSpace` there seems to 3265b24fb147SBarry Smith be different `PetscSpaceType` for them. 3266b24fb147SBarry Smith 3267b24fb147SBarry Smith .seealso: `PetscDualSpace`, `PetscDualSpaceType`, `PetscDualSpaceCreate()`, `PetscDualSpaceSetType()`, 3268b24fb147SBarry Smith `PetscDualSpaceLagrangeSetMomentOrder()`, `PetscDualSpaceLagrangeGetMomentOrder()`, `PetscDualSpaceLagrangeSetUseMoments()`, `PetscDualSpaceLagrangeGetUseMoments()`, 3269b24fb147SBarry Smith `PetscDualSpaceLagrangeSetNodeType, PetscDualSpaceLagrangeGetNodeType, PetscDualSpaceLagrangeGetContinuity, PetscDualSpaceLagrangeSetContinuity, 3270b24fb147SBarry Smith `PetscDualSpaceLagrangeGetTensor()`, `PetscDualSpaceLagrangeSetTensor()`, `PetscDualSpaceLagrangeGetTrimmed()`, `PetscDualSpaceLagrangeSetTrimmed()` 327120cf1dd8SToby Isaac M*/ 3272d71ae5a4SJacob Faibussowitsch PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Lagrange(PetscDualSpace sp) 3273d71ae5a4SJacob Faibussowitsch { 327420cf1dd8SToby Isaac PetscDualSpace_Lag *lag; 327520cf1dd8SToby Isaac 327620cf1dd8SToby Isaac PetscFunctionBegin; 327720cf1dd8SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 32784dfa11a4SJacob Faibussowitsch PetscCall(PetscNew(&lag)); 327920cf1dd8SToby Isaac sp->data = lag; 328020cf1dd8SToby Isaac 32813f27d899SToby Isaac lag->tensorCell = PETSC_FALSE; 328220cf1dd8SToby Isaac lag->tensorSpace = PETSC_FALSE; 328320cf1dd8SToby Isaac lag->continuous = PETSC_TRUE; 32843f27d899SToby Isaac lag->numCopies = PETSC_DEFAULT; 32853f27d899SToby Isaac lag->numNodeSkip = PETSC_DEFAULT; 32863f27d899SToby Isaac lag->nodeType = PETSCDTNODES_DEFAULT; 328766a6c23cSMatthew G. Knepley lag->useMoments = PETSC_FALSE; 328866a6c23cSMatthew G. Knepley lag->momentOrder = 0; 328920cf1dd8SToby Isaac 32909566063dSJacob Faibussowitsch PetscCall(PetscDualSpaceInitialize_Lagrange(sp)); 32919566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetContinuity_C", PetscDualSpaceLagrangeGetContinuity_Lagrange)); 32929566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetContinuity_C", PetscDualSpaceLagrangeSetContinuity_Lagrange)); 32939566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetTensor_C", PetscDualSpaceLagrangeGetTensor_Lagrange)); 32949566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetTensor_C", PetscDualSpaceLagrangeSetTensor_Lagrange)); 32959566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetTrimmed_C", PetscDualSpaceLagrangeGetTrimmed_Lagrange)); 32969566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetTrimmed_C", PetscDualSpaceLagrangeSetTrimmed_Lagrange)); 32979566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetNodeType_C", PetscDualSpaceLagrangeGetNodeType_Lagrange)); 32989566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetNodeType_C", PetscDualSpaceLagrangeSetNodeType_Lagrange)); 32999566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetUseMoments_C", PetscDualSpaceLagrangeGetUseMoments_Lagrange)); 33009566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetUseMoments_C", PetscDualSpaceLagrangeSetUseMoments_Lagrange)); 33019566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeGetMomentOrder_C", PetscDualSpaceLagrangeGetMomentOrder_Lagrange)); 33029566063dSJacob Faibussowitsch PetscCall(PetscObjectComposeFunction((PetscObject)sp, "PetscDualSpaceLagrangeSetMomentOrder_C", PetscDualSpaceLagrangeSetMomentOrder_Lagrange)); 33033ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 330420cf1dd8SToby Isaac } 3305