xref: /libCEED/examples/petsc/src/petscutils.c (revision 751eb813a262a2147c23ac2e55685e7f0d6b8af0)
1 #include "../include/petscutils.h"
2 
3 // -----------------------------------------------------------------------------
4 // Convert PETSc MemType to libCEED MemType
5 // -----------------------------------------------------------------------------
6 CeedMemType MemTypeP2C(PetscMemType mem_type) {
7   return PetscMemTypeDevice(mem_type) ? CEED_MEM_DEVICE : CEED_MEM_HOST;
8 }
9 
10 // -----------------------------------------------------------------------------
11 // Apply 3D Kershaw mesh transformation
12 // -----------------------------------------------------------------------------
13 // Transition from a value of "a" for x=0, to a value of "b" for x=1.  Optionally
14 // smooth -- see the commented versions at the end.
15 static double step(const double a, const double b, double x) {
16   if (x <= 0) return a;
17   if (x >= 1) return b;
18   return a + (b-a) * (x);
19 }
20 
21 // 1D transformation at the right boundary
22 static double right(const double eps, const double x) {
23   return (x <= 0.5) ? (2-eps) * x : 1 + eps*(x-1);
24 }
25 
26 // 1D transformation at the left boundary
27 static double left(const double eps, const double x) {
28   return 1-right(eps,1-x);
29 }
30 
31 // Apply 3D Kershaw mesh transformation
32 // The eps parameters are in (0, 1]
33 // Uniform mesh is recovered for eps=1
34 PetscErrorCode Kershaw(DM dm_orig, PetscScalar eps) {
35   PetscErrorCode ierr;
36   Vec coord;
37   PetscInt ncoord;
38   PetscScalar *c;
39 
40   PetscFunctionBeginUser;
41   ierr = DMGetCoordinatesLocal(dm_orig, &coord); CHKERRQ(ierr);
42   ierr = VecGetLocalSize(coord, &ncoord); CHKERRQ(ierr);
43   ierr = VecGetArray(coord, &c); CHKERRQ(ierr);
44 
45   for (PetscInt i = 0; i < ncoord; i += 3) {
46     PetscScalar x = c[i], y = c[i+1], z = c[i+2];
47     PetscInt layer = x*6;
48     PetscScalar lambda = (x-layer/6.0)*6;
49     c[i] = x;
50 
51     switch (layer) {
52     case 0:
53       c[i+1] = left(eps, y);
54       c[i+2] = left(eps, z);
55       break;
56     case 1:
57     case 4:
58       c[i+1] = step(left(eps, y), right(eps, y), lambda);
59       c[i+2] = step(left(eps, z), right(eps, z), lambda);
60       break;
61     case 2:
62       c[i+1] = step(right(eps, y), left(eps, y), lambda/2);
63       c[i+2] = step(right(eps, z), left(eps, z), lambda/2);
64       break;
65     case 3:
66       c[i+1] = step(right(eps, y), left(eps, y), (1+lambda)/2);
67       c[i+2] = step(right(eps, z), left(eps, z), (1+lambda)/2);
68       break;
69     default:
70       c[i+1] = right(eps, y);
71       c[i+2] = right(eps, z);
72     }
73   }
74   ierr = VecRestoreArray(coord, &c); CHKERRQ(ierr);
75   PetscFunctionReturn(0);
76 }
77 
78 // -----------------------------------------------------------------------------
79 // Create BC label
80 // -----------------------------------------------------------------------------
81 static PetscErrorCode CreateBCLabel(DM dm, const char name[]) {
82 
83   DMLabel label;
84 
85   PetscFunctionBeginUser;
86 
87   PetscCall(DMCreateLabel(dm, name));
88   PetscCall(DMGetLabel(dm, name, &label));
89   PetscCall(DMPlexMarkBoundaryFaces(dm, PETSC_DETERMINE, label));
90   PetscCall(DMPlexLabelComplete(dm, label));
91 
92   PetscFunctionReturn(0);
93 };
94 
95 // -----------------------------------------------------------------------------
96 // This function sets up a DM for a given degree
97 // -----------------------------------------------------------------------------
98 PetscErrorCode SetupDMByDegree(DM dm, PetscInt p_degree, PetscInt q_extra,
99                                PetscInt num_comp_u,
100                                PetscInt dim, bool enforce_bc, BCFunction bc_func) {
101   PetscInt ierr, marker_ids[1] = {1};
102   PetscInt q_degree = p_degree + q_extra;
103   PetscFE fe;
104   MPI_Comm comm;
105   PetscBool      is_simplex = PETSC_TRUE;
106 
107   PetscFunctionBeginUser;
108 
109   // Check if simplex or tensor-product mesh
110   ierr = DMPlexIsSimplex(dm, &is_simplex); CHKERRQ(ierr);
111   // Setup FE
112   ierr = PetscObjectGetComm((PetscObject)dm, &comm); CHKERRQ(ierr);
113   ierr = PetscFECreateLagrange(comm, dim, num_comp_u, is_simplex, p_degree,
114                                q_degree, &fe); CHKERRQ(ierr);
115   ierr = DMAddField(dm, NULL, (PetscObject)fe); CHKERRQ(ierr);
116   ierr = DMCreateDS(dm); CHKERRQ(ierr);
117 
118   {
119     // create FE field for coordinates
120     PetscFE fe_coords;
121     PetscInt num_comp_coord;
122     ierr = DMGetCoordinateDim(dm, &num_comp_coord); CHKERRQ(ierr);
123     ierr = PetscFECreateLagrange(comm, dim, num_comp_coord, is_simplex, 1, q_degree,
124                                  &fe_coords); CHKERRQ(ierr);
125     ierr = DMProjectCoordinates(dm, fe_coords); CHKERRQ(ierr);
126     ierr = PetscFEDestroy(&fe_coords); CHKERRQ(ierr);
127   }
128 
129   // Setup DM
130   if (enforce_bc) {
131     PetscBool has_label;
132     DMHasLabel(dm, "marker", &has_label);
133     if (!has_label) {CreateBCLabel(dm, "marker");}
134     DMLabel label;
135     ierr = DMGetLabel(dm, "marker", &label); CHKERRQ(ierr);
136     ierr = DMAddBoundary(dm, DM_BC_ESSENTIAL, "wall", label, 1,
137                          marker_ids, 0, 0, NULL, (void(*)(void))bc_func,
138                          NULL, NULL, NULL); CHKERRQ(ierr);
139     PetscCall(DMSetOptionsPrefix(dm, "final_"));
140     PetscCall(DMViewFromOptions(dm, NULL, "-dm_view"));
141   }
142 
143   if (!is_simplex) {
144     DM dm_coord;
145     ierr = DMGetCoordinateDM(dm, &dm_coord); CHKERRQ(ierr);
146     ierr = DMPlexSetClosurePermutationTensor(dm, PETSC_DETERMINE, NULL);
147     CHKERRQ(ierr);
148     ierr = DMPlexSetClosurePermutationTensor(dm_coord, PETSC_DETERMINE, NULL);
149     CHKERRQ(ierr);
150   }
151   ierr = PetscFEDestroy(&fe); CHKERRQ(ierr);
152 
153   PetscFunctionReturn(0);
154 };
155 
156 // -----------------------------------------------------------------------------
157 // Get CEED restriction data from DMPlex
158 // -----------------------------------------------------------------------------
159 PetscErrorCode CreateRestrictionFromPlex(Ceed ceed, DM dm, CeedInt height,
160     DMLabel domain_label, CeedInt value, CeedElemRestriction *elem_restr) {
161   PetscInt num_elem, elem_size, num_dof, num_comp, *elem_restr_offsets;
162   PetscErrorCode ierr;
163 
164   PetscFunctionBeginUser;
165 
166   ierr = DMPlexGetLocalOffsets(dm, domain_label, value, height, 0, &num_elem,
167                                &elem_size, &num_comp, &num_dof, &elem_restr_offsets);
168   CHKERRQ(ierr);
169 
170   CeedElemRestrictionCreate(ceed, num_elem, elem_size, num_comp,
171                             1, num_dof, CEED_MEM_HOST, CEED_COPY_VALUES,
172                             elem_restr_offsets, elem_restr);
173   ierr = PetscFree(elem_restr_offsets); CHKERRQ(ierr);
174 
175   PetscFunctionReturn(0);
176 };
177 
178 // -----------------------------------------------------------------------------
179 // Utility function - convert from DMPolytopeType to CeedElemTopology
180 // -----------------------------------------------------------------------------
181 CeedElemTopology ElemTopologyP2C(DMPolytopeType cell_type) {
182   switch (cell_type) {
183   case DM_POLYTOPE_TRIANGLE:      return CEED_TOPOLOGY_TRIANGLE;
184   case DM_POLYTOPE_QUADRILATERAL: return CEED_TOPOLOGY_QUAD;
185   case DM_POLYTOPE_TETRAHEDRON:   return CEED_TOPOLOGY_TET;
186   case DM_POLYTOPE_HEXAHEDRON:    return CEED_TOPOLOGY_HEX;
187   default:                        return 0;
188   }
189 }
190 
191 // -----------------------------------------------------------------------------
192 // Get CEED Basis from DMPlex
193 // -----------------------------------------------------------------------------
194 PetscErrorCode CreateBasisFromPlex(Ceed ceed, DM dm, DMLabel domain_label,
195                                    CeedInt label_value, CeedInt height,
196                                    CeedInt dm_field, CeedBasis *basis) {
197   PetscErrorCode   ierr;
198   PetscDS          ds;
199   PetscFE          fe;
200   PetscQuadrature  quadrature;
201   PetscBool        is_simplex = PETSC_TRUE;
202   PetscInt         dim, ds_field = -1, num_comp, P, Q;
203 
204   PetscFunctionBeginUser;
205 
206   // Get basis information
207   {
208     IS             field_is;
209     const PetscInt *fields;
210     PetscInt       num_fields;
211 
212     ierr = DMGetRegionDS(dm, domain_label, &field_is, &ds); CHKERRQ(ierr);
213     // Translate dm_field to ds_field
214     ierr = ISGetIndices(field_is, &fields); CHKERRQ(ierr);
215     ierr = ISGetSize(field_is, &num_fields); CHKERRQ(ierr);
216     for (PetscInt i = 0; i < num_fields; i++) {
217       if (dm_field == fields[i]) {
218         ds_field = i;
219         break;
220       }
221     }
222     ierr = ISRestoreIndices(field_is, &fields); CHKERRQ(ierr);
223   }
224   if (ds_field == -1) {
225     // LCOV_EXCL_START
226     SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP,
227             "Could not find dm_field %" PetscInt_FMT " in DS", dm_field);
228     // LCOV_EXCL_STOP
229   }
230 
231   // Get element information
232   {
233     PetscDualSpace dual_space;
234     PetscInt       num_dual_basis_vectors;
235 
236     ierr = PetscDSGetDiscretization(ds, ds_field, (PetscObject *)&fe);
237     CHKERRQ(ierr);
238     ierr = PetscFEGetHeightSubspace(fe, height, &fe); CHKERRQ(ierr);
239     ierr = PetscFEGetSpatialDimension(fe, &dim); CHKERRQ(ierr);
240     ierr = PetscFEGetNumComponents(fe, &num_comp); CHKERRQ(ierr);
241     ierr = PetscFEGetDualSpace(fe, &dual_space); CHKERRQ(ierr);
242     ierr = PetscDualSpaceGetDimension(dual_space, &num_dual_basis_vectors);
243     CHKERRQ(ierr);
244     P = num_dual_basis_vectors / num_comp;
245     ierr = PetscFEGetQuadrature(fe, &quadrature); CHKERRQ(ierr);
246     ierr = PetscQuadratureGetData(quadrature, NULL, NULL, &Q, NULL, NULL);
247     CHKERRQ(ierr);
248   }
249 
250   // Check if simplex or tensor-product mesh
251   ierr = DMPlexIsSimplex(dm, &is_simplex); CHKERRQ(ierr);
252   // Build libCEED basis
253   if (is_simplex) {
254     PetscInt          num_derivatives = 1, first_point;
255     PetscInt          ids[1] = {label_value};
256     PetscTabulation   basis_tabulation;
257     const PetscScalar *q_points, *q_weights;
258     DMLabel           depth_label;
259     DMPolytopeType    cell_type;
260     CeedElemTopology  elem_topo;
261     PetscScalar       *interp, *grad;
262 
263     // Use depth label if no domain label present
264     if (!domain_label) {
265       PetscInt depth;
266 
267       ierr = DMPlexGetDepth(dm, &depth); CHKERRQ(ierr);
268       ierr = DMPlexGetDepthLabel(dm, &depth_label); CHKERRQ(ierr);
269       ids[0] = depth - height;
270     }
271     // Get cell interp, grad, and quadrature data
272     ierr = PetscFEGetCellTabulation(fe, num_derivatives, &basis_tabulation);
273     CHKERRQ(ierr);
274     ierr = PetscQuadratureGetData(quadrature, NULL, NULL, NULL, &q_points,
275                                   &q_weights); CHKERRQ(ierr);
276     ierr = DMGetFirstLabeledPoint(dm, dm, domain_label ? domain_label : depth_label,
277                                   1, ids, height, &first_point, NULL);
278     CHKERRQ(ierr);
279     ierr = DMPlexGetCellType(dm, first_point, &cell_type); CHKERRQ(ierr);
280     elem_topo = ElemTopologyP2C(cell_type);
281     if (!elem_topo) SETERRQ(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP,
282                               "DMPlex topology not supported");
283     // Convert to libCEED orientation
284     ierr = PetscCalloc(P * Q * sizeof(PetscScalar), &interp); CHKERRQ(ierr);
285     ierr = PetscCalloc(P * Q * dim * sizeof(PetscScalar), &grad); CHKERRQ(ierr);
286     const CeedInt c = 0;
287     for (CeedInt q = 0; q < Q; q++) {
288       for (CeedInt p = 0; p < P; p++) {
289         interp[q*P + p] = basis_tabulation->T[0][(q*P + p)*num_comp*num_comp + c];
290         for (CeedInt d = 0; d < dim; d++) {
291           grad[(d*Q + q)*P + p] = basis_tabulation->T[1][((q*P + p)*num_comp*num_comp + c)
292                                   *dim + d];
293         }
294       }
295     }
296     // Finaly, create libCEED basis
297     ierr = CeedBasisCreateH1(ceed, elem_topo, num_comp, P, Q, interp, grad,
298                              q_points, q_weights, basis);
299     CHKERRQ(ierr);
300     ierr = PetscFree(interp); CHKERRQ(ierr);
301     ierr = PetscFree(grad); CHKERRQ(ierr);
302   } else {
303     CeedInt P_1d = (CeedInt) round(pow(P, 1.0 / dim));
304     CeedInt Q_1d = (CeedInt) round(pow(Q, 1.0 / dim));
305 
306     ierr = CeedBasisCreateTensorH1Lagrange(ceed, dim, num_comp, P_1d, Q_1d,
307                                            CEED_GAUSS, basis);
308     CHKERRQ(ierr);
309   }
310 
311   PetscFunctionReturn(0);
312 };
313 
314 // -----------------------------------------------------------------------------
315 // Utilities
316 // -----------------------------------------------------------------------------
317 
318 // Utility function, compute three factors of an integer
319 static void Split3(PetscInt size, PetscInt m[3], bool reverse) {
320   for (PetscInt d=0, size_left=size; d<3; d++) {
321     PetscInt try = (PetscInt)PetscCeilReal(PetscPowReal(size_left, 1./(3 - d)));
322     while (try * (size_left / try) != size_left) try++;
323     m[reverse ? 2-d : d] = try;
324     size_left /= try;
325   }
326 }
327 
328 static int Max3(const PetscInt a[3]) {
329   return PetscMax(a[0], PetscMax(a[1], a[2]));
330 }
331 
332 static int Min3(const PetscInt a[3]) {
333   return PetscMin(a[0], PetscMin(a[1], a[2]));
334 }
335 
336 // -----------------------------------------------------------------------------
337 // Create distribute dm
338 // -----------------------------------------------------------------------------
339 PetscErrorCode CreateDistributedDM(RunParams rp, DM *dm) {
340   PetscErrorCode   ierr;
341 
342   PetscFunctionBeginUser;
343   // Setup DM
344   if (rp->read_mesh) {
345     ierr = DMPlexCreateFromFile(PETSC_COMM_WORLD, rp->filename, NULL, PETSC_TRUE,
346                                 dm);
347     CHKERRQ(ierr);
348   } else {
349     if (rp->user_l_nodes) {
350       // Find a nicely composite number of elements no less than global nodes
351       PetscMPIInt size;
352       ierr = MPI_Comm_size(rp->comm, &size); CHKERRQ(ierr);
353       for (PetscInt g_elem =
354              PetscMax(1, size * rp->local_nodes / PetscPowInt(rp->degree, rp->dim));
355            ;
356            g_elem++) {
357         Split3(g_elem, rp->mesh_elem, true);
358         if (Max3(rp->mesh_elem) / Min3(rp->mesh_elem) <= 2) break;
359       }
360     }
361     ierr = DMPlexCreateBoxMesh(PETSC_COMM_WORLD, rp->dim, rp->simplex,
362                                rp->mesh_elem,
363                                NULL, NULL, NULL, PETSC_TRUE, dm); CHKERRQ(ierr);
364   }
365 
366   ierr = DMSetFromOptions(*dm); CHKERRQ(ierr);
367   ierr = DMViewFromOptions(*dm, NULL, "-dm_view"); CHKERRQ(ierr);
368 
369   PetscFunctionReturn(0);
370 }
371 
372 // -----------------------------------------------------------------------------
373