Actual source code: dspacelagrange.c

petsc-3.10.5 2019-03-28
Report Typos and Errors
  1:  #include <petsc/private/petscfeimpl.h>
  2:  #include <petscdmplex.h>

  4: static PetscErrorCode PetscDualSpaceLagrangeGetTensor_Lagrange(PetscDualSpace sp, PetscBool *tensor)
  5: {
  6:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;

  9:   *tensor = lag->tensorSpace;
 10:   return(0);
 11: }

 13: static PetscErrorCode PetscDualSpaceLagrangeSetTensor_Lagrange(PetscDualSpace sp, PetscBool tensor)
 14: {
 15:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;

 18:   lag->tensorSpace = tensor;
 19:   return(0);
 20: }

 22: /*
 23:   LatticePointLexicographic_Internal - Returns all tuples of size 'len' with nonnegative integers that sum up to at most 'max'.
 24:                                        Ordering is lexicographic with lowest index as least significant in ordering.
 25:                                        e.g. for len == 2 and max == 2, this will return, in order, {0,0}, {1,0}, {2,0}, {0,1}, {1,1}, {2,0}.

 27:   Input Parameters:
 28: + len - The length of the tuple
 29: . max - The maximum sum
 30: - tup - A tuple of length len+1: tup[len] > 0 indicates a stopping condition

 32:   Output Parameter:
 33: . tup - A tuple of len integers whos sum is at most 'max'
 34: */
 35: static PetscErrorCode LatticePointLexicographic_Internal(PetscInt len, PetscInt max, PetscInt tup[])
 36: {
 38:   while (len--) {
 39:     max -= tup[len];
 40:     if (!max) {
 41:       tup[len] = 0;
 42:       break;
 43:     }
 44:   }
 45:   tup[++len]++;
 46:   return(0);
 47: }

 49: /*
 50:   TensorPointLexicographic_Internal - Returns all tuples of size 'len' with nonnegative integers that are all less than or equal to 'max'.
 51:                                       Ordering is lexicographic with lowest index as least significant in ordering.
 52:                                       e.g. for len == 2 and max == 2, this will return, in order, {0,0}, {1,0}, {2,0}, {0,1}, {1,1}, {2,1}, {0,2}, {1,2}, {2,2}.

 54:   Input Parameters:
 55: + len - The length of the tuple
 56: . max - The maximum value
 57: - tup - A tuple of length len+1: tup[len] > 0 indicates a stopping condition

 59:   Output Parameter:
 60: . tup - A tuple of len integers whos sum is at most 'max'
 61: */
 62: static PetscErrorCode TensorPointLexicographic_Internal(PetscInt len, PetscInt max, PetscInt tup[])
 63: {
 64:   PetscInt       i;

 67:   for (i = 0; i < len; i++) {
 68:     if (tup[i] < max) {
 69:       break;
 70:     } else {
 71:       tup[i] = 0;
 72:     }
 73:   }
 74:   tup[i]++;
 75:   return(0);
 76: }


 79: #define BaryIndex(perEdge,a,b,c) (((b)*(2*perEdge+1-(b)))/2)+(c)

 81: #define CartIndex(perEdge,a,b) (perEdge*(a)+b)

 83: static PetscErrorCode PetscDualSpaceGetSymmetries_Lagrange(PetscDualSpace sp, const PetscInt ****perms, const PetscScalar ****flips)
 84: {

 86:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
 87:   PetscInt           dim, order, p, Nc;
 88:   PetscErrorCode     ierr;

 91:   PetscDualSpaceGetOrder(sp,&order);
 92:   PetscDualSpaceGetNumComponents(sp,&Nc);
 93:   DMGetDimension(sp->dm,&dim);
 94:   if (!dim || !lag->continuous || order < 3) return(0);
 95:   if (dim > 3) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Lagrange symmetries not implemented for dim = %D > 3",dim);
 96:   if (!lag->symmetries) { /* store symmetries */
 97:     PetscDualSpace hsp;
 98:     DM             K;
 99:     PetscInt       numPoints = 1, d;
100:     PetscInt       numFaces;
101:     PetscInt       ***symmetries;
102:     const PetscInt ***hsymmetries;

104:     if (lag->simplexCell) {
105:       numFaces = 1 + dim;
106:       for (d = 0; d < dim; d++) numPoints = numPoints * 2 + 1;
107:     }
108:     else {
109:       numPoints = PetscPowInt(3,dim);
110:       numFaces  = 2 * dim;
111:     }
112:     PetscCalloc1(numPoints,&symmetries);
113:     if (0 < dim && dim < 3) { /* compute self symmetries */
114:       PetscInt **cellSymmetries;

116:       lag->numSelfSym = 2 * numFaces;
117:       lag->selfSymOff = numFaces;
118:       PetscCalloc1(2*numFaces,&cellSymmetries);
119:       /* we want to be able to index symmetries directly with the orientations, which range from [-numFaces,numFaces) */
120:       symmetries[0] = &cellSymmetries[numFaces];
121:       if (dim == 1) {
122:         PetscInt dofPerEdge = order - 1;

124:         if (dofPerEdge > 1) {
125:           PetscInt i, j, *reverse;

127:           PetscMalloc1(dofPerEdge*Nc,&reverse);
128:           for (i = 0; i < dofPerEdge; i++) {
129:             for (j = 0; j < Nc; j++) {
130:               reverse[i*Nc + j] = Nc * (dofPerEdge - 1 - i) + j;
131:             }
132:           }
133:           symmetries[0][-2] = reverse;

135:           /* yes, this is redundant, but it makes it easier to cleanup if I don't have to worry about what not to free */
136:           PetscMalloc1(dofPerEdge*Nc,&reverse);
137:           for (i = 0; i < dofPerEdge; i++) {
138:             for (j = 0; j < Nc; j++) {
139:               reverse[i*Nc + j] = Nc * (dofPerEdge - 1 - i) + j;
140:             }
141:           }
142:           symmetries[0][1] = reverse;
143:         }
144:       } else {
145:         PetscInt dofPerEdge = lag->simplexCell ? (order - 2) : (order - 1), s;
146:         PetscInt dofPerFace;

148:         if (dofPerEdge > 1) {
149:           for (s = -numFaces; s < numFaces; s++) {
150:             PetscInt *sym, i, j, k, l;

152:             if (!s) continue;
153:             if (lag->simplexCell) {
154:               dofPerFace = (dofPerEdge * (dofPerEdge + 1))/2;
155:               PetscMalloc1(Nc*dofPerFace,&sym);
156:               for (j = 0, l = 0; j < dofPerEdge; j++) {
157:                 for (k = 0; k < dofPerEdge - j; k++, l++) {
158:                   i = dofPerEdge - 1 - j - k;
159:                   switch (s) {
160:                   case -3:
161:                     sym[Nc*l] = BaryIndex(dofPerEdge,i,k,j);
162:                     break;
163:                   case -2:
164:                     sym[Nc*l] = BaryIndex(dofPerEdge,j,i,k);
165:                     break;
166:                   case -1:
167:                     sym[Nc*l] = BaryIndex(dofPerEdge,k,j,i);
168:                     break;
169:                   case 1:
170:                     sym[Nc*l] = BaryIndex(dofPerEdge,k,i,j);
171:                     break;
172:                   case 2:
173:                     sym[Nc*l] = BaryIndex(dofPerEdge,j,k,i);
174:                     break;
175:                   }
176:                 }
177:               }
178:             } else {
179:               dofPerFace = dofPerEdge * dofPerEdge;
180:               PetscMalloc1(Nc*dofPerFace,&sym);
181:               for (j = 0, l = 0; j < dofPerEdge; j++) {
182:                 for (k = 0; k < dofPerEdge; k++, l++) {
183:                   switch (s) {
184:                   case -4:
185:                     sym[Nc*l] = CartIndex(dofPerEdge,k,j);
186:                     break;
187:                   case -3:
188:                     sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - j),k);
189:                     break;
190:                   case -2:
191:                     sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - k),(dofPerEdge - 1 - j));
192:                     break;
193:                   case -1:
194:                     sym[Nc*l] = CartIndex(dofPerEdge,j,(dofPerEdge - 1 - k));
195:                     break;
196:                   case 1:
197:                     sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - k),j);
198:                     break;
199:                   case 2:
200:                     sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - j),(dofPerEdge - 1 - k));
201:                     break;
202:                   case 3:
203:                     sym[Nc*l] = CartIndex(dofPerEdge,k,(dofPerEdge - 1 - j));
204:                     break;
205:                   }
206:                 }
207:               }
208:             }
209:             for (i = 0; i < dofPerFace; i++) {
210:               sym[Nc*i] *= Nc;
211:               for (j = 1; j < Nc; j++) {
212:                 sym[Nc*i+j] = sym[Nc*i] + j;
213:               }
214:             }
215:             symmetries[0][s] = sym;
216:           }
217:         }
218:       }
219:     }
220:     PetscDualSpaceGetHeightSubspace(sp,1,&hsp);
221:     PetscDualSpaceGetSymmetries(hsp,&hsymmetries,NULL);
222:     if (hsymmetries) {
223:       PetscBool      *seen;
224:       const PetscInt *cone;
225:       PetscInt       KclosureSize, *Kclosure = NULL;

227:       PetscDualSpaceGetDM(sp,&K);
228:       PetscCalloc1(numPoints,&seen);
229:       DMPlexGetCone(K,0,&cone);
230:       DMPlexGetTransitiveClosure(K,0,PETSC_TRUE,&KclosureSize,&Kclosure);
231:       for (p = 0; p < numFaces; p++) {
232:         PetscInt closureSize, *closure = NULL, q;

234:         DMPlexGetTransitiveClosure(K,cone[p],PETSC_TRUE,&closureSize,&closure);
235:         for (q = 0; q < closureSize; q++) {
236:           PetscInt point = closure[2*q], r;

238:           if(!seen[point]) {
239:             for (r = 0; r < KclosureSize; r++) {
240:               if (Kclosure[2 * r] == point) break;
241:             }
242:             seen[point] = PETSC_TRUE;
243:             symmetries[r] = (PetscInt **) hsymmetries[q];
244:           }
245:         }
246:         DMPlexRestoreTransitiveClosure(K,cone[p],PETSC_TRUE,&closureSize,&closure);
247:       }
248:       DMPlexRestoreTransitiveClosure(K,0,PETSC_TRUE,&KclosureSize,&Kclosure);
249:       PetscFree(seen);
250:     }
251:     lag->symmetries = symmetries;
252:   }
253:   if (perms) *perms = (const PetscInt ***) lag->symmetries;
254:   return(0);
255: }

