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