#include "../include/petscutils.h" // ----------------------------------------------------------------------------- // Convert PETSc MemType to libCEED MemType // ----------------------------------------------------------------------------- CeedMemType MemTypeP2C(PetscMemType mtype) { return PetscMemTypeDevice(mtype) ? CEED_MEM_DEVICE : CEED_MEM_HOST; } // ----------------------------------------------------------------------------- // Utility function taken from petsc/src/dm/impls/plex/examples/tutorials/ex7.c // ----------------------------------------------------------------------------- PetscErrorCode ProjectToUnitSphere(DM dm) { Vec coordinates; PetscScalar *coords; PetscInt Nv, v, dim, d; PetscErrorCode ierr; PetscFunctionBeginUser; ierr = DMGetCoordinatesLocal(dm, &coordinates); CHKERRQ(ierr); ierr = VecGetLocalSize(coordinates, &Nv); CHKERRQ(ierr); ierr = VecGetBlockSize(coordinates, &dim); CHKERRQ(ierr); Nv /= dim; ierr = VecGetArray(coordinates, &coords); CHKERRQ(ierr); for (v = 0; v < Nv; ++v) { PetscReal r = 0.0; for (d = 0; d < dim; ++d) r += PetscSqr(PetscRealPart(coords[v*dim+d])); r = PetscSqrtReal(r); for (d = 0; d < dim; ++d) coords[v*dim+d] /= r; } ierr = VecRestoreArray(coordinates, &coords); CHKERRQ(ierr); PetscFunctionReturn(0); }; // ----------------------------------------------------------------------------- // Apply 3D Kershaw mesh transformation // ----------------------------------------------------------------------------- // Transition from a value of "a" for x=0, to a value of "b" for x=1. Optionally // smooth -- see the commented versions at the end. static double step(const double a, const double b, double x) { if (x <= 0) return a; if (x >= 1) return b; return a + (b-a) * (x); } // 1D transformation at the right boundary static double right(const double eps, const double x) { return (x <= 0.5) ? (2-eps) * x : 1 + eps*(x-1); } // 1D transformation at the left boundary static double left(const double eps, const double x) { return 1-right(eps,1-x); } // Apply 3D Kershaw mesh transformation // The eps parameters are in (0, 1] // Uniform mesh is recovered for eps=1 PetscErrorCode kershaw(DM dmorig, PetscScalar eps) { PetscErrorCode ierr; Vec coord; PetscInt ncoord; PetscScalar *c; PetscFunctionBeginUser; ierr = DMGetCoordinatesLocal(dmorig, &coord); CHKERRQ(ierr); ierr = VecGetLocalSize(coord, &ncoord); CHKERRQ(ierr); ierr = VecGetArray(coord, &c); CHKERRQ(ierr); for (PetscInt i = 0; i < ncoord; i += 3) { PetscScalar x = c[i], y = c[i+1], z = c[i+2]; PetscInt layer = x*6; PetscScalar lambda = (x-layer/6.0)*6; c[i] = x; switch (layer) { case 0: c[i+1] = left(eps, y); c[i+2] = left(eps, z); break; case 1: case 4: c[i+1] = step(left(eps, y), right(eps, y), lambda); c[i+2] = step(left(eps, z), right(eps, z), lambda); break; case 2: c[i+1] = step(right(eps, y), left(eps, y), lambda/2); c[i+2] = step(right(eps, z), left(eps, z), lambda/2); break; case 3: c[i+1] = step(right(eps, y), left(eps, y), (1+lambda)/2); c[i+2] = step(right(eps, z), left(eps, z), (1+lambda)/2); break; default: c[i+1] = right(eps, y); c[i+2] = right(eps, z); } } ierr = VecRestoreArray(coord, &c); CHKERRQ(ierr); PetscFunctionReturn(0); } // ----------------------------------------------------------------------------- // PETSc FE Boilerplate // ----------------------------------------------------------------------------- PetscErrorCode PetscFECreateByDegree(DM dm, PetscInt dim, PetscInt Nc, PetscBool isSimplex, const char prefix[], PetscInt order, PetscFE *fem) { PetscQuadrature q, fq; DM K; PetscSpace P; PetscDualSpace Q; PetscInt quadPointsPerEdge; PetscBool tensor = isSimplex ? PETSC_FALSE : PETSC_TRUE; PetscErrorCode ierr; PetscFunctionBeginUser; /* Create space */ ierr = PetscSpaceCreate(PetscObjectComm((PetscObject) dm), &P); CHKERRQ(ierr); ierr = PetscObjectSetOptionsPrefix((PetscObject) P, prefix); CHKERRQ(ierr); ierr = PetscSpacePolynomialSetTensor(P, tensor); CHKERRQ(ierr); ierr = PetscSpaceSetFromOptions(P); CHKERRQ(ierr); ierr = PetscSpaceSetNumComponents(P, Nc); CHKERRQ(ierr); ierr = PetscSpaceSetNumVariables(P, dim); CHKERRQ(ierr); ierr = PetscSpaceSetDegree(P, order, order); CHKERRQ(ierr); ierr = PetscSpaceSetUp(P); CHKERRQ(ierr); ierr = PetscSpacePolynomialGetTensor(P, &tensor); CHKERRQ(ierr); /* Create dual space */ ierr = PetscDualSpaceCreate(PetscObjectComm((PetscObject) dm), &Q); CHKERRQ(ierr); ierr = PetscDualSpaceSetType(Q,PETSCDUALSPACELAGRANGE); CHKERRQ(ierr); ierr = PetscObjectSetOptionsPrefix((PetscObject) Q, prefix); CHKERRQ(ierr); ierr = PetscDualSpaceCreateReferenceCell(Q, dim, isSimplex, &K); CHKERRQ(ierr); ierr = PetscDualSpaceSetDM(Q, K); CHKERRQ(ierr); ierr = DMDestroy(&K); CHKERRQ(ierr); ierr = PetscDualSpaceSetNumComponents(Q, Nc); CHKERRQ(ierr); ierr = PetscDualSpaceSetOrder(Q, order); CHKERRQ(ierr); ierr = PetscDualSpaceLagrangeSetTensor(Q, tensor); CHKERRQ(ierr); ierr = PetscDualSpaceSetFromOptions(Q); CHKERRQ(ierr); ierr = PetscDualSpaceSetUp(Q); CHKERRQ(ierr); /* Create element */ ierr = PetscFECreate(PetscObjectComm((PetscObject) dm), fem); CHKERRQ(ierr); ierr = PetscObjectSetOptionsPrefix((PetscObject) *fem, prefix); CHKERRQ(ierr); ierr = PetscFESetFromOptions(*fem); CHKERRQ(ierr); ierr = PetscFESetBasisSpace(*fem, P); CHKERRQ(ierr); ierr = PetscFESetDualSpace(*fem, Q); CHKERRQ(ierr); ierr = PetscFESetNumComponents(*fem, Nc); CHKERRQ(ierr); ierr = PetscFESetUp(*fem); CHKERRQ(ierr); ierr = PetscSpaceDestroy(&P); CHKERRQ(ierr); ierr = PetscDualSpaceDestroy(&Q); CHKERRQ(ierr); /* Create quadrature */ quadPointsPerEdge = PetscMax(order + 1,1); if (isSimplex) { ierr = PetscDTStroudConicalQuadrature(dim, 1, quadPointsPerEdge, -1.0, 1.0, &q); CHKERRQ(ierr); ierr = PetscDTStroudConicalQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq); CHKERRQ(ierr); } else { ierr = PetscDTGaussTensorQuadrature(dim, 1, quadPointsPerEdge, -1.0, 1.0, &q); CHKERRQ(ierr); ierr = PetscDTGaussTensorQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq); CHKERRQ(ierr); } ierr = PetscFESetQuadrature(*fem, q); CHKERRQ(ierr); ierr = PetscFESetFaceQuadrature(*fem, fq); CHKERRQ(ierr); ierr = PetscQuadratureDestroy(&q); CHKERRQ(ierr); ierr = PetscQuadratureDestroy(&fq); CHKERRQ(ierr); PetscFunctionReturn(0); }; // ----------------------------------------------------------------------------- // Create BC label // ----------------------------------------------------------------------------- static PetscErrorCode CreateBCLabel(DM dm, const char name[]) { int ierr; DMLabel label; PetscFunctionBeginUser; ierr = DMCreateLabel(dm, name); CHKERRQ(ierr); ierr = DMGetLabel(dm, name, &label); CHKERRQ(ierr); ierr = DMPlexMarkBoundaryFaces(dm, 1, label); CHKERRQ(ierr); ierr = DMPlexLabelComplete(dm, label); CHKERRQ(ierr); PetscFunctionReturn(0); }; // ----------------------------------------------------------------------------- // This function sets up a DM for a given degree // ----------------------------------------------------------------------------- PetscErrorCode SetupDMByDegree(DM dm, PetscInt degree, PetscInt ncompu, PetscInt dim, bool enforcebc, BCFunction bcsfunc) { PetscInt ierr, marker_ids[1] = {1}; PetscFE fe; PetscFunctionBeginUser; // Setup FE ierr = PetscFECreateByDegree(dm, dim, ncompu, PETSC_FALSE, NULL, degree, &fe); CHKERRQ(ierr); ierr = DMSetFromOptions(dm); CHKERRQ(ierr); ierr = DMAddField(dm, NULL, (PetscObject)fe); CHKERRQ(ierr); // Setup DM ierr = DMCreateDS(dm); CHKERRQ(ierr); if (enforcebc) { PetscBool hasLabel; DMHasLabel(dm, "marker", &hasLabel); if (!hasLabel) {CreateBCLabel(dm, "marker");} ierr = DMAddBoundary(dm, DM_BC_ESSENTIAL, "wall", "marker", 0, 0, NULL, (void(*)(void))bcsfunc, NULL, 1, marker_ids, NULL); CHKERRQ(ierr); } ierr = DMPlexSetClosurePermutationTensor(dm, PETSC_DETERMINE, NULL); CHKERRQ(ierr); ierr = PetscFEDestroy(&fe); CHKERRQ(ierr); PetscFunctionReturn(0); }; // ----------------------------------------------------------------------------- // Utility function - essential BC dofs are encoded in closure indices as -(i+1) // ----------------------------------------------------------------------------- PetscInt Involute(PetscInt i) { return i >= 0 ? i : -(i + 1); }; // ----------------------------------------------------------------------------- // Get CEED restriction data from DMPlex // ----------------------------------------------------------------------------- PetscErrorCode CreateRestrictionFromPlex(Ceed ceed, DM dm, CeedInt P, CeedInt topodim, CeedInt height, DMLabel domainLabel, CeedInt value, CeedElemRestriction *Erestrict) { PetscSection section; PetscInt p, Nelem, Ndof, *erestrict, eoffset, nfields, dim, depth; DMLabel depthLabel; IS depthIS, iterIS; Vec Uloc; const PetscInt *iterIndices; PetscErrorCode ierr; PetscFunctionBeginUser; ierr = DMGetDimension(dm, &dim); CHKERRQ(ierr); dim -= height; ierr = DMGetLocalSection(dm, §ion); CHKERRQ(ierr); ierr = PetscSectionGetNumFields(section, &nfields); CHKERRQ(ierr); PetscInt ncomp[nfields], fieldoff[nfields+1]; fieldoff[0] = 0; for (PetscInt f = 0; f < nfields; f++) { ierr = PetscSectionGetFieldComponents(section, f, &ncomp[f]); CHKERRQ(ierr); fieldoff[f+1] = fieldoff[f] + ncomp[f]; } ierr = DMPlexGetDepth(dm, &depth); CHKERRQ(ierr); ierr = DMPlexGetDepthLabel(dm, &depthLabel); CHKERRQ(ierr); ierr = DMLabelGetStratumIS(depthLabel, depth - height, &depthIS); CHKERRQ(ierr); if (domainLabel) { IS domainIS; ierr = DMLabelGetStratumIS(domainLabel, value, &domainIS); CHKERRQ(ierr); if (domainIS) { // domainIS is non-empty ierr = ISIntersect(depthIS, domainIS, &iterIS); CHKERRQ(ierr); ierr = ISDestroy(&domainIS); CHKERRQ(ierr); } else { // domainIS is NULL (empty) iterIS = NULL; } ierr = ISDestroy(&depthIS); CHKERRQ(ierr); } else { iterIS = depthIS; } if (iterIS) { ierr = ISGetLocalSize(iterIS, &Nelem); CHKERRQ(ierr); ierr = ISGetIndices(iterIS, &iterIndices); CHKERRQ(ierr); } else { Nelem = 0; iterIndices = NULL; } ierr = PetscMalloc1(Nelem*PetscPowInt(P, topodim), &erestrict); CHKERRQ(ierr); for (p = 0, eoffset = 0; p < Nelem; p++) { PetscInt c = iterIndices[p]; PetscInt numindices, *indices, nnodes; ierr = DMPlexGetClosureIndices(dm, section, section, c, PETSC_TRUE, &numindices, &indices, NULL, NULL); CHKERRQ(ierr); bool flip = false; if (height > 0) { PetscInt numCells, numFaces, start = -1; const PetscInt *orients, *faces, *cells; ierr = DMPlexGetSupport(dm, c, &cells); CHKERRQ(ierr); ierr = DMPlexGetSupportSize(dm, c, &numCells); CHKERRQ(ierr); if (numCells != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "Expected one cell in support of exterior face, but got %D cells", numCells); ierr = DMPlexGetCone(dm, cells[0], &faces); CHKERRQ(ierr); ierr = DMPlexGetConeSize(dm, cells[0], &numFaces); CHKERRQ(ierr); for (PetscInt i=0; i