257: /*@C
258:   PetscDualSpaceGetSymmetries - Returns a description of the symmetries of this basis

260:   Not collective

262:   Input Parameter:
263: . sp - the PetscDualSpace object

265:   Output Parameters:
266: + perms - Permutations of the local degrees of freedom, parameterized by the point orientation
267: - flips - Sign reversal of the local degrees of freedom, parameterized by the point orientation

269:   Note: The permutation and flip arrays are organized in the following way
270: $ perms[p][ornt][dof # on point] = new local dof #
271: $ flips[p][ornt][dof # on point] = reversal or not

273:   Level: developer

275: .seealso: PetscDualSpaceSetSymmetries()
276: @*/
277: PetscErrorCode PetscDualSpaceGetSymmetries(PetscDualSpace sp, const PetscInt ****perms, const PetscScalar ****flips)
278: {

283:   if (perms) {
285:     *perms = NULL;
286:   }
287:   if (flips) {
289:     *flips = NULL;
290:   }
291:   if (sp->ops->getsymmetries) {
292:     (sp->ops->getsymmetries)(sp,perms,flips);
293:   }
294:   return(0);
295: }

297: static PetscErrorCode PetscDualSpaceLagrangeView_Ascii(PetscDualSpace sp, PetscViewer viewer)
298: {
299:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
300:   PetscErrorCode      ierr;

303:   PetscViewerASCIIPrintf(viewer, "%s %sLagrange dual space of order %D", lag->continuous ? "Continuous" : "Discontinuous", lag->tensorSpace ? "Tensor " : "", sp->order, sp->Nc);
304:   if (sp->Nc > 1) {PetscViewerASCIIPrintf(viewer, " with %D components", sp->Nc);}
305:   PetscViewerASCIIPrintf(viewer, "\n");
306:   return(0);
307: }

