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