1 #include <petsc/private/dmpleximpl.h> /*I "petscdmplex.h" I*/
2 #include <petscsf.h>
3
4 #include <petsc/private/hashsetij.h>
5 #include <petsc/private/petscfeimpl.h>
6 #include <petsc/private/petscfvimpl.h>
7
DMPlexConvertPlex(DM dm,DM * plex,PetscBool copy)8 static PetscErrorCode DMPlexConvertPlex(DM dm, DM *plex, PetscBool copy)
9 {
10 PetscBool isPlex;
11 PetscErrorCode ierr;
12
13 PetscFunctionBegin;
14 ierr = PetscObjectTypeCompare((PetscObject) dm, DMPLEX, &isPlex);CHKERRQ(ierr);
15 if (isPlex) {
16 *plex = dm;
17 ierr = PetscObjectReference((PetscObject) dm);CHKERRQ(ierr);
18 } else {
19 ierr = PetscObjectQuery((PetscObject) dm, "dm_plex", (PetscObject *) plex);CHKERRQ(ierr);
20 if (!*plex) {
21 ierr = DMConvert(dm,DMPLEX,plex);CHKERRQ(ierr);
22 ierr = PetscObjectCompose((PetscObject) dm, "dm_plex", (PetscObject) *plex);CHKERRQ(ierr);
23 if (copy) {
24 const char *comps[3] = {"A", "dmAux"};
25 PetscObject obj;
26 PetscInt i;
27
28 {
29 /* Run the subdomain hook (this will copy the DMSNES/DMTS) */
30 DMSubDomainHookLink link;
31 for (link = dm->subdomainhook; link; link = link->next) {
32 if (link->ddhook) {ierr = (*link->ddhook)(dm, *plex, link->ctx);CHKERRQ(ierr);}
33 }
34 }
35 for (i = 0; i < 3; i++) {
36 ierr = PetscObjectQuery((PetscObject) dm, comps[i], &obj);CHKERRQ(ierr);
37 ierr = PetscObjectCompose((PetscObject) *plex, comps[i], obj);CHKERRQ(ierr);
38 }
39 }
40 } else {
41 ierr = PetscObjectReference((PetscObject) *plex);CHKERRQ(ierr);
42 }
43 }
44 PetscFunctionReturn(0);
45 }
46
PetscContainerUserDestroy_PetscFEGeom(void * ctx)47 static PetscErrorCode PetscContainerUserDestroy_PetscFEGeom (void *ctx)
48 {
49 PetscFEGeom *geom = (PetscFEGeom *) ctx;
50 PetscErrorCode ierr;
51
52 PetscFunctionBegin;
53 ierr = PetscFEGeomDestroy(&geom);CHKERRQ(ierr);
54 PetscFunctionReturn(0);
55 }
56
DMPlexGetFEGeom(DMField coordField,IS pointIS,PetscQuadrature quad,PetscBool faceData,PetscFEGeom ** geom)57 static PetscErrorCode DMPlexGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
58 {
59 char composeStr[33] = {0};
60 PetscObjectId id;
61 PetscContainer container;
62 PetscErrorCode ierr;
63
64 PetscFunctionBegin;
65 ierr = PetscObjectGetId((PetscObject)quad,&id);CHKERRQ(ierr);
66 ierr = PetscSNPrintf(composeStr, 32, "DMPlexGetFEGeom_%x\n", id);CHKERRQ(ierr);
67 ierr = PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);CHKERRQ(ierr);
68 if (container) {
69 ierr = PetscContainerGetPointer(container, (void **) geom);CHKERRQ(ierr);
70 } else {
71 ierr = DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);CHKERRQ(ierr);
72 ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr);
73 ierr = PetscContainerSetPointer(container, (void *) *geom);CHKERRQ(ierr);
74 ierr = PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);CHKERRQ(ierr);
75 ierr = PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);CHKERRQ(ierr);
76 ierr = PetscContainerDestroy(&container);CHKERRQ(ierr);
77 }
78 PetscFunctionReturn(0);
79 }
80
DMPlexRestoreFEGeom(DMField coordField,IS pointIS,PetscQuadrature quad,PetscBool faceData,PetscFEGeom ** geom)81 static PetscErrorCode DMPlexRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
82 {
83 PetscFunctionBegin;
84 *geom = NULL;
85 PetscFunctionReturn(0);
86 }
87
88 /*@
89 DMPlexGetScale - Get the scale for the specified fundamental unit
90
91 Not collective
92
93 Input Arguments:
94 + dm - the DM
95 - unit - The SI unit
96
97 Output Argument:
98 . scale - The value used to scale all quantities with this unit
99
100 Level: advanced
101
102 .seealso: DMPlexSetScale(), PetscUnit
103 @*/
DMPlexGetScale(DM dm,PetscUnit unit,PetscReal * scale)104 PetscErrorCode DMPlexGetScale(DM dm, PetscUnit unit, PetscReal *scale)
105 {
106 DM_Plex *mesh = (DM_Plex*) dm->data;
107
108 PetscFunctionBegin;
109 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
110 PetscValidPointer(scale, 3);
111 *scale = mesh->scale[unit];
112 PetscFunctionReturn(0);
113 }
114
115 /*@
116 DMPlexSetScale - Set the scale for the specified fundamental unit
117
118 Not collective
119
120 Input Arguments:
121 + dm - the DM
122 . unit - The SI unit
123 - scale - The value used to scale all quantities with this unit
124
125 Level: advanced
126
127 .seealso: DMPlexGetScale(), PetscUnit
128 @*/
DMPlexSetScale(DM dm,PetscUnit unit,PetscReal scale)129 PetscErrorCode DMPlexSetScale(DM dm, PetscUnit unit, PetscReal scale)
130 {
131 DM_Plex *mesh = (DM_Plex*) dm->data;
132
133 PetscFunctionBegin;
134 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
135 mesh->scale[unit] = scale;
136 PetscFunctionReturn(0);
137 }
138
DMPlexProjectRigidBody_Private(PetscInt dim,PetscReal t,const PetscReal X[],PetscInt Nc,PetscScalar * mode,void * ctx)139 static PetscErrorCode DMPlexProjectRigidBody_Private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nc, PetscScalar *mode, void *ctx)
140 {
141 const PetscInt eps[3][3][3] = {{{0, 0, 0}, {0, 0, 1}, {0, -1, 0}}, {{0, 0, -1}, {0, 0, 0}, {1, 0, 0}}, {{0, 1, 0}, {-1, 0, 0}, {0, 0, 0}}};
142 PetscInt *ctxInt = (PetscInt *) ctx;
143 PetscInt dim2 = ctxInt[0];
144 PetscInt d = ctxInt[1];
145 PetscInt i, j, k = dim > 2 ? d - dim : d;
146
147 PetscFunctionBegin;
148 if (dim != dim2) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Input dimension %D does not match context dimension %D", dim, dim2);
149 for (i = 0; i < dim; i++) mode[i] = 0.;
150 if (d < dim) {
151 mode[d] = 1.; /* Translation along axis d */
152 } else {
153 for (i = 0; i < dim; i++) {
154 for (j = 0; j < dim; j++) {
155 mode[j] += eps[i][j][k]*X[i]; /* Rotation about axis d */
156 }
157 }
158 }
159 PetscFunctionReturn(0);
160 }
161
162 /*@
163 DMPlexCreateRigidBody - For the default global section, create rigid body modes by function space interpolation
164
165 Collective on dm
166
167 Input Arguments:
168 + dm - the DM
169 - field - The field number for the rigid body space, or 0 for the default
170
171 Output Argument:
172 . sp - the null space
173
174 Note: This is necessary to provide a suitable coarse space for algebraic multigrid
175
176 Level: advanced
177
178 .seealso: MatNullSpaceCreate(), PCGAMG
179 @*/
DMPlexCreateRigidBody(DM dm,PetscInt field,MatNullSpace * sp)180 PetscErrorCode DMPlexCreateRigidBody(DM dm, PetscInt field, MatNullSpace *sp)
181 {
182 PetscErrorCode (**func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
183 MPI_Comm comm;
184 Vec mode[6];
185 PetscSection section, globalSection;
186 PetscInt dim, dimEmbed, Nf, n, m, mmin, d, i, j;
187 PetscErrorCode ierr;
188
189 PetscFunctionBegin;
190 ierr = PetscObjectGetComm((PetscObject) dm, &comm);CHKERRQ(ierr);
191 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
192 ierr = DMGetCoordinateDim(dm, &dimEmbed);CHKERRQ(ierr);
193 ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
194 if (Nf && (field < 0 || field >= Nf)) SETERRQ2(comm, PETSC_ERR_ARG_OUTOFRANGE, "Field %D is not in [0, Nf)", field, Nf);
195 if (dim == 1 && Nf < 2) {
196 ierr = MatNullSpaceCreate(comm, PETSC_TRUE, 0, NULL, sp);CHKERRQ(ierr);
197 PetscFunctionReturn(0);
198 }
199 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
200 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);
201 ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr);
202 ierr = PetscCalloc1(Nf, &func);CHKERRQ(ierr);
203 m = (dim*(dim+1))/2;
204 ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr);
205 ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr);
206 ierr = VecSetUp(mode[0]);CHKERRQ(ierr);
207 ierr = VecGetSize(mode[0], &n);CHKERRQ(ierr);
208 mmin = PetscMin(m, n);
209 func[field] = DMPlexProjectRigidBody_Private;
210 for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);}
211 for (d = 0; d < m; d++) {
212 PetscInt ctx[2];
213 void *voidctx = (void *) (&ctx[0]);
214
215 ctx[0] = dimEmbed;
216 ctx[1] = d;
217 ierr = DMProjectFunction(dm, 0.0, func, &voidctx, INSERT_VALUES, mode[d]);CHKERRQ(ierr);
218 }
219 /* Orthonormalize system */
220 for (i = 0; i < mmin; ++i) {
221 PetscScalar dots[6];
222
223 ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);
224 ierr = VecMDot(mode[i], mmin-i-1, mode+i+1, dots+i+1);CHKERRQ(ierr);
225 for (j = i+1; j < mmin; ++j) {
226 dots[j] *= -1.0;
227 ierr = VecAXPY(mode[j], dots[j], mode[i]);CHKERRQ(ierr);
228 }
229 }
230 ierr = MatNullSpaceCreate(comm, PETSC_FALSE, mmin, mode, sp);CHKERRQ(ierr);
231 for (i = 0; i < m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);}
232 ierr = PetscFree(func);CHKERRQ(ierr);
233 PetscFunctionReturn(0);
234 }
235
236 /*@
237 DMPlexCreateRigidBodies - For the default global section, create rigid body modes by function space interpolation
238
239 Collective on dm
240
241 Input Arguments:
242 + dm - the DM
243 . nb - The number of bodies
244 . label - The DMLabel marking each domain
245 . nids - The number of ids per body
246 - ids - An array of the label ids in sequence for each domain
247
248 Output Argument:
249 . sp - the null space
250
251 Note: This is necessary to provide a suitable coarse space for algebraic multigrid
252
253 Level: advanced
254
255 .seealso: MatNullSpaceCreate()
256 @*/
DMPlexCreateRigidBodies(DM dm,PetscInt nb,DMLabel label,const PetscInt nids[],const PetscInt ids[],MatNullSpace * sp)257 PetscErrorCode DMPlexCreateRigidBodies(DM dm, PetscInt nb, DMLabel label, const PetscInt nids[], const PetscInt ids[], MatNullSpace *sp)
258 {
259 MPI_Comm comm;
260 PetscSection section, globalSection;
261 Vec *mode;
262 PetscScalar *dots;
263 PetscInt dim, dimEmbed, n, m, b, d, i, j, off;
264 PetscErrorCode ierr;
265
266 PetscFunctionBegin;
267 ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
268 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
269 ierr = DMGetCoordinateDim(dm, &dimEmbed);CHKERRQ(ierr);
270 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
271 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);
272 ierr = PetscSectionGetConstrainedStorageSize(globalSection, &n);CHKERRQ(ierr);
273 m = nb * (dim*(dim+1))/2;
274 ierr = PetscMalloc2(m, &mode, m, &dots);CHKERRQ(ierr);
275 ierr = VecCreate(comm, &mode[0]);CHKERRQ(ierr);
276 ierr = VecSetSizes(mode[0], n, PETSC_DETERMINE);CHKERRQ(ierr);
277 ierr = VecSetUp(mode[0]);CHKERRQ(ierr);
278 for (i = 1; i < m; ++i) {ierr = VecDuplicate(mode[0], &mode[i]);CHKERRQ(ierr);}
279 for (b = 0, off = 0; b < nb; ++b) {
280 for (d = 0; d < m/nb; ++d) {
281 PetscInt ctx[2];
282 PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *) = DMPlexProjectRigidBody_Private;
283 void *voidctx = (void *) (&ctx[0]);
284
285 ctx[0] = dimEmbed;
286 ctx[1] = d;
287 ierr = DMProjectFunctionLabel(dm, 0.0, label, nids[b], &ids[off], 0, NULL, &func, &voidctx, INSERT_VALUES, mode[d]);CHKERRQ(ierr);
288 off += nids[b];
289 }
290 }
291 /* Orthonormalize system */
292 for (i = 0; i < m; ++i) {
293 PetscScalar dots[6];
294
295 ierr = VecNormalize(mode[i], NULL);CHKERRQ(ierr);
296 ierr = VecMDot(mode[i], m-i-1, mode+i+1, dots+i+1);CHKERRQ(ierr);
297 for (j = i+1; j < m; ++j) {
298 dots[j] *= -1.0;
299 ierr = VecAXPY(mode[j], dots[j], mode[i]);CHKERRQ(ierr);
300 }
301 }
302 ierr = MatNullSpaceCreate(comm, PETSC_FALSE, m, mode, sp);CHKERRQ(ierr);
303 for (i = 0; i< m; ++i) {ierr = VecDestroy(&mode[i]);CHKERRQ(ierr);}
304 ierr = PetscFree2(mode, dots);CHKERRQ(ierr);
305 PetscFunctionReturn(0);
306 }
307
308 /*@
309 DMPlexSetMaxProjectionHeight - In DMPlexProjectXXXLocal() functions, the projected values of a basis function's dofs
310 are computed by associating the basis function with one of the mesh points in its transitively-closed support, and
311 evaluating the dual space basis of that point. A basis function is associated with the point in its
312 transitively-closed support whose mesh height is highest (w.r.t. DAG height), but not greater than the maximum
313 projection height, which is set with this function. By default, the maximum projection height is zero, which means
314 that only mesh cells are used to project basis functions. A height of one, for example, evaluates a cell-interior
315 basis functions using its cells dual space basis, but all other basis functions with the dual space basis of a face.
316
317 Input Parameters:
318 + dm - the DMPlex object
319 - height - the maximum projection height >= 0
320
321 Level: advanced
322
323 .seealso: DMPlexGetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal()
324 @*/
DMPlexSetMaxProjectionHeight(DM dm,PetscInt height)325 PetscErrorCode DMPlexSetMaxProjectionHeight(DM dm, PetscInt height)
326 {
327 DM_Plex *plex = (DM_Plex *) dm->data;
328
329 PetscFunctionBegin;
330 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
331 plex->maxProjectionHeight = height;
332 PetscFunctionReturn(0);
333 }
334
335 /*@
336 DMPlexGetMaxProjectionHeight - Get the maximum height (w.r.t. DAG) of mesh points used to evaluate dual bases in
337 DMPlexProjectXXXLocal() functions.
338
339 Input Parameters:
340 . dm - the DMPlex object
341
342 Output Parameters:
343 . height - the maximum projection height
344
345 Level: intermediate
346
347 .seealso: DMPlexSetMaxProjectionHeight(), DMProjectFunctionLocal(), DMProjectFunctionLabelLocal()
348 @*/
DMPlexGetMaxProjectionHeight(DM dm,PetscInt * height)349 PetscErrorCode DMPlexGetMaxProjectionHeight(DM dm, PetscInt *height)
350 {
351 DM_Plex *plex = (DM_Plex *) dm->data;
352
353 PetscFunctionBegin;
354 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
355 *height = plex->maxProjectionHeight;
356 PetscFunctionReturn(0);
357 }
358
359 typedef struct {
360 PetscReal alpha; /* The first Euler angle, and in 2D the only one */
361 PetscReal beta; /* The second Euler angle */
362 PetscReal gamma; /* The third Euler angle */
363 PetscInt dim; /* The dimension of R */
364 PetscScalar *R; /* The rotation matrix, transforming a vector in the local basis to the global basis */
365 PetscScalar *RT; /* The transposed rotation matrix, transforming a vector in the global basis to the local basis */
366 } RotCtx;
367
368 /*
369 Note: Following https://en.wikipedia.org/wiki/Euler_angles, we will specify Euler angles by extrinsic rotations, meaning that
370 we rotate with respect to a fixed initial coordinate system, the local basis (x-y-z). The global basis (X-Y-Z) is reached as follows:
371 $ The XYZ system rotates about the z axis by alpha. The X axis is now at angle alpha with respect to the x axis.
372 $ The XYZ system rotates again about the x axis by beta. The Z axis is now at angle beta with respect to the z axis.
373 $ The XYZ system rotates a third time about the z axis by gamma.
374 */
DMPlexBasisTransformSetUp_Rotation_Internal(DM dm,void * ctx)375 static PetscErrorCode DMPlexBasisTransformSetUp_Rotation_Internal(DM dm, void *ctx)
376 {
377 RotCtx *rc = (RotCtx *) ctx;
378 PetscInt dim = rc->dim;
379 PetscReal c1, s1, c2, s2, c3, s3;
380 PetscErrorCode ierr;
381
382 PetscFunctionBegin;
383 ierr = PetscMalloc2(PetscSqr(dim), &rc->R, PetscSqr(dim), &rc->RT);CHKERRQ(ierr);
384 switch (dim) {
385 case 2:
386 c1 = PetscCosReal(rc->alpha);s1 = PetscSinReal(rc->alpha);
387 rc->R[0] = c1;rc->R[1] = s1;
388 rc->R[2] = -s1;rc->R[3] = c1;
389 ierr = PetscArraycpy(rc->RT, rc->R, PetscSqr(dim));CHKERRQ(ierr);
390 DMPlex_Transpose2D_Internal(rc->RT);break;
391 break;
392 case 3:
393 c1 = PetscCosReal(rc->alpha);s1 = PetscSinReal(rc->alpha);
394 c2 = PetscCosReal(rc->beta); s2 = PetscSinReal(rc->beta);
395 c3 = PetscCosReal(rc->gamma);s3 = PetscSinReal(rc->gamma);
396 rc->R[0] = c1*c3 - c2*s1*s3;rc->R[1] = c3*s1 + c1*c2*s3;rc->R[2] = s2*s3;
397 rc->R[3] = -c1*s3 - c2*c3*s1;rc->R[4] = c1*c2*c3 - s1*s3; rc->R[5] = c3*s2;
398 rc->R[6] = s1*s2; rc->R[7] = -c1*s2; rc->R[8] = c2;
399 ierr = PetscArraycpy(rc->RT, rc->R, PetscSqr(dim));CHKERRQ(ierr);
400 DMPlex_Transpose3D_Internal(rc->RT);break;
401 break;
402 default: SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_OUTOFRANGE, "Dimension %D not supported", dim);
403 }
404 PetscFunctionReturn(0);
405 }
406
DMPlexBasisTransformDestroy_Rotation_Internal(DM dm,void * ctx)407 static PetscErrorCode DMPlexBasisTransformDestroy_Rotation_Internal(DM dm, void *ctx)
408 {
409 RotCtx *rc = (RotCtx *) ctx;
410 PetscErrorCode ierr;
411
412 PetscFunctionBegin;
413 ierr = PetscFree2(rc->R, rc->RT);CHKERRQ(ierr);
414 ierr = PetscFree(rc);CHKERRQ(ierr);
415 PetscFunctionReturn(0);
416 }
417
DMPlexBasisTransformGetMatrix_Rotation_Internal(DM dm,const PetscReal x[],PetscBool l2g,const PetscScalar ** A,void * ctx)418 static PetscErrorCode DMPlexBasisTransformGetMatrix_Rotation_Internal(DM dm, const PetscReal x[], PetscBool l2g, const PetscScalar **A, void *ctx)
419 {
420 RotCtx *rc = (RotCtx *) ctx;
421
422 PetscFunctionBeginHot;
423 PetscValidPointer(ctx, 5);
424 if (l2g) {*A = rc->R;}
425 else {*A = rc->RT;}
426 PetscFunctionReturn(0);
427 }
428
DMPlexBasisTransformApplyReal_Internal(DM dm,const PetscReal x[],PetscBool l2g,PetscInt dim,const PetscReal * y,PetscReal * z,void * ctx)429 PetscErrorCode DMPlexBasisTransformApplyReal_Internal(DM dm, const PetscReal x[], PetscBool l2g, PetscInt dim, const PetscReal *y, PetscReal *z, void *ctx)
430 {
431 PetscErrorCode ierr;
432
433 PetscFunctionBegin;
434 #if defined(PETSC_USE_COMPLEX)
435 switch (dim) {
436 case 2:
437 {
438 PetscScalar yt[2], zt[2];
439
440 yt[0] = y[0]; yt[1] = y[1];
441 ierr = DMPlexBasisTransformApply_Internal(dm, x, l2g, dim, yt, zt, ctx);CHKERRQ(ierr);
442 z[0] = PetscRealPart(zt[0]); z[1] = PetscRealPart(zt[1]);
443 }
444 break;
445 case 3:
446 {
447 PetscScalar yt[3], zt[3];
448
449 yt[0] = y[0]; yt[1] = y[1]; yt[2] = y[2];
450 ierr = DMPlexBasisTransformApply_Internal(dm, x, l2g, dim, yt, zt, ctx);CHKERRQ(ierr);
451 z[0] = PetscRealPart(zt[0]); z[1] = PetscRealPart(zt[1]); z[2] = PetscRealPart(zt[2]);
452 }
453 break;
454 }
455 #else
456 ierr = DMPlexBasisTransformApply_Internal(dm, x, l2g, dim, y, z, ctx);CHKERRQ(ierr);
457 #endif
458 PetscFunctionReturn(0);
459 }
460
DMPlexBasisTransformApply_Internal(DM dm,const PetscReal x[],PetscBool l2g,PetscInt dim,const PetscScalar * y,PetscScalar * z,void * ctx)461 PetscErrorCode DMPlexBasisTransformApply_Internal(DM dm, const PetscReal x[], PetscBool l2g, PetscInt dim, const PetscScalar *y, PetscScalar *z, void *ctx)
462 {
463 const PetscScalar *A;
464 PetscErrorCode ierr;
465
466 PetscFunctionBeginHot;
467 ierr = (*dm->transformGetMatrix)(dm, x, l2g, &A, ctx);CHKERRQ(ierr);
468 switch (dim) {
469 case 2: DMPlex_Mult2D_Internal(A, 1, y, z);break;
470 case 3: DMPlex_Mult3D_Internal(A, 1, y, z);break;
471 }
472 PetscFunctionReturn(0);
473 }
474
DMPlexBasisTransformField_Internal(DM dm,DM tdm,Vec tv,PetscInt p,PetscInt f,PetscBool l2g,PetscScalar * a)475 static PetscErrorCode DMPlexBasisTransformField_Internal(DM dm, DM tdm, Vec tv, PetscInt p, PetscInt f, PetscBool l2g, PetscScalar *a)
476 {
477 PetscSection ts;
478 const PetscScalar *ta, *tva;
479 PetscInt dof;
480 PetscErrorCode ierr;
481
482 PetscFunctionBeginHot;
483 ierr = DMGetLocalSection(tdm, &ts);CHKERRQ(ierr);
484 ierr = PetscSectionGetFieldDof(ts, p, f, &dof);CHKERRQ(ierr);
485 ierr = VecGetArrayRead(tv, &ta);CHKERRQ(ierr);
486 ierr = DMPlexPointLocalFieldRead(tdm, p, f, ta, (void *) &tva);CHKERRQ(ierr);
487 if (l2g) {
488 switch (dof) {
489 case 4: DMPlex_Mult2D_Internal(tva, 1, a, a);break;
490 case 9: DMPlex_Mult3D_Internal(tva, 1, a, a);break;
491 }
492 } else {
493 switch (dof) {
494 case 4: DMPlex_MultTranspose2D_Internal(tva, 1, a, a);break;
495 case 9: DMPlex_MultTranspose3D_Internal(tva, 1, a, a);break;
496 }
497 }
498 ierr = VecRestoreArrayRead(tv, &ta);CHKERRQ(ierr);
499 PetscFunctionReturn(0);
500 }
501
DMPlexBasisTransformFieldTensor_Internal(DM dm,DM tdm,Vec tv,PetscInt pf,PetscInt f,PetscInt pg,PetscInt g,PetscBool l2g,PetscInt lda,PetscScalar * a)502 static PetscErrorCode DMPlexBasisTransformFieldTensor_Internal(DM dm, DM tdm, Vec tv, PetscInt pf, PetscInt f, PetscInt pg, PetscInt g, PetscBool l2g, PetscInt lda, PetscScalar *a)
503 {
504 PetscSection s, ts;
505 const PetscScalar *ta, *tvaf, *tvag;
506 PetscInt fdof, gdof, fpdof, gpdof;
507 PetscErrorCode ierr;
508
509 PetscFunctionBeginHot;
510 ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr);
511 ierr = DMGetLocalSection(tdm, &ts);CHKERRQ(ierr);
512 ierr = PetscSectionGetFieldDof(s, pf, f, &fpdof);CHKERRQ(ierr);
513 ierr = PetscSectionGetFieldDof(s, pg, g, &gpdof);CHKERRQ(ierr);
514 ierr = PetscSectionGetFieldDof(ts, pf, f, &fdof);CHKERRQ(ierr);
515 ierr = PetscSectionGetFieldDof(ts, pg, g, &gdof);CHKERRQ(ierr);
516 ierr = VecGetArrayRead(tv, &ta);CHKERRQ(ierr);
517 ierr = DMPlexPointLocalFieldRead(tdm, pf, f, ta, (void *) &tvaf);CHKERRQ(ierr);
518 ierr = DMPlexPointLocalFieldRead(tdm, pg, g, ta, (void *) &tvag);CHKERRQ(ierr);
519 if (l2g) {
520 switch (fdof) {
521 case 4: DMPlex_MatMult2D_Internal(tvaf, gpdof, lda, a, a);break;
522 case 9: DMPlex_MatMult3D_Internal(tvaf, gpdof, lda, a, a);break;
523 }
524 switch (gdof) {
525 case 4: DMPlex_MatMultTransposeLeft2D_Internal(tvag, fpdof, lda, a, a);break;
526 case 9: DMPlex_MatMultTransposeLeft3D_Internal(tvag, fpdof, lda, a, a);break;
527 }
528 } else {
529 switch (fdof) {
530 case 4: DMPlex_MatMultTranspose2D_Internal(tvaf, gpdof, lda, a, a);break;
531 case 9: DMPlex_MatMultTranspose3D_Internal(tvaf, gpdof, lda, a, a);break;
532 }
533 switch (gdof) {
534 case 4: DMPlex_MatMultLeft2D_Internal(tvag, fpdof, lda, a, a);break;
535 case 9: DMPlex_MatMultLeft3D_Internal(tvag, fpdof, lda, a, a);break;
536 }
537 }
538 ierr = VecRestoreArrayRead(tv, &ta);CHKERRQ(ierr);
539 PetscFunctionReturn(0);
540 }
541
DMPlexBasisTransformPoint_Internal(DM dm,DM tdm,Vec tv,PetscInt p,PetscBool fieldActive[],PetscBool l2g,PetscScalar * a)542 PetscErrorCode DMPlexBasisTransformPoint_Internal(DM dm, DM tdm, Vec tv, PetscInt p, PetscBool fieldActive[], PetscBool l2g, PetscScalar *a)
543 {
544 PetscSection s;
545 PetscSection clSection;
546 IS clPoints;
547 const PetscInt *clp;
548 PetscInt *points = NULL;
549 PetscInt Nf, f, Np, cp, dof, d = 0;
550 PetscErrorCode ierr;
551
552 PetscFunctionBegin;
553 ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr);
554 ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr);
555 ierr = DMPlexGetCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
556 for (f = 0; f < Nf; ++f) {
557 for (cp = 0; cp < Np*2; cp += 2) {
558 ierr = PetscSectionGetFieldDof(s, points[cp], f, &dof);CHKERRQ(ierr);
559 if (!dof) continue;
560 if (fieldActive[f]) {ierr = DMPlexBasisTransformField_Internal(dm, tdm, tv, points[cp], f, l2g, &a[d]);CHKERRQ(ierr);}
561 d += dof;
562 }
563 }
564 ierr = DMPlexRestoreCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
565 PetscFunctionReturn(0);
566 }
567
DMPlexBasisTransformPointTensor_Internal(DM dm,DM tdm,Vec tv,PetscInt p,PetscBool l2g,PetscInt lda,PetscScalar * a)568 PetscErrorCode DMPlexBasisTransformPointTensor_Internal(DM dm, DM tdm, Vec tv, PetscInt p, PetscBool l2g, PetscInt lda, PetscScalar *a)
569 {
570 PetscSection s;
571 PetscSection clSection;
572 IS clPoints;
573 const PetscInt *clp;
574 PetscInt *points = NULL;
575 PetscInt Nf, f, g, Np, cpf, cpg, fdof, gdof, r, c = 0;
576 PetscErrorCode ierr;
577
578 PetscFunctionBegin;
579 ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr);
580 ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr);
581 ierr = DMPlexGetCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
582 for (f = 0, r = 0; f < Nf; ++f) {
583 for (cpf = 0; cpf < Np*2; cpf += 2) {
584 ierr = PetscSectionGetFieldDof(s, points[cpf], f, &fdof);CHKERRQ(ierr);
585 for (g = 0, c = 0; g < Nf; ++g) {
586 for (cpg = 0; cpg < Np*2; cpg += 2) {
587 ierr = PetscSectionGetFieldDof(s, points[cpg], g, &gdof);CHKERRQ(ierr);
588 ierr = DMPlexBasisTransformFieldTensor_Internal(dm, tdm, tv, points[cpf], f, points[cpg], g, l2g, lda, &a[r*lda+c]);CHKERRQ(ierr);
589 c += gdof;
590 }
591 }
592 if (c != lda) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of columns %D should be %D", c, lda);
593 r += fdof;
594 }
595 }
596 if (r != lda) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of rows %D should be %D", c, lda);
597 ierr = DMPlexRestoreCompressedClosure(dm, s, p, &Np, &points, &clSection, &clPoints, &clp);CHKERRQ(ierr);
598 PetscFunctionReturn(0);
599 }
600
DMPlexBasisTransform_Internal(DM dm,Vec lv,PetscBool l2g)601 static PetscErrorCode DMPlexBasisTransform_Internal(DM dm, Vec lv, PetscBool l2g)
602 {
603 DM tdm;
604 Vec tv;
605 PetscSection ts, s;
606 const PetscScalar *ta;
607 PetscScalar *a, *va;
608 PetscInt pStart, pEnd, p, Nf, f;
609 PetscErrorCode ierr;
610
611 PetscFunctionBegin;
612 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr);
613 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr);
614 ierr = DMGetLocalSection(tdm, &ts);CHKERRQ(ierr);
615 ierr = DMGetLocalSection(dm, &s);CHKERRQ(ierr);
616 ierr = PetscSectionGetChart(s, &pStart, &pEnd);CHKERRQ(ierr);
617 ierr = PetscSectionGetNumFields(s, &Nf);CHKERRQ(ierr);
618 ierr = VecGetArray(lv, &a);CHKERRQ(ierr);
619 ierr = VecGetArrayRead(tv, &ta);CHKERRQ(ierr);
620 for (p = pStart; p < pEnd; ++p) {
621 for (f = 0; f < Nf; ++f) {
622 ierr = DMPlexPointLocalFieldRef(dm, p, f, a, (void *) &va);CHKERRQ(ierr);
623 ierr = DMPlexBasisTransformField_Internal(dm, tdm, tv, p, f, l2g, va);CHKERRQ(ierr);
624 }
625 }
626 ierr = VecRestoreArray(lv, &a);CHKERRQ(ierr);
627 ierr = VecRestoreArrayRead(tv, &ta);CHKERRQ(ierr);
628 PetscFunctionReturn(0);
629 }
630
631 /*@
632 DMPlexGlobalToLocalBasis - Transform the values in the given local vector from the global basis to the local basis
633
634 Input Parameters:
635 + dm - The DM
636 - lv - A local vector with values in the global basis
637
638 Output Parameters:
639 . lv - A local vector with values in the local basis
640
641 Note: This method is only intended to be called inside DMGlobalToLocal(). It is unlikely that a user will have a local vector full of coefficients for the global basis unless they are reimplementing GlobalToLocal.
642
643 Level: developer
644
645 .seealso: DMPlexLocalToGlobalBasis(), DMGetLocalSection(), DMPlexCreateBasisRotation()
646 @*/
DMPlexGlobalToLocalBasis(DM dm,Vec lv)647 PetscErrorCode DMPlexGlobalToLocalBasis(DM dm, Vec lv)
648 {
649 PetscErrorCode ierr;
650
651 PetscFunctionBegin;
652 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
653 PetscValidHeaderSpecific(lv, VEC_CLASSID, 2);
654 ierr = DMPlexBasisTransform_Internal(dm, lv, PETSC_FALSE);CHKERRQ(ierr);
655 PetscFunctionReturn(0);
656 }
657
658 /*@
659 DMPlexLocalToGlobalBasis - Transform the values in the given local vector from the local basis to the global basis
660
661 Input Parameters:
662 + dm - The DM
663 - lv - A local vector with values in the local basis
664
665 Output Parameters:
666 . lv - A local vector with values in the global basis
667
668 Note: This method is only intended to be called inside DMGlobalToLocal(). It is unlikely that a user would want a local vector full of coefficients for the global basis unless they are reimplementing GlobalToLocal.
669
670 Level: developer
671
672 .seealso: DMPlexGlobalToLocalBasis(), DMGetLocalSection(), DMPlexCreateBasisRotation()
673 @*/
DMPlexLocalToGlobalBasis(DM dm,Vec lv)674 PetscErrorCode DMPlexLocalToGlobalBasis(DM dm, Vec lv)
675 {
676 PetscErrorCode ierr;
677
678 PetscFunctionBegin;
679 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
680 PetscValidHeaderSpecific(lv, VEC_CLASSID, 2);
681 ierr = DMPlexBasisTransform_Internal(dm, lv, PETSC_TRUE);CHKERRQ(ierr);
682 PetscFunctionReturn(0);
683 }
684
685 /*@
686 DMPlexCreateBasisRotation - Create an internal transformation from the global basis, used to specify boundary conditions
687 and global solutions, to a local basis, appropriate for discretization integrals and assembly.
688
689 Input Parameters:
690 + dm - The DM
691 . alpha - The first Euler angle, and in 2D the only one
692 . beta - The second Euler angle
693 - gamma - The third Euler angle
694
695 Note: Following https://en.wikipedia.org/wiki/Euler_angles, we will specify Euler angles by extrinsic rotations, meaning that
696 we rotate with respect to a fixed initial coordinate system, the local basis (x-y-z). The global basis (X-Y-Z) is reached as follows:
697 $ The XYZ system rotates about the z axis by alpha. The X axis is now at angle alpha with respect to the x axis.
698 $ The XYZ system rotates again about the x axis by beta. The Z axis is now at angle beta with respect to the z axis.
699 $ The XYZ system rotates a third time about the z axis by gamma.
700
701 Level: developer
702
703 .seealso: DMPlexGlobalToLocalBasis(), DMPlexLocalToGlobalBasis()
704 @*/
DMPlexCreateBasisRotation(DM dm,PetscReal alpha,PetscReal beta,PetscReal gamma)705 PetscErrorCode DMPlexCreateBasisRotation(DM dm, PetscReal alpha, PetscReal beta, PetscReal gamma)
706 {
707 RotCtx *rc;
708 PetscInt cdim;
709 PetscErrorCode ierr;
710
711 ierr = DMGetCoordinateDim(dm, &cdim);CHKERRQ(ierr);
712 ierr = PetscMalloc1(1, &rc);CHKERRQ(ierr);
713 dm->transformCtx = rc;
714 dm->transformSetUp = DMPlexBasisTransformSetUp_Rotation_Internal;
715 dm->transformDestroy = DMPlexBasisTransformDestroy_Rotation_Internal;
716 dm->transformGetMatrix = DMPlexBasisTransformGetMatrix_Rotation_Internal;
717 rc->dim = cdim;
718 rc->alpha = alpha;
719 rc->beta = beta;
720 rc->gamma = gamma;
721 ierr = (*dm->transformSetUp)(dm, dm->transformCtx);CHKERRQ(ierr);
722 ierr = DMConstructBasisTransform_Internal(dm);CHKERRQ(ierr);
723 PetscFunctionReturn(0);
724 }
725
726 /*@C
727 DMPlexInsertBoundaryValuesEssential - Insert boundary values into a local vector using a function of the coordinates
728
729 Input Parameters:
730 + dm - The DM, with a PetscDS that matches the problem being constrained
731 . time - The time
732 . field - The field to constrain
733 . Nc - The number of constrained field components, or 0 for all components
734 . comps - An array of constrained component numbers, or NULL for all components
735 . label - The DMLabel defining constrained points
736 . numids - The number of DMLabel ids for constrained points
737 . ids - An array of ids for constrained points
738 . func - A pointwise function giving boundary values
739 - ctx - An optional user context for bcFunc
740
741 Output Parameter:
742 . locX - A local vector to receives the boundary values
743
744 Level: developer
745
746 .seealso: DMPlexInsertBoundaryValuesEssentialField(), DMPlexInsertBoundaryValuesEssentialBdField(), DMAddBoundary()
747 @*/
DMPlexInsertBoundaryValuesEssential(DM dm,PetscReal time,PetscInt field,PetscInt Nc,const PetscInt comps[],DMLabel label,PetscInt numids,const PetscInt ids[],PetscErrorCode (* func)(PetscInt,PetscReal,const PetscReal[],PetscInt,PetscScalar *,void *),void * ctx,Vec locX)748 PetscErrorCode DMPlexInsertBoundaryValuesEssential(DM dm, PetscReal time, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[], PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *), void *ctx, Vec locX)
749 {
750 PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal x[], PetscInt, PetscScalar *u, void *ctx);
751 void **ctxs;
752 PetscInt numFields;
753 PetscErrorCode ierr;
754
755 PetscFunctionBegin;
756 ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
757 ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr);
758 funcs[field] = func;
759 ctxs[field] = ctx;
760 ierr = DMProjectFunctionLabelLocal(dm, time, label, numids, ids, Nc, comps, funcs, ctxs, INSERT_BC_VALUES, locX);CHKERRQ(ierr);
761 ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
762 PetscFunctionReturn(0);
763 }
764
765 /*@C
766 DMPlexInsertBoundaryValuesEssentialField - Insert boundary values into a local vector using a function of the coordinates and field data
767
768 Input Parameters:
769 + dm - The DM, with a PetscDS that matches the problem being constrained
770 . time - The time
771 . locU - A local vector with the input solution values
772 . field - The field to constrain
773 . Nc - The number of constrained field components, or 0 for all components
774 . comps - An array of constrained component numbers, or NULL for all components
775 . label - The DMLabel defining constrained points
776 . numids - The number of DMLabel ids for constrained points
777 . ids - An array of ids for constrained points
778 . func - A pointwise function giving boundary values
779 - ctx - An optional user context for bcFunc
780
781 Output Parameter:
782 . locX - A local vector to receives the boundary values
783
784 Level: developer
785
786 .seealso: DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialBdField(), DMAddBoundary()
787 @*/
DMPlexInsertBoundaryValuesEssentialField(DM dm,PetscReal time,Vec locU,PetscInt field,PetscInt Nc,const PetscInt comps[],DMLabel label,PetscInt numids,const PetscInt ids[],void (* func)(PetscInt,PetscInt,PetscInt,const PetscInt[],const PetscInt[],const PetscScalar[],const PetscScalar[],const PetscScalar[],const PetscInt[],const PetscInt[],const PetscScalar[],const PetscScalar[],const PetscScalar[],PetscReal,const PetscReal[],PetscInt,const PetscScalar[],PetscScalar[]),void * ctx,Vec locX)788 PetscErrorCode DMPlexInsertBoundaryValuesEssentialField(DM dm, PetscReal time, Vec locU, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[],
789 void (*func)(PetscInt, PetscInt, PetscInt,
790 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
791 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
792 PetscReal, const PetscReal[], PetscInt, const PetscScalar[],
793 PetscScalar[]),
794 void *ctx, Vec locX)
795 {
796 void (**funcs)(PetscInt, PetscInt, PetscInt,
797 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
798 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
799 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]);
800 void **ctxs;
801 PetscInt numFields;
802 PetscErrorCode ierr;
803
804 PetscFunctionBegin;
805 ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
806 ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr);
807 funcs[field] = func;
808 ctxs[field] = ctx;
809 ierr = DMProjectFieldLabelLocal(dm, time, label, numids, ids, Nc, comps, locU, funcs, INSERT_BC_VALUES, locX);CHKERRQ(ierr);
810 ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
811 PetscFunctionReturn(0);
812 }
813
814 /*@C
815 DMPlexInsertBoundaryValuesEssentialBdField - Insert boundary values into a local vector using a function of the coodinates and boundary field data
816
817 Collective on dm
818
819 Input Parameters:
820 + dm - The DM, with a PetscDS that matches the problem being constrained
821 . time - The time
822 . locU - A local vector with the input solution values
823 . field - The field to constrain
824 . Nc - The number of constrained field components, or 0 for all components
825 . comps - An array of constrained component numbers, or NULL for all components
826 . label - The DMLabel defining constrained points
827 . numids - The number of DMLabel ids for constrained points
828 . ids - An array of ids for constrained points
829 . func - A pointwise function giving boundary values, the calling sequence is given in DMProjectBdFieldLabelLocal()
830 - ctx - An optional user context for bcFunc
831
832 Output Parameter:
833 . locX - A local vector to receive the boundary values
834
835 Level: developer
836
837 .seealso: DMProjectBdFieldLabelLocal(), DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary()
838 @*/
DMPlexInsertBoundaryValuesEssentialBdField(DM dm,PetscReal time,Vec locU,PetscInt field,PetscInt Nc,const PetscInt comps[],DMLabel label,PetscInt numids,const PetscInt ids[],void (* func)(PetscInt,PetscInt,PetscInt,const PetscInt[],const PetscInt[],const PetscScalar[],const PetscScalar[],const PetscScalar[],const PetscInt[],const PetscInt[],const PetscScalar[],const PetscScalar[],const PetscScalar[],PetscReal,const PetscReal[],const PetscReal[],PetscInt,const PetscScalar[],PetscScalar[]),void * ctx,Vec locX)839 PetscErrorCode DMPlexInsertBoundaryValuesEssentialBdField(DM dm, PetscReal time, Vec locU, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[],
840 void (*func)(PetscInt, PetscInt, PetscInt,
841 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
842 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
843 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[],
844 PetscScalar[]),
845 void *ctx, Vec locX)
846 {
847 void (**funcs)(PetscInt, PetscInt, PetscInt,
848 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
849 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
850 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]);
851 void **ctxs;
852 PetscInt numFields;
853 PetscErrorCode ierr;
854
855 PetscFunctionBegin;
856 ierr = DMGetNumFields(dm, &numFields);CHKERRQ(ierr);
857 ierr = PetscCalloc2(numFields,&funcs,numFields,&ctxs);CHKERRQ(ierr);
858 funcs[field] = func;
859 ctxs[field] = ctx;
860 ierr = DMProjectBdFieldLabelLocal(dm, time, label, numids, ids, Nc, comps, locU, funcs, INSERT_BC_VALUES, locX);CHKERRQ(ierr);
861 ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
862 PetscFunctionReturn(0);
863 }
864
865 /*@C
866 DMPlexInsertBoundaryValuesRiemann - Insert boundary values into a local vector
867
868 Input Parameters:
869 + dm - The DM, with a PetscDS that matches the problem being constrained
870 . time - The time
871 . faceGeometry - A vector with the FVM face geometry information
872 . cellGeometry - A vector with the FVM cell geometry information
873 . Grad - A vector with the FVM cell gradient information
874 . field - The field to constrain
875 . Nc - The number of constrained field components, or 0 for all components
876 . comps - An array of constrained component numbers, or NULL for all components
877 . label - The DMLabel defining constrained points
878 . numids - The number of DMLabel ids for constrained points
879 . ids - An array of ids for constrained points
880 . func - A pointwise function giving boundary values
881 - ctx - An optional user context for bcFunc
882
883 Output Parameter:
884 . locX - A local vector to receives the boundary values
885
886 Note: This implementation currently ignores the numcomps/comps argument from DMAddBoundary()
887
888 Level: developer
889
890 .seealso: DMPlexInsertBoundaryValuesEssential(), DMPlexInsertBoundaryValuesEssentialField(), DMAddBoundary()
891 @*/
DMPlexInsertBoundaryValuesRiemann(DM dm,PetscReal time,Vec faceGeometry,Vec cellGeometry,Vec Grad,PetscInt field,PetscInt Nc,const PetscInt comps[],DMLabel label,PetscInt numids,const PetscInt ids[],PetscErrorCode (* func)(PetscReal,const PetscReal *,const PetscReal *,const PetscScalar *,PetscScalar *,void *),void * ctx,Vec locX)892 PetscErrorCode DMPlexInsertBoundaryValuesRiemann(DM dm, PetscReal time, Vec faceGeometry, Vec cellGeometry, Vec Grad, PetscInt field, PetscInt Nc, const PetscInt comps[], DMLabel label, PetscInt numids, const PetscInt ids[],
893 PetscErrorCode (*func)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*), void *ctx, Vec locX)
894 {
895 PetscDS prob;
896 PetscSF sf;
897 DM dmFace, dmCell, dmGrad;
898 const PetscScalar *facegeom, *cellgeom = NULL, *grad;
899 const PetscInt *leaves;
900 PetscScalar *x, *fx;
901 PetscInt dim, nleaves, loc, fStart, fEnd, pdim, i;
902 PetscErrorCode ierr, ierru = 0;
903
904 PetscFunctionBegin;
905 ierr = DMGetPointSF(dm, &sf);CHKERRQ(ierr);
906 ierr = PetscSFGetGraph(sf, NULL, &nleaves, &leaves, NULL);CHKERRQ(ierr);
907 nleaves = PetscMax(0, nleaves);
908 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
909 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
910 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
911 ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
912 ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
913 if (cellGeometry) {
914 ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
915 ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
916 }
917 if (Grad) {
918 PetscFV fv;
919
920 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fv);CHKERRQ(ierr);
921 ierr = VecGetDM(Grad, &dmGrad);CHKERRQ(ierr);
922 ierr = VecGetArrayRead(Grad, &grad);CHKERRQ(ierr);
923 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
924 ierr = DMGetWorkArray(dm, pdim, MPIU_SCALAR, &fx);CHKERRQ(ierr);
925 }
926 ierr = VecGetArray(locX, &x);CHKERRQ(ierr);
927 for (i = 0; i < numids; ++i) {
928 IS faceIS;
929 const PetscInt *faces;
930 PetscInt numFaces, f;
931
932 ierr = DMLabelGetStratumIS(label, ids[i], &faceIS);CHKERRQ(ierr);
933 if (!faceIS) continue; /* No points with that id on this process */
934 ierr = ISGetLocalSize(faceIS, &numFaces);CHKERRQ(ierr);
935 ierr = ISGetIndices(faceIS, &faces);CHKERRQ(ierr);
936 for (f = 0; f < numFaces; ++f) {
937 const PetscInt face = faces[f], *cells;
938 PetscFVFaceGeom *fg;
939
940 if ((face < fStart) || (face >= fEnd)) continue; /* Refinement adds non-faces to labels */
941 ierr = PetscFindInt(face, nleaves, (PetscInt *) leaves, &loc);CHKERRQ(ierr);
942 if (loc >= 0) continue;
943 ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
944 ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
945 if (Grad) {
946 PetscFVCellGeom *cg;
947 PetscScalar *cx, *cgrad;
948 PetscScalar *xG;
949 PetscReal dx[3];
950 PetscInt d;
951
952 ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cg);CHKERRQ(ierr);
953 ierr = DMPlexPointLocalRead(dm, cells[0], x, &cx);CHKERRQ(ierr);
954 ierr = DMPlexPointLocalRead(dmGrad, cells[0], grad, &cgrad);CHKERRQ(ierr);
955 ierr = DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);CHKERRQ(ierr);
956 DMPlex_WaxpyD_Internal(dim, -1, cg->centroid, fg->centroid, dx);
957 for (d = 0; d < pdim; ++d) fx[d] = cx[d] + DMPlex_DotD_Internal(dim, &cgrad[d*dim], dx);
958 ierru = (*func)(time, fg->centroid, fg->normal, fx, xG, ctx);
959 if (ierru) {
960 ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr);
961 ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
962 goto cleanup;
963 }
964 } else {
965 PetscScalar *xI;
966 PetscScalar *xG;
967
968 ierr = DMPlexPointLocalRead(dm, cells[0], x, &xI);CHKERRQ(ierr);
969 ierr = DMPlexPointLocalFieldRef(dm, cells[1], field, x, &xG);CHKERRQ(ierr);
970 ierru = (*func)(time, fg->centroid, fg->normal, xI, xG, ctx);
971 if (ierru) {
972 ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr);
973 ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
974 goto cleanup;
975 }
976 }
977 }
978 ierr = ISRestoreIndices(faceIS, &faces);CHKERRQ(ierr);
979 ierr = ISDestroy(&faceIS);CHKERRQ(ierr);
980 }
981 cleanup:
982 ierr = VecRestoreArray(locX, &x);CHKERRQ(ierr);
983 if (Grad) {
984 ierr = DMRestoreWorkArray(dm, pdim, MPIU_SCALAR, &fx);CHKERRQ(ierr);
985 ierr = VecRestoreArrayRead(Grad, &grad);CHKERRQ(ierr);
986 }
987 if (cellGeometry) {ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);}
988 ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
989 CHKERRQ(ierru);
990 PetscFunctionReturn(0);
991 }
992
zero(PetscInt dim,PetscReal time,const PetscReal x[],PetscInt Nc,PetscScalar * u,void * ctx)993 static PetscErrorCode zero(PetscInt dim, PetscReal time, const PetscReal x[], PetscInt Nc, PetscScalar *u, void *ctx)
994 {
995 PetscInt c;
996 for (c = 0; c < Nc; ++c) u[c] = 0.0;
997 return 0;
998 }
999
DMPlexInsertBoundaryValues_Plex(DM dm,PetscBool insertEssential,Vec locX,PetscReal time,Vec faceGeomFVM,Vec cellGeomFVM,Vec gradFVM)1000 PetscErrorCode DMPlexInsertBoundaryValues_Plex(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM)
1001 {
1002 PetscObject isZero;
1003 PetscDS prob;
1004 PetscInt numBd, b;
1005 PetscErrorCode ierr;
1006
1007 PetscFunctionBegin;
1008 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1009 ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr);
1010 ierr = PetscObjectQuery((PetscObject) locX, "__Vec_bc_zero__", &isZero);CHKERRQ(ierr);
1011 for (b = 0; b < numBd; ++b) {
1012 DMBoundaryConditionType type;
1013 const char *name, *labelname;
1014 DMLabel label;
1015 PetscInt field, Nc;
1016 const PetscInt *comps;
1017 PetscObject obj;
1018 PetscClassId id;
1019 void (*func)(void);
1020 PetscInt numids;
1021 const PetscInt *ids;
1022 void *ctx;
1023
1024 ierr = DMGetBoundary(dm, b, &type, &name, &labelname, &field, &Nc, &comps, &func, NULL, &numids, &ids, &ctx);CHKERRQ(ierr);
1025 if (insertEssential != (type & DM_BC_ESSENTIAL)) continue;
1026 ierr = DMGetLabel(dm, labelname, &label);CHKERRQ(ierr);
1027 if (!label) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONGSTATE, "Label %s for boundary condition %s does not exist in the DM", labelname, name);
1028 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1029 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1030 if (id == PETSCFE_CLASSID) {
1031 switch (type) {
1032 /* for FEM, there is no insertion to be done for non-essential boundary conditions */
1033 case DM_BC_ESSENTIAL:
1034 if (isZero) func = (void (*)(void)) zero;
1035 ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr);
1036 ierr = DMPlexInsertBoundaryValuesEssential(dm, time, field, Nc, comps, label, numids, ids, (PetscErrorCode (*)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *)) func, ctx, locX);CHKERRQ(ierr);
1037 ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr);
1038 break;
1039 case DM_BC_ESSENTIAL_FIELD:
1040 ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr);
1041 ierr = DMPlexInsertBoundaryValuesEssentialField(dm, time, locX, field, Nc, comps, label, numids, ids,
1042 (void (*)(PetscInt, PetscInt, PetscInt, const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1043 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1044 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[])) func, ctx, locX);CHKERRQ(ierr);
1045 ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr);
1046 break;
1047 default: break;
1048 }
1049 } else if (id == PETSCFV_CLASSID) {
1050 if (!faceGeomFVM) continue;
1051 ierr = DMPlexInsertBoundaryValuesRiemann(dm, time, faceGeomFVM, cellGeomFVM, gradFVM, field, Nc, comps, label, numids, ids,
1052 (PetscErrorCode (*)(PetscReal,const PetscReal*,const PetscReal*,const PetscScalar*,PetscScalar*,void*)) func, ctx, locX);CHKERRQ(ierr);
1053 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1054 }
1055 PetscFunctionReturn(0);
1056 }
1057
DMPlexInsertTimeDerivativeBoundaryValues_Plex(DM dm,PetscBool insertEssential,Vec locX,PetscReal time,Vec faceGeomFVM,Vec cellGeomFVM,Vec gradFVM)1058 PetscErrorCode DMPlexInsertTimeDerivativeBoundaryValues_Plex(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM)
1059 {
1060 PetscObject isZero;
1061 PetscDS prob;
1062 PetscInt numBd, b;
1063 PetscErrorCode ierr;
1064
1065 PetscFunctionBegin;
1066 if (!locX) PetscFunctionReturn(0);
1067 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1068 ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr);
1069 ierr = PetscObjectQuery((PetscObject) locX, "__Vec_bc_zero__", &isZero);CHKERRQ(ierr);
1070 for (b = 0; b < numBd; ++b) {
1071 DMBoundaryConditionType type;
1072 const char *name, *labelname;
1073 DMLabel label;
1074 PetscInt field, Nc;
1075 const PetscInt *comps;
1076 PetscObject obj;
1077 PetscClassId id;
1078 void (*func_t)(void);
1079 PetscInt numids;
1080 const PetscInt *ids;
1081 void *ctx;
1082
1083 ierr = DMGetBoundary(dm, b, &type, &name, &labelname, &field, &Nc, &comps, NULL, &func_t, &numids, &ids, &ctx);CHKERRQ(ierr);
1084 if (!func_t) continue;
1085 if (insertEssential != (type & DM_BC_ESSENTIAL)) continue;
1086 ierr = DMGetLabel(dm, labelname, &label);CHKERRQ(ierr);
1087 if (!label) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONGSTATE, "Label %s for boundary condition %s does not exist in the DM", labelname, name);
1088 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1089 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1090 if (id == PETSCFE_CLASSID) {
1091 switch (type) {
1092 /* for FEM, there is no insertion to be done for non-essential boundary conditions */
1093 case DM_BC_ESSENTIAL:
1094 if (isZero) func_t = (void (*)(void)) zero;
1095 ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr);
1096 ierr = DMPlexInsertBoundaryValuesEssential(dm, time, field, Nc, comps, label, numids, ids, (PetscErrorCode (*)(PetscInt, PetscReal, const PetscReal[], PetscInt, PetscScalar *, void *)) func_t, ctx, locX);CHKERRQ(ierr);
1097 ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr);
1098 break;
1099 case DM_BC_ESSENTIAL_FIELD:
1100 ierr = DMPlexLabelAddCells(dm,label);CHKERRQ(ierr);
1101 ierr = DMPlexInsertBoundaryValuesEssentialField(dm, time, locX, field, Nc, comps, label, numids, ids,
1102 (void (*)(PetscInt, PetscInt, PetscInt, const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1103 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
1104 PetscReal, const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[])) func_t, ctx, locX);CHKERRQ(ierr);
1105 ierr = DMPlexLabelClearCells(dm,label);CHKERRQ(ierr);
1106 break;
1107 default: break;
1108 }
1109 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1110 }
1111 PetscFunctionReturn(0);
1112 }
1113
1114 /*@
1115 DMPlexInsertBoundaryValues - Puts coefficients which represent boundary values into the local solution vector
1116
1117 Input Parameters:
1118 + dm - The DM
1119 . insertEssential - Should I insert essential (e.g. Dirichlet) or inessential (e.g. Neumann) boundary conditions
1120 . time - The time
1121 . faceGeomFVM - Face geometry data for FV discretizations
1122 . cellGeomFVM - Cell geometry data for FV discretizations
1123 - gradFVM - Gradient reconstruction data for FV discretizations
1124
1125 Output Parameters:
1126 . locX - Solution updated with boundary values
1127
1128 Level: developer
1129
1130 .seealso: DMProjectFunctionLabelLocal()
1131 @*/
DMPlexInsertBoundaryValues(DM dm,PetscBool insertEssential,Vec locX,PetscReal time,Vec faceGeomFVM,Vec cellGeomFVM,Vec gradFVM)1132 PetscErrorCode DMPlexInsertBoundaryValues(DM dm, PetscBool insertEssential, Vec locX, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM)
1133 {
1134 PetscErrorCode ierr;
1135
1136 PetscFunctionBegin;
1137 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1138 PetscValidHeaderSpecific(locX, VEC_CLASSID, 2);
1139 if (faceGeomFVM) {PetscValidHeaderSpecific(faceGeomFVM, VEC_CLASSID, 4);}
1140 if (cellGeomFVM) {PetscValidHeaderSpecific(cellGeomFVM, VEC_CLASSID, 5);}
1141 if (gradFVM) {PetscValidHeaderSpecific(gradFVM, VEC_CLASSID, 6);}
1142 ierr = PetscTryMethod(dm,"DMPlexInsertBoundaryValues_C",(DM,PetscBool,Vec,PetscReal,Vec,Vec,Vec),(dm,insertEssential,locX,time,faceGeomFVM,cellGeomFVM,gradFVM));CHKERRQ(ierr);
1143 PetscFunctionReturn(0);
1144 }
1145
1146 /*@
1147 DMPlexInsertTimeDerivativeBoundaryValues - Puts coefficients which represent boundary values of the time derviative into the local solution vector
1148
1149 Input Parameters:
1150 + dm - The DM
1151 . insertEssential - Should I insert essential (e.g. Dirichlet) or inessential (e.g. Neumann) boundary conditions
1152 . time - The time
1153 . faceGeomFVM - Face geometry data for FV discretizations
1154 . cellGeomFVM - Cell geometry data for FV discretizations
1155 - gradFVM - Gradient reconstruction data for FV discretizations
1156
1157 Output Parameters:
1158 . locX_t - Solution updated with boundary values
1159
1160 Level: developer
1161
1162 .seealso: DMProjectFunctionLabelLocal()
1163 @*/
DMPlexInsertTimeDerivativeBoundaryValues(DM dm,PetscBool insertEssential,Vec locX_t,PetscReal time,Vec faceGeomFVM,Vec cellGeomFVM,Vec gradFVM)1164 PetscErrorCode DMPlexInsertTimeDerivativeBoundaryValues(DM dm, PetscBool insertEssential, Vec locX_t, PetscReal time, Vec faceGeomFVM, Vec cellGeomFVM, Vec gradFVM)
1165 {
1166 PetscErrorCode ierr;
1167
1168 PetscFunctionBegin;
1169 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
1170 if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 2);}
1171 if (faceGeomFVM) {PetscValidHeaderSpecific(faceGeomFVM, VEC_CLASSID, 4);}
1172 if (cellGeomFVM) {PetscValidHeaderSpecific(cellGeomFVM, VEC_CLASSID, 5);}
1173 if (gradFVM) {PetscValidHeaderSpecific(gradFVM, VEC_CLASSID, 6);}
1174 ierr = PetscTryMethod(dm,"DMPlexInsertTimeDerviativeBoundaryValues_C",(DM,PetscBool,Vec,PetscReal,Vec,Vec,Vec),(dm,insertEssential,locX_t,time,faceGeomFVM,cellGeomFVM,gradFVM));CHKERRQ(ierr);
1175 PetscFunctionReturn(0);
1176 }
1177
DMComputeL2Diff_Plex(DM dm,PetscReal time,PetscErrorCode (** funcs)(PetscInt,PetscReal,const PetscReal[],PetscInt,PetscScalar *,void *),void ** ctxs,Vec X,PetscReal * diff)1178 PetscErrorCode DMComputeL2Diff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff)
1179 {
1180 Vec localX;
1181 PetscErrorCode ierr;
1182
1183 PetscFunctionBegin;
1184 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
1185 ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, localX, time, NULL, NULL, NULL);CHKERRQ(ierr);
1186 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1187 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1188 ierr = DMPlexComputeL2DiffLocal(dm, time, funcs, ctxs, localX, diff);CHKERRQ(ierr);
1189 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
1190 PetscFunctionReturn(0);
1191 }
1192
1193 /*@C
1194 DMComputeL2DiffLocal - This function computes the L_2 difference between a function u and an FEM interpolant solution u_h.
1195
1196 Collective on dm
1197
1198 Input Parameters:
1199 + dm - The DM
1200 . time - The time
1201 . funcs - The functions to evaluate for each field component
1202 . ctxs - Optional array of contexts to pass to each function, or NULL.
1203 - localX - The coefficient vector u_h, a local vector
1204
1205 Output Parameter:
1206 . diff - The diff ||u - u_h||_2
1207
1208 Level: developer
1209
1210 .seealso: DMProjectFunction(), DMComputeL2FieldDiff(), DMComputeL2GradientDiff()
1211 @*/
DMPlexComputeL2DiffLocal(DM dm,PetscReal time,PetscErrorCode (** funcs)(PetscInt,PetscReal,const PetscReal[],PetscInt,PetscScalar *,void *),void ** ctxs,Vec localX,PetscReal * diff)1212 PetscErrorCode DMPlexComputeL2DiffLocal(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec localX, PetscReal *diff)
1213 {
1214 const PetscInt debug = ((DM_Plex*)dm->data)->printL2;
1215 DM tdm;
1216 Vec tv;
1217 PetscSection section;
1218 PetscQuadrature quad;
1219 PetscFEGeom fegeom;
1220 PetscScalar *funcVal, *interpolant;
1221 PetscReal *coords, *gcoords;
1222 PetscReal localDiff = 0.0;
1223 const PetscReal *quadWeights;
1224 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cellHeight, cStart, cEnd, c, field, fieldOffset;
1225 PetscBool transform;
1226 PetscErrorCode ierr;
1227
1228 PetscFunctionBegin;
1229 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1230 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
1231 fegeom.dimEmbed = coordDim;
1232 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
1233 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
1234 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr);
1235 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr);
1236 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr);
1237 for (field = 0; field < numFields; ++field) {
1238 PetscObject obj;
1239 PetscClassId id;
1240 PetscInt Nc;
1241
1242 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1243 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1244 if (id == PETSCFE_CLASSID) {
1245 PetscFE fe = (PetscFE) obj;
1246
1247 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
1248 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1249 } else if (id == PETSCFV_CLASSID) {
1250 PetscFV fv = (PetscFV) obj;
1251
1252 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr);
1253 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
1254 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1255 numComponents += Nc;
1256 }
1257 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, NULL, &quadWeights);CHKERRQ(ierr);
1258 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1259 ierr = PetscMalloc6(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ);CHKERRQ(ierr);
1260 ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
1261 ierr = DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
1262 for (c = cStart; c < cEnd; ++c) {
1263 PetscScalar *x = NULL;
1264 PetscReal elemDiff = 0.0;
1265 PetscInt qc = 0;
1266
1267 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr);
1268 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1269
1270 for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1271 PetscObject obj;
1272 PetscClassId id;
1273 void * const ctx = ctxs ? ctxs[field] : NULL;
1274 PetscInt Nb, Nc, q, fc;
1275
1276 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1277 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1278 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);}
1279 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;}
1280 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1281 if (debug) {
1282 char title[1024];
1283 ierr = PetscSNPrintf(title, 1023, "Solution for Field %D", field);CHKERRQ(ierr);
1284 ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr);
1285 }
1286 for (q = 0; q < Nq; ++q) {
1287 PetscFEGeom qgeom;
1288
1289 qgeom.dimEmbed = fegeom.dimEmbed;
1290 qgeom.J = &fegeom.J[q*coordDim*coordDim];
1291 qgeom.invJ = &fegeom.invJ[q*coordDim*coordDim];
1292 qgeom.detJ = &fegeom.detJ[q];
1293 if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, point %D", (double)fegeom.detJ[q], c, q);
1294 if (transform) {
1295 gcoords = &coords[coordDim*Nq];
1296 ierr = DMPlexBasisTransformApplyReal_Internal(dm, &coords[coordDim*q], PETSC_TRUE, coordDim, &coords[coordDim*q], gcoords, dm->transformCtx);CHKERRQ(ierr);
1297 } else {
1298 gcoords = &coords[coordDim*q];
1299 }
1300 ierr = (*funcs[field])(coordDim, time, gcoords, Nc, funcVal, ctx);
1301 if (ierr) {
1302 PetscErrorCode ierr2;
1303 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
1304 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
1305 ierr2 = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr2);
1306 CHKERRQ(ierr);
1307 }
1308 if (transform) {ierr = DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx);CHKERRQ(ierr);}
1309 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], &qgeom, q, interpolant);CHKERRQ(ierr);}
1310 else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);}
1311 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1312 for (fc = 0; fc < Nc; ++fc) {
1313 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1314 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %D field %D,%D point %g %g %g diff %g\n", c, field, fc, (double)(coordDim > 0 ? coords[coordDim*q] : 0.), (double)(coordDim > 1 ? coords[coordDim*q+1] : 0.),(double)(coordDim > 2 ? coords[coordDim*q+2] : 0.), (double)(PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]));CHKERRQ(ierr);}
1315 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q];
1316 }
1317 }
1318 fieldOffset += Nb;
1319 qc += Nc;
1320 }
1321 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1322 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %D diff %g\n", c, (double)elemDiff);CHKERRQ(ierr);}
1323 localDiff += elemDiff;
1324 }
1325 ierr = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr);
1326 ierr = MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
1327 *diff = PetscSqrtReal(*diff);
1328 PetscFunctionReturn(0);
1329 }
1330
DMComputeL2GradientDiff_Plex(DM dm,PetscReal time,PetscErrorCode (** funcs)(PetscInt,PetscReal,const PetscReal[],const PetscReal[],PetscInt,PetscScalar *,void *),void ** ctxs,Vec X,const PetscReal n[],PetscReal * diff)1331 PetscErrorCode DMComputeL2GradientDiff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, const PetscReal n[], PetscReal *diff)
1332 {
1333 const PetscInt debug = ((DM_Plex*)dm->data)->printL2;
1334 DM tdm;
1335 PetscSection section;
1336 PetscQuadrature quad;
1337 Vec localX, tv;
1338 PetscScalar *funcVal, *interpolant;
1339 const PetscReal *quadWeights;
1340 PetscFEGeom fegeom;
1341 PetscReal *coords, *gcoords;
1342 PetscReal localDiff = 0.0;
1343 PetscInt dim, coordDim, qNc = 0, Nq = 0, numFields, numComponents = 0, cStart, cEnd, c, field, fieldOffset;
1344 PetscBool transform;
1345 PetscErrorCode ierr;
1346
1347 PetscFunctionBegin;
1348 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1349 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
1350 fegeom.dimEmbed = coordDim;
1351 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
1352 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
1353 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
1354 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1355 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1356 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr);
1357 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr);
1358 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr);
1359 for (field = 0; field < numFields; ++field) {
1360 PetscFE fe;
1361 PetscInt Nc;
1362
1363 ierr = DMGetField(dm, field, NULL, (PetscObject *) &fe);CHKERRQ(ierr);
1364 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
1365 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1366 numComponents += Nc;
1367 }
1368 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, NULL, &quadWeights);CHKERRQ(ierr);
1369 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1370 /* ierr = DMProjectFunctionLocal(dm, fe, funcs, INSERT_BC_VALUES, localX);CHKERRQ(ierr); */
1371 ierr = PetscMalloc6(numComponents,&funcVal,coordDim*Nq,&coords,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ,numComponents*coordDim,&interpolant,Nq,&fegeom.detJ);CHKERRQ(ierr);
1372 ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1373 for (c = cStart; c < cEnd; ++c) {
1374 PetscScalar *x = NULL;
1375 PetscReal elemDiff = 0.0;
1376 PetscInt qc = 0;
1377
1378 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr);
1379 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1380
1381 for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1382 PetscFE fe;
1383 void * const ctx = ctxs ? ctxs[field] : NULL;
1384 PetscInt Nb, Nc, q, fc;
1385
1386 ierr = DMGetField(dm, field, NULL, (PetscObject *) &fe);CHKERRQ(ierr);
1387 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
1388 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1389 if (debug) {
1390 char title[1024];
1391 ierr = PetscSNPrintf(title, 1023, "Solution for Field %D", field);CHKERRQ(ierr);
1392 ierr = DMPrintCellVector(c, title, Nb, &x[fieldOffset]);CHKERRQ(ierr);
1393 }
1394 for (q = 0; q < Nq; ++q) {
1395 PetscFEGeom qgeom;
1396
1397 qgeom.dimEmbed = fegeom.dimEmbed;
1398 qgeom.J = &fegeom.J[q*coordDim*coordDim];
1399 qgeom.invJ = &fegeom.invJ[q*coordDim*coordDim];
1400 qgeom.detJ = &fegeom.detJ[q];
1401 if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)fegeom.detJ[q], c, q);
1402 if (transform) {
1403 gcoords = &coords[coordDim*Nq];
1404 ierr = DMPlexBasisTransformApplyReal_Internal(dm, &coords[coordDim*q], PETSC_TRUE, coordDim, &coords[coordDim*q], gcoords, dm->transformCtx);CHKERRQ(ierr);
1405 } else {
1406 gcoords = &coords[coordDim*q];
1407 }
1408 ierr = (*funcs[field])(coordDim, time, gcoords, n, Nc, funcVal, ctx);
1409 if (ierr) {
1410 PetscErrorCode ierr2;
1411 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
1412 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
1413 ierr2 = PetscFree6(funcVal,coords,fegeom.J,fegeom.invJ,interpolant,fegeom.detJ);CHKERRQ(ierr2);
1414 CHKERRQ(ierr);
1415 }
1416 if (transform) {ierr = DMPlexBasisTransformApply_Internal(dm, &coords[coordDim*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx);CHKERRQ(ierr);}
1417 ierr = PetscFEInterpolateGradient_Static(fe, &x[fieldOffset], &qgeom, q, interpolant);CHKERRQ(ierr);
1418 /* Overwrite with the dot product if the normal is given */
1419 if (n) {
1420 for (fc = 0; fc < Nc; ++fc) {
1421 PetscScalar sum = 0.0;
1422 PetscInt d;
1423 for (d = 0; d < dim; ++d) sum += interpolant[fc*dim+d]*n[d];
1424 interpolant[fc] = sum;
1425 }
1426 }
1427 for (fc = 0; fc < Nc; ++fc) {
1428 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1429 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %D fieldDer %D,%D diff %g\n", c, field, fc, (double)(PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]));CHKERRQ(ierr);}
1430 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q];
1431 }
1432 }
1433 fieldOffset += Nb;
1434 qc += Nc;
1435 }
1436 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1437 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " elem %D diff %g\n", c, (double)elemDiff);CHKERRQ(ierr);}
1438 localDiff += elemDiff;
1439 }
1440 ierr = PetscFree6(funcVal,coords,fegeom.J,fegeom.invJ,interpolant,fegeom.detJ);CHKERRQ(ierr);
1441 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
1442 ierr = MPIU_Allreduce(&localDiff, diff, 1, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
1443 *diff = PetscSqrtReal(*diff);
1444 PetscFunctionReturn(0);
1445 }
1446
DMComputeL2FieldDiff_Plex(DM dm,PetscReal time,PetscErrorCode (** funcs)(PetscInt,PetscReal,const PetscReal[],PetscInt,PetscScalar *,void *),void ** ctxs,Vec X,PetscReal * diff)1447 PetscErrorCode DMComputeL2FieldDiff_Plex(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, PetscReal *diff)
1448 {
1449 const PetscInt debug = ((DM_Plex*)dm->data)->printL2;
1450 DM tdm;
1451 DMLabel depthLabel;
1452 PetscSection section;
1453 Vec localX, tv;
1454 PetscReal *localDiff;
1455 PetscInt dim, depth, dE, Nf, f, Nds, s;
1456 PetscBool transform;
1457 PetscErrorCode ierr;
1458
1459 PetscFunctionBegin;
1460 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1461 ierr = DMGetCoordinateDim(dm, &dE);CHKERRQ(ierr);
1462 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
1463 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
1464 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr);
1465 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr);
1466 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr);
1467 ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
1468 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
1469 ierr = DMLabelGetNumValues(depthLabel, &depth);CHKERRQ(ierr);
1470
1471 ierr = VecSet(localX, 0.0);CHKERRQ(ierr);
1472 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1473 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1474 ierr = DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);CHKERRQ(ierr);
1475 ierr = DMGetNumDS(dm, &Nds);CHKERRQ(ierr);
1476 ierr = PetscCalloc1(Nf, &localDiff);CHKERRQ(ierr);
1477 for (s = 0; s < Nds; ++s) {
1478 PetscDS ds;
1479 DMLabel label;
1480 IS fieldIS, pointIS;
1481 const PetscInt *fields, *points = NULL;
1482 PetscQuadrature quad;
1483 const PetscReal *quadPoints, *quadWeights;
1484 PetscFEGeom fegeom;
1485 PetscReal *coords, *gcoords;
1486 PetscScalar *funcVal, *interpolant;
1487 PetscBool isHybrid;
1488 PetscInt qNc, Nq, totNc, cStart = 0, cEnd, c, dsNf;
1489
1490 ierr = DMGetRegionNumDS(dm, s, &label, &fieldIS, &ds);CHKERRQ(ierr);
1491 ierr = ISGetIndices(fieldIS, &fields);CHKERRQ(ierr);
1492 ierr = PetscDSGetHybrid(ds, &isHybrid);CHKERRQ(ierr);
1493 ierr = PetscDSGetNumFields(ds, &dsNf);CHKERRQ(ierr);
1494 ierr = PetscDSGetTotalComponents(ds, &totNc);CHKERRQ(ierr);
1495 ierr = PetscDSGetQuadrature(ds, &quad);CHKERRQ(ierr);
1496 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr);
1497 if ((qNc != 1) && (qNc != totNc)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, totNc);
1498 ierr = PetscCalloc6(totNc, &funcVal, totNc, &interpolant, dE*(Nq+1), &coords,Nq, &fegeom.detJ, dE*dE*Nq, &fegeom.J, dE*dE*Nq, &fegeom.invJ);CHKERRQ(ierr);
1499 if (!label) {
1500 ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1501 } else {
1502 ierr = DMLabelGetStratumIS(label, 1, &pointIS);CHKERRQ(ierr);
1503 ierr = ISGetLocalSize(pointIS, &cEnd);CHKERRQ(ierr);
1504 ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
1505 }
1506 for (c = cStart; c < cEnd; ++c) {
1507 const PetscInt cell = points ? points[c] : c;
1508 PetscScalar *x = NULL;
1509 PetscInt qc = 0, fOff = 0, dep, fStart = isHybrid ? dsNf-1 : 0;
1510
1511 ierr = DMLabelGetValue(depthLabel, cell, &dep);CHKERRQ(ierr);
1512 if (dep != depth-1) continue;
1513 if (isHybrid) {
1514 const PetscInt *cone;
1515
1516 ierr = DMPlexGetCone(dm, cell, &cone);CHKERRQ(ierr);
1517 ierr = DMPlexComputeCellGeometryFEM(dm, cone[0], quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr);
1518 } else {
1519 ierr = DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr);
1520 }
1521 ierr = DMPlexVecGetClosure(dm, NULL, localX, cell, NULL, &x);CHKERRQ(ierr);
1522 for (f = fStart; f < dsNf; ++f) {
1523 PetscObject obj;
1524 PetscClassId id;
1525 void * const ctx = ctxs ? ctxs[fields[f]] : NULL;
1526 PetscInt Nb, Nc, q, fc;
1527 PetscReal elemDiff = 0.0;
1528
1529 ierr = PetscDSGetDiscretization(ds, f, &obj);CHKERRQ(ierr);
1530 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1531 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);}
1532 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;}
1533 else SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", fields[f]);
1534 if (debug) {
1535 char title[1024];
1536 ierr = PetscSNPrintf(title, 1023, "Solution for Field %D", fields[f]);CHKERRQ(ierr);
1537 ierr = DMPrintCellVector(cell, title, Nb, &x[fOff]);CHKERRQ(ierr);
1538 }
1539 for (q = 0; q < Nq; ++q) {
1540 PetscFEGeom qgeom;
1541
1542 qgeom.dimEmbed = fegeom.dimEmbed;
1543 qgeom.J = &fegeom.J[q*dE*dE];
1544 qgeom.invJ = &fegeom.invJ[q*dE*dE];
1545 qgeom.detJ = &fegeom.detJ[q];
1546 if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for cell %D, quadrature point %D", (double)fegeom.detJ[q], cell, q);
1547 if (transform) {
1548 gcoords = &coords[dE*Nq];
1549 ierr = DMPlexBasisTransformApplyReal_Internal(dm, &coords[dE*q], PETSC_TRUE, dE, &coords[dE*q], gcoords, dm->transformCtx);CHKERRQ(ierr);
1550 } else {
1551 gcoords = &coords[dE*q];
1552 }
1553 ierr = (*funcs[fields[f]])(dE, time, gcoords, Nc, funcVal, ctx);
1554 if (ierr) {
1555 PetscErrorCode ierr2;
1556 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, cell, NULL, &x);CHKERRQ(ierr2);
1557 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
1558 ierr2 = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr2);
1559 CHKERRQ(ierr);
1560 }
1561 if (transform) {ierr = DMPlexBasisTransformApply_Internal(dm, &coords[dE*q], PETSC_FALSE, Nc, funcVal, funcVal, dm->transformCtx);CHKERRQ(ierr);}
1562 /* Call once for each face, except for lagrange field */
1563 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fOff], &qgeom, q, interpolant);CHKERRQ(ierr);}
1564 else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fOff], q, interpolant);CHKERRQ(ierr);}
1565 else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", fields[f]);
1566 for (fc = 0; fc < Nc; ++fc) {
1567 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1568 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " cell %D field %D,%D point %g %g %g diff %g\n", cell, fields[f], fc, (double)(dE > 0 ? coords[dE*q] : 0.), (double)(dE > 1 ? coords[dE*q+1] : 0.),(double)(dE > 2 ? coords[dE*q+2] : 0.), (double)(PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q]));CHKERRQ(ierr);}
1569 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q];
1570 }
1571 }
1572 fOff += Nb;
1573 qc += Nc;
1574 localDiff[fields[f]] += elemDiff;
1575 if (debug) {ierr = PetscPrintf(PETSC_COMM_SELF, " cell %D field %D cum diff %g\n", cell, fields[f], (double)localDiff[fields[f]]);CHKERRQ(ierr);}
1576 }
1577 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, cell, NULL, &x);CHKERRQ(ierr);
1578 }
1579 if (label) {
1580 ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
1581 ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
1582 }
1583 ierr = ISRestoreIndices(fieldIS, &fields);CHKERRQ(ierr);
1584 ierr = PetscFree6(funcVal, interpolant, coords, fegeom.detJ, fegeom.J, fegeom.invJ);CHKERRQ(ierr);
1585 }
1586 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
1587 ierr = MPIU_Allreduce(localDiff, diff, Nf, MPIU_REAL, MPIU_SUM, PetscObjectComm((PetscObject)dm));CHKERRQ(ierr);
1588 ierr = PetscFree(localDiff);CHKERRQ(ierr);
1589 for (f = 0; f < Nf; ++f) diff[f] = PetscSqrtReal(diff[f]);
1590 PetscFunctionReturn(0);
1591 }
1592
1593 /*@C
1594 DMPlexComputeL2DiffVec - This function computes the cellwise L_2 difference between a function u and an FEM interpolant solution u_h, and stores it in a Vec.
1595
1596 Collective on dm
1597
1598 Input Parameters:
1599 + dm - The DM
1600 . time - The time
1601 . funcs - The functions to evaluate for each field component: NULL means that component does not contribute to error calculation
1602 . ctxs - Optional array of contexts to pass to each function, or NULL.
1603 - X - The coefficient vector u_h
1604
1605 Output Parameter:
1606 . D - A Vec which holds the difference ||u - u_h||_2 for each cell
1607
1608 Level: developer
1609
1610 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff()
1611 @*/
DMPlexComputeL2DiffVec(DM dm,PetscReal time,PetscErrorCode (** funcs)(PetscInt,PetscReal,const PetscReal[],PetscInt,PetscScalar *,void *),void ** ctxs,Vec X,Vec D)1612 PetscErrorCode DMPlexComputeL2DiffVec(DM dm, PetscReal time, PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void **ctxs, Vec X, Vec D)
1613 {
1614 PetscSection section;
1615 PetscQuadrature quad;
1616 Vec localX;
1617 PetscFEGeom fegeom;
1618 PetscScalar *funcVal, *interpolant;
1619 PetscReal *coords;
1620 const PetscReal *quadPoints, *quadWeights;
1621 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, c, field, fieldOffset;
1622 PetscErrorCode ierr;
1623
1624 PetscFunctionBegin;
1625 ierr = VecSet(D, 0.0);CHKERRQ(ierr);
1626 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1627 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
1628 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
1629 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
1630 ierr = DMGetLocalVector(dm, &localX);CHKERRQ(ierr);
1631 ierr = DMProjectFunctionLocal(dm, time, funcs, ctxs, INSERT_BC_VALUES, localX);CHKERRQ(ierr);
1632 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1633 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, localX);CHKERRQ(ierr);
1634 for (field = 0; field < numFields; ++field) {
1635 PetscObject obj;
1636 PetscClassId id;
1637 PetscInt Nc;
1638
1639 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1640 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1641 if (id == PETSCFE_CLASSID) {
1642 PetscFE fe = (PetscFE) obj;
1643
1644 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
1645 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1646 } else if (id == PETSCFV_CLASSID) {
1647 PetscFV fv = (PetscFV) obj;
1648
1649 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr);
1650 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
1651 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1652 numComponents += Nc;
1653 }
1654 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr);
1655 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1656 ierr = PetscMalloc6(numComponents,&funcVal,numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ);CHKERRQ(ierr);
1657 ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1658 for (c = cStart; c < cEnd; ++c) {
1659 PetscScalar *x = NULL;
1660 PetscScalar elemDiff = 0.0;
1661 PetscInt qc = 0;
1662
1663 ierr = DMPlexComputeCellGeometryFEM(dm, c, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr);
1664 ierr = DMPlexVecGetClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1665
1666 for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1667 PetscObject obj;
1668 PetscClassId id;
1669 void * const ctx = ctxs ? ctxs[field] : NULL;
1670 PetscInt Nb, Nc, q, fc;
1671
1672 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1673 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1674 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);}
1675 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;}
1676 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1677 if (funcs[field]) {
1678 for (q = 0; q < Nq; ++q) {
1679 PetscFEGeom qgeom;
1680
1681 qgeom.dimEmbed = fegeom.dimEmbed;
1682 qgeom.J = &fegeom.J[q*coordDim*coordDim];
1683 qgeom.invJ = &fegeom.invJ[q*coordDim*coordDim];
1684 qgeom.detJ = &fegeom.detJ[q];
1685 if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)fegeom.detJ[q], c, q);
1686 ierr = (*funcs[field])(coordDim, time, &coords[q*coordDim], Nc, funcVal, ctx);
1687 if (ierr) {
1688 PetscErrorCode ierr2;
1689 ierr2 = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr2);
1690 ierr2 = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr2);
1691 ierr2 = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr2);
1692 CHKERRQ(ierr);
1693 }
1694 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolate_Static((PetscFE) obj, &x[fieldOffset], &qgeom, q, interpolant);CHKERRQ(ierr);}
1695 else if (id == PETSCFV_CLASSID) {ierr = PetscFVInterpolate_Static((PetscFV) obj, &x[fieldOffset], q, interpolant);CHKERRQ(ierr);}
1696 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1697 for (fc = 0; fc < Nc; ++fc) {
1698 const PetscReal wt = quadWeights[q*qNc+(qNc == 1 ? 0 : qc+fc)];
1699 elemDiff += PetscSqr(PetscRealPart(interpolant[fc] - funcVal[fc]))*wt*fegeom.detJ[q];
1700 }
1701 }
1702 }
1703 fieldOffset += Nb;
1704 qc += Nc;
1705 }
1706 ierr = DMPlexVecRestoreClosure(dm, NULL, localX, c, NULL, &x);CHKERRQ(ierr);
1707 ierr = VecSetValue(D, c - cStart, elemDiff, INSERT_VALUES);CHKERRQ(ierr);
1708 }
1709 ierr = PetscFree6(funcVal,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr);
1710 ierr = DMRestoreLocalVector(dm, &localX);CHKERRQ(ierr);
1711 ierr = VecSqrtAbs(D);CHKERRQ(ierr);
1712 PetscFunctionReturn(0);
1713 }
1714
1715 /*@C
1716 DMPlexComputeGradientClementInterpolant - This function computes the L2 projection of the cellwise gradient of a function u onto P1, and stores it in a Vec.
1717
1718 Collective on dm
1719
1720 Input Parameters:
1721 + dm - The DM
1722 - LocX - The coefficient vector u_h
1723
1724 Output Parameter:
1725 . locC - A Vec which holds the Clement interpolant of the gradient
1726
1727 Notes:
1728 Add citation to (Clement, 1975) and definition of the interpolant
1729 \nabla u_h(v_i) = \sum_{T_i \in support(v_i)} |T_i| \nabla u_h(T_i) / \sum_{T_i \in support(v_i)} |T_i| where |T_i| is the cell volume
1730
1731 Level: developer
1732
1733 .seealso: DMProjectFunction(), DMComputeL2Diff(), DMPlexComputeL2FieldDiff(), DMComputeL2GradientDiff()
1734 @*/
DMPlexComputeGradientClementInterpolant(DM dm,Vec locX,Vec locC)1735 PetscErrorCode DMPlexComputeGradientClementInterpolant(DM dm, Vec locX, Vec locC)
1736 {
1737 DM_Plex *mesh = (DM_Plex *) dm->data;
1738 PetscInt debug = mesh->printFEM;
1739 DM dmC;
1740 PetscSection section;
1741 PetscQuadrature quad;
1742 PetscScalar *interpolant, *gradsum;
1743 PetscFEGeom fegeom;
1744 PetscReal *coords;
1745 const PetscReal *quadPoints, *quadWeights;
1746 PetscInt dim, coordDim, numFields, numComponents = 0, qNc, Nq, cStart, cEnd, vStart, vEnd, v, field, fieldOffset;
1747 PetscErrorCode ierr;
1748
1749 PetscFunctionBegin;
1750 ierr = VecGetDM(locC, &dmC);CHKERRQ(ierr);
1751 ierr = VecSet(locC, 0.0);CHKERRQ(ierr);
1752 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1753 ierr = DMGetCoordinateDim(dm, &coordDim);CHKERRQ(ierr);
1754 fegeom.dimEmbed = coordDim;
1755 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
1756 ierr = PetscSectionGetNumFields(section, &numFields);CHKERRQ(ierr);
1757 for (field = 0; field < numFields; ++field) {
1758 PetscObject obj;
1759 PetscClassId id;
1760 PetscInt Nc;
1761
1762 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1763 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1764 if (id == PETSCFE_CLASSID) {
1765 PetscFE fe = (PetscFE) obj;
1766
1767 ierr = PetscFEGetQuadrature(fe, &quad);CHKERRQ(ierr);
1768 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
1769 } else if (id == PETSCFV_CLASSID) {
1770 PetscFV fv = (PetscFV) obj;
1771
1772 ierr = PetscFVGetQuadrature(fv, &quad);CHKERRQ(ierr);
1773 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
1774 } else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1775 numComponents += Nc;
1776 }
1777 ierr = PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);CHKERRQ(ierr);
1778 if ((qNc != 1) && (qNc != numComponents)) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_SIZ, "Quadrature components %D != %D field components", qNc, numComponents);
1779 ierr = PetscMalloc6(coordDim*numComponents*2,&gradsum,coordDim*numComponents,&interpolant,coordDim*Nq,&coords,Nq,&fegeom.detJ,coordDim*coordDim*Nq,&fegeom.J,coordDim*coordDim*Nq,&fegeom.invJ);CHKERRQ(ierr);
1780 ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
1781 ierr = DMPlexGetSimplexOrBoxCells(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
1782 for (v = vStart; v < vEnd; ++v) {
1783 PetscScalar volsum = 0.0;
1784 PetscInt *star = NULL;
1785 PetscInt starSize, st, d, fc;
1786
1787 ierr = PetscArrayzero(gradsum, coordDim*numComponents);CHKERRQ(ierr);
1788 ierr = DMPlexGetTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr);
1789 for (st = 0; st < starSize*2; st += 2) {
1790 const PetscInt cell = star[st];
1791 PetscScalar *grad = &gradsum[coordDim*numComponents];
1792 PetscScalar *x = NULL;
1793 PetscReal vol = 0.0;
1794
1795 if ((cell < cStart) || (cell >= cEnd)) continue;
1796 ierr = DMPlexComputeCellGeometryFEM(dm, cell, quad, coords, fegeom.J, fegeom.invJ, fegeom.detJ);CHKERRQ(ierr);
1797 ierr = DMPlexVecGetClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr);
1798 for (field = 0, fieldOffset = 0; field < numFields; ++field) {
1799 PetscObject obj;
1800 PetscClassId id;
1801 PetscInt Nb, Nc, q, qc = 0;
1802
1803 ierr = PetscArrayzero(grad, coordDim*numComponents);CHKERRQ(ierr);
1804 ierr = DMGetField(dm, field, NULL, &obj);CHKERRQ(ierr);
1805 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1806 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetNumComponents((PetscFE) obj, &Nc);CHKERRQ(ierr);ierr = PetscFEGetDimension((PetscFE) obj, &Nb);CHKERRQ(ierr);}
1807 else if (id == PETSCFV_CLASSID) {ierr = PetscFVGetNumComponents((PetscFV) obj, &Nc);CHKERRQ(ierr);Nb = 1;}
1808 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1809 for (q = 0; q < Nq; ++q) {
1810 PetscFEGeom qgeom;
1811
1812 qgeom.dimEmbed = fegeom.dimEmbed;
1813 qgeom.J = &fegeom.J[q*coordDim*coordDim];
1814 qgeom.invJ = &fegeom.invJ[q*coordDim*coordDim];
1815 qgeom.detJ = &fegeom.detJ[q];
1816 if (fegeom.detJ[q] <= 0.0) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %D, quadrature points %D", (double)fegeom.detJ[q], cell, q);
1817 if (ierr) {
1818 PetscErrorCode ierr2;
1819 ierr2 = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr2);
1820 ierr2 = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr2);
1821 ierr2 = PetscFree6(gradsum,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr2);
1822 CHKERRQ(ierr);
1823 }
1824 if (id == PETSCFE_CLASSID) {ierr = PetscFEInterpolateGradient_Static((PetscFE) obj, &x[fieldOffset], &qgeom, q, interpolant);CHKERRQ(ierr);}
1825 else SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", field);
1826 for (fc = 0; fc < Nc; ++fc) {
1827 const PetscReal wt = quadWeights[q*qNc+qc+fc];
1828
1829 for (d = 0; d < coordDim; ++d) grad[fc*coordDim+d] += interpolant[fc*dim+d]*wt*fegeom.detJ[q];
1830 }
1831 vol += quadWeights[q*qNc]*fegeom.detJ[q];
1832 }
1833 fieldOffset += Nb;
1834 qc += Nc;
1835 }
1836 ierr = DMPlexVecRestoreClosure(dm, NULL, locX, cell, NULL, &x);CHKERRQ(ierr);
1837 for (fc = 0; fc < numComponents; ++fc) {
1838 for (d = 0; d < coordDim; ++d) {
1839 gradsum[fc*coordDim+d] += grad[fc*coordDim+d];
1840 }
1841 }
1842 volsum += vol;
1843 if (debug) {
1844 ierr = PetscPrintf(PETSC_COMM_SELF, "Cell %D gradient: [", cell);CHKERRQ(ierr);
1845 for (fc = 0; fc < numComponents; ++fc) {
1846 for (d = 0; d < coordDim; ++d) {
1847 if (fc || d > 0) {ierr = PetscPrintf(PETSC_COMM_SELF, ", ");CHKERRQ(ierr);}
1848 ierr = PetscPrintf(PETSC_COMM_SELF, "%g", (double)PetscRealPart(grad[fc*coordDim+d]));CHKERRQ(ierr);
1849 }
1850 }
1851 ierr = PetscPrintf(PETSC_COMM_SELF, "]\n");CHKERRQ(ierr);
1852 }
1853 }
1854 for (fc = 0; fc < numComponents; ++fc) {
1855 for (d = 0; d < coordDim; ++d) gradsum[fc*coordDim+d] /= volsum;
1856 }
1857 ierr = DMPlexRestoreTransitiveClosure(dm, v, PETSC_FALSE, &starSize, &star);CHKERRQ(ierr);
1858 ierr = DMPlexVecSetClosure(dmC, NULL, locC, v, gradsum, INSERT_VALUES);CHKERRQ(ierr);
1859 }
1860 ierr = PetscFree6(gradsum,interpolant,coords,fegeom.detJ,fegeom.J,fegeom.invJ);CHKERRQ(ierr);
1861 PetscFunctionReturn(0);
1862 }
1863
DMPlexComputeIntegral_Internal(DM dm,Vec X,PetscInt cStart,PetscInt cEnd,PetscScalar * cintegral,void * user)1864 static PetscErrorCode DMPlexComputeIntegral_Internal(DM dm, Vec X, PetscInt cStart, PetscInt cEnd, PetscScalar *cintegral, void *user)
1865 {
1866 DM dmAux = NULL;
1867 PetscDS prob, probAux = NULL;
1868 PetscSection section, sectionAux;
1869 Vec locX, locA;
1870 PetscInt dim, numCells = cEnd - cStart, c, f;
1871 PetscBool useFVM = PETSC_FALSE;
1872 /* DS */
1873 PetscInt Nf, totDim, *uOff, *uOff_x, numConstants;
1874 PetscInt NfAux, totDimAux, *aOff;
1875 PetscScalar *u, *a;
1876 const PetscScalar *constants;
1877 /* Geometry */
1878 PetscFEGeom *cgeomFEM;
1879 DM dmGrad;
1880 PetscQuadrature affineQuad = NULL;
1881 Vec cellGeometryFVM = NULL, faceGeometryFVM = NULL, locGrad = NULL;
1882 PetscFVCellGeom *cgeomFVM;
1883 const PetscScalar *lgrad;
1884 PetscInt maxDegree;
1885 DMField coordField;
1886 IS cellIS;
1887 PetscErrorCode ierr;
1888
1889 PetscFunctionBegin;
1890 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
1891 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
1892 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
1893 ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
1894 /* Determine which discretizations we have */
1895 for (f = 0; f < Nf; ++f) {
1896 PetscObject obj;
1897 PetscClassId id;
1898
1899 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1900 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1901 if (id == PETSCFV_CLASSID) useFVM = PETSC_TRUE;
1902 }
1903 /* Get local solution with boundary values */
1904 ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr);
1905 ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);CHKERRQ(ierr);
1906 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
1907 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
1908 /* Read DS information */
1909 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
1910 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr);
1911 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr);
1912 ierr = ISCreateStride(PETSC_COMM_SELF,numCells,cStart,1,&cellIS);CHKERRQ(ierr);
1913 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr);
1914 /* Read Auxiliary DS information */
1915 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr);
1916 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr);
1917 if (dmAux) {
1918 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
1919 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr);
1920 ierr = DMGetLocalSection(dmAux, §ionAux);CHKERRQ(ierr);
1921 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
1922 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr);
1923 }
1924 /* Allocate data arrays */
1925 ierr = PetscCalloc1(numCells*totDim, &u);CHKERRQ(ierr);
1926 if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);}
1927 /* Read out geometry */
1928 ierr = DMGetCoordinateField(dm,&coordField);CHKERRQ(ierr);
1929 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr);
1930 if (maxDegree <= 1) {
1931 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr);
1932 if (affineQuad) {
1933 ierr = DMFieldCreateFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr);
1934 }
1935 }
1936 if (useFVM) {
1937 PetscFV fv = NULL;
1938 Vec grad;
1939 PetscInt fStart, fEnd;
1940 PetscBool compGrad;
1941
1942 for (f = 0; f < Nf; ++f) {
1943 PetscObject obj;
1944 PetscClassId id;
1945
1946 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1947 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1948 if (id == PETSCFV_CLASSID) {fv = (PetscFV) obj; break;}
1949 }
1950 ierr = PetscFVGetComputeGradients(fv, &compGrad);CHKERRQ(ierr);
1951 ierr = PetscFVSetComputeGradients(fv, PETSC_TRUE);CHKERRQ(ierr);
1952 ierr = DMPlexComputeGeometryFVM(dm, &cellGeometryFVM, &faceGeometryFVM);CHKERRQ(ierr);
1953 ierr = DMPlexComputeGradientFVM(dm, fv, faceGeometryFVM, cellGeometryFVM, &dmGrad);CHKERRQ(ierr);
1954 ierr = PetscFVSetComputeGradients(fv, compGrad);CHKERRQ(ierr);
1955 ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr);
1956 /* Reconstruct and limit cell gradients */
1957 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
1958 ierr = DMGetGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
1959 ierr = DMPlexReconstructGradients_Internal(dm, fv, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr);
1960 /* Communicate gradient values */
1961 ierr = DMGetLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);
1962 ierr = DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
1963 ierr = DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
1964 ierr = DMRestoreGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
1965 /* Handle non-essential (e.g. outflow) boundary values */
1966 ierr = DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, 0.0, faceGeometryFVM, cellGeometryFVM, locGrad);CHKERRQ(ierr);
1967 ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
1968 }
1969 /* Read out data from inputs */
1970 for (c = cStart; c < cEnd; ++c) {
1971 PetscScalar *x = NULL;
1972 PetscInt i;
1973
1974 ierr = DMPlexVecGetClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr);
1975 for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
1976 ierr = DMPlexVecRestoreClosure(dm, section, locX, c, NULL, &x);CHKERRQ(ierr);
1977 if (dmAux) {
1978 ierr = DMPlexVecGetClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr);
1979 for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
1980 ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, locA, c, NULL, &x);CHKERRQ(ierr);
1981 }
1982 }
1983 /* Do integration for each field */
1984 for (f = 0; f < Nf; ++f) {
1985 PetscObject obj;
1986 PetscClassId id;
1987 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;
1988
1989 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
1990 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
1991 if (id == PETSCFE_CLASSID) {
1992 PetscFE fe = (PetscFE) obj;
1993 PetscQuadrature q;
1994 PetscFEGeom *chunkGeom = NULL;
1995 PetscInt Nq, Nb;
1996
1997 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
1998 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
1999 ierr = PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
2000 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
2001 blockSize = Nb*Nq;
2002 batchSize = numBlocks * blockSize;
2003 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
2004 numChunks = numCells / (numBatches*batchSize);
2005 Ne = numChunks*numBatches*batchSize;
2006 Nr = numCells % (numBatches*batchSize);
2007 offset = numCells - Nr;
2008 if (!affineQuad) {
2009 ierr = DMFieldCreateFEGeom(coordField,cellIS,q,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr);
2010 }
2011 ierr = PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr);
2012 ierr = PetscFEIntegrate(prob, f, Ne, chunkGeom, u, probAux, a, cintegral);CHKERRQ(ierr);
2013 ierr = PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&chunkGeom);CHKERRQ(ierr);
2014 ierr = PetscFEIntegrate(prob, f, Nr, chunkGeom, &u[offset*totDim], probAux, &a[offset*totDimAux], &cintegral[offset*Nf]);CHKERRQ(ierr);
2015 ierr = PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&chunkGeom);CHKERRQ(ierr);
2016 if (!affineQuad) {
2017 ierr = PetscFEGeomDestroy(&cgeomFEM);CHKERRQ(ierr);
2018 }
2019 } else if (id == PETSCFV_CLASSID) {
2020 PetscInt foff;
2021 PetscPointFunc obj_func;
2022 PetscScalar lint;
2023
2024 ierr = PetscDSGetObjective(prob, f, &obj_func);CHKERRQ(ierr);
2025 ierr = PetscDSGetFieldOffset(prob, f, &foff);CHKERRQ(ierr);
2026 if (obj_func) {
2027 for (c = 0; c < numCells; ++c) {
2028 PetscScalar *u_x;
2029
2030 ierr = DMPlexPointLocalRead(dmGrad, c, lgrad, &u_x);CHKERRQ(ierr);
2031 obj_func(dim, Nf, NfAux, uOff, uOff_x, &u[totDim*c+foff], NULL, u_x, aOff, NULL, &a[totDimAux*c], NULL, NULL, 0.0, cgeomFVM[c].centroid, numConstants, constants, &lint);
2032 cintegral[c*Nf+f] += PetscRealPart(lint)*cgeomFVM[c].volume;
2033 }
2034 }
2035 } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
2036 }
2037 /* Cleanup data arrays */
2038 if (useFVM) {
2039 ierr = VecRestoreArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
2040 ierr = VecRestoreArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr);
2041 ierr = DMRestoreLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);
2042 ierr = VecDestroy(&faceGeometryFVM);CHKERRQ(ierr);
2043 ierr = VecDestroy(&cellGeometryFVM);CHKERRQ(ierr);
2044 ierr = DMDestroy(&dmGrad);CHKERRQ(ierr);
2045 }
2046 if (dmAux) {ierr = PetscFree(a);CHKERRQ(ierr);}
2047 ierr = PetscFree(u);CHKERRQ(ierr);
2048 /* Cleanup */
2049 if (affineQuad) {
2050 ierr = PetscFEGeomDestroy(&cgeomFEM);CHKERRQ(ierr);
2051 }
2052 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr);
2053 ierr = ISDestroy(&cellIS);CHKERRQ(ierr);
2054 ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr);
2055 PetscFunctionReturn(0);
2056 }
2057
2058 /*@
2059 DMPlexComputeIntegralFEM - Form the integral over the domain from the global input X using pointwise functions specified by the user
2060
2061 Input Parameters:
2062 + dm - The mesh
2063 . X - Global input vector
2064 - user - The user context
2065
2066 Output Parameter:
2067 . integral - Integral for each field
2068
2069 Level: developer
2070
2071 .seealso: DMPlexComputeResidualFEM()
2072 @*/
DMPlexComputeIntegralFEM(DM dm,Vec X,PetscScalar * integral,void * user)2073 PetscErrorCode DMPlexComputeIntegralFEM(DM dm, Vec X, PetscScalar *integral, void *user)
2074 {
2075 DM_Plex *mesh = (DM_Plex *) dm->data;
2076 PetscScalar *cintegral, *lintegral;
2077 PetscInt Nf, f, cellHeight, cStart, cEnd, cell;
2078 PetscErrorCode ierr;
2079
2080 PetscFunctionBegin;
2081 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2082 PetscValidHeaderSpecific(X, VEC_CLASSID, 2);
2083 PetscValidPointer(integral, 3);
2084 ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
2085 ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
2086 ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
2087 ierr = DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
2088 /* TODO Introduce a loop over large chunks (right now this is a single chunk) */
2089 ierr = PetscCalloc2(Nf, &lintegral, (cEnd-cStart)*Nf, &cintegral);CHKERRQ(ierr);
2090 ierr = DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);CHKERRQ(ierr);
2091 /* Sum up values */
2092 for (cell = cStart; cell < cEnd; ++cell) {
2093 const PetscInt c = cell - cStart;
2094
2095 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);CHKERRQ(ierr);}
2096 for (f = 0; f < Nf; ++f) lintegral[f] += cintegral[c*Nf+f];
2097 }
2098 ierr = MPIU_Allreduce(lintegral, integral, Nf, MPIU_SCALAR, MPIU_SUM, PetscObjectComm((PetscObject) dm));CHKERRQ(ierr);
2099 if (mesh->printFEM) {
2100 ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "Integral:");CHKERRQ(ierr);
2101 for (f = 0; f < Nf; ++f) {ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), " %g", (double) PetscRealPart(integral[f]));CHKERRQ(ierr);}
2102 ierr = PetscPrintf(PetscObjectComm((PetscObject) dm), "\n");CHKERRQ(ierr);
2103 }
2104 ierr = PetscFree2(lintegral, cintegral);CHKERRQ(ierr);
2105 ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
2106 PetscFunctionReturn(0);
2107 }
2108
2109 /*@
2110 DMPlexComputeCellwiseIntegralFEM - Form the vector of cellwise integrals F from the global input X using pointwise functions specified by the user
2111
2112 Input Parameters:
2113 + dm - The mesh
2114 . X - Global input vector
2115 - user - The user context
2116
2117 Output Parameter:
2118 . integral - Cellwise integrals for each field
2119
2120 Level: developer
2121
2122 .seealso: DMPlexComputeResidualFEM()
2123 @*/
DMPlexComputeCellwiseIntegralFEM(DM dm,Vec X,Vec F,void * user)2124 PetscErrorCode DMPlexComputeCellwiseIntegralFEM(DM dm, Vec X, Vec F, void *user)
2125 {
2126 DM_Plex *mesh = (DM_Plex *) dm->data;
2127 DM dmF;
2128 PetscSection sectionF;
2129 PetscScalar *cintegral, *af;
2130 PetscInt Nf, f, cellHeight, cStart, cEnd, cell;
2131 PetscErrorCode ierr;
2132
2133 PetscFunctionBegin;
2134 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2135 PetscValidHeaderSpecific(X, VEC_CLASSID, 2);
2136 PetscValidHeaderSpecific(F, VEC_CLASSID, 3);
2137 ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
2138 ierr = DMGetNumFields(dm, &Nf);CHKERRQ(ierr);
2139 ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
2140 ierr = DMPlexGetSimplexOrBoxCells(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
2141 /* TODO Introduce a loop over large chunks (right now this is a single chunk) */
2142 ierr = PetscCalloc1((cEnd-cStart)*Nf, &cintegral);CHKERRQ(ierr);
2143 ierr = DMPlexComputeIntegral_Internal(dm, X, cStart, cEnd, cintegral, user);CHKERRQ(ierr);
2144 /* Put values in F*/
2145 ierr = VecGetDM(F, &dmF);CHKERRQ(ierr);
2146 ierr = DMGetLocalSection(dmF, §ionF);CHKERRQ(ierr);
2147 ierr = VecGetArray(F, &af);CHKERRQ(ierr);
2148 for (cell = cStart; cell < cEnd; ++cell) {
2149 const PetscInt c = cell - cStart;
2150 PetscInt dof, off;
2151
2152 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, "Cell Integral", Nf, &cintegral[c*Nf]);CHKERRQ(ierr);}
2153 ierr = PetscSectionGetDof(sectionF, cell, &dof);CHKERRQ(ierr);
2154 ierr = PetscSectionGetOffset(sectionF, cell, &off);CHKERRQ(ierr);
2155 if (dof != Nf) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "The number of cell dofs %D != %D", dof, Nf);
2156 for (f = 0; f < Nf; ++f) af[off+f] = cintegral[c*Nf+f];
2157 }
2158 ierr = VecRestoreArray(F, &af);CHKERRQ(ierr);
2159 ierr = PetscFree(cintegral);CHKERRQ(ierr);
2160 ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
2161 PetscFunctionReturn(0);
2162 }
2163
DMPlexComputeBdIntegral_Internal(DM dm,Vec locX,IS pointIS,void (* func)(PetscInt,PetscInt,PetscInt,const PetscInt[],const PetscInt[],const PetscScalar[],const PetscScalar[],const PetscScalar[],const PetscInt[],const PetscInt[],const PetscScalar[],const PetscScalar[],const PetscScalar[],PetscReal,const PetscReal[],const PetscReal[],PetscInt,const PetscScalar[],PetscScalar[]),PetscScalar * fintegral,void * user)2164 static PetscErrorCode DMPlexComputeBdIntegral_Internal(DM dm, Vec locX, IS pointIS,
2165 void (*func)(PetscInt, PetscInt, PetscInt,
2166 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
2167 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
2168 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]),
2169 PetscScalar *fintegral, void *user)
2170 {
2171 DM plex = NULL, plexA = NULL;
2172 DMEnclosureType encAux;
2173 PetscDS prob, probAux = NULL;
2174 PetscSection section, sectionAux = NULL;
2175 Vec locA = NULL;
2176 DMField coordField;
2177 PetscInt Nf, totDim, *uOff, *uOff_x;
2178 PetscInt NfAux = 0, totDimAux = 0, *aOff = NULL;
2179 PetscScalar *u, *a = NULL;
2180 const PetscScalar *constants;
2181 PetscInt numConstants, f;
2182 PetscErrorCode ierr;
2183
2184 PetscFunctionBegin;
2185 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
2186 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr);
2187 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
2188 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
2189 ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
2190 /* Determine which discretizations we have */
2191 for (f = 0; f < Nf; ++f) {
2192 PetscObject obj;
2193 PetscClassId id;
2194
2195 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
2196 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2197 if (id == PETSCFV_CLASSID) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_SUP, "Not supported for FVM (field %D)", f);
2198 }
2199 /* Read DS information */
2200 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
2201 ierr = PetscDSGetComponentOffsets(prob, &uOff);CHKERRQ(ierr);
2202 ierr = PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);CHKERRQ(ierr);
2203 ierr = PetscDSGetConstants(prob, &numConstants, &constants);CHKERRQ(ierr);
2204 /* Read Auxiliary DS information */
2205 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr);
2206 if (locA) {
2207 DM dmAux;
2208
2209 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
2210 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr);
2211 ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr);
2212 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
2213 ierr = PetscDSGetNumFields(probAux, &NfAux);CHKERRQ(ierr);
2214 ierr = DMGetLocalSection(dmAux, §ionAux);CHKERRQ(ierr);
2215 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
2216 ierr = PetscDSGetComponentOffsets(probAux, &aOff);CHKERRQ(ierr);
2217 }
2218 /* Integrate over points */
2219 {
2220 PetscFEGeom *fgeom, *chunkGeom = NULL;
2221 PetscInt maxDegree;
2222 PetscQuadrature qGeom = NULL;
2223 const PetscInt *points;
2224 PetscInt numFaces, face, Nq, field;
2225 PetscInt numChunks, chunkSize, chunk, Nr, offset;
2226
2227 ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr);
2228 ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
2229 ierr = PetscCalloc2(numFaces*totDim, &u, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr);
2230 ierr = DMFieldGetDegree(coordField, pointIS, NULL, &maxDegree);CHKERRQ(ierr);
2231 for (field = 0; field < Nf; ++field) {
2232 PetscFE fe;
2233
2234 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
2235 if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, pointIS, &qGeom);CHKERRQ(ierr);}
2236 if (!qGeom) {
2237 ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr);
2238 ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr);
2239 }
2240 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
2241 ierr = DMPlexGetFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);CHKERRQ(ierr);
2242 for (face = 0; face < numFaces; ++face) {
2243 const PetscInt point = points[face], *support;
2244 PetscScalar *x = NULL;
2245 PetscInt i;
2246
2247 ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
2248 ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
2249 for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
2250 ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
2251 if (locA) {
2252 PetscInt subp;
2253 ierr = DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp);CHKERRQ(ierr);
2254 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
2255 for (i = 0; i < totDimAux; ++i) a[f*totDimAux+i] = x[i];
2256 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
2257 }
2258 }
2259 /* Get blocking */
2260 {
2261 PetscQuadrature q;
2262 PetscInt numBatches, batchSize, numBlocks, blockSize;
2263 PetscInt Nq, Nb;
2264
2265 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
2266 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
2267 ierr = PetscQuadratureGetData(q, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
2268 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
2269 blockSize = Nb*Nq;
2270 batchSize = numBlocks * blockSize;
2271 chunkSize = numBatches*batchSize;
2272 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
2273 numChunks = numFaces / chunkSize;
2274 Nr = numFaces % chunkSize;
2275 offset = numFaces - Nr;
2276 }
2277 /* Do integration for each field */
2278 for (chunk = 0; chunk < numChunks; ++chunk) {
2279 ierr = PetscFEGeomGetChunk(fgeom, chunk*chunkSize, (chunk+1)*chunkSize, &chunkGeom);CHKERRQ(ierr);
2280 ierr = PetscFEIntegrateBd(prob, field, func, chunkSize, chunkGeom, u, probAux, a, fintegral);CHKERRQ(ierr);
2281 ierr = PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom);CHKERRQ(ierr);
2282 }
2283 ierr = PetscFEGeomGetChunk(fgeom, offset, numFaces, &chunkGeom);CHKERRQ(ierr);
2284 ierr = PetscFEIntegrateBd(prob, field, func, Nr, chunkGeom, &u[offset*totDim], probAux, a ? &a[offset*totDimAux] : NULL, &fintegral[offset*Nf]);CHKERRQ(ierr);
2285 ierr = PetscFEGeomRestoreChunk(fgeom, offset, numFaces, &chunkGeom);CHKERRQ(ierr);
2286 /* Cleanup data arrays */
2287 ierr = DMPlexRestoreFEGeom(coordField, pointIS, qGeom, PETSC_TRUE, &fgeom);CHKERRQ(ierr);
2288 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr);
2289 ierr = PetscFree2(u, a);CHKERRQ(ierr);
2290 ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
2291 }
2292 }
2293 if (plex) {ierr = DMDestroy(&plex);CHKERRQ(ierr);}
2294 if (plexA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);}
2295 PetscFunctionReturn(0);
2296 }
2297
2298 /*@
2299 DMPlexComputeBdIntegral - Form the integral over the specified boundary from the global input X using pointwise functions specified by the user
2300
2301 Input Parameters:
2302 + dm - The mesh
2303 . X - Global input vector
2304 . label - The boundary DMLabel
2305 . numVals - The number of label values to use, or PETSC_DETERMINE for all values
2306 . vals - The label values to use, or PETSC_NULL for all values
2307 . func = The function to integrate along the boundary
2308 - user - The user context
2309
2310 Output Parameter:
2311 . integral - Integral for each field
2312
2313 Level: developer
2314
2315 .seealso: DMPlexComputeIntegralFEM(), DMPlexComputeBdResidualFEM()
2316 @*/
DMPlexComputeBdIntegral(DM dm,Vec X,DMLabel label,PetscInt numVals,const PetscInt vals[],void (* func)(PetscInt,PetscInt,PetscInt,const PetscInt[],const PetscInt[],const PetscScalar[],const PetscScalar[],const PetscScalar[],const PetscInt[],const PetscInt[],const PetscScalar[],const PetscScalar[],const PetscScalar[],PetscReal,const PetscReal[],const PetscReal[],PetscInt,const PetscScalar[],PetscScalar[]),PetscScalar * integral,void * user)2317 PetscErrorCode DMPlexComputeBdIntegral(DM dm, Vec X, DMLabel label, PetscInt numVals, const PetscInt vals[],
2318 void (*func)(PetscInt, PetscInt, PetscInt,
2319 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
2320 const PetscInt[], const PetscInt[], const PetscScalar[], const PetscScalar[], const PetscScalar[],
2321 PetscReal, const PetscReal[], const PetscReal[], PetscInt, const PetscScalar[], PetscScalar[]),
2322 PetscScalar *integral, void *user)
2323 {
2324 Vec locX;
2325 PetscSection section;
2326 DMLabel depthLabel;
2327 IS facetIS;
2328 PetscInt dim, Nf, f, v;
2329 PetscErrorCode ierr;
2330
2331 PetscFunctionBegin;
2332 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
2333 PetscValidHeaderSpecific(X, VEC_CLASSID, 2);
2334 PetscValidPointer(label, 3);
2335 if (vals) PetscValidPointer(vals, 5);
2336 PetscValidPointer(integral, 6);
2337 ierr = PetscLogEventBegin(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
2338 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
2339 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
2340 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr);
2341 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
2342 ierr = PetscSectionGetNumFields(section, &Nf);CHKERRQ(ierr);
2343 /* Get local solution with boundary values */
2344 ierr = DMGetLocalVector(dm, &locX);CHKERRQ(ierr);
2345 ierr = DMPlexInsertBoundaryValues(dm, PETSC_TRUE, locX, 0.0, NULL, NULL, NULL);CHKERRQ(ierr);
2346 ierr = DMGlobalToLocalBegin(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
2347 ierr = DMGlobalToLocalEnd(dm, X, INSERT_VALUES, locX);CHKERRQ(ierr);
2348 /* Loop over label values */
2349 ierr = PetscArrayzero(integral, Nf);CHKERRQ(ierr);
2350 for (v = 0; v < numVals; ++v) {
2351 IS pointIS;
2352 PetscInt numFaces, face;
2353 PetscScalar *fintegral;
2354
2355 ierr = DMLabelGetStratumIS(label, vals[v], &pointIS);CHKERRQ(ierr);
2356 if (!pointIS) continue; /* No points with that id on this process */
2357 {
2358 IS isectIS;
2359
2360 /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */
2361 ierr = ISIntersect_Caching_Internal(facetIS, pointIS, &isectIS);CHKERRQ(ierr);
2362 ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2363 pointIS = isectIS;
2364 }
2365 ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr);
2366 ierr = PetscCalloc1(numFaces*Nf, &fintegral);CHKERRQ(ierr);
2367 ierr = DMPlexComputeBdIntegral_Internal(dm, locX, pointIS, func, fintegral, user);CHKERRQ(ierr);
2368 /* Sum point contributions into integral */
2369 for (f = 0; f < Nf; ++f) for (face = 0; face < numFaces; ++face) integral[f] += fintegral[face*Nf+f];
2370 ierr = PetscFree(fintegral);CHKERRQ(ierr);
2371 ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
2372 }
2373 ierr = DMRestoreLocalVector(dm, &locX);CHKERRQ(ierr);
2374 ierr = ISDestroy(&facetIS);CHKERRQ(ierr);
2375 ierr = PetscLogEventEnd(DMPLEX_IntegralFEM,dm,0,0,0);CHKERRQ(ierr);
2376 PetscFunctionReturn(0);
2377 }
2378
2379 /*@
2380 DMPlexComputeInterpolatorNested - Form the local portion of the interpolation matrix I from the coarse DM to a uniformly refined DM.
2381
2382 Input Parameters:
2383 + dmc - The coarse mesh
2384 . dmf - The fine mesh
2385 . isRefined - Flag indicating regular refinement, rather than the same topology
2386 - user - The user context
2387
2388 Output Parameter:
2389 . In - The interpolation matrix
2390
2391 Level: developer
2392
2393 .seealso: DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM()
2394 @*/
DMPlexComputeInterpolatorNested(DM dmc,DM dmf,PetscBool isRefined,Mat In,void * user)2395 PetscErrorCode DMPlexComputeInterpolatorNested(DM dmc, DM dmf, PetscBool isRefined, Mat In, void *user)
2396 {
2397 DM_Plex *mesh = (DM_Plex *) dmc->data;
2398 const char *name = "Interpolator";
2399 PetscDS cds, rds;
2400 PetscFE *feRef;
2401 PetscFV *fvRef;
2402 PetscSection fsection, fglobalSection;
2403 PetscSection csection, cglobalSection;
2404 PetscScalar *elemMat;
2405 PetscInt dim, Nf, f, fieldI, fieldJ, offsetI, offsetJ, cStart, cEnd, c;
2406 PetscInt cTotDim, rTotDim = 0;
2407 PetscErrorCode ierr;
2408
2409 PetscFunctionBegin;
2410 ierr = PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
2411 ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr);
2412 ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);
2413 ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr);
2414 ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);
2415 ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr);
2416 ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr);
2417 ierr = DMPlexGetSimplexOrBoxCells(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr);
2418 ierr = DMGetDS(dmc, &cds);CHKERRQ(ierr);
2419 ierr = DMGetDS(dmf, &rds);CHKERRQ(ierr);
2420 ierr = PetscCalloc2(Nf, &feRef, Nf, &fvRef);CHKERRQ(ierr);
2421 for (f = 0; f < Nf; ++f) {
2422 PetscObject obj;
2423 PetscClassId id;
2424 PetscInt rNb = 0, Nc = 0;
2425
2426 ierr = PetscDSGetDiscretization(rds, f, &obj);CHKERRQ(ierr);
2427 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2428 if (id == PETSCFE_CLASSID) {
2429 PetscFE fe = (PetscFE) obj;
2430
2431 if (isRefined) {
2432 ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr);
2433 } else {
2434 ierr = PetscObjectReference((PetscObject) fe);CHKERRQ(ierr);
2435 feRef[f] = fe;
2436 }
2437 ierr = PetscFEGetDimension(feRef[f], &rNb);CHKERRQ(ierr);
2438 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
2439 } else if (id == PETSCFV_CLASSID) {
2440 PetscFV fv = (PetscFV) obj;
2441 PetscDualSpace Q;
2442
2443 if (isRefined) {
2444 ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr);
2445 } else {
2446 ierr = PetscObjectReference((PetscObject) fv);CHKERRQ(ierr);
2447 fvRef[f] = fv;
2448 }
2449 ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr);
2450 ierr = PetscDualSpaceGetDimension(Q, &rNb);CHKERRQ(ierr);
2451 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
2452 }
2453 rTotDim += rNb;
2454 }
2455 ierr = PetscDSGetTotalDimension(cds, &cTotDim);CHKERRQ(ierr);
2456 ierr = PetscMalloc1(rTotDim*cTotDim,&elemMat);CHKERRQ(ierr);
2457 ierr = PetscArrayzero(elemMat, rTotDim*cTotDim);CHKERRQ(ierr);
2458 for (fieldI = 0, offsetI = 0; fieldI < Nf; ++fieldI) {
2459 PetscDualSpace Qref;
2460 PetscQuadrature f;
2461 const PetscReal *qpoints, *qweights;
2462 PetscReal *points;
2463 PetscInt npoints = 0, Nc, Np, fpdim, i, k, p, d;
2464
2465 /* Compose points from all dual basis functionals */
2466 if (feRef[fieldI]) {
2467 ierr = PetscFEGetDualSpace(feRef[fieldI], &Qref);CHKERRQ(ierr);
2468 ierr = PetscFEGetNumComponents(feRef[fieldI], &Nc);CHKERRQ(ierr);
2469 } else {
2470 ierr = PetscFVGetDualSpace(fvRef[fieldI], &Qref);CHKERRQ(ierr);
2471 ierr = PetscFVGetNumComponents(fvRef[fieldI], &Nc);CHKERRQ(ierr);
2472 }
2473 ierr = PetscDualSpaceGetDimension(Qref, &fpdim);CHKERRQ(ierr);
2474 for (i = 0; i < fpdim; ++i) {
2475 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr);
2476 ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, NULL, NULL);CHKERRQ(ierr);
2477 npoints += Np;
2478 }
2479 ierr = PetscMalloc1(npoints*dim,&points);CHKERRQ(ierr);
2480 for (i = 0, k = 0; i < fpdim; ++i) {
2481 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr);
2482 ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);CHKERRQ(ierr);
2483 for (p = 0; p < Np; ++p, ++k) for (d = 0; d < dim; ++d) points[k*dim+d] = qpoints[p*dim+d];
2484 }
2485
2486 for (fieldJ = 0, offsetJ = 0; fieldJ < Nf; ++fieldJ) {
2487 PetscObject obj;
2488 PetscClassId id;
2489 PetscInt NcJ = 0, cpdim = 0, j, qNc;
2490
2491 ierr = PetscDSGetDiscretization(cds, fieldJ, &obj);CHKERRQ(ierr);
2492 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2493 if (id == PETSCFE_CLASSID) {
2494 PetscFE fe = (PetscFE) obj;
2495 PetscTabulation T = NULL;
2496
2497 /* Evaluate basis at points */
2498 ierr = PetscFEGetNumComponents(fe, &NcJ);CHKERRQ(ierr);
2499 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr);
2500 /* For now, fields only interpolate themselves */
2501 if (fieldI == fieldJ) {
2502 if (Nc != NcJ) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in fine space field %D does not match coarse field %D", Nc, NcJ);
2503 ierr = PetscFECreateTabulation(fe, 1, npoints, points, 0, &T);CHKERRQ(ierr);
2504 for (i = 0, k = 0; i < fpdim; ++i) {
2505 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr);
2506 ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);CHKERRQ(ierr);
2507 if (qNc != NcJ) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in quadrature %D does not match coarse field %D", qNc, NcJ);
2508 for (p = 0; p < Np; ++p, ++k) {
2509 for (j = 0; j < cpdim; ++j) {
2510 /*
2511 cTotDim: Total columns in element interpolation matrix, sum of number of dual basis functionals in each field
2512 offsetI, offsetJ: Offsets into the larger element interpolation matrix for different fields
2513 fpdim, i, cpdim, j: Dofs for fine and coarse grids, correspond to dual space basis functionals
2514 qNC, Nc, Ncj, c: Number of components in this field
2515 Np, p: Number of quad points in the fine grid functional i
2516 k: i*Np + p, overall point number for the interpolation
2517 */
2518 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += T->T[0][k*cpdim*NcJ+j*Nc+c]*qweights[p*qNc+c];
2519 }
2520 }
2521 }
2522 ierr = PetscTabulationDestroy(&T);CHKERRQ(ierr);CHKERRQ(ierr);
2523 }
2524 } else if (id == PETSCFV_CLASSID) {
2525 PetscFV fv = (PetscFV) obj;
2526
2527 /* Evaluate constant function at points */
2528 ierr = PetscFVGetNumComponents(fv, &NcJ);CHKERRQ(ierr);
2529 cpdim = 1;
2530 /* For now, fields only interpolate themselves */
2531 if (fieldI == fieldJ) {
2532 if (Nc != NcJ) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in fine space field %D does not match coarse field %D", Nc, NcJ);
2533 for (i = 0, k = 0; i < fpdim; ++i) {
2534 ierr = PetscDualSpaceGetFunctional(Qref, i, &f);CHKERRQ(ierr);
2535 ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, NULL, &qweights);CHKERRQ(ierr);
2536 if (qNc != NcJ) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in quadrature %D does not match coarse field %D", qNc, NcJ);
2537 for (p = 0; p < Np; ++p, ++k) {
2538 for (j = 0; j < cpdim; ++j) {
2539 for (c = 0; c < Nc; ++c) elemMat[(offsetI + i)*cTotDim + offsetJ + j] += 1.0*qweights[p*qNc+c];
2540 }
2541 }
2542 }
2543 }
2544 }
2545 offsetJ += cpdim;
2546 }
2547 offsetI += fpdim;
2548 ierr = PetscFree(points);CHKERRQ(ierr);
2549 }
2550 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(0, name, rTotDim, cTotDim, elemMat);CHKERRQ(ierr);}
2551 /* Preallocate matrix */
2552 {
2553 Mat preallocator;
2554 PetscScalar *vals;
2555 PetscInt *cellCIndices, *cellFIndices;
2556 PetscInt locRows, locCols, cell;
2557
2558 ierr = MatGetLocalSize(In, &locRows, &locCols);CHKERRQ(ierr);
2559 ierr = MatCreate(PetscObjectComm((PetscObject) In), &preallocator);CHKERRQ(ierr);
2560 ierr = MatSetType(preallocator, MATPREALLOCATOR);CHKERRQ(ierr);
2561 ierr = MatSetSizes(preallocator, locRows, locCols, PETSC_DETERMINE, PETSC_DETERMINE);CHKERRQ(ierr);
2562 ierr = MatSetUp(preallocator);CHKERRQ(ierr);
2563 ierr = PetscCalloc3(rTotDim*cTotDim, &vals,cTotDim,&cellCIndices,rTotDim,&cellFIndices);CHKERRQ(ierr);
2564 for (cell = cStart; cell < cEnd; ++cell) {
2565 if (isRefined) {
2566 ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, cell, cellCIndices, cellFIndices);CHKERRQ(ierr);
2567 ierr = MatSetValues(preallocator, rTotDim, cellFIndices, cTotDim, cellCIndices, vals, INSERT_VALUES);CHKERRQ(ierr);
2568 } else {
2569 ierr = DMPlexMatSetClosureGeneral(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, preallocator, cell, vals, INSERT_VALUES);CHKERRQ(ierr);
2570 }
2571 }
2572 ierr = PetscFree3(vals,cellCIndices,cellFIndices);CHKERRQ(ierr);
2573 ierr = MatAssemblyBegin(preallocator, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2574 ierr = MatAssemblyEnd(preallocator, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2575 ierr = MatPreallocatorPreallocate(preallocator, PETSC_TRUE, In);CHKERRQ(ierr);
2576 ierr = MatDestroy(&preallocator);CHKERRQ(ierr);
2577 }
2578 /* Fill matrix */
2579 ierr = MatZeroEntries(In);CHKERRQ(ierr);
2580 for (c = cStart; c < cEnd; ++c) {
2581 if (isRefined) {
2582 ierr = DMPlexMatSetClosureRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES);CHKERRQ(ierr);
2583 } else {
2584 ierr = DMPlexMatSetClosureGeneral(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, In, c, elemMat, INSERT_VALUES);CHKERRQ(ierr);
2585 }
2586 }
2587 for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);}
2588 ierr = PetscFree2(feRef,fvRef);CHKERRQ(ierr);
2589 ierr = PetscFree(elemMat);CHKERRQ(ierr);
2590 ierr = MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2591 ierr = MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2592 if (mesh->printFEM) {
2593 ierr = PetscPrintf(PetscObjectComm((PetscObject)In), "%s:\n", name);CHKERRQ(ierr);
2594 ierr = MatChop(In, 1.0e-10);CHKERRQ(ierr);
2595 ierr = MatView(In, NULL);CHKERRQ(ierr);
2596 }
2597 ierr = PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
2598 PetscFunctionReturn(0);
2599 }
2600
DMPlexComputeMassMatrixNested(DM dmc,DM dmf,Mat mass,void * user)2601 PetscErrorCode DMPlexComputeMassMatrixNested(DM dmc, DM dmf, Mat mass, void *user)
2602 {
2603 SETERRQ(PetscObjectComm((PetscObject) dmc), PETSC_ERR_SUP, "Laziness");
2604 }
2605
2606 /*@
2607 DMPlexComputeInterpolatorGeneral - Form the local portion of the interpolation matrix I from the coarse DM to a non-nested fine DM.
2608
2609 Input Parameters:
2610 + dmf - The fine mesh
2611 . dmc - The coarse mesh
2612 - user - The user context
2613
2614 Output Parameter:
2615 . In - The interpolation matrix
2616
2617 Level: developer
2618
2619 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM()
2620 @*/
DMPlexComputeInterpolatorGeneral(DM dmc,DM dmf,Mat In,void * user)2621 PetscErrorCode DMPlexComputeInterpolatorGeneral(DM dmc, DM dmf, Mat In, void *user)
2622 {
2623 DM_Plex *mesh = (DM_Plex *) dmf->data;
2624 const char *name = "Interpolator";
2625 PetscDS prob;
2626 PetscSection fsection, csection, globalFSection, globalCSection;
2627 PetscHSetIJ ht;
2628 PetscLayout rLayout;
2629 PetscInt *dnz, *onz;
2630 PetscInt locRows, rStart, rEnd;
2631 PetscReal *x, *v0, *J, *invJ, detJ;
2632 PetscReal *v0c, *Jc, *invJc, detJc;
2633 PetscScalar *elemMat;
2634 PetscInt dim, Nf, field, totDim, cStart, cEnd, cell, ccell;
2635 PetscErrorCode ierr;
2636
2637 PetscFunctionBegin;
2638 ierr = PetscLogEventBegin(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
2639 ierr = DMGetCoordinateDim(dmc, &dim);CHKERRQ(ierr);
2640 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr);
2641 ierr = PetscDSGetWorkspace(prob, &x, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
2642 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
2643 ierr = PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);CHKERRQ(ierr);
2644 ierr = PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);CHKERRQ(ierr);
2645 ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);
2646 ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);
2647 ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);
2648 ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);
2649 ierr = DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);CHKERRQ(ierr);
2650 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
2651 ierr = PetscMalloc1(totDim, &elemMat);CHKERRQ(ierr);
2652
2653 ierr = MatGetLocalSize(In, &locRows, NULL);CHKERRQ(ierr);
2654 ierr = PetscLayoutCreate(PetscObjectComm((PetscObject) In), &rLayout);CHKERRQ(ierr);
2655 ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr);
2656 ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr);
2657 ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr);
2658 ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr);
2659 ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr);
2660 ierr = PetscCalloc2(locRows,&dnz,locRows,&onz);CHKERRQ(ierr);
2661 ierr = PetscHSetIJCreate(&ht);CHKERRQ(ierr);
2662 for (field = 0; field < Nf; ++field) {
2663 PetscObject obj;
2664 PetscClassId id;
2665 PetscDualSpace Q = NULL;
2666 PetscQuadrature f;
2667 const PetscReal *qpoints;
2668 PetscInt Nc, Np, fpdim, i, d;
2669
2670 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
2671 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2672 if (id == PETSCFE_CLASSID) {
2673 PetscFE fe = (PetscFE) obj;
2674
2675 ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr);
2676 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
2677 } else if (id == PETSCFV_CLASSID) {
2678 PetscFV fv = (PetscFV) obj;
2679
2680 ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr);
2681 Nc = 1;
2682 }
2683 ierr = PetscDualSpaceGetDimension(Q, &fpdim);CHKERRQ(ierr);
2684 /* For each fine grid cell */
2685 for (cell = cStart; cell < cEnd; ++cell) {
2686 PetscInt *findices, *cindices;
2687 PetscInt numFIndices, numCIndices;
2688
2689 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
2690 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
2691 if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %D != %D dual basis vecs", numFIndices, fpdim);
2692 for (i = 0; i < fpdim; ++i) {
2693 Vec pointVec;
2694 PetscScalar *pV;
2695 PetscSF coarseCellSF = NULL;
2696 const PetscSFNode *coarseCells;
2697 PetscInt numCoarseCells, q, c;
2698
2699 /* Get points from the dual basis functional quadrature */
2700 ierr = PetscDualSpaceGetFunctional(Q, i, &f);CHKERRQ(ierr);
2701 ierr = PetscQuadratureGetData(f, NULL, NULL, &Np, &qpoints, NULL);CHKERRQ(ierr);
2702 ierr = VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);CHKERRQ(ierr);
2703 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr);
2704 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2705 for (q = 0; q < Np; ++q) {
2706 const PetscReal xi0[3] = {-1., -1., -1.};
2707
2708 /* Transform point to real space */
2709 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2710 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2711 }
2712 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2713 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2714 /* OPT: Pack all quad points from fine cell */
2715 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr);
2716 ierr = PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");CHKERRQ(ierr);
2717 /* Update preallocation info */
2718 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr);
2719 if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2720 {
2721 PetscHashIJKey key;
2722 PetscBool missing;
2723
2724 key.i = findices[i];
2725 if (key.i >= 0) {
2726 /* Get indices for coarse elements */
2727 for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2728 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
2729 for (c = 0; c < numCIndices; ++c) {
2730 key.j = cindices[c];
2731 if (key.j < 0) continue;
2732 ierr = PetscHSetIJQueryAdd(ht, key, &missing);CHKERRQ(ierr);
2733 if (missing) {
2734 if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart];
2735 else ++onz[key.i-rStart];
2736 }
2737 }
2738 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
2739 }
2740 }
2741 }
2742 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr);
2743 ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
2744 }
2745 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
2746 }
2747 }
2748 ierr = PetscHSetIJDestroy(&ht);CHKERRQ(ierr);
2749 ierr = MatXAIJSetPreallocation(In, 1, dnz, onz, NULL, NULL);CHKERRQ(ierr);
2750 ierr = MatSetOption(In, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2751 ierr = PetscFree2(dnz,onz);CHKERRQ(ierr);
2752 for (field = 0; field < Nf; ++field) {
2753 PetscObject obj;
2754 PetscClassId id;
2755 PetscDualSpace Q = NULL;
2756 PetscTabulation T = NULL;
2757 PetscQuadrature f;
2758 const PetscReal *qpoints, *qweights;
2759 PetscInt Nc, qNc, Np, fpdim, i, d;
2760
2761 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
2762 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2763 if (id == PETSCFE_CLASSID) {
2764 PetscFE fe = (PetscFE) obj;
2765
2766 ierr = PetscFEGetDualSpace(fe, &Q);CHKERRQ(ierr);
2767 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
2768 ierr = PetscFECreateTabulation(fe, 1, 1, x, 0, &T);CHKERRQ(ierr);
2769 } else if (id == PETSCFV_CLASSID) {
2770 PetscFV fv = (PetscFV) obj;
2771
2772 ierr = PetscFVGetDualSpace(fv, &Q);CHKERRQ(ierr);
2773 Nc = 1;
2774 } else SETERRQ1(PetscObjectComm((PetscObject)dmc),PETSC_ERR_ARG_WRONG,"Unknown discretization type for field %D",field);
2775 ierr = PetscDualSpaceGetDimension(Q, &fpdim);CHKERRQ(ierr);
2776 /* For each fine grid cell */
2777 for (cell = cStart; cell < cEnd; ++cell) {
2778 PetscInt *findices, *cindices;
2779 PetscInt numFIndices, numCIndices;
2780
2781 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
2782 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
2783 if (numFIndices != fpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of fine indices %D != %D dual basis vecs", numFIndices, fpdim);
2784 for (i = 0; i < fpdim; ++i) {
2785 Vec pointVec;
2786 PetscScalar *pV;
2787 PetscSF coarseCellSF = NULL;
2788 const PetscSFNode *coarseCells;
2789 PetscInt numCoarseCells, cpdim, q, c, j;
2790
2791 /* Get points from the dual basis functional quadrature */
2792 ierr = PetscDualSpaceGetFunctional(Q, i, &f);CHKERRQ(ierr);
2793 ierr = PetscQuadratureGetData(f, NULL, &qNc, &Np, &qpoints, &qweights);CHKERRQ(ierr);
2794 if (qNc != Nc) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in quadrature %D does not match coarse field %D", qNc, Nc);
2795 ierr = VecCreateSeq(PETSC_COMM_SELF, Np*dim, &pointVec);CHKERRQ(ierr);
2796 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr);
2797 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2798 for (q = 0; q < Np; ++q) {
2799 const PetscReal xi0[3] = {-1., -1., -1.};
2800
2801 /* Transform point to real space */
2802 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2803 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2804 }
2805 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2806 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2807 /* OPT: Read this out from preallocation information */
2808 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr);
2809 /* Update preallocation info */
2810 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr);
2811 if (numCoarseCells != Np) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2812 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2813 for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2814 PetscReal pVReal[3];
2815 const PetscReal xi0[3] = {-1., -1., -1.};
2816
2817 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
2818 /* Transform points from real space to coarse reference space */
2819 ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr);
2820 for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]);
2821 CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x);
2822
2823 if (id == PETSCFE_CLASSID) {
2824 PetscFE fe = (PetscFE) obj;
2825
2826 /* Evaluate coarse basis on contained point */
2827 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr);
2828 ierr = PetscFEComputeTabulation(fe, 1, x, 0, T);CHKERRQ(ierr);
2829 ierr = PetscArrayzero(elemMat, cpdim);CHKERRQ(ierr);
2830 /* Get elemMat entries by multiplying by weight */
2831 for (j = 0; j < cpdim; ++j) {
2832 for (c = 0; c < Nc; ++c) elemMat[j] += T->T[0][j*Nc + c]*qweights[ccell*qNc + c];
2833 }
2834 } else {
2835 cpdim = 1;
2836 for (j = 0; j < cpdim; ++j) {
2837 for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*qweights[ccell*qNc + c];
2838 }
2839 }
2840 /* Update interpolator */
2841 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);}
2842 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
2843 ierr = MatSetValues(In, 1, &findices[i], numCIndices, cindices, elemMat, INSERT_VALUES);CHKERRQ(ierr);
2844 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
2845 }
2846 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2847 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr);
2848 ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
2849 }
2850 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
2851 }
2852 if (id == PETSCFE_CLASSID) {ierr = PetscTabulationDestroy(&T);CHKERRQ(ierr);}
2853 }
2854 ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr);
2855 ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr);
2856 ierr = PetscFree(elemMat);CHKERRQ(ierr);
2857 ierr = MatAssemblyBegin(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2858 ierr = MatAssemblyEnd(In, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2859 ierr = PetscLogEventEnd(DMPLEX_InterpolatorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
2860 PetscFunctionReturn(0);
2861 }
2862
2863 /*@
2864 DMPlexComputeMassMatrixGeneral - Form the local portion of the mass matrix M from the coarse DM to a non-nested fine DM.
2865
2866 Input Parameters:
2867 + dmf - The fine mesh
2868 . dmc - The coarse mesh
2869 - user - The user context
2870
2871 Output Parameter:
2872 . mass - The mass matrix
2873
2874 Level: developer
2875
2876 .seealso: DMPlexComputeMassMatrixNested(), DMPlexComputeInterpolatorNested(), DMPlexComputeInterpolatorGeneral(), DMPlexComputeJacobianFEM()
2877 @*/
DMPlexComputeMassMatrixGeneral(DM dmc,DM dmf,Mat mass,void * user)2878 PetscErrorCode DMPlexComputeMassMatrixGeneral(DM dmc, DM dmf, Mat mass, void *user)
2879 {
2880 DM_Plex *mesh = (DM_Plex *) dmf->data;
2881 const char *name = "Mass Matrix";
2882 PetscDS prob;
2883 PetscSection fsection, csection, globalFSection, globalCSection;
2884 PetscHSetIJ ht;
2885 PetscLayout rLayout;
2886 PetscInt *dnz, *onz;
2887 PetscInt locRows, rStart, rEnd;
2888 PetscReal *x, *v0, *J, *invJ, detJ;
2889 PetscReal *v0c, *Jc, *invJc, detJc;
2890 PetscScalar *elemMat;
2891 PetscInt dim, Nf, field, totDim, cStart, cEnd, cell, ccell;
2892 PetscErrorCode ierr;
2893
2894 PetscFunctionBegin;
2895 ierr = DMGetCoordinateDim(dmc, &dim);CHKERRQ(ierr);
2896 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr);
2897 ierr = PetscDSGetWorkspace(prob, &x, NULL, NULL, NULL, NULL);CHKERRQ(ierr);
2898 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
2899 ierr = PetscMalloc3(dim,&v0,dim*dim,&J,dim*dim,&invJ);CHKERRQ(ierr);
2900 ierr = PetscMalloc3(dim,&v0c,dim*dim,&Jc,dim*dim,&invJc);CHKERRQ(ierr);
2901 ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);
2902 ierr = DMGetGlobalSection(dmf, &globalFSection);CHKERRQ(ierr);
2903 ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);
2904 ierr = DMGetGlobalSection(dmc, &globalCSection);CHKERRQ(ierr);
2905 ierr = DMPlexGetHeightStratum(dmf, 0, &cStart, &cEnd);CHKERRQ(ierr);
2906 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
2907 ierr = PetscMalloc1(totDim, &elemMat);CHKERRQ(ierr);
2908
2909 ierr = MatGetLocalSize(mass, &locRows, NULL);CHKERRQ(ierr);
2910 ierr = PetscLayoutCreate(PetscObjectComm((PetscObject) mass), &rLayout);CHKERRQ(ierr);
2911 ierr = PetscLayoutSetLocalSize(rLayout, locRows);CHKERRQ(ierr);
2912 ierr = PetscLayoutSetBlockSize(rLayout, 1);CHKERRQ(ierr);
2913 ierr = PetscLayoutSetUp(rLayout);CHKERRQ(ierr);
2914 ierr = PetscLayoutGetRange(rLayout, &rStart, &rEnd);CHKERRQ(ierr);
2915 ierr = PetscLayoutDestroy(&rLayout);CHKERRQ(ierr);
2916 ierr = PetscCalloc2(locRows,&dnz,locRows,&onz);CHKERRQ(ierr);
2917 ierr = PetscHSetIJCreate(&ht);CHKERRQ(ierr);
2918 for (field = 0; field < Nf; ++field) {
2919 PetscObject obj;
2920 PetscClassId id;
2921 PetscQuadrature quad;
2922 const PetscReal *qpoints;
2923 PetscInt Nq, Nc, i, d;
2924
2925 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
2926 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
2927 if (id == PETSCFE_CLASSID) {ierr = PetscFEGetQuadrature((PetscFE) obj, &quad);CHKERRQ(ierr);}
2928 else {ierr = PetscFVGetQuadrature((PetscFV) obj, &quad);CHKERRQ(ierr);}
2929 ierr = PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, NULL);CHKERRQ(ierr);
2930 /* For each fine grid cell */
2931 for (cell = cStart; cell < cEnd; ++cell) {
2932 Vec pointVec;
2933 PetscScalar *pV;
2934 PetscSF coarseCellSF = NULL;
2935 const PetscSFNode *coarseCells;
2936 PetscInt numCoarseCells, q, c;
2937 PetscInt *findices, *cindices;
2938 PetscInt numFIndices, numCIndices;
2939
2940 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
2941 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
2942 /* Get points from the quadrature */
2943 ierr = VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);CHKERRQ(ierr);
2944 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr);
2945 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
2946 for (q = 0; q < Nq; ++q) {
2947 const PetscReal xi0[3] = {-1., -1., -1.};
2948
2949 /* Transform point to real space */
2950 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
2951 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
2952 }
2953 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
2954 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
2955 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr);
2956 ierr = PetscSFViewFromOptions(coarseCellSF, NULL, "-interp_sf_view");CHKERRQ(ierr);
2957 /* Update preallocation info */
2958 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr);
2959 if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
2960 {
2961 PetscHashIJKey key;
2962 PetscBool missing;
2963
2964 for (i = 0; i < numFIndices; ++i) {
2965 key.i = findices[i];
2966 if (key.i >= 0) {
2967 /* Get indices for coarse elements */
2968 for (ccell = 0; ccell < numCoarseCells; ++ccell) {
2969 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
2970 for (c = 0; c < numCIndices; ++c) {
2971 key.j = cindices[c];
2972 if (key.j < 0) continue;
2973 ierr = PetscHSetIJQueryAdd(ht, key, &missing);CHKERRQ(ierr);
2974 if (missing) {
2975 if ((key.j >= rStart) && (key.j < rEnd)) ++dnz[key.i-rStart];
2976 else ++onz[key.i-rStart];
2977 }
2978 }
2979 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
2980 }
2981 }
2982 }
2983 }
2984 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr);
2985 ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
2986 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
2987 }
2988 }
2989 ierr = PetscHSetIJDestroy(&ht);CHKERRQ(ierr);
2990 ierr = MatXAIJSetPreallocation(mass, 1, dnz, onz, NULL, NULL);CHKERRQ(ierr);
2991 ierr = MatSetOption(mass, MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2992 ierr = PetscFree2(dnz,onz);CHKERRQ(ierr);
2993 for (field = 0; field < Nf; ++field) {
2994 PetscObject obj;
2995 PetscClassId id;
2996 PetscTabulation T, Tfine;
2997 PetscQuadrature quad;
2998 const PetscReal *qpoints, *qweights;
2999 PetscInt Nq, Nc, i, d;
3000
3001 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
3002 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3003 if (id == PETSCFE_CLASSID) {
3004 ierr = PetscFEGetQuadrature((PetscFE) obj, &quad);CHKERRQ(ierr);
3005 ierr = PetscFEGetCellTabulation((PetscFE) obj, &Tfine);CHKERRQ(ierr);
3006 ierr = PetscFECreateTabulation((PetscFE) obj, 1, 1, x, 0, &T);CHKERRQ(ierr);
3007 } else {
3008 ierr = PetscFVGetQuadrature((PetscFV) obj, &quad);CHKERRQ(ierr);
3009 }
3010 ierr = PetscQuadratureGetData(quad, NULL, &Nc, &Nq, &qpoints, &qweights);CHKERRQ(ierr);
3011 /* For each fine grid cell */
3012 for (cell = cStart; cell < cEnd; ++cell) {
3013 Vec pointVec;
3014 PetscScalar *pV;
3015 PetscSF coarseCellSF = NULL;
3016 const PetscSFNode *coarseCells;
3017 PetscInt numCoarseCells, cpdim, q, c, j;
3018 PetscInt *findices, *cindices;
3019 PetscInt numFIndices, numCIndices;
3020
3021 ierr = DMPlexGetClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
3022 ierr = DMPlexComputeCellGeometryFEM(dmf, cell, NULL, v0, J, invJ, &detJ);CHKERRQ(ierr);
3023 /* Get points from the quadrature */
3024 ierr = VecCreateSeq(PETSC_COMM_SELF, Nq*dim, &pointVec);CHKERRQ(ierr);
3025 ierr = VecSetBlockSize(pointVec, dim);CHKERRQ(ierr);
3026 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
3027 for (q = 0; q < Nq; ++q) {
3028 const PetscReal xi0[3] = {-1., -1., -1.};
3029
3030 /* Transform point to real space */
3031 CoordinatesRefToReal(dim, dim, xi0, v0, J, &qpoints[q*dim], x);
3032 for (d = 0; d < dim; ++d) pV[q*dim+d] = x[d];
3033 }
3034 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
3035 /* Get set of coarse cells that overlap points (would like to group points by coarse cell) */
3036 ierr = DMLocatePoints(dmc, pointVec, DM_POINTLOCATION_NEAREST, &coarseCellSF);CHKERRQ(ierr);
3037 /* Update matrix */
3038 ierr = PetscSFGetGraph(coarseCellSF, NULL, &numCoarseCells, NULL, &coarseCells);CHKERRQ(ierr);
3039 if (numCoarseCells != Nq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not all closure points located");
3040 ierr = VecGetArray(pointVec, &pV);CHKERRQ(ierr);
3041 for (ccell = 0; ccell < numCoarseCells; ++ccell) {
3042 PetscReal pVReal[3];
3043 const PetscReal xi0[3] = {-1., -1., -1.};
3044
3045
3046 ierr = DMPlexGetClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
3047 /* Transform points from real space to coarse reference space */
3048 ierr = DMPlexComputeCellGeometryFEM(dmc, coarseCells[ccell].index, NULL, v0c, Jc, invJc, &detJc);CHKERRQ(ierr);
3049 for (d = 0; d < dim; ++d) pVReal[d] = PetscRealPart(pV[ccell*dim+d]);
3050 CoordinatesRealToRef(dim, dim, xi0, v0c, invJc, pVReal, x);
3051
3052 if (id == PETSCFE_CLASSID) {
3053 PetscFE fe = (PetscFE) obj;
3054
3055 /* Evaluate coarse basis on contained point */
3056 ierr = PetscFEGetDimension(fe, &cpdim);CHKERRQ(ierr);
3057 ierr = PetscFEComputeTabulation(fe, 1, x, 0, T);CHKERRQ(ierr);
3058 /* Get elemMat entries by multiplying by weight */
3059 for (i = 0; i < numFIndices; ++i) {
3060 ierr = PetscArrayzero(elemMat, cpdim);CHKERRQ(ierr);
3061 for (j = 0; j < cpdim; ++j) {
3062 for (c = 0; c < Nc; ++c) elemMat[j] += T->T[0][j*Nc + c]*Tfine->T[0][(ccell*numFIndices + i)*Nc + c]*qweights[ccell*Nc + c]*detJ;
3063 }
3064 /* Update interpolator */
3065 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);}
3066 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
3067 ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr);
3068 }
3069 } else {
3070 cpdim = 1;
3071 for (i = 0; i < numFIndices; ++i) {
3072 ierr = PetscArrayzero(elemMat, cpdim);CHKERRQ(ierr);
3073 for (j = 0; j < cpdim; ++j) {
3074 for (c = 0; c < Nc; ++c) elemMat[j] += 1.0*1.0*qweights[ccell*Nc + c]*detJ;
3075 }
3076 /* Update interpolator */
3077 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, 1, numCIndices, elemMat);CHKERRQ(ierr);}
3078 ierr = PetscPrintf(PETSC_COMM_SELF, "Nq: %D %D Nf: %D %D Nc: %D %D\n", ccell, Nq, i, numFIndices, j, numCIndices);CHKERRQ(ierr);
3079 if (numCIndices != cpdim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of element matrix columns %D != %D", numCIndices, cpdim);
3080 ierr = MatSetValues(mass, 1, &findices[i], numCIndices, cindices, elemMat, ADD_VALUES);CHKERRQ(ierr);
3081 }
3082 }
3083 ierr = DMPlexRestoreClosureIndices(dmc, csection, globalCSection, coarseCells[ccell].index, PETSC_FALSE, &numCIndices, &cindices, NULL, NULL);CHKERRQ(ierr);
3084 }
3085 ierr = VecRestoreArray(pointVec, &pV);CHKERRQ(ierr);
3086 ierr = PetscSFDestroy(&coarseCellSF);CHKERRQ(ierr);
3087 ierr = VecDestroy(&pointVec);CHKERRQ(ierr);
3088 ierr = DMPlexRestoreClosureIndices(dmf, fsection, globalFSection, cell, PETSC_FALSE, &numFIndices, &findices, NULL, NULL);CHKERRQ(ierr);
3089 }
3090 if (id == PETSCFE_CLASSID) {ierr = PetscTabulationDestroy(&T);CHKERRQ(ierr);}
3091 }
3092 ierr = PetscFree3(v0,J,invJ);CHKERRQ(ierr);
3093 ierr = PetscFree3(v0c,Jc,invJc);CHKERRQ(ierr);
3094 ierr = PetscFree(elemMat);CHKERRQ(ierr);
3095 ierr = MatAssemblyBegin(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3096 ierr = MatAssemblyEnd(mass, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3097 PetscFunctionReturn(0);
3098 }
3099
3100 /*@
3101 DMPlexComputeInjectorFEM - Compute a mapping from coarse unknowns to fine unknowns
3102
3103 Input Parameters:
3104 + dmc - The coarse mesh
3105 - dmf - The fine mesh
3106 - user - The user context
3107
3108 Output Parameter:
3109 . sc - The mapping
3110
3111 Level: developer
3112
3113 .seealso: DMPlexComputeInterpolatorNested(), DMPlexComputeJacobianFEM()
3114 @*/
DMPlexComputeInjectorFEM(DM dmc,DM dmf,VecScatter * sc,void * user)3115 PetscErrorCode DMPlexComputeInjectorFEM(DM dmc, DM dmf, VecScatter *sc, void *user)
3116 {
3117 PetscDS prob;
3118 PetscFE *feRef;
3119 PetscFV *fvRef;
3120 Vec fv, cv;
3121 IS fis, cis;
3122 PetscSection fsection, fglobalSection, csection, cglobalSection;
3123 PetscInt *cmap, *cellCIndices, *cellFIndices, *cindices, *findices;
3124 PetscInt cTotDim, fTotDim = 0, Nf, f, field, cStart, cEnd, c, dim, d, startC, endC, offsetC, offsetF, m;
3125 PetscBool *needAvg;
3126 PetscErrorCode ierr;
3127
3128 PetscFunctionBegin;
3129 ierr = PetscLogEventBegin(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
3130 ierr = DMGetDimension(dmf, &dim);CHKERRQ(ierr);
3131 ierr = DMGetLocalSection(dmf, &fsection);CHKERRQ(ierr);
3132 ierr = DMGetGlobalSection(dmf, &fglobalSection);CHKERRQ(ierr);
3133 ierr = DMGetLocalSection(dmc, &csection);CHKERRQ(ierr);
3134 ierr = DMGetGlobalSection(dmc, &cglobalSection);CHKERRQ(ierr);
3135 ierr = PetscSectionGetNumFields(fsection, &Nf);CHKERRQ(ierr);
3136 ierr = DMPlexGetSimplexOrBoxCells(dmc, 0, &cStart, &cEnd);CHKERRQ(ierr);
3137 ierr = DMGetDS(dmc, &prob);CHKERRQ(ierr);
3138 ierr = PetscCalloc3(Nf,&feRef,Nf,&fvRef,Nf,&needAvg);CHKERRQ(ierr);
3139 for (f = 0; f < Nf; ++f) {
3140 PetscObject obj;
3141 PetscClassId id;
3142 PetscInt fNb = 0, Nc = 0;
3143
3144 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
3145 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3146 if (id == PETSCFE_CLASSID) {
3147 PetscFE fe = (PetscFE) obj;
3148 PetscSpace sp;
3149 PetscInt maxDegree;
3150
3151 ierr = PetscFERefine(fe, &feRef[f]);CHKERRQ(ierr);
3152 ierr = PetscFEGetDimension(feRef[f], &fNb);CHKERRQ(ierr);
3153 ierr = PetscFEGetNumComponents(fe, &Nc);CHKERRQ(ierr);
3154 ierr = PetscFEGetBasisSpace(fe, &sp);CHKERRQ(ierr);
3155 ierr = PetscSpaceGetDegree(sp, NULL, &maxDegree);CHKERRQ(ierr);
3156 if (!maxDegree) needAvg[f] = PETSC_TRUE;
3157 } else if (id == PETSCFV_CLASSID) {
3158 PetscFV fv = (PetscFV) obj;
3159 PetscDualSpace Q;
3160
3161 ierr = PetscFVRefine(fv, &fvRef[f]);CHKERRQ(ierr);
3162 ierr = PetscFVGetDualSpace(fvRef[f], &Q);CHKERRQ(ierr);
3163 ierr = PetscDualSpaceGetDimension(Q, &fNb);CHKERRQ(ierr);
3164 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
3165 needAvg[f] = PETSC_TRUE;
3166 }
3167 fTotDim += fNb;
3168 }
3169 ierr = PetscDSGetTotalDimension(prob, &cTotDim);CHKERRQ(ierr);
3170 ierr = PetscMalloc1(cTotDim,&cmap);CHKERRQ(ierr);
3171 for (field = 0, offsetC = 0, offsetF = 0; field < Nf; ++field) {
3172 PetscFE feC;
3173 PetscFV fvC;
3174 PetscDualSpace QF, QC;
3175 PetscInt order = -1, NcF, NcC, fpdim, cpdim;
3176
3177 if (feRef[field]) {
3178 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &feC);CHKERRQ(ierr);
3179 ierr = PetscFEGetNumComponents(feC, &NcC);CHKERRQ(ierr);
3180 ierr = PetscFEGetNumComponents(feRef[field], &NcF);CHKERRQ(ierr);
3181 ierr = PetscFEGetDualSpace(feRef[field], &QF);CHKERRQ(ierr);
3182 ierr = PetscDualSpaceGetOrder(QF, &order);CHKERRQ(ierr);
3183 ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr);
3184 ierr = PetscFEGetDualSpace(feC, &QC);CHKERRQ(ierr);
3185 ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr);
3186 } else {
3187 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fvC);CHKERRQ(ierr);
3188 ierr = PetscFVGetNumComponents(fvC, &NcC);CHKERRQ(ierr);
3189 ierr = PetscFVGetNumComponents(fvRef[field], &NcF);CHKERRQ(ierr);
3190 ierr = PetscFVGetDualSpace(fvRef[field], &QF);CHKERRQ(ierr);
3191 ierr = PetscDualSpaceGetDimension(QF, &fpdim);CHKERRQ(ierr);
3192 ierr = PetscFVGetDualSpace(fvC, &QC);CHKERRQ(ierr);
3193 ierr = PetscDualSpaceGetDimension(QC, &cpdim);CHKERRQ(ierr);
3194 }
3195 if (NcF != NcC) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of components in fine space field %D does not match coarse field %D", NcF, NcC);
3196 for (c = 0; c < cpdim; ++c) {
3197 PetscQuadrature cfunc;
3198 const PetscReal *cqpoints, *cqweights;
3199 PetscInt NqcC, NpC;
3200 PetscBool found = PETSC_FALSE;
3201
3202 ierr = PetscDualSpaceGetFunctional(QC, c, &cfunc);CHKERRQ(ierr);
3203 ierr = PetscQuadratureGetData(cfunc, NULL, &NqcC, &NpC, &cqpoints, &cqweights);CHKERRQ(ierr);
3204 if (NqcC != NcC) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components %D", NqcC, NcC);
3205 if (NpC != 1 && feRef[field]) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Do not know how to do injection for moments");
3206 for (f = 0; f < fpdim; ++f) {
3207 PetscQuadrature ffunc;
3208 const PetscReal *fqpoints, *fqweights;
3209 PetscReal sum = 0.0;
3210 PetscInt NqcF, NpF;
3211
3212 ierr = PetscDualSpaceGetFunctional(QF, f, &ffunc);CHKERRQ(ierr);
3213 ierr = PetscQuadratureGetData(ffunc, NULL, &NqcF, &NpF, &fqpoints, &fqweights);CHKERRQ(ierr);
3214 if (NqcF != NcF) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Number of quadrature components %D must match number of field components %D", NqcF, NcF);
3215 if (NpC != NpF) continue;
3216 for (d = 0; d < dim; ++d) sum += PetscAbsReal(cqpoints[d] - fqpoints[d]);
3217 if (sum > 1.0e-9) continue;
3218 for (d = 0; d < NcC; ++d) sum += PetscAbsReal(cqweights[d]*fqweights[d]);
3219 if (sum < 1.0e-9) continue;
3220 cmap[offsetC+c] = offsetF+f;
3221 found = PETSC_TRUE;
3222 break;
3223 }
3224 if (!found) {
3225 /* TODO We really want the average here, but some asshole put VecScatter in the interface */
3226 if (fvRef[field] || (feRef[field] && order == 0)) {
3227 cmap[offsetC+c] = offsetF+0;
3228 } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Could not locate matching functional for injection");
3229 }
3230 }
3231 offsetC += cpdim;
3232 offsetF += fpdim;
3233 }
3234 for (f = 0; f < Nf; ++f) {ierr = PetscFEDestroy(&feRef[f]);CHKERRQ(ierr);ierr = PetscFVDestroy(&fvRef[f]);CHKERRQ(ierr);}
3235 ierr = PetscFree3(feRef,fvRef,needAvg);CHKERRQ(ierr);
3236
3237 ierr = DMGetGlobalVector(dmf, &fv);CHKERRQ(ierr);
3238 ierr = DMGetGlobalVector(dmc, &cv);CHKERRQ(ierr);
3239 ierr = VecGetOwnershipRange(cv, &startC, &endC);CHKERRQ(ierr);
3240 ierr = PetscSectionGetConstrainedStorageSize(cglobalSection, &m);CHKERRQ(ierr);
3241 ierr = PetscMalloc2(cTotDim,&cellCIndices,fTotDim,&cellFIndices);CHKERRQ(ierr);
3242 ierr = PetscMalloc1(m,&cindices);CHKERRQ(ierr);
3243 ierr = PetscMalloc1(m,&findices);CHKERRQ(ierr);
3244 for (d = 0; d < m; ++d) cindices[d] = findices[d] = -1;
3245 for (c = cStart; c < cEnd; ++c) {
3246 ierr = DMPlexMatGetClosureIndicesRefined(dmf, fsection, fglobalSection, dmc, csection, cglobalSection, c, cellCIndices, cellFIndices);CHKERRQ(ierr);
3247 for (d = 0; d < cTotDim; ++d) {
3248 if ((cellCIndices[d] < startC) || (cellCIndices[d] >= endC)) continue;
3249 if ((findices[cellCIndices[d]-startC] >= 0) && (findices[cellCIndices[d]-startC] != cellFIndices[cmap[d]])) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Coarse dof %D maps to both %D and %D", cindices[cellCIndices[d]-startC], findices[cellCIndices[d]-startC], cellFIndices[cmap[d]]);
3250 cindices[cellCIndices[d]-startC] = cellCIndices[d];
3251 findices[cellCIndices[d]-startC] = cellFIndices[cmap[d]];
3252 }
3253 }
3254 ierr = PetscFree(cmap);CHKERRQ(ierr);
3255 ierr = PetscFree2(cellCIndices,cellFIndices);CHKERRQ(ierr);
3256
3257 ierr = ISCreateGeneral(PETSC_COMM_SELF, m, cindices, PETSC_OWN_POINTER, &cis);CHKERRQ(ierr);
3258 ierr = ISCreateGeneral(PETSC_COMM_SELF, m, findices, PETSC_OWN_POINTER, &fis);CHKERRQ(ierr);
3259 ierr = VecScatterCreate(cv, cis, fv, fis, sc);CHKERRQ(ierr);
3260 ierr = ISDestroy(&cis);CHKERRQ(ierr);
3261 ierr = ISDestroy(&fis);CHKERRQ(ierr);
3262 ierr = DMRestoreGlobalVector(dmf, &fv);CHKERRQ(ierr);
3263 ierr = DMRestoreGlobalVector(dmc, &cv);CHKERRQ(ierr);
3264 ierr = PetscLogEventEnd(DMPLEX_InjectorFEM,dmc,dmf,0,0);CHKERRQ(ierr);
3265 PetscFunctionReturn(0);
3266 }
3267
3268 /*@C
3269 DMPlexGetCellFields - Retrieve the field values values for a chunk of cells
3270
3271 Input Parameters:
3272 + dm - The DM
3273 . cellIS - The cells to include
3274 . locX - A local vector with the solution fields
3275 . locX_t - A local vector with solution field time derivatives, or NULL
3276 - locA - A local vector with auxiliary fields, or NULL
3277
3278 Output Parameters:
3279 + u - The field coefficients
3280 . u_t - The fields derivative coefficients
3281 - a - The auxiliary field coefficients
3282
3283 Level: developer
3284
3285 .seealso: DMPlexGetFaceFields()
3286 @*/
DMPlexGetCellFields(DM dm,IS cellIS,Vec locX,Vec locX_t,Vec locA,PetscScalar ** u,PetscScalar ** u_t,PetscScalar ** a)3287 PetscErrorCode DMPlexGetCellFields(DM dm, IS cellIS, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a)
3288 {
3289 DM plex, plexA = NULL;
3290 DMEnclosureType encAux;
3291 PetscSection section, sectionAux;
3292 PetscDS prob;
3293 const PetscInt *cells;
3294 PetscInt cStart, cEnd, numCells, totDim, totDimAux, c;
3295 PetscErrorCode ierr;
3296
3297 PetscFunctionBegin;
3298 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3299 PetscValidHeaderSpecific(locX, VEC_CLASSID, 4);
3300 if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 5);}
3301 if (locA) {PetscValidHeaderSpecific(locA, VEC_CLASSID, 6);}
3302 PetscValidPointer(u, 7);
3303 PetscValidPointer(u_t, 8);
3304 PetscValidPointer(a, 9);
3305 ierr = DMPlexConvertPlex(dm, &plex, PETSC_FALSE);CHKERRQ(ierr);
3306 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
3307 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
3308 ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob);CHKERRQ(ierr);
3309 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
3310 if (locA) {
3311 DM dmAux;
3312 PetscDS probAux;
3313
3314 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
3315 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr);
3316 ierr = DMPlexConvertPlex(dmAux, &plexA, PETSC_FALSE);CHKERRQ(ierr);
3317 ierr = DMGetLocalSection(dmAux, §ionAux);CHKERRQ(ierr);
3318 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
3319 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
3320 }
3321 numCells = cEnd - cStart;
3322 ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u);CHKERRQ(ierr);
3323 if (locX_t) {ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, u_t);CHKERRQ(ierr);} else {*u_t = NULL;}
3324 if (locA) {ierr = DMGetWorkArray(dm, numCells*totDimAux, MPIU_SCALAR, a);CHKERRQ(ierr);} else {*a = NULL;}
3325 for (c = cStart; c < cEnd; ++c) {
3326 const PetscInt cell = cells ? cells[c] : c;
3327 const PetscInt cind = c - cStart;
3328 PetscScalar *x = NULL, *x_t = NULL, *ul = *u, *ul_t = *u_t, *al = *a;
3329 PetscInt i;
3330
3331 ierr = DMPlexVecGetClosure(plex, section, locX, cell, NULL, &x);CHKERRQ(ierr);
3332 for (i = 0; i < totDim; ++i) ul[cind*totDim+i] = x[i];
3333 ierr = DMPlexVecRestoreClosure(plex, section, locX, cell, NULL, &x);CHKERRQ(ierr);
3334 if (locX_t) {
3335 ierr = DMPlexVecGetClosure(plex, section, locX_t, cell, NULL, &x_t);CHKERRQ(ierr);
3336 for (i = 0; i < totDim; ++i) ul_t[cind*totDim+i] = x_t[i];
3337 ierr = DMPlexVecRestoreClosure(plex, section, locX_t, cell, NULL, &x_t);CHKERRQ(ierr);
3338 }
3339 if (locA) {
3340 PetscInt subcell;
3341 ierr = DMGetEnclosurePoint(plexA, dm, encAux, cell, &subcell);CHKERRQ(ierr);
3342 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subcell, NULL, &x);CHKERRQ(ierr);
3343 for (i = 0; i < totDimAux; ++i) al[cind*totDimAux+i] = x[i];
3344 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subcell, NULL, &x);CHKERRQ(ierr);
3345 }
3346 }
3347 ierr = DMDestroy(&plex);CHKERRQ(ierr);
3348 if (locA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);}
3349 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
3350 PetscFunctionReturn(0);
3351 }
3352
3353 /*@C
3354 DMPlexRestoreCellFields - Restore the field values values for a chunk of cells
3355
3356 Input Parameters:
3357 + dm - The DM
3358 . cellIS - The cells to include
3359 . locX - A local vector with the solution fields
3360 . locX_t - A local vector with solution field time derivatives, or NULL
3361 - locA - A local vector with auxiliary fields, or NULL
3362
3363 Output Parameters:
3364 + u - The field coefficients
3365 . u_t - The fields derivative coefficients
3366 - a - The auxiliary field coefficients
3367
3368 Level: developer
3369
3370 .seealso: DMPlexGetFaceFields()
3371 @*/
DMPlexRestoreCellFields(DM dm,IS cellIS,Vec locX,Vec locX_t,Vec locA,PetscScalar ** u,PetscScalar ** u_t,PetscScalar ** a)3372 PetscErrorCode DMPlexRestoreCellFields(DM dm, IS cellIS, Vec locX, Vec locX_t, Vec locA, PetscScalar **u, PetscScalar **u_t, PetscScalar **a)
3373 {
3374 PetscErrorCode ierr;
3375
3376 PetscFunctionBegin;
3377 ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u);CHKERRQ(ierr);
3378 if (locX_t) {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, u_t);CHKERRQ(ierr);}
3379 if (locA) {ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, a);CHKERRQ(ierr);}
3380 PetscFunctionReturn(0);
3381 }
3382
3383 /*@C
3384 DMPlexGetFaceFields - Retrieve the field values values for a chunk of faces
3385
3386 Input Parameters:
3387 + dm - The DM
3388 . fStart - The first face to include
3389 . fEnd - The first face to exclude
3390 . locX - A local vector with the solution fields
3391 . locX_t - A local vector with solution field time derivatives, or NULL
3392 . faceGeometry - A local vector with face geometry
3393 . cellGeometry - A local vector with cell geometry
3394 - locaGrad - A local vector with field gradients, or NULL
3395
3396 Output Parameters:
3397 + Nface - The number of faces with field values
3398 . uL - The field values at the left side of the face
3399 - uR - The field values at the right side of the face
3400
3401 Level: developer
3402
3403 .seealso: DMPlexGetCellFields()
3404 @*/
DMPlexGetFaceFields(DM dm,PetscInt fStart,PetscInt fEnd,Vec locX,Vec locX_t,Vec faceGeometry,Vec cellGeometry,Vec locGrad,PetscInt * Nface,PetscScalar ** uL,PetscScalar ** uR)3405 PetscErrorCode DMPlexGetFaceFields(DM dm, PetscInt fStart, PetscInt fEnd, Vec locX, Vec locX_t, Vec faceGeometry, Vec cellGeometry, Vec locGrad, PetscInt *Nface, PetscScalar **uL, PetscScalar **uR)
3406 {
3407 DM dmFace, dmCell, dmGrad = NULL;
3408 PetscSection section;
3409 PetscDS prob;
3410 DMLabel ghostLabel;
3411 const PetscScalar *facegeom, *cellgeom, *x, *lgrad;
3412 PetscBool *isFE;
3413 PetscInt dim, Nf, f, Nc, numFaces = fEnd - fStart, iface, face;
3414 PetscErrorCode ierr;
3415
3416 PetscFunctionBegin;
3417 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3418 PetscValidHeaderSpecific(locX, VEC_CLASSID, 4);
3419 if (locX_t) {PetscValidHeaderSpecific(locX_t, VEC_CLASSID, 5);}
3420 PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 6);
3421 PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 7);
3422 if (locGrad) {PetscValidHeaderSpecific(locGrad, VEC_CLASSID, 8);}
3423 PetscValidPointer(uL, 9);
3424 PetscValidPointer(uR, 10);
3425 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
3426 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
3427 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
3428 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
3429 ierr = PetscDSGetTotalComponents(prob, &Nc);CHKERRQ(ierr);
3430 ierr = PetscMalloc1(Nf, &isFE);CHKERRQ(ierr);
3431 for (f = 0; f < Nf; ++f) {
3432 PetscObject obj;
3433 PetscClassId id;
3434
3435 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
3436 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3437 if (id == PETSCFE_CLASSID) {isFE[f] = PETSC_TRUE;}
3438 else if (id == PETSCFV_CLASSID) {isFE[f] = PETSC_FALSE;}
3439 else {isFE[f] = PETSC_FALSE;}
3440 }
3441 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
3442 ierr = VecGetArrayRead(locX, &x);CHKERRQ(ierr);
3443 ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
3444 ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
3445 ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
3446 ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
3447 if (locGrad) {
3448 ierr = VecGetDM(locGrad, &dmGrad);CHKERRQ(ierr);
3449 ierr = VecGetArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
3450 }
3451 ierr = DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uL);CHKERRQ(ierr);
3452 ierr = DMGetWorkArray(dm, numFaces*Nc, MPIU_SCALAR, uR);CHKERRQ(ierr);
3453 /* Right now just eat the extra work for FE (could make a cell loop) */
3454 for (face = fStart, iface = 0; face < fEnd; ++face) {
3455 const PetscInt *cells;
3456 PetscFVFaceGeom *fg;
3457 PetscFVCellGeom *cgL, *cgR;
3458 PetscScalar *xL, *xR, *gL, *gR;
3459 PetscScalar *uLl = *uL, *uRl = *uR;
3460 PetscInt ghost, nsupp, nchild;
3461
3462 ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
3463 ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr);
3464 ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr);
3465 if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
3466 ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
3467 ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
3468 ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr);
3469 ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr);
3470 for (f = 0; f < Nf; ++f) {
3471 PetscInt off;
3472
3473 ierr = PetscDSGetComponentOffset(prob, f, &off);CHKERRQ(ierr);
3474 if (isFE[f]) {
3475 const PetscInt *cone;
3476 PetscInt comp, coneSizeL, coneSizeR, faceLocL, faceLocR, ldof, rdof, d;
3477
3478 xL = xR = NULL;
3479 ierr = PetscSectionGetFieldComponents(section, f, &comp);CHKERRQ(ierr);
3480 ierr = DMPlexVecGetClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL);CHKERRQ(ierr);
3481 ierr = DMPlexVecGetClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR);CHKERRQ(ierr);
3482 ierr = DMPlexGetCone(dm, cells[0], &cone);CHKERRQ(ierr);
3483 ierr = DMPlexGetConeSize(dm, cells[0], &coneSizeL);CHKERRQ(ierr);
3484 for (faceLocL = 0; faceLocL < coneSizeL; ++faceLocL) if (cone[faceLocL] == face) break;
3485 ierr = DMPlexGetCone(dm, cells[1], &cone);CHKERRQ(ierr);
3486 ierr = DMPlexGetConeSize(dm, cells[1], &coneSizeR);CHKERRQ(ierr);
3487 for (faceLocR = 0; faceLocR < coneSizeR; ++faceLocR) if (cone[faceLocR] == face) break;
3488 if (faceLocL == coneSizeL && faceLocR == coneSizeR) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Could not find face %D in cone of cell %D or cell %D", face, cells[0], cells[1]);
3489 /* Check that FEM field has values in the right cell (sometimes its an FV ghost cell) */
3490 /* TODO: this is a hack that might not be right for nonconforming */
3491 if (faceLocL < coneSizeL) {
3492 ierr = PetscFEEvaluateFaceFields_Internal(prob, f, faceLocL, xL, &uLl[iface*Nc+off]);CHKERRQ(ierr);
3493 if (rdof == ldof && faceLocR < coneSizeR) {ierr = PetscFEEvaluateFaceFields_Internal(prob, f, faceLocR, xR, &uRl[iface*Nc+off]);CHKERRQ(ierr);}
3494 else {for (d = 0; d < comp; ++d) uRl[iface*Nc+off+d] = uLl[iface*Nc+off+d];}
3495 }
3496 else {
3497 ierr = PetscFEEvaluateFaceFields_Internal(prob, f, faceLocR, xR, &uRl[iface*Nc+off]);CHKERRQ(ierr);
3498 ierr = PetscSectionGetFieldComponents(section, f, &comp);CHKERRQ(ierr);
3499 for (d = 0; d < comp; ++d) uLl[iface*Nc+off+d] = uRl[iface*Nc+off+d];
3500 }
3501 ierr = DMPlexVecRestoreClosure(dm, section, locX, cells[0], &ldof, (PetscScalar **) &xL);CHKERRQ(ierr);
3502 ierr = DMPlexVecRestoreClosure(dm, section, locX, cells[1], &rdof, (PetscScalar **) &xR);CHKERRQ(ierr);
3503 } else {
3504 PetscFV fv;
3505 PetscInt numComp, c;
3506
3507 ierr = PetscDSGetDiscretization(prob, f, (PetscObject *) &fv);CHKERRQ(ierr);
3508 ierr = PetscFVGetNumComponents(fv, &numComp);CHKERRQ(ierr);
3509 ierr = DMPlexPointLocalFieldRead(dm, cells[0], f, x, &xL);CHKERRQ(ierr);
3510 ierr = DMPlexPointLocalFieldRead(dm, cells[1], f, x, &xR);CHKERRQ(ierr);
3511 if (dmGrad) {
3512 PetscReal dxL[3], dxR[3];
3513
3514 ierr = DMPlexPointLocalRead(dmGrad, cells[0], lgrad, &gL);CHKERRQ(ierr);
3515 ierr = DMPlexPointLocalRead(dmGrad, cells[1], lgrad, &gR);CHKERRQ(ierr);
3516 DMPlex_WaxpyD_Internal(dim, -1, cgL->centroid, fg->centroid, dxL);
3517 DMPlex_WaxpyD_Internal(dim, -1, cgR->centroid, fg->centroid, dxR);
3518 for (c = 0; c < numComp; ++c) {
3519 uLl[iface*Nc+off+c] = xL[c] + DMPlex_DotD_Internal(dim, &gL[c*dim], dxL);
3520 uRl[iface*Nc+off+c] = xR[c] + DMPlex_DotD_Internal(dim, &gR[c*dim], dxR);
3521 }
3522 } else {
3523 for (c = 0; c < numComp; ++c) {
3524 uLl[iface*Nc+off+c] = xL[c];
3525 uRl[iface*Nc+off+c] = xR[c];
3526 }
3527 }
3528 }
3529 }
3530 ++iface;
3531 }
3532 *Nface = iface;
3533 ierr = VecRestoreArrayRead(locX, &x);CHKERRQ(ierr);
3534 ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
3535 ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
3536 if (locGrad) {
3537 ierr = VecRestoreArrayRead(locGrad, &lgrad);CHKERRQ(ierr);
3538 }
3539 ierr = PetscFree(isFE);CHKERRQ(ierr);
3540 PetscFunctionReturn(0);
3541 }
3542
3543 /*@C
3544 DMPlexRestoreFaceFields - Restore the field values values for a chunk of faces
3545
3546 Input Parameters:
3547 + dm - The DM
3548 . fStart - The first face to include
3549 . fEnd - The first face to exclude
3550 . locX - A local vector with the solution fields
3551 . locX_t - A local vector with solution field time derivatives, or NULL
3552 . faceGeometry - A local vector with face geometry
3553 . cellGeometry - A local vector with cell geometry
3554 - locaGrad - A local vector with field gradients, or NULL
3555
3556 Output Parameters:
3557 + Nface - The number of faces with field values
3558 . uL - The field values at the left side of the face
3559 - uR - The field values at the right side of the face
3560
3561 Level: developer
3562
3563 .seealso: DMPlexGetFaceFields()
3564 @*/
DMPlexRestoreFaceFields(DM dm,PetscInt fStart,PetscInt fEnd,Vec locX,Vec locX_t,Vec faceGeometry,Vec cellGeometry,Vec locGrad,PetscInt * Nface,PetscScalar ** uL,PetscScalar ** uR)3565 PetscErrorCode DMPlexRestoreFaceFields(DM dm, PetscInt fStart, PetscInt fEnd, Vec locX, Vec locX_t, Vec faceGeometry, Vec cellGeometry, Vec locGrad, PetscInt *Nface, PetscScalar **uL, PetscScalar **uR)
3566 {
3567 PetscErrorCode ierr;
3568
3569 PetscFunctionBegin;
3570 ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uL);CHKERRQ(ierr);
3571 ierr = DMRestoreWorkArray(dm, 0, MPIU_SCALAR, uR);CHKERRQ(ierr);
3572 PetscFunctionReturn(0);
3573 }
3574
3575 /*@C
3576 DMPlexGetFaceGeometry - Retrieve the geometric values for a chunk of faces
3577
3578 Input Parameters:
3579 + dm - The DM
3580 . fStart - The first face to include
3581 . fEnd - The first face to exclude
3582 . faceGeometry - A local vector with face geometry
3583 - cellGeometry - A local vector with cell geometry
3584
3585 Output Parameters:
3586 + Nface - The number of faces with field values
3587 . fgeom - The extract the face centroid and normal
3588 - vol - The cell volume
3589
3590 Level: developer
3591
3592 .seealso: DMPlexGetCellFields()
3593 @*/
DMPlexGetFaceGeometry(DM dm,PetscInt fStart,PetscInt fEnd,Vec faceGeometry,Vec cellGeometry,PetscInt * Nface,PetscFVFaceGeom ** fgeom,PetscReal ** vol)3594 PetscErrorCode DMPlexGetFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscInt *Nface, PetscFVFaceGeom **fgeom, PetscReal **vol)
3595 {
3596 DM dmFace, dmCell;
3597 DMLabel ghostLabel;
3598 const PetscScalar *facegeom, *cellgeom;
3599 PetscInt dim, numFaces = fEnd - fStart, iface, face;
3600 PetscErrorCode ierr;
3601
3602 PetscFunctionBegin;
3603 PetscValidHeaderSpecific(dm, DM_CLASSID, 1);
3604 PetscValidHeaderSpecific(faceGeometry, VEC_CLASSID, 4);
3605 PetscValidHeaderSpecific(cellGeometry, VEC_CLASSID, 5);
3606 PetscValidPointer(fgeom, 6);
3607 PetscValidPointer(vol, 7);
3608 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
3609 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
3610 ierr = VecGetDM(faceGeometry, &dmFace);CHKERRQ(ierr);
3611 ierr = VecGetArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
3612 ierr = VecGetDM(cellGeometry, &dmCell);CHKERRQ(ierr);
3613 ierr = VecGetArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
3614 ierr = PetscMalloc1(numFaces, fgeom);CHKERRQ(ierr);
3615 ierr = DMGetWorkArray(dm, numFaces*2, MPIU_SCALAR, vol);CHKERRQ(ierr);
3616 for (face = fStart, iface = 0; face < fEnd; ++face) {
3617 const PetscInt *cells;
3618 PetscFVFaceGeom *fg;
3619 PetscFVCellGeom *cgL, *cgR;
3620 PetscFVFaceGeom *fgeoml = *fgeom;
3621 PetscReal *voll = *vol;
3622 PetscInt ghost, d, nchild, nsupp;
3623
3624 ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
3625 ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr);
3626 ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr);
3627 if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
3628 ierr = DMPlexPointLocalRead(dmFace, face, facegeom, &fg);CHKERRQ(ierr);
3629 ierr = DMPlexGetSupport(dm, face, &cells);CHKERRQ(ierr);
3630 ierr = DMPlexPointLocalRead(dmCell, cells[0], cellgeom, &cgL);CHKERRQ(ierr);
3631 ierr = DMPlexPointLocalRead(dmCell, cells[1], cellgeom, &cgR);CHKERRQ(ierr);
3632 for (d = 0; d < dim; ++d) {
3633 fgeoml[iface].centroid[d] = fg->centroid[d];
3634 fgeoml[iface].normal[d] = fg->normal[d];
3635 }
3636 voll[iface*2+0] = cgL->volume;
3637 voll[iface*2+1] = cgR->volume;
3638 ++iface;
3639 }
3640 *Nface = iface;
3641 ierr = VecRestoreArrayRead(faceGeometry, &facegeom);CHKERRQ(ierr);
3642 ierr = VecRestoreArrayRead(cellGeometry, &cellgeom);CHKERRQ(ierr);
3643 PetscFunctionReturn(0);
3644 }
3645
3646 /*@C
3647 DMPlexRestoreFaceGeometry - Restore the field values values for a chunk of faces
3648
3649 Input Parameters:
3650 + dm - The DM
3651 . fStart - The first face to include
3652 . fEnd - The first face to exclude
3653 . faceGeometry - A local vector with face geometry
3654 - cellGeometry - A local vector with cell geometry
3655
3656 Output Parameters:
3657 + Nface - The number of faces with field values
3658 . fgeom - The extract the face centroid and normal
3659 - vol - The cell volume
3660
3661 Level: developer
3662
3663 .seealso: DMPlexGetFaceFields()
3664 @*/
DMPlexRestoreFaceGeometry(DM dm,PetscInt fStart,PetscInt fEnd,Vec faceGeometry,Vec cellGeometry,PetscInt * Nface,PetscFVFaceGeom ** fgeom,PetscReal ** vol)3665 PetscErrorCode DMPlexRestoreFaceGeometry(DM dm, PetscInt fStart, PetscInt fEnd, Vec faceGeometry, Vec cellGeometry, PetscInt *Nface, PetscFVFaceGeom **fgeom, PetscReal **vol)
3666 {
3667 PetscErrorCode ierr;
3668
3669 PetscFunctionBegin;
3670 ierr = PetscFree(*fgeom);CHKERRQ(ierr);
3671 ierr = DMRestoreWorkArray(dm, 0, MPIU_REAL, vol);CHKERRQ(ierr);
3672 PetscFunctionReturn(0);
3673 }
3674
DMSNESGetFEGeom(DMField coordField,IS pointIS,PetscQuadrature quad,PetscBool faceData,PetscFEGeom ** geom)3675 PetscErrorCode DMSNESGetFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
3676 {
3677 char composeStr[33] = {0};
3678 PetscObjectId id;
3679 PetscContainer container;
3680 PetscErrorCode ierr;
3681
3682 PetscFunctionBegin;
3683 ierr = PetscObjectGetId((PetscObject)quad,&id);CHKERRQ(ierr);
3684 ierr = PetscSNPrintf(composeStr, 32, "DMSNESGetFEGeom_%x\n", id);CHKERRQ(ierr);
3685 ierr = PetscObjectQuery((PetscObject) pointIS, composeStr, (PetscObject *) &container);CHKERRQ(ierr);
3686 if (container) {
3687 ierr = PetscContainerGetPointer(container, (void **) geom);CHKERRQ(ierr);
3688 } else {
3689 ierr = DMFieldCreateFEGeom(coordField, pointIS, quad, faceData, geom);CHKERRQ(ierr);
3690 ierr = PetscContainerCreate(PETSC_COMM_SELF,&container);CHKERRQ(ierr);
3691 ierr = PetscContainerSetPointer(container, (void *) *geom);CHKERRQ(ierr);
3692 ierr = PetscContainerSetUserDestroy(container, PetscContainerUserDestroy_PetscFEGeom);CHKERRQ(ierr);
3693 ierr = PetscObjectCompose((PetscObject) pointIS, composeStr, (PetscObject) container);CHKERRQ(ierr);
3694 ierr = PetscContainerDestroy(&container);CHKERRQ(ierr);
3695 }
3696 PetscFunctionReturn(0);
3697 }
3698
DMSNESRestoreFEGeom(DMField coordField,IS pointIS,PetscQuadrature quad,PetscBool faceData,PetscFEGeom ** geom)3699 PetscErrorCode DMSNESRestoreFEGeom(DMField coordField, IS pointIS, PetscQuadrature quad, PetscBool faceData, PetscFEGeom **geom)
3700 {
3701 PetscFunctionBegin;
3702 *geom = NULL;
3703 PetscFunctionReturn(0);
3704 }
3705
DMPlexComputeResidual_Patch_Internal(DM dm,PetscSection section,IS cellIS,PetscReal t,Vec locX,Vec locX_t,Vec locF,void * user)3706 PetscErrorCode DMPlexComputeResidual_Patch_Internal(DM dm, PetscSection section, IS cellIS, PetscReal t, Vec locX, Vec locX_t, Vec locF, void *user)
3707 {
3708 DM_Plex *mesh = (DM_Plex *) dm->data;
3709 const char *name = "Residual";
3710 DM dmAux = NULL;
3711 DMLabel ghostLabel = NULL;
3712 PetscDS prob = NULL;
3713 PetscDS probAux = NULL;
3714 PetscBool useFEM = PETSC_FALSE;
3715 PetscBool isImplicit = (locX_t || t == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE;
3716 DMField coordField = NULL;
3717 Vec locA;
3718 PetscScalar *u = NULL, *u_t, *a, *uL = NULL, *uR = NULL;
3719 IS chunkIS;
3720 const PetscInt *cells;
3721 PetscInt cStart, cEnd, numCells;
3722 PetscInt Nf, f, totDim, totDimAux, numChunks, cellChunkSize, chunk, fStart, fEnd;
3723 PetscInt maxDegree = PETSC_MAX_INT;
3724 PetscQuadrature affineQuad = NULL, *quads = NULL;
3725 PetscFEGeom *affineGeom = NULL, **geoms = NULL;
3726 PetscErrorCode ierr;
3727
3728 PetscFunctionBegin;
3729 ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
3730 /* FEM+FVM */
3731 /* 1: Get sizes from dm and dmAux */
3732 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
3733 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
3734 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
3735 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
3736 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr);
3737 if (locA) {
3738 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
3739 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
3740 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
3741 }
3742 /* 2: Get geometric data */
3743 for (f = 0; f < Nf; ++f) {
3744 PetscObject obj;
3745 PetscClassId id;
3746 PetscBool fimp;
3747
3748 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
3749 if (isImplicit != fimp) continue;
3750 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
3751 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3752 if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;}
3753 if (id == PETSCFV_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Use of FVM with PCPATCH not yet implemented");
3754 }
3755 if (useFEM) {
3756 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
3757 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr);
3758 if (maxDegree <= 1) {
3759 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr);
3760 if (affineQuad) {
3761 ierr = DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
3762 }
3763 } else {
3764 ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr);
3765 for (f = 0; f < Nf; ++f) {
3766 PetscObject obj;
3767 PetscClassId id;
3768 PetscBool fimp;
3769
3770 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
3771 if (isImplicit != fimp) continue;
3772 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
3773 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3774 if (id == PETSCFE_CLASSID) {
3775 PetscFE fe = (PetscFE) obj;
3776
3777 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr);
3778 ierr = PetscObjectReference((PetscObject)quads[f]);CHKERRQ(ierr);
3779 ierr = DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);
3780 }
3781 }
3782 }
3783 }
3784 /* Loop over chunks */
3785 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
3786 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
3787 if (useFEM) {ierr = ISCreate(PETSC_COMM_SELF, &chunkIS);CHKERRQ(ierr);}
3788 numCells = cEnd - cStart;
3789 numChunks = 1;
3790 cellChunkSize = numCells/numChunks;
3791 numChunks = PetscMin(1,numCells);
3792 for (chunk = 0; chunk < numChunks; ++chunk) {
3793 PetscScalar *elemVec, *fluxL = NULL, *fluxR = NULL;
3794 PetscReal *vol = NULL;
3795 PetscFVFaceGeom *fgeom = NULL;
3796 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
3797 PetscInt numFaces = 0;
3798
3799 /* Extract field coefficients */
3800 if (useFEM) {
3801 ierr = ISGetPointSubrange(chunkIS, cS, cE, cells);CHKERRQ(ierr);
3802 ierr = DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
3803 ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
3804 ierr = PetscArrayzero(elemVec, numCells*totDim);CHKERRQ(ierr);
3805 }
3806 /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */
3807 /* Loop over fields */
3808 for (f = 0; f < Nf; ++f) {
3809 PetscObject obj;
3810 PetscClassId id;
3811 PetscBool fimp;
3812 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;
3813
3814 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
3815 if (isImplicit != fimp) continue;
3816 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
3817 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3818 if (id == PETSCFE_CLASSID) {
3819 PetscFE fe = (PetscFE) obj;
3820 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[f];
3821 PetscFEGeom *chunkGeom = NULL;
3822 PetscQuadrature quad = affineQuad ? affineQuad : quads[f];
3823 PetscInt Nq, Nb;
3824
3825 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
3826 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
3827 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
3828 blockSize = Nb;
3829 batchSize = numBlocks * blockSize;
3830 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
3831 numChunks = numCells / (numBatches*batchSize);
3832 Ne = numChunks*numBatches*batchSize;
3833 Nr = numCells % (numBatches*batchSize);
3834 offset = numCells - Nr;
3835 /* Integrate FE residual to get elemVec (need fields at quadrature points) */
3836 /* For FV, I think we use a P0 basis and the cell coefficients (for subdivided cells, we can tweak the basis tabulation to be the indicator function) */
3837 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr);
3838 ierr = PetscFEIntegrateResidual(prob, f, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec);CHKERRQ(ierr);
3839 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
3840 ierr = PetscFEIntegrateResidual(prob, f, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]);CHKERRQ(ierr);
3841 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
3842 } else if (id == PETSCFV_CLASSID) {
3843 PetscFV fv = (PetscFV) obj;
3844
3845 Ne = numFaces;
3846 /* Riemann solve over faces (need fields at face centroids) */
3847 /* We need to evaluate FE fields at those coordinates */
3848 ierr = PetscFVIntegrateRHSFunction(fv, prob, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR);CHKERRQ(ierr);
3849 } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
3850 }
3851 /* Loop over domain */
3852 if (useFEM) {
3853 /* Add elemVec to locX */
3854 for (c = cS; c < cE; ++c) {
3855 const PetscInt cell = cells ? cells[c] : c;
3856 const PetscInt cind = c - cStart;
3857
3858 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);}
3859 if (ghostLabel) {
3860 PetscInt ghostVal;
3861
3862 ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr);
3863 if (ghostVal > 0) continue;
3864 }
3865 ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr);
3866 }
3867 }
3868 /* Handle time derivative */
3869 if (locX_t) {
3870 PetscScalar *x_t, *fa;
3871
3872 ierr = VecGetArray(locF, &fa);CHKERRQ(ierr);
3873 ierr = VecGetArray(locX_t, &x_t);CHKERRQ(ierr);
3874 for (f = 0; f < Nf; ++f) {
3875 PetscFV fv;
3876 PetscObject obj;
3877 PetscClassId id;
3878 PetscInt pdim, d;
3879
3880 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
3881 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
3882 if (id != PETSCFV_CLASSID) continue;
3883 fv = (PetscFV) obj;
3884 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
3885 for (c = cS; c < cE; ++c) {
3886 const PetscInt cell = cells ? cells[c] : c;
3887 PetscScalar *u_t, *r;
3888
3889 if (ghostLabel) {
3890 PetscInt ghostVal;
3891
3892 ierr = DMLabelGetValue(ghostLabel, cell, &ghostVal);CHKERRQ(ierr);
3893 if (ghostVal > 0) continue;
3894 }
3895 ierr = DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t);CHKERRQ(ierr);
3896 ierr = DMPlexPointLocalFieldRef(dm, cell, f, fa, &r);CHKERRQ(ierr);
3897 for (d = 0; d < pdim; ++d) r[d] += u_t[d];
3898 }
3899 }
3900 ierr = VecRestoreArray(locX_t, &x_t);CHKERRQ(ierr);
3901 ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr);
3902 }
3903 if (useFEM) {
3904 ierr = DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
3905 ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
3906 }
3907 }
3908 if (useFEM) {ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);}
3909 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
3910 /* TODO Could include boundary residual here (see DMPlexComputeResidual_Internal) */
3911 if (useFEM) {
3912 if (maxDegree <= 1) {
3913 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
3914 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr);
3915 } else {
3916 for (f = 0; f < Nf; ++f) {
3917 ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);
3918 ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);
3919 }
3920 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr);
3921 }
3922 }
3923 ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
3924 PetscFunctionReturn(0);
3925 }
3926
3927 /*
3928 We always assemble JacP, and if the matrix is different from Jac and two different sets of point functions are provided, we also assemble Jac
3929
3930 X - The local solution vector
3931 X_t - The local solution time derviative vector, or NULL
3932 */
DMPlexComputeJacobian_Patch_Internal(DM dm,PetscSection section,PetscSection globalSection,IS cellIS,PetscReal t,PetscReal X_tShift,Vec X,Vec X_t,Mat Jac,Mat JacP,void * ctx)3933 PetscErrorCode DMPlexComputeJacobian_Patch_Internal(DM dm, PetscSection section, PetscSection globalSection, IS cellIS,
3934 PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP, void *ctx)
3935 {
3936 DM_Plex *mesh = (DM_Plex *) dm->data;
3937 const char *name = "Jacobian", *nameP = "JacobianPre";
3938 DM dmAux = NULL;
3939 PetscDS prob, probAux = NULL;
3940 PetscSection sectionAux = NULL;
3941 Vec A;
3942 DMField coordField;
3943 PetscFEGeom *cgeomFEM;
3944 PetscQuadrature qGeom = NULL;
3945 Mat J = Jac, JP = JacP;
3946 PetscScalar *work, *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL, *elemMatP = NULL, *elemMatD = NULL;
3947 PetscBool hasJac, hasPrec, hasDyn, assembleJac, isMatIS, isMatISP, *isFE, hasFV = PETSC_FALSE;
3948 const PetscInt *cells;
3949 PetscInt Nf, fieldI, fieldJ, maxDegree, numCells, cStart, cEnd, numChunks, chunkSize, chunk, totDim, totDimAux = 0, sz, wsz, off = 0, offCell = 0;
3950 PetscErrorCode ierr;
3951
3952 PetscFunctionBegin;
3953 CHKMEMQ;
3954 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr);
3955 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
3956 ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
3957 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
3958 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr);
3959 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr);
3960 if (dmAux) {
3961 ierr = DMGetLocalSection(dmAux, §ionAux);CHKERRQ(ierr);
3962 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
3963 }
3964 /* Get flags */
3965 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
3966 ierr = DMGetWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr);
3967 for (fieldI = 0; fieldI < Nf; ++fieldI) {
3968 PetscObject disc;
3969 PetscClassId id;
3970 ierr = PetscDSGetDiscretization(prob, fieldI, &disc);CHKERRQ(ierr);
3971 ierr = PetscObjectGetClassId(disc, &id);CHKERRQ(ierr);
3972 if (id == PETSCFE_CLASSID) {isFE[fieldI] = PETSC_TRUE;}
3973 else if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; isFE[fieldI] = PETSC_FALSE;}
3974 }
3975 ierr = PetscDSHasJacobian(prob, &hasJac);CHKERRQ(ierr);
3976 ierr = PetscDSHasJacobianPreconditioner(prob, &hasPrec);CHKERRQ(ierr);
3977 ierr = PetscDSHasDynamicJacobian(prob, &hasDyn);CHKERRQ(ierr);
3978 assembleJac = hasJac && hasPrec && (Jac != JacP) ? PETSC_TRUE : PETSC_FALSE;
3979 hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE;
3980 ierr = PetscObjectTypeCompare((PetscObject) Jac, MATIS, &isMatIS);CHKERRQ(ierr);
3981 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr);
3982 /* Setup input data and temp arrays (should be DMGetWorkArray) */
3983 if (isMatISP || isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &globalSection);CHKERRQ(ierr);}
3984 if (isMatIS) {ierr = MatISGetLocalMat(Jac, &J);CHKERRQ(ierr);}
3985 if (isMatISP) {ierr = MatISGetLocalMat(JacP, &JP);CHKERRQ(ierr);}
3986 if (hasFV) {ierr = MatSetOption(JP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE);CHKERRQ(ierr);} /* No allocated space for FV stuff, so ignore the zero entries */
3987 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr);
3988 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr);
3989 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
3990 if (probAux) {ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);}
3991 CHKMEMQ;
3992 /* Compute batch sizes */
3993 if (isFE[0]) {
3994 PetscFE fe;
3995 PetscQuadrature q;
3996 PetscInt numQuadPoints, numBatches, batchSize, numBlocks, blockSize, Nb;
3997
3998 ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr);
3999 ierr = PetscFEGetQuadrature(fe, &q);CHKERRQ(ierr);
4000 ierr = PetscQuadratureGetData(q, NULL, NULL, &numQuadPoints, NULL, NULL);CHKERRQ(ierr);
4001 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
4002 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
4003 blockSize = Nb*numQuadPoints;
4004 batchSize = numBlocks * blockSize;
4005 chunkSize = numBatches * batchSize;
4006 numChunks = numCells / chunkSize + numCells % chunkSize;
4007 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
4008 } else {
4009 chunkSize = numCells;
4010 numChunks = 1;
4011 }
4012 /* Get work space */
4013 wsz = (((X?1:0) + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize;
4014 ierr = DMGetWorkArray(dm, wsz, MPIU_SCALAR, &work);CHKERRQ(ierr);
4015 ierr = PetscArrayzero(work, wsz);CHKERRQ(ierr);
4016 off = 0;
4017 u = X ? (sz = chunkSize*totDim, off += sz, work+off-sz) : NULL;
4018 u_t = X_t ? (sz = chunkSize*totDim, off += sz, work+off-sz) : NULL;
4019 a = dmAux ? (sz = chunkSize*totDimAux, off += sz, work+off-sz) : NULL;
4020 elemMat = hasJac ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
4021 elemMatP = hasPrec ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
4022 elemMatD = hasDyn ? (sz = chunkSize*totDim*totDim, off += sz, work+off-sz) : NULL;
4023 if (off != wsz) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Error is workspace size %D should be %D", off, wsz);
4024 /* Setup geometry */
4025 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
4026 ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr);
4027 if (maxDegree <= 1) {ierr = DMFieldCreateDefaultQuadrature(coordField, cellIS, &qGeom);CHKERRQ(ierr);}
4028 if (!qGeom) {
4029 PetscFE fe;
4030
4031 ierr = PetscDSGetDiscretization(prob, 0, (PetscObject *) &fe);CHKERRQ(ierr);
4032 ierr = PetscFEGetQuadrature(fe, &qGeom);CHKERRQ(ierr);
4033 ierr = PetscObjectReference((PetscObject) qGeom);CHKERRQ(ierr);
4034 }
4035 ierr = DMSNESGetFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr);
4036 /* Compute volume integrals */
4037 if (assembleJac) {ierr = MatZeroEntries(J);CHKERRQ(ierr);}
4038 ierr = MatZeroEntries(JP);CHKERRQ(ierr);
4039 for (chunk = 0; chunk < numChunks; ++chunk, offCell += chunkSize) {
4040 const PetscInt Ncell = PetscMin(chunkSize, numCells - offCell);
4041 PetscInt c;
4042
4043 /* Extract values */
4044 for (c = 0; c < Ncell; ++c) {
4045 const PetscInt cell = cells ? cells[c+offCell] : c+offCell;
4046 PetscScalar *x = NULL, *x_t = NULL;
4047 PetscInt i;
4048
4049 if (X) {
4050 ierr = DMPlexVecGetClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr);
4051 for (i = 0; i < totDim; ++i) u[c*totDim+i] = x[i];
4052 ierr = DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr);
4053 }
4054 if (X_t) {
4055 ierr = DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr);
4056 for (i = 0; i < totDim; ++i) u_t[c*totDim+i] = x_t[i];
4057 ierr = DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr);
4058 }
4059 if (dmAux) {
4060 ierr = DMPlexVecGetClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr);
4061 for (i = 0; i < totDimAux; ++i) a[c*totDimAux+i] = x[i];
4062 ierr = DMPlexVecRestoreClosure(dmAux, sectionAux, A, cell, NULL, &x);CHKERRQ(ierr);
4063 }
4064 }
4065 CHKMEMQ;
4066 for (fieldI = 0; fieldI < Nf; ++fieldI) {
4067 PetscFE fe;
4068 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
4069 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
4070 if (hasJac) {ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);}
4071 if (hasPrec) {ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr);}
4072 if (hasDyn) {ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, fieldI, fieldJ, Ncell, cgeomFEM, u, u_t, probAux, a, t, X_tShift, elemMatD);CHKERRQ(ierr);}
4073 }
4074 /* For finite volume, add the identity */
4075 if (!isFE[fieldI]) {
4076 PetscFV fv;
4077 PetscInt eOffset = 0, Nc, fc, foff;
4078
4079 ierr = PetscDSGetFieldOffset(prob, fieldI, &foff);CHKERRQ(ierr);
4080 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv);CHKERRQ(ierr);
4081 ierr = PetscFVGetNumComponents(fv, &Nc);CHKERRQ(ierr);
4082 for (c = 0; c < chunkSize; ++c, eOffset += totDim*totDim) {
4083 for (fc = 0; fc < Nc; ++fc) {
4084 const PetscInt i = foff + fc;
4085 if (hasJac) {elemMat [eOffset+i*totDim+i] = 1.0;}
4086 if (hasPrec) {elemMatP[eOffset+i*totDim+i] = 1.0;}
4087 }
4088 }
4089 }
4090 }
4091 CHKMEMQ;
4092 /* Add contribution from X_t */
4093 if (hasDyn) {for (c = 0; c < chunkSize*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];}
4094 /* Insert values into matrix */
4095 for (c = 0; c < Ncell; ++c) {
4096 const PetscInt cell = cells ? cells[c+offCell] : c+offCell;
4097 if (mesh->printFEM > 1) {
4098 if (hasJac) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);}
4099 if (hasPrec) {ierr = DMPrintCellMatrix(cell, nameP, totDim, totDim, &elemMatP[(c-cStart)*totDim*totDim]);CHKERRQ(ierr);}
4100 }
4101 if (assembleJac) {ierr = DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);}
4102 ierr = DMPlexMatSetClosure(dm, section, globalSection, JP, cell, &elemMat[(c-cStart)*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
4103 }
4104 CHKMEMQ;
4105 }
4106 /* Cleanup */
4107 ierr = DMSNESRestoreFEGeom(coordField, cellIS, qGeom, PETSC_FALSE, &cgeomFEM);CHKERRQ(ierr);
4108 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr);
4109 if (hasFV) {ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);}
4110 ierr = DMRestoreWorkArray(dm, Nf, MPIU_BOOL, &isFE);CHKERRQ(ierr);
4111 ierr = DMRestoreWorkArray(dm, ((1 + (X_t?1:0) + (dmAux?1:0))*totDim + ((hasJac?1:0) + (hasPrec?1:0) + (hasDyn?1:0))*totDim*totDim)*chunkSize, MPIU_SCALAR, &work);CHKERRQ(ierr);
4112 /* Compute boundary integrals */
4113 /* ierr = DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, ctx);CHKERRQ(ierr); */
4114 /* Assemble matrix */
4115 if (assembleJac) {ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);}
4116 ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4117 ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
4118 CHKMEMQ;
4119 PetscFunctionReturn(0);
4120 }
4121
4122 /******** FEM Assembly Function ********/
4123
DMConvertPlex_Internal(DM dm,DM * plex,PetscBool copy)4124 static PetscErrorCode DMConvertPlex_Internal(DM dm, DM *plex, PetscBool copy)
4125 {
4126 PetscBool isPlex;
4127 PetscErrorCode ierr;
4128
4129 PetscFunctionBegin;
4130 ierr = PetscObjectTypeCompare((PetscObject) dm, DMPLEX, &isPlex);CHKERRQ(ierr);
4131 if (isPlex) {
4132 *plex = dm;
4133 ierr = PetscObjectReference((PetscObject) dm);CHKERRQ(ierr);
4134 } else {
4135 ierr = PetscObjectQuery((PetscObject) dm, "dm_plex", (PetscObject *) plex);CHKERRQ(ierr);
4136 if (!*plex) {
4137 ierr = DMConvert(dm,DMPLEX,plex);CHKERRQ(ierr);
4138 ierr = PetscObjectCompose((PetscObject) dm, "dm_plex", (PetscObject) *plex);CHKERRQ(ierr);
4139 if (copy) {
4140 const char *comps[] = {"A", "dmAux"};
4141 PetscObject obj;
4142 PetscInt i;
4143
4144 for (i = 0; i < 2; ++i) {
4145 ierr = PetscObjectQuery((PetscObject) dm, comps[i], &obj);CHKERRQ(ierr);
4146 ierr = PetscObjectCompose((PetscObject) *plex, comps[i], obj);CHKERRQ(ierr);
4147 }
4148 }
4149 } else {
4150 ierr = PetscObjectReference((PetscObject) *plex);CHKERRQ(ierr);
4151 }
4152 }
4153 PetscFunctionReturn(0);
4154 }
4155
4156 /*@
4157 DMPlexGetGeometryFVM - Return precomputed geometric data
4158
4159 Collective on DM
4160
4161 Input Parameter:
4162 . dm - The DM
4163
4164 Output Parameters:
4165 + facegeom - The values precomputed from face geometry
4166 . cellgeom - The values precomputed from cell geometry
4167 - minRadius - The minimum radius over the mesh of an inscribed sphere in a cell
4168
4169 Level: developer
4170
4171 .seealso: DMPlexTSSetRHSFunctionLocal()
4172 @*/
DMPlexGetGeometryFVM(DM dm,Vec * facegeom,Vec * cellgeom,PetscReal * minRadius)4173 PetscErrorCode DMPlexGetGeometryFVM(DM dm, Vec *facegeom, Vec *cellgeom, PetscReal *minRadius)
4174 {
4175 DM plex;
4176 PetscErrorCode ierr;
4177
4178 PetscFunctionBegin;
4179 PetscValidHeaderSpecific(dm,DM_CLASSID,1);
4180 ierr = DMConvertPlex_Internal(dm,&plex,PETSC_TRUE);CHKERRQ(ierr);
4181 ierr = DMPlexGetDataFVM(plex, NULL, cellgeom, facegeom, NULL);CHKERRQ(ierr);
4182 if (minRadius) {ierr = DMPlexGetMinRadius(plex, minRadius);CHKERRQ(ierr);}
4183 ierr = DMDestroy(&plex);CHKERRQ(ierr);
4184 PetscFunctionReturn(0);
4185 }
4186
4187 /*@
4188 DMPlexGetGradientDM - Return gradient data layout
4189
4190 Collective on DM
4191
4192 Input Parameters:
4193 + dm - The DM
4194 - fv - The PetscFV
4195
4196 Output Parameter:
4197 . dmGrad - The layout for gradient values
4198
4199 Level: developer
4200
4201 .seealso: DMPlexSNESGetGeometryFVM()
4202 @*/
DMPlexGetGradientDM(DM dm,PetscFV fv,DM * dmGrad)4203 PetscErrorCode DMPlexGetGradientDM(DM dm, PetscFV fv, DM *dmGrad)
4204 {
4205 DM plex;
4206 PetscBool computeGradients;
4207 PetscErrorCode ierr;
4208
4209 PetscFunctionBegin;
4210 PetscValidHeaderSpecific(dm,DM_CLASSID,1);
4211 PetscValidHeaderSpecific(fv,PETSCFV_CLASSID,2);
4212 PetscValidPointer(dmGrad,3);
4213 ierr = PetscFVGetComputeGradients(fv, &computeGradients);CHKERRQ(ierr);
4214 if (!computeGradients) {*dmGrad = NULL; PetscFunctionReturn(0);}
4215 ierr = DMConvertPlex_Internal(dm,&plex,PETSC_TRUE);CHKERRQ(ierr);
4216 ierr = DMPlexGetDataFVM(plex, fv, NULL, NULL, dmGrad);CHKERRQ(ierr);
4217 ierr = DMDestroy(&plex);CHKERRQ(ierr);
4218 PetscFunctionReturn(0);
4219 }
4220
DMPlexComputeBdResidual_Single_Internal(DM dm,PetscReal t,DMLabel label,PetscInt numValues,const PetscInt values[],PetscInt field,Vec locX,Vec locX_t,Vec locF,DMField coordField,IS facetIS)4221 static PetscErrorCode DMPlexComputeBdResidual_Single_Internal(DM dm, PetscReal t, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt field, Vec locX, Vec locX_t, Vec locF, DMField coordField, IS facetIS)
4222 {
4223 DM_Plex *mesh = (DM_Plex *) dm->data;
4224 DM plex = NULL, plexA = NULL;
4225 DMEnclosureType encAux;
4226 PetscDS prob, probAux = NULL;
4227 PetscSection section, sectionAux = NULL;
4228 Vec locA = NULL;
4229 PetscScalar *u = NULL, *u_t = NULL, *a = NULL, *elemVec = NULL;
4230 PetscInt v;
4231 PetscInt totDim, totDimAux = 0;
4232 PetscErrorCode ierr;
4233
4234 PetscFunctionBegin;
4235 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr);
4236 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
4237 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
4238 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
4239 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr);
4240 if (locA) {
4241 DM dmAux;
4242
4243 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
4244 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr);
4245 ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr);
4246 ierr = DMGetDS(plexA, &probAux);CHKERRQ(ierr);
4247 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
4248 ierr = DMGetLocalSection(plexA, §ionAux);CHKERRQ(ierr);
4249 }
4250 for (v = 0; v < numValues; ++v) {
4251 PetscFEGeom *fgeom;
4252 PetscInt maxDegree;
4253 PetscQuadrature qGeom = NULL;
4254 IS pointIS;
4255 const PetscInt *points;
4256 PetscInt numFaces, face, Nq;
4257
4258 ierr = DMLabelGetStratumIS(label, values[v], &pointIS);CHKERRQ(ierr);
4259 if (!pointIS) continue; /* No points with that id on this process */
4260 {
4261 IS isectIS;
4262
4263 /* TODO: Special cases of ISIntersect where it is quick to check a priori if one is a superset of the other */
4264 ierr = ISIntersect_Caching_Internal(facetIS,pointIS,&isectIS);CHKERRQ(ierr);
4265 ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
4266 pointIS = isectIS;
4267 }
4268 ierr = ISGetLocalSize(pointIS,&numFaces);CHKERRQ(ierr);
4269 ierr = ISGetIndices(pointIS,&points);CHKERRQ(ierr);
4270 ierr = PetscMalloc4(numFaces*totDim, &u, locX_t ? numFaces*totDim : 0, &u_t, numFaces*totDim, &elemVec, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr);
4271 ierr = DMFieldGetDegree(coordField,pointIS,NULL,&maxDegree);CHKERRQ(ierr);
4272 if (maxDegree <= 1) {
4273 ierr = DMFieldCreateDefaultQuadrature(coordField,pointIS,&qGeom);CHKERRQ(ierr);
4274 }
4275 if (!qGeom) {
4276 PetscFE fe;
4277
4278 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
4279 ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr);
4280 ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr);
4281 }
4282 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
4283 ierr = DMSNESGetFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr);
4284 for (face = 0; face < numFaces; ++face) {
4285 const PetscInt point = points[face], *support;
4286 PetscScalar *x = NULL;
4287 PetscInt i;
4288
4289 ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
4290 ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
4291 for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
4292 ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
4293 if (locX_t) {
4294 ierr = DMPlexVecGetClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr);
4295 for (i = 0; i < totDim; ++i) u_t[face*totDim+i] = x[i];
4296 ierr = DMPlexVecRestoreClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr);
4297 }
4298 if (locA) {
4299 PetscInt subp;
4300
4301 ierr = DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp);CHKERRQ(ierr);
4302 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
4303 for (i = 0; i < totDimAux; ++i) a[face*totDimAux+i] = x[i];
4304 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
4305 }
4306 }
4307 ierr = PetscArrayzero(elemVec, numFaces*totDim);CHKERRQ(ierr);
4308 {
4309 PetscFE fe;
4310 PetscInt Nb;
4311 PetscFEGeom *chunkGeom = NULL;
4312 /* Conforming batches */
4313 PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
4314 /* Remainder */
4315 PetscInt Nr, offset;
4316
4317 ierr = PetscDSGetDiscretization(prob, field, (PetscObject *) &fe);CHKERRQ(ierr);
4318 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
4319 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
4320 /* TODO: documentation is unclear about what is going on with these numbers: how should Nb / Nq factor in ? */
4321 blockSize = Nb;
4322 batchSize = numBlocks * blockSize;
4323 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
4324 numChunks = numFaces / (numBatches*batchSize);
4325 Ne = numChunks*numBatches*batchSize;
4326 Nr = numFaces % (numBatches*batchSize);
4327 offset = numFaces - Nr;
4328 ierr = PetscFEGeomGetChunk(fgeom,0,offset,&chunkGeom);CHKERRQ(ierr);
4329 ierr = PetscFEIntegrateBdResidual(prob, field, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec);CHKERRQ(ierr);
4330 ierr = PetscFEGeomRestoreChunk(fgeom, 0, offset, &chunkGeom);CHKERRQ(ierr);
4331 ierr = PetscFEGeomGetChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr);
4332 ierr = PetscFEIntegrateBdResidual(prob, field, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, a ? &a[offset*totDimAux] : NULL, t, &elemVec[offset*totDim]);CHKERRQ(ierr);
4333 ierr = PetscFEGeomRestoreChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr);
4334 }
4335 for (face = 0; face < numFaces; ++face) {
4336 const PetscInt point = points[face], *support;
4337
4338 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(point, "BdResidual", totDim, &elemVec[face*totDim]);CHKERRQ(ierr);}
4339 ierr = DMPlexGetSupport(plex, point, &support);CHKERRQ(ierr);
4340 ierr = DMPlexVecSetClosure(plex, NULL, locF, support[0], &elemVec[face*totDim], ADD_ALL_VALUES);CHKERRQ(ierr);
4341 }
4342 ierr = DMSNESRestoreFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr);
4343 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr);
4344 ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
4345 ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
4346 ierr = PetscFree4(u, u_t, elemVec, a);CHKERRQ(ierr);
4347 }
4348 ierr = DMDestroy(&plex);CHKERRQ(ierr);
4349 ierr = DMDestroy(&plexA);CHKERRQ(ierr);
4350 PetscFunctionReturn(0);
4351 }
4352
DMPlexComputeBdResidualSingle(DM dm,PetscReal t,DMLabel label,PetscInt numValues,const PetscInt values[],PetscInt field,Vec locX,Vec locX_t,Vec locF)4353 PetscErrorCode DMPlexComputeBdResidualSingle(DM dm, PetscReal t, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt field, Vec locX, Vec locX_t, Vec locF)
4354 {
4355 DMField coordField;
4356 DMLabel depthLabel;
4357 IS facetIS;
4358 PetscInt dim;
4359 PetscErrorCode ierr;
4360
4361 PetscFunctionBegin;
4362 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4363 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
4364 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr);
4365 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
4366 ierr = DMPlexComputeBdResidual_Single_Internal(dm, t, label, numValues, values, field, locX, locX_t, locF, coordField, facetIS);CHKERRQ(ierr);
4367 ierr = ISDestroy(&facetIS);CHKERRQ(ierr);
4368 PetscFunctionReturn(0);
4369 }
4370
DMPlexComputeBdResidual_Internal(DM dm,Vec locX,Vec locX_t,PetscReal t,Vec locF,void * user)4371 PetscErrorCode DMPlexComputeBdResidual_Internal(DM dm, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user)
4372 {
4373 PetscDS prob;
4374 PetscInt numBd, bd;
4375 DMField coordField = NULL;
4376 IS facetIS = NULL;
4377 DMLabel depthLabel;
4378 PetscInt dim;
4379 PetscErrorCode ierr;
4380
4381 PetscFunctionBegin;
4382 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
4383 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
4384 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4385 ierr = DMLabelGetStratumIS(depthLabel,dim - 1,&facetIS);CHKERRQ(ierr);
4386 ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr);
4387 for (bd = 0; bd < numBd; ++bd) {
4388 DMBoundaryConditionType type;
4389 const char *bdLabel;
4390 DMLabel label;
4391 const PetscInt *values;
4392 PetscInt field, numValues;
4393 PetscObject obj;
4394 PetscClassId id;
4395
4396 ierr = PetscDSGetBoundary(prob, bd, &type, NULL, &bdLabel, &field, NULL, NULL, NULL, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
4397 ierr = PetscDSGetDiscretization(prob, field, &obj);CHKERRQ(ierr);
4398 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
4399 if ((id != PETSCFE_CLASSID) || (type & DM_BC_ESSENTIAL)) continue;
4400 if (!facetIS) {
4401 DMLabel depthLabel;
4402 PetscInt dim;
4403
4404 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
4405 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
4406 ierr = DMLabelGetStratumIS(depthLabel, dim - 1, &facetIS);CHKERRQ(ierr);
4407 }
4408 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
4409 ierr = DMGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
4410 ierr = DMPlexComputeBdResidual_Single_Internal(dm, t, label, numValues, values, field, locX, locX_t, locF, coordField, facetIS);CHKERRQ(ierr);
4411 }
4412 ierr = ISDestroy(&facetIS);CHKERRQ(ierr);
4413 PetscFunctionReturn(0);
4414 }
4415
DMPlexComputeResidual_Internal(DM dm,IS cellIS,PetscReal time,Vec locX,Vec locX_t,PetscReal t,Vec locF,void * user)4416 PetscErrorCode DMPlexComputeResidual_Internal(DM dm, IS cellIS, PetscReal time, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user)
4417 {
4418 DM_Plex *mesh = (DM_Plex *) dm->data;
4419 const char *name = "Residual";
4420 DM dmAux = NULL;
4421 DM dmGrad = NULL;
4422 DMLabel ghostLabel = NULL;
4423 PetscDS prob = NULL;
4424 PetscDS probAux = NULL;
4425 PetscSection section = NULL;
4426 PetscBool useFEM = PETSC_FALSE;
4427 PetscBool useFVM = PETSC_FALSE;
4428 PetscBool isImplicit = (locX_t || time == PETSC_MIN_REAL) ? PETSC_TRUE : PETSC_FALSE;
4429 PetscFV fvm = NULL;
4430 PetscFVCellGeom *cgeomFVM = NULL;
4431 PetscFVFaceGeom *fgeomFVM = NULL;
4432 DMField coordField = NULL;
4433 Vec locA, cellGeometryFVM = NULL, faceGeometryFVM = NULL, grad, locGrad = NULL;
4434 PetscScalar *u = NULL, *u_t, *a, *uL, *uR;
4435 IS chunkIS;
4436 const PetscInt *cells;
4437 PetscInt cStart, cEnd, numCells;
4438 PetscInt Nf, f, totDim, totDimAux, numChunks, cellChunkSize, faceChunkSize, chunk, fStart, fEnd;
4439 PetscInt maxDegree = PETSC_MAX_INT;
4440 PetscQuadrature affineQuad = NULL, *quads = NULL;
4441 PetscFEGeom *affineGeom = NULL, **geoms = NULL;
4442 PetscErrorCode ierr;
4443
4444 PetscFunctionBegin;
4445 ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
4446 /* TODO The places where we have to use isFE are probably the member functions for the PetscDisc class */
4447 /* TODO The FVM geometry is over-manipulated. Make the precalc functions return exactly what we need */
4448 /* FEM+FVM */
4449 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
4450 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4451 /* 1: Get sizes from dm and dmAux */
4452 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
4453 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
4454 ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob);CHKERRQ(ierr);
4455 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
4456 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
4457 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr);
4458 if (locA) {
4459 PetscInt subcell;
4460 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
4461 ierr = DMGetEnclosurePoint(dmAux, dm, DM_ENC_UNKNOWN, cStart, &subcell);CHKERRQ(ierr);
4462 ierr = DMGetCellDS(dmAux, subcell, &probAux);CHKERRQ(ierr);
4463 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
4464 }
4465 /* 2: Get geometric data */
4466 for (f = 0; f < Nf; ++f) {
4467 PetscObject obj;
4468 PetscClassId id;
4469 PetscBool fimp;
4470
4471 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
4472 if (isImplicit != fimp) continue;
4473 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
4474 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
4475 if (id == PETSCFE_CLASSID) {useFEM = PETSC_TRUE;}
4476 if (id == PETSCFV_CLASSID) {useFVM = PETSC_TRUE; fvm = (PetscFV) obj;}
4477 }
4478 if (useFEM) {
4479 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
4480 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr);
4481 if (maxDegree <= 1) {
4482 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&affineQuad);CHKERRQ(ierr);
4483 if (affineQuad) {
4484 ierr = DMSNESGetFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
4485 }
4486 } else {
4487 ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr);
4488 for (f = 0; f < Nf; ++f) {
4489 PetscObject obj;
4490 PetscClassId id;
4491 PetscBool fimp;
4492
4493 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
4494 if (isImplicit != fimp) continue;
4495 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
4496 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
4497 if (id == PETSCFE_CLASSID) {
4498 PetscFE fe = (PetscFE) obj;
4499
4500 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr);
4501 ierr = PetscObjectReference((PetscObject)quads[f]);CHKERRQ(ierr);
4502 ierr = DMSNESGetFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);
4503 }
4504 }
4505 }
4506 }
4507 if (useFVM) {
4508 ierr = DMPlexGetGeometryFVM(dm, &faceGeometryFVM, &cellGeometryFVM, NULL);CHKERRQ(ierr);
4509 ierr = VecGetArrayRead(faceGeometryFVM, (const PetscScalar **) &fgeomFVM);CHKERRQ(ierr);
4510 ierr = VecGetArrayRead(cellGeometryFVM, (const PetscScalar **) &cgeomFVM);CHKERRQ(ierr);
4511 /* Reconstruct and limit cell gradients */
4512 ierr = DMPlexGetGradientDM(dm, fvm, &dmGrad);CHKERRQ(ierr);
4513 if (dmGrad) {
4514 ierr = DMPlexGetHeightStratum(dm, 1, &fStart, &fEnd);CHKERRQ(ierr);
4515 ierr = DMGetGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
4516 ierr = DMPlexReconstructGradients_Internal(dm, fvm, fStart, fEnd, faceGeometryFVM, cellGeometryFVM, locX, grad);CHKERRQ(ierr);
4517 /* Communicate gradient values */
4518 ierr = DMGetLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);
4519 ierr = DMGlobalToLocalBegin(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
4520 ierr = DMGlobalToLocalEnd(dmGrad, grad, INSERT_VALUES, locGrad);CHKERRQ(ierr);
4521 ierr = DMRestoreGlobalVector(dmGrad, &grad);CHKERRQ(ierr);
4522 }
4523 /* Handle non-essential (e.g. outflow) boundary values */
4524 ierr = DMPlexInsertBoundaryValues(dm, PETSC_FALSE, locX, time, faceGeometryFVM, cellGeometryFVM, locGrad);CHKERRQ(ierr);
4525 }
4526 /* Loop over chunks */
4527 if (useFEM) {ierr = ISCreate(PETSC_COMM_SELF, &chunkIS);CHKERRQ(ierr);}
4528 numCells = cEnd - cStart;
4529 numChunks = 1;
4530 cellChunkSize = numCells/numChunks;
4531 faceChunkSize = (fEnd - fStart)/numChunks;
4532 numChunks = PetscMin(1,numCells);
4533 for (chunk = 0; chunk < numChunks; ++chunk) {
4534 PetscScalar *elemVec, *fluxL, *fluxR;
4535 PetscReal *vol;
4536 PetscFVFaceGeom *fgeom;
4537 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
4538 PetscInt fS = fStart+chunk*faceChunkSize, fE = PetscMin(fS+faceChunkSize, fEnd), numFaces = 0, face;
4539
4540 /* Extract field coefficients */
4541 if (useFEM) {
4542 ierr = ISGetPointSubrange(chunkIS, cS, cE, cells);CHKERRQ(ierr);
4543 ierr = DMPlexGetCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
4544 ierr = DMGetWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
4545 ierr = PetscArrayzero(elemVec, numCells*totDim);CHKERRQ(ierr);
4546 }
4547 if (useFVM) {
4548 ierr = DMPlexGetFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR);CHKERRQ(ierr);
4549 ierr = DMPlexGetFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol);CHKERRQ(ierr);
4550 ierr = DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL);CHKERRQ(ierr);
4551 ierr = DMGetWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR);CHKERRQ(ierr);
4552 ierr = PetscArrayzero(fluxL, numFaces*totDim);CHKERRQ(ierr);
4553 ierr = PetscArrayzero(fluxR, numFaces*totDim);CHKERRQ(ierr);
4554 }
4555 /* TODO We will interlace both our field coefficients (u, u_t, uL, uR, etc.) and our output (elemVec, fL, fR). I think this works */
4556 /* Loop over fields */
4557 for (f = 0; f < Nf; ++f) {
4558 PetscObject obj;
4559 PetscClassId id;
4560 PetscBool fimp;
4561 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset;
4562
4563 ierr = PetscDSGetImplicit(prob, f, &fimp);CHKERRQ(ierr);
4564 if (isImplicit != fimp) continue;
4565 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
4566 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
4567 if (id == PETSCFE_CLASSID) {
4568 PetscFE fe = (PetscFE) obj;
4569 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[f];
4570 PetscFEGeom *chunkGeom = NULL;
4571 PetscQuadrature quad = affineQuad ? affineQuad : quads[f];
4572 PetscInt Nq, Nb;
4573
4574 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
4575 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
4576 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
4577 blockSize = Nb;
4578 batchSize = numBlocks * blockSize;
4579 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
4580 numChunks = numCells / (numBatches*batchSize);
4581 Ne = numChunks*numBatches*batchSize;
4582 Nr = numCells % (numBatches*batchSize);
4583 offset = numCells - Nr;
4584 /* Integrate FE residual to get elemVec (need fields at quadrature points) */
4585 /* For FV, I think we use a P0 basis and the cell coefficients (for subdivided cells, we can tweak the basis tabulation to be the indicator function) */
4586 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr);
4587 ierr = PetscFEIntegrateResidual(prob, f, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec);CHKERRQ(ierr);
4588 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
4589 ierr = PetscFEIntegrateResidual(prob, f, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]);CHKERRQ(ierr);
4590 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
4591 } else if (id == PETSCFV_CLASSID) {
4592 PetscFV fv = (PetscFV) obj;
4593
4594 Ne = numFaces;
4595 /* Riemann solve over faces (need fields at face centroids) */
4596 /* We need to evaluate FE fields at those coordinates */
4597 ierr = PetscFVIntegrateRHSFunction(fv, prob, f, Ne, fgeom, vol, uL, uR, fluxL, fluxR);CHKERRQ(ierr);
4598 } else SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Unknown discretization type for field %D", f);
4599 }
4600 /* Loop over domain */
4601 if (useFEM) {
4602 /* Add elemVec to locX */
4603 for (c = cS; c < cE; ++c) {
4604 const PetscInt cell = cells ? cells[c] : c;
4605 const PetscInt cind = c - cStart;
4606
4607 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);}
4608 if (ghostLabel) {
4609 PetscInt ghostVal;
4610
4611 ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr);
4612 if (ghostVal > 0) continue;
4613 }
4614 ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr);
4615 }
4616 }
4617 if (useFVM) {
4618 PetscScalar *fa;
4619 PetscInt iface;
4620
4621 ierr = VecGetArray(locF, &fa);CHKERRQ(ierr);
4622 for (f = 0; f < Nf; ++f) {
4623 PetscFV fv;
4624 PetscObject obj;
4625 PetscClassId id;
4626 PetscInt foff, pdim;
4627
4628 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
4629 ierr = PetscDSGetFieldOffset(prob, f, &foff);CHKERRQ(ierr);
4630 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
4631 if (id != PETSCFV_CLASSID) continue;
4632 fv = (PetscFV) obj;
4633 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
4634 /* Accumulate fluxes to cells */
4635 for (face = fS, iface = 0; face < fE; ++face) {
4636 const PetscInt *scells;
4637 PetscScalar *fL = NULL, *fR = NULL;
4638 PetscInt ghost, d, nsupp, nchild;
4639
4640 ierr = DMLabelGetValue(ghostLabel, face, &ghost);CHKERRQ(ierr);
4641 ierr = DMPlexGetSupportSize(dm, face, &nsupp);CHKERRQ(ierr);
4642 ierr = DMPlexGetTreeChildren(dm, face, &nchild, NULL);CHKERRQ(ierr);
4643 if (ghost >= 0 || nsupp > 2 || nchild > 0) continue;
4644 ierr = DMPlexGetSupport(dm, face, &scells);CHKERRQ(ierr);
4645 ierr = DMLabelGetValue(ghostLabel,scells[0],&ghost);CHKERRQ(ierr);
4646 if (ghost <= 0) {ierr = DMPlexPointLocalFieldRef(dm, scells[0], f, fa, &fL);CHKERRQ(ierr);}
4647 ierr = DMLabelGetValue(ghostLabel,scells[1],&ghost);CHKERRQ(ierr);
4648 if (ghost <= 0) {ierr = DMPlexPointLocalFieldRef(dm, scells[1], f, fa, &fR);CHKERRQ(ierr);}
4649 for (d = 0; d < pdim; ++d) {
4650 if (fL) fL[d] -= fluxL[iface*totDim+foff+d];
4651 if (fR) fR[d] += fluxR[iface*totDim+foff+d];
4652 }
4653 ++iface;
4654 }
4655 }
4656 ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr);
4657 }
4658 /* Handle time derivative */
4659 if (locX_t) {
4660 PetscScalar *x_t, *fa;
4661
4662 ierr = VecGetArray(locF, &fa);CHKERRQ(ierr);
4663 ierr = VecGetArray(locX_t, &x_t);CHKERRQ(ierr);
4664 for (f = 0; f < Nf; ++f) {
4665 PetscFV fv;
4666 PetscObject obj;
4667 PetscClassId id;
4668 PetscInt pdim, d;
4669
4670 ierr = PetscDSGetDiscretization(prob, f, &obj);CHKERRQ(ierr);
4671 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
4672 if (id != PETSCFV_CLASSID) continue;
4673 fv = (PetscFV) obj;
4674 ierr = PetscFVGetNumComponents(fv, &pdim);CHKERRQ(ierr);
4675 for (c = cS; c < cE; ++c) {
4676 const PetscInt cell = cells ? cells[c] : c;
4677 PetscScalar *u_t, *r;
4678
4679 if (ghostLabel) {
4680 PetscInt ghostVal;
4681
4682 ierr = DMLabelGetValue(ghostLabel, cell, &ghostVal);CHKERRQ(ierr);
4683 if (ghostVal > 0) continue;
4684 }
4685 ierr = DMPlexPointLocalFieldRead(dm, cell, f, x_t, &u_t);CHKERRQ(ierr);
4686 ierr = DMPlexPointLocalFieldRef(dm, cell, f, fa, &r);CHKERRQ(ierr);
4687 for (d = 0; d < pdim; ++d) r[d] += u_t[d];
4688 }
4689 }
4690 ierr = VecRestoreArray(locX_t, &x_t);CHKERRQ(ierr);
4691 ierr = VecRestoreArray(locF, &fa);CHKERRQ(ierr);
4692 }
4693 if (useFEM) {
4694 ierr = DMPlexRestoreCellFields(dm, chunkIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
4695 ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
4696 }
4697 if (useFVM) {
4698 ierr = DMPlexRestoreFaceFields(dm, fS, fE, locX, locX_t, faceGeometryFVM, cellGeometryFVM, locGrad, &numFaces, &uL, &uR);CHKERRQ(ierr);
4699 ierr = DMPlexRestoreFaceGeometry(dm, fS, fE, faceGeometryFVM, cellGeometryFVM, &numFaces, &fgeom, &vol);CHKERRQ(ierr);
4700 ierr = DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxL);CHKERRQ(ierr);
4701 ierr = DMRestoreWorkArray(dm, numFaces*totDim, MPIU_SCALAR, &fluxR);CHKERRQ(ierr);
4702 if (dmGrad) {ierr = DMRestoreLocalVector(dmGrad, &locGrad);CHKERRQ(ierr);}
4703 }
4704 }
4705 if (useFEM) {ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);}
4706 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
4707
4708 if (useFEM) {
4709 ierr = DMPlexComputeBdResidual_Internal(dm, locX, locX_t, t, locF, user);CHKERRQ(ierr);
4710
4711 if (maxDegree <= 1) {
4712 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
4713 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr);
4714 } else {
4715 for (f = 0; f < Nf; ++f) {
4716 ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);
4717 ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);
4718 }
4719 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr);
4720 }
4721 }
4722
4723 /* FEM */
4724 /* 1: Get sizes from dm and dmAux */
4725 /* 2: Get geometric data */
4726 /* 3: Handle boundary values */
4727 /* 4: Loop over domain */
4728 /* Extract coefficients */
4729 /* Loop over fields */
4730 /* Set tiling for FE*/
4731 /* Integrate FE residual to get elemVec */
4732 /* Loop over subdomain */
4733 /* Loop over quad points */
4734 /* Transform coords to real space */
4735 /* Evaluate field and aux fields at point */
4736 /* Evaluate residual at point */
4737 /* Transform residual to real space */
4738 /* Add residual to elemVec */
4739 /* Loop over domain */
4740 /* Add elemVec to locX */
4741
4742 /* FVM */
4743 /* Get geometric data */
4744 /* If using gradients */
4745 /* Compute gradient data */
4746 /* Loop over domain faces */
4747 /* Count computational faces */
4748 /* Reconstruct cell gradient */
4749 /* Loop over domain cells */
4750 /* Limit cell gradients */
4751 /* Handle boundary values */
4752 /* Loop over domain faces */
4753 /* Read out field, centroid, normal, volume for each side of face */
4754 /* Riemann solve over faces */
4755 /* Loop over domain faces */
4756 /* Accumulate fluxes to cells */
4757 /* TODO Change printFEM to printDisc here */
4758 if (mesh->printFEM) {
4759 Vec locFbc;
4760 PetscInt pStart, pEnd, p, maxDof;
4761 PetscScalar *zeroes;
4762
4763 ierr = VecDuplicate(locF,&locFbc);CHKERRQ(ierr);
4764 ierr = VecCopy(locF,locFbc);CHKERRQ(ierr);
4765 ierr = PetscSectionGetChart(section,&pStart,&pEnd);CHKERRQ(ierr);
4766 ierr = PetscSectionGetMaxDof(section,&maxDof);CHKERRQ(ierr);
4767 ierr = PetscCalloc1(maxDof,&zeroes);CHKERRQ(ierr);
4768 for (p = pStart; p < pEnd; p++) {
4769 ierr = VecSetValuesSection(locFbc,section,p,zeroes,INSERT_BC_VALUES);CHKERRQ(ierr);
4770 }
4771 ierr = PetscFree(zeroes);CHKERRQ(ierr);
4772 ierr = DMPrintLocalVec(dm, name, mesh->printTol, locFbc);CHKERRQ(ierr);
4773 ierr = VecDestroy(&locFbc);CHKERRQ(ierr);
4774 }
4775 ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
4776 PetscFunctionReturn(0);
4777 }
4778
DMPlexComputeResidual_Hybrid_Internal(DM dm,IS cellIS,PetscReal time,Vec locX,Vec locX_t,PetscReal t,Vec locF,void * user)4779 PetscErrorCode DMPlexComputeResidual_Hybrid_Internal(DM dm, IS cellIS, PetscReal time, Vec locX, Vec locX_t, PetscReal t, Vec locF, void *user)
4780 {
4781 DM_Plex *mesh = (DM_Plex *) dm->data;
4782 const char *name = "Hybrid Residual";
4783 DM dmAux = NULL;
4784 DMLabel ghostLabel = NULL;
4785 PetscDS prob = NULL;
4786 PetscDS probAux = NULL;
4787 PetscSection section = NULL;
4788 DMField coordField = NULL;
4789 Vec locA;
4790 PetscScalar *u = NULL, *u_t, *a;
4791 PetscScalar *elemVec;
4792 IS chunkIS;
4793 const PetscInt *cells;
4794 PetscInt *faces;
4795 PetscInt cStart, cEnd, numCells;
4796 PetscInt Nf, f, totDim, totDimAux, numChunks, cellChunkSize, chunk;
4797 PetscInt maxDegree = PETSC_MAX_INT;
4798 PetscQuadrature affineQuad = NULL, *quads = NULL;
4799 PetscFEGeom *affineGeom = NULL, **geoms = NULL;
4800 PetscErrorCode ierr;
4801
4802 PetscFunctionBegin;
4803 ierr = PetscLogEventBegin(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
4804 /* TODO The places where we have to use isFE are probably the member functions for the PetscDisc class */
4805 /* FEM */
4806 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
4807 /* 1: Get sizes from dm and dmAux */
4808 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr);
4809 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
4810 ierr = DMGetCellDS(dm, cStart, &prob);CHKERRQ(ierr);
4811 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
4812 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
4813 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr);
4814 if (locA) {
4815 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
4816 ierr = DMGetCellDS(dmAux, cStart, &probAux);CHKERRQ(ierr);
4817 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
4818 }
4819 /* 2: Setup geometric data */
4820 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
4821 ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr);
4822 if (maxDegree > 1) {
4823 ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr);
4824 for (f = 0; f < Nf; ++f) {
4825 PetscFE fe;
4826
4827 ierr = PetscDSGetDiscretization(prob, f, (PetscObject *) &fe);CHKERRQ(ierr);
4828 if (fe) {
4829 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr);
4830 ierr = PetscObjectReference((PetscObject) quads[f]);CHKERRQ(ierr);
4831 }
4832 }
4833 }
4834 /* Loop over chunks */
4835 numCells = cEnd - cStart;
4836 cellChunkSize = numCells;
4837 numChunks = !numCells ? 0 : PetscCeilReal(((PetscReal) numCells)/cellChunkSize);
4838 ierr = PetscCalloc1(2*cellChunkSize, &faces);CHKERRQ(ierr);
4839 ierr = ISCreateGeneral(PETSC_COMM_SELF, cellChunkSize, faces, PETSC_USE_POINTER, &chunkIS);CHKERRQ(ierr);
4840 /* Extract field coefficients */
4841 /* NOTE This needs the end cap faces to have identical orientations */
4842 ierr = DMPlexGetCellFields(dm, cellIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
4843 ierr = DMGetWorkArray(dm, cellChunkSize*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
4844 for (chunk = 0; chunk < numChunks; ++chunk) {
4845 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
4846
4847 ierr = PetscMemzero(elemVec, cellChunkSize*totDim * sizeof(PetscScalar));CHKERRQ(ierr);
4848 /* Get faces */
4849 for (c = cS; c < cE; ++c) {
4850 const PetscInt cell = cells ? cells[c] : c;
4851 const PetscInt *cone;
4852 ierr = DMPlexGetCone(dm, cell, &cone);CHKERRQ(ierr);
4853 faces[(c-cS)*2+0] = cone[0];
4854 faces[(c-cS)*2+1] = cone[1];
4855 }
4856 ierr = ISGeneralSetIndices(chunkIS, cellChunkSize, faces, PETSC_USE_POINTER);CHKERRQ(ierr);
4857 /* Get geometric data */
4858 if (maxDegree <= 1) {
4859 if (!affineQuad) {ierr = DMFieldCreateDefaultQuadrature(coordField, chunkIS, &affineQuad);CHKERRQ(ierr);}
4860 if (affineQuad) {ierr = DMSNESGetFEGeom(coordField, chunkIS, affineQuad, PETSC_TRUE, &affineGeom);CHKERRQ(ierr);}
4861 } else {
4862 for (f = 0; f < Nf; ++f) {
4863 if (quads[f]) {ierr = DMSNESGetFEGeom(coordField, chunkIS, quads[f], PETSC_TRUE, &geoms[f]);CHKERRQ(ierr);}
4864 }
4865 }
4866 /* Loop over fields */
4867 for (f = 0; f < Nf; ++f) {
4868 PetscFE fe;
4869 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[f];
4870 PetscFEGeom *chunkGeom = NULL;
4871 PetscQuadrature quad = affineQuad ? affineQuad : quads[f];
4872 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset, Nq, Nb;
4873
4874 ierr = PetscDSGetDiscretization(prob, f, (PetscObject *) &fe);CHKERRQ(ierr);
4875 if (!fe) continue;
4876 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
4877 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
4878 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
4879 blockSize = Nb;
4880 batchSize = numBlocks * blockSize;
4881 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
4882 numChunks = numCells / (numBatches*batchSize);
4883 Ne = numChunks*numBatches*batchSize;
4884 Nr = numCells % (numBatches*batchSize);
4885 offset = numCells - Nr;
4886 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr);
4887 ierr = PetscFEIntegrateHybridResidual(prob, f, Ne, chunkGeom, u, u_t, probAux, a, t, elemVec);CHKERRQ(ierr);
4888 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
4889 ierr = PetscFEIntegrateHybridResidual(prob, f, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, &elemVec[offset*totDim]);CHKERRQ(ierr);
4890 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&chunkGeom);CHKERRQ(ierr);
4891 }
4892 /* Add elemVec to locX */
4893 for (c = cS; c < cE; ++c) {
4894 const PetscInt cell = cells ? cells[c] : c;
4895 const PetscInt cind = c - cStart;
4896
4897 if (mesh->printFEM > 1) {ierr = DMPrintCellVector(cell, name, totDim, &elemVec[cind*totDim]);CHKERRQ(ierr);}
4898 if (ghostLabel) {
4899 PetscInt ghostVal;
4900
4901 ierr = DMLabelGetValue(ghostLabel,cell,&ghostVal);CHKERRQ(ierr);
4902 if (ghostVal > 0) continue;
4903 }
4904 ierr = DMPlexVecSetClosure(dm, section, locF, cell, &elemVec[cind*totDim], ADD_ALL_VALUES);CHKERRQ(ierr);
4905 }
4906 }
4907 ierr = DMPlexRestoreCellFields(dm, cellIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
4908 ierr = DMRestoreWorkArray(dm, numCells*totDim, MPIU_SCALAR, &elemVec);CHKERRQ(ierr);
4909 ierr = PetscFree(faces);CHKERRQ(ierr);
4910 ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);
4911 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
4912 if (maxDegree <= 1) {
4913 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
4914 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr);
4915 } else {
4916 for (f = 0; f < Nf; ++f) {
4917 if (geoms) {ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE,&geoms[f]);CHKERRQ(ierr);}
4918 if (quads) {ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);}
4919 }
4920 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr);
4921 }
4922 ierr = PetscLogEventEnd(DMPLEX_ResidualFEM,dm,0,0,0);CHKERRQ(ierr);
4923 PetscFunctionReturn(0);
4924 }
4925
DMPlexComputeBdJacobian_Single_Internal(DM dm,PetscReal t,DMLabel label,PetscInt numValues,const PetscInt values[],PetscInt fieldI,Vec locX,Vec locX_t,PetscReal X_tShift,Mat Jac,Mat JacP,DMField coordField,IS facetIS)4926 PetscErrorCode DMPlexComputeBdJacobian_Single_Internal(DM dm, PetscReal t, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt fieldI, Vec locX, Vec locX_t, PetscReal X_tShift, Mat Jac, Mat JacP, DMField coordField, IS facetIS)
4927 {
4928 DM_Plex *mesh = (DM_Plex *) dm->data;
4929 DM plex = NULL, plexA = NULL, tdm;
4930 DMEnclosureType encAux;
4931 PetscDS prob, probAux = NULL;
4932 PetscSection section, sectionAux = NULL;
4933 PetscSection globalSection, subSection = NULL;
4934 Vec locA = NULL, tv;
4935 PetscScalar *u = NULL, *u_t = NULL, *a = NULL, *elemMat = NULL;
4936 PetscInt v;
4937 PetscInt Nf, totDim, totDimAux = 0;
4938 PetscBool isMatISP, transform;
4939 PetscErrorCode ierr;
4940
4941 PetscFunctionBegin;
4942 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr);
4943 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr);
4944 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr);
4945 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr);
4946 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
4947 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
4948 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
4949 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
4950 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr);
4951 if (locA) {
4952 DM dmAux;
4953
4954 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
4955 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr);
4956 ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr);
4957 ierr = DMGetDS(plexA, &probAux);CHKERRQ(ierr);
4958 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
4959 ierr = DMGetLocalSection(plexA, §ionAux);CHKERRQ(ierr);
4960 }
4961
4962 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr);
4963 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);
4964 if (isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);}
4965 for (v = 0; v < numValues; ++v) {
4966 PetscFEGeom *fgeom;
4967 PetscInt maxDegree;
4968 PetscQuadrature qGeom = NULL;
4969 IS pointIS;
4970 const PetscInt *points;
4971 PetscInt numFaces, face, Nq;
4972
4973 ierr = DMLabelGetStratumIS(label, values[v], &pointIS);CHKERRQ(ierr);
4974 if (!pointIS) continue; /* No points with that id on this process */
4975 {
4976 IS isectIS;
4977
4978 /* TODO: Special cases of ISIntersect where it is quick to check a prior if one is a superset of the other */
4979 ierr = ISIntersect_Caching_Internal(facetIS,pointIS,&isectIS);CHKERRQ(ierr);
4980 ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
4981 pointIS = isectIS;
4982 }
4983 ierr = ISGetLocalSize(pointIS, &numFaces);CHKERRQ(ierr);
4984 ierr = ISGetIndices(pointIS, &points);CHKERRQ(ierr);
4985 ierr = PetscMalloc4(numFaces*totDim, &u, locX_t ? numFaces*totDim : 0, &u_t, numFaces*totDim*totDim, &elemMat, locA ? numFaces*totDimAux : 0, &a);CHKERRQ(ierr);
4986 ierr = DMFieldGetDegree(coordField,pointIS,NULL,&maxDegree);CHKERRQ(ierr);
4987 if (maxDegree <= 1) {
4988 ierr = DMFieldCreateDefaultQuadrature(coordField,pointIS,&qGeom);CHKERRQ(ierr);
4989 }
4990 if (!qGeom) {
4991 PetscFE fe;
4992
4993 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
4994 ierr = PetscFEGetFaceQuadrature(fe, &qGeom);CHKERRQ(ierr);
4995 ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr);
4996 }
4997 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
4998 ierr = DMSNESGetFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr);
4999 for (face = 0; face < numFaces; ++face) {
5000 const PetscInt point = points[face], *support;
5001 PetscScalar *x = NULL;
5002 PetscInt i;
5003
5004 ierr = DMPlexGetSupport(dm, point, &support);CHKERRQ(ierr);
5005 ierr = DMPlexVecGetClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
5006 for (i = 0; i < totDim; ++i) u[face*totDim+i] = x[i];
5007 ierr = DMPlexVecRestoreClosure(plex, section, locX, support[0], NULL, &x);CHKERRQ(ierr);
5008 if (locX_t) {
5009 ierr = DMPlexVecGetClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr);
5010 for (i = 0; i < totDim; ++i) u_t[face*totDim+i] = x[i];
5011 ierr = DMPlexVecRestoreClosure(plex, section, locX_t, support[0], NULL, &x);CHKERRQ(ierr);
5012 }
5013 if (locA) {
5014 PetscInt subp;
5015 ierr = DMGetEnclosurePoint(plexA, dm, encAux, support[0], &subp);CHKERRQ(ierr);
5016 ierr = DMPlexVecGetClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
5017 for (i = 0; i < totDimAux; ++i) a[face*totDimAux+i] = x[i];
5018 ierr = DMPlexVecRestoreClosure(plexA, sectionAux, locA, subp, NULL, &x);CHKERRQ(ierr);
5019 }
5020 }
5021 ierr = PetscArrayzero(elemMat, numFaces*totDim*totDim);CHKERRQ(ierr);
5022 {
5023 PetscFE fe;
5024 PetscInt Nb;
5025 /* Conforming batches */
5026 PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
5027 /* Remainder */
5028 PetscFEGeom *chunkGeom = NULL;
5029 PetscInt fieldJ, Nr, offset;
5030
5031 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
5032 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
5033 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
5034 blockSize = Nb;
5035 batchSize = numBlocks * blockSize;
5036 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
5037 numChunks = numFaces / (numBatches*batchSize);
5038 Ne = numChunks*numBatches*batchSize;
5039 Nr = numFaces % (numBatches*batchSize);
5040 offset = numFaces - Nr;
5041 ierr = PetscFEGeomGetChunk(fgeom,0,offset,&chunkGeom);CHKERRQ(ierr);
5042 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5043 ierr = PetscFEIntegrateBdJacobian(prob, fieldI, fieldJ, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);
5044 }
5045 ierr = PetscFEGeomGetChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr);
5046 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5047 ierr = PetscFEIntegrateBdJacobian(prob, fieldI, fieldJ, Nr, chunkGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, a ? &a[offset*totDimAux] : NULL, t, X_tShift, &elemMat[offset*totDim*totDim]);CHKERRQ(ierr);
5048 }
5049 ierr = PetscFEGeomRestoreChunk(fgeom,offset,numFaces,&chunkGeom);CHKERRQ(ierr);
5050 }
5051 for (face = 0; face < numFaces; ++face) {
5052 const PetscInt point = points[face], *support;
5053
5054 /* Transform to global basis before insertion in Jacobian */
5055 ierr = DMPlexGetSupport(plex, point, &support);CHKERRQ(ierr);
5056 if (transform) {ierr = DMPlexBasisTransformPointTensor_Internal(dm, tdm, tv, support[0], PETSC_TRUE, totDim, &elemMat[face*totDim*totDim]);CHKERRQ(ierr);}
5057 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(point, "BdJacobian", totDim, totDim, &elemMat[face*totDim*totDim]);CHKERRQ(ierr);}
5058 if (!isMatISP) {
5059 ierr = DMPlexMatSetClosure(plex, section, globalSection, JacP, support[0], &elemMat[face*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5060 } else {
5061 Mat lJ;
5062
5063 ierr = MatISGetLocalMat(JacP, &lJ);CHKERRQ(ierr);
5064 ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, support[0], &elemMat[face*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5065 }
5066 }
5067 ierr = DMSNESRestoreFEGeom(coordField,pointIS,qGeom,PETSC_TRUE,&fgeom);CHKERRQ(ierr);
5068 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr);
5069 ierr = ISRestoreIndices(pointIS, &points);CHKERRQ(ierr);
5070 ierr = ISDestroy(&pointIS);CHKERRQ(ierr);
5071 ierr = PetscFree4(u, u_t, elemMat, a);CHKERRQ(ierr);
5072 }
5073 if (plex) {ierr = DMDestroy(&plex);CHKERRQ(ierr);}
5074 if (plexA) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);}
5075 PetscFunctionReturn(0);
5076 }
5077
DMPlexComputeBdJacobianSingle(DM dm,PetscReal t,DMLabel label,PetscInt numValues,const PetscInt values[],PetscInt field,Vec locX,Vec locX_t,PetscReal X_tShift,Mat Jac,Mat JacP)5078 PetscErrorCode DMPlexComputeBdJacobianSingle(DM dm, PetscReal t, DMLabel label, PetscInt numValues, const PetscInt values[], PetscInt field, Vec locX, Vec locX_t, PetscReal X_tShift, Mat Jac, Mat JacP)
5079 {
5080 DMField coordField;
5081 DMLabel depthLabel;
5082 IS facetIS;
5083 PetscInt dim;
5084 PetscErrorCode ierr;
5085
5086 PetscFunctionBegin;
5087 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5088 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
5089 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr);
5090 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
5091 ierr = DMPlexComputeBdJacobian_Single_Internal(dm, t, label, numValues, values, field, locX, locX_t, X_tShift, Jac, JacP, coordField, facetIS);CHKERRQ(ierr);
5092 ierr = ISDestroy(&facetIS);CHKERRQ(ierr);
5093 PetscFunctionReturn(0);
5094 }
5095
DMPlexComputeBdJacobian_Internal(DM dm,Vec locX,Vec locX_t,PetscReal t,PetscReal X_tShift,Mat Jac,Mat JacP,void * user)5096 PetscErrorCode DMPlexComputeBdJacobian_Internal(DM dm, Vec locX, Vec locX_t, PetscReal t, PetscReal X_tShift, Mat Jac, Mat JacP, void *user)
5097 {
5098 PetscDS prob;
5099 PetscInt dim, numBd, bd;
5100 DMLabel depthLabel;
5101 DMField coordField = NULL;
5102 IS facetIS;
5103 PetscErrorCode ierr;
5104
5105 PetscFunctionBegin;
5106 ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
5107 ierr = DMPlexGetDepthLabel(dm, &depthLabel);CHKERRQ(ierr);
5108 ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
5109 ierr = DMLabelGetStratumIS(depthLabel, dim-1, &facetIS);CHKERRQ(ierr);
5110 ierr = PetscDSGetNumBoundary(prob, &numBd);CHKERRQ(ierr);
5111 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
5112 for (bd = 0; bd < numBd; ++bd) {
5113 DMBoundaryConditionType type;
5114 const char *bdLabel;
5115 DMLabel label;
5116 const PetscInt *values;
5117 PetscInt fieldI, numValues;
5118 PetscObject obj;
5119 PetscClassId id;
5120
5121 ierr = PetscDSGetBoundary(prob, bd, &type, NULL, &bdLabel, &fieldI, NULL, NULL, NULL, NULL, &numValues, &values, NULL);CHKERRQ(ierr);
5122 ierr = PetscDSGetDiscretization(prob, fieldI, &obj);CHKERRQ(ierr);
5123 ierr = PetscObjectGetClassId(obj, &id);CHKERRQ(ierr);
5124 if ((id != PETSCFE_CLASSID) || (type & DM_BC_ESSENTIAL)) continue;
5125 ierr = DMGetLabel(dm, bdLabel, &label);CHKERRQ(ierr);
5126 ierr = DMPlexComputeBdJacobian_Single_Internal(dm, t, label, numValues, values, fieldI, locX, locX_t, X_tShift, Jac, JacP, coordField, facetIS);CHKERRQ(ierr);
5127 }
5128 ierr = ISDestroy(&facetIS);CHKERRQ(ierr);
5129 PetscFunctionReturn(0);
5130 }
5131
DMPlexComputeJacobian_Internal(DM dm,IS cellIS,PetscReal t,PetscReal X_tShift,Vec X,Vec X_t,Mat Jac,Mat JacP,void * user)5132 PetscErrorCode DMPlexComputeJacobian_Internal(DM dm, IS cellIS, PetscReal t, PetscReal X_tShift, Vec X, Vec X_t, Mat Jac, Mat JacP,void *user)
5133 {
5134 DM_Plex *mesh = (DM_Plex *) dm->data;
5135 const char *name = "Jacobian";
5136 DM dmAux, plex, tdm;
5137 DMEnclosureType encAux;
5138 Vec A, tv;
5139 DMField coordField;
5140 PetscDS prob, probAux = NULL;
5141 PetscSection section, globalSection, subSection, sectionAux;
5142 PetscScalar *elemMat, *elemMatP, *elemMatD, *u, *u_t, *a = NULL;
5143 const PetscInt *cells;
5144 PetscInt Nf, fieldI, fieldJ;
5145 PetscInt totDim, totDimAux, cStart, cEnd, numCells, c;
5146 PetscBool isMatIS, isMatISP, hasJac, hasPrec, hasDyn, hasFV = PETSC_FALSE, transform;
5147 PetscErrorCode ierr;
5148
5149 PetscFunctionBegin;
5150 ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
5151 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr);
5152 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
5153 ierr = DMHasBasisTransform(dm, &transform);CHKERRQ(ierr);
5154 ierr = DMGetBasisTransformDM_Internal(dm, &tdm);CHKERRQ(ierr);
5155 ierr = DMGetBasisTransformVec_Internal(dm, &tv);CHKERRQ(ierr);
5156 ierr = DMGetLocalSection(dm, §ion);CHKERRQ(ierr);
5157 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr);
5158 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);
5159 if (isMatISP) {ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);}
5160 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr);
5161 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
5162 ierr = DMGetCellDS(dm, cells ? cells[cStart] : cStart, &prob);CHKERRQ(ierr);
5163 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
5164 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
5165 ierr = PetscDSHasJacobian(prob, &hasJac);CHKERRQ(ierr);
5166 ierr = PetscDSHasJacobianPreconditioner(prob, &hasPrec);CHKERRQ(ierr);
5167 /* user passed in the same matrix, avoid double contributions and
5168 only assemble the Jacobian */
5169 if (hasJac && Jac == JacP) hasPrec = PETSC_FALSE;
5170 ierr = PetscDSHasDynamicJacobian(prob, &hasDyn);CHKERRQ(ierr);
5171 hasDyn = hasDyn && (X_tShift != 0.0) ? PETSC_TRUE : PETSC_FALSE;
5172 ierr = PetscObjectQuery((PetscObject) dm, "dmAux", (PetscObject *) &dmAux);CHKERRQ(ierr);
5173 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &A);CHKERRQ(ierr);
5174 if (dmAux) {
5175 ierr = DMGetEnclosureRelation(dmAux, dm, &encAux);CHKERRQ(ierr);
5176 ierr = DMConvert(dmAux, DMPLEX, &plex);CHKERRQ(ierr);
5177 ierr = DMGetLocalSection(plex, §ionAux);CHKERRQ(ierr);
5178 ierr = DMGetDS(dmAux, &probAux);CHKERRQ(ierr);
5179 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
5180 }
5181 ierr = PetscMalloc5(numCells*totDim,&u,X_t ? numCells*totDim : 0,&u_t,hasJac ? numCells*totDim*totDim : 0,&elemMat,hasPrec ? numCells*totDim*totDim : 0, &elemMatP,hasDyn ? numCells*totDim*totDim : 0, &elemMatD);CHKERRQ(ierr);
5182 if (dmAux) {ierr = PetscMalloc1(numCells*totDimAux, &a);CHKERRQ(ierr);}
5183 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
5184 for (c = cStart; c < cEnd; ++c) {
5185 const PetscInt cell = cells ? cells[c] : c;
5186 const PetscInt cind = c - cStart;
5187 PetscScalar *x = NULL, *x_t = NULL;
5188 PetscInt i;
5189
5190 ierr = DMPlexVecGetClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr);
5191 for (i = 0; i < totDim; ++i) u[cind*totDim+i] = x[i];
5192 ierr = DMPlexVecRestoreClosure(dm, section, X, cell, NULL, &x);CHKERRQ(ierr);
5193 if (X_t) {
5194 ierr = DMPlexVecGetClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr);
5195 for (i = 0; i < totDim; ++i) u_t[cind*totDim+i] = x_t[i];
5196 ierr = DMPlexVecRestoreClosure(dm, section, X_t, cell, NULL, &x_t);CHKERRQ(ierr);
5197 }
5198 if (dmAux) {
5199 PetscInt subcell;
5200 ierr = DMGetEnclosurePoint(dmAux, dm, encAux, cell, &subcell);CHKERRQ(ierr);
5201 ierr = DMPlexVecGetClosure(plex, sectionAux, A, subcell, NULL, &x);CHKERRQ(ierr);
5202 for (i = 0; i < totDimAux; ++i) a[cind*totDimAux+i] = x[i];
5203 ierr = DMPlexVecRestoreClosure(plex, sectionAux, A, subcell, NULL, &x);CHKERRQ(ierr);
5204 }
5205 }
5206 if (hasJac) {ierr = PetscArrayzero(elemMat, numCells*totDim*totDim);CHKERRQ(ierr);}
5207 if (hasPrec) {ierr = PetscArrayzero(elemMatP, numCells*totDim*totDim);CHKERRQ(ierr);}
5208 if (hasDyn) {ierr = PetscArrayzero(elemMatD, numCells*totDim*totDim);CHKERRQ(ierr);}
5209 for (fieldI = 0; fieldI < Nf; ++fieldI) {
5210 PetscClassId id;
5211 PetscFE fe;
5212 PetscQuadrature qGeom = NULL;
5213 PetscInt Nb;
5214 /* Conforming batches */
5215 PetscInt numChunks, numBatches, numBlocks, Ne, blockSize, batchSize;
5216 /* Remainder */
5217 PetscInt Nr, offset, Nq;
5218 PetscInt maxDegree;
5219 PetscFEGeom *cgeomFEM, *chunkGeom = NULL, *remGeom = NULL;
5220
5221 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fe);CHKERRQ(ierr);
5222 ierr = PetscObjectGetClassId((PetscObject) fe, &id);CHKERRQ(ierr);
5223 if (id == PETSCFV_CLASSID) {hasFV = PETSC_TRUE; continue;}
5224 ierr = PetscFEGetDimension(fe, &Nb);CHKERRQ(ierr);
5225 ierr = PetscFEGetTileSizes(fe, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
5226 ierr = DMFieldGetDegree(coordField,cellIS,NULL,&maxDegree);CHKERRQ(ierr);
5227 if (maxDegree <= 1) {
5228 ierr = DMFieldCreateDefaultQuadrature(coordField,cellIS,&qGeom);CHKERRQ(ierr);
5229 }
5230 if (!qGeom) {
5231 ierr = PetscFEGetQuadrature(fe,&qGeom);CHKERRQ(ierr);
5232 ierr = PetscObjectReference((PetscObject)qGeom);CHKERRQ(ierr);
5233 }
5234 ierr = PetscQuadratureGetData(qGeom, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
5235 ierr = DMSNESGetFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr);
5236 blockSize = Nb;
5237 batchSize = numBlocks * blockSize;
5238 ierr = PetscFESetTileSizes(fe, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
5239 numChunks = numCells / (numBatches*batchSize);
5240 Ne = numChunks*numBatches*batchSize;
5241 Nr = numCells % (numBatches*batchSize);
5242 offset = numCells - Nr;
5243 ierr = PetscFEGeomGetChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr);
5244 ierr = PetscFEGeomGetChunk(cgeomFEM,offset,numCells,&remGeom);CHKERRQ(ierr);
5245 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5246 if (hasJac) {
5247 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, fieldI, fieldJ, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);
5248 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN, fieldI, fieldJ, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMat[offset*totDim*totDim]);CHKERRQ(ierr);
5249 }
5250 if (hasPrec) {
5251 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, fieldI, fieldJ, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr);
5252 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_PRE, fieldI, fieldJ, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMatP[offset*totDim*totDim]);CHKERRQ(ierr);
5253 }
5254 if (hasDyn) {
5255 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, fieldI, fieldJ, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatD);CHKERRQ(ierr);
5256 ierr = PetscFEIntegrateJacobian(prob, PETSCFE_JACOBIAN_DYN, fieldI, fieldJ, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMatD[offset*totDim*totDim]);CHKERRQ(ierr);
5257 }
5258 }
5259 ierr = PetscFEGeomRestoreChunk(cgeomFEM,offset,numCells,&remGeom);CHKERRQ(ierr);
5260 ierr = PetscFEGeomRestoreChunk(cgeomFEM,0,offset,&chunkGeom);CHKERRQ(ierr);
5261 ierr = DMSNESRestoreFEGeom(coordField,cellIS,qGeom,PETSC_FALSE,&cgeomFEM);CHKERRQ(ierr);
5262 ierr = PetscQuadratureDestroy(&qGeom);CHKERRQ(ierr);
5263 }
5264 /* Add contribution from X_t */
5265 if (hasDyn) {for (c = 0; c < numCells*totDim*totDim; ++c) elemMat[c] += X_tShift*elemMatD[c];}
5266 if (hasFV) {
5267 PetscClassId id;
5268 PetscFV fv;
5269 PetscInt offsetI, NcI, NbI = 1, fc, f;
5270
5271 for (fieldI = 0; fieldI < Nf; ++fieldI) {
5272 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &fv);CHKERRQ(ierr);
5273 ierr = PetscDSGetFieldOffset(prob, fieldI, &offsetI);CHKERRQ(ierr);
5274 ierr = PetscObjectGetClassId((PetscObject) fv, &id);CHKERRQ(ierr);
5275 if (id != PETSCFV_CLASSID) continue;
5276 /* Put in the identity */
5277 ierr = PetscFVGetNumComponents(fv, &NcI);CHKERRQ(ierr);
5278 for (c = cStart; c < cEnd; ++c) {
5279 const PetscInt cind = c - cStart;
5280 const PetscInt eOffset = cind*totDim*totDim;
5281 for (fc = 0; fc < NcI; ++fc) {
5282 for (f = 0; f < NbI; ++f) {
5283 const PetscInt i = offsetI + f*NcI+fc;
5284 if (hasPrec) {
5285 if (hasJac) {elemMat[eOffset+i*totDim+i] = 1.0;}
5286 elemMatP[eOffset+i*totDim+i] = 1.0;
5287 } else {elemMat[eOffset+i*totDim+i] = 1.0;}
5288 }
5289 }
5290 }
5291 }
5292 /* No allocated space for FV stuff, so ignore the zero entries */
5293 ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_TRUE);CHKERRQ(ierr);
5294 }
5295 /* Insert values into matrix */
5296 isMatIS = PETSC_FALSE;
5297 if (hasPrec && hasJac) {
5298 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatIS);CHKERRQ(ierr);
5299 }
5300 if (isMatIS && !subSection) {
5301 ierr = DMPlexGetSubdomainSection(dm, &subSection);CHKERRQ(ierr);
5302 }
5303 for (c = cStart; c < cEnd; ++c) {
5304 const PetscInt cell = cells ? cells[c] : c;
5305 const PetscInt cind = c - cStart;
5306
5307 /* Transform to global basis before insertion in Jacobian */
5308 if (transform) {ierr = DMPlexBasisTransformPointTensor_Internal(dm, tdm, tv, cell, PETSC_TRUE, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);}
5309 if (hasPrec) {
5310 if (hasJac) {
5311 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);}
5312 if (!isMatIS) {
5313 ierr = DMPlexMatSetClosure(dm, section, globalSection, Jac, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5314 } else {
5315 Mat lJ;
5316
5317 ierr = MatISGetLocalMat(Jac,&lJ);CHKERRQ(ierr);
5318 ierr = DMPlexMatSetClosure(dm, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5319 }
5320 }
5321 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMatP[cind*totDim*totDim]);CHKERRQ(ierr);}
5322 if (!isMatISP) {
5323 ierr = DMPlexMatSetClosure(dm, section, globalSection, JacP, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5324 } else {
5325 Mat lJ;
5326
5327 ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr);
5328 ierr = DMPlexMatSetClosure(dm, section, subSection, lJ, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5329 }
5330 } else {
5331 if (hasJac) {
5332 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);}
5333 if (!isMatISP) {
5334 ierr = DMPlexMatSetClosure(dm, section, globalSection, JacP, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5335 } else {
5336 Mat lJ;
5337
5338 ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr);
5339 ierr = DMPlexMatSetClosure(dm, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5340 }
5341 }
5342 }
5343 }
5344 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
5345 if (hasFV) {ierr = MatSetOption(JacP, MAT_IGNORE_ZERO_ENTRIES, PETSC_FALSE);CHKERRQ(ierr);}
5346 ierr = PetscFree5(u,u_t,elemMat,elemMatP,elemMatD);CHKERRQ(ierr);
5347 if (dmAux) {
5348 ierr = PetscFree(a);CHKERRQ(ierr);
5349 ierr = DMDestroy(&plex);CHKERRQ(ierr);
5350 }
5351 /* Compute boundary integrals */
5352 ierr = DMPlexComputeBdJacobian_Internal(dm, X, X_t, t, X_tShift, Jac, JacP, user);CHKERRQ(ierr);
5353 /* Assemble matrix */
5354 if (hasJac && hasPrec) {
5355 ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5356 ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5357 }
5358 ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5359 ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5360 ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
5361 PetscFunctionReturn(0);
5362 }
5363
DMPlexComputeJacobian_Hybrid_Internal(DM dm,IS cellIS,PetscReal t,PetscReal X_tShift,Vec locX,Vec locX_t,Mat Jac,Mat JacP,void * user)5364 PetscErrorCode DMPlexComputeJacobian_Hybrid_Internal(DM dm, IS cellIS, PetscReal t, PetscReal X_tShift, Vec locX, Vec locX_t, Mat Jac, Mat JacP, void *user)
5365 {
5366 DM_Plex *mesh = (DM_Plex *) dm->data;
5367 const char *name = "Hybrid Jacobian";
5368 DM dmAux = NULL;
5369 DM plex = NULL;
5370 DM plexA = NULL;
5371 DMLabel ghostLabel = NULL;
5372 PetscDS prob = NULL;
5373 PetscDS probAux = NULL;
5374 PetscSection section = NULL;
5375 DMField coordField = NULL;
5376 Vec locA;
5377 PetscScalar *u = NULL, *u_t, *a = NULL;
5378 PetscScalar *elemMat, *elemMatP;
5379 PetscSection globalSection, subSection, sectionAux;
5380 IS chunkIS;
5381 const PetscInt *cells;
5382 PetscInt *faces;
5383 PetscInt cStart, cEnd, numCells;
5384 PetscInt Nf, fieldI, fieldJ, totDim, totDimAux, numChunks, cellChunkSize, chunk;
5385 PetscInt maxDegree = PETSC_MAX_INT;
5386 PetscQuadrature affineQuad = NULL, *quads = NULL;
5387 PetscFEGeom *affineGeom = NULL, **geoms = NULL;
5388 PetscBool isMatIS = PETSC_FALSE, isMatISP = PETSC_FALSE, hasBdJac, hasBdPrec;
5389 PetscErrorCode ierr;
5390
5391 PetscFunctionBegin;
5392 ierr = PetscLogEventBegin(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
5393 ierr = ISGetLocalSize(cellIS, &numCells);CHKERRQ(ierr);
5394 ierr = ISGetPointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
5395 ierr = DMConvert(dm, DMPLEX, &plex);CHKERRQ(ierr);
5396 ierr = DMGetSection(dm, §ion);CHKERRQ(ierr);
5397 ierr = DMGetGlobalSection(dm, &globalSection);CHKERRQ(ierr);
5398 ierr = DMGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
5399 ierr = DMGetCellDS(dm, cStart, &prob);CHKERRQ(ierr);
5400 ierr = PetscDSGetNumFields(prob, &Nf);CHKERRQ(ierr);
5401 ierr = PetscDSGetTotalDimension(prob, &totDim);CHKERRQ(ierr);
5402 ierr = PetscDSHasBdJacobian(prob, &hasBdJac);CHKERRQ(ierr);
5403 ierr = PetscDSHasBdJacobianPreconditioner(prob, &hasBdPrec);CHKERRQ(ierr);
5404 ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatISP);CHKERRQ(ierr);
5405 if (isMatISP) {ierr = DMPlexGetSubdomainSection(plex, &subSection);CHKERRQ(ierr);}
5406 if (hasBdPrec && hasBdJac) {ierr = PetscObjectTypeCompare((PetscObject) JacP, MATIS, &isMatIS);CHKERRQ(ierr);}
5407 if (isMatIS && !subSection) {ierr = DMPlexGetSubdomainSection(plex, &subSection);CHKERRQ(ierr);}
5408 ierr = PetscObjectQuery((PetscObject) dm, "A", (PetscObject *) &locA);CHKERRQ(ierr);
5409 if (locA) {
5410 ierr = VecGetDM(locA, &dmAux);CHKERRQ(ierr);
5411 ierr = DMConvert(dmAux, DMPLEX, &plexA);CHKERRQ(ierr);
5412 ierr = DMGetSection(dmAux, §ionAux);CHKERRQ(ierr);
5413 ierr = DMGetCellDS(dmAux, cStart, &probAux);CHKERRQ(ierr);
5414 ierr = PetscDSGetTotalDimension(probAux, &totDimAux);CHKERRQ(ierr);
5415 }
5416 ierr = DMGetCoordinateField(dm, &coordField);CHKERRQ(ierr);
5417 ierr = DMFieldGetDegree(coordField, cellIS, NULL, &maxDegree);CHKERRQ(ierr);
5418 if (maxDegree > 1) {
5419 PetscInt f;
5420 ierr = PetscCalloc2(Nf,&quads,Nf,&geoms);CHKERRQ(ierr);
5421 for (f = 0; f < Nf; ++f) {
5422 PetscFE fe;
5423
5424 ierr = PetscDSGetDiscretization(prob, f, (PetscObject *) &fe);CHKERRQ(ierr);
5425 if (fe) {
5426 ierr = PetscFEGetQuadrature(fe, &quads[f]);CHKERRQ(ierr);
5427 ierr = PetscObjectReference((PetscObject) quads[f]);CHKERRQ(ierr);
5428 }
5429 }
5430 }
5431 cellChunkSize = numCells;
5432 numChunks = !numCells ? 0 : PetscCeilReal(((PetscReal) numCells)/cellChunkSize);
5433 ierr = PetscCalloc1(2*cellChunkSize, &faces);CHKERRQ(ierr);
5434 ierr = ISCreateGeneral(PETSC_COMM_SELF, cellChunkSize, faces, PETSC_USE_POINTER, &chunkIS);CHKERRQ(ierr);
5435 ierr = DMPlexGetCellFields(dm, cellIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
5436 ierr = DMGetWorkArray(dm, hasBdJac ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMat);CHKERRQ(ierr);
5437 ierr = DMGetWorkArray(dm, hasBdPrec ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMatP);CHKERRQ(ierr);
5438 for (chunk = 0; chunk < numChunks; ++chunk) {
5439 PetscInt cS = cStart+chunk*cellChunkSize, cE = PetscMin(cS+cellChunkSize, cEnd), numCells = cE - cS, c;
5440
5441 if (hasBdJac) {ierr = PetscMemzero(elemMat, numCells*totDim*totDim * sizeof(PetscScalar));CHKERRQ(ierr);}
5442 if (hasBdPrec) {ierr = PetscMemzero(elemMatP, numCells*totDim*totDim * sizeof(PetscScalar));CHKERRQ(ierr);}
5443 /* Get faces */
5444 for (c = cS; c < cE; ++c) {
5445 const PetscInt cell = cells ? cells[c] : c;
5446 const PetscInt *cone;
5447 ierr = DMPlexGetCone(plex, cell, &cone);CHKERRQ(ierr);
5448 faces[(c-cS)*2+0] = cone[0];
5449 faces[(c-cS)*2+1] = cone[1];
5450 }
5451 ierr = ISGeneralSetIndices(chunkIS, cellChunkSize, faces, PETSC_USE_POINTER);CHKERRQ(ierr);
5452 if (maxDegree <= 1) {
5453 if (!affineQuad) {ierr = DMFieldCreateDefaultQuadrature(coordField, chunkIS, &affineQuad);CHKERRQ(ierr);}
5454 if (affineQuad) {ierr = DMSNESGetFEGeom(coordField, chunkIS, affineQuad, PETSC_TRUE, &affineGeom);CHKERRQ(ierr);}
5455 } else {
5456 PetscInt f;
5457 for (f = 0; f < Nf; ++f) {
5458 if (quads[f]) {ierr = DMSNESGetFEGeom(coordField, chunkIS, quads[f], PETSC_TRUE, &geoms[f]);CHKERRQ(ierr);}
5459 }
5460 }
5461
5462 for (fieldI = 0; fieldI < Nf; ++fieldI) {
5463 PetscFE feI;
5464 PetscFEGeom *geom = affineGeom ? affineGeom : geoms[fieldI];
5465 PetscFEGeom *chunkGeom = NULL, *remGeom = NULL;
5466 PetscQuadrature quad = affineQuad ? affineQuad : quads[fieldI];
5467 PetscInt numChunks, numBatches, batchSize, numBlocks, blockSize, Ne, Nr, offset, Nq, Nb;
5468
5469 ierr = PetscDSGetDiscretization(prob, fieldI, (PetscObject *) &feI);CHKERRQ(ierr);
5470 if (!feI) continue;
5471 ierr = PetscFEGetTileSizes(feI, NULL, &numBlocks, NULL, &numBatches);CHKERRQ(ierr);
5472 ierr = PetscQuadratureGetData(quad, NULL, NULL, &Nq, NULL, NULL);CHKERRQ(ierr);
5473 ierr = PetscFEGetDimension(feI, &Nb);CHKERRQ(ierr);
5474 blockSize = Nb;
5475 batchSize = numBlocks * blockSize;
5476 ierr = PetscFESetTileSizes(feI, blockSize, numBlocks, batchSize, numBatches);CHKERRQ(ierr);
5477 numChunks = numCells / (numBatches*batchSize);
5478 Ne = numChunks*numBatches*batchSize;
5479 Nr = numCells % (numBatches*batchSize);
5480 offset = numCells - Nr;
5481 ierr = PetscFEGeomGetChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr);
5482 ierr = PetscFEGeomGetChunk(geom,offset,numCells,&remGeom);CHKERRQ(ierr);
5483 for (fieldJ = 0; fieldJ < Nf; ++fieldJ) {
5484 PetscFE feJ;
5485
5486 ierr = PetscDSGetDiscretization(prob, fieldJ, (PetscObject *) &feJ);CHKERRQ(ierr);
5487 if (!feJ) continue;
5488 if (hasBdJac) {
5489 ierr = PetscFEIntegrateHybridJacobian(prob, PETSCFE_JACOBIAN, fieldI, fieldJ, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMat);CHKERRQ(ierr);
5490 ierr = PetscFEIntegrateHybridJacobian(prob, PETSCFE_JACOBIAN, fieldI, fieldJ, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMat[offset*totDim*totDim]);CHKERRQ(ierr);
5491 }
5492 if (hasBdPrec) {
5493 ierr = PetscFEIntegrateHybridJacobian(prob, PETSCFE_JACOBIAN_PRE, fieldI, fieldJ, Ne, chunkGeom, u, u_t, probAux, a, t, X_tShift, elemMatP);CHKERRQ(ierr);
5494 ierr = PetscFEIntegrateHybridJacobian(prob, PETSCFE_JACOBIAN_PRE, fieldI, fieldJ, Nr, remGeom, &u[offset*totDim], u_t ? &u_t[offset*totDim] : NULL, probAux, &a[offset*totDimAux], t, X_tShift, &elemMatP[offset*totDim*totDim]);CHKERRQ(ierr);
5495 }
5496 }
5497 ierr = PetscFEGeomRestoreChunk(geom,offset,numCells,&remGeom);CHKERRQ(ierr);
5498 ierr = PetscFEGeomRestoreChunk(geom,0,offset,&chunkGeom);CHKERRQ(ierr);
5499 }
5500 /* Insert values into matrix */
5501 for (c = cS; c < cE; ++c) {
5502 const PetscInt cell = cells ? cells[c] : c;
5503 const PetscInt cind = c - cS;
5504
5505 if (hasBdPrec) {
5506 if (hasBdJac) {
5507 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);}
5508 if (!isMatIS) {
5509 ierr = DMPlexMatSetClosure(plex, section, globalSection, Jac, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5510 } else {
5511 Mat lJ;
5512
5513 ierr = MatISGetLocalMat(Jac,&lJ);CHKERRQ(ierr);
5514 ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5515 }
5516 }
5517 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMatP[cind*totDim*totDim]);CHKERRQ(ierr);}
5518 if (!isMatISP) {
5519 ierr = DMPlexMatSetClosure(plex, section, globalSection, JacP, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5520 } else {
5521 Mat lJ;
5522
5523 ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr);
5524 ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, cell, &elemMatP[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5525 }
5526 } else if (hasBdJac) {
5527 if (mesh->printFEM > 1) {ierr = DMPrintCellMatrix(cell, name, totDim, totDim, &elemMat[cind*totDim*totDim]);CHKERRQ(ierr);}
5528 if (!isMatISP) {
5529 ierr = DMPlexMatSetClosure(plex, section, globalSection, JacP, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5530 } else {
5531 Mat lJ;
5532
5533 ierr = MatISGetLocalMat(JacP,&lJ);CHKERRQ(ierr);
5534 ierr = DMPlexMatSetClosure(plex, section, subSection, lJ, cell, &elemMat[cind*totDim*totDim], ADD_VALUES);CHKERRQ(ierr);
5535 }
5536 }
5537 }
5538 }
5539 ierr = DMPlexRestoreCellFields(dm, cellIS, locX, locX_t, locA, &u, &u_t, &a);CHKERRQ(ierr);
5540 ierr = DMRestoreWorkArray(dm, hasBdJac ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMat);CHKERRQ(ierr);
5541 ierr = DMRestoreWorkArray(dm, hasBdPrec ? cellChunkSize*totDim*totDim : 0, MPIU_SCALAR, &elemMatP);CHKERRQ(ierr);
5542 ierr = PetscFree(faces);CHKERRQ(ierr);
5543 ierr = ISDestroy(&chunkIS);CHKERRQ(ierr);
5544 ierr = ISRestorePointRange(cellIS, &cStart, &cEnd, &cells);CHKERRQ(ierr);
5545 if (maxDegree <= 1) {
5546 ierr = DMSNESRestoreFEGeom(coordField,cellIS,affineQuad,PETSC_FALSE,&affineGeom);CHKERRQ(ierr);
5547 ierr = PetscQuadratureDestroy(&affineQuad);CHKERRQ(ierr);
5548 } else {
5549 PetscInt f;
5550 for (f = 0; f < Nf; ++f) {
5551 if (geoms) {ierr = DMSNESRestoreFEGeom(coordField,cellIS,quads[f],PETSC_FALSE, &geoms[f]);CHKERRQ(ierr);}
5552 if (quads) {ierr = PetscQuadratureDestroy(&quads[f]);CHKERRQ(ierr);}
5553 }
5554 ierr = PetscFree2(quads,geoms);CHKERRQ(ierr);
5555 }
5556 if (dmAux) {ierr = DMDestroy(&plexA);CHKERRQ(ierr);}
5557 ierr = DMDestroy(&plex);CHKERRQ(ierr);
5558 /* Assemble matrix */
5559 if (hasBdJac && hasBdPrec) {
5560 ierr = MatAssemblyBegin(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5561 ierr = MatAssemblyEnd(Jac, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5562 }
5563 ierr = MatAssemblyBegin(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5564 ierr = MatAssemblyEnd(JacP, MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5565 ierr = PetscLogEventEnd(DMPLEX_JacobianFEM,dm,0,0,0);CHKERRQ(ierr);
5566 PetscFunctionReturn(0);
5567 }
5568