309: PetscErrorCode PetscDualSpaceView_Lagrange(PetscDualSpace sp, PetscViewer viewer)
310: {
311:   PetscBool      iascii;

317:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
318:   if (iascii) {PetscDualSpaceLagrangeView_Ascii(sp, viewer);}
319:   return(0);
320: }

322: static PetscErrorCode PetscDualSpaceGetDimension_SingleCell_Lagrange(PetscDualSpace sp, PetscInt order, PetscInt *dim)
323: {
324:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
325:   PetscReal           D   = 1.0;
326:   PetscInt            n, i;
327:   PetscErrorCode      ierr;

330:   *dim = -1;                    /* Ensure that the compiler knows *dim is set. */
331:   DMGetDimension(sp->dm, &n);
332:   if (!lag->tensorSpace) {
333:     for (i = 1; i <= n; ++i) {
334:       D *= ((PetscReal) (order+i))/i;
335:     }
336:     *dim = (PetscInt) (D + 0.5);
337:   } else {
338:     *dim = 1;
339:     for (i = 0; i < n; ++i) *dim *= (order+1);
340:   }
341:   *dim *= sp->Nc;
342:   return(0);
343: }

345: static PetscErrorCode PetscDualSpaceCreateHeightSubspace_Lagrange(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
346: {
347:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
348:   PetscBool          continuous, tensor;
349:   PetscInt           order;
350:   PetscErrorCode     ierr;

355:   PetscDualSpaceLagrangeGetContinuity(sp,&continuous);
356:   PetscDualSpaceGetOrder(sp,&order);
357:   if (height == 0) {
358:     PetscObjectReference((PetscObject)sp);
359:     *bdsp = sp;
360:   } else if (continuous == PETSC_FALSE || !order) {
361:     *bdsp = NULL;
362:   } else {
363:     DM dm, K;
364:     PetscInt dim;

366:     PetscDualSpaceGetDM(sp,&dm);
367:     DMGetDimension(dm,&dim);
368:     if (height > dim || height < 0) {SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Asked for dual space at height %d for dimension %d reference element\n",height,dim);}
369:     PetscDualSpaceDuplicate(sp,bdsp);
370:     PetscDualSpaceCreateReferenceCell(*bdsp, dim-height, lag->simplexCell, &K);
371:     PetscDualSpaceSetDM(*bdsp, K);
372:     DMDestroy(&K);
373:     PetscDualSpaceLagrangeGetTensor(sp,&tensor);
374:     PetscDualSpaceLagrangeSetTensor(*bdsp,tensor);
375:     PetscDualSpaceSetUp(*bdsp);
376:   }
377:   return(0);
378: }

380: PetscErrorCode PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp)
381: {
382:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
383:   DM                  dm    = sp->dm;
384:   PetscInt            order = sp->order;
385:   PetscInt            Nc    = sp->Nc;
386:   PetscBool           continuous;
387:   PetscSection        csection;
388:   Vec                 coordinates;
389:   PetscReal          *qpoints, *qweights;
390:   PetscInt            depth, dim, pdimMax, pStart, pEnd, p, *pStratStart, *pStratEnd, coneSize, d, f = 0, c;
391:   PetscBool           simplex, tensorSpace;
392:   PetscErrorCode      ierr;

395:   /* Classify element type */
396:   if (!order) lag->continuous = PETSC_FALSE;
397:   continuous = lag->continuous;
398:   DMGetDimension(dm, &dim);
399:   DMPlexGetDepth(dm, &depth);
400:   DMPlexGetChart(dm, &pStart, &pEnd);
401:   PetscCalloc1(dim+1, &lag->numDof);
402:   PetscMalloc2(depth+1,&pStratStart,depth+1,&pStratEnd);
403:   for (d = 0; d <= depth; ++d) {DMPlexGetDepthStratum(dm, d, &pStratStart[d], &pStratEnd[d]);}
404:   DMPlexGetConeSize(dm, pStratStart[depth], &coneSize);
405:   DMGetCoordinateSection(dm, &csection);
406:   DMGetCoordinatesLocal(dm, &coordinates);
407:   if (depth == 1) {
408:     if      (coneSize == dim+1)    simplex = PETSC_TRUE;
409:     else if (coneSize == 1 << dim) simplex = PETSC_FALSE;
410:     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
411:   } else if (depth == dim) {
412:     if      (coneSize == dim+1)   simplex = PETSC_TRUE;
413:     else if (coneSize == 2 * dim) simplex = PETSC_FALSE;
414:     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
415:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support cell-vertex meshes or interpolated meshes");
416:   lag->simplexCell = simplex;
417:   if (dim > 1 && continuous && lag->simplexCell == lag->tensorSpace) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP, "Mismatching simplex/tensor cells and spaces only allowed for discontinuous elements");
418:   tensorSpace    = lag->tensorSpace;
419:   lag->height    = 0;
420:   lag->subspaces = NULL;
421:   if (continuous && sp->order > 0 && dim > 0) {
422:     PetscInt i;

424:     lag->height = dim;
425:     PetscMalloc1(dim,&lag->subspaces);
426:     PetscDualSpaceCreateHeightSubspace_Lagrange(sp,1,&lag->subspaces[0]);
427:     PetscDualSpaceSetUp(lag->subspaces[0]);
428:     for (i = 1; i < dim; i++) {
429:       PetscDualSpaceGetHeightSubspace(lag->subspaces[i-1],1,&lag->subspaces[i]);
430:       PetscObjectReference((PetscObject)(lag->subspaces[i]));
431:     }
432:   }
433:   PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, sp->order, &pdimMax);
434:   pdimMax *= (pStratEnd[depth] - pStratStart[depth]);
435:   PetscMalloc1(pdimMax, &sp->functional);
436:   if (!dim) {
437:     for (c = 0; c < Nc; ++c) {
438:       PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
439:       PetscCalloc1(Nc, &qweights);
440:       PetscQuadratureSetOrder(sp->functional[f], 0);
441:       PetscQuadratureSetData(sp->functional[f], 0, Nc, 1, NULL, qweights);
442:       qweights[c] = 1.0;
443:       ++f;
444:       lag->numDof[0]++;
445:     }
446:   } else {
447:     PetscInt     *tup;
448:     PetscReal    *v0, *hv0, *J, *invJ, detJ, hdetJ;
449:     PetscSection section;

451:     PetscSectionCreate(PETSC_COMM_SELF,&section);
452:     PetscSectionSetChart(section,pStart,pEnd);
453:     PetscCalloc5(dim+1,&tup,dim,&v0,dim,&hv0,dim*dim,&J,dim*dim,&invJ);
454:     for (p = pStart; p < pEnd; p++) {
455:       PetscInt       pointDim, d, nFunc = 0;
456:       PetscDualSpace hsp;

458:       DMPlexComputeCellGeometryFEM(dm, p, NULL, v0, J, invJ, &detJ);
459:       for (d = 0; d < depth; d++) {if (p >= pStratStart[d] && p < pStratEnd[d]) break;}
460:       pointDim = (depth == 1 && d == 1) ? dim : d;
461:       hsp = ((pointDim < dim) && lag->subspaces) ? lag->subspaces[dim - pointDim - 1] : NULL;
462:       if (hsp) {
463:         PetscDualSpace_Lag *hlag = (PetscDualSpace_Lag *) hsp->data;
464:         DM                 hdm;

466:         PetscDualSpaceGetDM(hsp,&hdm);
467:         DMPlexComputeCellGeometryFEM(hdm, 0, NULL, hv0, NULL, NULL, &hdetJ);
468:         nFunc = lag->numDof[pointDim] = hlag->numDof[pointDim];
469:       }
470:       if (pointDim == dim) {
471:         /* Cells, create for self */
472:         PetscInt     orderEff = continuous ? (!tensorSpace ? order-1-dim : order-2) : order;
473:         PetscReal    denom    = continuous ? order : (!tensorSpace ? order+1+dim : order+2);
474:         PetscReal    numer    = (!simplex || !tensorSpace) ? 2. : (2./dim);
475:         PetscReal    dx = numer/denom;
476:         PetscInt     cdim, d, d2;

478:         if (orderEff < 0) continue;
479:         PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, orderEff, &cdim);
480:         PetscMemzero(tup,(dim+1)*sizeof(PetscInt));
481:         if (!tensorSpace) {
482:           while (!tup[dim]) {
483:             for (c = 0; c < Nc; ++c) {
484:               PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
485:               PetscMalloc1(dim, &qpoints);
486:               PetscCalloc1(Nc,  &qweights);
487:               PetscQuadratureSetOrder(sp->functional[f], 0);
488:               PetscQuadratureSetData(sp->functional[f], dim, Nc, 1, qpoints, qweights);
489:               for (d = 0; d < dim; ++d) {
490:                 qpoints[d] = v0[d];
491:                 for (d2 = 0; d2 < dim; ++d2) qpoints[d] += J[d*dim+d2]*((tup[d2]+1)*dx);
492:               }
493:               qweights[c] = 1.0;
494:               ++f;
495:             }
496:             LatticePointLexicographic_Internal(dim, orderEff, tup);
497:           }
498:         } else {
499:           while (!tup[dim]) {
500:             for (c = 0; c < Nc; ++c) {
501:               PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
502:               PetscMalloc1(dim, &qpoints);
503:               PetscCalloc1(Nc,  &qweights);
504:               PetscQuadratureSetOrder(sp->functional[f], 0);
505:               PetscQuadratureSetData(sp->functional[f], dim, Nc, 1, qpoints, qweights);
506:               for (d = 0; d < dim; ++d) {
507:                 qpoints[d] = v0[d];
508:                 for (d2 = 0; d2 < dim; ++d2) qpoints[d] += J[d*dim+d2]*((tup[d2]+1)*dx);
509:               }
510:               qweights[c] = 1.0;
511:               ++f;
512:             }
513:             TensorPointLexicographic_Internal(dim, orderEff, tup);
514:           }
515:         }
516:         lag->numDof[dim] = cdim;
517:       } else { /* transform functionals from subspaces */
518:         PetscInt q;

520:         for (q = 0; q < nFunc; q++, f++) {
521:           PetscQuadrature fn;
522:           PetscInt        fdim, Nc, c, nPoints, i;
523:           const PetscReal *points;
524:           const PetscReal *weights;
525:           PetscReal       *qpoints;
526:           PetscReal       *qweights;

528:           PetscDualSpaceGetFunctional(hsp, q, &fn);
529:           PetscQuadratureGetData(fn,&fdim,&Nc,&nPoints,&points,&weights);
530:           if (fdim != pointDim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expected height dual space dim %D, got %D",pointDim,fdim);
531:           PetscMalloc1(nPoints * dim, &qpoints);
532:           PetscCalloc1(nPoints * Nc,  &qweights);
533:           for (i = 0; i < nPoints; i++) {
534:             PetscInt  j, k;
535:             PetscReal *qp = &qpoints[i * dim];

537:             for (c = 0; c < Nc; ++c) qweights[i*Nc+c] = weights[i*Nc+c];
538:             for (j = 0; j < dim; ++j) qp[j] = v0[j];
539:             for (j = 0; j < dim; ++j) {
540:               for (k = 0; k < pointDim; k++) qp[j] += J[dim * j + k] * (points[pointDim * i + k] - hv0[k]);
541:             }
542:           }
543:           PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
544:           PetscQuadratureSetOrder(sp->functional[f],0);
545:           PetscQuadratureSetData(sp->functional[f],dim,Nc,nPoints,qpoints,qweights);
546:         }
547:       }
548:       PetscSectionSetDof(section,p,lag->numDof[pointDim]);
549:     }
550:     PetscFree5(tup,v0,hv0,J,invJ);
551:     PetscSectionSetUp(section);
552:     { /* reorder to closure order */
553:       PetscInt *key, count;
554:       PetscQuadrature *reorder = NULL;

556:       PetscCalloc1(f,&key);
557:       PetscMalloc1(f*sp->Nc,&reorder);

559:       for (p = pStratStart[depth], count = 0; p < pStratEnd[depth]; p++) {
560:         PetscInt *closure = NULL, closureSize, c;

562:         DMPlexGetTransitiveClosure(dm,p,PETSC_TRUE,&closureSize,&closure);
563:         for (c = 0; c < closureSize; c++) {
564:           PetscInt point = closure[2 * c], dof, off, i;

566:           PetscSectionGetDof(section,point,&dof);
567:           PetscSectionGetOffset(section,point,&off);
568:           for (i = 0; i < dof; i++) {
569:             PetscInt fi = i + off;
570:             if (!key[fi]) {
571:               key[fi] = 1;
572:               reorder[count++] = sp->functional[fi];
573:             }
574:           }
575:         }
576:         DMPlexRestoreTransitiveClosure(dm,p,PETSC_TRUE,&closureSize,&closure);
577:       }
578:       PetscFree(sp->functional);
579:       sp->functional = reorder;
580:       PetscFree(key);
581:     }
582:     PetscSectionDestroy(&section);
583:   }
584:   if (pStratEnd[depth] == 1 && f != pdimMax) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of dual basis vectors %d not equal to dimension %d", f, pdimMax);
585:   PetscFree2(pStratStart, pStratEnd);
586:   if (f > pdimMax) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of dual basis vectors %d is greater than dimension %d", f, pdimMax);
587:   return(0);
588: }

