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