xref: /petsc/src/snes/tutorials/ex11.c (revision c28052fffaf1fc78ad5bd552ab6fd2c36087b321)
1*c28052ffSStefano Zampini static char help[] = "Poisson problem with finite elements.\n\
2*c28052ffSStefano Zampini We solve the Poisson problem using a parallel unstructured mesh to discretize it.\n\
3*c28052ffSStefano Zampini This example is a simplified version of ex12.c that only solves the linear problem.\n\
4*c28052ffSStefano Zampini It uses discretized auxiliary fields for coefficient and right-hand side, \n\
5*c28052ffSStefano Zampini supports multilevel solvers and non-conforming mesh refinement.\n\n\n";
6*c28052ffSStefano Zampini 
7*c28052ffSStefano Zampini /*
8*c28052ffSStefano Zampini Here we describe the PETSc approach to solve nonlinear problems arising from Finite Element (FE) discretizations.
9*c28052ffSStefano Zampini 
10*c28052ffSStefano Zampini The general model requires to solve the residual equations
11*c28052ffSStefano Zampini 
12*c28052ffSStefano Zampini     residual(u) := \int_\Omega \phi \cdot f_0(u, \nabla u, a, \nabla a) + \nabla \phi : f_1(u, \nabla u, a, \nabla a) = 0
13*c28052ffSStefano Zampini 
14*c28052ffSStefano Zampini where \phi is a test function, u is the sought FE solution, and a generically describes auxiliary data (for example material properties).
15*c28052ffSStefano Zampini 
16*c28052ffSStefano Zampini The functions f_0 (scalar) and f_1 (vector) describe the problem, while : is the usual contraction operator for tensors, i.e. A : B = \sum_{ij} A_{ij} B_{ij}.
17*c28052ffSStefano Zampini 
18*c28052ffSStefano Zampini The discrete residual is (with abuse of notation)
19*c28052ffSStefano Zampini 
20*c28052ffSStefano Zampini     F(u) := \sum_e E_e^T [ B^T_e W_{0,e} f_0(u_q, \nabla u_q, a_q, \nabla a_q) + D_e W_{1,e} f_1(u_q, \nabla u_q, a_q, \nabla a_q) ]
21*c28052ffSStefano Zampini 
22*c28052ffSStefano Zampini where E are element restriction matrices (can support non-conforming meshes), W are quadrature weights, B (resp. D) are basis function (resp. derivative of basis function) matrices, and u_q,a_q are vectors sampled at quadrature points.
23*c28052ffSStefano Zampini 
24*c28052ffSStefano Zampini Having the residual in the above form, it is straightforward to derive its Jacobian (again with abuse of notation)
25*c28052ffSStefano Zampini 
26*c28052ffSStefano Zampini     J(u) := \sum_e E_e^T [B^T_e D^T_e] W  J_e [ B_e^T, D_e^T ]^T E_e,
27*c28052ffSStefano Zampini 
28*c28052ffSStefano Zampini where J_e is the 2x2 matrix
29*c28052ffSStefano Zampini 
30*c28052ffSStefano Zampini    | \partial_u f_0, \partial_{\grad u} f_0 |
31*c28052ffSStefano Zampini    | \partial_u f_1, \partial_{\grad u} f_1 |
32*c28052ffSStefano Zampini 
33*c28052ffSStefano Zampini Here we use a single-field approach, but the extension to the multi-field case is straightforward.
34*c28052ffSStefano Zampini 
35*c28052ffSStefano Zampini To keep the presentation simple, here we are interested in solving the Poisson problem in divergence form
36*c28052ffSStefano Zampini 
37*c28052ffSStefano Zampini    - \nabla \cdot (K * \nabla u) = g
38*c28052ffSStefano Zampini 
39*c28052ffSStefano Zampini with either u = 0 or K * \partial_n u = 0 on \partial \Omega.
40*c28052ffSStefano Zampini The above problem possesses the weak form
41*c28052ffSStefano Zampini 
42*c28052ffSStefano Zampini    \int_\Omega \nabla \phi K \nabla u + \phi g = 0,
43*c28052ffSStefano Zampini 
44*c28052ffSStefano Zampini thus we have:
45*c28052ffSStefano Zampini 
46*c28052ffSStefano Zampini    f_0 = g, f_1 = K * \nabla u, and the only non-zero term of the Jacobian is J_{11} = K
47*c28052ffSStefano Zampini 
48*c28052ffSStefano Zampini See https://petsc.org/release/manual/fe the and the paper "Achieving High Performance with Unified Residual Evaluation" (available at https://arxiv.org/abs/1309.1204) for additional information.
49*c28052ffSStefano Zampini */
50*c28052ffSStefano Zampini 
51*c28052ffSStefano Zampini /* Include the necessary definitions */
52*c28052ffSStefano Zampini #include <petscdmplex.h>
53*c28052ffSStefano Zampini #include <petscsnes.h>
54*c28052ffSStefano Zampini #include <petscds.h>
55*c28052ffSStefano Zampini 
56*c28052ffSStefano Zampini /* The f_0 function: we read the right hand side from the first field of the auxiliary data */
57*c28052ffSStefano Zampini static void f_0(PetscInt dim, PetscInt Nf, PetscInt NfAux, const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[], const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[], PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f0[])
58*c28052ffSStefano Zampini {
59*c28052ffSStefano Zampini   const PetscScalar g = a[0];
60*c28052ffSStefano Zampini 
61*c28052ffSStefano Zampini   f0[0] = g;
62*c28052ffSStefano Zampini }
63*c28052ffSStefano Zampini 
64*c28052ffSStefano Zampini /* The f_1 function: we read the conductivity tensor from the second field of the auxiliary data */
65*c28052ffSStefano Zampini static void f_1(PetscInt dim, PetscInt Nf, PetscInt NfAux, const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[], const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[], PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar f1[])
66*c28052ffSStefano Zampini {
67*c28052ffSStefano Zampini   const PetscScalar *K = &a[1];
68*c28052ffSStefano Zampini 
69*c28052ffSStefano Zampini   for (PetscInt d1 = 0; d1 < dim; ++d1) {
70*c28052ffSStefano Zampini     PetscScalar v = 0;
71*c28052ffSStefano Zampini     for (PetscInt d2 = 0; d2 < dim; ++d2) v += K[d1 * dim + d2] * u_x[d2];
72*c28052ffSStefano Zampini     f1[d1] = v;
73*c28052ffSStefano Zampini   }
74*c28052ffSStefano Zampini }
75*c28052ffSStefano Zampini 
76*c28052ffSStefano Zampini /* The only non-zero term for the Jacobian is J_11 */
77*c28052ffSStefano Zampini static void J_11(PetscInt dim, PetscInt Nf, PetscInt NfAux, const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[], const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[], PetscReal t, PetscReal u_tShift, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar J11[])
78*c28052ffSStefano Zampini {
79*c28052ffSStefano Zampini   const PetscScalar *K = &a[1];
80*c28052ffSStefano Zampini 
81*c28052ffSStefano Zampini   for (PetscInt d1 = 0; d1 < dim; ++d1) {
82*c28052ffSStefano Zampini     for (PetscInt d2 = 0; d2 < dim; ++d2) J11[d1 * dim + d2] = K[d1 * dim + d2];
83*c28052ffSStefano Zampini   }
84*c28052ffSStefano Zampini }
85*c28052ffSStefano Zampini 
86*c28052ffSStefano Zampini /* The boundary conditions: Dirichlet (essential) or Neumann (natural) */
87*c28052ffSStefano Zampini typedef enum {
88*c28052ffSStefano Zampini   BC_DIRICHLET,
89*c28052ffSStefano Zampini   BC_NEUMANN,
90*c28052ffSStefano Zampini } bcType;
91*c28052ffSStefano Zampini 
92*c28052ffSStefano Zampini static const char *const bcTypes[] = {"DIRICHLET", "NEUMANN", "bcType", "BC_", 0};
93*c28052ffSStefano Zampini 
94*c28052ffSStefano Zampini /* The forcing term: constant or analytical */
95*c28052ffSStefano Zampini typedef enum {
96*c28052ffSStefano Zampini   RHS_CONSTANT,
97*c28052ffSStefano Zampini   RHS_ANALYTICAL,
98*c28052ffSStefano Zampini } rhsType;
99*c28052ffSStefano Zampini 
100*c28052ffSStefano Zampini static const char *const rhsTypes[] = {"CONSTANT", "ANALYTICAL", "rhsType", "RHS_", 0};
101*c28052ffSStefano Zampini 
102*c28052ffSStefano Zampini /* the constant case */
103*c28052ffSStefano Zampini static PetscErrorCode rhs_constant(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *g, void *ctx)
104*c28052ffSStefano Zampini {
105*c28052ffSStefano Zampini   *g = 1.0;
106*c28052ffSStefano Zampini   return PETSC_SUCCESS;
107*c28052ffSStefano Zampini }
108*c28052ffSStefano Zampini 
109*c28052ffSStefano Zampini /* the analytical case */
110*c28052ffSStefano Zampini static PetscErrorCode rhs_analytical(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *g, void *ctx)
111*c28052ffSStefano Zampini {
112*c28052ffSStefano Zampini   PetscScalar v = 1.0;
113*c28052ffSStefano Zampini   for (PetscInt d = 0; d < dim; d++) v *= PetscSinReal(2.0 * PETSC_PI * x[d]);
114*c28052ffSStefano Zampini   *g = v;
115*c28052ffSStefano Zampini   return PETSC_SUCCESS;
116*c28052ffSStefano Zampini }
117*c28052ffSStefano Zampini 
118*c28052ffSStefano Zampini /* For the Neumann BC case we need a functional to be integrated: average -> \int_\Omega u dx */
119*c28052ffSStefano Zampini static void average(PetscInt dim, PetscInt Nf, PetscInt NfAux, const PetscInt uOff[], const PetscInt uOff_x[], const PetscScalar u[], const PetscScalar u_t[], const PetscScalar u_x[], const PetscInt aOff[], const PetscInt aOff_x[], const PetscScalar a[], const PetscScalar a_t[], const PetscScalar a_x[], PetscReal t, const PetscReal x[], PetscInt numConstants, const PetscScalar constants[], PetscScalar obj[])
120*c28052ffSStefano Zampini {
121*c28052ffSStefano Zampini   obj[0] = u[0];
122*c28052ffSStefano Zampini }
123*c28052ffSStefano Zampini 
124*c28052ffSStefano Zampini /* The conductivity coefficient term: constant, checkerboard or analytical */
125*c28052ffSStefano Zampini typedef enum {
126*c28052ffSStefano Zampini   COEFF_CONSTANT,
127*c28052ffSStefano Zampini   COEFF_CHECKERBOARD,
128*c28052ffSStefano Zampini   COEFF_ANALYTICAL,
129*c28052ffSStefano Zampini } coeffType;
130*c28052ffSStefano Zampini 
131*c28052ffSStefano Zampini static const char *const coeffTypes[] = {"CONSTANT", "CHECKERBOARD", "ANALYTICAL", "coeffType", "COEFF_", 0};
132*c28052ffSStefano Zampini 
133*c28052ffSStefano Zampini /* the constant coefficient case */
134*c28052ffSStefano Zampini static PetscErrorCode coefficient_constant(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *K, void *ctx)
135*c28052ffSStefano Zampini {
136*c28052ffSStefano Zampini   for (PetscInt d = 0; d < dim; d++) K[d * dim + d] = 1.0;
137*c28052ffSStefano Zampini   return PETSC_SUCCESS;
138*c28052ffSStefano Zampini }
139*c28052ffSStefano Zampini 
140*c28052ffSStefano Zampini /* the checkerboard coefficient case: 10^2 in odd ranks, 10^-2 in even ranks */
141*c28052ffSStefano Zampini static PetscErrorCode coefficient_checkerboard(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *K, void *ctx)
142*c28052ffSStefano Zampini {
143*c28052ffSStefano Zampini   PetscScalar exponent = PetscGlobalRank % 2 ? 2.0 : -2.0;
144*c28052ffSStefano Zampini   for (PetscInt d = 0; d < dim; d++) K[d * dim + d] = PetscPowScalar(10.0, exponent);
145*c28052ffSStefano Zampini   return PETSC_SUCCESS;
146*c28052ffSStefano Zampini }
147*c28052ffSStefano Zampini 
148*c28052ffSStefano Zampini /* the analytical case (channels in diagonal with 4 order of magnitude in jumps) */
149*c28052ffSStefano Zampini static PetscErrorCode coefficient_analytical(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *K, void *ctx)
150*c28052ffSStefano Zampini {
151*c28052ffSStefano Zampini   for (PetscInt d = 0; d < dim; d++) {
152*c28052ffSStefano Zampini     const PetscReal v = PetscPowReal(10.0, 4.0 * PetscSinReal(4.0 * PETSC_PI * x[d]) * PetscCosReal(4.0 * PETSC_PI * x[d]));
153*c28052ffSStefano Zampini     K[d * dim + d]    = v;
154*c28052ffSStefano Zampini   }
155*c28052ffSStefano Zampini   return PETSC_SUCCESS;
156*c28052ffSStefano Zampini }
157*c28052ffSStefano Zampini 
158*c28052ffSStefano Zampini /* The application context that defines our problem */
159*c28052ffSStefano Zampini typedef struct {
160*c28052ffSStefano Zampini   bcType    bc;         /* type of boundary conditions */
161*c28052ffSStefano Zampini   rhsType   rhs;        /* type of right-hand side */
162*c28052ffSStefano Zampini   coeffType coeff;      /* type of conductivity coefficient */
163*c28052ffSStefano Zampini   PetscInt  order;      /* the polynomial order for the solution */
164*c28052ffSStefano Zampini   PetscInt  rhsOrder;   /* the polynomial order for the right-hand side */
165*c28052ffSStefano Zampini   PetscInt  coeffOrder; /* the polynomial order for the coefficient */
166*c28052ffSStefano Zampini   PetscBool p4est;      /* if we want to use non-conforming AMR */
167*c28052ffSStefano Zampini } AppCtx;
168*c28052ffSStefano Zampini 
169*c28052ffSStefano Zampini /* Process command line options */
170*c28052ffSStefano Zampini static PetscErrorCode ProcessOptions(MPI_Comm comm, AppCtx *options)
171*c28052ffSStefano Zampini {
172*c28052ffSStefano Zampini   PetscFunctionBeginUser;
173*c28052ffSStefano Zampini   options->bc         = BC_DIRICHLET;
174*c28052ffSStefano Zampini   options->rhs        = RHS_CONSTANT;
175*c28052ffSStefano Zampini   options->coeff      = COEFF_CONSTANT;
176*c28052ffSStefano Zampini   options->order      = 1;
177*c28052ffSStefano Zampini   options->rhsOrder   = 1;
178*c28052ffSStefano Zampini   options->coeffOrder = 1;
179*c28052ffSStefano Zampini   options->p4est      = PETSC_FALSE;
180*c28052ffSStefano Zampini 
181*c28052ffSStefano Zampini   PetscOptionsBegin(comm, "", "Poisson problem options", "DMPLEX");
182*c28052ffSStefano Zampini   PetscCall(PetscOptionsEnum("-bc_type", "Type of boundary condition", __FILE__, bcTypes, (PetscEnum)options->bc, (PetscEnum *)&options->bc, NULL));
183*c28052ffSStefano Zampini   PetscCall(PetscOptionsEnum("-rhs_type", "Type of forcing term", __FILE__, rhsTypes, (PetscEnum)options->rhs, (PetscEnum *)&options->rhs, NULL));
184*c28052ffSStefano Zampini   PetscCall(PetscOptionsEnum("-coefficient_type", "Type of conductivity coefficient", __FILE__, coeffTypes, (PetscEnum)options->coeff, (PetscEnum *)&options->coeff, NULL));
185*c28052ffSStefano Zampini   PetscCall(PetscOptionsInt("-order", "The polynomial order for the approximation of the solution", __FILE__, options->order, &options->order, NULL));
186*c28052ffSStefano Zampini   PetscCall(PetscOptionsInt("-rhs_order", "The polynomial order for the approximation of the right-hand side", __FILE__, options->rhsOrder, &options->rhsOrder, NULL));
187*c28052ffSStefano Zampini   PetscCall(PetscOptionsInt("-coefficient_order", "The polynomial order for the approximation of the coefficient", __FILE__, options->coeffOrder, &options->coeffOrder, NULL));
188*c28052ffSStefano Zampini   PetscCall(PetscOptionsBool("-p4est", "Use p4est to represent the mesh", __FILE__, options->p4est, &options->p4est, NULL));
189*c28052ffSStefano Zampini   PetscOptionsEnd();
190*c28052ffSStefano Zampini 
191*c28052ffSStefano Zampini   /* View processed options */
192*c28052ffSStefano Zampini   PetscCall(PetscPrintf(comm, "Simulation parameters\n"));
193*c28052ffSStefano Zampini   PetscCall(PetscPrintf(comm, "  polynomial order: %" PetscInt_FMT "\n", options->order));
194*c28052ffSStefano Zampini   PetscCall(PetscPrintf(comm, "  boundary conditions: %s\n", bcTypes[options->bc]));
195*c28052ffSStefano Zampini   PetscCall(PetscPrintf(comm, "  right-hand side: %s, order %" PetscInt_FMT "\n", rhsTypes[options->rhs], options->rhsOrder));
196*c28052ffSStefano Zampini   PetscCall(PetscPrintf(comm, "  coefficient: %s, order %" PetscInt_FMT "\n", coeffTypes[options->coeff], options->coeffOrder));
197*c28052ffSStefano Zampini   PetscCall(PetscPrintf(comm, "  non-conforming AMR: %d\n", options->p4est));
198*c28052ffSStefano Zampini   PetscFunctionReturn(PETSC_SUCCESS);
199*c28052ffSStefano Zampini }
200*c28052ffSStefano Zampini 
201*c28052ffSStefano Zampini /* Create mesh from command line options */
202*c28052ffSStefano Zampini static PetscErrorCode CreateMesh(MPI_Comm comm, AppCtx *user, DM *dm)
203*c28052ffSStefano Zampini {
204*c28052ffSStefano Zampini   PetscFunctionBeginUser;
205*c28052ffSStefano Zampini   /* Create various types of meshes only with command line options */
206*c28052ffSStefano Zampini   PetscCall(DMCreate(comm, dm));
207*c28052ffSStefano Zampini   PetscCall(DMSetType(*dm, DMPLEX));
208*c28052ffSStefano Zampini   PetscCall(DMSetOptionsPrefix(*dm, "initial_"));
209*c28052ffSStefano Zampini   PetscCall(DMPlexDistributeSetDefault(*dm, PETSC_FALSE));
210*c28052ffSStefano Zampini   PetscCall(DMSetFromOptions(*dm));
211*c28052ffSStefano Zampini   PetscCall(DMLocalizeCoordinates(*dm));
212*c28052ffSStefano Zampini   PetscCall(DMViewFromOptions(*dm, NULL, "-dm_view"));
213*c28052ffSStefano Zampini   PetscCall(DMPlexDistributeSetDefault(*dm, PETSC_TRUE));
214*c28052ffSStefano Zampini   PetscCall(DMSetOptionsPrefix(*dm, "mesh_"));
215*c28052ffSStefano Zampini   PetscCall(DMSetFromOptions(*dm));
216*c28052ffSStefano Zampini 
217*c28052ffSStefano Zampini   /* If requested convert to a format suitable for non-conforming adaptive mesh refinement */
218*c28052ffSStefano Zampini   if (user->p4est) {
219*c28052ffSStefano Zampini     PetscInt dim;
220*c28052ffSStefano Zampini     DM       dmConv;
221*c28052ffSStefano Zampini 
222*c28052ffSStefano Zampini     PetscCall(DMGetDimension(*dm, &dim));
223*c28052ffSStefano Zampini     PetscCheck(dim == 2 || dim == 3, comm, PETSC_ERR_SUP, "p4est support not for dimension %" PetscInt_FMT, dim);
224*c28052ffSStefano Zampini     PetscCall(DMConvert(*dm, dim == 3 ? DMP8EST : DMP4EST, &dmConv));
225*c28052ffSStefano Zampini     if (dmConv) {
226*c28052ffSStefano Zampini       PetscCall(DMDestroy(dm));
227*c28052ffSStefano Zampini       PetscCall(DMSetOptionsPrefix(dmConv, "mesh_"));
228*c28052ffSStefano Zampini       PetscCall(DMSetFromOptions(dmConv));
229*c28052ffSStefano Zampini       *dm = dmConv;
230*c28052ffSStefano Zampini     }
231*c28052ffSStefano Zampini   }
232*c28052ffSStefano Zampini   PetscCall(DMSetUp(*dm));
233*c28052ffSStefano Zampini 
234*c28052ffSStefano Zampini   /* View the mesh.
235*c28052ffSStefano Zampini      With a single call we can dump ASCII information, VTK data for visualization, store the mesh in HDF5 format, etc. */
236*c28052ffSStefano Zampini   PetscCall(PetscObjectSetName((PetscObject)*dm, "Mesh"));
237*c28052ffSStefano Zampini   PetscCall(DMViewFromOptions(*dm, NULL, "-dm_view"));
238*c28052ffSStefano Zampini   PetscFunctionReturn(PETSC_SUCCESS);
239*c28052ffSStefano Zampini }
240*c28052ffSStefano Zampini 
241*c28052ffSStefano Zampini /* Setup the discrete problem */
242*c28052ffSStefano Zampini static PetscErrorCode SetupProblem(DM dm, DM fdm, AppCtx *user)
243*c28052ffSStefano Zampini {
244*c28052ffSStefano Zampini   DM             plex, dmAux, cdm = NULL, coordDM;
245*c28052ffSStefano Zampini   Vec            auxData, auxDataGlobal;
246*c28052ffSStefano Zampini   PetscDS        ds;
247*c28052ffSStefano Zampini   DMPolytopeType ct;
248*c28052ffSStefano Zampini   PetscInt       dim, cdim, cStart;
249*c28052ffSStefano Zampini   PetscFE        fe, fe_rhs, fe_K;
250*c28052ffSStefano Zampini   PetscErrorCode (*auxFuncs[])(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar u[], void *ctx) = {NULL, NULL};
251*c28052ffSStefano Zampini   void *auxCtxs[]                                                                                                          = {NULL, NULL};
252*c28052ffSStefano Zampini 
253*c28052ffSStefano Zampini   PetscFunctionBeginUser;
254*c28052ffSStefano Zampini   /* Create the Finite Element for the solution and pass it to the problem DM */
255*c28052ffSStefano Zampini   PetscCall(DMGetDimension(dm, &dim));
256*c28052ffSStefano Zampini   PetscCall(DMConvert(dm, DMPLEX, &plex));
257*c28052ffSStefano Zampini   PetscCall(DMPlexGetHeightStratum(plex, 0, &cStart, NULL));
258*c28052ffSStefano Zampini   PetscCall(DMPlexGetCellType(plex, cStart, &ct));
259*c28052ffSStefano Zampini   PetscCall(DMDestroy(&plex));
260*c28052ffSStefano Zampini   PetscCall(PetscFECreateLagrangeByCell(PETSC_COMM_SELF, dim, 1, ct, user->order, PETSC_DETERMINE, &fe));
261*c28052ffSStefano Zampini   PetscCall(PetscObjectSetName((PetscObject)fe, "potential"));
262*c28052ffSStefano Zampini   PetscCall(DMSetField(dm, 0, NULL, (PetscObject)fe));
263*c28052ffSStefano Zampini   PetscCall(DMCreateDS(dm));
264*c28052ffSStefano Zampini 
265*c28052ffSStefano Zampini   /* Set residual and Jacobian callbacks */
266*c28052ffSStefano Zampini   PetscCall(DMGetDS(dm, &ds));
267*c28052ffSStefano Zampini   PetscCall(PetscDSSetResidual(ds, 0, f_0, f_1));
268*c28052ffSStefano Zampini   PetscCall(PetscDSSetJacobian(ds, 0, 0, NULL, NULL, NULL, J_11));
269*c28052ffSStefano Zampini   /* Tell DMPLEX we are going to use FEM callbacks */
270*c28052ffSStefano Zampini   PetscCall(DMPlexSetSNESLocalFEM(dm, PETSC_FALSE, &user));
271*c28052ffSStefano Zampini 
272*c28052ffSStefano Zampini   /* Create the Finite Element for the auxiliary data */
273*c28052ffSStefano Zampini   PetscCall(PetscFECreateLagrangeByCell(PETSC_COMM_SELF, dim, 1, ct, user->rhsOrder, PETSC_DETERMINE, &fe_rhs));
274*c28052ffSStefano Zampini   PetscCall(PetscObjectSetName((PetscObject)fe_rhs, "g"));
275*c28052ffSStefano Zampini   PetscCall(PetscFECopyQuadrature(fe, fe_rhs));
276*c28052ffSStefano Zampini   PetscCall(DMGetCoordinateDM(dm, &coordDM));
277*c28052ffSStefano Zampini   PetscCall(DMGetDimension(coordDM, &cdim));
278*c28052ffSStefano Zampini   PetscCall(PetscFECreateLagrangeByCell(PETSC_COMM_SELF, dim, cdim * cdim, ct, user->coeffOrder, PETSC_DETERMINE, &fe_K));
279*c28052ffSStefano Zampini   PetscCall(PetscObjectSetName((PetscObject)fe_K, "K"));
280*c28052ffSStefano Zampini   PetscCall(PetscFECopyQuadrature(fe, fe_K));
281*c28052ffSStefano Zampini   PetscCall(DMClone(dm, &dmAux));
282*c28052ffSStefano Zampini   PetscCall(DMSetField(dmAux, 0, NULL, (PetscObject)fe_rhs));
283*c28052ffSStefano Zampini   PetscCall(DMSetField(dmAux, 1, NULL, (PetscObject)fe_K));
284*c28052ffSStefano Zampini   PetscCall(DMCreateDS(dmAux));
285*c28052ffSStefano Zampini 
286*c28052ffSStefano Zampini   /* Project the requested rhs and K to the auxiliary DM and pass it to the problem DM */
287*c28052ffSStefano Zampini   PetscCall(DMCreateLocalVector(dmAux, &auxData));
288*c28052ffSStefano Zampini   PetscCall(DMCreateGlobalVector(dmAux, &auxDataGlobal));
289*c28052ffSStefano Zampini   PetscCall(PetscObjectSetName((PetscObject)auxData, ""));
290*c28052ffSStefano Zampini   if (!fdm) {
291*c28052ffSStefano Zampini     switch (user->rhs) {
292*c28052ffSStefano Zampini     case RHS_CONSTANT:
293*c28052ffSStefano Zampini       auxFuncs[0] = rhs_constant;
294*c28052ffSStefano Zampini       auxCtxs[0]  = NULL;
295*c28052ffSStefano Zampini       break;
296*c28052ffSStefano Zampini     case RHS_ANALYTICAL:
297*c28052ffSStefano Zampini       auxFuncs[0] = rhs_analytical;
298*c28052ffSStefano Zampini       auxCtxs[0]  = NULL;
299*c28052ffSStefano Zampini       break;
300*c28052ffSStefano Zampini     default:
301*c28052ffSStefano Zampini       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unsupported rhs type %s", rhsTypes[user->rhs]);
302*c28052ffSStefano Zampini     }
303*c28052ffSStefano Zampini     switch (user->coeff) {
304*c28052ffSStefano Zampini     case COEFF_CONSTANT:
305*c28052ffSStefano Zampini       auxFuncs[1] = coefficient_constant;
306*c28052ffSStefano Zampini       auxCtxs[1]  = NULL;
307*c28052ffSStefano Zampini       break;
308*c28052ffSStefano Zampini     case COEFF_CHECKERBOARD:
309*c28052ffSStefano Zampini       auxFuncs[1] = coefficient_checkerboard;
310*c28052ffSStefano Zampini       auxCtxs[1]  = NULL;
311*c28052ffSStefano Zampini       break;
312*c28052ffSStefano Zampini     case COEFF_ANALYTICAL:
313*c28052ffSStefano Zampini       auxFuncs[1] = coefficient_analytical;
314*c28052ffSStefano Zampini       auxCtxs[1]  = NULL;
315*c28052ffSStefano Zampini       break;
316*c28052ffSStefano Zampini     default:
317*c28052ffSStefano Zampini       SETERRQ(PetscObjectComm((PetscObject)dm), PETSC_ERR_SUP, "Unsupported coefficient type %s", coeffTypes[user->coeff]);
318*c28052ffSStefano Zampini     }
319*c28052ffSStefano Zampini     PetscCall(DMGetDS(dmAux, &ds));
320*c28052ffSStefano Zampini     PetscCall(DMProjectFunction(dmAux, 0.0, auxFuncs, auxCtxs, INSERT_ALL_VALUES, auxDataGlobal));
321*c28052ffSStefano Zampini     if (user->bc == BC_NEUMANN) {
322*c28052ffSStefano Zampini       PetscScalar vals[2];
323*c28052ffSStefano Zampini       PetscInt    rhs_id = 0;
324*c28052ffSStefano Zampini       IS          is;
325*c28052ffSStefano Zampini 
326*c28052ffSStefano Zampini       PetscCall(PetscDSSetObjective(ds, rhs_id, average));
327*c28052ffSStefano Zampini       PetscCall(DMPlexComputeIntegralFEM(dmAux, auxDataGlobal, vals, NULL));
328*c28052ffSStefano Zampini       PetscCall(DMCreateSubDM(dmAux, 1, &rhs_id, &is, NULL));
329*c28052ffSStefano Zampini       PetscCall(VecISShift(auxDataGlobal, is, -vals[rhs_id]));
330*c28052ffSStefano Zampini       PetscCall(DMPlexComputeIntegralFEM(dmAux, auxDataGlobal, vals, NULL));
331*c28052ffSStefano Zampini       PetscCall(ISDestroy(&is));
332*c28052ffSStefano Zampini     }
333*c28052ffSStefano Zampini   } else {
334*c28052ffSStefano Zampini     Mat J;
335*c28052ffSStefano Zampini     Vec auxDataGlobalf, auxDataf, Jscale;
336*c28052ffSStefano Zampini     DM  dmAuxf;
337*c28052ffSStefano Zampini 
338*c28052ffSStefano Zampini     PetscCall(DMGetAuxiliaryVec(fdm, NULL, 0, 0, &auxDataf));
339*c28052ffSStefano Zampini     PetscCall(VecGetDM(auxDataf, &dmAuxf));
340*c28052ffSStefano Zampini     PetscCall(DMSetCoarseDM(dmAuxf, dmAux));
341*c28052ffSStefano Zampini     PetscCall(DMCreateGlobalVector(dmAuxf, &auxDataGlobalf));
342*c28052ffSStefano Zampini     PetscCall(DMLocalToGlobal(dmAuxf, auxDataf, INSERT_VALUES, auxDataGlobalf));
343*c28052ffSStefano Zampini     PetscCall(DMCreateInterpolation(dmAux, dmAuxf, &J, &Jscale));
344*c28052ffSStefano Zampini     PetscCall(MatInterpolate(J, auxDataGlobalf, auxDataGlobal));
345*c28052ffSStefano Zampini     PetscCall(VecPointwiseMult(auxDataGlobal, auxDataGlobal, Jscale));
346*c28052ffSStefano Zampini     PetscCall(VecDestroy(&Jscale));
347*c28052ffSStefano Zampini     PetscCall(VecDestroy(&auxDataGlobalf));
348*c28052ffSStefano Zampini     PetscCall(MatDestroy(&J));
349*c28052ffSStefano Zampini     PetscCall(DMSetCoarseDM(dmAuxf, NULL));
350*c28052ffSStefano Zampini   }
351*c28052ffSStefano Zampini   /* auxiliary data must be a local vector */
352*c28052ffSStefano Zampini   PetscCall(DMGlobalToLocal(dmAux, auxDataGlobal, INSERT_VALUES, auxData));
353*c28052ffSStefano Zampini   { /* view auxiliary data */
354*c28052ffSStefano Zampini     PetscInt level;
355*c28052ffSStefano Zampini     char     optionName[PETSC_MAX_PATH_LEN];
356*c28052ffSStefano Zampini 
357*c28052ffSStefano Zampini     PetscCall(DMGetRefineLevel(dm, &level));
358*c28052ffSStefano Zampini     PetscCall(PetscSNPrintf(optionName, sizeof(optionName), "-aux_%" PetscInt_FMT "_vec_view", level));
359*c28052ffSStefano Zampini     PetscCall(VecViewFromOptions(auxData, NULL, optionName));
360*c28052ffSStefano Zampini   }
361*c28052ffSStefano Zampini   PetscCall(DMSetAuxiliaryVec(dm, NULL, 0, 0, auxData));
362*c28052ffSStefano Zampini   PetscCall(VecDestroy(&auxData));
363*c28052ffSStefano Zampini   PetscCall(VecDestroy(&auxDataGlobal));
364*c28052ffSStefano Zampini   PetscCall(DMDestroy(&dmAux));
365*c28052ffSStefano Zampini 
366*c28052ffSStefano Zampini   /* Setup boundary conditions
367*c28052ffSStefano Zampini      Since we use homogeneous natural boundary conditions for the Neumann problem we
368*c28052ffSStefano Zampini      only handle the Dirichlet case here */
369*c28052ffSStefano Zampini   if (user->bc == BC_DIRICHLET) {
370*c28052ffSStefano Zampini     DMLabel  label;
371*c28052ffSStefano Zampini     PetscInt id = 1;
372*c28052ffSStefano Zampini 
373*c28052ffSStefano Zampini     /* Label faces on the mesh boundary */
374*c28052ffSStefano Zampini     PetscCall(DMCreateLabel(dm, "boundary"));
375*c28052ffSStefano Zampini     PetscCall(DMGetLabel(dm, "boundary", &label));
376*c28052ffSStefano Zampini     PetscCall(DMPlexMarkBoundaryFaces(dm, 1, label));
377*c28052ffSStefano Zampini     PetscCall(DMAddBoundary(dm, DM_BC_ESSENTIAL, "dirichlet", label, 1, &id, 0, 0, NULL, NULL, NULL, NULL, NULL));
378*c28052ffSStefano Zampini   }
379*c28052ffSStefano Zampini 
380*c28052ffSStefano Zampini   /* Iterate on coarser mesh if present */
381*c28052ffSStefano Zampini   if (!user->p4est) PetscCall(DMGetCoarseDM(dm, &cdm));
382*c28052ffSStefano Zampini   if (cdm) PetscCall(SetupProblem(cdm, dm, user));
383*c28052ffSStefano Zampini 
384*c28052ffSStefano Zampini   PetscCall(PetscFEDestroy(&fe));
385*c28052ffSStefano Zampini   PetscCall(PetscFEDestroy(&fe_rhs));
386*c28052ffSStefano Zampini   PetscCall(PetscFEDestroy(&fe_K));
387*c28052ffSStefano Zampini   PetscFunctionReturn(PETSC_SUCCESS);
388*c28052ffSStefano Zampini }
389*c28052ffSStefano Zampini 
390*c28052ffSStefano Zampini /* We are now ready to run the simulation */
391*c28052ffSStefano Zampini int main(int argc, char **argv)
392*c28052ffSStefano Zampini {
393*c28052ffSStefano Zampini   DM     dm;   /* problem specification */
394*c28052ffSStefano Zampini   SNES   snes; /* nonlinear solver */
395*c28052ffSStefano Zampini   KSP    ksp;  /* linear solver */
396*c28052ffSStefano Zampini   Vec    u;    /* solution vector */
397*c28052ffSStefano Zampini   AppCtx user; /* user-defined work context */
398*c28052ffSStefano Zampini 
399*c28052ffSStefano Zampini   PetscFunctionBeginUser;
400*c28052ffSStefano Zampini   PetscCall(PetscInitialize(&argc, &argv, NULL, help));
401*c28052ffSStefano Zampini   PetscCall(ProcessOptions(PETSC_COMM_WORLD, &user));
402*c28052ffSStefano Zampini   PetscCall(CreateMesh(PETSC_COMM_WORLD, &user, &dm));
403*c28052ffSStefano Zampini   PetscCall(SetupProblem(dm, NULL, &user));
404*c28052ffSStefano Zampini 
405*c28052ffSStefano Zampini   PetscCall(SNESCreate(PETSC_COMM_WORLD, &snes));
406*c28052ffSStefano Zampini   PetscCall(SNESSetDM(snes, dm));
407*c28052ffSStefano Zampini   PetscCall(SNESSetType(snes, SNESKSPONLY));
408*c28052ffSStefano Zampini   PetscCall(SNESGetKSP(snes, &ksp));
409*c28052ffSStefano Zampini   PetscCall(KSPSetType(ksp, KSPCG));
410*c28052ffSStefano Zampini   PetscCall(KSPSetNormType(ksp, KSP_NORM_NATURAL));
411*c28052ffSStefano Zampini   PetscCall(SNESSetFromOptions(snes));
412*c28052ffSStefano Zampini 
413*c28052ffSStefano Zampini   PetscCall(DMCreateGlobalVector(dm, &u));
414*c28052ffSStefano Zampini   PetscCall(PetscObjectSetName((PetscObject)u, ""));
415*c28052ffSStefano Zampini   PetscCall(VecSetRandom(u, NULL));
416*c28052ffSStefano Zampini   PetscCall(SNESSolve(snes, NULL, u));
417*c28052ffSStefano Zampini   PetscCall(VecDestroy(&u));
418*c28052ffSStefano Zampini   PetscCall(SNESDestroy(&snes));
419*c28052ffSStefano Zampini   PetscCall(DMDestroy(&dm));
420*c28052ffSStefano Zampini   PetscCall(PetscFinalize());
421*c28052ffSStefano Zampini   return 0;
422*c28052ffSStefano Zampini }
423*c28052ffSStefano Zampini 
424*c28052ffSStefano Zampini /*TEST
425*c28052ffSStefano Zampini 
426*c28052ffSStefano Zampini   test:
427*c28052ffSStefano Zampini     suffix: 0
428*c28052ffSStefano Zampini     requires: triangle !single
429*c28052ffSStefano Zampini     args: -bc_type {{dirichlet neumann}separate output} -rhs_type {{constant analytical}separate output} -coefficient_type {{constant checkerboard analytical}separate output} -initial_dm_plex_simplex 1 -pc_type svd -snes_type newtonls -snes_error_if_not_converged
430*c28052ffSStefano Zampini 
431*c28052ffSStefano Zampini   test:
432*c28052ffSStefano Zampini     requires: !single
433*c28052ffSStefano Zampini     suffix: 0_quad
434*c28052ffSStefano Zampini     args: -bc_type {{dirichlet neumann}separate output} -rhs_type {{constant analytical}separate output} -coefficient_type {{constant checkerboard analytical}separate output} -initial_dm_plex_simplex 0 -pc_type svd -snes_type newtonls -snes_error_if_not_converged
435*c28052ffSStefano Zampini 
436*c28052ffSStefano Zampini   test:
437*c28052ffSStefano Zampini     suffix: 0_p4est
438*c28052ffSStefano Zampini     requires: p4est !single
439*c28052ffSStefano Zampini     args: -bc_type {{dirichlet neumann}separate output} -rhs_type {{constant analytical}separate output} -coefficient_type {{constant checkerboard analytical}separate output} -initial_dm_plex_simplex 0 -pc_type svd -snes_type newtonls -snes_error_if_not_converged
440*c28052ffSStefano Zampini 
441*c28052ffSStefano Zampini   test:
442*c28052ffSStefano Zampini     nsize: 2
443*c28052ffSStefano Zampini     suffix: hpddm
444*c28052ffSStefano Zampini     requires: hpddm slepc !single defined(PETSC_HAVE_DYNAMIC_LIBRARIES) defined(PETSC_USE_SHARED_LIBRARIES)
445*c28052ffSStefano Zampini     args: -pc_type hpddm -pc_hpddm_coarse_correction balanced -pc_hpddm_coarse_mat_type aij -pc_hpddm_coarse_pc_type lu -pc_hpddm_levels_eps_nev 1 -pc_hpddm_levels_sub_pc_type lu -ksp_monitor -initial_dm_plex_simplex 0 -petscpartitioner_type simple
446*c28052ffSStefano Zampini 
447*c28052ffSStefano Zampini   test:
448*c28052ffSStefano Zampini     nsize: 2
449*c28052ffSStefano Zampini     suffix: hpddm_p4est
450*c28052ffSStefano Zampini     requires: p4est hpddm slepc !single defined(PETSC_HAVE_DYNAMIC_LIBRARIES) defined(PETSC_USE_SHARED_LIBRARIES)
451*c28052ffSStefano Zampini     args: -pc_type hpddm -pc_hpddm_coarse_correction balanced -pc_hpddm_coarse_mat_type aij -pc_hpddm_coarse_pc_type lu -pc_hpddm_levels_eps_nev 1 -pc_hpddm_levels_sub_pc_type lu -ksp_monitor -initial_dm_plex_simplex 0 -p4est -petscpartitioner_type simple
452*c28052ffSStefano Zampini 
453*c28052ffSStefano Zampini   test:
454*c28052ffSStefano Zampini     nsize: 4
455*c28052ffSStefano Zampini     suffix: gdsw_corner
456*c28052ffSStefano Zampini     requires: triangle
457*c28052ffSStefano Zampini     args: -pc_type mg -pc_mg_galerkin -pc_mg_adapt_interp_coarse_space gdsw -pc_mg_levels 2 -mg_levels_pc_type asm -initial_dm_plex_shape ball -initial_dm_refine 2 -mesh_dm_mat_type {{aij is}} -mg_levels_sub_pc_type lu -mg_levels_pc_asm_type basic -petscpartitioner_type simple
458*c28052ffSStefano Zampini 
459*c28052ffSStefano Zampini TEST*/
460