590: PetscErrorCode PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp)
591: {
592:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
593:   PetscInt            i;
594:   PetscErrorCode      ierr;

597:   if (lag->symmetries) {
598:     PetscInt **selfSyms = lag->symmetries[0];

600:     if (selfSyms) {
601:       PetscInt i, **allocated = &selfSyms[-lag->selfSymOff];

603:       for (i = 0; i < lag->numSelfSym; i++) {
604:         PetscFree(allocated[i]);
605:       }
606:       PetscFree(allocated);
607:     }
608:     PetscFree(lag->symmetries);
609:   }
610:   for (i = 0; i < lag->height; i++) {
611:     PetscDualSpaceDestroy(&lag->subspaces[i]);
612:   }
613:   PetscFree(lag->subspaces);
614:   PetscFree(lag->numDof);
615:   PetscFree(lag);
616:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", NULL);
617:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", NULL);
618:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", NULL);
619:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", NULL);
620:   return(0);
621: }

623: PetscErrorCode PetscDualSpaceDuplicate_Lagrange(PetscDualSpace sp, PetscDualSpace *spNew)
624: {
625:   PetscInt       order, Nc;
626:   PetscBool      cont, tensor;

630:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) sp), spNew);
631:   PetscDualSpaceSetType(*spNew, PETSCDUALSPACELAGRANGE);
632:   PetscDualSpaceGetOrder(sp, &order);
633:   PetscDualSpaceSetOrder(*spNew, order);
634:   PetscDualSpaceGetNumComponents(sp, &Nc);
635:   PetscDualSpaceSetNumComponents(*spNew, Nc);
636:   PetscDualSpaceLagrangeGetContinuity(sp, &cont);
637:   PetscDualSpaceLagrangeSetContinuity(*spNew, cont);
638:   PetscDualSpaceLagrangeGetTensor(sp, &tensor);
639:   PetscDualSpaceLagrangeSetTensor(*spNew, tensor);
640:   return(0);
641: }

