PetscErrorCode SetupDiscretization(DM dm, AppCtx *user)
{
DM cdm = dm;
const PetscInt dim = user->dim;
const PetscInt id = 1;
PetscFE feAux = NULL;
PetscFE feBd = NULL;
PetscFE feCh = NULL;
PetscFE fe;
PetscDS prob;
PetscErrorCode ierr;
PetscFunctionBeginUser;
/* Create finite element */
ierr = PetscFECreateDefault(dm, dim, 1, PETSC_TRUE, NULL, -1, &fe);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) fe, "potential");CHKERRQ(ierr);
if (user->bcType == NEUMANN) {
ierr = PetscFECreateDefault(dm, dim-1, 1, PETSC_TRUE, "bd_", -1, &feBd);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) feBd, "potential");CHKERRQ(ierr);
}
if (user->variableCoefficient == COEFF_FIELD) {
PetscQuadrature q;
ierr = PetscFECreateDefault(dm, dim, 1, PETSC_TRUE, "mat_", -1, &feAux);CHKERRQ(ierr);
ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
ierr = PetscFESetQuadrature(feAux, q);CHKERRQ(ierr);
}
if (user->check) {ierr = PetscFECreateDefault(dm, dim, 1, PETSC_TRUE, "ch_", -1, &feCh);CHKERRQ(ierr);}
/* Set discretization and boundary conditions for each mesh */
while (cdm) {
ierr = DMGetDS(cdm, &prob);CHKERRQ(ierr);
ierr = PetscDSSetDiscretization(prob, 0, (PetscObject) fe);CHKERRQ(ierr);
ierr = PetscDSSetBdDiscretization(prob, 0, (PetscObject) feBd);CHKERRQ(ierr);
if (feAux) {
DM dmAux;
PetscDS probAux;
ierr = DMClone(cdm, &dmAux);CHKERRQ(ierr);
ierr = DMPlexCopyCoordinates(cdm, dmAux);CHKERRQ(ierr);
ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
ierr = PetscDSSetDiscretization(probAux, 0, (PetscObject) feAux);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) dm, "dmAux", (PetscObject) dmAux);CHKERRQ(ierr);
ierr = SetupMaterial(cdm, dmAux, user);CHKERRQ(ierr);
ierr = DMDestroy(&dmAux);CHKERRQ(ierr);
}
if (feCh) {
DM dmCh;
PetscDS probCh;
ierr = DMClone(cdm, &dmCh);CHKERRQ(ierr);
ierr = DMPlexCopyCoordinates(cdm, dmCh);CHKERRQ(ierr);
ierr = DMGetDS(dmCh, &probCh);CHKERRQ(ierr);
ierr = PetscDSSetDiscretization(probCh, 0, (PetscObject) feCh);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject) dm, "dmCh", (PetscObject) dmCh);CHKERRQ(ierr);
ierr = DMDestroy(&dmCh);CHKERRQ(ierr);
}
ierr = SetupProblem(cdm, user);CHKERRQ(ierr);
ierr = DMPlexAddBoundary(cdm, user->bcType == DIRICHLET, "wall", user->bcType == NEUMANN ? "boundary" : "marker", 0, user->exactFuncs[0], 1, &id, user);CHKERRQ(ierr);
ierr = DMPlexGetCoarseDM(cdm, &cdm);CHKERRQ(ierr);
}
ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
ierr = PetscFEDestroy(&feBd);CHKERRQ(ierr);
ierr = PetscFEDestroy(&feAux);CHKERRQ(ierr);
ierr = PetscFEDestroy(&feCh);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode CheckFunctions(DM dm, PetscInt order, Vec u, AppCtx *user)
{
void (*exactFuncs[3]) (const PetscReal x[], PetscScalar *u);
MPI_Comm comm;
PetscInt dim = user->dim, Nc;
PetscQuadrature fq;
PetscReal error, tol = 1.0e-10;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
ierr = PetscFEGetQuadrature(user->fe, &fq);CHKERRQ(ierr);
ierr = PetscFEGetNumComponents(user->fe, &Nc);CHKERRQ(ierr);
/* Setup functions to approximate */
switch (dim) {
case 2:
switch (order) {
case 0:
exactFuncs[0] = constant;
exactFuncs[1] = constant;
break;
case 1:
exactFuncs[0] = linear_x;
exactFuncs[1] = linear_y;
break;
case 2:
exactFuncs[0] = quadratic_xx;
exactFuncs[1] = quadratic_xy;
break;
default:
SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Could not determine functions to test for dimension %d order %d", dim, order);
}
break;
case 3:
switch (order) {
case 0:
exactFuncs[0] = constant;
exactFuncs[1] = constant;
exactFuncs[2] = constant;
break;
case 1:
exactFuncs[0] = linear_x;
exactFuncs[1] = linear_y;
exactFuncs[2] = linear_z;
break;
case 2:
exactFuncs[0] = quadratic_xy;
exactFuncs[1] = quadratic_yz;
exactFuncs[2] = quadratic_zx;
break;
default:
SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Could not determine functions to test for dimension %d order %d", dim, order);
}
break;
default:
SETERRQ1(comm, PETSC_ERR_ARG_OUTOFRANGE, "Could not determine functions to test for dimension %d", dim);
}
/* Project function into FE function space */
ierr = DMPlexProjectFunction(dm, &user->fe, exactFuncs, INSERT_ALL_VALUES, u);CHKERRQ(ierr);
/* Compare approximation to exact in L_2 */
ierr = DMPlexComputeL2Diff(dm, &user->fe, exactFuncs, u, &error);CHKERRQ(ierr);
if (error > tol) {
ierr = PetscPrintf(comm, "Tests FAIL for order %d at tolerance %g error %g\n", order, tol, error);CHKERRQ(ierr);
/* SETERRQ3(comm, PETSC_ERR_ARG_WRONG, "Input FIAT tabulation cannot resolve functions of order %d, error %g > %g", order, error, tol); */
} else {
ierr = PetscPrintf(comm, "Tests pass for order %d at tolerance %g\n", order, tol);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
