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 73f27d899SToby Isaac struct _n_Petsc1DNodeFamily 83f27d899SToby Isaac { 93f27d899SToby Isaac PetscInt refct; 103f27d899SToby Isaac PetscDTNodeType nodeFamily; 113f27d899SToby Isaac PetscReal gaussJacobiExp; 123f27d899SToby Isaac PetscInt nComputed; 133f27d899SToby Isaac PetscReal **nodesets; 143f27d899SToby Isaac PetscBool endpoints; 153f27d899SToby Isaac }; 163f27d899SToby Isaac 1777f1a120SToby Isaac /* users set node families for PETSCDUALSPACELAGRANGE with just the inputs to this function, but internally we create 1877f1a120SToby Isaac * an object that can cache the computations across multiple dual spaces */ 193f27d899SToby Isaac static PetscErrorCode Petsc1DNodeFamilyCreate(PetscDTNodeType family, PetscReal gaussJacobiExp, PetscBool endpoints, Petsc1DNodeFamily *nf) 203f27d899SToby Isaac { 213f27d899SToby Isaac Petsc1DNodeFamily f; 223f27d899SToby Isaac PetscErrorCode ierr; 233f27d899SToby Isaac 243f27d899SToby Isaac PetscFunctionBegin; 253f27d899SToby Isaac ierr = PetscNew(&f);CHKERRQ(ierr); 263f27d899SToby Isaac switch (family) { 273f27d899SToby Isaac case PETSCDTNODES_GAUSSJACOBI: 283f27d899SToby Isaac case PETSCDTNODES_EQUISPACED: 293f27d899SToby Isaac f->nodeFamily = family; 303f27d899SToby Isaac break; 313f27d899SToby Isaac default: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown 1D node family"); 323f27d899SToby Isaac } 333f27d899SToby Isaac f->endpoints = endpoints; 343f27d899SToby Isaac f->gaussJacobiExp = 0.; 353f27d899SToby Isaac if (family == PETSCDTNODES_GAUSSJACOBI) { 363f27d899SToby Isaac if (gaussJacobiExp <= -1.) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Gauss-Jacobi exponent must be > -1.\n"); 373f27d899SToby Isaac f->gaussJacobiExp = gaussJacobiExp; 383f27d899SToby Isaac } 393f27d899SToby Isaac f->refct = 1; 403f27d899SToby Isaac *nf = f; 413f27d899SToby Isaac PetscFunctionReturn(0); 423f27d899SToby Isaac } 433f27d899SToby Isaac 443f27d899SToby Isaac static PetscErrorCode Petsc1DNodeFamilyReference(Petsc1DNodeFamily nf) 453f27d899SToby Isaac { 463f27d899SToby Isaac PetscFunctionBegin; 473f27d899SToby Isaac if (nf) nf->refct++; 483f27d899SToby Isaac PetscFunctionReturn(0); 493f27d899SToby Isaac } 503f27d899SToby Isaac 513f27d899SToby Isaac static PetscErrorCode Petsc1DNodeFamilyDestroy(Petsc1DNodeFamily *nf) { 523f27d899SToby Isaac PetscInt i, nc; 533f27d899SToby Isaac PetscErrorCode ierr; 543f27d899SToby Isaac 553f27d899SToby Isaac PetscFunctionBegin; 563f27d899SToby Isaac if (!(*nf)) PetscFunctionReturn(0); 573f27d899SToby Isaac if (--(*nf)->refct > 0) { 583f27d899SToby Isaac *nf = NULL; 593f27d899SToby Isaac PetscFunctionReturn(0); 603f27d899SToby Isaac } 613f27d899SToby Isaac nc = (*nf)->nComputed; 623f27d899SToby Isaac for (i = 0; i < nc; i++) { 633f27d899SToby Isaac ierr = PetscFree((*nf)->nodesets[i]);CHKERRQ(ierr); 643f27d899SToby Isaac } 653f27d899SToby Isaac ierr = PetscFree((*nf)->nodesets);CHKERRQ(ierr); 663f27d899SToby Isaac ierr = PetscFree(*nf);CHKERRQ(ierr); 673f27d899SToby Isaac *nf = NULL; 683f27d899SToby Isaac PetscFunctionReturn(0); 693f27d899SToby Isaac } 703f27d899SToby Isaac 713f27d899SToby Isaac static PetscErrorCode Petsc1DNodeFamilyGetNodeSets(Petsc1DNodeFamily f, PetscInt degree, PetscReal ***nodesets) 723f27d899SToby Isaac { 733f27d899SToby Isaac PetscInt nc; 743f27d899SToby Isaac PetscErrorCode ierr; 753f27d899SToby Isaac 763f27d899SToby Isaac PetscFunctionBegin; 773f27d899SToby Isaac nc = f->nComputed; 783f27d899SToby Isaac if (degree >= nc) { 793f27d899SToby Isaac PetscInt i, j; 803f27d899SToby Isaac PetscReal **new_nodesets; 813f27d899SToby Isaac PetscReal *w; 823f27d899SToby Isaac 833f27d899SToby Isaac ierr = PetscMalloc1(degree + 1, &new_nodesets);CHKERRQ(ierr); 843f27d899SToby Isaac ierr = PetscArraycpy(new_nodesets, f->nodesets, nc);CHKERRQ(ierr); 853f27d899SToby Isaac ierr = PetscFree(f->nodesets);CHKERRQ(ierr); 863f27d899SToby Isaac f->nodesets = new_nodesets; 873f27d899SToby Isaac ierr = PetscMalloc1(degree + 1, &w);CHKERRQ(ierr); 883f27d899SToby Isaac for (i = nc; i < degree + 1; i++) { 893f27d899SToby Isaac ierr = PetscMalloc1(i + 1, &(f->nodesets[i]));CHKERRQ(ierr); 903f27d899SToby Isaac if (!i) { 913f27d899SToby Isaac f->nodesets[i][0] = 0.5; 923f27d899SToby Isaac } else { 933f27d899SToby Isaac switch (f->nodeFamily) { 943f27d899SToby Isaac case PETSCDTNODES_EQUISPACED: 953f27d899SToby Isaac if (f->endpoints) { 963f27d899SToby Isaac for (j = 0; j <= i; j++) f->nodesets[i][j] = (PetscReal) j / (PetscReal) i; 973f27d899SToby Isaac } else { 9877f1a120SToby Isaac /* these nodes are at the centroids of the small simplices created by the equispaced nodes that include 9977f1a120SToby Isaac * the endpoints */ 1003f27d899SToby Isaac for (j = 0; j <= i; j++) f->nodesets[i][j] = ((PetscReal) j + 0.5) / ((PetscReal) i + 1.); 1013f27d899SToby Isaac } 1023f27d899SToby Isaac break; 1033f27d899SToby Isaac case PETSCDTNODES_GAUSSJACOBI: 1043f27d899SToby Isaac if (f->endpoints) { 1053f27d899SToby Isaac ierr = PetscDTGaussLobattoJacobiQuadrature(i + 1, 0., 1., f->gaussJacobiExp, f->gaussJacobiExp, f->nodesets[i], w);CHKERRQ(ierr); 1063f27d899SToby Isaac } else { 1073f27d899SToby Isaac ierr = PetscDTGaussJacobiQuadrature(i + 1, 0., 1., f->gaussJacobiExp, f->gaussJacobiExp, f->nodesets[i], w);CHKERRQ(ierr); 1083f27d899SToby Isaac } 1093f27d899SToby Isaac break; 1103f27d899SToby Isaac default: SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown 1D node family"); 1113f27d899SToby Isaac } 1123f27d899SToby Isaac } 1133f27d899SToby Isaac } 1143f27d899SToby Isaac ierr = PetscFree(w);CHKERRQ(ierr); 1153f27d899SToby Isaac f->nComputed = degree + 1; 1163f27d899SToby Isaac } 1173f27d899SToby Isaac *nodesets = f->nodesets; 1183f27d899SToby Isaac PetscFunctionReturn(0); 1193f27d899SToby Isaac } 1203f27d899SToby Isaac 12177f1a120SToby Isaac /* http://arxiv.org/abs/2002.09421 for details */ 1223f27d899SToby Isaac static PetscErrorCode PetscNodeRecursive_Internal(PetscInt dim, PetscInt degree, PetscReal **nodesets, PetscInt tup[], PetscReal node[]) 1233f27d899SToby Isaac { 1243f27d899SToby Isaac PetscReal w; 1253f27d899SToby Isaac PetscInt i, j; 1263f27d899SToby Isaac PetscErrorCode ierr; 1273f27d899SToby Isaac 1283f27d899SToby Isaac PetscFunctionBeginHot; 1293f27d899SToby Isaac w = 0.; 1303f27d899SToby Isaac if (dim == 1) { 1313f27d899SToby Isaac node[0] = nodesets[degree][tup[0]]; 1323f27d899SToby Isaac node[1] = nodesets[degree][tup[1]]; 1333f27d899SToby Isaac } else { 1343f27d899SToby Isaac for (i = 0; i < dim + 1; i++) node[i] = 0.; 1353f27d899SToby Isaac for (i = 0; i < dim + 1; i++) { 1363f27d899SToby Isaac PetscReal wi = nodesets[degree][degree-tup[i]]; 1373f27d899SToby Isaac 1383f27d899SToby Isaac for (j = 0; j < dim+1; j++) tup[dim+1+j] = tup[j+(j>=i)]; 1393f27d899SToby Isaac ierr = PetscNodeRecursive_Internal(dim-1,degree-tup[i],nodesets,&tup[dim+1],&node[dim+1]);CHKERRQ(ierr); 1403f27d899SToby Isaac for (j = 0; j < dim+1; j++) node[j+(j>=i)] += wi * node[dim+1+j]; 1413f27d899SToby Isaac w += wi; 1423f27d899SToby Isaac } 1433f27d899SToby Isaac for (i = 0; i < dim+1; i++) node[i] /= w; 1443f27d899SToby Isaac } 1453f27d899SToby Isaac PetscFunctionReturn(0); 1463f27d899SToby Isaac } 1473f27d899SToby Isaac 1483f27d899SToby Isaac /* compute simplex nodes for the biunit simplex from the 1D node family */ 1493f27d899SToby Isaac static PetscErrorCode Petsc1DNodeFamilyComputeSimplexNodes(Petsc1DNodeFamily f, PetscInt dim, PetscInt degree, PetscReal points[]) 1503f27d899SToby Isaac { 1513f27d899SToby Isaac PetscInt *tup; 1523f27d899SToby Isaac PetscInt k; 1533f27d899SToby Isaac PetscInt npoints; 1543f27d899SToby Isaac PetscReal **nodesets = NULL; 1553f27d899SToby Isaac PetscInt worksize; 1563f27d899SToby Isaac PetscReal *nodework; 1573f27d899SToby Isaac PetscInt *tupwork; 1583f27d899SToby Isaac PetscErrorCode ierr; 1593f27d899SToby Isaac 1603f27d899SToby Isaac PetscFunctionBegin; 1613f27d899SToby Isaac if (dim < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Must have non-negative dimension\n"); 1623f27d899SToby Isaac if (degree < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Must have non-negative degree\n"); 1633f27d899SToby Isaac if (!dim) PetscFunctionReturn(0); 1643f27d899SToby Isaac ierr = PetscCalloc1(dim+2, &tup);CHKERRQ(ierr); 1653f27d899SToby Isaac k = 0; 1663f27d899SToby Isaac ierr = PetscDTBinomialInt(degree + dim, dim, &npoints);CHKERRQ(ierr); 1673f27d899SToby Isaac ierr = Petsc1DNodeFamilyGetNodeSets(f, degree, &nodesets);CHKERRQ(ierr); 1683f27d899SToby Isaac worksize = ((dim + 2) * (dim + 3)) / 2; 1693f27d899SToby Isaac ierr = PetscMalloc2(worksize, &nodework, worksize, &tupwork);CHKERRQ(ierr); 17077f1a120SToby Isaac /* loop over the tuples of length dim with sum at most degree */ 1713f27d899SToby Isaac for (k = 0; k < npoints; k++) { 1723f27d899SToby Isaac PetscInt i; 1733f27d899SToby Isaac 17477f1a120SToby Isaac /* turn thm into tuples of length dim + 1 with sum equal to degree (barycentric indice) */ 1753f27d899SToby Isaac tup[0] = degree; 1763f27d899SToby Isaac for (i = 0; i < dim; i++) { 1773f27d899SToby Isaac tup[0] -= tup[i+1]; 1783f27d899SToby Isaac } 1793f27d899SToby Isaac switch(f->nodeFamily) { 1803f27d899SToby Isaac case PETSCDTNODES_EQUISPACED: 18177f1a120SToby Isaac /* compute equispaces nodes on the unit reference triangle */ 1823f27d899SToby Isaac if (f->endpoints) { 1833f27d899SToby Isaac for (i = 0; i < dim; i++) { 1843f27d899SToby Isaac points[dim*k + i] = (PetscReal) tup[i+1] / (PetscReal) degree; 1853f27d899SToby Isaac } 1863f27d899SToby Isaac } else { 1873f27d899SToby Isaac for (i = 0; i < dim; i++) { 18877f1a120SToby Isaac /* these nodes are at the centroids of the small simplices created by the equispaced nodes that include 18977f1a120SToby Isaac * the endpoints */ 1903f27d899SToby Isaac points[dim*k + i] = ((PetscReal) tup[i+1] + 1./(dim+1.)) / (PetscReal) (degree + 1.); 1913f27d899SToby Isaac } 1923f27d899SToby Isaac } 1933f27d899SToby Isaac break; 1943f27d899SToby Isaac default: 19577f1a120SToby Isaac /* compute equispaces nodes on the barycentric reference triangle (the trace on the first dim dimensions are the 19677f1a120SToby Isaac * unit reference triangle nodes */ 1973f27d899SToby Isaac for (i = 0; i < dim + 1; i++) tupwork[i] = tup[i]; 1983f27d899SToby Isaac ierr = PetscNodeRecursive_Internal(dim, degree, nodesets, tupwork, nodework);CHKERRQ(ierr); 1993f27d899SToby Isaac for (i = 0; i < dim; i++) points[dim*k + i] = nodework[i + 1]; 2003f27d899SToby Isaac break; 2013f27d899SToby Isaac } 2023f27d899SToby Isaac ierr = PetscDualSpaceLatticePointLexicographic_Internal(dim, degree, &tup[1]);CHKERRQ(ierr); 2033f27d899SToby Isaac } 2043f27d899SToby Isaac /* map from unit simplex to biunit simplex */ 2053f27d899SToby Isaac for (k = 0; k < npoints * dim; k++) points[k] = points[k] * 2. - 1.; 2063f27d899SToby Isaac ierr = PetscFree2(nodework, tupwork);CHKERRQ(ierr); 2073f27d899SToby Isaac ierr = PetscFree(tup); 2083f27d899SToby Isaac PetscFunctionReturn(0); 2093f27d899SToby Isaac } 2103f27d899SToby Isaac 21177f1a120SToby 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 21277f1a120SToby Isaac * on that mesh point, we have to be careful about getting/adding everything in the right place. 21377f1a120SToby Isaac * 21477f1a120SToby Isaac * With nodal dofs like PETSCDUALSPACELAGRANGE makes, the general approach to calculate the value of dofs associate 21577f1a120SToby Isaac * with a node A is 21677f1a120SToby Isaac * - transform the node locations x(A) by the map that takes the mesh point to its reorientation, x' = phi(x(A)) 21777f1a120SToby Isaac * - figure out which node was originally at the location of the transformed point, A' = idx(x') 21877f1a120SToby Isaac * - if the dofs are not scalars, figure out how to represent the transformed dofs in terms of the basis 21977f1a120SToby Isaac * of dofs at A' (using pushforward/pullback rules) 22077f1a120SToby Isaac * 22177f1a120SToby Isaac * The one sticky point with this approach is the "A' = idx(x')" step: trying to go from real valued coordinates 22277f1a120SToby Isaac * back to indices. I don't want to rely on floating point tolerances. Additionally, PETSCDUALSPACELAGRANGE may 22377f1a120SToby Isaac * eventually support quasi-Lagrangian dofs, which could involve quadrature at multiple points, so the location "x(A)" 22477f1a120SToby Isaac * would be ambiguous. 22577f1a120SToby Isaac * 22677f1a120SToby Isaac * So each dof gets an integer value coordinate (nodeIdx in the structure below). The choice of integer coordinates 22777f1a120SToby Isaac * is somewhat arbitrary, as long as all of the relevant symmetries of the mesh point correspond to *permutations* of 22877f1a120SToby Isaac * the integer coordinates, which do not depend on numerical precision. 22977f1a120SToby Isaac * 23077f1a120SToby Isaac * So 23177f1a120SToby Isaac * 23277f1a120SToby Isaac * - DMPlexGetTransitiveClosure_Internal() tells me how an orientation turns into a permutation of the vertices of a 23377f1a120SToby Isaac * mesh point 23477f1a120SToby Isaac * - The permutation of the vertices, and the nodeIdx values assigned to them, tells what permutation in index space 23577f1a120SToby Isaac * is associated with the orientation 23677f1a120SToby Isaac * - I uses that permutation to get xi' = phi(xi(A)), the integer coordinate of the transformed dof 23777f1a120SToby Isaac * - I can without numerical issues compute A' = idx(xi') 23877f1a120SToby Isaac * 23977f1a120SToby Isaac * Here are some examples of how the process works 24077f1a120SToby Isaac * 24177f1a120SToby Isaac * - With a triangle: 24277f1a120SToby Isaac * 24377f1a120SToby Isaac * The triangle has the following integer coordinates for vertices, taken from the barycentric triangle 24477f1a120SToby Isaac * 24577f1a120SToby Isaac * closure order 2 24677f1a120SToby Isaac * nodeIdx (0,0,1) 24777f1a120SToby Isaac * \ 24877f1a120SToby Isaac * + 24977f1a120SToby Isaac * |\ 25077f1a120SToby Isaac * | \ 25177f1a120SToby Isaac * | \ 25277f1a120SToby Isaac * | \ closure order 1 25377f1a120SToby Isaac * | \ / nodeIdx (0,1,0) 25477f1a120SToby Isaac * +-----+ 25577f1a120SToby Isaac * \ 25677f1a120SToby Isaac * closure order 0 25777f1a120SToby Isaac * nodeIdx (1,0,0) 25877f1a120SToby Isaac * 25977f1a120SToby Isaac * If I do DMPlexGetTransitiveClosure_Internal() with orientation 1, the vertices would appear 26077f1a120SToby Isaac * in the order (1, 2, 0) 26177f1a120SToby Isaac * 26277f1a120SToby 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 26377f1a120SToby Isaac * see 26477f1a120SToby Isaac * 26577f1a120SToby Isaac * orientation 0 | orientation 1 26677f1a120SToby Isaac * 26777f1a120SToby Isaac * [0] (1,0,0) [1] (0,1,0) 26877f1a120SToby Isaac * [1] (0,1,0) [2] (0,0,1) 26977f1a120SToby Isaac * [2] (0,0,1) [0] (1,0,0) 27077f1a120SToby Isaac * A B 27177f1a120SToby Isaac * 27277f1a120SToby Isaac * In other words, B is the result of a row permutation of A. But, there is also 27377f1a120SToby Isaac * a column permutation that accomplishes the same result, (2,0,1). 27477f1a120SToby Isaac * 27577f1a120SToby Isaac * So if a dof has nodeIdx coordinate (a,b,c), after the transformation its nodeIdx coordinate 27677f1a120SToby Isaac * is (c,a,b), and the transformed degree of freedom will be a linear combination of dofs 27777f1a120SToby Isaac * that originally had coordinate (c,a,b). 27877f1a120SToby Isaac * 27977f1a120SToby Isaac * - With a quadrilateral: 28077f1a120SToby Isaac * 28177f1a120SToby Isaac * The quadrilateral has the following integer coordinates for vertices, taken from concatenating barycentric 28277f1a120SToby Isaac * coordinates for two segments: 28377f1a120SToby Isaac * 28477f1a120SToby Isaac * closure order 3 closure order 2 28577f1a120SToby Isaac * nodeIdx (1,0,0,1) nodeIdx (0,1,0,1) 28677f1a120SToby Isaac * \ / 28777f1a120SToby Isaac * +----+ 28877f1a120SToby Isaac * | | 28977f1a120SToby Isaac * | | 29077f1a120SToby Isaac * +----+ 29177f1a120SToby Isaac * / \ 29277f1a120SToby Isaac * closure order 0 closure order 1 29377f1a120SToby Isaac * nodeIdx (1,0,1,0) nodeIdx (0,1,1,0) 29477f1a120SToby Isaac * 29577f1a120SToby Isaac * If I do DMPlexGetTransitiveClosure_Internal() with orientation 1, the vertices would appear 29677f1a120SToby Isaac * in the order (1, 2, 3, 0) 29777f1a120SToby Isaac * 29877f1a120SToby Isaac * If I list the nodeIdx of each vertex in closure order for orientation 0 (0, 1, 2, 3) and 29977f1a120SToby Isaac * orientation 1 (1, 2, 3, 0), I see 30077f1a120SToby Isaac * 30177f1a120SToby Isaac * orientation 0 | orientation 1 30277f1a120SToby Isaac * 30377f1a120SToby Isaac * [0] (1,0,1,0) [1] (0,1,1,0) 30477f1a120SToby Isaac * [1] (0,1,1,0) [2] (0,1,0,1) 30577f1a120SToby Isaac * [2] (0,1,0,1) [3] (1,0,0,1) 30677f1a120SToby Isaac * [3] (1,0,0,1) [0] (1,0,1,0) 30777f1a120SToby Isaac * A B 30877f1a120SToby Isaac * 30977f1a120SToby Isaac * The column permutation that accomplishes the same result is (3,2,0,1). 31077f1a120SToby Isaac * 31177f1a120SToby Isaac * So if a dof has nodeIdx coordinate (a,b,c,d), after the transformation its nodeIdx coordinate 31277f1a120SToby Isaac * is (d,c,a,b), and the transformed degree of freedom will be a linear combination of dofs 31377f1a120SToby Isaac * that originally had coordinate (d,c,a,b). 31477f1a120SToby Isaac * 31577f1a120SToby Isaac * Previously PETSCDUALSPACELAGRANGE had hardcoded symmetries for the triangle and quadrilateral, 31677f1a120SToby Isaac * but this approach will work for any polytope, such as the wedge (triangular prism). 31777f1a120SToby Isaac */ 3183f27d899SToby Isaac struct _n_PetscLagNodeIndices 3193f27d899SToby Isaac { 3203f27d899SToby Isaac PetscInt refct; 3213f27d899SToby Isaac PetscInt nodeIdxDim; 3223f27d899SToby Isaac PetscInt nodeVecDim; 3233f27d899SToby Isaac PetscInt nNodes; 3243f27d899SToby Isaac PetscInt *nodeIdx; /* for each node an index of size nodeIdxDim */ 3253f27d899SToby Isaac PetscReal *nodeVec; /* for each node a vector of size nodeVecDim */ 3263f27d899SToby Isaac PetscInt *perm; /* if these are vertices, perm takes DMPlex point index to closure order; 3273f27d899SToby Isaac if these are nodes, perm lists nodes in index revlex order */ 3283f27d899SToby Isaac }; 3293f27d899SToby Isaac 33077f1a120SToby Isaac /* this is just here so I can access the values in tests/ex1.c outside the library */ 3313f27d899SToby Isaac PetscErrorCode PetscLagNodeIndicesGetData_Internal(PetscLagNodeIndices ni, PetscInt *nodeIdxDim, PetscInt *nodeVecDim, PetscInt *nNodes, const PetscInt *nodeIdx[], const PetscReal *nodeVec[]) 3323f27d899SToby Isaac { 3333f27d899SToby Isaac PetscFunctionBegin; 3343f27d899SToby Isaac *nodeIdxDim = ni->nodeIdxDim; 3353f27d899SToby Isaac *nodeVecDim = ni->nodeVecDim; 3363f27d899SToby Isaac *nNodes = ni->nNodes; 3373f27d899SToby Isaac *nodeIdx = ni->nodeIdx; 3383f27d899SToby Isaac *nodeVec = ni->nodeVec; 3393f27d899SToby Isaac PetscFunctionReturn(0); 3403f27d899SToby Isaac } 3413f27d899SToby Isaac 3423f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesReference(PetscLagNodeIndices ni) 3433f27d899SToby Isaac { 3443f27d899SToby Isaac PetscFunctionBegin; 3453f27d899SToby Isaac if (ni) ni->refct++; 3463f27d899SToby Isaac PetscFunctionReturn(0); 3473f27d899SToby Isaac } 3483f27d899SToby Isaac 3493f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesDestroy(PetscLagNodeIndices *ni) { 3503f27d899SToby Isaac PetscErrorCode ierr; 3513f27d899SToby Isaac 3523f27d899SToby Isaac PetscFunctionBegin; 3533f27d899SToby Isaac if (!(*ni)) PetscFunctionReturn(0); 3543f27d899SToby Isaac if (--(*ni)->refct > 0) { 3553f27d899SToby Isaac *ni = NULL; 3563f27d899SToby Isaac PetscFunctionReturn(0); 3573f27d899SToby Isaac } 3583f27d899SToby Isaac ierr = PetscFree((*ni)->nodeIdx);CHKERRQ(ierr); 3593f27d899SToby Isaac ierr = PetscFree((*ni)->nodeVec);CHKERRQ(ierr); 3603f27d899SToby Isaac ierr = PetscFree((*ni)->perm);CHKERRQ(ierr); 3613f27d899SToby Isaac ierr = PetscFree(*ni);CHKERRQ(ierr); 3623f27d899SToby Isaac *ni = NULL; 3633f27d899SToby Isaac PetscFunctionReturn(0); 3643f27d899SToby Isaac } 3653f27d899SToby Isaac 36677f1a120SToby Isaac /* The vertices are given nodeIdx coordinates (e.g. the corners of the barycentric triangle). Those coordinates are 36777f1a120SToby Isaac * in some other order, and to understand the effect of different symmetries, we need them to be in closure order. 36877f1a120SToby Isaac * 36977f1a120SToby Isaac * If sortIdx is PETSC_FALSE, the coordinates are already in revlex order, otherwise we must sort them 37077f1a120SToby Isaac * to that order before we do the real work of this function, which is 37177f1a120SToby Isaac * 37277f1a120SToby Isaac * - mark the vertices in closure order 37377f1a120SToby Isaac * - sort them in revlex order 37477f1a120SToby Isaac * - use the resulting permutation to list the vertex coordinates in closure order 37577f1a120SToby Isaac */ 3763f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesComputeVertexOrder(DM dm, PetscLagNodeIndices ni, PetscBool sortIdx) 3773f27d899SToby Isaac { 3783f27d899SToby Isaac PetscInt v, w, vStart, vEnd, c, d; 3793f27d899SToby Isaac PetscInt nVerts; 3803f27d899SToby Isaac PetscInt closureSize = 0; 3813f27d899SToby Isaac PetscInt *closure = NULL; 3823f27d899SToby Isaac PetscInt *closureOrder; 3833f27d899SToby Isaac PetscInt *invClosureOrder; 3843f27d899SToby Isaac PetscInt *revlexOrder; 3853f27d899SToby Isaac PetscInt *newNodeIdx; 3863f27d899SToby Isaac PetscInt dim; 3873f27d899SToby Isaac Vec coordVec; 3883f27d899SToby Isaac const PetscScalar *coords; 3893f27d899SToby Isaac PetscErrorCode ierr; 3903f27d899SToby Isaac 3913f27d899SToby Isaac PetscFunctionBegin; 3923f27d899SToby Isaac ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 3933f27d899SToby Isaac ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr); 3943f27d899SToby Isaac nVerts = vEnd - vStart; 3953f27d899SToby Isaac ierr = PetscMalloc1(nVerts, &closureOrder);CHKERRQ(ierr); 3963f27d899SToby Isaac ierr = PetscMalloc1(nVerts, &invClosureOrder);CHKERRQ(ierr); 3973f27d899SToby Isaac ierr = PetscMalloc1(nVerts, &revlexOrder);CHKERRQ(ierr); 39877f1a120SToby Isaac if (sortIdx) { /* bubble sort nodeIdx into revlex order */ 3993f27d899SToby Isaac PetscInt nodeIdxDim = ni->nodeIdxDim; 4003f27d899SToby Isaac PetscInt *idxOrder; 4013f27d899SToby Isaac 4023f27d899SToby Isaac ierr = PetscMalloc1(nVerts * nodeIdxDim, &newNodeIdx);CHKERRQ(ierr); 4033f27d899SToby Isaac ierr = PetscMalloc1(nVerts, &idxOrder);CHKERRQ(ierr); 4043f27d899SToby Isaac for (v = 0; v < nVerts; v++) idxOrder[v] = v; 4053f27d899SToby Isaac for (v = 0; v < nVerts; v++) { 4063f27d899SToby Isaac for (w = v + 1; w < nVerts; w++) { 4073f27d899SToby Isaac const PetscInt *iv = &(ni->nodeIdx[idxOrder[v] * nodeIdxDim]); 4083f27d899SToby Isaac const PetscInt *iw = &(ni->nodeIdx[idxOrder[w] * nodeIdxDim]); 4093f27d899SToby Isaac PetscInt diff = 0; 4103f27d899SToby Isaac 4113f27d899SToby Isaac for (d = nodeIdxDim - 1; d >= 0; d--) if ((diff = (iv[d] - iw[d]))) break; 4123f27d899SToby Isaac if (diff > 0) { 4133f27d899SToby Isaac PetscInt swap = idxOrder[v]; 4143f27d899SToby Isaac 4153f27d899SToby Isaac idxOrder[v] = idxOrder[w]; 4163f27d899SToby Isaac idxOrder[w] = swap; 4173f27d899SToby Isaac } 4183f27d899SToby Isaac } 4193f27d899SToby Isaac } 4203f27d899SToby Isaac for (v = 0; v < nVerts; v++) { 4213f27d899SToby Isaac for (d = 0; d < nodeIdxDim; d++) { 4223f27d899SToby Isaac newNodeIdx[v * ni->nodeIdxDim + d] = ni->nodeIdx[idxOrder[v] * nodeIdxDim + d]; 4233f27d899SToby Isaac } 4243f27d899SToby Isaac } 4253f27d899SToby Isaac ierr = PetscFree(ni->nodeIdx);CHKERRQ(ierr); 4263f27d899SToby Isaac ni->nodeIdx = newNodeIdx; 4273f27d899SToby Isaac newNodeIdx = NULL; 4283f27d899SToby Isaac ierr = PetscFree(idxOrder);CHKERRQ(ierr); 4293f27d899SToby Isaac } 4303f27d899SToby Isaac ierr = DMPlexGetTransitiveClosure(dm, 0, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr); 4313f27d899SToby Isaac c = closureSize - nVerts; 4323f27d899SToby Isaac for (v = 0; v < nVerts; v++) closureOrder[v] = closure[2 * (c + v)] - vStart; 4333f27d899SToby Isaac for (v = 0; v < nVerts; v++) invClosureOrder[closureOrder[v]] = v; 4343f27d899SToby Isaac ierr = DMPlexRestoreTransitiveClosure(dm, 0, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr); 4353f27d899SToby Isaac ierr = DMGetCoordinatesLocal(dm, &coordVec);CHKERRQ(ierr); 4363f27d899SToby Isaac ierr = VecGetArrayRead(coordVec, &coords);CHKERRQ(ierr); 4373f27d899SToby Isaac /* bubble sort closure vertices by coordinates in revlex order */ 4383f27d899SToby Isaac for (v = 0; v < nVerts; v++) revlexOrder[v] = v; 4393f27d899SToby Isaac for (v = 0; v < nVerts; v++) { 4403f27d899SToby Isaac for (w = v + 1; w < nVerts; w++) { 4413f27d899SToby Isaac const PetscScalar *cv = &coords[closureOrder[revlexOrder[v]] * dim]; 4423f27d899SToby Isaac const PetscScalar *cw = &coords[closureOrder[revlexOrder[w]] * dim]; 4433f27d899SToby Isaac PetscReal diff = 0; 4443f27d899SToby Isaac 4453f27d899SToby Isaac for (d = dim - 1; d >= 0; d--) if ((diff = PetscRealPart(cv[d] - cw[d])) != 0.) break; 4463f27d899SToby Isaac if (diff > 0.) { 4473f27d899SToby Isaac PetscInt swap = revlexOrder[v]; 4483f27d899SToby Isaac 4493f27d899SToby Isaac revlexOrder[v] = revlexOrder[w]; 4503f27d899SToby Isaac revlexOrder[w] = swap; 4513f27d899SToby Isaac } 4523f27d899SToby Isaac } 4533f27d899SToby Isaac } 4543f27d899SToby Isaac ierr = VecRestoreArrayRead(coordVec, &coords);CHKERRQ(ierr); 4553f27d899SToby Isaac ierr = PetscMalloc1(ni->nodeIdxDim * nVerts, &newNodeIdx);CHKERRQ(ierr); 4563f27d899SToby Isaac /* reorder nodeIdx to be in closure order */ 4573f27d899SToby Isaac for (v = 0; v < nVerts; v++) { 4583f27d899SToby Isaac for (d = 0; d < ni->nodeIdxDim; d++) { 4593f27d899SToby Isaac newNodeIdx[revlexOrder[v] * ni->nodeIdxDim + d] = ni->nodeIdx[v * ni->nodeIdxDim + d]; 4603f27d899SToby Isaac } 4613f27d899SToby Isaac } 4623f27d899SToby Isaac ierr = PetscFree(ni->nodeIdx);CHKERRQ(ierr); 4633f27d899SToby Isaac ni->nodeIdx = newNodeIdx; 4643f27d899SToby Isaac ni->perm = invClosureOrder; 4653f27d899SToby Isaac ierr = PetscFree(revlexOrder);CHKERRQ(ierr); 4663f27d899SToby Isaac ierr = PetscFree(closureOrder);CHKERRQ(ierr); 4673f27d899SToby Isaac PetscFunctionReturn(0); 4683f27d899SToby Isaac } 4693f27d899SToby Isaac 47077f1a120SToby Isaac /* the coordinates of the simplex vertices are the corners of the barycentric simplex. 47177f1a120SToby Isaac * When we stack them on top of each other in revlex order, they look like the identity matrix */ 4723f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesCreateSimplexVertices(DM dm, PetscLagNodeIndices *nodeIndices) 4733f27d899SToby Isaac { 4743f27d899SToby Isaac PetscLagNodeIndices ni; 4753f27d899SToby Isaac PetscInt dim, d; 4763f27d899SToby Isaac 4773f27d899SToby Isaac PetscErrorCode ierr; 4783f27d899SToby Isaac 4793f27d899SToby Isaac PetscFunctionBegin; 4803f27d899SToby Isaac ierr = PetscNew(&ni);CHKERRQ(ierr); 4813f27d899SToby Isaac ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 4823f27d899SToby Isaac ni->nodeIdxDim = dim + 1; 4833f27d899SToby Isaac ni->nodeVecDim = 0; 4843f27d899SToby Isaac ni->nNodes = dim + 1; 4853f27d899SToby Isaac ni->refct = 1; 4863f27d899SToby Isaac ierr = PetscCalloc1((dim + 1)*(dim + 1), &(ni->nodeIdx));CHKERRQ(ierr); 4873f27d899SToby Isaac for (d = 0; d < dim + 1; d++) ni->nodeIdx[d*(dim + 2)] = 1; 4883f27d899SToby Isaac ierr = PetscLagNodeIndicesComputeVertexOrder(dm, ni, PETSC_FALSE);CHKERRQ(ierr); 4893f27d899SToby Isaac *nodeIndices = ni; 4903f27d899SToby Isaac PetscFunctionReturn(0); 4913f27d899SToby Isaac } 4923f27d899SToby Isaac 49377f1a120SToby Isaac /* A polytope that is a tensor product of a facet and a segment. 49477f1a120SToby Isaac * We take whatever coordinate system was being used for the facet 49577f1a120SToby Isaac * and we concatenaty the barycentric coordinates for the vertices 49677f1a120SToby Isaac * at the end of the segment, (1,0) and (0,1), to get a coordinate 49777f1a120SToby Isaac * system for the tensor product element */ 4983f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesCreateTensorVertices(DM dm, PetscLagNodeIndices facetni, PetscLagNodeIndices *nodeIndices) 4993f27d899SToby Isaac { 5003f27d899SToby Isaac PetscLagNodeIndices ni; 5013f27d899SToby Isaac PetscInt nodeIdxDim, subNodeIdxDim = facetni->nodeIdxDim; 5023f27d899SToby Isaac PetscInt nVerts, nSubVerts = facetni->nNodes; 5033f27d899SToby Isaac PetscInt dim, d, e, f, g; 5043f27d899SToby Isaac 5053f27d899SToby Isaac PetscErrorCode ierr; 5063f27d899SToby Isaac 5073f27d899SToby Isaac PetscFunctionBegin; 5083f27d899SToby Isaac ierr = PetscNew(&ni);CHKERRQ(ierr); 5093f27d899SToby Isaac ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 5103f27d899SToby Isaac ni->nodeIdxDim = nodeIdxDim = subNodeIdxDim + 2; 5113f27d899SToby Isaac ni->nodeVecDim = 0; 5123f27d899SToby Isaac ni->nNodes = nVerts = 2 * nSubVerts; 5133f27d899SToby Isaac ni->refct = 1; 5143f27d899SToby Isaac ierr = PetscCalloc1(nodeIdxDim * nVerts, &(ni->nodeIdx));CHKERRQ(ierr); 5153f27d899SToby Isaac for (f = 0, d = 0; d < 2; d++) { 5163f27d899SToby Isaac for (e = 0; e < nSubVerts; e++, f++) { 5173f27d899SToby Isaac for (g = 0; g < subNodeIdxDim; g++) { 5183f27d899SToby Isaac ni->nodeIdx[f * nodeIdxDim + g] = facetni->nodeIdx[e * subNodeIdxDim + g]; 5193f27d899SToby Isaac } 5203f27d899SToby Isaac ni->nodeIdx[f * nodeIdxDim + subNodeIdxDim] = (1 - d); 5213f27d899SToby Isaac ni->nodeIdx[f * nodeIdxDim + subNodeIdxDim + 1] = d; 5223f27d899SToby Isaac } 5233f27d899SToby Isaac } 5243f27d899SToby Isaac ierr = PetscLagNodeIndicesComputeVertexOrder(dm, ni, PETSC_TRUE);CHKERRQ(ierr); 5253f27d899SToby Isaac *nodeIndices = ni; 5263f27d899SToby Isaac PetscFunctionReturn(0); 5273f27d899SToby Isaac } 5283f27d899SToby Isaac 52977f1a120SToby Isaac /* This helps us compute symmetries, and it also helps us compute coordinates for dofs that are being pushed 53077f1a120SToby Isaac * forward from a boundary mesh point. 53177f1a120SToby Isaac * 53277f1a120SToby Isaac * Input: 53377f1a120SToby Isaac * 53477f1a120SToby Isaac * dm - the target reference cell where we want new coordinates and dof directions to be valid 53577f1a120SToby Isaac * vert - the vertex coordinate system for the target reference cell 53677f1a120SToby Isaac * p - the point in the target reference cell that the dofs are coming from 53777f1a120SToby Isaac * vertp - the vertex coordinate system for p's reference cell 53877f1a120SToby Isaac * ornt - the resulting coordinates and dof vectors will be for p under this orientation 53977f1a120SToby Isaac * nodep - the node coordinates and dof vectors in p's reference cell 54077f1a120SToby Isaac * formDegree - the form degree that the dofs transform as 54177f1a120SToby Isaac * 54277f1a120SToby Isaac * Output: 54377f1a120SToby Isaac * 54477f1a120SToby Isaac * pfNodeIdx - the node coordinates for p's dofs, in the dm reference cell, from the ornt perspective 54577f1a120SToby Isaac * pfNodeVec - the node dof vectors for p's dofs, in the dm reference cell, from the ornt perspective 54677f1a120SToby Isaac */ 5473f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesPushForward(DM dm, PetscLagNodeIndices vert, PetscInt p, PetscLagNodeIndices vertp, PetscLagNodeIndices nodep, PetscInt ornt, PetscInt formDegree, PetscInt pfNodeIdx[], PetscReal pfNodeVec[]) 5483f27d899SToby Isaac { 5493f27d899SToby Isaac PetscInt *closureVerts; 5503f27d899SToby Isaac PetscInt closureSize = 0; 5513f27d899SToby Isaac PetscInt *closure = NULL; 5523f27d899SToby Isaac PetscInt dim, pdim, c, i, j, k, n, v, vStart, vEnd; 5533f27d899SToby Isaac PetscInt nSubVert = vertp->nNodes; 5543f27d899SToby Isaac PetscInt nodeIdxDim = vert->nodeIdxDim; 5553f27d899SToby Isaac PetscInt subNodeIdxDim = vertp->nodeIdxDim; 5563f27d899SToby Isaac PetscInt nNodes = nodep->nNodes; 5573f27d899SToby Isaac const PetscInt *vertIdx = vert->nodeIdx; 5583f27d899SToby Isaac const PetscInt *subVertIdx = vertp->nodeIdx; 5593f27d899SToby Isaac const PetscInt *nodeIdx = nodep->nodeIdx; 5603f27d899SToby Isaac const PetscReal *nodeVec = nodep->nodeVec; 5613f27d899SToby Isaac PetscReal *J, *Jstar; 5623f27d899SToby Isaac PetscReal detJ; 5633f27d899SToby Isaac PetscInt depth, pdepth, Nk, pNk; 5643f27d899SToby Isaac Vec coordVec; 5653f27d899SToby Isaac PetscScalar *newCoords = NULL; 5663f27d899SToby Isaac const PetscScalar *oldCoords = NULL; 5673f27d899SToby Isaac PetscErrorCode ierr; 5683f27d899SToby Isaac 5693f27d899SToby Isaac PetscFunctionBegin; 5703f27d899SToby Isaac ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 5713f27d899SToby Isaac ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr); 5723f27d899SToby Isaac ierr = DMGetCoordinatesLocal(dm, &coordVec);CHKERRQ(ierr); 5733f27d899SToby Isaac ierr = DMPlexGetPointDepth(dm, p, &pdepth);CHKERRQ(ierr); 5743f27d899SToby Isaac pdim = pdepth != depth ? pdepth != 0 ? pdepth : 0 : dim; 5753f27d899SToby Isaac ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr); 5763f27d899SToby Isaac ierr = DMGetWorkArray(dm, nSubVert, MPIU_INT, &closureVerts);CHKERRQ(ierr); 5773f27d899SToby Isaac ierr = DMPlexGetTransitiveClosure_Internal(dm, p, ornt, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr); 5783f27d899SToby Isaac c = closureSize - nSubVert; 5793f27d899SToby Isaac /* we want which cell closure indices the closure of this point corresponds to */ 5803f27d899SToby Isaac for (v = 0; v < nSubVert; v++) closureVerts[v] = vert->perm[closure[2 * (c + v)] - vStart]; 5813f27d899SToby Isaac ierr = DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr); 5823f27d899SToby Isaac /* push forward indices */ 5833f27d899SToby Isaac for (i = 0; i < nodeIdxDim; i++) { /* for every component of the target index space */ 5843f27d899SToby Isaac /* check if this is a component that all vertices around this point have in common */ 5853f27d899SToby Isaac for (j = 1; j < nSubVert; j++) { 5863f27d899SToby Isaac if (vertIdx[closureVerts[j] * nodeIdxDim + i] != vertIdx[closureVerts[0] * nodeIdxDim + i]) break; 5873f27d899SToby Isaac } 5883f27d899SToby Isaac if (j == nSubVert) { /* all vertices have this component in common, directly copy to output */ 5893f27d899SToby Isaac PetscInt val = vertIdx[closureVerts[0] * nodeIdxDim + i]; 5903f27d899SToby Isaac for (n = 0; n < nNodes; n++) pfNodeIdx[n * nodeIdxDim + i] = val; 5913f27d899SToby Isaac } else { 5923f27d899SToby Isaac PetscInt subi = -1; 5933f27d899SToby Isaac /* there must be a component in vertp that looks the same */ 5943f27d899SToby Isaac for (k = 0; k < subNodeIdxDim; k++) { 5953f27d899SToby Isaac for (j = 0; j < nSubVert; j++) { 5963f27d899SToby Isaac if (vertIdx[closureVerts[j] * nodeIdxDim + i] != subVertIdx[j * subNodeIdxDim + k]) break; 5973f27d899SToby Isaac } 5983f27d899SToby Isaac if (j == nSubVert) { 5993f27d899SToby Isaac subi = k; 6003f27d899SToby Isaac break; 6013f27d899SToby Isaac } 6023f27d899SToby Isaac } 6033f27d899SToby Isaac if (subi < 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Did not find matching coordinate\n"); 60477f1a120SToby Isaac /* that component in the vertp system becomes component i in the vert system for each dof */ 6053f27d899SToby Isaac for (n = 0; n < nNodes; n++) pfNodeIdx[n * nodeIdxDim + i] = nodeIdx[n * subNodeIdxDim + subi]; 6063f27d899SToby Isaac } 6073f27d899SToby Isaac } 6083f27d899SToby Isaac /* push forward vectors */ 6093f27d899SToby Isaac ierr = DMGetWorkArray(dm, dim * dim, MPIU_REAL, &J);CHKERRQ(ierr); 61077f1a120SToby Isaac if (ornt != 0) { /* temporarily change the coordinate vector so 61177f1a120SToby Isaac DMPlexComputeCellGeometryAffineFEM gives us the Jacobian we want */ 6123f27d899SToby Isaac PetscInt closureSize2 = 0; 6133f27d899SToby Isaac PetscInt *closure2 = NULL; 6143f27d899SToby Isaac 6153f27d899SToby Isaac ierr = DMPlexGetTransitiveClosure_Internal(dm, p, 0, PETSC_TRUE, &closureSize2, &closure2);CHKERRQ(ierr); 6163f27d899SToby Isaac ierr = PetscMalloc1(dim * nSubVert, &newCoords);CHKERRQ(ierr); 6173f27d899SToby Isaac ierr = VecGetArrayRead(coordVec, &oldCoords);CHKERRQ(ierr); 6183f27d899SToby Isaac for (v = 0; v < nSubVert; v++) { 6193f27d899SToby Isaac PetscInt d; 6203f27d899SToby Isaac for (d = 0; d < dim; d++) { 6213f27d899SToby Isaac newCoords[(closure2[2 * (c + v)] - vStart) * dim + d] = oldCoords[closureVerts[v] * dim + d]; 6223f27d899SToby Isaac } 6233f27d899SToby Isaac } 6243f27d899SToby Isaac ierr = VecRestoreArrayRead(coordVec, &oldCoords);CHKERRQ(ierr); 6253f27d899SToby Isaac ierr = DMPlexRestoreTransitiveClosure(dm, p, PETSC_TRUE, &closureSize2, &closure2);CHKERRQ(ierr); 6263f27d899SToby Isaac ierr = VecPlaceArray(coordVec, newCoords);CHKERRQ(ierr); 6273f27d899SToby Isaac } 6283f27d899SToby Isaac ierr = DMPlexComputeCellGeometryAffineFEM(dm, p, NULL, J, NULL, &detJ);CHKERRQ(ierr); 6293f27d899SToby Isaac if (ornt != 0) { 6303f27d899SToby Isaac ierr = VecResetArray(coordVec);CHKERRQ(ierr); 6313f27d899SToby Isaac ierr = PetscFree(newCoords);CHKERRQ(ierr); 6323f27d899SToby Isaac } 6333f27d899SToby Isaac ierr = DMRestoreWorkArray(dm, nSubVert, MPIU_INT, &closureVerts);CHKERRQ(ierr); 6343f27d899SToby Isaac /* compactify */ 6353f27d899SToby Isaac for (i = 0; i < dim; i++) for (j = 0; j < pdim; j++) J[i * pdim + j] = J[i * dim + j]; 63677f1a120SToby Isaac /* We have the Jacobian mapping the point's reference cell to this reference cell: 63777f1a120SToby Isaac * pulling back a function to the point and applying the dof is what we want, 63877f1a120SToby Isaac * so we get the pullback matrix and multiply the dof by that matrix on the right */ 6393f27d899SToby Isaac ierr = PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk);CHKERRQ(ierr); 6403f27d899SToby Isaac ierr = PetscDTBinomialInt(pdim, PetscAbsInt(formDegree), &pNk);CHKERRQ(ierr); 6413f27d899SToby Isaac ierr = DMGetWorkArray(dm, pNk * Nk, MPIU_REAL, &Jstar);CHKERRQ(ierr); 6423f27d899SToby Isaac ierr = PetscDTAltVPullbackMatrix(pdim, dim, J, formDegree, Jstar);CHKERRQ(ierr); 6433f27d899SToby Isaac for (n = 0; n < nNodes; n++) { 6443f27d899SToby Isaac for (i = 0; i < Nk; i++) { 6453f27d899SToby Isaac PetscReal val = 0.; 6463f27d899SToby Isaac for (j = 0; j < pNk; j++) val += nodeVec[n * pNk + j] * Jstar[j * pNk + i]; 6473f27d899SToby Isaac pfNodeVec[n * Nk + i] = val; 6483f27d899SToby Isaac } 6493f27d899SToby Isaac } 6503f27d899SToby Isaac ierr = DMRestoreWorkArray(dm, pNk * Nk, MPIU_REAL, &Jstar);CHKERRQ(ierr); 6513f27d899SToby Isaac ierr = DMRestoreWorkArray(dm, dim * dim, MPIU_REAL, &J);CHKERRQ(ierr); 6523f27d899SToby Isaac PetscFunctionReturn(0); 6533f27d899SToby Isaac } 6543f27d899SToby Isaac 65577f1a120SToby Isaac /* given to sets of nodes, take the tensor product, where the product of the dof indices is concatenation and the 65677f1a120SToby Isaac * product of the dof vectors is the wedge product */ 6573f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesTensor(PetscLagNodeIndices tracei, PetscInt dimT, PetscInt kT, PetscLagNodeIndices fiberi, PetscInt dimF, PetscInt kF, PetscLagNodeIndices *nodeIndices) 6583f27d899SToby Isaac { 6593f27d899SToby Isaac PetscInt dim = dimT + dimF; 6603f27d899SToby Isaac PetscInt nodeIdxDim, nNodes; 6613f27d899SToby Isaac PetscInt formDegree = kT + kF; 6623f27d899SToby Isaac PetscInt Nk, NkT, NkF; 6633f27d899SToby Isaac PetscInt MkT, MkF; 6643f27d899SToby Isaac PetscLagNodeIndices ni; 6653f27d899SToby Isaac PetscInt i, j, l; 6663f27d899SToby Isaac PetscReal *projF, *projT; 6673f27d899SToby Isaac PetscReal *projFstar, *projTstar; 6683f27d899SToby Isaac PetscReal *workF, *workF2, *workT, *workT2, *work, *work2; 6693f27d899SToby Isaac PetscReal *wedgeMat; 6703f27d899SToby Isaac PetscReal sign; 6713f27d899SToby Isaac PetscErrorCode ierr; 6723f27d899SToby Isaac 6733f27d899SToby Isaac PetscFunctionBegin; 6743f27d899SToby Isaac ierr = PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk);CHKERRQ(ierr); 6753f27d899SToby Isaac ierr = PetscDTBinomialInt(dimT, PetscAbsInt(kT), &NkT);CHKERRQ(ierr); 6763f27d899SToby Isaac ierr = PetscDTBinomialInt(dimF, PetscAbsInt(kF), &NkF);CHKERRQ(ierr); 6773f27d899SToby Isaac ierr = PetscDTBinomialInt(dim, PetscAbsInt(kT), &MkT);CHKERRQ(ierr); 6783f27d899SToby Isaac ierr = PetscDTBinomialInt(dim, PetscAbsInt(kF), &MkF);CHKERRQ(ierr); 6793f27d899SToby Isaac ierr = PetscNew(&ni);CHKERRQ(ierr); 6803f27d899SToby Isaac ni->nodeIdxDim = nodeIdxDim = tracei->nodeIdxDim + fiberi->nodeIdxDim; 6813f27d899SToby Isaac ni->nodeVecDim = Nk; 6823f27d899SToby Isaac ni->nNodes = nNodes = tracei->nNodes * fiberi->nNodes; 6833f27d899SToby Isaac ni->refct = 1; 6843f27d899SToby Isaac ierr = PetscMalloc1(nNodes * nodeIdxDim, &(ni->nodeIdx));CHKERRQ(ierr); 6853f27d899SToby Isaac /* first concatenate the indices */ 6863f27d899SToby Isaac for (l = 0, j = 0; j < fiberi->nNodes; j++) { 6873f27d899SToby Isaac for (i = 0; i < tracei->nNodes; i++, l++) { 6883f27d899SToby Isaac PetscInt m, n = 0; 6893f27d899SToby Isaac 6903f27d899SToby Isaac for (m = 0; m < tracei->nodeIdxDim; m++) ni->nodeIdx[l * nodeIdxDim + n++] = tracei->nodeIdx[i * tracei->nodeIdxDim + m]; 6913f27d899SToby Isaac for (m = 0; m < fiberi->nodeIdxDim; m++) ni->nodeIdx[l * nodeIdxDim + n++] = fiberi->nodeIdx[j * fiberi->nodeIdxDim + m]; 6923f27d899SToby Isaac } 6933f27d899SToby Isaac } 6943f27d899SToby Isaac 6953f27d899SToby Isaac /* now wedge together the push-forward vectors */ 6963f27d899SToby Isaac ierr = PetscMalloc1(nNodes * Nk, &(ni->nodeVec));CHKERRQ(ierr); 6973f27d899SToby Isaac ierr = PetscCalloc2(dimT*dim, &projT, dimF*dim, &projF);CHKERRQ(ierr); 6983f27d899SToby Isaac for (i = 0; i < dimT; i++) projT[i * (dim + 1)] = 1.; 6993f27d899SToby Isaac for (i = 0; i < dimF; i++) projF[i * (dim + dimT + 1) + dimT] = 1.; 7003f27d899SToby Isaac ierr = PetscMalloc2(MkT*NkT, &projTstar, MkF*NkF, &projFstar);CHKERRQ(ierr); 7013f27d899SToby Isaac ierr = PetscDTAltVPullbackMatrix(dim, dimT, projT, kT, projTstar);CHKERRQ(ierr); 7023f27d899SToby Isaac ierr = PetscDTAltVPullbackMatrix(dim, dimF, projF, kF, projFstar);CHKERRQ(ierr); 7033f27d899SToby Isaac ierr = PetscMalloc6(MkT, &workT, MkT, &workT2, MkF, &workF, MkF, &workF2, Nk, &work, Nk, &work2);CHKERRQ(ierr); 7043f27d899SToby Isaac ierr = PetscMalloc1(Nk * MkT, &wedgeMat);CHKERRQ(ierr); 7053f27d899SToby Isaac sign = (PetscAbsInt(kT * kF) & 1) ? -1. : 1.; 7063f27d899SToby Isaac for (l = 0, j = 0; j < fiberi->nNodes; j++) { 7073f27d899SToby Isaac PetscInt d, e; 7083f27d899SToby Isaac 7093f27d899SToby Isaac /* push forward fiber k-form */ 7103f27d899SToby Isaac for (d = 0; d < MkF; d++) { 7113f27d899SToby Isaac PetscReal val = 0.; 7123f27d899SToby Isaac for (e = 0; e < NkF; e++) val += projFstar[d * NkF + e] * fiberi->nodeVec[j * NkF + e]; 7133f27d899SToby Isaac workF[d] = val; 7143f27d899SToby Isaac } 7153f27d899SToby Isaac /* Hodge star to proper form if necessary */ 7163f27d899SToby Isaac if (kF < 0) { 7173f27d899SToby Isaac for (d = 0; d < MkF; d++) workF2[d] = workF[d]; 7183f27d899SToby Isaac ierr = PetscDTAltVStar(dim, PetscAbsInt(kF), 1, workF2, workF);CHKERRQ(ierr); 7193f27d899SToby Isaac } 7203f27d899SToby Isaac /* Compute the matrix that wedges this form with one of the trace k-form */ 7213f27d899SToby Isaac ierr = PetscDTAltVWedgeMatrix(dim, PetscAbsInt(kF), PetscAbsInt(kT), workF, wedgeMat);CHKERRQ(ierr); 7223f27d899SToby Isaac for (i = 0; i < tracei->nNodes; i++, l++) { 7233f27d899SToby Isaac /* push forward trace k-form */ 7243f27d899SToby Isaac for (d = 0; d < MkT; d++) { 7253f27d899SToby Isaac PetscReal val = 0.; 7263f27d899SToby Isaac for (e = 0; e < NkT; e++) val += projTstar[d * NkT + e] * tracei->nodeVec[i * NkT + e]; 7273f27d899SToby Isaac workT[d] = val; 7283f27d899SToby Isaac } 7293f27d899SToby Isaac /* Hodge star to proper form if necessary */ 7303f27d899SToby Isaac if (kT < 0) { 7313f27d899SToby Isaac for (d = 0; d < MkT; d++) workT2[d] = workT[d]; 7323f27d899SToby Isaac ierr = PetscDTAltVStar(dim, PetscAbsInt(kT), 1, workT2, workT);CHKERRQ(ierr); 7333f27d899SToby Isaac } 7343f27d899SToby Isaac /* compute the wedge product of the push-forward trace form and firer forms */ 7353f27d899SToby Isaac for (d = 0; d < Nk; d++) { 7363f27d899SToby Isaac PetscReal val = 0.; 7373f27d899SToby Isaac for (e = 0; e < MkT; e++) val += wedgeMat[d * MkT + e] * workT[e]; 7383f27d899SToby Isaac work[d] = val; 7393f27d899SToby Isaac } 7403f27d899SToby Isaac /* inverse Hodge star from proper form if necessary */ 7413f27d899SToby Isaac if (formDegree < 0) { 7423f27d899SToby Isaac for (d = 0; d < Nk; d++) work2[d] = work[d]; 7433f27d899SToby Isaac ierr = PetscDTAltVStar(dim, PetscAbsInt(formDegree), -1, work2, work);CHKERRQ(ierr); 7443f27d899SToby Isaac } 7453f27d899SToby Isaac /* insert into the array (adjusting for sign) */ 7463f27d899SToby Isaac for (d = 0; d < Nk; d++) ni->nodeVec[l * Nk + d] = sign * work[d]; 7473f27d899SToby Isaac } 7483f27d899SToby Isaac } 7493f27d899SToby Isaac ierr = PetscFree(wedgeMat);CHKERRQ(ierr); 7503f27d899SToby Isaac ierr = PetscFree6(workT, workT2, workF, workF2, work, work2);CHKERRQ(ierr); 7513f27d899SToby Isaac ierr = PetscFree2(projTstar, projFstar);CHKERRQ(ierr); 7523f27d899SToby Isaac ierr = PetscFree2(projT, projF);CHKERRQ(ierr); 7533f27d899SToby Isaac *nodeIndices = ni; 7543f27d899SToby Isaac PetscFunctionReturn(0); 7553f27d899SToby Isaac } 7563f27d899SToby Isaac 75777f1a120SToby Isaac /* simple union of two sets of nodes */ 7583f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesMerge(PetscLagNodeIndices niA, PetscLagNodeIndices niB, PetscLagNodeIndices *nodeIndices) 7593f27d899SToby Isaac { 7603f27d899SToby Isaac PetscLagNodeIndices ni; 7613f27d899SToby Isaac PetscInt nodeIdxDim, nodeVecDim, nNodes; 7623f27d899SToby Isaac PetscErrorCode ierr; 7633f27d899SToby Isaac 7643f27d899SToby Isaac PetscFunctionBegin; 7653f27d899SToby Isaac ierr = PetscNew(&ni);CHKERRQ(ierr); 7663f27d899SToby Isaac ni->nodeIdxDim = nodeIdxDim = niA->nodeIdxDim; 7673f27d899SToby Isaac if (niB->nodeIdxDim != nodeIdxDim) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cannot merge PetscLagNodeIndices with different nodeIdxDim"); 7683f27d899SToby Isaac ni->nodeVecDim = nodeVecDim = niA->nodeVecDim; 7693f27d899SToby Isaac if (niB->nodeVecDim != nodeVecDim) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Cannot merge PetscLagNodeIndices with different nodeVecDim"); 7703f27d899SToby Isaac ni->nNodes = nNodes = niA->nNodes + niB->nNodes; 7713f27d899SToby Isaac ni->refct = 1; 7723f27d899SToby Isaac ierr = PetscMalloc1(nNodes * nodeIdxDim, &(ni->nodeIdx));CHKERRQ(ierr); 7733f27d899SToby Isaac ierr = PetscMalloc1(nNodes * nodeVecDim, &(ni->nodeVec));CHKERRQ(ierr); 7743f27d899SToby Isaac ierr = PetscArraycpy(ni->nodeIdx, niA->nodeIdx, niA->nNodes * nodeIdxDim);CHKERRQ(ierr); 7753f27d899SToby Isaac ierr = PetscArraycpy(ni->nodeVec, niA->nodeVec, niA->nNodes * nodeVecDim);CHKERRQ(ierr); 7763f27d899SToby Isaac ierr = PetscArraycpy(&(ni->nodeIdx[niA->nNodes * nodeIdxDim]), niB->nodeIdx, niB->nNodes * nodeIdxDim);CHKERRQ(ierr); 7773f27d899SToby Isaac ierr = PetscArraycpy(&(ni->nodeVec[niA->nNodes * nodeVecDim]), niB->nodeVec, niB->nNodes * nodeVecDim);CHKERRQ(ierr); 7783f27d899SToby Isaac *nodeIndices = ni; 7793f27d899SToby Isaac PetscFunctionReturn(0); 7803f27d899SToby Isaac } 7813f27d899SToby Isaac 7823f27d899SToby Isaac #define PETSCTUPINTCOMPREVLEX(N) \ 7833f27d899SToby Isaac static int PetscTupIntCompRevlex_##N(const void *a, const void *b) \ 7843f27d899SToby Isaac { \ 7853f27d899SToby Isaac const PetscInt *A = (const PetscInt *) a; \ 7863f27d899SToby Isaac const PetscInt *B = (const PetscInt *) b; \ 7873f27d899SToby Isaac int i; \ 7883f27d899SToby Isaac PetscInt diff = 0; \ 7893f27d899SToby Isaac for (i = 0; i < N; i++) { \ 7903f27d899SToby Isaac diff = A[N - i] - B[N - i]; \ 7913f27d899SToby Isaac if (diff) break; \ 7923f27d899SToby Isaac } \ 7933f27d899SToby Isaac return (diff <= 0) ? (diff < 0) ? -1 : 0 : 1; \ 7943f27d899SToby Isaac } 7953f27d899SToby Isaac 7963f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(3) 7973f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(4) 7983f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(5) 7993f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(6) 8003f27d899SToby Isaac PETSCTUPINTCOMPREVLEX(7) 8013f27d899SToby Isaac 8023f27d899SToby Isaac static int PetscTupIntCompRevlex_N(const void *a, const void *b) 8033f27d899SToby Isaac { 8043f27d899SToby Isaac const PetscInt *A = (const PetscInt *) a; 8053f27d899SToby Isaac const PetscInt *B = (const PetscInt *) b; 8063f27d899SToby Isaac int i; 8073f27d899SToby Isaac int N = A[0]; 8083f27d899SToby Isaac PetscInt diff = 0; 8093f27d899SToby Isaac for (i = 0; i < N; i++) { 8103f27d899SToby Isaac diff = A[N - i] - B[N - i]; 8113f27d899SToby Isaac if (diff) break; 8123f27d899SToby Isaac } 8133f27d899SToby Isaac return (diff <= 0) ? (diff < 0) ? -1 : 0 : 1; 8143f27d899SToby Isaac } 8153f27d899SToby Isaac 81677f1a120SToby Isaac /* The nodes are not necessarily in revlex order wrt nodeIdx: get the permutation 81777f1a120SToby Isaac * that puts them in that order */ 8183f27d899SToby Isaac static PetscErrorCode PetscLagNodeIndicesGetPermutation(PetscLagNodeIndices ni, PetscInt *perm[]) 8193f27d899SToby Isaac { 8203f27d899SToby Isaac PetscErrorCode ierr; 8213f27d899SToby Isaac 8223f27d899SToby Isaac PetscFunctionBegin; 8233f27d899SToby Isaac if (!(ni->perm)) { 8243f27d899SToby Isaac PetscInt *sorter; 8253f27d899SToby Isaac PetscInt m = ni->nNodes; 8263f27d899SToby Isaac PetscInt nodeIdxDim = ni->nodeIdxDim; 8273f27d899SToby Isaac PetscInt i, j, k, l; 8283f27d899SToby Isaac PetscInt *prm; 8293f27d899SToby Isaac int (*comp) (const void *, const void *); 8303f27d899SToby Isaac 8313f27d899SToby Isaac ierr = PetscMalloc1((nodeIdxDim + 2) * m, &sorter);CHKERRQ(ierr); 8323f27d899SToby Isaac for (k = 0, l = 0, i = 0; i < m; i++) { 8333f27d899SToby Isaac sorter[k++] = nodeIdxDim + 1; 8343f27d899SToby Isaac sorter[k++] = i; 8353f27d899SToby Isaac for (j = 0; j < nodeIdxDim; j++) sorter[k++] = ni->nodeIdx[l++]; 8363f27d899SToby Isaac } 8373f27d899SToby Isaac switch (nodeIdxDim) { 8383f27d899SToby Isaac case 2: 8393f27d899SToby Isaac comp = PetscTupIntCompRevlex_3; 8403f27d899SToby Isaac break; 8413f27d899SToby Isaac case 3: 8423f27d899SToby Isaac comp = PetscTupIntCompRevlex_4; 8433f27d899SToby Isaac break; 8443f27d899SToby Isaac case 4: 8453f27d899SToby Isaac comp = PetscTupIntCompRevlex_5; 8463f27d899SToby Isaac break; 8473f27d899SToby Isaac case 5: 8483f27d899SToby Isaac comp = PetscTupIntCompRevlex_6; 8493f27d899SToby Isaac break; 8503f27d899SToby Isaac case 6: 8513f27d899SToby Isaac comp = PetscTupIntCompRevlex_7; 8523f27d899SToby Isaac break; 8533f27d899SToby Isaac default: 8543f27d899SToby Isaac comp = PetscTupIntCompRevlex_N; 8553f27d899SToby Isaac break; 8563f27d899SToby Isaac } 8573f27d899SToby Isaac qsort(sorter, m, (nodeIdxDim + 2) * sizeof(PetscInt), comp); 8583f27d899SToby Isaac ierr = PetscMalloc1(m, &prm);CHKERRQ(ierr); 8593f27d899SToby Isaac for (i = 0; i < m; i++) prm[i] = sorter[(nodeIdxDim + 2) * i + 1]; 8603f27d899SToby Isaac ni->perm = prm; 8613f27d899SToby Isaac ierr = PetscFree(sorter); 8623f27d899SToby Isaac } 8633f27d899SToby Isaac *perm = ni->perm; 8643f27d899SToby Isaac PetscFunctionReturn(0); 8653f27d899SToby Isaac } 86620cf1dd8SToby Isaac 8676f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp) 86820cf1dd8SToby Isaac { 86920cf1dd8SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data; 8706f905325SMatthew G. Knepley PetscErrorCode ierr; 87120cf1dd8SToby Isaac 87220cf1dd8SToby Isaac PetscFunctionBegin; 8733f27d899SToby Isaac if (lag->symperms) { 8743f27d899SToby Isaac PetscInt **selfSyms = lag->symperms[0]; 8756f905325SMatthew G. Knepley 8766f905325SMatthew G. Knepley if (selfSyms) { 8776f905325SMatthew G. Knepley PetscInt i, **allocated = &selfSyms[-lag->selfSymOff]; 8786f905325SMatthew G. Knepley 8796f905325SMatthew G. Knepley for (i = 0; i < lag->numSelfSym; i++) { 8806f905325SMatthew G. Knepley ierr = PetscFree(allocated[i]);CHKERRQ(ierr); 8816f905325SMatthew G. Knepley } 8826f905325SMatthew G. Knepley ierr = PetscFree(allocated);CHKERRQ(ierr); 8836f905325SMatthew G. Knepley } 8843f27d899SToby Isaac ierr = PetscFree(lag->symperms);CHKERRQ(ierr); 8856f905325SMatthew G. Knepley } 8863f27d899SToby Isaac if (lag->symflips) { 8873f27d899SToby Isaac PetscScalar **selfSyms = lag->symflips[0]; 8883f27d899SToby Isaac 8893f27d899SToby Isaac if (selfSyms) { 8903f27d899SToby Isaac PetscInt i; 8913f27d899SToby Isaac PetscScalar **allocated = &selfSyms[-lag->selfSymOff]; 8923f27d899SToby Isaac 8933f27d899SToby Isaac for (i = 0; i < lag->numSelfSym; i++) { 8943f27d899SToby Isaac ierr = PetscFree(allocated[i]);CHKERRQ(ierr); 8956f905325SMatthew G. Knepley } 8963f27d899SToby Isaac ierr = PetscFree(allocated);CHKERRQ(ierr); 8973f27d899SToby Isaac } 8983f27d899SToby Isaac ierr = PetscFree(lag->symflips);CHKERRQ(ierr); 8993f27d899SToby Isaac } 9003f27d899SToby Isaac ierr = Petsc1DNodeFamilyDestroy(&(lag->nodeFamily));CHKERRQ(ierr); 9013f27d899SToby Isaac ierr = PetscLagNodeIndicesDestroy(&(lag->vertIndices));CHKERRQ(ierr); 9023f27d899SToby Isaac ierr = PetscLagNodeIndicesDestroy(&(lag->intNodeIndices));CHKERRQ(ierr); 9033f27d899SToby Isaac ierr = PetscLagNodeIndicesDestroy(&(lag->allNodeIndices));CHKERRQ(ierr); 9046f905325SMatthew G. Knepley ierr = PetscFree(lag);CHKERRQ(ierr); 9056f905325SMatthew G. Knepley ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", NULL);CHKERRQ(ierr); 9066f905325SMatthew G. Knepley ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", NULL);CHKERRQ(ierr); 9076f905325SMatthew G. Knepley ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", NULL);CHKERRQ(ierr); 9086f905325SMatthew G. Knepley ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", NULL);CHKERRQ(ierr); 9093f27d899SToby Isaac ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTrimmed_C", NULL);CHKERRQ(ierr); 9103f27d899SToby Isaac ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTrimmed_C", NULL);CHKERRQ(ierr); 9113f27d899SToby Isaac ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetNodeType_C", NULL);CHKERRQ(ierr); 9123f27d899SToby Isaac ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetNodeType_C", NULL);CHKERRQ(ierr); 913*66a6c23cSMatthew G. Knepley ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetUseMoments_C", NULL);CHKERRQ(ierr); 914*66a6c23cSMatthew G. Knepley ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetUseMoments_C", NULL);CHKERRQ(ierr); 915*66a6c23cSMatthew G. Knepley ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetMomentOrder_C", NULL);CHKERRQ(ierr); 916*66a6c23cSMatthew G. Knepley ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetMomentOrder_C", NULL);CHKERRQ(ierr); 91720cf1dd8SToby Isaac PetscFunctionReturn(0); 91820cf1dd8SToby Isaac } 91920cf1dd8SToby Isaac 9206f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceLagrangeView_Ascii(PetscDualSpace sp, PetscViewer viewer) 92120cf1dd8SToby Isaac { 92220cf1dd8SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data; 9236f905325SMatthew G. Knepley PetscErrorCode ierr; 92420cf1dd8SToby Isaac 92520cf1dd8SToby Isaac PetscFunctionBegin; 9263f27d899SToby Isaac ierr = PetscViewerASCIIPrintf(viewer, "%s %s%sLagrange dual space\n", lag->continuous ? "Continuous" : "Discontinuous", lag->tensorSpace ? "tensor " : "", lag->trimmed ? "trimmed " : "");CHKERRQ(ierr); 92720cf1dd8SToby Isaac PetscFunctionReturn(0); 92820cf1dd8SToby Isaac } 92920cf1dd8SToby Isaac 9306f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceView_Lagrange(PetscDualSpace sp, PetscViewer viewer) 93120cf1dd8SToby Isaac { 9326f905325SMatthew G. Knepley PetscBool iascii; 9336f905325SMatthew G. Knepley PetscErrorCode ierr; 9346f905325SMatthew G. Knepley 93520cf1dd8SToby Isaac PetscFunctionBegin; 9366f905325SMatthew G. Knepley PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 9376f905325SMatthew G. Knepley PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 2); 9386f905325SMatthew G. Knepley ierr = PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);CHKERRQ(ierr); 9396f905325SMatthew G. Knepley if (iascii) {ierr = PetscDualSpaceLagrangeView_Ascii(sp, viewer);CHKERRQ(ierr);} 94020cf1dd8SToby Isaac PetscFunctionReturn(0); 94120cf1dd8SToby Isaac } 94220cf1dd8SToby Isaac 9436f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceSetFromOptions_Lagrange(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp) 94420cf1dd8SToby Isaac { 9453f27d899SToby Isaac PetscBool continuous, tensor, trimmed, flg, flg2, flg3; 9463f27d899SToby Isaac PetscDTNodeType nodeType; 9473f27d899SToby Isaac PetscReal nodeExponent; 948*66a6c23cSMatthew G. Knepley PetscInt momentOrder; 949*66a6c23cSMatthew G. Knepley PetscBool nodeEndpoints, useMoments; 9506f905325SMatthew G. Knepley PetscErrorCode ierr; 9516f905325SMatthew G. Knepley 9526f905325SMatthew G. Knepley PetscFunctionBegin; 9536f905325SMatthew G. Knepley ierr = PetscDualSpaceLagrangeGetContinuity(sp, &continuous);CHKERRQ(ierr); 9546f905325SMatthew G. Knepley ierr = PetscDualSpaceLagrangeGetTensor(sp, &tensor);CHKERRQ(ierr); 9553f27d899SToby Isaac ierr = PetscDualSpaceLagrangeGetTrimmed(sp, &trimmed);CHKERRQ(ierr); 9563f27d899SToby Isaac ierr = PetscDualSpaceLagrangeGetNodeType(sp, &nodeType, &nodeEndpoints, &nodeExponent);CHKERRQ(ierr); 9573f27d899SToby Isaac if (nodeType == PETSCDTNODES_DEFAULT) nodeType = PETSCDTNODES_GAUSSJACOBI; 958*66a6c23cSMatthew G. Knepley ierr = PetscDualSpaceLagrangeGetUseMoments(sp, &useMoments);CHKERRQ(ierr); 959*66a6c23cSMatthew G. Knepley ierr = PetscDualSpaceLagrangeGetMomentOrder(sp, &momentOrder);CHKERRQ(ierr); 9606f905325SMatthew G. Knepley ierr = PetscOptionsHead(PetscOptionsObject,"PetscDualSpace Lagrange Options");CHKERRQ(ierr); 9616f905325SMatthew G. Knepley ierr = PetscOptionsBool("-petscdualspace_lagrange_continuity", "Flag for continuous element", "PetscDualSpaceLagrangeSetContinuity", continuous, &continuous, &flg);CHKERRQ(ierr); 9626f905325SMatthew G. Knepley if (flg) {ierr = PetscDualSpaceLagrangeSetContinuity(sp, continuous);CHKERRQ(ierr);} 9633f27d899SToby Isaac ierr = PetscOptionsBool("-petscdualspace_lagrange_tensor", "Flag for tensor dual space", "PetscDualSpaceLagrangeSetTensor", tensor, &tensor, &flg);CHKERRQ(ierr); 9646f905325SMatthew G. Knepley if (flg) {ierr = PetscDualSpaceLagrangeSetTensor(sp, tensor);CHKERRQ(ierr);} 9653f27d899SToby Isaac ierr = PetscOptionsBool("-petscdualspace_lagrange_trimmed", "Flag for trimmed dual space", "PetscDualSpaceLagrangeSetTrimmed", trimmed, &trimmed, &flg);CHKERRQ(ierr); 9663f27d899SToby Isaac if (flg) {ierr = PetscDualSpaceLagrangeSetTrimmed(sp, trimmed);CHKERRQ(ierr);} 9673f27d899SToby Isaac ierr = PetscOptionsEnum("-petscdualspace_lagrange_node_type", "Lagrange node location type", "PetscDualSpaceLagrangeSetNodeType", PetscDTNodeTypes, (PetscEnum)nodeType, (PetscEnum *)&nodeType, &flg);CHKERRQ(ierr); 9683f27d899SToby Isaac ierr = PetscOptionsBool("-petscdualspace_lagrange_node_endpoints", "Flag for nodes that include endpoints", "PetscDualSpaceLagrangeSetNodeType", nodeEndpoints, &nodeEndpoints, &flg2);CHKERRQ(ierr); 9693f27d899SToby Isaac flg3 = PETSC_FALSE; 9703f27d899SToby Isaac if (nodeType == PETSCDTNODES_GAUSSJACOBI) { 9713f27d899SToby Isaac ierr = PetscOptionsReal("-petscdualspace_lagrange_node_exponent", "Gauss-Jacobi weight function exponent", "PetscDualSpaceLagrangeSetNodeType", nodeExponent, &nodeExponent, &flg3);CHKERRQ(ierr); 9723f27d899SToby Isaac } 9733f27d899SToby Isaac if (flg || flg2 || flg3) {ierr = PetscDualSpaceLagrangeSetNodeType(sp, nodeType, nodeEndpoints, nodeExponent);CHKERRQ(ierr);} 974*66a6c23cSMatthew G. Knepley ierr = PetscOptionsBool("-petscdualspace_lagrange_use_moments", "Use moments (where appropriate) for functionals", "PetscDualSpaceLagrangeSetUseMoments", useMoments, &useMoments, &flg);CHKERRQ(ierr); 975*66a6c23cSMatthew G. Knepley if (flg) {ierr = PetscDualSpaceLagrangeSetUseMoments(sp, useMoments);CHKERRQ(ierr);} 976*66a6c23cSMatthew G. Knepley ierr = PetscOptionsInt("-petscdualspace_lagrange_moment_order", "Quadrature order for moment functionals", "PetscDualSpaceLagrangeSetMomentOrder", momentOrder, &momentOrder, &flg);CHKERRQ(ierr); 977*66a6c23cSMatthew G. Knepley if (flg) {ierr = PetscDualSpaceLagrangeSetMomentOrder(sp, momentOrder);CHKERRQ(ierr);} 9786f905325SMatthew G. Knepley ierr = PetscOptionsTail();CHKERRQ(ierr); 9796f905325SMatthew G. Knepley PetscFunctionReturn(0); 9806f905325SMatthew G. Knepley } 9816f905325SMatthew G. Knepley 982b4457527SToby Isaac static PetscErrorCode PetscDualSpaceDuplicate_Lagrange(PetscDualSpace sp, PetscDualSpace spNew) 9836f905325SMatthew G. Knepley { 9843f27d899SToby Isaac PetscBool cont, tensor, trimmed, boundary; 9853f27d899SToby Isaac PetscDTNodeType nodeType; 9863f27d899SToby Isaac PetscReal exponent; 9873f27d899SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data; 9886f905325SMatthew G. Knepley PetscErrorCode ierr; 9896f905325SMatthew G. Knepley 9906f905325SMatthew G. Knepley PetscFunctionBegin; 9916f905325SMatthew G. Knepley ierr = PetscDualSpaceLagrangeGetContinuity(sp, &cont);CHKERRQ(ierr); 992b4457527SToby Isaac ierr = PetscDualSpaceLagrangeSetContinuity(spNew, cont);CHKERRQ(ierr); 9936f905325SMatthew G. Knepley ierr = PetscDualSpaceLagrangeGetTensor(sp, &tensor);CHKERRQ(ierr); 994b4457527SToby Isaac ierr = PetscDualSpaceLagrangeSetTensor(spNew, tensor);CHKERRQ(ierr); 9953f27d899SToby Isaac ierr = PetscDualSpaceLagrangeGetTrimmed(sp, &trimmed);CHKERRQ(ierr); 9963f27d899SToby Isaac ierr = PetscDualSpaceLagrangeSetTrimmed(spNew, trimmed);CHKERRQ(ierr); 9973f27d899SToby Isaac ierr = PetscDualSpaceLagrangeGetNodeType(sp, &nodeType, &boundary, &exponent);CHKERRQ(ierr); 9983f27d899SToby Isaac ierr = PetscDualSpaceLagrangeSetNodeType(spNew, nodeType, boundary, exponent);CHKERRQ(ierr); 9993f27d899SToby Isaac if (lag->nodeFamily) { 10003f27d899SToby Isaac PetscDualSpace_Lag *lagnew = (PetscDualSpace_Lag *) spNew->data; 10013f27d899SToby Isaac 10023f27d899SToby Isaac ierr = Petsc1DNodeFamilyReference(lag->nodeFamily);CHKERRQ(ierr); 10033f27d899SToby Isaac lagnew->nodeFamily = lag->nodeFamily; 10043f27d899SToby Isaac } 10056f905325SMatthew G. Knepley PetscFunctionReturn(0); 10066f905325SMatthew G. Knepley } 10076f905325SMatthew G. Knepley 100877f1a120SToby Isaac /* for making tensor product spaces: take a dual space and product a segment space that has all the same 100977f1a120SToby Isaac * specifications (trimmed, continuous, order, node set), except for the form degree */ 10103f27d899SToby Isaac static PetscErrorCode PetscDualSpaceCreateEdgeSubspace_Lagrange(PetscDualSpace sp, PetscInt order, PetscInt k, PetscInt Nc, PetscBool interiorOnly, PetscDualSpace *bdsp) 10116f905325SMatthew G. Knepley { 10123f27d899SToby Isaac DM K; 10133f27d899SToby Isaac PetscDualSpace_Lag *newlag; 10146f905325SMatthew G. Knepley PetscErrorCode ierr; 10156f905325SMatthew G. Knepley 10166f905325SMatthew G. Knepley PetscFunctionBegin; 10176f905325SMatthew G. Knepley ierr = PetscDualSpaceDuplicate(sp,bdsp);CHKERRQ(ierr); 10183f27d899SToby Isaac ierr = PetscDualSpaceSetFormDegree(*bdsp, k);CHKERRQ(ierr); 10193f27d899SToby Isaac ierr = PetscDualSpaceCreateReferenceCell(*bdsp, 1, PETSC_TRUE, &K);CHKERRQ(ierr); 10206f905325SMatthew G. Knepley ierr = PetscDualSpaceSetDM(*bdsp, K);CHKERRQ(ierr); 10216f905325SMatthew G. Knepley ierr = DMDestroy(&K);CHKERRQ(ierr); 10223f27d899SToby Isaac ierr = PetscDualSpaceSetOrder(*bdsp, order);CHKERRQ(ierr); 10233f27d899SToby Isaac ierr = PetscDualSpaceSetNumComponents(*bdsp, Nc);CHKERRQ(ierr); 10243f27d899SToby Isaac newlag = (PetscDualSpace_Lag *) (*bdsp)->data; 10253f27d899SToby Isaac newlag->interiorOnly = interiorOnly; 10266f905325SMatthew G. Knepley ierr = PetscDualSpaceSetUp(*bdsp);CHKERRQ(ierr); 10273f27d899SToby Isaac PetscFunctionReturn(0); 10286f905325SMatthew G. Knepley } 10293f27d899SToby Isaac 10303f27d899SToby Isaac /* just the points, weights aren't handled */ 10313f27d899SToby Isaac static PetscErrorCode PetscQuadratureCreateTensor(PetscQuadrature trace, PetscQuadrature fiber, PetscQuadrature *product) 10323f27d899SToby Isaac { 10333f27d899SToby Isaac PetscInt dimTrace, dimFiber; 10343f27d899SToby Isaac PetscInt numPointsTrace, numPointsFiber; 10353f27d899SToby Isaac PetscInt dim, numPoints; 10363f27d899SToby Isaac const PetscReal *pointsTrace; 10373f27d899SToby Isaac const PetscReal *pointsFiber; 10383f27d899SToby Isaac PetscReal *points; 10393f27d899SToby Isaac PetscInt i, j, k, p; 10403f27d899SToby Isaac PetscErrorCode ierr; 10413f27d899SToby Isaac 10423f27d899SToby Isaac PetscFunctionBegin; 10433f27d899SToby Isaac ierr = PetscQuadratureGetData(trace, &dimTrace, NULL, &numPointsTrace, &pointsTrace, NULL);CHKERRQ(ierr); 10443f27d899SToby Isaac ierr = PetscQuadratureGetData(fiber, &dimFiber, NULL, &numPointsFiber, &pointsFiber, NULL);CHKERRQ(ierr); 10453f27d899SToby Isaac dim = dimTrace + dimFiber; 10463f27d899SToby Isaac numPoints = numPointsFiber * numPointsTrace; 10473f27d899SToby Isaac ierr = PetscMalloc1(numPoints * dim, &points);CHKERRQ(ierr); 10483f27d899SToby Isaac for (p = 0, j = 0; j < numPointsFiber; j++) { 10493f27d899SToby Isaac for (i = 0; i < numPointsTrace; i++, p++) { 10503f27d899SToby Isaac for (k = 0; k < dimTrace; k++) points[p * dim + k] = pointsTrace[i * dimTrace + k]; 10513f27d899SToby Isaac for (k = 0; k < dimFiber; k++) points[p * dim + dimTrace + k] = pointsFiber[j * dimFiber + k]; 10523f27d899SToby Isaac } 10533f27d899SToby Isaac } 10543f27d899SToby Isaac ierr = PetscQuadratureCreate(PETSC_COMM_SELF, product);CHKERRQ(ierr); 10553f27d899SToby Isaac ierr = PetscQuadratureSetData(*product, dim, 0, numPoints, points, NULL);CHKERRQ(ierr); 10563f27d899SToby Isaac PetscFunctionReturn(0); 10573f27d899SToby Isaac } 10583f27d899SToby Isaac 105977f1a120SToby Isaac /* Kronecker tensor product where matrix is considered a matrix of k-forms, so that 106077f1a120SToby Isaac * the entries in the product matrix are wedge products of the entries in the original matrices */ 10613f27d899SToby Isaac static PetscErrorCode MatTensorAltV(Mat trace, Mat fiber, PetscInt dimTrace, PetscInt kTrace, PetscInt dimFiber, PetscInt kFiber, Mat *product) 10623f27d899SToby Isaac { 10633f27d899SToby Isaac PetscInt mTrace, nTrace, mFiber, nFiber, m, n, k, i, j, l; 10643f27d899SToby Isaac PetscInt dim, NkTrace, NkFiber, Nk; 10653f27d899SToby Isaac PetscInt dT, dF; 10663f27d899SToby Isaac PetscInt *nnzTrace, *nnzFiber, *nnz; 10673f27d899SToby Isaac PetscInt iT, iF, jT, jF, il, jl; 10683f27d899SToby Isaac PetscReal *workT, *workT2, *workF, *workF2, *work, *workstar; 10693f27d899SToby Isaac PetscReal *projT, *projF; 10703f27d899SToby Isaac PetscReal *projTstar, *projFstar; 10713f27d899SToby Isaac PetscReal *wedgeMat; 10723f27d899SToby Isaac PetscReal sign; 10733f27d899SToby Isaac PetscScalar *workS; 10743f27d899SToby Isaac Mat prod; 10753f27d899SToby Isaac /* this produces dof groups that look like the identity */ 10763f27d899SToby Isaac PetscErrorCode ierr; 10773f27d899SToby Isaac 10783f27d899SToby Isaac PetscFunctionBegin; 10793f27d899SToby Isaac ierr = MatGetSize(trace, &mTrace, &nTrace);CHKERRQ(ierr); 10803f27d899SToby Isaac ierr = PetscDTBinomialInt(dimTrace, PetscAbsInt(kTrace), &NkTrace);CHKERRQ(ierr); 10813f27d899SToby Isaac if (nTrace % NkTrace) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "point value space of trace matrix is not a multiple of k-form size"); 10823f27d899SToby Isaac ierr = MatGetSize(fiber, &mFiber, &nFiber);CHKERRQ(ierr); 10833f27d899SToby Isaac ierr = PetscDTBinomialInt(dimFiber, PetscAbsInt(kFiber), &NkFiber);CHKERRQ(ierr); 10843f27d899SToby Isaac if (nFiber % NkFiber) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "point value space of fiber matrix is not a multiple of k-form size"); 10853f27d899SToby Isaac ierr = PetscMalloc2(mTrace, &nnzTrace, mFiber, &nnzFiber);CHKERRQ(ierr); 10863f27d899SToby Isaac for (i = 0; i < mTrace; i++) { 10873f27d899SToby Isaac ierr = MatGetRow(trace, i, &(nnzTrace[i]), NULL, NULL);CHKERRQ(ierr); 10883f27d899SToby Isaac if (nnzTrace[i] % NkTrace) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in trace matrix are not in k-form size blocks"); 10893f27d899SToby Isaac } 10903f27d899SToby Isaac for (i = 0; i < mFiber; i++) { 10913f27d899SToby Isaac ierr = MatGetRow(fiber, i, &(nnzFiber[i]), NULL, NULL);CHKERRQ(ierr); 10923f27d899SToby Isaac if (nnzFiber[i] % NkFiber) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in fiber matrix are not in k-form size blocks"); 10933f27d899SToby Isaac } 10943f27d899SToby Isaac dim = dimTrace + dimFiber; 10953f27d899SToby Isaac k = kFiber + kTrace; 10963f27d899SToby Isaac ierr = PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk);CHKERRQ(ierr); 10973f27d899SToby Isaac m = mTrace * mFiber; 10983f27d899SToby Isaac ierr = PetscMalloc1(m, &nnz);CHKERRQ(ierr); 10993f27d899SToby Isaac for (l = 0, j = 0; j < mFiber; j++) for (i = 0; i < mTrace; i++, l++) nnz[l] = (nnzTrace[i] / NkTrace) * (nnzFiber[j] / NkFiber) * Nk; 11003f27d899SToby Isaac n = (nTrace / NkTrace) * (nFiber / NkFiber) * Nk; 11013f27d899SToby Isaac ierr = MatCreateSeqAIJ(PETSC_COMM_SELF, m, n, 0, nnz, &prod);CHKERRQ(ierr); 11023f27d899SToby Isaac ierr = PetscFree(nnz);CHKERRQ(ierr); 11033f27d899SToby Isaac ierr = PetscFree2(nnzTrace,nnzFiber);CHKERRQ(ierr); 11043f27d899SToby Isaac /* reasoning about which points each dof needs depends on having zeros computed at points preserved */ 11053f27d899SToby Isaac ierr = MatSetOption(prod, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr); 11063f27d899SToby Isaac /* compute pullbacks */ 11073f27d899SToby Isaac ierr = PetscDTBinomialInt(dim, PetscAbsInt(kTrace), &dT);CHKERRQ(ierr); 11083f27d899SToby Isaac ierr = PetscDTBinomialInt(dim, PetscAbsInt(kFiber), &dF);CHKERRQ(ierr); 11093f27d899SToby Isaac ierr = PetscMalloc4(dimTrace * dim, &projT, dimFiber * dim, &projF, dT * NkTrace, &projTstar, dF * NkFiber, &projFstar);CHKERRQ(ierr); 11103f27d899SToby Isaac ierr = PetscArrayzero(projT, dimTrace * dim);CHKERRQ(ierr); 11113f27d899SToby Isaac for (i = 0; i < dimTrace; i++) projT[i * (dim + 1)] = 1.; 11123f27d899SToby Isaac ierr = PetscArrayzero(projF, dimFiber * dim);CHKERRQ(ierr); 11133f27d899SToby Isaac for (i = 0; i < dimFiber; i++) projF[i * (dim + 1) + dimTrace] = 1.; 11143f27d899SToby Isaac ierr = PetscDTAltVPullbackMatrix(dim, dimTrace, projT, kTrace, projTstar);CHKERRQ(ierr); 11153f27d899SToby Isaac ierr = PetscDTAltVPullbackMatrix(dim, dimFiber, projF, kFiber, projFstar);CHKERRQ(ierr); 11163f27d899SToby Isaac ierr = PetscMalloc5(dT, &workT, dF, &workF, Nk, &work, Nk, &workstar, Nk, &workS);CHKERRQ(ierr); 11173f27d899SToby Isaac ierr = PetscMalloc2(dT, &workT2, dF, &workF2);CHKERRQ(ierr); 11183f27d899SToby Isaac ierr = PetscMalloc1(Nk * dT, &wedgeMat);CHKERRQ(ierr); 11193f27d899SToby Isaac sign = (PetscAbsInt(kTrace * kFiber) & 1) ? -1. : 1.; 11203f27d899SToby Isaac for (i = 0, iF = 0; iF < mFiber; iF++) { 11213f27d899SToby Isaac PetscInt ncolsF, nformsF; 11223f27d899SToby Isaac const PetscInt *colsF; 11233f27d899SToby Isaac const PetscScalar *valsF; 11243f27d899SToby Isaac 11253f27d899SToby Isaac ierr = MatGetRow(fiber, iF, &ncolsF, &colsF, &valsF);CHKERRQ(ierr); 11263f27d899SToby Isaac nformsF = ncolsF / NkFiber; 11273f27d899SToby Isaac for (iT = 0; iT < mTrace; iT++, i++) { 11283f27d899SToby Isaac PetscInt ncolsT, nformsT; 11293f27d899SToby Isaac const PetscInt *colsT; 11303f27d899SToby Isaac const PetscScalar *valsT; 11313f27d899SToby Isaac 11323f27d899SToby Isaac ierr = MatGetRow(trace, iT, &ncolsT, &colsT, &valsT);CHKERRQ(ierr); 11333f27d899SToby Isaac nformsT = ncolsT / NkTrace; 11343f27d899SToby Isaac for (j = 0, jF = 0; jF < nformsF; jF++) { 11353f27d899SToby Isaac PetscInt colF = colsF[jF * NkFiber] / NkFiber; 11363f27d899SToby Isaac 11373f27d899SToby Isaac for (il = 0; il < dF; il++) { 11383f27d899SToby Isaac PetscReal val = 0.; 11393f27d899SToby Isaac for (jl = 0; jl < NkFiber; jl++) val += projFstar[il * NkFiber + jl] * PetscRealPart(valsF[jF * NkFiber + jl]); 11403f27d899SToby Isaac workF[il] = val; 11413f27d899SToby Isaac } 11423f27d899SToby Isaac if (kFiber < 0) { 11433f27d899SToby Isaac for (il = 0; il < dF; il++) workF2[il] = workF[il]; 11443f27d899SToby Isaac ierr = PetscDTAltVStar(dim, PetscAbsInt(kFiber), 1, workF2, workF);CHKERRQ(ierr); 11453f27d899SToby Isaac } 11463f27d899SToby Isaac ierr = PetscDTAltVWedgeMatrix(dim, PetscAbsInt(kFiber), PetscAbsInt(kTrace), workF, wedgeMat);CHKERRQ(ierr); 11473f27d899SToby Isaac for (jT = 0; jT < nformsT; jT++, j++) { 11483f27d899SToby Isaac PetscInt colT = colsT[jT * NkTrace] / NkTrace; 11493f27d899SToby Isaac PetscInt col = colF * (nTrace / NkTrace) + colT; 11503f27d899SToby Isaac const PetscScalar *vals; 11513f27d899SToby Isaac 11523f27d899SToby Isaac for (il = 0; il < dT; il++) { 11533f27d899SToby Isaac PetscReal val = 0.; 11543f27d899SToby Isaac for (jl = 0; jl < NkTrace; jl++) val += projTstar[il * NkTrace + jl] * PetscRealPart(valsT[jT * NkTrace + jl]); 11553f27d899SToby Isaac workT[il] = val; 11563f27d899SToby Isaac } 11573f27d899SToby Isaac if (kTrace < 0) { 11583f27d899SToby Isaac for (il = 0; il < dT; il++) workT2[il] = workT[il]; 11593f27d899SToby Isaac ierr = PetscDTAltVStar(dim, PetscAbsInt(kTrace), 1, workT2, workT);CHKERRQ(ierr); 11603f27d899SToby Isaac } 11613f27d899SToby Isaac 11623f27d899SToby Isaac for (il = 0; il < Nk; il++) { 11633f27d899SToby Isaac PetscReal val = 0.; 11643f27d899SToby Isaac for (jl = 0; jl < dT; jl++) val += sign * wedgeMat[il * dT + jl] * workT[jl]; 11653f27d899SToby Isaac work[il] = val; 11663f27d899SToby Isaac } 11673f27d899SToby Isaac if (k < 0) { 11683f27d899SToby Isaac ierr = PetscDTAltVStar(dim, PetscAbsInt(k), -1, work, workstar);CHKERRQ(ierr); 11693f27d899SToby Isaac #if defined(PETSC_USE_COMPLEX) 11703f27d899SToby Isaac for (l = 0; l < Nk; l++) workS[l] = workstar[l]; 11713f27d899SToby Isaac vals = &workS[0]; 11723f27d899SToby Isaac #else 11733f27d899SToby Isaac vals = &workstar[0]; 11743f27d899SToby Isaac #endif 11753f27d899SToby Isaac } else { 11763f27d899SToby Isaac #if defined(PETSC_USE_COMPLEX) 11773f27d899SToby Isaac for (l = 0; l < Nk; l++) workS[l] = work[l]; 11783f27d899SToby Isaac vals = &workS[0]; 11793f27d899SToby Isaac #else 11803f27d899SToby Isaac vals = &work[0]; 11813f27d899SToby Isaac #endif 11823f27d899SToby Isaac } 11833f27d899SToby Isaac for (l = 0; l < Nk; l++) { 11843f27d899SToby Isaac ierr = MatSetValue(prod, i, col * Nk + l, vals[l], INSERT_VALUES);CHKERRQ(ierr); 11853f27d899SToby Isaac } /* Nk */ 11863f27d899SToby Isaac } /* jT */ 11873f27d899SToby Isaac } /* jF */ 11883f27d899SToby Isaac ierr = MatRestoreRow(trace, iT, &ncolsT, &colsT, &valsT);CHKERRQ(ierr); 11893f27d899SToby Isaac } /* iT */ 11903f27d899SToby Isaac ierr = MatRestoreRow(fiber, iF, &ncolsF, &colsF, &valsF);CHKERRQ(ierr); 11913f27d899SToby Isaac } /* iF */ 11923f27d899SToby Isaac ierr = PetscFree(wedgeMat);CHKERRQ(ierr); 11933f27d899SToby Isaac ierr = PetscFree4(projT, projF, projTstar, projFstar);CHKERRQ(ierr); 11943f27d899SToby Isaac ierr = PetscFree2(workT2, workF2);CHKERRQ(ierr); 11953f27d899SToby Isaac ierr = PetscFree5(workT, workF, work, workstar, workS);CHKERRQ(ierr); 11963f27d899SToby Isaac ierr = MatAssemblyBegin(prod, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 11973f27d899SToby Isaac ierr = MatAssemblyEnd(prod, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 11983f27d899SToby Isaac *product = prod; 11993f27d899SToby Isaac PetscFunctionReturn(0); 12003f27d899SToby Isaac } 12013f27d899SToby Isaac 120277f1a120SToby Isaac /* Union of quadrature points, with an attempt to identify commont points in the two sets */ 12033f27d899SToby Isaac static PetscErrorCode PetscQuadraturePointsMerge(PetscQuadrature quadA, PetscQuadrature quadB, PetscQuadrature *quadJoint, PetscInt *aToJoint[], PetscInt *bToJoint[]) 12043f27d899SToby Isaac { 12053f27d899SToby Isaac PetscInt dimA, dimB; 12063f27d899SToby Isaac PetscInt nA, nB, nJoint, i, j, d; 12073f27d899SToby Isaac const PetscReal *pointsA; 12083f27d899SToby Isaac const PetscReal *pointsB; 12093f27d899SToby Isaac PetscReal *pointsJoint; 12103f27d899SToby Isaac PetscInt *aToJ, *bToJ; 12113f27d899SToby Isaac PetscQuadrature qJ; 12123f27d899SToby Isaac PetscErrorCode ierr; 12133f27d899SToby Isaac 12143f27d899SToby Isaac PetscFunctionBegin; 12153f27d899SToby Isaac ierr = PetscQuadratureGetData(quadA, &dimA, NULL, &nA, &pointsA, NULL);CHKERRQ(ierr); 12163f27d899SToby Isaac ierr = PetscQuadratureGetData(quadB, &dimB, NULL, &nB, &pointsB, NULL);CHKERRQ(ierr); 12173f27d899SToby Isaac if (dimA != dimB) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Quadrature points must be in the same dimension"); 12183f27d899SToby Isaac nJoint = nA; 12193f27d899SToby Isaac ierr = PetscMalloc1(nA, &aToJ);CHKERRQ(ierr); 12203f27d899SToby Isaac for (i = 0; i < nA; i++) aToJ[i] = i; 12213f27d899SToby Isaac ierr = PetscMalloc1(nB, &bToJ);CHKERRQ(ierr); 12223f27d899SToby Isaac for (i = 0; i < nB; i++) { 12233f27d899SToby Isaac for (j = 0; j < nA; j++) { 12243f27d899SToby Isaac bToJ[i] = -1; 12256ff15688SToby Isaac for (d = 0; d < dimA; d++) if (PetscAbsReal(pointsB[i * dimA + d] - pointsA[j * dimA + d]) > PETSC_SMALL) break; 12263f27d899SToby Isaac if (d == dimA) { 12273f27d899SToby Isaac bToJ[i] = j; 12283f27d899SToby Isaac break; 12293f27d899SToby Isaac } 12303f27d899SToby Isaac } 12313f27d899SToby Isaac if (bToJ[i] == -1) { 12323f27d899SToby Isaac bToJ[i] = nJoint++; 12333f27d899SToby Isaac } 12343f27d899SToby Isaac } 12353f27d899SToby Isaac *aToJoint = aToJ; 12363f27d899SToby Isaac *bToJoint = bToJ; 12373f27d899SToby Isaac ierr = PetscMalloc1(nJoint * dimA, &pointsJoint);CHKERRQ(ierr); 12383f27d899SToby Isaac ierr = PetscArraycpy(pointsJoint, pointsA, nA * dimA);CHKERRQ(ierr); 12393f27d899SToby Isaac for (i = 0; i < nB; i++) { 12403f27d899SToby Isaac if (bToJ[i] >= nA) { 12413f27d899SToby Isaac for (d = 0; d < dimA; d++) pointsJoint[bToJ[i] * dimA + d] = pointsB[i * dimA + d]; 12423f27d899SToby Isaac } 12433f27d899SToby Isaac } 12443f27d899SToby Isaac ierr = PetscQuadratureCreate(PETSC_COMM_SELF, &qJ);CHKERRQ(ierr); 12453f27d899SToby Isaac ierr = PetscQuadratureSetData(qJ, dimA, 0, nJoint, pointsJoint, NULL);CHKERRQ(ierr); 12463f27d899SToby Isaac *quadJoint = qJ; 12473f27d899SToby Isaac PetscFunctionReturn(0); 12483f27d899SToby Isaac } 12493f27d899SToby Isaac 125077f1a120SToby Isaac /* Matrices matA and matB are both quadrature -> dof matrices: produce a matrix that is joint quadrature -> union of 125177f1a120SToby Isaac * dofs, where the joint quadrature was produced by PetscQuadraturePointsMerge */ 12523f27d899SToby Isaac static PetscErrorCode MatricesMerge(Mat matA, Mat matB, PetscInt dim, PetscInt k, PetscInt numMerged, const PetscInt aToMerged[], const PetscInt bToMerged[], Mat *matMerged) 12533f27d899SToby Isaac { 12543f27d899SToby Isaac PetscInt m, n, mA, nA, mB, nB, Nk, i, j, l; 12553f27d899SToby Isaac Mat M; 12563f27d899SToby Isaac PetscInt *nnz; 12573f27d899SToby Isaac PetscInt maxnnz; 12583f27d899SToby Isaac PetscInt *work; 12593f27d899SToby Isaac PetscErrorCode ierr; 12603f27d899SToby Isaac 12613f27d899SToby Isaac PetscFunctionBegin; 12623f27d899SToby Isaac ierr = PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk);CHKERRQ(ierr); 12633f27d899SToby Isaac ierr = MatGetSize(matA, &mA, &nA);CHKERRQ(ierr); 12643f27d899SToby Isaac if (nA % Nk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "matA column space not a multiple of k-form size"); 12653f27d899SToby Isaac ierr = MatGetSize(matB, &mB, &nB);CHKERRQ(ierr); 12663f27d899SToby Isaac if (nB % Nk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "matB column space not a multiple of k-form size"); 12673f27d899SToby Isaac m = mA + mB; 12683f27d899SToby Isaac n = numMerged * Nk; 12693f27d899SToby Isaac ierr = PetscMalloc1(m, &nnz);CHKERRQ(ierr); 12703f27d899SToby Isaac maxnnz = 0; 12713f27d899SToby Isaac for (i = 0; i < mA; i++) { 12723f27d899SToby Isaac ierr = MatGetRow(matA, i, &(nnz[i]), NULL, NULL);CHKERRQ(ierr); 12733f27d899SToby Isaac if (nnz[i] % Nk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in matA are not in k-form size blocks"); 12743f27d899SToby Isaac maxnnz = PetscMax(maxnnz, nnz[i]); 12753f27d899SToby Isaac } 12763f27d899SToby Isaac for (i = 0; i < mB; i++) { 12773f27d899SToby Isaac ierr = MatGetRow(matB, i, &(nnz[i+mA]), NULL, NULL);CHKERRQ(ierr); 12783f27d899SToby Isaac if (nnz[i+mA] % Nk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "nonzeros in matB are not in k-form size blocks"); 12793f27d899SToby Isaac maxnnz = PetscMax(maxnnz, nnz[i+mA]); 12803f27d899SToby Isaac } 12813f27d899SToby Isaac ierr = MatCreateSeqAIJ(PETSC_COMM_SELF, m, n, 0, nnz, &M);CHKERRQ(ierr); 12823f27d899SToby Isaac ierr = PetscFree(nnz);CHKERRQ(ierr); 12833f27d899SToby Isaac /* reasoning about which points each dof needs depends on having zeros computed at points preserved */ 12843f27d899SToby Isaac ierr = MatSetOption(M, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr); 12853f27d899SToby Isaac ierr = PetscMalloc1(maxnnz, &work);CHKERRQ(ierr); 12863f27d899SToby Isaac for (i = 0; i < mA; i++) { 12873f27d899SToby Isaac const PetscInt *cols; 12883f27d899SToby Isaac const PetscScalar *vals; 12893f27d899SToby Isaac PetscInt nCols; 12903f27d899SToby Isaac ierr = MatGetRow(matA, i, &nCols, &cols, &vals);CHKERRQ(ierr); 12913f27d899SToby Isaac for (j = 0; j < nCols / Nk; j++) { 12923f27d899SToby Isaac PetscInt newCol = aToMerged[cols[j * Nk] / Nk]; 12933f27d899SToby Isaac for (l = 0; l < Nk; l++) work[j * Nk + l] = newCol * Nk + l; 12943f27d899SToby Isaac } 12953f27d899SToby Isaac ierr = MatSetValuesBlocked(M, 1, &i, nCols, work, vals, INSERT_VALUES);CHKERRQ(ierr); 12963f27d899SToby Isaac ierr = MatRestoreRow(matA, i, &nCols, &cols, &vals);CHKERRQ(ierr); 12973f27d899SToby Isaac } 12983f27d899SToby Isaac for (i = 0; i < mB; i++) { 12993f27d899SToby Isaac const PetscInt *cols; 13003f27d899SToby Isaac const PetscScalar *vals; 13013f27d899SToby Isaac 13023f27d899SToby Isaac PetscInt row = i + mA; 13033f27d899SToby Isaac PetscInt nCols; 13043f27d899SToby Isaac ierr = MatGetRow(matB, i, &nCols, &cols, &vals);CHKERRQ(ierr); 13053f27d899SToby Isaac for (j = 0; j < nCols / Nk; j++) { 13063f27d899SToby Isaac PetscInt newCol = bToMerged[cols[j * Nk] / Nk]; 13073f27d899SToby Isaac for (l = 0; l < Nk; l++) work[j * Nk + l] = newCol * Nk + l; 13083f27d899SToby Isaac } 13093f27d899SToby Isaac ierr = MatSetValuesBlocked(M, 1, &row, nCols, work, vals, INSERT_VALUES);CHKERRQ(ierr); 13103f27d899SToby Isaac ierr = MatRestoreRow(matB, i, &nCols, &cols, &vals);CHKERRQ(ierr); 13113f27d899SToby Isaac } 13123f27d899SToby Isaac ierr = PetscFree(work);CHKERRQ(ierr); 13133f27d899SToby Isaac ierr = MatAssemblyBegin(M, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 13143f27d899SToby Isaac ierr = MatAssemblyEnd(M, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 13153f27d899SToby Isaac *matMerged = M; 13163f27d899SToby Isaac PetscFunctionReturn(0); 13173f27d899SToby Isaac } 13183f27d899SToby Isaac 131977f1a120SToby Isaac /* Take a dual space and product a segment space that has all the same specifications (trimmed, continuous, order, 132077f1a120SToby Isaac * node set), except for the form degree. For computing boundary dofs and for making tensor product spaces */ 13213f27d899SToby Isaac static PetscErrorCode PetscDualSpaceCreateFacetSubspace_Lagrange(PetscDualSpace sp, DM K, PetscInt f, PetscInt k, PetscInt Ncopies, PetscBool interiorOnly, PetscDualSpace *bdsp) 13223f27d899SToby Isaac { 13233f27d899SToby Isaac PetscInt Nknew, Ncnew; 13243f27d899SToby Isaac PetscInt dim, pointDim = -1; 13253f27d899SToby Isaac PetscInt depth; 13263f27d899SToby Isaac DM dm; 13273f27d899SToby Isaac PetscDualSpace_Lag *newlag; 13283f27d899SToby Isaac PetscErrorCode ierr; 13293f27d899SToby Isaac 13303f27d899SToby Isaac PetscFunctionBegin; 13313f27d899SToby Isaac ierr = PetscDualSpaceGetDM(sp,&dm);CHKERRQ(ierr); 13323f27d899SToby Isaac ierr = DMGetDimension(dm,&dim);CHKERRQ(ierr); 13333f27d899SToby Isaac ierr = DMPlexGetDepth(dm,&depth);CHKERRQ(ierr); 13343f27d899SToby Isaac ierr = PetscDualSpaceDuplicate(sp,bdsp);CHKERRQ(ierr); 13353f27d899SToby Isaac ierr = PetscDualSpaceSetFormDegree(*bdsp,k);CHKERRQ(ierr); 13363f27d899SToby Isaac if (!K) { 13373f27d899SToby Isaac PetscBool isSimplex; 13383f27d899SToby Isaac 13393f27d899SToby Isaac 13403f27d899SToby Isaac if (depth == dim) { 13413f27d899SToby Isaac PetscInt coneSize; 13423f27d899SToby Isaac 13436ff15688SToby Isaac pointDim = dim - 1; 13443f27d899SToby Isaac ierr = DMPlexGetConeSize(dm,f,&coneSize);CHKERRQ(ierr); 13453f27d899SToby Isaac isSimplex = (PetscBool) (coneSize == dim); 13463f27d899SToby Isaac ierr = PetscDualSpaceCreateReferenceCell(*bdsp, dim-1, isSimplex, &K);CHKERRQ(ierr); 13473f27d899SToby Isaac } else if (depth == 1) { 13483f27d899SToby Isaac pointDim = 0; 13493f27d899SToby Isaac ierr = PetscDualSpaceCreateReferenceCell(*bdsp, 0, PETSC_TRUE, &K);CHKERRQ(ierr); 13503f27d899SToby Isaac } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Unsupported interpolation state of reference element"); 13513f27d899SToby Isaac } else { 13523f27d899SToby Isaac ierr = PetscObjectReference((PetscObject)K);CHKERRQ(ierr); 13533f27d899SToby Isaac ierr = DMGetDimension(K, &pointDim);CHKERRQ(ierr); 13543f27d899SToby Isaac } 13553f27d899SToby Isaac ierr = PetscDualSpaceSetDM(*bdsp, K);CHKERRQ(ierr); 13563f27d899SToby Isaac ierr = DMDestroy(&K);CHKERRQ(ierr); 13573f27d899SToby Isaac ierr = PetscDTBinomialInt(pointDim, PetscAbsInt(k), &Nknew);CHKERRQ(ierr); 13583f27d899SToby Isaac Ncnew = Nknew * Ncopies; 13593f27d899SToby Isaac ierr = PetscDualSpaceSetNumComponents(*bdsp, Ncnew);CHKERRQ(ierr); 13603f27d899SToby Isaac newlag = (PetscDualSpace_Lag *) (*bdsp)->data; 13613f27d899SToby Isaac newlag->interiorOnly = interiorOnly; 13623f27d899SToby Isaac ierr = PetscDualSpaceSetUp(*bdsp);CHKERRQ(ierr); 13633f27d899SToby Isaac PetscFunctionReturn(0); 13643f27d899SToby Isaac } 13653f27d899SToby Isaac 136677f1a120SToby Isaac /* Construct simplex nodes from a nodefamily, add Nk dof vectors of length Nk at each node. 136777f1a120SToby Isaac * Return the (quadrature, matrix) form of the dofs and the nodeIndices form as well. 136877f1a120SToby Isaac * 136977f1a120SToby Isaac * Sometimes we want a set of nodes to be contained in the interior of the element, 137077f1a120SToby Isaac * even when the node scheme puts nodes on the boundaries. numNodeSkip tells 137177f1a120SToby Isaac * the routine how many "layers" of nodes need to be skipped. 137277f1a120SToby Isaac * */ 13733f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeCreateSimplexNodeMat(Petsc1DNodeFamily nodeFamily, PetscInt dim, PetscInt sum, PetscInt Nk, PetscInt numNodeSkip, PetscQuadrature *iNodes, Mat *iMat, PetscLagNodeIndices *nodeIndices) 13743f27d899SToby Isaac { 13753f27d899SToby Isaac PetscReal *extraNodeCoords, *nodeCoords; 13763f27d899SToby Isaac PetscInt nNodes, nExtraNodes; 13773f27d899SToby Isaac PetscInt i, j, k, extraSum = sum + numNodeSkip * (1 + dim); 13783f27d899SToby Isaac PetscQuadrature intNodes; 13793f27d899SToby Isaac Mat intMat; 13803f27d899SToby Isaac PetscLagNodeIndices ni; 13813f27d899SToby Isaac PetscErrorCode ierr; 13823f27d899SToby Isaac 13833f27d899SToby Isaac PetscFunctionBegin; 13843f27d899SToby Isaac ierr = PetscDTBinomialInt(dim + sum, dim, &nNodes);CHKERRQ(ierr); 13853f27d899SToby Isaac ierr = PetscDTBinomialInt(dim + extraSum, dim, &nExtraNodes);CHKERRQ(ierr); 13863f27d899SToby Isaac 13873f27d899SToby Isaac ierr = PetscMalloc1(dim * nExtraNodes, &extraNodeCoords);CHKERRQ(ierr); 13883f27d899SToby Isaac ierr = PetscNew(&ni);CHKERRQ(ierr); 13893f27d899SToby Isaac ni->nodeIdxDim = dim + 1; 13903f27d899SToby Isaac ni->nodeVecDim = Nk; 13913f27d899SToby Isaac ni->nNodes = nNodes * Nk; 13923f27d899SToby Isaac ni->refct = 1; 13933f27d899SToby Isaac ierr = PetscMalloc1(nNodes * Nk * (dim + 1), &(ni->nodeIdx));CHKERRQ(ierr); 13943f27d899SToby Isaac ierr = PetscMalloc1(nNodes * Nk * Nk, &(ni->nodeVec));CHKERRQ(ierr); 13953f27d899SToby Isaac for (i = 0; i < nNodes; i++) for (j = 0; j < Nk; j++) for (k = 0; k < Nk; k++) ni->nodeVec[(i * Nk + j) * Nk + k] = (j == k) ? 1. : 0.; 13963f27d899SToby Isaac ierr = Petsc1DNodeFamilyComputeSimplexNodes(nodeFamily, dim, extraSum, extraNodeCoords);CHKERRQ(ierr); 13973f27d899SToby Isaac if (numNodeSkip) { 13983f27d899SToby Isaac PetscInt k; 13993f27d899SToby Isaac PetscInt *tup; 14003f27d899SToby Isaac 14013f27d899SToby Isaac ierr = PetscMalloc1(dim * nNodes, &nodeCoords);CHKERRQ(ierr); 14023f27d899SToby Isaac ierr = PetscMalloc1(dim + 1, &tup);CHKERRQ(ierr); 14033f27d899SToby Isaac for (k = 0; k < nNodes; k++) { 14043f27d899SToby Isaac PetscInt j, c; 14053f27d899SToby Isaac PetscInt index; 14063f27d899SToby Isaac 14073f27d899SToby Isaac ierr = PetscDTIndexToBary(dim + 1, sum, k, tup);CHKERRQ(ierr); 14083f27d899SToby Isaac for (j = 0; j < dim + 1; j++) tup[j] += numNodeSkip; 14093f27d899SToby Isaac for (c = 0; c < Nk; c++) { 14103f27d899SToby Isaac for (j = 0; j < dim + 1; j++) { 14113f27d899SToby Isaac ni->nodeIdx[(k * Nk + c) * (dim + 1) + j] = tup[j] + 1; 14123f27d899SToby Isaac } 14133f27d899SToby Isaac } 14143f27d899SToby Isaac ierr = PetscDTBaryToIndex(dim + 1, extraSum, tup, &index);CHKERRQ(ierr); 14153f27d899SToby Isaac for (j = 0; j < dim; j++) nodeCoords[k * dim + j] = extraNodeCoords[index * dim + j]; 14163f27d899SToby Isaac } 14173f27d899SToby Isaac ierr = PetscFree(tup);CHKERRQ(ierr); 14183f27d899SToby Isaac ierr = PetscFree(extraNodeCoords);CHKERRQ(ierr); 14193f27d899SToby Isaac } else { 14203f27d899SToby Isaac PetscInt k; 14213f27d899SToby Isaac PetscInt *tup; 14223f27d899SToby Isaac 14233f27d899SToby Isaac nodeCoords = extraNodeCoords; 14243f27d899SToby Isaac ierr = PetscMalloc1(dim + 1, &tup);CHKERRQ(ierr); 14253f27d899SToby Isaac for (k = 0; k < nNodes; k++) { 14263f27d899SToby Isaac PetscInt j, c; 14273f27d899SToby Isaac 14283f27d899SToby Isaac ierr = PetscDTIndexToBary(dim + 1, sum, k, tup);CHKERRQ(ierr); 14293f27d899SToby Isaac for (c = 0; c < Nk; c++) { 14303f27d899SToby Isaac for (j = 0; j < dim + 1; j++) { 14313f27d899SToby Isaac /* barycentric indices can have zeros, but we don't want to push forward zeros because it makes it harder to 143277f1a120SToby Isaac * determine which nodes correspond to which under symmetries, so we increase by 1. This is fine 143377f1a120SToby Isaac * because the nodeIdx coordinates don't have any meaning other than helping to identify symmetries */ 14343f27d899SToby Isaac ni->nodeIdx[(k * Nk + c) * (dim + 1) + j] = tup[j] + 1; 14353f27d899SToby Isaac } 14363f27d899SToby Isaac } 14373f27d899SToby Isaac } 14383f27d899SToby Isaac ierr = PetscFree(tup);CHKERRQ(ierr); 14393f27d899SToby Isaac } 14403f27d899SToby Isaac ierr = PetscQuadratureCreate(PETSC_COMM_SELF, &intNodes);CHKERRQ(ierr); 14413f27d899SToby Isaac ierr = PetscQuadratureSetData(intNodes, dim, 0, nNodes, nodeCoords, NULL);CHKERRQ(ierr); 14423f27d899SToby Isaac ierr = MatCreateSeqAIJ(PETSC_COMM_SELF, nNodes * Nk, nNodes * Nk, Nk, NULL, &intMat);CHKERRQ(ierr); 14433f27d899SToby Isaac ierr = MatSetOption(intMat,MAT_IGNORE_ZERO_ENTRIES,PETSC_FALSE);CHKERRQ(ierr); 14443f27d899SToby Isaac for (j = 0; j < nNodes * Nk; j++) { 14453f27d899SToby Isaac PetscInt rem = j % Nk; 14463f27d899SToby Isaac PetscInt a, aprev = j - rem; 14473f27d899SToby Isaac PetscInt anext = aprev + Nk; 14483f27d899SToby Isaac 14493f27d899SToby Isaac for (a = aprev; a < anext; a++) { 14503f27d899SToby Isaac ierr = MatSetValue(intMat, j, a, (a == j) ? 1. : 0., INSERT_VALUES);CHKERRQ(ierr); 14513f27d899SToby Isaac } 14523f27d899SToby Isaac } 14533f27d899SToby Isaac ierr = MatAssemblyBegin(intMat, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 14543f27d899SToby Isaac ierr = MatAssemblyEnd(intMat, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 14553f27d899SToby Isaac *iNodes = intNodes; 14563f27d899SToby Isaac *iMat = intMat; 14573f27d899SToby Isaac *nodeIndices = ni; 14583f27d899SToby Isaac PetscFunctionReturn(0); 14593f27d899SToby Isaac } 14603f27d899SToby Isaac 146177f1a120SToby Isaac /* once the nodeIndices have been created for the interior of the reference cell, and for all of the boundary cells, 146277f1a120SToby Isaac * push forward the boudary dofs and concatenate them into the full node indices for the dual space */ 14633f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeCreateAllNodeIdx(PetscDualSpace sp) 14643f27d899SToby Isaac { 14653f27d899SToby Isaac DM dm; 14663f27d899SToby Isaac PetscInt dim, nDofs; 14673f27d899SToby Isaac PetscSection section; 14683f27d899SToby Isaac PetscInt pStart, pEnd, p; 14693f27d899SToby Isaac PetscInt formDegree, Nk; 14703f27d899SToby Isaac PetscInt nodeIdxDim, spintdim; 14713f27d899SToby Isaac PetscDualSpace_Lag *lag; 14723f27d899SToby Isaac PetscLagNodeIndices ni, verti; 14733f27d899SToby Isaac PetscErrorCode ierr; 14743f27d899SToby Isaac 14753f27d899SToby Isaac PetscFunctionBegin; 14763f27d899SToby Isaac lag = (PetscDualSpace_Lag *) sp->data; 14773f27d899SToby Isaac verti = lag->vertIndices; 14783f27d899SToby Isaac ierr = PetscDualSpaceGetDM(sp, &dm);CHKERRQ(ierr); 14793f27d899SToby Isaac ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 14803f27d899SToby Isaac ierr = PetscDualSpaceGetFormDegree(sp, &formDegree);CHKERRQ(ierr); 14813f27d899SToby Isaac ierr = PetscDTBinomialInt(dim, PetscAbsInt(formDegree), &Nk);CHKERRQ(ierr); 14823f27d899SToby Isaac ierr = PetscDualSpaceGetSection(sp, §ion);CHKERRQ(ierr); 14833f27d899SToby Isaac ierr = PetscSectionGetStorageSize(section, &nDofs);CHKERRQ(ierr); 14843f27d899SToby Isaac ierr = PetscNew(&ni);CHKERRQ(ierr); 14853f27d899SToby Isaac ni->nodeIdxDim = nodeIdxDim = verti->nodeIdxDim; 14863f27d899SToby Isaac ni->nodeVecDim = Nk; 14873f27d899SToby Isaac ni->nNodes = nDofs; 14883f27d899SToby Isaac ni->refct = 1; 14893f27d899SToby Isaac ierr = PetscMalloc1(nodeIdxDim * nDofs, &(ni->nodeIdx));CHKERRQ(ierr); 14903f27d899SToby Isaac ierr = PetscMalloc1(Nk * nDofs, &(ni->nodeVec));CHKERRQ(ierr); 14913f27d899SToby Isaac ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr); 14923f27d899SToby Isaac ierr = PetscSectionGetDof(section, 0, &spintdim);CHKERRQ(ierr); 14933f27d899SToby Isaac if (spintdim) { 14943f27d899SToby Isaac ierr = PetscArraycpy(ni->nodeIdx, lag->intNodeIndices->nodeIdx, spintdim * nodeIdxDim);CHKERRQ(ierr); 14953f27d899SToby Isaac ierr = PetscArraycpy(ni->nodeVec, lag->intNodeIndices->nodeVec, spintdim * Nk);CHKERRQ(ierr); 14963f27d899SToby Isaac } 14973f27d899SToby Isaac for (p = pStart + 1; p < pEnd; p++) { 14983f27d899SToby Isaac PetscDualSpace psp = sp->pointSpaces[p]; 14993f27d899SToby Isaac PetscDualSpace_Lag *plag; 15003f27d899SToby Isaac PetscInt dof, off; 15013f27d899SToby Isaac 15023f27d899SToby Isaac ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr); 15033f27d899SToby Isaac if (!dof) continue; 15043f27d899SToby Isaac plag = (PetscDualSpace_Lag *) psp->data; 15053f27d899SToby Isaac ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); 15063f27d899SToby Isaac ierr = PetscLagNodeIndicesPushForward(dm, verti, p, plag->vertIndices, plag->intNodeIndices, 0, formDegree, &(ni->nodeIdx[off * nodeIdxDim]), &(ni->nodeVec[off * Nk]));CHKERRQ(ierr); 15073f27d899SToby Isaac } 15083f27d899SToby Isaac lag->allNodeIndices = ni; 15093f27d899SToby Isaac PetscFunctionReturn(0); 15103f27d899SToby Isaac } 15113f27d899SToby Isaac 151277f1a120SToby Isaac /* once the (quadrature, Matrix) forms of the dofs have been created for the interior of the 151377f1a120SToby Isaac * reference cell and for the boundary cells, jk 151477f1a120SToby Isaac * push forward the boundary data and concatenate them into the full (quadrature, matrix) data 151577f1a120SToby Isaac * for the dual space */ 15163f27d899SToby Isaac static PetscErrorCode PetscDualSpaceCreateAllDataFromInteriorData(PetscDualSpace sp) 15173f27d899SToby Isaac { 15183f27d899SToby Isaac DM dm; 15193f27d899SToby Isaac PetscSection section; 15203f27d899SToby Isaac PetscInt pStart, pEnd, p, k, Nk, dim, Nc; 15213f27d899SToby Isaac PetscInt nNodes; 15223f27d899SToby Isaac PetscInt countNodes; 15233f27d899SToby Isaac Mat allMat; 15243f27d899SToby Isaac PetscQuadrature allNodes; 15253f27d899SToby Isaac PetscInt nDofs; 15263f27d899SToby Isaac PetscInt maxNzforms, j; 15273f27d899SToby Isaac PetscScalar *work; 15283f27d899SToby Isaac PetscReal *L, *J, *Jinv, *v0, *pv0; 15293f27d899SToby Isaac PetscInt *iwork; 15303f27d899SToby Isaac PetscReal *nodes; 15313f27d899SToby Isaac PetscErrorCode ierr; 15323f27d899SToby Isaac 15333f27d899SToby Isaac PetscFunctionBegin; 15343f27d899SToby Isaac ierr = PetscDualSpaceGetDM(sp, &dm);CHKERRQ(ierr); 15353f27d899SToby Isaac ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 15363f27d899SToby Isaac ierr = PetscDualSpaceGetSection(sp, §ion);CHKERRQ(ierr); 15373f27d899SToby Isaac ierr = PetscSectionGetStorageSize(section, &nDofs);CHKERRQ(ierr); 15383f27d899SToby Isaac ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr); 15393f27d899SToby Isaac ierr = PetscDualSpaceGetFormDegree(sp, &k);CHKERRQ(ierr); 15403f27d899SToby Isaac ierr = PetscDualSpaceGetNumComponents(sp, &Nc);CHKERRQ(ierr); 15413f27d899SToby Isaac ierr = PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk);CHKERRQ(ierr); 15423f27d899SToby Isaac for (p = pStart, nNodes = 0, maxNzforms = 0; p < pEnd; p++) { 15433f27d899SToby Isaac PetscDualSpace psp; 15443f27d899SToby Isaac DM pdm; 15453f27d899SToby Isaac PetscInt pdim, pNk; 15463f27d899SToby Isaac PetscQuadrature intNodes; 15473f27d899SToby Isaac Mat intMat; 15483f27d899SToby Isaac 15493f27d899SToby Isaac ierr = PetscDualSpaceGetPointSubspace(sp, p, &psp);CHKERRQ(ierr); 15503f27d899SToby Isaac if (!psp) continue; 15513f27d899SToby Isaac ierr = PetscDualSpaceGetDM(psp, &pdm);CHKERRQ(ierr); 15523f27d899SToby Isaac ierr = DMGetDimension(pdm, &pdim);CHKERRQ(ierr); 15533f27d899SToby Isaac if (pdim < PetscAbsInt(k)) continue; 15543f27d899SToby Isaac ierr = PetscDTBinomialInt(pdim, PetscAbsInt(k), &pNk);CHKERRQ(ierr); 15553f27d899SToby Isaac ierr = PetscDualSpaceGetInteriorData(psp, &intNodes, &intMat);CHKERRQ(ierr); 15563f27d899SToby Isaac if (intNodes) { 15573f27d899SToby Isaac PetscInt nNodesp; 15583f27d899SToby Isaac 15593f27d899SToby Isaac ierr = PetscQuadratureGetData(intNodes, NULL, NULL, &nNodesp, NULL, NULL);CHKERRQ(ierr); 15603f27d899SToby Isaac nNodes += nNodesp; 15613f27d899SToby Isaac } 15623f27d899SToby Isaac if (intMat) { 15633f27d899SToby Isaac PetscInt maxNzsp; 15643f27d899SToby Isaac PetscInt maxNzformsp; 15653f27d899SToby Isaac 15663f27d899SToby Isaac ierr = MatSeqAIJGetMaxRowNonzeros(intMat, &maxNzsp);CHKERRQ(ierr); 15673f27d899SToby Isaac if (maxNzsp % pNk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms"); 15683f27d899SToby Isaac maxNzformsp = maxNzsp / pNk; 15693f27d899SToby Isaac maxNzforms = PetscMax(maxNzforms, maxNzformsp); 15703f27d899SToby Isaac } 15713f27d899SToby Isaac } 15723f27d899SToby Isaac ierr = MatCreateSeqAIJ(PETSC_COMM_SELF, nDofs, nNodes * Nc, maxNzforms * Nk, NULL, &allMat);CHKERRQ(ierr); 15733f27d899SToby Isaac ierr = MatSetOption(allMat,MAT_IGNORE_ZERO_ENTRIES,PETSC_FALSE);CHKERRQ(ierr); 15743f27d899SToby Isaac ierr = PetscMalloc7(dim, &v0, dim, &pv0, dim * dim, &J, dim * dim, &Jinv, Nk * Nk, &L, maxNzforms * Nk, &work, maxNzforms * Nk, &iwork);CHKERRQ(ierr); 15753f27d899SToby Isaac for (j = 0; j < dim; j++) pv0[j] = -1.; 15763f27d899SToby Isaac ierr = PetscMalloc1(dim * nNodes, &nodes);CHKERRQ(ierr); 15773f27d899SToby Isaac for (p = pStart, countNodes = 0; p < pEnd; p++) { 15783f27d899SToby Isaac PetscDualSpace psp; 15793f27d899SToby Isaac PetscQuadrature intNodes; 15803f27d899SToby Isaac DM pdm; 15813f27d899SToby Isaac PetscInt pdim, pNk; 15823f27d899SToby Isaac PetscInt countNodesIn = countNodes; 15833f27d899SToby Isaac PetscReal detJ; 15843f27d899SToby Isaac Mat intMat; 15853f27d899SToby Isaac 15863f27d899SToby Isaac ierr = PetscDualSpaceGetPointSubspace(sp, p, &psp);CHKERRQ(ierr); 15873f27d899SToby Isaac if (!psp) continue; 15883f27d899SToby Isaac ierr = PetscDualSpaceGetDM(psp, &pdm);CHKERRQ(ierr); 15893f27d899SToby Isaac ierr = DMGetDimension(pdm, &pdim);CHKERRQ(ierr); 15903f27d899SToby Isaac if (pdim < PetscAbsInt(k)) continue; 15913f27d899SToby Isaac ierr = PetscDualSpaceGetInteriorData(psp, &intNodes, &intMat);CHKERRQ(ierr); 15923f27d899SToby Isaac if (intNodes == NULL && intMat == NULL) continue; 15933f27d899SToby Isaac ierr = PetscDTBinomialInt(pdim, PetscAbsInt(k), &pNk);CHKERRQ(ierr); 15943f27d899SToby Isaac if (p) { 15953f27d899SToby Isaac ierr = DMPlexComputeCellGeometryAffineFEM(dm, p, v0, J, Jinv, &detJ);CHKERRQ(ierr); 15963f27d899SToby Isaac } else { /* identity */ 15973f27d899SToby Isaac PetscInt i,j; 15983f27d899SToby Isaac 15993f27d899SToby Isaac for (i = 0; i < dim; i++) for (j = 0; j < dim; j++) J[i * dim + j] = Jinv[i * dim + j] = 0.; 16003f27d899SToby Isaac for (i = 0; i < dim; i++) J[i * dim + i] = Jinv[i * dim + i] = 1.; 16013f27d899SToby Isaac for (i = 0; i < dim; i++) v0[i] = -1.; 16023f27d899SToby Isaac } 16033f27d899SToby Isaac if (pdim != dim) { /* compactify Jacobian */ 16043f27d899SToby Isaac PetscInt i, j; 16053f27d899SToby Isaac 16063f27d899SToby Isaac for (i = 0; i < dim; i++) for (j = 0; j < pdim; j++) J[i * pdim + j] = J[i * dim + j]; 16073f27d899SToby Isaac } 16083f27d899SToby Isaac ierr = PetscDTAltVPullbackMatrix(pdim, dim, J, k, L);CHKERRQ(ierr); 160977f1a120SToby Isaac if (intNodes) { /* push forward quadrature locations by the affine transformation */ 16103f27d899SToby Isaac PetscInt nNodesp; 16113f27d899SToby Isaac const PetscReal *nodesp; 16123f27d899SToby Isaac PetscInt j; 16133f27d899SToby Isaac 16143f27d899SToby Isaac ierr = PetscQuadratureGetData(intNodes, NULL, NULL, &nNodesp, &nodesp, NULL);CHKERRQ(ierr); 16153f27d899SToby Isaac for (j = 0; j < nNodesp; j++, countNodes++) { 16163f27d899SToby Isaac PetscInt d, e; 16173f27d899SToby Isaac 16183f27d899SToby Isaac for (d = 0; d < dim; d++) { 16193f27d899SToby Isaac nodes[countNodes * dim + d] = v0[d]; 16203f27d899SToby Isaac for (e = 0; e < pdim; e++) { 16213f27d899SToby Isaac nodes[countNodes * dim + d] += J[d * pdim + e] * (nodesp[j * pdim + e] - pv0[e]); 16223f27d899SToby Isaac } 16233f27d899SToby Isaac } 16243f27d899SToby Isaac } 16253f27d899SToby Isaac } 16263f27d899SToby Isaac if (intMat) { 16273f27d899SToby Isaac PetscInt nrows; 16283f27d899SToby Isaac PetscInt off; 16293f27d899SToby Isaac 16303f27d899SToby Isaac ierr = PetscSectionGetDof(section, p, &nrows);CHKERRQ(ierr); 16313f27d899SToby Isaac ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr); 16323f27d899SToby Isaac for (j = 0; j < nrows; j++) { 16333f27d899SToby Isaac PetscInt ncols; 16343f27d899SToby Isaac const PetscInt *cols; 16353f27d899SToby Isaac const PetscScalar *vals; 16363f27d899SToby Isaac PetscInt l, d, e; 16373f27d899SToby Isaac PetscInt row = j + off; 16383f27d899SToby Isaac 16393f27d899SToby Isaac ierr = MatGetRow(intMat, j, &ncols, &cols, &vals);CHKERRQ(ierr); 16403f27d899SToby Isaac if (ncols % pNk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms"); 16413f27d899SToby Isaac for (l = 0; l < ncols / pNk; l++) { 16423f27d899SToby Isaac PetscInt blockcol; 16433f27d899SToby Isaac 16443f27d899SToby Isaac for (d = 0; d < pNk; d++) { 16453f27d899SToby Isaac if ((cols[l * pNk + d] % pNk) != d) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "interior matrix is not laid out as blocks of k-forms"); 16463f27d899SToby Isaac } 16473f27d899SToby Isaac blockcol = cols[l * pNk] / pNk; 16483f27d899SToby Isaac for (d = 0; d < Nk; d++) { 16493f27d899SToby Isaac iwork[l * Nk + d] = (blockcol + countNodesIn) * Nk + d; 16503f27d899SToby Isaac } 16513f27d899SToby Isaac for (d = 0; d < Nk; d++) work[l * Nk + d] = 0.; 16523f27d899SToby Isaac for (d = 0; d < Nk; d++) { 16533f27d899SToby Isaac for (e = 0; e < pNk; e++) { 16543f27d899SToby Isaac /* "push forward" dof by pulling back a k-form to be evaluated on the point: multiply on the right by L */ 16553f27d899SToby Isaac work[l * Nk + d] += vals[l * pNk + e] * L[e * pNk + d]; 16563f27d899SToby Isaac } 16573f27d899SToby Isaac } 16583f27d899SToby Isaac } 16593f27d899SToby Isaac ierr = MatSetValues(allMat, 1, &row, (ncols / pNk) * Nk, iwork, work, INSERT_VALUES);CHKERRQ(ierr); 16603f27d899SToby Isaac ierr = MatRestoreRow(intMat, j, &ncols, &cols, &vals);CHKERRQ(ierr); 16613f27d899SToby Isaac } 16623f27d899SToby Isaac } 16633f27d899SToby Isaac } 16643f27d899SToby Isaac ierr = MatAssemblyBegin(allMat, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 16653f27d899SToby Isaac ierr = MatAssemblyEnd(allMat, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 16663f27d899SToby Isaac ierr = PetscQuadratureCreate(PETSC_COMM_SELF, &allNodes);CHKERRQ(ierr); 16673f27d899SToby Isaac ierr = PetscQuadratureSetData(allNodes, dim, 0, nNodes, nodes, NULL);CHKERRQ(ierr); 16683f27d899SToby Isaac ierr = PetscFree7(v0, pv0, J, Jinv, L, work, iwork);CHKERRQ(ierr); 16693f27d899SToby Isaac ierr = MatDestroy(&(sp->allMat));CHKERRQ(ierr); 16703f27d899SToby Isaac sp->allMat = allMat; 16713f27d899SToby Isaac ierr = PetscQuadratureDestroy(&(sp->allNodes));CHKERRQ(ierr); 16723f27d899SToby Isaac sp->allNodes = allNodes; 16733f27d899SToby Isaac PetscFunctionReturn(0); 16743f27d899SToby Isaac } 16753f27d899SToby Isaac 167677f1a120SToby Isaac /* rather than trying to get all data from the functionals, we create 167777f1a120SToby Isaac * the functionals from rows of the quadrature -> dof matrix. 167877f1a120SToby Isaac * 167977f1a120SToby Isaac * Ideally most of the uses of PetscDualSpace in PetscFE will switch 168077f1a120SToby Isaac * to using intMat and allMat, so that the individual functionals 168177f1a120SToby Isaac * don't need to be constructed at all */ 16823f27d899SToby Isaac static PetscErrorCode PetscDualSpaceComputeFunctionalsFromAllData(PetscDualSpace sp) 16833f27d899SToby Isaac { 16843f27d899SToby Isaac PetscQuadrature allNodes; 16853f27d899SToby Isaac Mat allMat; 16863f27d899SToby Isaac PetscInt nDofs; 16873f27d899SToby Isaac PetscInt dim, k, Nk, Nc, f; 16883f27d899SToby Isaac DM dm; 16893f27d899SToby Isaac PetscInt nNodes, spdim; 16903f27d899SToby Isaac const PetscReal *nodes = NULL; 16913f27d899SToby Isaac PetscSection section; 1692*66a6c23cSMatthew G. Knepley PetscBool useMoments; 16933f27d899SToby Isaac PetscErrorCode ierr; 16943f27d899SToby Isaac 16953f27d899SToby Isaac PetscFunctionBegin; 16963f27d899SToby Isaac ierr = PetscDualSpaceGetDM(sp, &dm);CHKERRQ(ierr); 16973f27d899SToby Isaac ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 16983f27d899SToby Isaac ierr = PetscDualSpaceGetNumComponents(sp, &Nc);CHKERRQ(ierr); 16993f27d899SToby Isaac ierr = PetscDualSpaceGetFormDegree(sp, &k);CHKERRQ(ierr); 17003f27d899SToby Isaac ierr = PetscDTBinomialInt(dim, PetscAbsInt(k), &Nk);CHKERRQ(ierr); 17013f27d899SToby Isaac ierr = PetscDualSpaceGetAllData(sp, &allNodes, &allMat);CHKERRQ(ierr); 17023f27d899SToby Isaac nNodes = 0; 17033f27d899SToby Isaac if (allNodes) { 17043f27d899SToby Isaac ierr = PetscQuadratureGetData(allNodes, NULL, NULL, &nNodes, &nodes, NULL);CHKERRQ(ierr); 17053f27d899SToby Isaac } 17063f27d899SToby Isaac ierr = MatGetSize(allMat, &nDofs, NULL);CHKERRQ(ierr); 17073f27d899SToby Isaac ierr = PetscDualSpaceGetSection(sp, §ion);CHKERRQ(ierr); 17083f27d899SToby Isaac ierr = PetscSectionGetStorageSize(section, &spdim);CHKERRQ(ierr); 17093f27d899SToby Isaac if (spdim != nDofs) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "incompatible all matrix size"); 17103f27d899SToby Isaac ierr = PetscMalloc1(nDofs, &(sp->functional));CHKERRQ(ierr); 1711*66a6c23cSMatthew G. Knepley ierr = PetscDualSpaceLagrangeGetUseMoments(sp, &useMoments);CHKERRQ(ierr); 1712*66a6c23cSMatthew G. Knepley if (useMoments) { 1713*66a6c23cSMatthew G. Knepley Mat allMat; 1714*66a6c23cSMatthew G. Knepley PetscInt momentOrder, i; 1715*66a6c23cSMatthew G. Knepley PetscBool tensor; 1716*66a6c23cSMatthew G. Knepley const PetscReal *weights; 1717*66a6c23cSMatthew G. Knepley PetscScalar *array; 1718*66a6c23cSMatthew G. Knepley 1719*66a6c23cSMatthew G. Knepley if (nDofs != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "We do not yet support moments beyond P0, nDofs == %D", nDofs); 1720*66a6c23cSMatthew G. Knepley ierr = PetscDualSpaceLagrangeGetMomentOrder(sp, &momentOrder);CHKERRQ(ierr); 1721*66a6c23cSMatthew G. Knepley ierr = PetscDualSpaceLagrangeGetTensor(sp, &tensor);CHKERRQ(ierr); 1722*66a6c23cSMatthew G. Knepley if (!tensor) {ierr = PetscDTStroudConicalQuadrature(dim, Nc, PetscMax(momentOrder + 1,1), -1.0, 1.0, &(sp->functional[0]));CHKERRQ(ierr);} 1723*66a6c23cSMatthew G. Knepley else {ierr = PetscDTGaussTensorQuadrature(dim, Nc, PetscMax(momentOrder + 1,1), -1.0, 1.0, &(sp->functional[0]));CHKERRQ(ierr);} 1724*66a6c23cSMatthew G. Knepley /* Need to replace allNodes and allMat */ 1725*66a6c23cSMatthew G. Knepley ierr = PetscObjectReference((PetscObject) sp->functional[0]);CHKERRQ(ierr); 1726*66a6c23cSMatthew G. Knepley ierr = PetscQuadratureDestroy(&(sp->allNodes));CHKERRQ(ierr); 1727*66a6c23cSMatthew G. Knepley sp->allNodes = sp->functional[0]; 1728*66a6c23cSMatthew G. Knepley ierr = PetscQuadratureGetData(sp->allNodes, NULL, NULL, &nNodes, NULL, &weights);CHKERRQ(ierr); 1729*66a6c23cSMatthew G. Knepley ierr = MatCreateSeqDense(PETSC_COMM_SELF, nDofs, nNodes * Nc, NULL, &allMat);CHKERRQ(ierr); 1730*66a6c23cSMatthew G. Knepley ierr = MatDenseGetArrayWrite(allMat, &array);CHKERRQ(ierr); 1731*66a6c23cSMatthew G. Knepley for (i = 0; i < nNodes * Nc; ++i) array[i] = weights[i]; 1732*66a6c23cSMatthew G. Knepley ierr = MatDenseRestoreArrayWrite(allMat, &array);CHKERRQ(ierr); 1733*66a6c23cSMatthew G. Knepley ierr = MatAssemblyBegin(allMat, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1734*66a6c23cSMatthew G. Knepley ierr = MatAssemblyEnd(allMat, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1735*66a6c23cSMatthew G. Knepley ierr = MatDestroy(&(sp->allMat));CHKERRQ(ierr); 1736*66a6c23cSMatthew G. Knepley sp->allMat = allMat; 1737*66a6c23cSMatthew G. Knepley PetscFunctionReturn(0); 1738*66a6c23cSMatthew G. Knepley } 17393f27d899SToby Isaac for (f = 0; f < nDofs; f++) { 17403f27d899SToby Isaac PetscInt ncols, c; 17413f27d899SToby Isaac const PetscInt *cols; 17423f27d899SToby Isaac const PetscScalar *vals; 17433f27d899SToby Isaac PetscReal *nodesf; 17443f27d899SToby Isaac PetscReal *weightsf; 17453f27d899SToby Isaac PetscInt nNodesf; 17463f27d899SToby Isaac PetscInt countNodes; 17473f27d899SToby Isaac 17483f27d899SToby Isaac ierr = MatGetRow(allMat, f, &ncols, &cols, &vals);CHKERRQ(ierr); 17493f27d899SToby Isaac if (ncols % Nk) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "all matrix is not laid out as blocks of k-forms"); 17503f27d899SToby Isaac for (c = 1, nNodesf = 1; c < ncols; c++) { 17513f27d899SToby Isaac if ((cols[c] / Nc) != (cols[c-1] / Nc)) nNodesf++; 17523f27d899SToby Isaac } 17533f27d899SToby Isaac ierr = PetscMalloc1(dim * nNodesf, &nodesf);CHKERRQ(ierr); 17543f27d899SToby Isaac ierr = PetscMalloc1(Nc * nNodesf, &weightsf);CHKERRQ(ierr); 17553f27d899SToby Isaac for (c = 0, countNodes = 0; c < ncols; c++) { 17563f27d899SToby Isaac if (!c || ((cols[c] / Nc) != (cols[c-1] / Nc))) { 17573f27d899SToby Isaac PetscInt d; 17583f27d899SToby Isaac 17593f27d899SToby Isaac for (d = 0; d < Nc; d++) { 17603f27d899SToby Isaac weightsf[countNodes * Nc + d] = 0.; 17613f27d899SToby Isaac } 17623f27d899SToby Isaac for (d = 0; d < dim; d++) { 17633f27d899SToby Isaac nodesf[countNodes * dim + d] = nodes[(cols[c] / Nc) * dim + d]; 17643f27d899SToby Isaac } 17653f27d899SToby Isaac countNodes++; 17663f27d899SToby Isaac } 17673f27d899SToby Isaac weightsf[(countNodes - 1) * Nc + (cols[c] % Nc)] = PetscRealPart(vals[c]); 17683f27d899SToby Isaac } 17693f27d899SToby Isaac ierr = PetscQuadratureCreate(PETSC_COMM_SELF, &(sp->functional[f]));CHKERRQ(ierr); 17703f27d899SToby Isaac ierr = PetscQuadratureSetData(sp->functional[f], dim, Nc, nNodesf, nodesf, weightsf);CHKERRQ(ierr); 17713f27d899SToby Isaac ierr = MatRestoreRow(allMat, f, &ncols, &cols, &vals);CHKERRQ(ierr); 17723f27d899SToby Isaac } 17733f27d899SToby Isaac PetscFunctionReturn(0); 17743f27d899SToby Isaac } 17753f27d899SToby Isaac 17763f27d899SToby Isaac /* take a matrix meant for k-forms and expand it to one for Ncopies */ 17773f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeMatrixCreateCopies(Mat A, PetscInt Nk, PetscInt Ncopies, Mat *Abs) 17783f27d899SToby Isaac { 17793f27d899SToby Isaac PetscInt m, n, i, j, k; 17803f27d899SToby Isaac PetscInt maxnnz, *nnz, *iwork; 17813f27d899SToby Isaac Mat Ac; 17823f27d899SToby Isaac PetscErrorCode ierr; 17833f27d899SToby Isaac 17843f27d899SToby Isaac PetscFunctionBegin; 17853f27d899SToby Isaac ierr = MatGetSize(A, &m, &n);CHKERRQ(ierr); 17863f27d899SToby Isaac if (n % Nk) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of columns in A %D is not a multiple of Nk %D", n, Nk); 17873f27d899SToby Isaac ierr = PetscMalloc1(m * Ncopies, &nnz);CHKERRQ(ierr); 17883f27d899SToby Isaac for (i = 0, maxnnz = 0; i < m; i++) { 17893f27d899SToby Isaac PetscInt innz; 17903f27d899SToby Isaac ierr = MatGetRow(A, i, &innz, NULL, NULL);CHKERRQ(ierr); 17913f27d899SToby Isaac if (innz % Nk) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "A row %D nnzs is not a multiple of Nk %D", innz, Nk); 17923f27d899SToby Isaac for (j = 0; j < Ncopies; j++) nnz[i * Ncopies + j] = innz; 17933f27d899SToby Isaac maxnnz = PetscMax(maxnnz, innz); 17943f27d899SToby Isaac } 17953f27d899SToby Isaac ierr = MatCreateSeqAIJ(PETSC_COMM_SELF, m * Ncopies, n * Ncopies, 0, nnz, &Ac);CHKERRQ(ierr); 17963f27d899SToby Isaac ierr = MatSetOption(Ac, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr); 17973f27d899SToby Isaac ierr = PetscFree(nnz);CHKERRQ(ierr); 17983f27d899SToby Isaac ierr = PetscMalloc1(maxnnz, &iwork);CHKERRQ(ierr); 17993f27d899SToby Isaac for (i = 0; i < m; i++) { 18003f27d899SToby Isaac PetscInt innz; 18013f27d899SToby Isaac const PetscInt *cols; 18023f27d899SToby Isaac const PetscScalar *vals; 18033f27d899SToby Isaac 18043f27d899SToby Isaac ierr = MatGetRow(A, i, &innz, &cols, &vals);CHKERRQ(ierr); 18053f27d899SToby Isaac for (j = 0; j < innz; j++) iwork[j] = (cols[j] / Nk) * (Nk * Ncopies) + (cols[j] % Nk); 18063f27d899SToby Isaac for (j = 0; j < Ncopies; j++) { 18073f27d899SToby Isaac PetscInt row = i * Ncopies + j; 18083f27d899SToby Isaac 18093f27d899SToby Isaac ierr = MatSetValues(Ac, 1, &row, innz, iwork, vals, INSERT_VALUES);CHKERRQ(ierr); 18103f27d899SToby Isaac for (k = 0; k < innz; k++) iwork[k] += Nk; 18113f27d899SToby Isaac } 18123f27d899SToby Isaac ierr = MatRestoreRow(A, i, &innz, &cols, &vals);CHKERRQ(ierr); 18133f27d899SToby Isaac } 18143f27d899SToby Isaac ierr = PetscFree(iwork);CHKERRQ(ierr); 18153f27d899SToby Isaac ierr = MatAssemblyBegin(Ac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 18163f27d899SToby Isaac ierr = MatAssemblyEnd(Ac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 18173f27d899SToby Isaac *Abs = Ac; 18183f27d899SToby Isaac PetscFunctionReturn(0); 18193f27d899SToby Isaac } 18203f27d899SToby Isaac 182177f1a120SToby Isaac /* check if a cell is a tensor product of the segment with a facet, 182277f1a120SToby Isaac * specifically checking if f and f2 can be the "endpoints" (like the triangles 182377f1a120SToby Isaac * at either end of a wedge) */ 18243f27d899SToby Isaac static PetscErrorCode DMPlexPointIsTensor_Internal_Given(DM dm, PetscInt p, PetscInt f, PetscInt f2, PetscBool *isTensor) 18253f27d899SToby Isaac { 18263f27d899SToby Isaac PetscInt coneSize, c; 18273f27d899SToby Isaac const PetscInt *cone; 18283f27d899SToby Isaac const PetscInt *fCone; 18293f27d899SToby Isaac const PetscInt *f2Cone; 18303f27d899SToby Isaac PetscInt fs[2]; 18313f27d899SToby Isaac PetscInt meetSize, nmeet; 18323f27d899SToby Isaac const PetscInt *meet; 18333f27d899SToby Isaac PetscErrorCode ierr; 18343f27d899SToby Isaac 18353f27d899SToby Isaac PetscFunctionBegin; 18363f27d899SToby Isaac fs[0] = f; 18373f27d899SToby Isaac fs[1] = f2; 18383f27d899SToby Isaac ierr = DMPlexGetMeet(dm, 2, fs, &meetSize, &meet);CHKERRQ(ierr); 18393f27d899SToby Isaac nmeet = meetSize; 18403f27d899SToby Isaac ierr = DMPlexRestoreMeet(dm, 2, fs, &meetSize, &meet);CHKERRQ(ierr); 184177f1a120SToby Isaac /* two points that have a non-empty meet cannot be at opposite ends of a cell */ 18423f27d899SToby Isaac if (nmeet) { 18433f27d899SToby Isaac *isTensor = PETSC_FALSE; 18443f27d899SToby Isaac PetscFunctionReturn(0); 18453f27d899SToby Isaac } 18463f27d899SToby Isaac ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr); 18473f27d899SToby Isaac ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr); 18483f27d899SToby Isaac ierr = DMPlexGetCone(dm, f, &fCone);CHKERRQ(ierr); 18493f27d899SToby Isaac ierr = DMPlexGetCone(dm, f2, &f2Cone);CHKERRQ(ierr); 18503f27d899SToby Isaac for (c = 0; c < coneSize; c++) { 18513f27d899SToby Isaac PetscInt e, ef; 18523f27d899SToby Isaac PetscInt d = -1, d2 = -1; 18533f27d899SToby Isaac PetscInt dcount, d2count; 18543f27d899SToby Isaac PetscInt t = cone[c]; 18553f27d899SToby Isaac PetscInt tConeSize; 18563f27d899SToby Isaac PetscBool tIsTensor; 18573f27d899SToby Isaac const PetscInt *tCone; 18583f27d899SToby Isaac 18593f27d899SToby Isaac if (t == f || t == f2) continue; 186077f1a120SToby Isaac /* for every other facet in the cone, check that is has 186177f1a120SToby Isaac * one ridge in common with each end */ 18623f27d899SToby Isaac ierr = DMPlexGetConeSize(dm, t, &tConeSize);CHKERRQ(ierr); 18633f27d899SToby Isaac ierr = DMPlexGetCone(dm, t, &tCone);CHKERRQ(ierr); 18643f27d899SToby Isaac 18653f27d899SToby Isaac dcount = 0; 18663f27d899SToby Isaac d2count = 0; 18673f27d899SToby Isaac for (e = 0; e < tConeSize; e++) { 18683f27d899SToby Isaac PetscInt q = tCone[e]; 18693f27d899SToby Isaac for (ef = 0; ef < coneSize - 2; ef++) { 18703f27d899SToby Isaac if (fCone[ef] == q) { 18713f27d899SToby Isaac if (dcount) { 18723f27d899SToby Isaac *isTensor = PETSC_FALSE; 18733f27d899SToby Isaac PetscFunctionReturn(0); 18743f27d899SToby Isaac } 18753f27d899SToby Isaac d = q; 18763f27d899SToby Isaac dcount++; 18773f27d899SToby Isaac } else if (f2Cone[ef] == q) { 18783f27d899SToby Isaac if (d2count) { 18793f27d899SToby Isaac *isTensor = PETSC_FALSE; 18803f27d899SToby Isaac PetscFunctionReturn(0); 18813f27d899SToby Isaac } 18823f27d899SToby Isaac d2 = q; 18833f27d899SToby Isaac d2count++; 18843f27d899SToby Isaac } 18853f27d899SToby Isaac } 18863f27d899SToby Isaac } 188777f1a120SToby Isaac /* if the whole cell is a tensor with the segment, then this 188877f1a120SToby Isaac * facet should be a tensor with the segment */ 18893f27d899SToby Isaac ierr = DMPlexPointIsTensor_Internal_Given(dm, t, d, d2, &tIsTensor);CHKERRQ(ierr); 18903f27d899SToby Isaac if (!tIsTensor) { 18913f27d899SToby Isaac *isTensor = PETSC_FALSE; 18923f27d899SToby Isaac PetscFunctionReturn(0); 18933f27d899SToby Isaac } 18943f27d899SToby Isaac } 18953f27d899SToby Isaac *isTensor = PETSC_TRUE; 18963f27d899SToby Isaac PetscFunctionReturn(0); 18973f27d899SToby Isaac } 18983f27d899SToby Isaac 189977f1a120SToby Isaac /* determine if a cell is a tensor with a segment by looping over pairs of facets to find a pair 190077f1a120SToby Isaac * that could be the opposite ends */ 19013f27d899SToby Isaac static PetscErrorCode DMPlexPointIsTensor_Internal(DM dm, PetscInt p, PetscBool *isTensor, PetscInt *endA, PetscInt *endB) 19023f27d899SToby Isaac { 19033f27d899SToby Isaac PetscInt coneSize, c, c2; 19043f27d899SToby Isaac const PetscInt *cone; 19053f27d899SToby Isaac PetscErrorCode ierr; 19063f27d899SToby Isaac 19073f27d899SToby Isaac PetscFunctionBegin; 19083f27d899SToby Isaac ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr); 19093f27d899SToby Isaac if (!coneSize) { 19103f27d899SToby Isaac if (isTensor) *isTensor = PETSC_FALSE; 19113f27d899SToby Isaac if (endA) *endA = -1; 19123f27d899SToby Isaac if (endB) *endB = -1; 19133f27d899SToby Isaac } 19143f27d899SToby Isaac ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr); 19153f27d899SToby Isaac for (c = 0; c < coneSize; c++) { 19163f27d899SToby Isaac PetscInt f = cone[c]; 19173f27d899SToby Isaac PetscInt fConeSize; 19183f27d899SToby Isaac 19193f27d899SToby Isaac ierr = DMPlexGetConeSize(dm, f, &fConeSize);CHKERRQ(ierr); 19203f27d899SToby Isaac if (fConeSize != coneSize - 2) continue; 19213f27d899SToby Isaac 19223f27d899SToby Isaac for (c2 = c + 1; c2 < coneSize; c2++) { 19233f27d899SToby Isaac PetscInt f2 = cone[c2]; 19243f27d899SToby Isaac PetscBool isTensorff2; 19253f27d899SToby Isaac PetscInt f2ConeSize; 19263f27d899SToby Isaac 19273f27d899SToby Isaac ierr = DMPlexGetConeSize(dm, f2, &f2ConeSize);CHKERRQ(ierr); 19283f27d899SToby Isaac if (f2ConeSize != coneSize - 2) continue; 19293f27d899SToby Isaac 19303f27d899SToby Isaac ierr = DMPlexPointIsTensor_Internal_Given(dm, p, f, f2, &isTensorff2);CHKERRQ(ierr); 19313f27d899SToby Isaac if (isTensorff2) { 19323f27d899SToby Isaac if (isTensor) *isTensor = PETSC_TRUE; 19333f27d899SToby Isaac if (endA) *endA = f; 19343f27d899SToby Isaac if (endB) *endB = f2; 19353f27d899SToby Isaac PetscFunctionReturn(0); 19363f27d899SToby Isaac } 19373f27d899SToby Isaac } 19383f27d899SToby Isaac } 19393f27d899SToby Isaac if (isTensor) *isTensor = PETSC_FALSE; 19403f27d899SToby Isaac if (endA) *endA = -1; 19413f27d899SToby Isaac if (endB) *endB = -1; 19423f27d899SToby Isaac PetscFunctionReturn(0); 19433f27d899SToby Isaac } 19443f27d899SToby Isaac 194577f1a120SToby Isaac /* determine if a cell is a tensor with a segment by looping over pairs of facets to find a pair 194677f1a120SToby Isaac * that could be the opposite ends */ 19473f27d899SToby Isaac static PetscErrorCode DMPlexPointIsTensor(DM dm, PetscInt p, PetscBool *isTensor, PetscInt *endA, PetscInt *endB) 19483f27d899SToby Isaac { 19493f27d899SToby Isaac DMPlexInterpolatedFlag interpolated; 19503f27d899SToby Isaac PetscErrorCode ierr; 19513f27d899SToby Isaac 19523f27d899SToby Isaac PetscFunctionBegin; 19533f27d899SToby Isaac ierr = DMPlexIsInterpolated(dm, &interpolated);CHKERRQ(ierr); 19543f27d899SToby Isaac if (interpolated != DMPLEX_INTERPOLATED_FULL) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONGSTATE, "Only for interpolated DMPlex's"); 19553f27d899SToby Isaac ierr = DMPlexPointIsTensor_Internal(dm, p, isTensor, endA, endB);CHKERRQ(ierr); 19563f27d899SToby Isaac PetscFunctionReturn(0); 19573f27d899SToby Isaac } 19583f27d899SToby Isaac 195977f1a120SToby Isaac /* permute a quadrature -> dof matrix so that its rows are in revlex order by nodeIdx */ 19603f27d899SToby Isaac static PetscErrorCode MatPermuteByNodeIdx(Mat A, PetscLagNodeIndices ni, Mat *Aperm) 19613f27d899SToby Isaac { 19623f27d899SToby Isaac PetscInt m, n, i, j; 19633f27d899SToby Isaac PetscInt nodeIdxDim = ni->nodeIdxDim; 19643f27d899SToby Isaac PetscInt nodeVecDim = ni->nodeVecDim; 19653f27d899SToby Isaac PetscInt *perm; 19663f27d899SToby Isaac IS permIS; 19673f27d899SToby Isaac IS id; 19683f27d899SToby Isaac PetscInt *nIdxPerm; 19693f27d899SToby Isaac PetscReal *nVecPerm; 19703f27d899SToby Isaac PetscErrorCode ierr; 19713f27d899SToby Isaac 19723f27d899SToby Isaac PetscFunctionBegin; 19733f27d899SToby Isaac ierr = PetscLagNodeIndicesGetPermutation(ni, &perm);CHKERRQ(ierr); 19743f27d899SToby Isaac ierr = MatGetSize(A, &m, &n);CHKERRQ(ierr); 19753f27d899SToby Isaac ierr = PetscMalloc1(nodeIdxDim * m, &nIdxPerm);CHKERRQ(ierr); 19763f27d899SToby Isaac ierr = PetscMalloc1(nodeVecDim * m, &nVecPerm);CHKERRQ(ierr); 19773f27d899SToby Isaac for (i = 0; i < m; i++) for (j = 0; j < nodeIdxDim; j++) nIdxPerm[i * nodeIdxDim + j] = ni->nodeIdx[perm[i] * nodeIdxDim + j]; 19783f27d899SToby Isaac for (i = 0; i < m; i++) for (j = 0; j < nodeVecDim; j++) nVecPerm[i * nodeVecDim + j] = ni->nodeVec[perm[i] * nodeVecDim + j]; 19793f27d899SToby Isaac ierr = ISCreateGeneral(PETSC_COMM_SELF, m, perm, PETSC_USE_POINTER, &permIS);CHKERRQ(ierr); 19803f27d899SToby Isaac ierr = ISSetPermutation(permIS);CHKERRQ(ierr); 19813f27d899SToby Isaac ierr = ISCreateStride(PETSC_COMM_SELF, n, 0, 1, &id);CHKERRQ(ierr); 19823f27d899SToby Isaac ierr = ISSetPermutation(id);CHKERRQ(ierr); 19833f27d899SToby Isaac ierr = MatPermute(A, permIS, id, Aperm);CHKERRQ(ierr); 19843f27d899SToby Isaac ierr = ISDestroy(&permIS);CHKERRQ(ierr); 19853f27d899SToby Isaac ierr = ISDestroy(&id);CHKERRQ(ierr); 19863f27d899SToby Isaac for (i = 0; i < m; i++) perm[i] = i; 19873f27d899SToby Isaac ierr = PetscFree(ni->nodeIdx);CHKERRQ(ierr); 19883f27d899SToby Isaac ierr = PetscFree(ni->nodeVec);CHKERRQ(ierr); 19893f27d899SToby Isaac ni->nodeIdx = nIdxPerm; 19903f27d899SToby Isaac ni->nodeVec = nVecPerm; 19916f905325SMatthew G. Knepley PetscFunctionReturn(0); 19926f905325SMatthew G. Knepley } 19936f905325SMatthew G. Knepley 19946f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp) 19956f905325SMatthew G. Knepley { 19966f905325SMatthew G. Knepley PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data; 19976f905325SMatthew G. Knepley DM dm = sp->dm; 19983f27d899SToby Isaac DM dmint = NULL; 19993f27d899SToby Isaac PetscInt order; 20006f905325SMatthew G. Knepley PetscInt Nc = sp->Nc; 20016f905325SMatthew G. Knepley MPI_Comm comm; 20026f905325SMatthew G. Knepley PetscBool continuous; 20033f27d899SToby Isaac PetscSection section; 20043f27d899SToby Isaac PetscInt depth, dim, pStart, pEnd, cStart, cEnd, p, *pStratStart, *pStratEnd, d; 20053f27d899SToby Isaac PetscInt formDegree, Nk, Ncopies; 20063f27d899SToby Isaac PetscInt tensorf = -1, tensorf2 = -1; 20073f27d899SToby Isaac PetscBool tensorCell, tensorSpace; 20083f27d899SToby Isaac PetscBool uniform, trimmed; 20093f27d899SToby Isaac Petsc1DNodeFamily nodeFamily; 20103f27d899SToby Isaac PetscInt numNodeSkip; 20113f27d899SToby Isaac DMPlexInterpolatedFlag interpolated; 20123f27d899SToby Isaac PetscBool isbdm; 20136f905325SMatthew G. Knepley PetscErrorCode ierr; 20146f905325SMatthew G. Knepley 20156f905325SMatthew G. Knepley PetscFunctionBegin; 20163f27d899SToby Isaac /* step 1: sanitize input */ 20176f905325SMatthew G. Knepley ierr = PetscObjectGetComm((PetscObject) sp, &comm);CHKERRQ(ierr); 20186f905325SMatthew G. Knepley ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); 2019efac50ffSToby Isaac ierr = PetscObjectTypeCompare((PetscObject)sp, PETSCDUALSPACEBDM, &isbdm);CHKERRQ(ierr); 20203f27d899SToby Isaac if (isbdm) { 20213f27d899SToby Isaac sp->k = -(dim-1); /* form degree of H-div */ 20223f27d899SToby Isaac ierr = PetscObjectChangeTypeName((PetscObject)sp, PETSCDUALSPACELAGRANGE);CHKERRQ(ierr); 20233f27d899SToby Isaac } 20243f27d899SToby Isaac ierr = PetscDualSpaceGetFormDegree(sp, &formDegree);CHKERRQ(ierr); 20253f27d899SToby Isaac if (PetscAbsInt(formDegree) > dim) SETERRQ(comm, PETSC_ERR_ARG_OUTOFRANGE, "Form degree must be bounded by dimension"); 20263f27d899SToby Isaac ierr = PetscDTBinomialInt(dim,PetscAbsInt(formDegree),&Nk);CHKERRQ(ierr); 20273f27d899SToby Isaac if (sp->Nc <= 0 && lag->numCopies > 0) sp->Nc = Nk * lag->numCopies; 20283f27d899SToby Isaac Nc = sp->Nc; 20293f27d899SToby Isaac if (Nc % Nk) SETERRQ(comm, PETSC_ERR_ARG_INCOMP, "Number of components is not a multiple of form degree size"); 20303f27d899SToby Isaac if (lag->numCopies <= 0) lag->numCopies = Nc / Nk; 20313f27d899SToby Isaac Ncopies = lag->numCopies; 20323f27d899SToby Isaac if (Nc / Nk != Ncopies) SETERRQ(comm, PETSC_ERR_ARG_INCOMP, "Number of copies * (dim choose k) != Nc"); 20333f27d899SToby Isaac if (!dim) sp->order = 0; 20343f27d899SToby Isaac order = sp->order; 20353f27d899SToby Isaac uniform = sp->uniform; 20363f27d899SToby Isaac if (!uniform) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Variable order not supported yet"); 20373f27d899SToby Isaac if (lag->trimmed && !formDegree) lag->trimmed = PETSC_FALSE; /* trimmed spaces are the same as full spaces for 0-forms */ 20383f27d899SToby Isaac if (lag->nodeType == PETSCDTNODES_DEFAULT) { 20393f27d899SToby Isaac lag->nodeType = PETSCDTNODES_GAUSSJACOBI; 20403f27d899SToby Isaac lag->nodeExponent = 0.; 20413f27d899SToby Isaac /* trimmed spaces don't include corner vertices, so don't use end nodes by default */ 20423f27d899SToby Isaac lag->endNodes = lag->trimmed ? PETSC_FALSE : PETSC_TRUE; 20433f27d899SToby Isaac } 20443f27d899SToby Isaac /* If a trimmed space and the user did choose nodes with endpoints, skip them by default */ 20453f27d899SToby Isaac if (lag->numNodeSkip < 0) lag->numNodeSkip = (lag->trimmed && lag->endNodes) ? 1 : 0; 20463f27d899SToby Isaac numNodeSkip = lag->numNodeSkip; 20473f27d899SToby Isaac if (lag->trimmed && !order) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Cannot have zeroth order trimmed elements"); 20483f27d899SToby Isaac if (lag->trimmed && PetscAbsInt(formDegree) == dim) { /* convert trimmed n-forms to untrimmed of one polynomial order less */ 20493f27d899SToby Isaac sp->order--; 20503f27d899SToby Isaac order--; 20513f27d899SToby Isaac lag->trimmed = PETSC_FALSE; 20523f27d899SToby Isaac } 20533f27d899SToby Isaac trimmed = lag->trimmed; 20543f27d899SToby Isaac if (!order || PetscAbsInt(formDegree) == dim) lag->continuous = PETSC_FALSE; 20553f27d899SToby Isaac continuous = lag->continuous; 20566f905325SMatthew G. Knepley ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr); 20576f905325SMatthew G. Knepley ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr); 20583f27d899SToby Isaac ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); 20593f27d899SToby Isaac if (pStart != 0 || cStart != 0) SETERRQ(PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_WRONGSTATE, "Expect DM with chart starting at zero and cells first"); 20603f27d899SToby Isaac if (cEnd != 1) SETERRQ(PetscObjectComm((PetscObject)sp), PETSC_ERR_ARG_WRONGSTATE, "Use PETSCDUALSPACEREFINED for multi-cell reference meshes"); 20613f27d899SToby Isaac ierr = DMPlexIsInterpolated(dm, &interpolated);CHKERRQ(ierr); 20623f27d899SToby Isaac if (interpolated != DMPLEX_INTERPOLATED_FULL) { 20633f27d899SToby Isaac ierr = DMPlexInterpolate(dm, &dmint);CHKERRQ(ierr); 20643f27d899SToby Isaac } else { 20653f27d899SToby Isaac ierr = PetscObjectReference((PetscObject)dm);CHKERRQ(ierr); 20663f27d899SToby Isaac dmint = dm; 20673f27d899SToby Isaac } 20683f27d899SToby Isaac tensorCell = PETSC_FALSE; 20693f27d899SToby Isaac if (dim > 1) { 20703f27d899SToby Isaac ierr = DMPlexPointIsTensor(dmint, 0, &tensorCell, &tensorf, &tensorf2);CHKERRQ(ierr); 20713f27d899SToby Isaac } 20723f27d899SToby Isaac lag->tensorCell = tensorCell; 20733f27d899SToby Isaac if (dim < 2 || !lag->tensorCell) lag->tensorSpace = PETSC_FALSE; 20746f905325SMatthew G. Knepley tensorSpace = lag->tensorSpace; 20753f27d899SToby Isaac if (!lag->nodeFamily) { 20763f27d899SToby Isaac ierr = Petsc1DNodeFamilyCreate(lag->nodeType, lag->nodeExponent, lag->endNodes, &lag->nodeFamily);CHKERRQ(ierr); 20773f27d899SToby Isaac } 20783f27d899SToby Isaac nodeFamily = lag->nodeFamily; 20793f27d899SToby Isaac if (interpolated != DMPLEX_INTERPOLATED_FULL && continuous && (PetscAbsInt(formDegree) > 0 || order > 1)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Reference element won't support all boundary nodes"); 208020cf1dd8SToby Isaac 20813f27d899SToby Isaac /* step 2: construct the boundary spaces */ 20823f27d899SToby Isaac ierr = PetscMalloc2(depth+1,&pStratStart,depth+1,&pStratEnd);CHKERRQ(ierr); 20833f27d899SToby Isaac ierr = PetscCalloc1(pEnd,&(sp->pointSpaces));CHKERRQ(ierr); 20843f27d899SToby Isaac for (d = 0; d <= depth; ++d) {ierr = DMPlexGetDepthStratum(dm, d, &pStratStart[d], &pStratEnd[d]);CHKERRQ(ierr);} 20853f27d899SToby Isaac ierr = PetscDualSpaceSectionCreate_Internal(sp, §ion);CHKERRQ(ierr); 20863f27d899SToby Isaac sp->pointSection = section; 20873f27d899SToby Isaac if (continuous && !(lag->interiorOnly)) { 20883f27d899SToby Isaac PetscInt h; 20896f905325SMatthew G. Knepley 20903f27d899SToby Isaac for (p = pStratStart[depth - 1]; p < pStratEnd[depth - 1]; p++) { /* calculate the facet dual spaces */ 20913f27d899SToby Isaac PetscReal v0[3]; 20923f27d899SToby Isaac DMPolytopeType ptype; 20933f27d899SToby Isaac PetscReal J[9], detJ; 20946f905325SMatthew G. Knepley PetscInt q; 20956f905325SMatthew G. Knepley 20963f27d899SToby Isaac ierr = DMPlexComputeCellGeometryAffineFEM(dm, p, v0, J, NULL, &detJ);CHKERRQ(ierr); 20973f27d899SToby Isaac ierr = DMPlexGetCellType(dm, p, &ptype);CHKERRQ(ierr); 20986f905325SMatthew G. Knepley 209977f1a120SToby Isaac /* compare to previous facets: if computed, reference that dualspace */ 21003f27d899SToby Isaac for (q = pStratStart[depth - 1]; q < p; q++) { 21013f27d899SToby Isaac DMPolytopeType qtype; 21026f905325SMatthew G. Knepley 21033f27d899SToby Isaac ierr = DMPlexGetCellType(dm, q, &qtype);CHKERRQ(ierr); 21043f27d899SToby Isaac if (qtype == ptype) break; 21056f905325SMatthew G. Knepley } 21063f27d899SToby Isaac if (q < p) { /* this facet has the same dual space as that one */ 21073f27d899SToby Isaac ierr = PetscObjectReference((PetscObject)sp->pointSpaces[q]);CHKERRQ(ierr); 21083f27d899SToby Isaac sp->pointSpaces[p] = sp->pointSpaces[q]; 21093f27d899SToby Isaac continue; 21106f905325SMatthew G. Knepley } 21113f27d899SToby Isaac /* if not, recursively compute this dual space */ 21123f27d899SToby Isaac ierr = PetscDualSpaceCreateFacetSubspace_Lagrange(sp,NULL,p,formDegree,Ncopies,PETSC_FALSE,&sp->pointSpaces[p]);CHKERRQ(ierr); 21136f905325SMatthew G. Knepley } 21143f27d899SToby Isaac for (h = 2; h <= depth; h++) { /* get the higher subspaces from the facet subspaces */ 21153f27d899SToby Isaac PetscInt hd = depth - h; 21163f27d899SToby Isaac PetscInt hdim = dim - h; 21176f905325SMatthew G. Knepley 21183f27d899SToby Isaac if (hdim < PetscAbsInt(formDegree)) break; 21193f27d899SToby Isaac for (p = pStratStart[hd]; p < pStratEnd[hd]; p++) { 21203f27d899SToby Isaac PetscInt suppSize, s; 21213f27d899SToby Isaac const PetscInt *supp; 21226f905325SMatthew G. Knepley 21233f27d899SToby Isaac ierr = DMPlexGetSupportSize(dm, p, &suppSize);CHKERRQ(ierr); 21243f27d899SToby Isaac ierr = DMPlexGetSupport(dm, p, &supp);CHKERRQ(ierr); 21253f27d899SToby Isaac for (s = 0; s < suppSize; s++) { 21263f27d899SToby Isaac DM qdm; 21273f27d899SToby Isaac PetscDualSpace qsp, psp; 21283f27d899SToby Isaac PetscInt c, coneSize, q; 21293f27d899SToby Isaac const PetscInt *cone; 21303f27d899SToby Isaac const PetscInt *refCone; 21316f905325SMatthew G. Knepley 21323f27d899SToby Isaac q = supp[0]; 21333f27d899SToby Isaac qsp = sp->pointSpaces[q]; 21343f27d899SToby Isaac ierr = DMPlexGetConeSize(dm, q, &coneSize);CHKERRQ(ierr); 21353f27d899SToby Isaac ierr = DMPlexGetCone(dm, q, &cone);CHKERRQ(ierr); 21363f27d899SToby Isaac for (c = 0; c < coneSize; c++) if (cone[c] == p) break; 21372479783cSJose E. Roman if (c == coneSize) SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_PLIB, "cone/support mismatch"); 21383f27d899SToby Isaac ierr = PetscDualSpaceGetDM(qsp, &qdm);CHKERRQ(ierr); 21393f27d899SToby Isaac ierr = DMPlexGetCone(qdm, 0, &refCone);CHKERRQ(ierr); 21403f27d899SToby Isaac /* get the equivalent dual space from the support dual space */ 21413f27d899SToby Isaac ierr = PetscDualSpaceGetPointSubspace(qsp, refCone[c], &psp);CHKERRQ(ierr); 21423f27d899SToby Isaac if (!s) { 21433f27d899SToby Isaac ierr = PetscObjectReference((PetscObject)psp);CHKERRQ(ierr); 21443f27d899SToby Isaac sp->pointSpaces[p] = psp; 21453f27d899SToby Isaac } 21463f27d899SToby Isaac } 21473f27d899SToby Isaac } 21483f27d899SToby Isaac } 21493f27d899SToby Isaac for (p = 1; p < pEnd; p++) { 21503f27d899SToby Isaac PetscInt pspdim; 21513f27d899SToby Isaac if (!sp->pointSpaces[p]) continue; 21523f27d899SToby Isaac ierr = PetscDualSpaceGetInteriorDimension(sp->pointSpaces[p], &pspdim);CHKERRQ(ierr); 21533f27d899SToby Isaac ierr = PetscSectionSetDof(section, p, pspdim);CHKERRQ(ierr); 21543f27d899SToby Isaac } 21553f27d899SToby Isaac } 21566f905325SMatthew G. Knepley 21573f27d899SToby Isaac if (Ncopies > 1) { 21583f27d899SToby Isaac Mat intMatScalar, allMatScalar; 21593f27d899SToby Isaac PetscDualSpace scalarsp; 21603f27d899SToby Isaac PetscDualSpace_Lag *scalarlag; 21613f27d899SToby Isaac 21623f27d899SToby Isaac ierr = PetscDualSpaceDuplicate(sp, &scalarsp);CHKERRQ(ierr); 216377f1a120SToby Isaac /* Setting the number of components to Nk is a space with 1 copy of each k-form */ 21643f27d899SToby Isaac ierr = PetscDualSpaceSetNumComponents(scalarsp, Nk);CHKERRQ(ierr); 21653f27d899SToby Isaac ierr = PetscDualSpaceSetUp(scalarsp);CHKERRQ(ierr); 21663f27d899SToby Isaac ierr = PetscDualSpaceGetInteriorData(scalarsp, &(sp->intNodes), &intMatScalar);CHKERRQ(ierr); 21673f27d899SToby Isaac ierr = PetscObjectReference((PetscObject)(sp->intNodes));CHKERRQ(ierr); 21683f27d899SToby Isaac if (intMatScalar) {ierr = PetscDualSpaceLagrangeMatrixCreateCopies(intMatScalar, Nk, Ncopies, &(sp->intMat));CHKERRQ(ierr);} 21693f27d899SToby Isaac ierr = PetscDualSpaceGetAllData(scalarsp, &(sp->allNodes), &allMatScalar);CHKERRQ(ierr); 21703f27d899SToby Isaac ierr = PetscObjectReference((PetscObject)(sp->allNodes));CHKERRQ(ierr); 21713f27d899SToby Isaac ierr = PetscDualSpaceLagrangeMatrixCreateCopies(allMatScalar, Nk, Ncopies, &(sp->allMat));CHKERRQ(ierr); 21723f27d899SToby Isaac sp->spdim = scalarsp->spdim * Ncopies; 21733f27d899SToby Isaac sp->spintdim = scalarsp->spintdim * Ncopies; 21743f27d899SToby Isaac scalarlag = (PetscDualSpace_Lag *) scalarsp->data; 21753f27d899SToby Isaac ierr = PetscLagNodeIndicesReference(scalarlag->vertIndices);CHKERRQ(ierr); 21763f27d899SToby Isaac lag->vertIndices = scalarlag->vertIndices; 21773f27d899SToby Isaac ierr = PetscLagNodeIndicesReference(scalarlag->intNodeIndices);CHKERRQ(ierr); 21783f27d899SToby Isaac lag->intNodeIndices = scalarlag->intNodeIndices; 21793f27d899SToby Isaac ierr = PetscLagNodeIndicesReference(scalarlag->allNodeIndices);CHKERRQ(ierr); 21803f27d899SToby Isaac lag->allNodeIndices = scalarlag->allNodeIndices; 21813f27d899SToby Isaac ierr = PetscDualSpaceDestroy(&scalarsp);CHKERRQ(ierr); 21823f27d899SToby Isaac ierr = PetscSectionSetDof(section, 0, sp->spintdim);CHKERRQ(ierr); 21833f27d899SToby Isaac ierr = PetscDualSpaceSectionSetUp_Internal(sp, section);CHKERRQ(ierr); 21843f27d899SToby Isaac ierr = PetscDualSpaceComputeFunctionalsFromAllData(sp);CHKERRQ(ierr); 21856f905325SMatthew G. Knepley ierr = PetscFree2(pStratStart, pStratEnd);CHKERRQ(ierr); 21863f27d899SToby Isaac ierr = DMDestroy(&dmint);CHKERRQ(ierr); 218720cf1dd8SToby Isaac PetscFunctionReturn(0); 218820cf1dd8SToby Isaac } 218920cf1dd8SToby Isaac 21903f27d899SToby Isaac if (trimmed && !continuous) { 21913f27d899SToby Isaac /* the dofs of a trimmed space don't have a nice tensor/lattice structure: 21923f27d899SToby Isaac * just construct the continuous dual space and copy all of the data over, 21933f27d899SToby Isaac * allocating it all to the cell instead of splitting it up between the boundaries */ 21943f27d899SToby Isaac PetscDualSpace spcont; 21953f27d899SToby Isaac PetscInt spdim, f; 21963f27d899SToby Isaac PetscQuadrature allNodes; 21973f27d899SToby Isaac PetscDualSpace_Lag *lagc; 21983f27d899SToby Isaac Mat allMat; 21993f27d899SToby Isaac 22003f27d899SToby Isaac ierr = PetscDualSpaceDuplicate(sp, &spcont);CHKERRQ(ierr); 22013f27d899SToby Isaac ierr = PetscDualSpaceLagrangeSetContinuity(spcont, PETSC_TRUE);CHKERRQ(ierr); 22023f27d899SToby Isaac ierr = PetscDualSpaceSetUp(spcont);CHKERRQ(ierr); 22033f27d899SToby Isaac ierr = PetscDualSpaceGetDimension(spcont, &spdim);CHKERRQ(ierr); 22043f27d899SToby Isaac sp->spdim = sp->spintdim = spdim; 22053f27d899SToby Isaac ierr = PetscSectionSetDof(section, 0, spdim);CHKERRQ(ierr); 22063f27d899SToby Isaac ierr = PetscDualSpaceSectionSetUp_Internal(sp, section);CHKERRQ(ierr); 22073f27d899SToby Isaac ierr = PetscMalloc1(spdim, &(sp->functional));CHKERRQ(ierr); 22083f27d899SToby Isaac for (f = 0; f < spdim; f++) { 22093f27d899SToby Isaac PetscQuadrature fn; 22103f27d899SToby Isaac 22113f27d899SToby Isaac ierr = PetscDualSpaceGetFunctional(spcont, f, &fn);CHKERRQ(ierr); 22123f27d899SToby Isaac ierr = PetscObjectReference((PetscObject)fn);CHKERRQ(ierr); 22133f27d899SToby Isaac sp->functional[f] = fn; 22143f27d899SToby Isaac } 22153f27d899SToby Isaac ierr = PetscDualSpaceGetAllData(spcont, &allNodes, &allMat);CHKERRQ(ierr); 22163f27d899SToby Isaac ierr = PetscObjectReference((PetscObject) allNodes);CHKERRQ(ierr); 22173f27d899SToby Isaac ierr = PetscObjectReference((PetscObject) allNodes);CHKERRQ(ierr); 22183f27d899SToby Isaac sp->allNodes = sp->intNodes = allNodes; 22193f27d899SToby Isaac ierr = PetscObjectReference((PetscObject) allMat);CHKERRQ(ierr); 22203f27d899SToby Isaac ierr = PetscObjectReference((PetscObject) allMat);CHKERRQ(ierr); 22213f27d899SToby Isaac sp->allMat = sp->intMat = allMat; 22223f27d899SToby Isaac lagc = (PetscDualSpace_Lag *) spcont->data; 22233f27d899SToby Isaac ierr = PetscLagNodeIndicesReference(lagc->vertIndices);CHKERRQ(ierr); 22243f27d899SToby Isaac lag->vertIndices = lagc->vertIndices; 22253f27d899SToby Isaac ierr = PetscLagNodeIndicesReference(lagc->allNodeIndices);CHKERRQ(ierr); 22263f27d899SToby Isaac ierr = PetscLagNodeIndicesReference(lagc->allNodeIndices);CHKERRQ(ierr); 22273f27d899SToby Isaac lag->intNodeIndices = lagc->allNodeIndices; 22283f27d899SToby Isaac lag->allNodeIndices = lagc->allNodeIndices; 22293f27d899SToby Isaac ierr = PetscDualSpaceDestroy(&spcont);CHKERRQ(ierr); 22303f27d899SToby Isaac ierr = PetscFree2(pStratStart, pStratEnd);CHKERRQ(ierr); 22313f27d899SToby Isaac ierr = DMDestroy(&dmint);CHKERRQ(ierr); 22323f27d899SToby Isaac PetscFunctionReturn(0); 22333f27d899SToby Isaac } 22343f27d899SToby Isaac 22353f27d899SToby Isaac /* step 3: construct intNodes, and intMat, and combine it with boundray data to make allNodes and allMat */ 22363f27d899SToby Isaac if (!tensorSpace) { 22376ff15688SToby Isaac if (!tensorCell) {ierr = PetscLagNodeIndicesCreateSimplexVertices(dm, &(lag->vertIndices));CHKERRQ(ierr);} 22383f27d899SToby Isaac 22393f27d899SToby Isaac if (trimmed) { 224077f1a120SToby Isaac /* there is one dof in the interior of the a trimmed element for each full polynomial of with degree at most 224177f1a120SToby Isaac * order + k - dim - 1 */ 22423f27d899SToby Isaac if (order + PetscAbsInt(formDegree) > dim) { 22433f27d899SToby Isaac PetscInt sum = order + PetscAbsInt(formDegree) - dim - 1; 22443f27d899SToby Isaac PetscInt nDofs; 22453f27d899SToby Isaac 22463f27d899SToby Isaac ierr = PetscDualSpaceLagrangeCreateSimplexNodeMat(nodeFamily, dim, sum, Nk, numNodeSkip, &sp->intNodes, &sp->intMat, &(lag->intNodeIndices));CHKERRQ(ierr); 22473f27d899SToby Isaac ierr = MatGetSize(sp->intMat, &nDofs, NULL);CHKERRQ(ierr); 22483f27d899SToby Isaac ierr = PetscSectionSetDof(section, 0, nDofs);CHKERRQ(ierr); 22493f27d899SToby Isaac } 22503f27d899SToby Isaac ierr = PetscDualSpaceSectionSetUp_Internal(sp, section);CHKERRQ(ierr); 22513f27d899SToby Isaac ierr = PetscDualSpaceCreateAllDataFromInteriorData(sp);CHKERRQ(ierr); 22523f27d899SToby Isaac ierr = PetscDualSpaceLagrangeCreateAllNodeIdx(sp);CHKERRQ(ierr); 22533f27d899SToby Isaac } else { 22543f27d899SToby Isaac if (!continuous) { 225577f1a120SToby Isaac /* if discontinuous just construct one node for each set of dofs (a set of dofs is a basis for the k-form 225677f1a120SToby Isaac * space) */ 22573f27d899SToby Isaac PetscInt sum = order; 22583f27d899SToby Isaac PetscInt nDofs; 22593f27d899SToby Isaac 22603f27d899SToby Isaac ierr = PetscDualSpaceLagrangeCreateSimplexNodeMat(nodeFamily, dim, sum, Nk, numNodeSkip, &sp->intNodes, &sp->intMat, &(lag->intNodeIndices));CHKERRQ(ierr); 22613f27d899SToby Isaac ierr = MatGetSize(sp->intMat, &nDofs, NULL);CHKERRQ(ierr); 22623f27d899SToby Isaac ierr = PetscSectionSetDof(section, 0, nDofs);CHKERRQ(ierr); 22633f27d899SToby Isaac ierr = PetscDualSpaceSectionSetUp_Internal(sp, section);CHKERRQ(ierr); 22643f27d899SToby Isaac ierr = PetscObjectReference((PetscObject)(sp->intNodes));CHKERRQ(ierr); 22653f27d899SToby Isaac sp->allNodes = sp->intNodes; 22663f27d899SToby Isaac ierr = PetscObjectReference((PetscObject)(sp->intMat));CHKERRQ(ierr); 22673f27d899SToby Isaac sp->allMat = sp->intMat; 22683f27d899SToby Isaac ierr = PetscLagNodeIndicesReference(lag->intNodeIndices);CHKERRQ(ierr); 22693f27d899SToby Isaac lag->allNodeIndices = lag->intNodeIndices; 22703f27d899SToby Isaac } else { 227177f1a120SToby Isaac /* there is one dof in the interior of the a full element for each trimmed polynomial of with degree at most 227277f1a120SToby Isaac * order + k - dim, but with complementary form degree */ 22733f27d899SToby Isaac if (order + PetscAbsInt(formDegree) > dim) { 22743f27d899SToby Isaac PetscDualSpace trimmedsp; 22753f27d899SToby Isaac PetscDualSpace_Lag *trimmedlag; 22763f27d899SToby Isaac PetscQuadrature intNodes; 22773f27d899SToby Isaac PetscInt trFormDegree = formDegree >= 0 ? formDegree - dim : dim - PetscAbsInt(formDegree); 22783f27d899SToby Isaac PetscInt nDofs; 22793f27d899SToby Isaac Mat intMat; 22803f27d899SToby Isaac 22813f27d899SToby Isaac ierr = PetscDualSpaceDuplicate(sp, &trimmedsp);CHKERRQ(ierr); 22823f27d899SToby Isaac ierr = PetscDualSpaceLagrangeSetTrimmed(trimmedsp, PETSC_TRUE);CHKERRQ(ierr); 22833f27d899SToby Isaac ierr = PetscDualSpaceSetOrder(trimmedsp, order + PetscAbsInt(formDegree) - dim);CHKERRQ(ierr); 22843f27d899SToby Isaac ierr = PetscDualSpaceSetFormDegree(trimmedsp, trFormDegree);CHKERRQ(ierr); 22853f27d899SToby Isaac trimmedlag = (PetscDualSpace_Lag *) trimmedsp->data; 22863f27d899SToby Isaac trimmedlag->numNodeSkip = numNodeSkip + 1; 22873f27d899SToby Isaac ierr = PetscDualSpaceSetUp(trimmedsp);CHKERRQ(ierr); 22883f27d899SToby Isaac ierr = PetscDualSpaceGetAllData(trimmedsp, &intNodes, &intMat);CHKERRQ(ierr); 22893f27d899SToby Isaac ierr = PetscObjectReference((PetscObject)intNodes);CHKERRQ(ierr); 22903f27d899SToby Isaac sp->intNodes = intNodes; 22913f27d899SToby Isaac ierr = PetscObjectReference((PetscObject)intMat);CHKERRQ(ierr); 22923f27d899SToby Isaac sp->intMat = intMat; 22933f27d899SToby Isaac ierr = MatGetSize(sp->intMat, &nDofs, NULL);CHKERRQ(ierr); 22943f27d899SToby Isaac ierr = PetscLagNodeIndicesReference(trimmedlag->allNodeIndices);CHKERRQ(ierr); 22953f27d899SToby Isaac lag->intNodeIndices = trimmedlag->allNodeIndices; 22963f27d899SToby Isaac ierr = PetscDualSpaceDestroy(&trimmedsp);CHKERRQ(ierr); 22973f27d899SToby Isaac ierr = PetscSectionSetDof(section, 0, nDofs);CHKERRQ(ierr); 22983f27d899SToby Isaac } 22993f27d899SToby Isaac ierr = PetscDualSpaceSectionSetUp_Internal(sp, section);CHKERRQ(ierr); 23003f27d899SToby Isaac ierr = PetscDualSpaceCreateAllDataFromInteriorData(sp);CHKERRQ(ierr); 23013f27d899SToby Isaac ierr = PetscDualSpaceLagrangeCreateAllNodeIdx(sp);CHKERRQ(ierr); 23023f27d899SToby Isaac } 23033f27d899SToby Isaac } 23043f27d899SToby Isaac } else { 23053f27d899SToby Isaac PetscQuadrature intNodesTrace = NULL; 23063f27d899SToby Isaac PetscQuadrature intNodesFiber = NULL; 23073f27d899SToby Isaac PetscQuadrature intNodes = NULL; 23083f27d899SToby Isaac PetscLagNodeIndices intNodeIndices = NULL; 23093f27d899SToby Isaac Mat intMat = NULL; 23103f27d899SToby Isaac 231177f1a120SToby Isaac if (PetscAbsInt(formDegree) < dim) { /* get the trace k-forms on the first facet, and the 0-forms on the edge, 231277f1a120SToby Isaac and wedge them together to create some of the k-form dofs */ 23133f27d899SToby Isaac PetscDualSpace trace, fiber; 23143f27d899SToby Isaac PetscDualSpace_Lag *tracel, *fiberl; 23153f27d899SToby Isaac Mat intMatTrace, intMatFiber; 23163f27d899SToby Isaac 23173f27d899SToby Isaac if (sp->pointSpaces[tensorf]) { 23183f27d899SToby Isaac ierr = PetscObjectReference((PetscObject)(sp->pointSpaces[tensorf]));CHKERRQ(ierr); 23193f27d899SToby Isaac trace = sp->pointSpaces[tensorf]; 23203f27d899SToby Isaac } else { 23213f27d899SToby Isaac ierr = PetscDualSpaceCreateFacetSubspace_Lagrange(sp,NULL,tensorf,formDegree,Ncopies,PETSC_TRUE,&trace);CHKERRQ(ierr); 23223f27d899SToby Isaac } 23233f27d899SToby Isaac ierr = PetscDualSpaceCreateEdgeSubspace_Lagrange(sp,order,0,1,PETSC_TRUE,&fiber);CHKERRQ(ierr); 23243f27d899SToby Isaac tracel = (PetscDualSpace_Lag *) trace->data; 23253f27d899SToby Isaac fiberl = (PetscDualSpace_Lag *) fiber->data; 23263f27d899SToby Isaac ierr = PetscLagNodeIndicesCreateTensorVertices(dm, tracel->vertIndices, &(lag->vertIndices));CHKERRQ(ierr); 23273f27d899SToby Isaac ierr = PetscDualSpaceGetInteriorData(trace, &intNodesTrace, &intMatTrace);CHKERRQ(ierr); 23283f27d899SToby Isaac ierr = PetscDualSpaceGetInteriorData(fiber, &intNodesFiber, &intMatFiber);CHKERRQ(ierr); 23293f27d899SToby Isaac if (intNodesTrace && intNodesFiber) { 23303f27d899SToby Isaac ierr = PetscQuadratureCreateTensor(intNodesTrace, intNodesFiber, &intNodes);CHKERRQ(ierr); 23313f27d899SToby Isaac ierr = MatTensorAltV(intMatTrace, intMatFiber, dim-1, formDegree, 1, 0, &intMat);CHKERRQ(ierr); 23323f27d899SToby Isaac ierr = PetscLagNodeIndicesTensor(tracel->intNodeIndices, dim - 1, formDegree, fiberl->intNodeIndices, 1, 0, &intNodeIndices);CHKERRQ(ierr); 23333f27d899SToby Isaac } 23343f27d899SToby Isaac ierr = PetscObjectReference((PetscObject) intNodesTrace);CHKERRQ(ierr); 23353f27d899SToby Isaac ierr = PetscObjectReference((PetscObject) intNodesFiber);CHKERRQ(ierr); 23363f27d899SToby Isaac ierr = PetscDualSpaceDestroy(&fiber);CHKERRQ(ierr); 23373f27d899SToby Isaac ierr = PetscDualSpaceDestroy(&trace);CHKERRQ(ierr); 23383f27d899SToby Isaac } 233977f1a120SToby Isaac if (PetscAbsInt(formDegree) > 0) { /* get the trace (k-1)-forms on the first facet, and the 1-forms on the edge, 234077f1a120SToby Isaac and wedge them together to create the remaining k-form dofs */ 23413f27d899SToby Isaac PetscDualSpace trace, fiber; 23423f27d899SToby Isaac PetscDualSpace_Lag *tracel, *fiberl; 23433f27d899SToby Isaac PetscQuadrature intNodesTrace2, intNodesFiber2, intNodes2; 23443f27d899SToby Isaac PetscLagNodeIndices intNodeIndices2; 23453f27d899SToby Isaac Mat intMatTrace, intMatFiber, intMat2; 23463f27d899SToby Isaac PetscInt traceDegree = formDegree > 0 ? formDegree - 1 : formDegree + 1; 23473f27d899SToby Isaac PetscInt fiberDegree = formDegree > 0 ? 1 : -1; 23483f27d899SToby Isaac 23493f27d899SToby Isaac ierr = PetscDualSpaceCreateFacetSubspace_Lagrange(sp,NULL,tensorf,traceDegree,Ncopies,PETSC_TRUE,&trace);CHKERRQ(ierr); 23503f27d899SToby Isaac ierr = PetscDualSpaceCreateEdgeSubspace_Lagrange(sp,order,fiberDegree,1,PETSC_TRUE,&fiber);CHKERRQ(ierr); 23513f27d899SToby Isaac tracel = (PetscDualSpace_Lag *) trace->data; 23523f27d899SToby Isaac fiberl = (PetscDualSpace_Lag *) fiber->data; 23533f27d899SToby Isaac if (!lag->vertIndices) { 23543f27d899SToby Isaac ierr = PetscLagNodeIndicesCreateTensorVertices(dm, tracel->vertIndices, &(lag->vertIndices));CHKERRQ(ierr); 23553f27d899SToby Isaac } 23563f27d899SToby Isaac ierr = PetscDualSpaceGetInteriorData(trace, &intNodesTrace2, &intMatTrace);CHKERRQ(ierr); 23573f27d899SToby Isaac ierr = PetscDualSpaceGetInteriorData(fiber, &intNodesFiber2, &intMatFiber);CHKERRQ(ierr); 23583f27d899SToby Isaac if (intNodesTrace2 && intNodesFiber2) { 23593f27d899SToby Isaac ierr = PetscQuadratureCreateTensor(intNodesTrace2, intNodesFiber2, &intNodes2);CHKERRQ(ierr); 23603f27d899SToby Isaac ierr = MatTensorAltV(intMatTrace, intMatFiber, dim-1, traceDegree, 1, fiberDegree, &intMat2);CHKERRQ(ierr); 23613f27d899SToby Isaac ierr = PetscLagNodeIndicesTensor(tracel->intNodeIndices, dim - 1, traceDegree, fiberl->intNodeIndices, 1, fiberDegree, &intNodeIndices2);CHKERRQ(ierr); 23623f27d899SToby Isaac if (!intMat) { 23633f27d899SToby Isaac intMat = intMat2; 23643f27d899SToby Isaac intNodes = intNodes2; 23653f27d899SToby Isaac intNodeIndices = intNodeIndices2; 23663f27d899SToby Isaac } else { 236777f1a120SToby Isaac /* merge the matrices, quadrature points, and nodes */ 23683f27d899SToby Isaac PetscInt nM; 23693f27d899SToby Isaac PetscInt nDof, nDof2; 23706ff15688SToby Isaac PetscInt *toMerged = NULL, *toMerged2 = NULL; 23716ff15688SToby Isaac PetscQuadrature merged = NULL; 23723f27d899SToby Isaac PetscLagNodeIndices intNodeIndicesMerged = NULL; 23733f27d899SToby Isaac Mat matMerged = NULL; 23743f27d899SToby Isaac 2375ea78f98cSLisandro Dalcin ierr = MatGetSize(intMat, &nDof, NULL);CHKERRQ(ierr); 2376ea78f98cSLisandro Dalcin ierr = MatGetSize(intMat2, &nDof2, NULL);CHKERRQ(ierr); 23773f27d899SToby Isaac ierr = PetscQuadraturePointsMerge(intNodes, intNodes2, &merged, &toMerged, &toMerged2);CHKERRQ(ierr); 23783f27d899SToby Isaac ierr = PetscQuadratureGetData(merged, NULL, NULL, &nM, NULL, NULL);CHKERRQ(ierr); 23793f27d899SToby Isaac ierr = MatricesMerge(intMat, intMat2, dim, formDegree, nM, toMerged, toMerged2, &matMerged);CHKERRQ(ierr); 23803f27d899SToby Isaac ierr = PetscLagNodeIndicesMerge(intNodeIndices, intNodeIndices2, &intNodeIndicesMerged);CHKERRQ(ierr); 23816ff15688SToby Isaac ierr = PetscFree(toMerged);CHKERRQ(ierr); 23826ff15688SToby Isaac ierr = PetscFree(toMerged2);CHKERRQ(ierr); 23833f27d899SToby Isaac ierr = MatDestroy(&intMat);CHKERRQ(ierr); 23843f27d899SToby Isaac ierr = MatDestroy(&intMat2);CHKERRQ(ierr); 23853f27d899SToby Isaac ierr = PetscQuadratureDestroy(&intNodes);CHKERRQ(ierr); 23863f27d899SToby Isaac ierr = PetscQuadratureDestroy(&intNodes2);CHKERRQ(ierr); 23873f27d899SToby Isaac ierr = PetscLagNodeIndicesDestroy(&intNodeIndices);CHKERRQ(ierr); 23883f27d899SToby Isaac ierr = PetscLagNodeIndicesDestroy(&intNodeIndices2);CHKERRQ(ierr); 23893f27d899SToby Isaac intNodes = merged; 23903f27d899SToby Isaac intMat = matMerged; 23913f27d899SToby Isaac intNodeIndices = intNodeIndicesMerged; 23923f27d899SToby Isaac if (!trimmed) { 239377f1a120SToby Isaac /* I think users expect that, when a node has a full basis for the k-forms, 239477f1a120SToby Isaac * they should be consecutive dofs. That isn't the case for trimmed spaces, 239577f1a120SToby Isaac * but is for some of the nodes in untrimmed spaces, so in that case we 239677f1a120SToby Isaac * sort them to group them by node */ 23973f27d899SToby Isaac Mat intMatPerm; 23983f27d899SToby Isaac 23993f27d899SToby Isaac ierr = MatPermuteByNodeIdx(intMat, intNodeIndices, &intMatPerm);CHKERRQ(ierr); 24003f27d899SToby Isaac ierr = MatDestroy(&intMat);CHKERRQ(ierr); 24013f27d899SToby Isaac intMat = intMatPerm; 24023f27d899SToby Isaac } 24033f27d899SToby Isaac } 24043f27d899SToby Isaac } 24053f27d899SToby Isaac ierr = PetscDualSpaceDestroy(&fiber);CHKERRQ(ierr); 24063f27d899SToby Isaac ierr = PetscDualSpaceDestroy(&trace);CHKERRQ(ierr); 24073f27d899SToby Isaac } 24083f27d899SToby Isaac ierr = PetscQuadratureDestroy(&intNodesTrace);CHKERRQ(ierr); 24093f27d899SToby Isaac ierr = PetscQuadratureDestroy(&intNodesFiber);CHKERRQ(ierr); 24103f27d899SToby Isaac sp->intNodes = intNodes; 24113f27d899SToby Isaac sp->intMat = intMat; 24123f27d899SToby Isaac lag->intNodeIndices = intNodeIndices; 24136f905325SMatthew G. Knepley { 24143f27d899SToby Isaac PetscInt nDofs = 0; 24153f27d899SToby Isaac 24163f27d899SToby Isaac if (intMat) { 24173f27d899SToby Isaac ierr = MatGetSize(intMat, &nDofs, NULL);CHKERRQ(ierr); 24183f27d899SToby Isaac } 24193f27d899SToby Isaac ierr = PetscSectionSetDof(section, 0, nDofs);CHKERRQ(ierr); 24203f27d899SToby Isaac } 24213f27d899SToby Isaac ierr = PetscDualSpaceSectionSetUp_Internal(sp, section);CHKERRQ(ierr); 24223f27d899SToby Isaac if (continuous) { 24233f27d899SToby Isaac ierr = PetscDualSpaceCreateAllDataFromInteriorData(sp);CHKERRQ(ierr); 24243f27d899SToby Isaac ierr = PetscDualSpaceLagrangeCreateAllNodeIdx(sp);CHKERRQ(ierr); 24253f27d899SToby Isaac } else { 24263f27d899SToby Isaac ierr = PetscObjectReference((PetscObject) intNodes);CHKERRQ(ierr); 24273f27d899SToby Isaac sp->allNodes = intNodes; 24283f27d899SToby Isaac ierr = PetscObjectReference((PetscObject) intMat);CHKERRQ(ierr); 24293f27d899SToby Isaac sp->allMat = intMat; 24303f27d899SToby Isaac ierr = PetscLagNodeIndicesReference(intNodeIndices);CHKERRQ(ierr); 24313f27d899SToby Isaac lag->allNodeIndices = intNodeIndices; 24323f27d899SToby Isaac } 24333f27d899SToby Isaac } 24343f27d899SToby Isaac ierr = PetscSectionGetStorageSize(section, &sp->spdim);CHKERRQ(ierr); 24353f27d899SToby Isaac ierr = PetscSectionGetConstrainedStorageSize(section, &sp->spintdim);CHKERRQ(ierr); 24363f27d899SToby Isaac ierr = PetscDualSpaceComputeFunctionalsFromAllData(sp);CHKERRQ(ierr); 24373f27d899SToby Isaac ierr = PetscFree2(pStratStart, pStratEnd);CHKERRQ(ierr); 24383f27d899SToby Isaac ierr = DMDestroy(&dmint);CHKERRQ(ierr); 24393f27d899SToby Isaac PetscFunctionReturn(0); 24403f27d899SToby Isaac } 24413f27d899SToby Isaac 244277f1a120SToby Isaac /* Create a matrix that represents the transformation that DMPlexVecGetClosure() would need 244377f1a120SToby Isaac * to get the representation of the dofs for a mesh point if the mesh point had this orientation 244477f1a120SToby Isaac * relative to the cell */ 24453f27d899SToby Isaac PetscErrorCode PetscDualSpaceCreateInteriorSymmetryMatrix_Lagrange(PetscDualSpace sp, PetscInt ornt, Mat *symMat) 24463f27d899SToby Isaac { 24473f27d899SToby Isaac PetscDualSpace_Lag *lag; 24483f27d899SToby Isaac DM dm; 24493f27d899SToby Isaac PetscLagNodeIndices vertIndices, intNodeIndices; 24503f27d899SToby Isaac PetscLagNodeIndices ni; 24513f27d899SToby Isaac PetscInt nodeIdxDim, nodeVecDim, nNodes; 24523f27d899SToby Isaac PetscInt formDegree; 24533f27d899SToby Isaac PetscInt *perm, *permOrnt; 24543f27d899SToby Isaac PetscInt *nnz; 24553f27d899SToby Isaac PetscInt n; 24563f27d899SToby Isaac PetscInt maxGroupSize; 24573f27d899SToby Isaac PetscScalar *V, *W, *work; 24583f27d899SToby Isaac Mat A; 24596f905325SMatthew G. Knepley PetscErrorCode ierr; 24606f905325SMatthew G. Knepley 24616f905325SMatthew G. Knepley PetscFunctionBegin; 24623f27d899SToby Isaac if (!sp->spintdim) { 24633f27d899SToby Isaac *symMat = NULL; 24643f27d899SToby Isaac PetscFunctionReturn(0); 24656f905325SMatthew G. Knepley } 24663f27d899SToby Isaac lag = (PetscDualSpace_Lag *) sp->data; 24673f27d899SToby Isaac vertIndices = lag->vertIndices; 24683f27d899SToby Isaac intNodeIndices = lag->intNodeIndices; 24693f27d899SToby Isaac ierr = PetscDualSpaceGetDM(sp, &dm);CHKERRQ(ierr); 24703f27d899SToby Isaac ierr = PetscDualSpaceGetFormDegree(sp, &formDegree);CHKERRQ(ierr); 24713f27d899SToby Isaac ierr = PetscNew(&ni);CHKERRQ(ierr); 24723f27d899SToby Isaac ni->refct = 1; 24733f27d899SToby Isaac ni->nodeIdxDim = nodeIdxDim = intNodeIndices->nodeIdxDim; 24743f27d899SToby Isaac ni->nodeVecDim = nodeVecDim = intNodeIndices->nodeVecDim; 24753f27d899SToby Isaac ni->nNodes = nNodes = intNodeIndices->nNodes; 24763f27d899SToby Isaac ierr = PetscMalloc1(nNodes * nodeIdxDim, &(ni->nodeIdx));CHKERRQ(ierr); 24773f27d899SToby Isaac ierr = PetscMalloc1(nNodes * nodeVecDim, &(ni->nodeVec));CHKERRQ(ierr); 247877f1a120SToby Isaac /* push forward the dofs by the symmetry of the reference element induced by ornt */ 24793f27d899SToby Isaac ierr = PetscLagNodeIndicesPushForward(dm, vertIndices, 0, vertIndices, intNodeIndices, ornt, formDegree, ni->nodeIdx, ni->nodeVec);CHKERRQ(ierr); 248077f1a120SToby Isaac /* get the revlex order for both the original and transformed dofs */ 24813f27d899SToby Isaac ierr = PetscLagNodeIndicesGetPermutation(intNodeIndices, &perm);CHKERRQ(ierr); 24823f27d899SToby Isaac ierr = PetscLagNodeIndicesGetPermutation(ni, &permOrnt);CHKERRQ(ierr); 24833f27d899SToby Isaac ierr = PetscMalloc1(nNodes, &nnz);CHKERRQ(ierr); 24843f27d899SToby Isaac for (n = 0, maxGroupSize = 0; n < nNodes;) { /* incremented in the loop */ 24853f27d899SToby Isaac PetscInt *nind = &(ni->nodeIdx[permOrnt[n] * nodeIdxDim]); 24863f27d899SToby Isaac PetscInt m, nEnd; 24873f27d899SToby Isaac PetscInt groupSize; 248877f1a120SToby Isaac /* for each group of dofs that have the same nodeIdx coordinate */ 24893f27d899SToby Isaac for (nEnd = n + 1; nEnd < nNodes; nEnd++) { 24903f27d899SToby Isaac PetscInt *mind = &(ni->nodeIdx[permOrnt[nEnd] * nodeIdxDim]); 24913f27d899SToby Isaac PetscInt d; 24923f27d899SToby Isaac 24933f27d899SToby Isaac /* compare the oriented permutation indices */ 24943f27d899SToby Isaac for (d = 0; d < nodeIdxDim; d++) if (mind[d] != nind[d]) break; 24953f27d899SToby Isaac if (d < nodeIdxDim) break; 24963f27d899SToby Isaac } 249777f1a120SToby Isaac /* permOrnt[[n, nEnd)] is a group of dofs that, under the symmetry are at the same location */ 249876bd3646SJed Brown 249977f1a120SToby Isaac /* the symmetry had better map the group of dofs with the same permuted nodeIdx 250077f1a120SToby Isaac * to a group of dofs with the same size, otherwise we messed up */ 250176bd3646SJed Brown if (PetscDefined(USE_DEBUG)) { 25023f27d899SToby Isaac PetscInt m; 25033f27d899SToby Isaac PetscInt *nind = &(intNodeIndices->nodeIdx[perm[n] * nodeIdxDim]); 25043f27d899SToby Isaac 25053f27d899SToby Isaac for (m = n + 1; m < nEnd; m++) { 25063f27d899SToby Isaac PetscInt *mind = &(intNodeIndices->nodeIdx[perm[m] * nodeIdxDim]); 25073f27d899SToby Isaac PetscInt d; 25083f27d899SToby Isaac 25093f27d899SToby Isaac /* compare the oriented permutation indices */ 25103f27d899SToby Isaac for (d = 0; d < nodeIdxDim; d++) if (mind[d] != nind[d]) break; 25113f27d899SToby Isaac if (d < nodeIdxDim) break; 25123f27d899SToby Isaac } 25133f27d899SToby Isaac if (m < nEnd) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Dofs with same index after symmetry not same block size"); 25143f27d899SToby Isaac } 25153f27d899SToby Isaac groupSize = nEnd - n; 251677f1a120SToby Isaac /* each pushforward dof vector will be expressed in a basis of the unpermuted dofs */ 25173f27d899SToby Isaac for (m = n; m < nEnd; m++) nnz[permOrnt[m]] = groupSize; 25183f27d899SToby Isaac 25193f27d899SToby Isaac maxGroupSize = PetscMax(maxGroupSize, nEnd - n); 25203f27d899SToby Isaac n = nEnd; 25213f27d899SToby Isaac } 25223f27d899SToby Isaac if (maxGroupSize > nodeVecDim) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Dofs are not in blocks that can be solved"); 25233f27d899SToby Isaac ierr = MatCreateSeqAIJ(PETSC_COMM_SELF, nNodes, nNodes, 0, nnz, &A);CHKERRQ(ierr); 25243f27d899SToby Isaac ierr = PetscFree(nnz);CHKERRQ(ierr); 25253f27d899SToby Isaac ierr = PetscMalloc3(maxGroupSize * nodeVecDim, &V, maxGroupSize * nodeVecDim, &W, nodeVecDim * 2, &work);CHKERRQ(ierr); 25263f27d899SToby Isaac for (n = 0; n < nNodes;) { /* incremented in the loop */ 25273f27d899SToby Isaac PetscInt *nind = &(ni->nodeIdx[permOrnt[n] * nodeIdxDim]); 25283f27d899SToby Isaac PetscInt nEnd; 25293f27d899SToby Isaac PetscInt m; 25303f27d899SToby Isaac PetscInt groupSize; 25313f27d899SToby Isaac for (nEnd = n + 1; nEnd < nNodes; nEnd++) { 25323f27d899SToby Isaac PetscInt *mind = &(ni->nodeIdx[permOrnt[nEnd] * nodeIdxDim]); 25333f27d899SToby Isaac PetscInt d; 25343f27d899SToby Isaac 25353f27d899SToby Isaac /* compare the oriented permutation indices */ 25363f27d899SToby Isaac for (d = 0; d < nodeIdxDim; d++) if (mind[d] != nind[d]) break; 25373f27d899SToby Isaac if (d < nodeIdxDim) break; 25383f27d899SToby Isaac } 25393f27d899SToby Isaac groupSize = nEnd - n; 254077f1a120SToby Isaac /* get all of the vectors from the original and all of the pushforward vectors */ 25413f27d899SToby Isaac for (m = n; m < nEnd; m++) { 25423f27d899SToby Isaac PetscInt d; 25433f27d899SToby Isaac 25443f27d899SToby Isaac for (d = 0; d < nodeVecDim; d++) { 25453f27d899SToby Isaac V[(m - n) * nodeVecDim + d] = intNodeIndices->nodeVec[perm[m] * nodeVecDim + d]; 25463f27d899SToby Isaac W[(m - n) * nodeVecDim + d] = ni->nodeVec[permOrnt[m] * nodeVecDim + d]; 25473f27d899SToby Isaac } 25483f27d899SToby Isaac } 254977f1a120SToby Isaac /* now we have to solve for W in terms of V: the systems isn't always square, but the span 255077f1a120SToby Isaac * of V and W should always be the same, so the solution of the normal equations works */ 25513f27d899SToby Isaac { 25523f27d899SToby Isaac char transpose = 'N'; 25533f27d899SToby Isaac PetscBLASInt bm = nodeVecDim; 25543f27d899SToby Isaac PetscBLASInt bn = groupSize; 25553f27d899SToby Isaac PetscBLASInt bnrhs = groupSize; 25563f27d899SToby Isaac PetscBLASInt blda = bm; 25573f27d899SToby Isaac PetscBLASInt bldb = bm; 25583f27d899SToby Isaac PetscBLASInt blwork = 2 * nodeVecDim; 25593f27d899SToby Isaac PetscBLASInt info; 25603f27d899SToby Isaac 25613f27d899SToby Isaac PetscStackCallBLAS("LAPACKgels",LAPACKgels_(&transpose,&bm,&bn,&bnrhs,V,&blda,W,&bldb,work,&blwork, &info)); 25623f27d899SToby Isaac if (info != 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad argument to GELS"); 25633f27d899SToby Isaac /* repack */ 25643f27d899SToby Isaac { 25653f27d899SToby Isaac PetscInt i, j; 25663f27d899SToby Isaac 25673f27d899SToby Isaac for (i = 0; i < groupSize; i++) { 25683f27d899SToby Isaac for (j = 0; j < groupSize; j++) { 256977f1a120SToby Isaac /* notice the different leading dimension */ 25703f27d899SToby Isaac V[i * groupSize + j] = W[i * nodeVecDim + j]; 25713f27d899SToby Isaac } 25723f27d899SToby Isaac } 25733f27d899SToby Isaac } 25743f27d899SToby Isaac } 25753f27d899SToby Isaac ierr = MatSetValues(A, groupSize, &permOrnt[n], groupSize, &perm[n], V, INSERT_VALUES);CHKERRQ(ierr); 25763f27d899SToby Isaac n = nEnd; 25773f27d899SToby Isaac } 25783f27d899SToby Isaac ierr = MatAssemblyBegin(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 25793f27d899SToby Isaac ierr = MatAssemblyEnd(A, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 25803f27d899SToby Isaac *symMat = A; 25813f27d899SToby Isaac ierr = PetscFree3(V,W,work);CHKERRQ(ierr); 25823f27d899SToby Isaac ierr = PetscLagNodeIndicesDestroy(&ni);CHKERRQ(ierr); 25836f905325SMatthew G. Knepley PetscFunctionReturn(0); 25846f905325SMatthew G. Knepley } 258520cf1dd8SToby Isaac 258620cf1dd8SToby Isaac #define BaryIndex(perEdge,a,b,c) (((b)*(2*perEdge+1-(b)))/2)+(c) 258720cf1dd8SToby Isaac 258820cf1dd8SToby Isaac #define CartIndex(perEdge,a,b) (perEdge*(a)+b) 258920cf1dd8SToby Isaac 259077f1a120SToby Isaac /* the existing interface for symmetries is insufficient for all cases: 259177f1a120SToby Isaac * - it should be sufficient for form degrees that are scalar (0 and n) 259277f1a120SToby Isaac * - it should be sufficient for hypercube dofs 259377f1a120SToby Isaac * - it isn't sufficient for simplex cells with non-scalar form degrees if 259477f1a120SToby Isaac * there are any dofs in the interior 259577f1a120SToby Isaac * 259677f1a120SToby Isaac * We compute the general transformation matrices, and if they fit, we return them, 259777f1a120SToby Isaac * otherwise we error (but we should probably change the interface to allow for 259877f1a120SToby Isaac * these symmetries) 259977f1a120SToby Isaac */ 260020cf1dd8SToby Isaac static PetscErrorCode PetscDualSpaceGetSymmetries_Lagrange(PetscDualSpace sp, const PetscInt ****perms, const PetscScalar ****flips) 260120cf1dd8SToby Isaac { 260220cf1dd8SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data; 26033f27d899SToby Isaac PetscInt dim, order, Nc; 260420cf1dd8SToby Isaac PetscErrorCode ierr; 260520cf1dd8SToby Isaac 260620cf1dd8SToby Isaac PetscFunctionBegin; 260720cf1dd8SToby Isaac ierr = PetscDualSpaceGetOrder(sp,&order);CHKERRQ(ierr); 260820cf1dd8SToby Isaac ierr = PetscDualSpaceGetNumComponents(sp,&Nc);CHKERRQ(ierr); 260920cf1dd8SToby Isaac ierr = DMGetDimension(sp->dm,&dim);CHKERRQ(ierr); 26103f27d899SToby Isaac if (!lag->symComputed) { /* store symmetries */ 26113f27d899SToby Isaac PetscInt pStart, pEnd, p; 26123f27d899SToby Isaac PetscInt numPoints; 261320cf1dd8SToby Isaac PetscInt numFaces; 26143f27d899SToby Isaac PetscInt spintdim; 26153f27d899SToby Isaac PetscInt ***symperms; 26163f27d899SToby Isaac PetscScalar ***symflips; 261720cf1dd8SToby Isaac 26183f27d899SToby Isaac ierr = DMPlexGetChart(sp->dm, &pStart, &pEnd);CHKERRQ(ierr); 26193f27d899SToby Isaac numPoints = pEnd - pStart; 26203f27d899SToby Isaac ierr = DMPlexGetConeSize(sp->dm, 0, &numFaces);CHKERRQ(ierr); 26213f27d899SToby Isaac ierr = PetscCalloc1(numPoints,&symperms);CHKERRQ(ierr); 26223f27d899SToby Isaac ierr = PetscCalloc1(numPoints,&symflips);CHKERRQ(ierr); 26233f27d899SToby Isaac spintdim = sp->spintdim; 26243f27d899SToby Isaac /* The nodal symmetry behavior is not present when tensorSpace != tensorCell: someone might want this for the "S" 26253f27d899SToby Isaac * family of FEEC spaces. Most used in particular are discontinuous polynomial L2 spaces in tensor cells, where 26263f27d899SToby Isaac * the symmetries are not necessary for FE assembly. So for now we assume this is the case and don't return 26273f27d899SToby Isaac * symmetries if tensorSpace != tensorCell */ 26283f27d899SToby Isaac if (spintdim && 0 < dim && dim < 3 && (lag->tensorSpace == lag->tensorCell)) { /* compute self symmetries */ 26293f27d899SToby Isaac PetscInt **cellSymperms; 26303f27d899SToby Isaac PetscScalar **cellSymflips; 26313f27d899SToby Isaac PetscInt ornt; 26323f27d899SToby Isaac PetscInt nCopies = Nc / lag->intNodeIndices->nodeVecDim; 26333f27d899SToby Isaac PetscInt nNodes = lag->intNodeIndices->nNodes; 263420cf1dd8SToby Isaac 263520cf1dd8SToby Isaac lag->numSelfSym = 2 * numFaces; 263620cf1dd8SToby Isaac lag->selfSymOff = numFaces; 26373f27d899SToby Isaac ierr = PetscCalloc1(2*numFaces,&cellSymperms);CHKERRQ(ierr); 26383f27d899SToby Isaac ierr = PetscCalloc1(2*numFaces,&cellSymflips);CHKERRQ(ierr); 263920cf1dd8SToby Isaac /* we want to be able to index symmetries directly with the orientations, which range from [-numFaces,numFaces) */ 26403f27d899SToby Isaac symperms[0] = &cellSymperms[numFaces]; 26413f27d899SToby Isaac symflips[0] = &cellSymflips[numFaces]; 26423f27d899SToby Isaac if (lag->intNodeIndices->nodeVecDim * nCopies != Nc) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Node indices incompatible with dofs"); 26433f27d899SToby Isaac if (nNodes * nCopies != spintdim) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Node indices incompatible with dofs"); 26443f27d899SToby 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 */ 26453f27d899SToby Isaac Mat symMat; 26463f27d899SToby Isaac PetscInt *perm; 26473f27d899SToby Isaac PetscScalar *flips; 26483f27d899SToby Isaac PetscInt i; 264920cf1dd8SToby Isaac 26503f27d899SToby Isaac if (!ornt) continue; 26513f27d899SToby Isaac ierr = PetscMalloc1(spintdim, &perm);CHKERRQ(ierr); 26523f27d899SToby Isaac ierr = PetscCalloc1(spintdim, &flips);CHKERRQ(ierr); 26533f27d899SToby Isaac for (i = 0; i < spintdim; i++) perm[i] = -1; 26543f27d899SToby Isaac ierr = PetscDualSpaceCreateInteriorSymmetryMatrix_Lagrange(sp, ornt, &symMat);CHKERRQ(ierr); 26553f27d899SToby Isaac for (i = 0; i < nNodes; i++) { 26563f27d899SToby Isaac PetscInt ncols; 26573f27d899SToby Isaac PetscInt j, k; 26583f27d899SToby Isaac const PetscInt *cols; 26593f27d899SToby Isaac const PetscScalar *vals; 26603f27d899SToby Isaac PetscBool nz_seen = PETSC_FALSE; 266120cf1dd8SToby Isaac 26623f27d899SToby Isaac ierr = MatGetRow(symMat, i, &ncols, &cols, &vals);CHKERRQ(ierr); 26633f27d899SToby Isaac for (j = 0; j < ncols; j++) { 26643f27d899SToby Isaac if (PetscAbsScalar(vals[j]) > PETSC_SMALL) { 26653f27d899SToby Isaac if (nz_seen) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips"); 26663f27d899SToby Isaac nz_seen = PETSC_TRUE; 2667cd1695a5SJed Brown if (PetscAbsReal(PetscAbsScalar(vals[j]) - PetscRealConstant(1.)) > PETSC_SMALL) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips"); 26683f27d899SToby Isaac if (PetscAbsReal(PetscImaginaryPart(vals[j])) > PETSC_SMALL) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips"); 26693f27d899SToby Isaac if (perm[cols[j] * nCopies] >= 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "This dual space has symmetries that can't be described as a permutation + sign flips"); 26703f27d899SToby Isaac for (k = 0; k < nCopies; k++) { 26713f27d899SToby Isaac perm[cols[j] * nCopies + k] = i * nCopies + k; 267220cf1dd8SToby Isaac } 26733f27d899SToby Isaac if (PetscRealPart(vals[j]) < 0.) { 26743f27d899SToby Isaac for (k = 0; k < nCopies; k++) { 26753f27d899SToby Isaac flips[i * nCopies + k] = -1.; 267620cf1dd8SToby Isaac } 267720cf1dd8SToby Isaac } else { 26783f27d899SToby Isaac for (k = 0; k < nCopies; k++) { 26793f27d899SToby Isaac flips[i * nCopies + k] = 1.; 26803f27d899SToby Isaac } 26813f27d899SToby Isaac } 26823f27d899SToby Isaac } 26833f27d899SToby Isaac } 26843f27d899SToby Isaac ierr = MatRestoreRow(symMat, i, &ncols, &cols, &vals);CHKERRQ(ierr); 26853f27d899SToby Isaac } 26863f27d899SToby Isaac ierr = MatDestroy(&symMat);CHKERRQ(ierr); 26873f27d899SToby Isaac /* if there were no sign flips, keep NULL */ 26883f27d899SToby Isaac for (i = 0; i < spintdim; i++) if (flips[i] != 1.) break; 26893f27d899SToby Isaac if (i == spintdim) { 26903f27d899SToby Isaac ierr = PetscFree(flips);CHKERRQ(ierr); 26913f27d899SToby Isaac flips = NULL; 26923f27d899SToby Isaac } 26933f27d899SToby Isaac /* if the permutation is identity, keep NULL */ 26943f27d899SToby Isaac for (i = 0; i < spintdim; i++) if (perm[i] != i) break; 26953f27d899SToby Isaac if (i == spintdim) { 26963f27d899SToby Isaac ierr = PetscFree(perm);CHKERRQ(ierr); 26973f27d899SToby Isaac perm = NULL; 26983f27d899SToby Isaac } 26993f27d899SToby Isaac symperms[0][ornt] = perm; 27003f27d899SToby Isaac symflips[0][ornt] = flips; 27013f27d899SToby Isaac } 27023f27d899SToby Isaac /* if no orientations produced non-identity permutations, keep NULL */ 27033f27d899SToby Isaac for (ornt = -numFaces; ornt < numFaces; ornt++) if (symperms[0][ornt]) break; 27043f27d899SToby Isaac if (ornt == numFaces) { 27053f27d899SToby Isaac ierr = PetscFree(cellSymperms);CHKERRQ(ierr); 27063f27d899SToby Isaac symperms[0] = NULL; 27073f27d899SToby Isaac } 27083f27d899SToby Isaac /* if no orientations produced sign flips, keep NULL */ 27093f27d899SToby Isaac for (ornt = -numFaces; ornt < numFaces; ornt++) if (symflips[0][ornt]) break; 27103f27d899SToby Isaac if (ornt == numFaces) { 27113f27d899SToby Isaac ierr = PetscFree(cellSymflips);CHKERRQ(ierr); 27123f27d899SToby Isaac symflips[0] = NULL; 27133f27d899SToby Isaac } 27143f27d899SToby Isaac } 271577f1a120SToby Isaac { /* get the symmetries of closure points */ 27163f27d899SToby Isaac PetscInt closureSize = 0; 27173f27d899SToby Isaac PetscInt *closure = NULL; 27183f27d899SToby Isaac PetscInt r; 271920cf1dd8SToby Isaac 27203f27d899SToby Isaac ierr = DMPlexGetTransitiveClosure(sp->dm,0,PETSC_TRUE,&closureSize,&closure);CHKERRQ(ierr); 27213f27d899SToby Isaac for (r = 0; r < closureSize; r++) { 27223f27d899SToby Isaac PetscDualSpace psp; 27233f27d899SToby Isaac PetscInt point = closure[2 * r]; 27243f27d899SToby Isaac PetscInt pspintdim; 27253f27d899SToby Isaac const PetscInt ***psymperms = NULL; 27263f27d899SToby Isaac const PetscScalar ***psymflips = NULL; 272720cf1dd8SToby Isaac 27283f27d899SToby Isaac if (!point) continue; 27293f27d899SToby Isaac ierr = PetscDualSpaceGetPointSubspace(sp, point, &psp);CHKERRQ(ierr); 27303f27d899SToby Isaac if (!psp) continue; 27313f27d899SToby Isaac ierr = PetscDualSpaceGetInteriorDimension(psp, &pspintdim);CHKERRQ(ierr); 27323f27d899SToby Isaac if (!pspintdim) continue; 27333f27d899SToby Isaac ierr = PetscDualSpaceGetSymmetries(psp,&psymperms,&psymflips);CHKERRQ(ierr); 27343f27d899SToby Isaac symperms[r] = (PetscInt **) (psymperms ? psymperms[0] : NULL); 27353f27d899SToby Isaac symflips[r] = (PetscScalar **) (psymflips ? psymflips[0] : NULL); 273620cf1dd8SToby Isaac } 27373f27d899SToby Isaac ierr = DMPlexRestoreTransitiveClosure(sp->dm,0,PETSC_TRUE,&closureSize,&closure);CHKERRQ(ierr); 273820cf1dd8SToby Isaac } 27393f27d899SToby Isaac for (p = 0; p < pEnd; p++) if (symperms[p]) break; 27403f27d899SToby Isaac if (p == pEnd) { 27413f27d899SToby Isaac ierr = PetscFree(symperms);CHKERRQ(ierr); 27423f27d899SToby Isaac symperms = NULL; 274320cf1dd8SToby Isaac } 27443f27d899SToby Isaac for (p = 0; p < pEnd; p++) if (symflips[p]) break; 27453f27d899SToby Isaac if (p == pEnd) { 27463f27d899SToby Isaac ierr = PetscFree(symflips);CHKERRQ(ierr); 27473f27d899SToby Isaac symflips = NULL; 274820cf1dd8SToby Isaac } 27493f27d899SToby Isaac lag->symperms = symperms; 27503f27d899SToby Isaac lag->symflips = symflips; 27513f27d899SToby Isaac lag->symComputed = PETSC_TRUE; 275220cf1dd8SToby Isaac } 27533f27d899SToby Isaac if (perms) *perms = (const PetscInt ***) lag->symperms; 27543f27d899SToby Isaac if (flips) *flips = (const PetscScalar ***) lag->symflips; 275520cf1dd8SToby Isaac PetscFunctionReturn(0); 275620cf1dd8SToby Isaac } 275720cf1dd8SToby Isaac 275820cf1dd8SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeGetContinuity_Lagrange(PetscDualSpace sp, PetscBool *continuous) 275920cf1dd8SToby Isaac { 276020cf1dd8SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data; 276120cf1dd8SToby Isaac 276220cf1dd8SToby Isaac PetscFunctionBegin; 276320cf1dd8SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 276420cf1dd8SToby Isaac PetscValidPointer(continuous, 2); 276520cf1dd8SToby Isaac *continuous = lag->continuous; 276620cf1dd8SToby Isaac PetscFunctionReturn(0); 276720cf1dd8SToby Isaac } 276820cf1dd8SToby Isaac 276920cf1dd8SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeSetContinuity_Lagrange(PetscDualSpace sp, PetscBool continuous) 277020cf1dd8SToby Isaac { 277120cf1dd8SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data; 277220cf1dd8SToby Isaac 277320cf1dd8SToby Isaac PetscFunctionBegin; 277420cf1dd8SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 277520cf1dd8SToby Isaac lag->continuous = continuous; 277620cf1dd8SToby Isaac PetscFunctionReturn(0); 277720cf1dd8SToby Isaac } 277820cf1dd8SToby Isaac 277920cf1dd8SToby Isaac /*@ 278020cf1dd8SToby Isaac PetscDualSpaceLagrangeGetContinuity - Retrieves the flag for element continuity 278120cf1dd8SToby Isaac 278220cf1dd8SToby Isaac Not Collective 278320cf1dd8SToby Isaac 278420cf1dd8SToby Isaac Input Parameter: 278520cf1dd8SToby Isaac . sp - the PetscDualSpace 278620cf1dd8SToby Isaac 278720cf1dd8SToby Isaac Output Parameter: 278820cf1dd8SToby Isaac . continuous - flag for element continuity 278920cf1dd8SToby Isaac 279020cf1dd8SToby Isaac Level: intermediate 279120cf1dd8SToby Isaac 279220cf1dd8SToby Isaac .seealso: PetscDualSpaceLagrangeSetContinuity() 279320cf1dd8SToby Isaac @*/ 279420cf1dd8SToby Isaac PetscErrorCode PetscDualSpaceLagrangeGetContinuity(PetscDualSpace sp, PetscBool *continuous) 279520cf1dd8SToby Isaac { 279620cf1dd8SToby Isaac PetscErrorCode ierr; 279720cf1dd8SToby Isaac 279820cf1dd8SToby Isaac PetscFunctionBegin; 279920cf1dd8SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 280020cf1dd8SToby Isaac PetscValidPointer(continuous, 2); 280120cf1dd8SToby Isaac ierr = PetscTryMethod(sp, "PetscDualSpaceLagrangeGetContinuity_C", (PetscDualSpace,PetscBool*),(sp,continuous));CHKERRQ(ierr); 280220cf1dd8SToby Isaac PetscFunctionReturn(0); 280320cf1dd8SToby Isaac } 280420cf1dd8SToby Isaac 280520cf1dd8SToby Isaac /*@ 280620cf1dd8SToby Isaac PetscDualSpaceLagrangeSetContinuity - Indicate whether the element is continuous 280720cf1dd8SToby Isaac 2808d083f849SBarry Smith Logically Collective on sp 280920cf1dd8SToby Isaac 281020cf1dd8SToby Isaac Input Parameters: 281120cf1dd8SToby Isaac + sp - the PetscDualSpace 281220cf1dd8SToby Isaac - continuous - flag for element continuity 281320cf1dd8SToby Isaac 281420cf1dd8SToby Isaac Options Database: 281520cf1dd8SToby Isaac . -petscdualspace_lagrange_continuity <bool> 281620cf1dd8SToby Isaac 281720cf1dd8SToby Isaac Level: intermediate 281820cf1dd8SToby Isaac 281920cf1dd8SToby Isaac .seealso: PetscDualSpaceLagrangeGetContinuity() 282020cf1dd8SToby Isaac @*/ 282120cf1dd8SToby Isaac PetscErrorCode PetscDualSpaceLagrangeSetContinuity(PetscDualSpace sp, PetscBool continuous) 282220cf1dd8SToby Isaac { 282320cf1dd8SToby Isaac PetscErrorCode ierr; 282420cf1dd8SToby Isaac 282520cf1dd8SToby Isaac PetscFunctionBegin; 282620cf1dd8SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 282720cf1dd8SToby Isaac PetscValidLogicalCollectiveBool(sp, continuous, 2); 282820cf1dd8SToby Isaac ierr = PetscTryMethod(sp, "PetscDualSpaceLagrangeSetContinuity_C", (PetscDualSpace,PetscBool),(sp,continuous));CHKERRQ(ierr); 282920cf1dd8SToby Isaac PetscFunctionReturn(0); 283020cf1dd8SToby Isaac } 283120cf1dd8SToby Isaac 28326f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceLagrangeGetTensor_Lagrange(PetscDualSpace sp, PetscBool *tensor) 283320cf1dd8SToby Isaac { 283420cf1dd8SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 28356f905325SMatthew G. Knepley 28366f905325SMatthew G. Knepley PetscFunctionBegin; 28376f905325SMatthew G. Knepley *tensor = lag->tensorSpace; 28386f905325SMatthew G. Knepley PetscFunctionReturn(0); 28396f905325SMatthew G. Knepley } 28406f905325SMatthew G. Knepley 28416f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceLagrangeSetTensor_Lagrange(PetscDualSpace sp, PetscBool tensor) 28426f905325SMatthew G. Knepley { 28436f905325SMatthew G. Knepley PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 28446f905325SMatthew G. Knepley 28456f905325SMatthew G. Knepley PetscFunctionBegin; 28466f905325SMatthew G. Knepley lag->tensorSpace = tensor; 28476f905325SMatthew G. Knepley PetscFunctionReturn(0); 28486f905325SMatthew G. Knepley } 28496f905325SMatthew G. Knepley 28503f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeGetTrimmed_Lagrange(PetscDualSpace sp, PetscBool *trimmed) 28513f27d899SToby Isaac { 28523f27d899SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 28533f27d899SToby Isaac 28543f27d899SToby Isaac PetscFunctionBegin; 28553f27d899SToby Isaac *trimmed = lag->trimmed; 28563f27d899SToby Isaac PetscFunctionReturn(0); 28573f27d899SToby Isaac } 28583f27d899SToby Isaac 28593f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeSetTrimmed_Lagrange(PetscDualSpace sp, PetscBool trimmed) 28603f27d899SToby Isaac { 28613f27d899SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 28623f27d899SToby Isaac 28633f27d899SToby Isaac PetscFunctionBegin; 28643f27d899SToby Isaac lag->trimmed = trimmed; 28653f27d899SToby Isaac PetscFunctionReturn(0); 28663f27d899SToby Isaac } 28673f27d899SToby Isaac 28683f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeGetNodeType_Lagrange(PetscDualSpace sp, PetscDTNodeType *nodeType, PetscBool *boundary, PetscReal *exponent) 28693f27d899SToby Isaac { 28703f27d899SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 28713f27d899SToby Isaac 28723f27d899SToby Isaac PetscFunctionBegin; 28733f27d899SToby Isaac if (nodeType) *nodeType = lag->nodeType; 28743f27d899SToby Isaac if (boundary) *boundary = lag->endNodes; 28753f27d899SToby Isaac if (exponent) *exponent = lag->nodeExponent; 28763f27d899SToby Isaac PetscFunctionReturn(0); 28773f27d899SToby Isaac } 28783f27d899SToby Isaac 28793f27d899SToby Isaac static PetscErrorCode PetscDualSpaceLagrangeSetNodeType_Lagrange(PetscDualSpace sp, PetscDTNodeType nodeType, PetscBool boundary, PetscReal exponent) 28803f27d899SToby Isaac { 28813f27d899SToby Isaac PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 28823f27d899SToby Isaac 28833f27d899SToby Isaac PetscFunctionBegin; 28843f27d899SToby Isaac if (nodeType == PETSCDTNODES_GAUSSJACOBI && exponent <= -1.) SETERRQ(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_OUTOFRANGE, "Exponent must be > -1"); 28853f27d899SToby Isaac lag->nodeType = nodeType; 28863f27d899SToby Isaac lag->endNodes = boundary; 28873f27d899SToby Isaac lag->nodeExponent = exponent; 28883f27d899SToby Isaac PetscFunctionReturn(0); 28893f27d899SToby Isaac } 28903f27d899SToby Isaac 2891*66a6c23cSMatthew G. Knepley static PetscErrorCode PetscDualSpaceLagrangeGetUseMoments_Lagrange(PetscDualSpace sp, PetscBool *useMoments) 2892*66a6c23cSMatthew G. Knepley { 2893*66a6c23cSMatthew G. Knepley PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 2894*66a6c23cSMatthew G. Knepley 2895*66a6c23cSMatthew G. Knepley PetscFunctionBegin; 2896*66a6c23cSMatthew G. Knepley *useMoments = lag->useMoments; 2897*66a6c23cSMatthew G. Knepley PetscFunctionReturn(0); 2898*66a6c23cSMatthew G. Knepley } 2899*66a6c23cSMatthew G. Knepley 2900*66a6c23cSMatthew G. Knepley static PetscErrorCode PetscDualSpaceLagrangeSetUseMoments_Lagrange(PetscDualSpace sp, PetscBool useMoments) 2901*66a6c23cSMatthew G. Knepley { 2902*66a6c23cSMatthew G. Knepley PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 2903*66a6c23cSMatthew G. Knepley 2904*66a6c23cSMatthew G. Knepley PetscFunctionBegin; 2905*66a6c23cSMatthew G. Knepley lag->useMoments = useMoments; 2906*66a6c23cSMatthew G. Knepley PetscFunctionReturn(0); 2907*66a6c23cSMatthew G. Knepley } 2908*66a6c23cSMatthew G. Knepley 2909*66a6c23cSMatthew G. Knepley static PetscErrorCode PetscDualSpaceLagrangeGetMomentOrder_Lagrange(PetscDualSpace sp, PetscInt *momentOrder) 2910*66a6c23cSMatthew G. Knepley { 2911*66a6c23cSMatthew G. Knepley PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 2912*66a6c23cSMatthew G. Knepley 2913*66a6c23cSMatthew G. Knepley PetscFunctionBegin; 2914*66a6c23cSMatthew G. Knepley *momentOrder = lag->momentOrder; 2915*66a6c23cSMatthew G. Knepley PetscFunctionReturn(0); 2916*66a6c23cSMatthew G. Knepley } 2917*66a6c23cSMatthew G. Knepley 2918*66a6c23cSMatthew G. Knepley static PetscErrorCode PetscDualSpaceLagrangeSetMomentOrder_Lagrange(PetscDualSpace sp, PetscInt momentOrder) 2919*66a6c23cSMatthew G. Knepley { 2920*66a6c23cSMatthew G. Knepley PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data; 2921*66a6c23cSMatthew G. Knepley 2922*66a6c23cSMatthew G. Knepley PetscFunctionBegin; 2923*66a6c23cSMatthew G. Knepley lag->momentOrder = momentOrder; 2924*66a6c23cSMatthew G. Knepley PetscFunctionReturn(0); 2925*66a6c23cSMatthew G. Knepley } 2926*66a6c23cSMatthew G. Knepley 29276f905325SMatthew G. Knepley /*@ 29286f905325SMatthew G. Knepley PetscDualSpaceLagrangeGetTensor - Get the tensor nature of the dual space 29296f905325SMatthew G. Knepley 29306f905325SMatthew G. Knepley Not collective 29316f905325SMatthew G. Knepley 29326f905325SMatthew G. Knepley Input Parameter: 29336f905325SMatthew G. Knepley . sp - The PetscDualSpace 29346f905325SMatthew G. Knepley 29356f905325SMatthew G. Knepley Output Parameter: 29366f905325SMatthew G. Knepley . tensor - Whether the dual space has tensor layout (vs. simplicial) 29376f905325SMatthew G. Knepley 29386f905325SMatthew G. Knepley Level: intermediate 29396f905325SMatthew G. Knepley 29406f905325SMatthew G. Knepley .seealso: PetscDualSpaceLagrangeSetTensor(), PetscDualSpaceCreate() 29416f905325SMatthew G. Knepley @*/ 29426f905325SMatthew G. Knepley PetscErrorCode PetscDualSpaceLagrangeGetTensor(PetscDualSpace sp, PetscBool *tensor) 29436f905325SMatthew G. Knepley { 294420cf1dd8SToby Isaac PetscErrorCode ierr; 294520cf1dd8SToby Isaac 294620cf1dd8SToby Isaac PetscFunctionBegin; 294720cf1dd8SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 29486f905325SMatthew G. Knepley PetscValidPointer(tensor, 2); 29496f905325SMatthew G. Knepley ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeGetTensor_C",(PetscDualSpace,PetscBool *),(sp,tensor));CHKERRQ(ierr); 295020cf1dd8SToby Isaac PetscFunctionReturn(0); 295120cf1dd8SToby Isaac } 295220cf1dd8SToby Isaac 29536f905325SMatthew G. Knepley /*@ 29546f905325SMatthew G. Knepley PetscDualSpaceLagrangeSetTensor - Set the tensor nature of the dual space 29556f905325SMatthew G. Knepley 29566f905325SMatthew G. Knepley Not collective 29576f905325SMatthew G. Knepley 29586f905325SMatthew G. Knepley Input Parameters: 29596f905325SMatthew G. Knepley + sp - The PetscDualSpace 29606f905325SMatthew G. Knepley - tensor - Whether the dual space has tensor layout (vs. simplicial) 29616f905325SMatthew G. Knepley 29626f905325SMatthew G. Knepley Level: intermediate 29636f905325SMatthew G. Knepley 29646f905325SMatthew G. Knepley .seealso: PetscDualSpaceLagrangeGetTensor(), PetscDualSpaceCreate() 29656f905325SMatthew G. Knepley @*/ 29666f905325SMatthew G. Knepley PetscErrorCode PetscDualSpaceLagrangeSetTensor(PetscDualSpace sp, PetscBool tensor) 29676f905325SMatthew G. Knepley { 29686f905325SMatthew G. Knepley PetscErrorCode ierr; 29696f905325SMatthew G. Knepley 29706f905325SMatthew G. Knepley PetscFunctionBegin; 29716f905325SMatthew G. Knepley PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 29726f905325SMatthew G. Knepley ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeSetTensor_C",(PetscDualSpace,PetscBool),(sp,tensor));CHKERRQ(ierr); 29736f905325SMatthew G. Knepley PetscFunctionReturn(0); 29746f905325SMatthew G. Knepley } 29756f905325SMatthew G. Knepley 29763f27d899SToby Isaac /*@ 29773f27d899SToby Isaac PetscDualSpaceLagrangeGetTrimmed - Get the trimmed nature of the dual space 29783f27d899SToby Isaac 29793f27d899SToby Isaac Not collective 29803f27d899SToby Isaac 29813f27d899SToby Isaac Input Parameter: 29823f27d899SToby Isaac . sp - The PetscDualSpace 29833f27d899SToby Isaac 29843f27d899SToby Isaac Output Parameter: 29853f27d899SToby 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) 29863f27d899SToby Isaac 29873f27d899SToby Isaac Level: intermediate 29883f27d899SToby Isaac 29893f27d899SToby Isaac .seealso: PetscDualSpaceLagrangeSetTrimmed(), PetscDualSpaceCreate() 29903f27d899SToby Isaac @*/ 29913f27d899SToby Isaac PetscErrorCode PetscDualSpaceLagrangeGetTrimmed(PetscDualSpace sp, PetscBool *trimmed) 29923f27d899SToby Isaac { 29933f27d899SToby Isaac PetscErrorCode ierr; 29943f27d899SToby Isaac 29953f27d899SToby Isaac PetscFunctionBegin; 29963f27d899SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 29973f27d899SToby Isaac PetscValidPointer(trimmed, 2); 29983f27d899SToby Isaac ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeGetTrimmed_C",(PetscDualSpace,PetscBool *),(sp,trimmed));CHKERRQ(ierr); 29993f27d899SToby Isaac PetscFunctionReturn(0); 30003f27d899SToby Isaac } 30013f27d899SToby Isaac 30023f27d899SToby Isaac /*@ 30033f27d899SToby Isaac PetscDualSpaceLagrangeSetTrimmed - Set the trimmed nature of the dual space 30043f27d899SToby Isaac 30053f27d899SToby Isaac Not collective 30063f27d899SToby Isaac 30073f27d899SToby Isaac Input Parameters: 30083f27d899SToby Isaac + sp - The PetscDualSpace 30093f27d899SToby 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) 30103f27d899SToby Isaac 30113f27d899SToby Isaac Level: intermediate 30123f27d899SToby Isaac 30133f27d899SToby Isaac .seealso: PetscDualSpaceLagrangeGetTrimmed(), PetscDualSpaceCreate() 30143f27d899SToby Isaac @*/ 30153f27d899SToby Isaac PetscErrorCode PetscDualSpaceLagrangeSetTrimmed(PetscDualSpace sp, PetscBool trimmed) 30163f27d899SToby Isaac { 30173f27d899SToby Isaac PetscErrorCode ierr; 30183f27d899SToby Isaac 30193f27d899SToby Isaac PetscFunctionBegin; 30203f27d899SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 30213f27d899SToby Isaac ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeSetTrimmed_C",(PetscDualSpace,PetscBool),(sp,trimmed));CHKERRQ(ierr); 30223f27d899SToby Isaac PetscFunctionReturn(0); 30233f27d899SToby Isaac } 30243f27d899SToby Isaac 30253f27d899SToby Isaac /*@ 30263f27d899SToby Isaac PetscDualSpaceLagrangeGetNodeType - Get a description of how nodes are laid out for Lagrange polynomials in this 30273f27d899SToby Isaac dual space 30283f27d899SToby Isaac 30293f27d899SToby Isaac Not collective 30303f27d899SToby Isaac 30313f27d899SToby Isaac Input Parameter: 30323f27d899SToby Isaac . sp - The PetscDualSpace 30333f27d899SToby Isaac 30343f27d899SToby Isaac Output Parameters: 30353f27d899SToby Isaac + nodeType - The type of nodes 30363f27d899SToby Isaac . boundary - Whether the node type is one that includes endpoints (if nodeType is PETSCDTNODES_GAUSSJACOBI, nodes that 30373f27d899SToby Isaac include the boundary are Gauss-Lobatto-Jacobi nodes) 30383f27d899SToby Isaac - exponent - If nodeType is PETSCDTNODES_GAUSJACOBI, indicates the exponent used for both ends of the 1D Jacobi weight function 30393f27d899SToby Isaac '0' is Gauss-Legendre, '-0.5' is Gauss-Chebyshev of the first type, '0.5' is Gauss-Chebyshev of the second type 30403f27d899SToby Isaac 30413f27d899SToby Isaac Level: advanced 30423f27d899SToby Isaac 30433f27d899SToby Isaac .seealso: PetscDTNodeType, PetscDualSpaceLagrangeSetNodeType() 30443f27d899SToby Isaac @*/ 30453f27d899SToby Isaac PetscErrorCode PetscDualSpaceLagrangeGetNodeType(PetscDualSpace sp, PetscDTNodeType *nodeType, PetscBool *boundary, PetscReal *exponent) 30463f27d899SToby Isaac { 30473f27d899SToby Isaac PetscErrorCode ierr; 30483f27d899SToby Isaac 30493f27d899SToby Isaac PetscFunctionBegin; 30503f27d899SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 30513f27d899SToby Isaac if (nodeType) PetscValidPointer(nodeType, 2); 30523f27d899SToby Isaac if (boundary) PetscValidPointer(boundary, 3); 30533f27d899SToby Isaac if (exponent) PetscValidPointer(exponent, 4); 30543f27d899SToby Isaac ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeGetNodeType_C",(PetscDualSpace,PetscDTNodeType *,PetscBool *,PetscReal *),(sp,nodeType,boundary,exponent));CHKERRQ(ierr); 30553f27d899SToby Isaac PetscFunctionReturn(0); 30563f27d899SToby Isaac } 30573f27d899SToby Isaac 30583f27d899SToby Isaac /*@ 30593f27d899SToby Isaac PetscDualSpaceLagrangeSetNodeType - Set a description of how nodes are laid out for Lagrange polynomials in this 30603f27d899SToby Isaac dual space 30613f27d899SToby Isaac 30623f27d899SToby Isaac Logically collective 30633f27d899SToby Isaac 30643f27d899SToby Isaac Input Parameters: 30653f27d899SToby Isaac + sp - The PetscDualSpace 30663f27d899SToby Isaac . nodeType - The type of nodes 30673f27d899SToby Isaac . boundary - Whether the node type is one that includes endpoints (if nodeType is PETSCDTNODES_GAUSSJACOBI, nodes that 30683f27d899SToby Isaac include the boundary are Gauss-Lobatto-Jacobi nodes) 30693f27d899SToby Isaac - exponent - If nodeType is PETSCDTNODES_GAUSJACOBI, indicates the exponent used for both ends of the 1D Jacobi weight function 30703f27d899SToby Isaac '0' is Gauss-Legendre, '-0.5' is Gauss-Chebyshev of the first type, '0.5' is Gauss-Chebyshev of the second type 30713f27d899SToby Isaac 30723f27d899SToby Isaac Level: advanced 30733f27d899SToby Isaac 30743f27d899SToby Isaac .seealso: PetscDTNodeType, PetscDualSpaceLagrangeGetNodeType() 30753f27d899SToby Isaac @*/ 30763f27d899SToby Isaac PetscErrorCode PetscDualSpaceLagrangeSetNodeType(PetscDualSpace sp, PetscDTNodeType nodeType, PetscBool boundary, PetscReal exponent) 30773f27d899SToby Isaac { 30783f27d899SToby Isaac PetscErrorCode ierr; 30793f27d899SToby Isaac 30803f27d899SToby Isaac PetscFunctionBegin; 30813f27d899SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 30823f27d899SToby Isaac ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeSetNodeType_C",(PetscDualSpace,PetscDTNodeType,PetscBool,PetscReal),(sp,nodeType,boundary,exponent));CHKERRQ(ierr); 30833f27d899SToby Isaac PetscFunctionReturn(0); 30843f27d899SToby Isaac } 30853f27d899SToby Isaac 3086*66a6c23cSMatthew G. Knepley /*@ 3087*66a6c23cSMatthew G. Knepley PetscDualSpaceLagrangeGetUseMoments - Get the flag for using moment functionals 3088*66a6c23cSMatthew G. Knepley 3089*66a6c23cSMatthew G. Knepley Not collective 3090*66a6c23cSMatthew G. Knepley 3091*66a6c23cSMatthew G. Knepley Input Parameter: 3092*66a6c23cSMatthew G. Knepley . sp - The PetscDualSpace 3093*66a6c23cSMatthew G. Knepley 3094*66a6c23cSMatthew G. Knepley Output Parameter: 3095*66a6c23cSMatthew G. Knepley . useMoments - Moment flag 3096*66a6c23cSMatthew G. Knepley 3097*66a6c23cSMatthew G. Knepley Level: advanced 3098*66a6c23cSMatthew G. Knepley 3099*66a6c23cSMatthew G. Knepley .seealso: PetscDualSpaceLagrangeSetUseMoments() 3100*66a6c23cSMatthew G. Knepley @*/ 3101*66a6c23cSMatthew G. Knepley PetscErrorCode PetscDualSpaceLagrangeGetUseMoments(PetscDualSpace sp, PetscBool *useMoments) 3102*66a6c23cSMatthew G. Knepley { 3103*66a6c23cSMatthew G. Knepley PetscErrorCode ierr; 3104*66a6c23cSMatthew G. Knepley 3105*66a6c23cSMatthew G. Knepley PetscFunctionBegin; 3106*66a6c23cSMatthew G. Knepley PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 3107*66a6c23cSMatthew G. Knepley PetscValidBoolPointer(useMoments, 2); 3108*66a6c23cSMatthew G. Knepley ierr = PetscUseMethod(sp,"PetscDualSpaceLagrangeGetUseMoments_C",(PetscDualSpace,PetscBool *),(sp,useMoments));CHKERRQ(ierr); 3109*66a6c23cSMatthew G. Knepley PetscFunctionReturn(0); 3110*66a6c23cSMatthew G. Knepley } 3111*66a6c23cSMatthew G. Knepley 3112*66a6c23cSMatthew G. Knepley /*@ 3113*66a6c23cSMatthew G. Knepley PetscDualSpaceLagrangeSetUseMoments - Set the flag for moment functionals 3114*66a6c23cSMatthew G. Knepley 3115*66a6c23cSMatthew G. Knepley Logically collective 3116*66a6c23cSMatthew G. Knepley 3117*66a6c23cSMatthew G. Knepley Input Parameters: 3118*66a6c23cSMatthew G. Knepley + sp - The PetscDualSpace 3119*66a6c23cSMatthew G. Knepley - useMoments - The flag for moment functionals 3120*66a6c23cSMatthew G. Knepley 3121*66a6c23cSMatthew G. Knepley Level: advanced 3122*66a6c23cSMatthew G. Knepley 3123*66a6c23cSMatthew G. Knepley .seealso: PetscDualSpaceLagrangeGetUseMoments() 3124*66a6c23cSMatthew G. Knepley @*/ 3125*66a6c23cSMatthew G. Knepley PetscErrorCode PetscDualSpaceLagrangeSetUseMoments(PetscDualSpace sp, PetscBool useMoments) 3126*66a6c23cSMatthew G. Knepley { 3127*66a6c23cSMatthew G. Knepley PetscErrorCode ierr; 3128*66a6c23cSMatthew G. Knepley 3129*66a6c23cSMatthew G. Knepley PetscFunctionBegin; 3130*66a6c23cSMatthew G. Knepley PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 3131*66a6c23cSMatthew G. Knepley ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeSetUseMoments_C",(PetscDualSpace,PetscBool),(sp,useMoments));CHKERRQ(ierr); 3132*66a6c23cSMatthew G. Knepley PetscFunctionReturn(0); 3133*66a6c23cSMatthew G. Knepley } 3134*66a6c23cSMatthew G. Knepley 3135*66a6c23cSMatthew G. Knepley /*@ 3136*66a6c23cSMatthew G. Knepley PetscDualSpaceLagrangeGetMomentOrder - Get the order for moment integration 3137*66a6c23cSMatthew G. Knepley 3138*66a6c23cSMatthew G. Knepley Not collective 3139*66a6c23cSMatthew G. Knepley 3140*66a6c23cSMatthew G. Knepley Input Parameter: 3141*66a6c23cSMatthew G. Knepley . sp - The PetscDualSpace 3142*66a6c23cSMatthew G. Knepley 3143*66a6c23cSMatthew G. Knepley Output Parameter: 3144*66a6c23cSMatthew G. Knepley . order - Moment integration order 3145*66a6c23cSMatthew G. Knepley 3146*66a6c23cSMatthew G. Knepley Level: advanced 3147*66a6c23cSMatthew G. Knepley 3148*66a6c23cSMatthew G. Knepley .seealso: PetscDualSpaceLagrangeSetMomentOrder() 3149*66a6c23cSMatthew G. Knepley @*/ 3150*66a6c23cSMatthew G. Knepley PetscErrorCode PetscDualSpaceLagrangeGetMomentOrder(PetscDualSpace sp, PetscInt *order) 3151*66a6c23cSMatthew G. Knepley { 3152*66a6c23cSMatthew G. Knepley PetscErrorCode ierr; 3153*66a6c23cSMatthew G. Knepley 3154*66a6c23cSMatthew G. Knepley PetscFunctionBegin; 3155*66a6c23cSMatthew G. Knepley PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 3156*66a6c23cSMatthew G. Knepley PetscValidIntPointer(order, 2); 3157*66a6c23cSMatthew G. Knepley ierr = PetscUseMethod(sp,"PetscDualSpaceLagrangeGetMomentOrder_C",(PetscDualSpace,PetscInt *),(sp,order));CHKERRQ(ierr); 3158*66a6c23cSMatthew G. Knepley PetscFunctionReturn(0); 3159*66a6c23cSMatthew G. Knepley } 3160*66a6c23cSMatthew G. Knepley 3161*66a6c23cSMatthew G. Knepley /*@ 3162*66a6c23cSMatthew G. Knepley PetscDualSpaceLagrangeSetMomentOrder - Set the order for moment integration 3163*66a6c23cSMatthew G. Knepley 3164*66a6c23cSMatthew G. Knepley Logically collective 3165*66a6c23cSMatthew G. Knepley 3166*66a6c23cSMatthew G. Knepley Input Parameters: 3167*66a6c23cSMatthew G. Knepley + sp - The PetscDualSpace 3168*66a6c23cSMatthew G. Knepley - order - The order for moment integration 3169*66a6c23cSMatthew G. Knepley 3170*66a6c23cSMatthew G. Knepley Level: advanced 3171*66a6c23cSMatthew G. Knepley 3172*66a6c23cSMatthew G. Knepley .seealso: PetscDualSpaceLagrangeGetMomentOrder() 3173*66a6c23cSMatthew G. Knepley @*/ 3174*66a6c23cSMatthew G. Knepley PetscErrorCode PetscDualSpaceLagrangeSetMomentOrder(PetscDualSpace sp, PetscInt order) 3175*66a6c23cSMatthew G. Knepley { 3176*66a6c23cSMatthew G. Knepley PetscErrorCode ierr; 3177*66a6c23cSMatthew G. Knepley 3178*66a6c23cSMatthew G. Knepley PetscFunctionBegin; 3179*66a6c23cSMatthew G. Knepley PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 3180*66a6c23cSMatthew G. Knepley ierr = PetscTryMethod(sp,"PetscDualSpaceLagrangeSetMomentOrder_C",(PetscDualSpace,PetscInt),(sp,order));CHKERRQ(ierr); 3181*66a6c23cSMatthew G. Knepley PetscFunctionReturn(0); 3182*66a6c23cSMatthew G. Knepley } 31833f27d899SToby Isaac 31846f905325SMatthew G. Knepley static PetscErrorCode PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp) 318520cf1dd8SToby Isaac { 318620cf1dd8SToby Isaac PetscFunctionBegin; 318720cf1dd8SToby Isaac sp->ops->destroy = PetscDualSpaceDestroy_Lagrange; 31886f905325SMatthew G. Knepley sp->ops->view = PetscDualSpaceView_Lagrange; 31896f905325SMatthew G. Knepley sp->ops->setfromoptions = PetscDualSpaceSetFromOptions_Lagrange; 319020cf1dd8SToby Isaac sp->ops->duplicate = PetscDualSpaceDuplicate_Lagrange; 31916f905325SMatthew G. Knepley sp->ops->setup = PetscDualSpaceSetUp_Lagrange; 31923f27d899SToby Isaac sp->ops->createheightsubspace = NULL; 31933f27d899SToby Isaac sp->ops->createpointsubspace = NULL; 319420cf1dd8SToby Isaac sp->ops->getsymmetries = PetscDualSpaceGetSymmetries_Lagrange; 319520cf1dd8SToby Isaac sp->ops->apply = PetscDualSpaceApplyDefault; 319620cf1dd8SToby Isaac sp->ops->applyall = PetscDualSpaceApplyAllDefault; 3197b4457527SToby Isaac sp->ops->applyint = PetscDualSpaceApplyInteriorDefault; 31983f27d899SToby Isaac sp->ops->createalldata = PetscDualSpaceCreateAllDataDefault; 3199b4457527SToby Isaac sp->ops->createintdata = PetscDualSpaceCreateInteriorDataDefault; 320020cf1dd8SToby Isaac PetscFunctionReturn(0); 320120cf1dd8SToby Isaac } 320220cf1dd8SToby Isaac 320320cf1dd8SToby Isaac /*MC 320420cf1dd8SToby Isaac PETSCDUALSPACELAGRANGE = "lagrange" - A PetscDualSpace object that encapsulates a dual space of pointwise evaluation functionals 320520cf1dd8SToby Isaac 320620cf1dd8SToby Isaac Level: intermediate 320720cf1dd8SToby Isaac 320820cf1dd8SToby Isaac .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType() 320920cf1dd8SToby Isaac M*/ 321020cf1dd8SToby Isaac PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Lagrange(PetscDualSpace sp) 321120cf1dd8SToby Isaac { 321220cf1dd8SToby Isaac PetscDualSpace_Lag *lag; 321320cf1dd8SToby Isaac PetscErrorCode ierr; 321420cf1dd8SToby Isaac 321520cf1dd8SToby Isaac PetscFunctionBegin; 321620cf1dd8SToby Isaac PetscValidHeaderSpecific(sp, PETSCDUALSPACE_CLASSID, 1); 321720cf1dd8SToby Isaac ierr = PetscNewLog(sp,&lag);CHKERRQ(ierr); 321820cf1dd8SToby Isaac sp->data = lag; 321920cf1dd8SToby Isaac 32203f27d899SToby Isaac lag->tensorCell = PETSC_FALSE; 322120cf1dd8SToby Isaac lag->tensorSpace = PETSC_FALSE; 322220cf1dd8SToby Isaac lag->continuous = PETSC_TRUE; 32233f27d899SToby Isaac lag->numCopies = PETSC_DEFAULT; 32243f27d899SToby Isaac lag->numNodeSkip = PETSC_DEFAULT; 32253f27d899SToby Isaac lag->nodeType = PETSCDTNODES_DEFAULT; 3226*66a6c23cSMatthew G. Knepley lag->useMoments = PETSC_FALSE; 3227*66a6c23cSMatthew G. Knepley lag->momentOrder = 0; 322820cf1dd8SToby Isaac 322920cf1dd8SToby Isaac ierr = PetscDualSpaceInitialize_Lagrange(sp);CHKERRQ(ierr); 323020cf1dd8SToby Isaac ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", PetscDualSpaceLagrangeGetContinuity_Lagrange);CHKERRQ(ierr); 323120cf1dd8SToby Isaac ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", PetscDualSpaceLagrangeSetContinuity_Lagrange);CHKERRQ(ierr); 323220cf1dd8SToby Isaac ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", PetscDualSpaceLagrangeGetTensor_Lagrange);CHKERRQ(ierr); 323320cf1dd8SToby Isaac ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", PetscDualSpaceLagrangeSetTensor_Lagrange);CHKERRQ(ierr); 32343f27d899SToby Isaac ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTrimmed_C", PetscDualSpaceLagrangeGetTrimmed_Lagrange);CHKERRQ(ierr); 32353f27d899SToby Isaac ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTrimmed_C", PetscDualSpaceLagrangeSetTrimmed_Lagrange);CHKERRQ(ierr); 32363f27d899SToby Isaac ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetNodeType_C", PetscDualSpaceLagrangeGetNodeType_Lagrange);CHKERRQ(ierr); 32373f27d899SToby Isaac ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetNodeType_C", PetscDualSpaceLagrangeSetNodeType_Lagrange);CHKERRQ(ierr); 3238*66a6c23cSMatthew G. Knepley ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetUseMoments_C", PetscDualSpaceLagrangeGetUseMoments_Lagrange);CHKERRQ(ierr); 3239*66a6c23cSMatthew G. Knepley ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetUseMoments_C", PetscDualSpaceLagrangeSetUseMoments_Lagrange);CHKERRQ(ierr); 3240*66a6c23cSMatthew G. Knepley ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetMomentOrder_C", PetscDualSpaceLagrangeGetMomentOrder_Lagrange);CHKERRQ(ierr); 3241*66a6c23cSMatthew G. Knepley ierr = PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetMomentOrder_C", PetscDualSpaceLagrangeSetMomentOrder_Lagrange);CHKERRQ(ierr); 324220cf1dd8SToby Isaac PetscFunctionReturn(0); 324320cf1dd8SToby Isaac } 3244