643: PetscErrorCode PetscDualSpaceSetFromOptions_Lagrange(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp)
644: {
645:   PetscBool      continuous, tensor, flg;

649:   PetscDualSpaceLagrangeGetContinuity(sp, &continuous);
650:   PetscDualSpaceLagrangeGetTensor(sp, &tensor);
651:   PetscOptionsHead(PetscOptionsObject,"PetscDualSpace Lagrange Options");
652:   PetscOptionsBool("-petscdualspace_lagrange_continuity", "Flag for continuous element", "PetscDualSpaceLagrangeSetContinuity", continuous, &continuous, &flg);
653:   if (flg) {PetscDualSpaceLagrangeSetContinuity(sp, continuous);}
654:   PetscOptionsBool("-petscdualspace_lagrange_tensor", "Flag for tensor dual space", "PetscDualSpaceLagrangeSetContinuity", tensor, &tensor, &flg);
655:   if (flg) {PetscDualSpaceLagrangeSetTensor(sp, tensor);}
656:   PetscOptionsTail();
657:   return(0);
658: }

660: PetscErrorCode PetscDualSpaceGetDimension_Lagrange(PetscDualSpace sp, PetscInt *dim)
661: {
662:   DM              K;
663:   const PetscInt *numDof;
664:   PetscInt        spatialDim, Nc, size = 0, d;
665:   PetscErrorCode  ierr;

668:   PetscDualSpaceGetDM(sp, &K);
669:   PetscDualSpaceGetNumDof(sp, &numDof);
670:   DMGetDimension(K, &spatialDim);
671:   DMPlexGetHeightStratum(K, 0, NULL, &Nc);
672:   if (Nc == 1) {PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, sp->order, dim); return(0);}
673:   for (d = 0; d <= spatialDim; ++d) {
674:     PetscInt pStart, pEnd;

676:     DMPlexGetDepthStratum(K, d, &pStart, &pEnd);
677:     size += (pEnd-pStart)*numDof[d];
678:   }
679:   *dim = size;
680:   return(0);
681: }

683: PetscErrorCode PetscDualSpaceGetNumDof_Lagrange(PetscDualSpace sp, const PetscInt **numDof)
684: {
685:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

688:   *numDof = lag->numDof;
689:   return(0);
690: }

692: static PetscErrorCode PetscDualSpaceLagrangeGetContinuity_Lagrange(PetscDualSpace sp, PetscBool *continuous)
693: {
694:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

699:   *continuous = lag->continuous;
700:   return(0);
701: }

703: static PetscErrorCode PetscDualSpaceLagrangeSetContinuity_Lagrange(PetscDualSpace sp, PetscBool continuous)
704: {
705:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

709:   lag->continuous = continuous;
710:   return(0);
711: }

713: /*@
714:   PetscDualSpaceLagrangeGetContinuity - Retrieves the flag for element continuity

716:   Not Collective

718:   Input Parameter:
719: . sp         - the PetscDualSpace

721:   Output Parameter:
722: . continuous - flag for element continuity

724:   Level: intermediate

726: .keywords: PetscDualSpace, Lagrange, continuous, discontinuous
727: .seealso: PetscDualSpaceLagrangeSetContinuity()
728: @*/
729: PetscErrorCode PetscDualSpaceLagrangeGetContinuity(PetscDualSpace sp, PetscBool *continuous)
730: {

736:   PetscTryMethod(sp, "PetscDualSpaceLagrangeGetContinuity_C", (PetscDualSpace,PetscBool*),(sp,continuous));
737:   return(0);
738: }

740: /*@
741:   PetscDualSpaceLagrangeSetContinuity - Indicate whether the element is continuous

743:   Logically Collective on PetscDualSpace

745:   Input Parameters:
746: + sp         - the PetscDualSpace
747: - continuous - flag for element continuity

749:   Options Database:
750: . -petscdualspace_lagrange_continuity <bool>

752:   Level: intermediate

754: .keywords: PetscDualSpace, Lagrange, continuous, discontinuous
755: .seealso: PetscDualSpaceLagrangeGetContinuity()
756: @*/
757: PetscErrorCode PetscDualSpaceLagrangeSetContinuity(PetscDualSpace sp, PetscBool continuous)
758: {

764:   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetContinuity_C", (PetscDualSpace,PetscBool),(sp,continuous));
765:   return(0);
766: }

768: PetscErrorCode PetscDualSpaceGetHeightSubspace_Lagrange(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
769: {
770:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
771:   PetscErrorCode     ierr;

776:   if (height == 0) {
777:     *bdsp = sp;
778:   }
779:   else {
780:     DM dm;
781:     PetscInt dim;

783:     PetscDualSpaceGetDM(sp,&dm);
784:     DMGetDimension(dm,&dim);
785:     if (height > dim || height < 0) {SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Asked for dual space at height %d for dimension %d reference element\n",height,dim);}
786:     if (height <= lag->height) {
787:       *bdsp = lag->subspaces[height-1];
788:     }
789:     else {
790:       *bdsp = NULL;
791:     }
792:   }
793:   return(0);
794: }

796: PetscErrorCode PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp)
797: {
799:   sp->ops->setfromoptions    = PetscDualSpaceSetFromOptions_Lagrange;
800:   sp->ops->setup             = PetscDualSpaceSetUp_Lagrange;
801:   sp->ops->view              = PetscDualSpaceView_Lagrange;
802:   sp->ops->destroy           = PetscDualSpaceDestroy_Lagrange;
803:   sp->ops->duplicate         = PetscDualSpaceDuplicate_Lagrange;
804:   sp->ops->getdimension      = PetscDualSpaceGetDimension_Lagrange;
805:   sp->ops->getnumdof         = PetscDualSpaceGetNumDof_Lagrange;
806:   sp->ops->getheightsubspace = PetscDualSpaceGetHeightSubspace_Lagrange;
807:   sp->ops->getsymmetries     = PetscDualSpaceGetSymmetries_Lagrange;
808:   sp->ops->apply             = PetscDualSpaceApplyDefault;
809:   sp->ops->applyall          = PetscDualSpaceApplyAllDefault;
810:   sp->ops->createallpoints   = PetscDualSpaceCreateAllPointsDefault;
811:   return(0);
812: }

814: /*MC
815:   PETSCDUALSPACELAGRANGE = "lagrange" - A PetscDualSpace object that encapsulates a dual space of pointwise evaluation functionals

817:   Level: intermediate

819: .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
820: M*/

822: PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Lagrange(PetscDualSpace sp)
823: {
824:   PetscDualSpace_Lag *lag;
825:   PetscErrorCode      ierr;

829:   PetscNewLog(sp,&lag);
830:   sp->data = lag;

832:   lag->numDof      = NULL;
833:   lag->simplexCell = PETSC_TRUE;
834:   lag->tensorSpace = PETSC_FALSE;
835:   lag->continuous  = PETSC_TRUE;

837:   PetscDualSpaceInitialize_Lagrange(sp);
838:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", PetscDualSpaceLagrangeGetContinuity_Lagrange);
839:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", PetscDualSpaceLagrangeSetContinuity_Lagrange);
840:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", PetscDualSpaceLagrangeGetTensor_Lagrange);
841:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", PetscDualSpaceLagrangeSetTensor_Lagrange);
842:   return(0);
843: }