Actual source code: dtfe.c

petsc-master 2018-05-25
Report Typos and Errors
  1: /* Basis Jet Tabulation

  3: We would like to tabulate the nodal basis functions and derivatives at a set of points, usually quadrature points. We
  4: follow here the derviation in http://www.math.ttu.edu/~kirby/papers/fiat-toms-2004.pdf. The nodal basis $\psi_i$ can
  5: be expressed in terms of a prime basis $\phi_i$ which can be stably evaluated. In PETSc, we will use the Legendre basis
  6: as a prime basis.

  8:   \psi_i = \sum_k \alpha_{ki} \phi_k

 10: Our nodal basis is defined in terms of the dual basis $n_j$

 12:   n_j \cdot \psi_i = \delta_{ji}

 14: and we may act on the first equation to obtain

 16:   n_j \cdot \psi_i = \sum_k \alpha_{ki} n_j \cdot \phi_k
 17:        \delta_{ji} = \sum_k \alpha_{ki} V_{jk}
 18:                  I = V \alpha

 20: so the coefficients of the nodal basis in the prime basis are

 22:    \alpha = V^{-1}

 24: We will define the dual basis vectors $n_j$ using a quadrature rule.

 26: Right now, we will just use the polynomial spaces P^k. I know some elements use the space of symmetric polynomials
 27: (I think Nedelec), but we will neglect this for now. Constraints in the space, e.g. Arnold-Winther elements, can
 28: be implemented exactly as in FIAT using functionals $L_j$.

 30: I will have to count the degrees correctly for the Legendre product when we are on simplices.

 32: We will have three objects:
 33:  - Space, P: this just need point evaluation I think
 34:  - Dual Space, P'+K: This looks like a set of functionals that can act on members of P, each n is defined by a Q
 35:  - FEM: This keeps {P, P', Q}
 36: */
 37:  #include <petsc/private/petscfeimpl.h>
 38:  #include <petsc/private/dtimpl.h>
 39:  #include <petsc/private/dmpleximpl.h>
 40:  #include <petscdmshell.h>
 41:  #include <petscdmplex.h>
 42:  #include <petscblaslapack.h>

 44: PetscBool FEcite = PETSC_FALSE;
 45: const char FECitation[] = "@article{kirby2004,\n"
 46:                           "  title   = {Algorithm 839: FIAT, a New Paradigm for Computing Finite Element Basis Functions},\n"
 47:                           "  journal = {ACM Transactions on Mathematical Software},\n"
 48:                           "  author  = {Robert C. Kirby},\n"
 49:                           "  volume  = {30},\n"
 50:                           "  number  = {4},\n"
 51:                           "  pages   = {502--516},\n"
 52:                           "  doi     = {10.1145/1039813.1039820},\n"
 53:                           "  year    = {2004}\n}\n";

 55: PetscClassId PETSCSPACE_CLASSID = 0;

 57: PetscFunctionList PetscSpaceList              = NULL;
 58: PetscBool         PetscSpaceRegisterAllCalled = PETSC_FALSE;

 60: /*@C
 61:   PetscSpaceRegister - Adds a new PetscSpace implementation

 63:   Not Collective

 65:   Input Parameters:
 66: + name        - The name of a new user-defined creation routine
 67: - create_func - The creation routine itself

 69:   Notes:
 70:   PetscSpaceRegister() may be called multiple times to add several user-defined PetscSpaces

 72:   Sample usage:
 73: .vb
 74:     PetscSpaceRegister("my_space", MyPetscSpaceCreate);
 75: .ve

 77:   Then, your PetscSpace type can be chosen with the procedural interface via
 78: .vb
 79:     PetscSpaceCreate(MPI_Comm, PetscSpace *);
 80:     PetscSpaceSetType(PetscSpace, "my_space");
 81: .ve
 82:    or at runtime via the option
 83: .vb
 84:     -petscspace_type my_space
 85: .ve

 87:   Level: advanced

 89: .keywords: PetscSpace, register
 90: .seealso: PetscSpaceRegisterAll(), PetscSpaceRegisterDestroy()

 92: @*/
 93: PetscErrorCode PetscSpaceRegister(const char sname[], PetscErrorCode (*function)(PetscSpace))
 94: {

 98:   PetscFunctionListAdd(&PetscSpaceList, sname, function);
 99:   return(0);
100: }

102: /*@C
103:   PetscSpaceSetType - Builds a particular PetscSpace

105:   Collective on PetscSpace

107:   Input Parameters:
108: + sp   - The PetscSpace object
109: - name - The kind of space

111:   Options Database Key:
112: . -petscspace_type <type> - Sets the PetscSpace type; use -help for a list of available types

114:   Level: intermediate

116: .keywords: PetscSpace, set, type
117: .seealso: PetscSpaceGetType(), PetscSpaceCreate()
118: @*/
119: PetscErrorCode PetscSpaceSetType(PetscSpace sp, PetscSpaceType name)
120: {
121:   PetscErrorCode (*r)(PetscSpace);
122:   PetscBool      match;

127:   PetscObjectTypeCompare((PetscObject) sp, name, &match);
128:   if (match) return(0);

130:   PetscSpaceRegisterAll();
131:   PetscFunctionListFind(PetscSpaceList, name, &r);
132:   if (!r) SETERRQ1(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown PetscSpace type: %s", name);

134:   if (sp->ops->destroy) {
135:     (*sp->ops->destroy)(sp);
136:     sp->ops->destroy = NULL;
137:   }
138:   (*r)(sp);
139:   PetscObjectChangeTypeName((PetscObject) sp, name);
140:   return(0);
141: }

143: /*@C
144:   PetscSpaceGetType - Gets the PetscSpace type name (as a string) from the object.

146:   Not Collective

148:   Input Parameter:
149: . sp  - The PetscSpace

151:   Output Parameter:
152: . name - The PetscSpace type name

154:   Level: intermediate

156: .keywords: PetscSpace, get, type, name
157: .seealso: PetscSpaceSetType(), PetscSpaceCreate()
158: @*/
159: PetscErrorCode PetscSpaceGetType(PetscSpace sp, PetscSpaceType *name)
160: {

166:   if (!PetscSpaceRegisterAllCalled) {
167:     PetscSpaceRegisterAll();
168:   }
169:   *name = ((PetscObject) sp)->type_name;
170:   return(0);
171: }

173: /*@C
174:   PetscSpaceView - Views a PetscSpace

176:   Collective on PetscSpace

178:   Input Parameter:
179: + sp - the PetscSpace object to view
180: - v  - the viewer

182:   Level: developer

184: .seealso PetscSpaceDestroy()
185: @*/
186: PetscErrorCode PetscSpaceView(PetscSpace sp, PetscViewer v)
187: {
188:   PetscBool      iascii;

194:   if (!v) {PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) sp), &v);}
195:   PetscObjectTypeCompare((PetscObject) v, PETSCVIEWERASCII, &iascii);
196:   if (iascii) {
197:     PetscObjectPrintClassNamePrefixType((PetscObject)sp,v);
198:     PetscViewerASCIIPushTab(v);
199:     PetscViewerASCIIPrintf(v, "Space in %D variables of order %D with %D components\n", sp->Nv, sp->order, sp->Nc);
200:     PetscViewerASCIIPopTab(v);
201:   }
202:   PetscViewerASCIIPushTab(v);
203:   if (sp->ops->view) {(*sp->ops->view)(sp, v);}
204:   PetscViewerASCIIPopTab(v);
205:   return(0);
206: }

208: /*@
209:   PetscSpaceSetFromOptions - sets parameters in a PetscSpace from the options database

211:   Collective on PetscSpace

213:   Input Parameter:
214: . sp - the PetscSpace object to set options for

216:   Options Database:
217: . -petscspace_order the approximation order of the space

219:   Level: developer

221: .seealso PetscSpaceView()
222: @*/
223: PetscErrorCode PetscSpaceSetFromOptions(PetscSpace sp)
224: {
225:   const char    *defaultType;
226:   char           name[256];
227:   PetscBool      flg;

232:   if (!((PetscObject) sp)->type_name) {
233:     defaultType = PETSCSPACEPOLYNOMIAL;
234:   } else {
235:     defaultType = ((PetscObject) sp)->type_name;
236:   }
237:   if (!PetscSpaceRegisterAllCalled) {PetscSpaceRegisterAll();}

239:   PetscObjectOptionsBegin((PetscObject) sp);
240:   PetscOptionsFList("-petscspace_type", "Linear space", "PetscSpaceSetType", PetscSpaceList, defaultType, name, 256, &flg);
241:   if (flg) {
242:     PetscSpaceSetType(sp, name);
243:   } else if (!((PetscObject) sp)->type_name) {
244:     PetscSpaceSetType(sp, defaultType);
245:   }
246:   PetscOptionsInt("-petscspace_order", "The approximation order", "PetscSpaceSetOrder", sp->order, &sp->order, NULL);
247:   PetscOptionsInt("-petscspace_variables", "The number of different variables, e.g. x and y", "PetscSpaceSetNumVariables", sp->Nv, &sp->Nv, NULL);
248:   PetscOptionsInt("-petscspace_components", "The number of components", "PetscSpaceSetNumComponents", sp->Nc, &sp->Nc, NULL);
249:   if (sp->ops->setfromoptions) {
250:     (*sp->ops->setfromoptions)(PetscOptionsObject,sp);
251:   }
252:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
253:   PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) sp);
254:   PetscOptionsEnd();
255:   PetscSpaceViewFromOptions(sp, NULL, "-petscspace_view");
256:   return(0);
257: }

259: /*@C
260:   PetscSpaceSetUp - Construct data structures for the PetscSpace

262:   Collective on PetscSpace

264:   Input Parameter:
265: . sp - the PetscSpace object to setup

267:   Level: developer

269: .seealso PetscSpaceView(), PetscSpaceDestroy()
270: @*/
271: PetscErrorCode PetscSpaceSetUp(PetscSpace sp)
272: {

277:   if (sp->ops->setup) {(*sp->ops->setup)(sp);}
278:   return(0);
279: }

281: /*@
282:   PetscSpaceDestroy - Destroys a PetscSpace object

284:   Collective on PetscSpace

286:   Input Parameter:
287: . sp - the PetscSpace object to destroy

289:   Level: developer

291: .seealso PetscSpaceView()
292: @*/
293: PetscErrorCode PetscSpaceDestroy(PetscSpace *sp)
294: {

298:   if (!*sp) return(0);

301:   if (--((PetscObject)(*sp))->refct > 0) {*sp = 0; return(0);}
302:   ((PetscObject) (*sp))->refct = 0;
303:   DMDestroy(&(*sp)->dm);

305:   (*(*sp)->ops->destroy)(*sp);
306:   PetscHeaderDestroy(sp);
307:   return(0);
308: }

310: /*@
311:   PetscSpaceCreate - Creates an empty PetscSpace object. The type can then be set with PetscSpaceSetType().

313:   Collective on MPI_Comm

315:   Input Parameter:
316: . comm - The communicator for the PetscSpace object

318:   Output Parameter:
319: . sp - The PetscSpace object

321:   Level: beginner

323: .seealso: PetscSpaceSetType(), PETSCSPACEPOLYNOMIAL
324: @*/
325: PetscErrorCode PetscSpaceCreate(MPI_Comm comm, PetscSpace *sp)
326: {
327:   PetscSpace     s;

332:   PetscCitationsRegister(FECitation,&FEcite);
333:   *sp  = NULL;
334:   PetscFEInitializePackage();

336:   PetscHeaderCreate(s, PETSCSPACE_CLASSID, "PetscSpace", "Linear Space", "PetscSpace", comm, PetscSpaceDestroy, PetscSpaceView);

338:   s->order = 0;
339:   s->Nc    = 1;
340:   s->Nv    = 0;
341:   DMShellCreate(comm, &s->dm);
342:   PetscSpaceSetType(s, PETSCSPACEPOLYNOMIAL);

344:   *sp = s;
345:   return(0);
346: }

348: /*@
349:   PetscSpaceGetDimension - Return the dimension of this space, i.e. the number of basis vectors

351:   Input Parameter:
352: . sp - The PetscSpace

354:   Output Parameter:
355: . dim - The dimension

357:   Level: intermediate

359: .seealso: PetscSpaceGetOrder(), PetscSpaceCreate(), PetscSpace
360: @*/
361: PetscErrorCode PetscSpaceGetDimension(PetscSpace sp, PetscInt *dim)
362: {

368:   *dim = 0;
369:   if (sp->ops->getdimension) {(*sp->ops->getdimension)(sp, dim);}
370:   return(0);
371: }

373: /*@
374:   PetscSpaceGetOrder - Return the order of approximation for this space

376:   Input Parameter:
377: . sp - The PetscSpace

379:   Output Parameter:
380: . order - The approximation order

382:   Level: intermediate

384: .seealso: PetscSpaceSetOrder(), PetscSpaceGetDimension(), PetscSpaceCreate(), PetscSpace
385: @*/
386: PetscErrorCode PetscSpaceGetOrder(PetscSpace sp, PetscInt *order)
387: {
391:   *order = sp->order;
392:   return(0);
393: }

395: /*@
396:   PetscSpaceSetOrder - Set the order of approximation for this space

398:   Input Parameters:
399: + sp - The PetscSpace
400: - order - The approximation order

402:   Level: intermediate

404: .seealso: PetscSpaceGetOrder(), PetscSpaceCreate(), PetscSpace
405: @*/
406: PetscErrorCode PetscSpaceSetOrder(PetscSpace sp, PetscInt order)
407: {
410:   sp->order = order;
411:   return(0);
412: }

414: /*@
415:   PetscSpaceGetNumComponents - Return the number of components for this space

417:   Input Parameter:
418: . sp - The PetscSpace

420:   Output Parameter:
421: . Nc - The number of components

423:   Note: A vector space, for example, will have d components, where d is the spatial dimension

425:   Level: intermediate

427: .seealso: PetscSpaceSetNumComponents(), PetscSpaceGetDimension(), PetscSpaceCreate(), PetscSpace
428: @*/
429: PetscErrorCode PetscSpaceGetNumComponents(PetscSpace sp, PetscInt *Nc)
430: {
434:   *Nc = sp->Nc;
435:   return(0);
436: }

438: /*@
439:   PetscSpaceSetNumComponents - Set the number of components for this space

441:   Input Parameters:
442: + sp - The PetscSpace
443: - order - The number of components

445:   Level: intermediate

447: .seealso: PetscSpaceGetNumComponents(), PetscSpaceCreate(), PetscSpace
448: @*/
449: PetscErrorCode PetscSpaceSetNumComponents(PetscSpace sp, PetscInt Nc)
450: {
453:   sp->Nc = Nc;
454:   return(0);
455: }

457: PetscErrorCode PetscSpaceSetNumVariables(PetscSpace sp, PetscInt n)
458: {
461:   sp->Nv = n;
462:   return(0);
463: }

465: PetscErrorCode PetscSpaceGetNumVariables(PetscSpace sp, PetscInt *n)
466: {
470:   *n = sp->Nv;
471:   return(0);
472: }


475: /*@C
476:   PetscSpaceEvaluate - Evaluate the basis functions and their derivatives (jet) at each point

478:   Input Parameters:
479: + sp      - The PetscSpace
480: . npoints - The number of evaluation points, in reference coordinates
481: - points  - The point coordinates

483:   Output Parameters:
484: + B - The function evaluations in a npoints x nfuncs array
485: . D - The derivative evaluations in a npoints x nfuncs x dim array
486: - H - The second derivative evaluations in a npoints x nfuncs x dim x dim array

488:   Note: Above nfuncs is the dimension of the space, and dim is the spatial dimension. The coordinates are given
489:   on the reference cell, not in real space.

491:   Level: advanced

493: .seealso: PetscFEGetTabulation(), PetscFEGetDefaultTabulation(), PetscSpaceCreate()
494: @*/
495: PetscErrorCode PetscSpaceEvaluate(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
496: {

500:   if (!npoints) return(0);
506:   if (sp->ops->evaluate) {(*sp->ops->evaluate)(sp, npoints, points, B, D, H);}
507:   return(0);
508: }

510: /*@
511:   PetscSpaceGetHeightSubspace - Get the subset of the primal space basis that is supported on a mesh point of a given height.

513:   If the space is not defined on mesh points of the given height (e.g. if the space is discontinuous and
514:   pointwise values are not defined on the element boundaries), or if the implementation of PetscSpace does not
515:   support extracting subspaces, then NULL is returned.

517:   This does not increment the reference count on the returned space, and the user should not destroy it.

519:   Not collective

521:   Input Parameters:
522: + sp - the PetscSpace object
523: - height - the height of the mesh point for which the subspace is desired

525:   Output Parameter:
526: . subsp - the subspace

528:   Level: advanced

530: .seealso: PetscDualSpaceGetHeightSubspace(), PetscSpace
531: @*/
532: PetscErrorCode PetscSpaceGetHeightSubspace(PetscSpace sp, PetscInt height, PetscSpace *subsp)
533: {

539:   *subsp = NULL;
540:   if (sp->ops->getheightsubspace) {
541:     (*sp->ops->getheightsubspace)(sp, height, subsp);
542:   }
543:   return(0);
544: }

546: PetscErrorCode PetscSpaceSetFromOptions_Polynomial(PetscOptionItems *PetscOptionsObject,PetscSpace sp)
547: {
548:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
549:   PetscErrorCode   ierr;

552:   PetscOptionsHead(PetscOptionsObject,"PetscSpace polynomial options");
553:   PetscOptionsBool("-petscspace_poly_sym", "Use only symmetric polynomials", "PetscSpacePolynomialSetSymmetric", poly->symmetric, &poly->symmetric, NULL);
554:   PetscOptionsBool("-petscspace_poly_tensor", "Use the tensor product polynomials", "PetscSpacePolynomialSetTensor", poly->tensor, &poly->tensor, NULL);
555:   PetscOptionsTail();
556:   return(0);
557: }

559: static PetscErrorCode PetscSpacePolynomialView_Ascii(PetscSpace sp, PetscViewer viewer)
560: {
561:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
562:   PetscErrorCode   ierr;

565:   if (poly->tensor) {PetscViewerASCIIPrintf(viewer, "Tensor polynomial space of degree %D\n", sp->order);}
566:   else              {PetscViewerASCIIPrintf(viewer, "Polynomial space of degree %D\n", sp->order);}
567:   return(0);
568: }

570: PetscErrorCode PetscSpaceView_Polynomial(PetscSpace sp, PetscViewer viewer)
571: {
572:   PetscBool      iascii;

578:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
579:   if (iascii) {PetscSpacePolynomialView_Ascii(sp, viewer);}
580:   return(0);
581: }

583: PetscErrorCode PetscSpaceSetUp_Polynomial(PetscSpace sp)
584: {
585:   PetscSpace_Poly *poly    = (PetscSpace_Poly *) sp->data;
586:   PetscInt         ndegree = sp->order+1;
587:   PetscInt         deg;
588:   PetscErrorCode   ierr;

591:   PetscMalloc1(ndegree, &poly->degrees);
592:   for (deg = 0; deg < ndegree; ++deg) poly->degrees[deg] = deg;
593:   return(0);
594: }

596: PetscErrorCode PetscSpaceDestroy_Polynomial(PetscSpace sp)
597: {
598:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
599:   PetscErrorCode   ierr;

602:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", NULL);
603:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialSetTensor_C", NULL);
604:   PetscFree(poly->degrees);
605:   if (poly->subspaces) {
606:     PetscInt d;

608:     for (d = 0; d < sp->Nv; ++d) {
609:       PetscSpaceDestroy(&poly->subspaces[d]);
610:     }
611:   }
612:   PetscFree(poly->subspaces);
613:   PetscFree(poly);
614:   return(0);
615: }

617: /* We treat the space as a tensor product of scalar polynomial spaces, so the dimension is multiplied by Nc */
618: PetscErrorCode PetscSpaceGetDimension_Polynomial(PetscSpace sp, PetscInt *dim)
619: {
620:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
621:   PetscInt         deg  = sp->order;
622:   PetscInt         n    = sp->Nv, i;
623:   PetscReal        D    = 1.0;

626:   if (poly->tensor) {
627:     *dim = 1;
628:     for (i = 0; i < n; ++i) *dim *= (deg+1);
629:   } else {
630:     for (i = 1; i <= n; ++i) {
631:       D *= ((PetscReal) (deg+i))/i;
632:     }
633:     *dim = (PetscInt) (D + 0.5);
634:   }
635:   *dim *= sp->Nc;
636:   return(0);
637: }

639: /*
640:   LatticePoint_Internal - Returns all tuples of size 'len' with nonnegative integers that sum up to 'sum'.

642:   Input Parameters:
643: + len - The length of the tuple
644: . sum - The sum of all entries in the tuple
645: - ind - The current multi-index of the tuple, initialized to the 0 tuple

647:   Output Parameter:
648: + ind - The multi-index of the tuple, -1 indicates the iteration has terminated
649: . tup - A tuple of len integers addig to sum

651:   Level: developer

653: .seealso:
654: */
655: static PetscErrorCode LatticePoint_Internal(PetscInt len, PetscInt sum, PetscInt ind[], PetscInt tup[])
656: {
657:   PetscInt       i;

661:   if (len == 1) {
662:     ind[0] = -1;
663:     tup[0] = sum;
664:   } else if (sum == 0) {
665:     for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
666:   } else {
667:     tup[0] = sum - ind[0];
668:     LatticePoint_Internal(len-1, ind[0], &ind[1], &tup[1]);
669:     if (ind[1] < 0) {
670:       if (ind[0] == sum) {ind[0] = -1;}
671:       else               {ind[1] = 0; ++ind[0];}
672:     }
673:   }
674:   return(0);
675: }

677: /*
678:   LatticePointLexicographic_Internal - Returns all tuples of size 'len' with nonnegative integers that sum up to at most 'max'.
679:                                        Ordering is lexicographic with lowest index as least significant in ordering.
680:                                        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}.

682:   Input Parameters:
683: + len - The length of the tuple
684: . max - The maximum sum
685: - tup - A tuple of length len+1: tup[len] > 0 indicates a stopping condition

687:   Output Parameter:
688: . tup - A tuple of len integers whos sum is at most 'max'
689: */
690: static PetscErrorCode LatticePointLexicographic_Internal(PetscInt len, PetscInt max, PetscInt tup[])
691: {
693:   while (len--) {
694:     max -= tup[len];
695:     if (!max) {
696:       tup[len] = 0;
697:       break;
698:     }
699:   }
700:   tup[++len]++;
701:   return(0);
702: }

704: /*
705:   TensorPoint_Internal - Returns all tuples of size 'len' with nonnegative integers that are less than 'max'.

707:   Input Parameters:
708: + len - The length of the tuple
709: . max - The max for all entries in the tuple
710: - ind - The current multi-index of the tuple, initialized to the 0 tuple

712:   Output Parameter:
713: + ind - The multi-index of the tuple, -1 indicates the iteration has terminated
714: . tup - A tuple of len integers less than max

716:   Level: developer

718: .seealso:
719: */
720: static PetscErrorCode TensorPoint_Internal(PetscInt len, PetscInt max, PetscInt ind[], PetscInt tup[])
721: {
722:   PetscInt       i;

726:   if (len == 1) {
727:     tup[0] = ind[0]++;
728:     ind[0] = ind[0] >= max ? -1 : ind[0];
729:   } else if (max == 0) {
730:     for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
731:   } else {
732:     tup[0] = ind[0];
733:     TensorPoint_Internal(len-1, max, &ind[1], &tup[1]);
734:     if (ind[1] < 0) {
735:       ind[1] = 0;
736:       if (ind[0] == max-1) {ind[0] = -1;}
737:       else                 {++ind[0];}
738:     }
739:   }
740:   return(0);
741: }

743: /*
744:   TensorPointLexicographic_Internal - Returns all tuples of size 'len' with nonnegative integers that are all less than or equal to 'max'.
745:                                       Ordering is lexicographic with lowest index as least significant in ordering.
746:                                       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}.

748:   Input Parameters:
749: + len - The length of the tuple
750: . max - The maximum value
751: - tup - A tuple of length len+1: tup[len] > 0 indicates a stopping condition

753:   Output Parameter:
754: . tup - A tuple of len integers whos sum is at most 'max'
755: */
756: static PetscErrorCode TensorPointLexicographic_Internal(PetscInt len, PetscInt max, PetscInt tup[])
757: {
758:   PetscInt       i;

761:   for (i = 0; i < len; i++) {
762:     if (tup[i] < max) {
763:       break;
764:     } else {
765:       tup[i] = 0;
766:     }
767:   }
768:   tup[i]++;
769:   return(0);
770: }

772: /*
773:   p in [0, npoints), i in [0, pdim), c in [0, Nc)

775:   B[p][i][c] = B[p][i_scalar][c][c]
776: */
777: PetscErrorCode PetscSpaceEvaluate_Polynomial(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
778: {
779:   PetscSpace_Poly *poly    = (PetscSpace_Poly *) sp->data;
780:   DM               dm      = sp->dm;
781:   PetscInt         Nc      = sp->Nc;
782:   PetscInt         ndegree = sp->order+1;
783:   PetscInt        *degrees = poly->degrees;
784:   PetscInt         dim     = sp->Nv;
785:   PetscReal       *lpoints, *tmp, *LB, *LD, *LH;
786:   PetscInt        *ind, *tup;
787:   PetscInt         c, pdim, d, e, der, der2, i, p, deg, o;
788:   PetscErrorCode   ierr;

791:   PetscSpaceGetDimension(sp, &pdim);
792:   pdim /= Nc;
793:   DMGetWorkArray(dm, npoints, MPIU_REAL, &lpoints);
794:   DMGetWorkArray(dm, npoints*ndegree*3, MPIU_REAL, &tmp);
795:   if (B) {DMGetWorkArray(dm, npoints*dim*ndegree, MPIU_REAL, &LB);}
796:   if (D) {DMGetWorkArray(dm, npoints*dim*ndegree, MPIU_REAL, &LD);}
797:   if (H) {DMGetWorkArray(dm, npoints*dim*ndegree, MPIU_REAL, &LH);}
798:   for (d = 0; d < dim; ++d) {
799:     for (p = 0; p < npoints; ++p) {
800:       lpoints[p] = points[p*dim+d];
801:     }
802:     PetscDTLegendreEval(npoints, lpoints, ndegree, degrees, tmp, &tmp[1*npoints*ndegree], &tmp[2*npoints*ndegree]);
803:     /* LB, LD, LH (ndegree * dim x npoints) */
804:     for (deg = 0; deg < ndegree; ++deg) {
805:       for (p = 0; p < npoints; ++p) {
806:         if (B) LB[(deg*dim + d)*npoints + p] = tmp[(0*npoints + p)*ndegree+deg];
807:         if (D) LD[(deg*dim + d)*npoints + p] = tmp[(1*npoints + p)*ndegree+deg];
808:         if (H) LH[(deg*dim + d)*npoints + p] = tmp[(2*npoints + p)*ndegree+deg];
809:       }
810:     }
811:   }
812:   /* Multiply by A (pdim x ndegree * dim) */
813:   PetscMalloc2(dim,&ind,dim,&tup);
814:   if (B) {
815:     /* B (npoints x pdim x Nc) */
816:     PetscMemzero(B, npoints*pdim*Nc*Nc * sizeof(PetscReal));
817:     if (poly->tensor) {
818:       i = 0;
819:       PetscMemzero(ind, dim * sizeof(PetscInt));
820:       while (ind[0] >= 0) {
821:         TensorPoint_Internal(dim, sp->order+1, ind, tup);
822:         for (p = 0; p < npoints; ++p) {
823:           B[(p*pdim + i)*Nc*Nc] = 1.0;
824:           for (d = 0; d < dim; ++d) {
825:             B[(p*pdim + i)*Nc*Nc] *= LB[(tup[d]*dim + d)*npoints + p];
826:           }
827:         }
828:         ++i;
829:       }
830:     } else {
831:       i = 0;
832:       for (o = 0; o <= sp->order; ++o) {
833:         PetscMemzero(ind, dim * sizeof(PetscInt));
834:         while (ind[0] >= 0) {
835:           LatticePoint_Internal(dim, o, ind, tup);
836:           for (p = 0; p < npoints; ++p) {
837:             B[(p*pdim + i)*Nc*Nc] = 1.0;
838:             for (d = 0; d < dim; ++d) {
839:               B[(p*pdim + i)*Nc*Nc] *= LB[(tup[d]*dim + d)*npoints + p];
840:             }
841:           }
842:           ++i;
843:         }
844:       }
845:     }
846:     /* Make direct sum basis for multicomponent space */
847:     for (p = 0; p < npoints; ++p) {
848:       for (i = 0; i < pdim; ++i) {
849:         for (c = 1; c < Nc; ++c) {
850:           B[(p*pdim*Nc + i*Nc + c)*Nc + c] = B[(p*pdim + i)*Nc*Nc];
851:         }
852:       }
853:     }
854:   }
855:   if (D) {
856:     /* D (npoints x pdim x Nc x dim) */
857:     PetscMemzero(D, npoints*pdim*Nc*Nc*dim * sizeof(PetscReal));
858:     if (poly->tensor) {
859:       i = 0;
860:       PetscMemzero(ind, dim * sizeof(PetscInt));
861:       while (ind[0] >= 0) {
862:         TensorPoint_Internal(dim, sp->order+1, ind, tup);
863:         for (p = 0; p < npoints; ++p) {
864:           for (der = 0; der < dim; ++der) {
865:             D[(p*pdim + i)*Nc*Nc*dim + der] = 1.0;
866:             for (d = 0; d < dim; ++d) {
867:               if (d == der) {
868:                 D[(p*pdim + i)*Nc*Nc*dim + der] *= LD[(tup[d]*dim + d)*npoints + p];
869:               } else {
870:                 D[(p*pdim + i)*Nc*Nc*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
871:               }
872:             }
873:           }
874:         }
875:         ++i;
876:       }
877:     } else {
878:       i = 0;
879:       for (o = 0; o <= sp->order; ++o) {
880:         PetscMemzero(ind, dim * sizeof(PetscInt));
881:         while (ind[0] >= 0) {
882:           LatticePoint_Internal(dim, o, ind, tup);
883:           for (p = 0; p < npoints; ++p) {
884:             for (der = 0; der < dim; ++der) {
885:               D[(p*pdim + i)*Nc*Nc*dim + der] = 1.0;
886:               for (d = 0; d < dim; ++d) {
887:                 if (d == der) {
888:                   D[(p*pdim + i)*Nc*Nc*dim + der] *= LD[(tup[d]*dim + d)*npoints + p];
889:                 } else {
890:                   D[(p*pdim + i)*Nc*Nc*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
891:                 }
892:               }
893:             }
894:           }
895:           ++i;
896:         }
897:       }
898:     }
899:     /* Make direct sum basis for multicomponent space */
900:     for (p = 0; p < npoints; ++p) {
901:       for (i = 0; i < pdim; ++i) {
902:         for (c = 1; c < Nc; ++c) {
903:           for (d = 0; d < dim; ++d) {
904:             D[((p*pdim*Nc + i*Nc + c)*Nc + c)*dim + d] = D[(p*pdim + i)*Nc*Nc*dim + d];
905:           }
906:         }
907:       }
908:     }
909:   }
910:   if (H) {
911:     /* H (npoints x pdim x Nc x Nc x dim x dim) */
912:     PetscMemzero(H, npoints*pdim*Nc*Nc*dim*dim * sizeof(PetscReal));
913:     if (poly->tensor) {
914:       i = 0;
915:       PetscMemzero(ind, dim * sizeof(PetscInt));
916:       while (ind[0] >= 0) {
917:         TensorPoint_Internal(dim, sp->order+1, ind, tup);
918:         for (p = 0; p < npoints; ++p) {
919:           for (der = 0; der < dim; ++der) {
920:             H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der] = 1.0;
921:             for (d = 0; d < dim; ++d) {
922:               if (d == der) {
923:                 H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der] *= LH[(tup[d]*dim + d)*npoints + p];
924:               } else {
925:                 H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
926:               }
927:             }
928:             for (der2 = der + 1; der2 < dim; ++der2) {
929:               H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2] = 1.0;
930:               for (d = 0; d < dim; ++d) {
931:                 if (d == der || d == der2) {
932:                   H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2] *= LD[(tup[d]*dim + d)*npoints + p];
933:                 } else {
934:                   H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2] *= LB[(tup[d]*dim + d)*npoints + p];
935:                 }
936:               }
937:               H[((p*pdim + i)*Nc*Nc*dim + der2) * dim + der] = H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2];
938:             }
939:           }
940:         }
941:         ++i;
942:       }
943:     } else {
944:       i = 0;
945:       for (o = 0; o <= sp->order; ++o) {
946:         PetscMemzero(ind, dim * sizeof(PetscInt));
947:         while (ind[0] >= 0) {
948:           LatticePoint_Internal(dim, o, ind, tup);
949:           for (p = 0; p < npoints; ++p) {
950:             for (der = 0; der < dim; ++der) {
951:               H[((p*pdim + i)*Nc*Nc*dim + der)*dim + der] = 1.0;
952:               for (d = 0; d < dim; ++d) {
953:                 if (d == der) {
954:                   H[((p*pdim + i)*Nc*Nc*dim + der)*dim + der] *= LH[(tup[d]*dim + d)*npoints + p];
955:                 } else {
956:                   H[((p*pdim + i)*Nc*Nc*dim + der)*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
957:                 }
958:               }
959:               for (der2 = der + 1; der2 < dim; ++der2) {
960:                 H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2] = 1.0;
961:                 for (d = 0; d < dim; ++d) {
962:                   if (d == der || d == der2) {
963:                     H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2] *= LD[(tup[d]*dim + d)*npoints + p];
964:                   } else {
965:                     H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2] *= LB[(tup[d]*dim + d)*npoints + p];
966:                   }
967:                 }
968:                 H[((p*pdim + i)*Nc*Nc*dim + der2) * dim + der] = H[((p*pdim + i)*Nc*Nc*dim + der) * dim + der2];
969:               }
970:             }
971:           }
972:           ++i;
973:         }
974:       }
975:     }
976:     /* Make direct sum basis for multicomponent space */
977:     for (p = 0; p < npoints; ++p) {
978:       for (i = 0; i < pdim; ++i) {
979:         for (c = 1; c < Nc; ++c) {
980:           for (d = 0; d < dim; ++d) {
981:             for (e = 0; e < dim; ++e) {
982:               H[(((p*pdim*Nc + i*Nc + c)*Nc + c)*dim + d)*dim + e] = H[((p*pdim + i)*Nc*Nc*dim + d)*dim + e];
983:             }
984:           }
985:         }
986:       }
987:     }
988:   }
989:   PetscFree2(ind,tup);
990:   if (B) {DMRestoreWorkArray(dm, npoints*dim*ndegree, MPIU_REAL, &LB);}
991:   if (D) {DMRestoreWorkArray(dm, npoints*dim*ndegree, MPIU_REAL, &LD);}
992:   if (H) {DMRestoreWorkArray(dm, npoints*dim*ndegree, MPIU_REAL, &LH);}
993:   DMRestoreWorkArray(dm, npoints*ndegree*3, MPIU_REAL, &tmp);
994:   DMRestoreWorkArray(dm, npoints, MPIU_REAL, &lpoints);
995:   return(0);
996: }

998: /*@
999:   PetscSpacePolynomialSetTensor - Set whether a function space is a space of tensor polynomials (the space is spanned
1000:   by polynomials whose degree in each variabl is bounded by the given order), as opposed to polynomials (the space is
1001:   spanned by polynomials whose total degree---summing over all variables---is bounded by the given order).

1003:   Input Parameters:
1004: + sp     - the function space object
1005: - tensor - PETSC_TRUE for a tensor polynomial space, PETSC_FALSE for a polynomial space

1007:   Level: beginner

1009: .seealso: PetscSpacePolynomialGetTensor(), PetscSpaceSetOrder(), PetscSpaceSetNumVariables()
1010: @*/
1011: PetscErrorCode PetscSpacePolynomialSetTensor(PetscSpace sp, PetscBool tensor)
1012: {

1017:   PetscTryMethod(sp,"PetscSpacePolynomialSetTensor_C",(PetscSpace,PetscBool),(sp,tensor));
1018:   return(0);
1019: }

1021: /*@
1022:   PetscSpacePolynomialGetTensor - Get whether a function space is a space of tensor polynomials (the space is spanned
1023:   by polynomials whose degree in each variabl is bounded by the given order), as opposed to polynomials (the space is
1024:   spanned by polynomials whose total degree---summing over all variables---is bounded by the given order).

1026:   Input Parameters:
1027: . sp     - the function space object

1029:   Output Parameters:
1030: . tensor - PETSC_TRUE for a tensor polynomial space, PETSC_FALSE for a polynomial space

1032:   Level: beginner

1034: .seealso: PetscSpacePolynomialSetTensor(), PetscSpaceSetOrder(), PetscSpaceSetNumVariables()
1035: @*/
1036: PetscErrorCode PetscSpacePolynomialGetTensor(PetscSpace sp, PetscBool *tensor)
1037: {

1043:   PetscTryMethod(sp,"PetscSpacePolynomialGetTensor_C",(PetscSpace,PetscBool*),(sp,tensor));
1044:   return(0);
1045: }

1047: static PetscErrorCode PetscSpacePolynomialSetTensor_Polynomial(PetscSpace sp, PetscBool tensor)
1048: {
1049:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

1052:   poly->tensor = tensor;
1053:   return(0);
1054: }

1056: static PetscErrorCode PetscSpacePolynomialGetTensor_Polynomial(PetscSpace sp, PetscBool *tensor)
1057: {
1058:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

1063:   *tensor = poly->tensor;
1064:   return(0);
1065: }

1067: static PetscErrorCode PetscSpaceGetHeightSubspace_Polynomial(PetscSpace sp, PetscInt height, PetscSpace *subsp)
1068: {
1069:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
1070:   PetscInt         Nc, dim, order;
1071:   PetscBool        tensor;
1072:   PetscErrorCode   ierr;

1075:   PetscSpaceGetNumComponents(sp, &Nc);
1076:   PetscSpaceGetNumVariables(sp, &dim);
1077:   PetscSpaceGetOrder(sp, &order);
1078:   PetscSpacePolynomialGetTensor(sp, &tensor);
1079:   if (height > dim || height < 0) {SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Asked for space at height %D for dimension %D space", height, dim);}
1080:   if (!poly->subspaces) {PetscCalloc1(dim, &poly->subspaces);}
1081:   if (height <= dim) {
1082:     if (!poly->subspaces[height-1]) {
1083:       PetscSpace sub;

1085:       PetscSpaceCreate(PetscObjectComm((PetscObject) sp), &sub);
1086:       PetscSpaceSetNumComponents(sub, Nc);
1087:       PetscSpaceSetOrder(sub, order);
1088:       PetscSpaceSetType(sub, PETSCSPACEPOLYNOMIAL);
1089:       PetscSpaceSetNumVariables(sub, dim-height);
1090:       PetscSpacePolynomialSetTensor(sub, tensor);
1091:       PetscSpaceSetUp(sub);
1092:       poly->subspaces[height-1] = sub;
1093:     }
1094:     *subsp = poly->subspaces[height-1];
1095:   } else {
1096:     *subsp = NULL;
1097:   }
1098:   return(0);
1099: }

1101: PetscErrorCode PetscSpaceInitialize_Polynomial(PetscSpace sp)
1102: {

1106:   sp->ops->setfromoptions    = PetscSpaceSetFromOptions_Polynomial;
1107:   sp->ops->setup             = PetscSpaceSetUp_Polynomial;
1108:   sp->ops->view              = PetscSpaceView_Polynomial;
1109:   sp->ops->destroy           = PetscSpaceDestroy_Polynomial;
1110:   sp->ops->getdimension      = PetscSpaceGetDimension_Polynomial;
1111:   sp->ops->evaluate          = PetscSpaceEvaluate_Polynomial;
1112:   sp->ops->getheightsubspace = PetscSpaceGetHeightSubspace_Polynomial;
1113:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", PetscSpacePolynomialGetTensor_Polynomial);
1114:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialSetTensor_C", PetscSpacePolynomialSetTensor_Polynomial);
1115:   return(0);
1116: }

1118: /*MC
1119:   PETSCSPACEPOLYNOMIAL = "poly" - A PetscSpace object that encapsulates a polynomial space, e.g. P1 is the space of
1120:   linear polynomials. The space is replicated for each component.

1122:   Level: intermediate

1124: .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
1125: M*/

1127: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_Polynomial(PetscSpace sp)
1128: {
1129:   PetscSpace_Poly *poly;
1130:   PetscErrorCode   ierr;

1134:   PetscNewLog(sp,&poly);
1135:   sp->data = poly;

1137:   poly->symmetric    = PETSC_FALSE;
1138:   poly->tensor       = PETSC_FALSE;
1139:   poly->degrees      = NULL;
1140:   poly->subspaces    = NULL;

1142:   PetscSpaceInitialize_Polynomial(sp);
1143:   return(0);
1144: }

1146: PetscErrorCode PetscSpacePolynomialSetSymmetric(PetscSpace sp, PetscBool sym)
1147: {
1148:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

1152:   poly->symmetric = sym;
1153:   return(0);
1154: }

1156: PetscErrorCode PetscSpacePolynomialGetSymmetric(PetscSpace sp, PetscBool *sym)
1157: {
1158:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

1163:   *sym = poly->symmetric;
1164:   return(0);
1165: }

1167: PetscErrorCode PetscSpacePointView_Ascii(PetscSpace sp, PetscViewer viewer)
1168: {
1169:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1170:   PetscViewerFormat format;
1171:   PetscErrorCode    ierr;

1174:   PetscViewerGetFormat(viewer, &format);
1175:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
1176:     PetscViewerASCIIPrintf(viewer, "Point space in dimension %d:\n", sp->Nv);
1177:     PetscViewerASCIIPushTab(viewer);
1178:     PetscQuadratureView(pt->quad, viewer);
1179:     PetscViewerASCIIPopTab(viewer);
1180:   } else {
1181:     PetscViewerASCIIPrintf(viewer, "Point space in dimension %d on %d points\n", sp->Nv, pt->quad->numPoints);
1182:   }
1183:   return(0);
1184: }

1186: PetscErrorCode PetscSpaceView_Point(PetscSpace sp, PetscViewer viewer)
1187: {
1188:   PetscBool      iascii;

1194:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
1195:   if (iascii) {PetscSpacePointView_Ascii(sp, viewer);}
1196:   return(0);
1197: }

1199: PetscErrorCode PetscSpaceSetUp_Point(PetscSpace sp)
1200: {
1201:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1202:   PetscErrorCode    ierr;

1205:   if (!pt->quad->points && sp->order >= 0) {
1206:     PetscQuadratureDestroy(&pt->quad);
1207:     PetscDTGaussJacobiQuadrature(sp->Nv, sp->Nc, PetscMax(sp->order + 1, 1), -1.0, 1.0, &pt->quad);
1208:   }
1209:   return(0);
1210: }

1212: PetscErrorCode PetscSpaceDestroy_Point(PetscSpace sp)
1213: {
1214:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1215:   PetscErrorCode    ierr;

1218:   PetscQuadratureDestroy(&pt->quad);
1219:   PetscFree(pt);
1220:   return(0);
1221: }

1223: PetscErrorCode PetscSpaceGetDimension_Point(PetscSpace sp, PetscInt *dim)
1224: {
1225:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;

1228:   *dim = pt->quad->numPoints;
1229:   return(0);
1230: }

1232: PetscErrorCode PetscSpaceEvaluate_Point(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
1233: {
1234:   PetscSpace_Point *pt  = (PetscSpace_Point *) sp->data;
1235:   PetscInt          dim = sp->Nv, pdim = pt->quad->numPoints, d, p, i, c;
1236:   PetscErrorCode    ierr;

1239:   if (npoints != pt->quad->numPoints) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot evaluate Point space on %d points != %d size", npoints, pt->quad->numPoints);
1240:   PetscMemzero(B, npoints*pdim * sizeof(PetscReal));
1241:   for (p = 0; p < npoints; ++p) {
1242:     for (i = 0; i < pdim; ++i) {
1243:       for (d = 0; d < dim; ++d) {
1244:         if (PetscAbsReal(points[p*dim+d] - pt->quad->points[p*dim+d]) > 1.0e-10) break;
1245:       }
1246:       if (d >= dim) {B[p*pdim+i] = 1.0; break;}
1247:     }
1248:   }
1249:   /* Replicate for other components */
1250:   for (c = 1; c < sp->Nc; ++c) {
1251:     for (p = 0; p < npoints; ++p) {
1252:       for (i = 0; i < pdim; ++i) {
1253:         B[(c*npoints + p)*pdim + i] = B[p*pdim + i];
1254:       }
1255:     }
1256:   }
1257:   if (D) {PetscMemzero(D, npoints*pdim*dim * sizeof(PetscReal));}
1258:   if (H) {PetscMemzero(H, npoints*pdim*dim*dim * sizeof(PetscReal));}
1259:   return(0);
1260: }

1262: PetscErrorCode PetscSpaceInitialize_Point(PetscSpace sp)
1263: {
1265:   sp->ops->setfromoptions = NULL;
1266:   sp->ops->setup          = PetscSpaceSetUp_Point;
1267:   sp->ops->view           = PetscSpaceView_Point;
1268:   sp->ops->destroy        = PetscSpaceDestroy_Point;
1269:   sp->ops->getdimension   = PetscSpaceGetDimension_Point;
1270:   sp->ops->evaluate       = PetscSpaceEvaluate_Point;
1271:   return(0);
1272: }

1274: /*MC
1275:   PETSCSPACEPOINT = "point" - A PetscSpace object that encapsulates functions defined on a set of quadrature points.

1277:   Level: intermediate

1279: .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
1280: M*/

1282: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_Point(PetscSpace sp)
1283: {
1284:   PetscSpace_Point *pt;
1285:   PetscErrorCode    ierr;

1289:   PetscNewLog(sp,&pt);
1290:   sp->data = pt;

1292:   sp->Nv = 0;
1293:   PetscQuadratureCreate(PETSC_COMM_SELF, &pt->quad);
1294:   PetscQuadratureSetData(pt->quad, 0, 1, 0, NULL, NULL);

1296:   PetscSpaceInitialize_Point(sp);
1297:   return(0);
1298: }

1300: /*@
1301:   PetscSpacePointSetPoints - Sets the evaluation points for the space to coincide with the points of a quadrature rule

1303:   Logically collective

1305:   Input Parameters:
1306: + sp - The PetscSpace
1307: - q  - The PetscQuadrature defining the points

1309:   Level: intermediate

1311: .keywords: PetscSpacePoint
1312: .seealso: PetscSpaceCreate(), PetscSpaceSetType()
1313: @*/
1314: PetscErrorCode PetscSpacePointSetPoints(PetscSpace sp, PetscQuadrature q)
1315: {
1316:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1317:   PetscErrorCode    ierr;

1322:   PetscQuadratureDestroy(&pt->quad);
1323:   PetscQuadratureDuplicate(q, &pt->quad);
1324:   return(0);
1325: }

1327: /*@
1328:   PetscSpacePointGetPoints - Gets the evaluation points for the space as the points of a quadrature rule

1330:   Logically collective

1332:   Input Parameter:
1333: . sp - The PetscSpace

1335:   Output Parameter:
1336: . q  - The PetscQuadrature defining the points

1338:   Level: intermediate

1340: .keywords: PetscSpacePoint
1341: .seealso: PetscSpaceCreate(), PetscSpaceSetType()
1342: @*/
1343: PetscErrorCode PetscSpacePointGetPoints(PetscSpace sp, PetscQuadrature *q)
1344: {
1345:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;

1350:   *q = pt->quad;
1351:   return(0);
1352: }

1354: typedef struct {
1355:   PetscDualSpace dualSubspace;
1356:   PetscSpace     origSpace;
1357:   PetscReal      *x;
1358:   PetscReal      *x_alloc;
1359:   PetscReal      *Jx;
1360:   PetscReal      *Jx_alloc;
1361:   PetscReal      *u;
1362:   PetscReal      *u_alloc;
1363:   PetscReal      *Ju;
1364:   PetscReal      *Ju_alloc;
1365:   PetscReal      *Q;
1366:   PetscInt       Nb;
1367: } PetscSpace_Subspace;

1369: static PetscErrorCode PetscSpaceDestroy_Subspace(PetscSpace sp)
1370: {
1371:   PetscSpace_Subspace *subsp;
1372:   PetscErrorCode      ierr;

1375:   subsp = (PetscSpace_Subspace *) sp->data;
1376:   subsp->x = NULL;
1377:   PetscFree(subsp->x_alloc);
1378:   subsp->Jx = NULL;
1379:   PetscFree(subsp->Jx_alloc);
1380:   subsp->u = NULL;
1381:   PetscFree(subsp->u_alloc);
1382:   subsp->Ju = NULL;
1383:   PetscFree(subsp->Ju_alloc);
1384:   PetscFree(subsp->Q);
1385:   PetscSpaceDestroy(&subsp->origSpace);
1386:   PetscDualSpaceDestroy(&subsp->dualSubspace);
1387:   PetscFree(subsp);
1388:   sp->data = NULL;
1389:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", NULL);
1390:   return(0);
1391: }

1393: static PetscErrorCode PetscSpaceView_Subspace(PetscSpace sp, PetscViewer viewer)
1394: {
1395:   PetscBool           iascii;
1396:   PetscSpace_Subspace *subsp;
1397:   PetscErrorCode      ierr;

1400:   subsp = (PetscSpace_Subspace *) sp->data;
1401:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
1402:   if (iascii) {
1403:     PetscInt origDim, subDim, origNc, subNc, o, s;

1405:     PetscSpaceGetNumVariables(subsp->origSpace,&origDim);
1406:     PetscSpaceGetNumComponents(subsp->origSpace,&origNc);
1407:     PetscSpaceGetNumVariables(sp,&subDim);
1408:     PetscSpaceGetNumComponents(sp,&subNc);
1409:     if (subsp->x) {
1410:       PetscViewerASCIIPrintf(viewer,"Subspace-to-space domain shift:\n\n");
1411:       for (o = 0; o < origDim; o++) {
1412:         PetscViewerASCIIPrintf(viewer," %g\n", (double)subsp->x[o]);
1413:       }
1414:     }
1415:     if (subsp->Jx) {
1416:       PetscViewerASCIIPrintf(viewer,"Subspace-to-space domain transform:\n\n");
1417:       for (o = 0; o < origDim; o++) {
1418:         PetscViewerASCIIPrintf(viewer," %g", (double)subsp->Jx[o * subDim + 0]);
1419:         PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
1420:         for (s = 1; s < subDim; s++) {
1421:           PetscViewerASCIIPrintf(viewer," %g", (double)subsp->Jx[o * subDim + s]);
1422:         }
1423:         PetscViewerASCIIPrintf(viewer,"\n");
1424:         PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
1425:       }
1426:     }
1427:     if (subsp->u) {
1428:       PetscViewerASCIIPrintf(viewer,"Space-to-subspace range shift:\n\n");
1429:       for (o = 0; o < origNc; o++) {
1430:         PetscViewerASCIIPrintf(viewer," %d\n", subsp->u[o]);
1431:       }
1432:     }
1433:     if (subsp->Ju) {
1434:       PetscViewerASCIIPrintf(viewer,"Space-to-subsace domain transform:\n");
1435:       for (o = 0; o < origNc; o++) {
1436:         PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);
1437:         for (s = 0; s < subNc; s++) {
1438:           PetscViewerASCIIPrintf(viewer," %d", subsp->Ju[o * subNc + s]);
1439:         }
1440:         PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);
1441:       }
1442:       PetscViewerASCIIPrintf(viewer,"\n");
1443:     }
1444:     PetscViewerASCIIPrintf(viewer,"Original space:\n");
1445:   }
1446:   PetscViewerASCIIPushTab(viewer);
1447:   PetscSpaceView(subsp->origSpace,viewer);
1448:   PetscViewerASCIIPopTab(viewer);
1449:   return(0);
1450: }

1452: static PetscErrorCode PetscSpaceEvaluate_Subspace(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
1453: {
1454:   PetscSpace_Subspace *subsp = (PetscSpace_Subspace *) sp->data;
1455:   PetscSpace          origsp;
1456:   PetscInt            origDim, subDim, origNc, subNc, subNb, origNb, i, j, k, l, m, n, o;
1457:   PetscReal           *inpoints, *inB = NULL, *inD = NULL, *inH = NULL;
1458:   PetscErrorCode      ierr;

1461:   origsp = subsp->origSpace;
1462:   PetscSpaceGetNumVariables(sp,&subDim);
1463:   PetscSpaceGetNumVariables(origsp,&origDim);
1464:   PetscSpaceGetNumComponents(sp,&subNc);
1465:   PetscSpaceGetNumComponents(origsp,&origNc);
1466:   PetscSpaceGetDimension(sp,&subNb);
1467:   PetscSpaceGetDimension(origsp,&origNb);
1468:   DMGetWorkArray(sp->dm,npoints*origDim,MPIU_REAL,&inpoints);
1469:   for (i = 0; i < npoints; i++) {
1470:     if (subsp->x) {
1471:       for (j = 0; j < origDim; j++) inpoints[i * origDim + j] = subsp->x[j];
1472:     } else {
1473:       for (j = 0; j < origDim; j++) inpoints[i * origDim + j] = 0.0;
1474:     }
1475:     if (subsp->Jx) {
1476:       for (j = 0; j < origDim; j++) {
1477:         for (k = 0; k < subDim; k++) {
1478:           inpoints[i * origDim + j] += subsp->Jx[j * subDim + k] * points[i * subDim + k];
1479:         }
1480:       }
1481:     } else {
1482:       for (j = 0; j < PetscMin(subDim, origDim); j++) {
1483:         inpoints[i * origDim + j] += points[i * subDim + j];
1484:       }
1485:     }
1486:   }
1487:   if (B) {
1488:     DMGetWorkArray(sp->dm,npoints*origNb*origNc,MPIU_REAL,&inB);
1489:   }
1490:   if (D) {
1491:     DMGetWorkArray(sp->dm,npoints*origNb*origNc*origDim,MPIU_REAL,&inD);
1492:   }
1493:   if (H) {
1494:     DMGetWorkArray(sp->dm,npoints*origNb*origNc*origDim*origDim,MPIU_REAL,&inH);
1495:   }
1496:   PetscSpaceEvaluate(origsp,npoints,inpoints,inB,inD,inH);
1497:   if (H) {
1498:     PetscReal *phi, *psi;

1500:     DMGetWorkArray(sp->dm,origNc*origDim*origDim,MPIU_REAL,&phi);
1501:     DMGetWorkArray(sp->dm,origNc*subDim*subDim,MPIU_REAL,&psi);
1502:     for (i = 0; i < npoints * subNb * subNc * subDim; i++) D[i] = 0.0;
1503:     for (i = 0; i < subNb; i++) {
1504:       const PetscReal *subq = &subsp->Q[i * origNb];

1506:       for (j = 0; j < npoints; j++) {
1507:         for (k = 0; k < origNc * origDim; k++) phi[k] = 0.;
1508:         for (k = 0; k < origNc * subDim; k++) psi[k] = 0.;
1509:         for (k = 0; k < origNb; k++) {
1510:           for (l = 0; l < origNc * origDim * origDim; l++) {
1511:             phi[l] += inH[(j * origNb + k) * origNc * origDim * origDim + l] * subq[k];
1512:           }
1513:         }
1514:         if (subsp->Jx) {
1515:           for (k = 0; k < subNc; k++) {
1516:             for (l = 0; l < subDim; l++) {
1517:               for (m = 0; m < origDim; m++) {
1518:                 for (n = 0; n < subDim; n++) {
1519:                   for (o = 0; o < origDim; o++) {
1520:                     psi[(k * subDim + l) * subDim + n] += subsp->Jx[m * subDim + l] * subsp->Jx[o * subDim + n] * phi[(k * origDim + m) * origDim + o];
1521:                   }
1522:                 }
1523:               }
1524:             }
1525:           }
1526:         } else {
1527:           for (k = 0; k < subNc; k++) {
1528:             for (l = 0; l < PetscMin(subDim, origDim); l++) {
1529:               for (m = 0; m < PetscMin(subDim, origDim); m++) {
1530:                 psi[(k * subDim + l) * subDim + m] += phi[(k * origDim + l) * origDim + m];
1531:               }
1532:             }
1533:           }
1534:         }
1535:         if (subsp->Ju) {
1536:           for (k = 0; k < subNc; k++) {
1537:             for (l = 0; l < origNc; l++) {
1538:               for (m = 0; m < subDim * subDim; m++) {
1539:                 H[((j * subNb + i) * subNc + k) * subDim * subDim + m] += subsp->Ju[k * origNc + l] * psi[l * subDim * subDim + m];
1540:               }
1541:             }
1542:           }
1543:         }
1544:         else {
1545:           for (k = 0; k < PetscMin(subNc, origNc); k++) {
1546:             for (l = 0; l < subDim * subDim; l++) {
1547:               H[((j * subNb + i) * subNc + k) * subDim * subDim + l] += psi[k * subDim * subDim + l];
1548:             }
1549:           }
1550:         }
1551:       }
1552:     }
1553:     DMRestoreWorkArray(sp->dm,subNc*origDim,MPIU_REAL,&psi);
1554:     DMRestoreWorkArray(sp->dm,origNc*origDim,MPIU_REAL,&phi);
1555:     DMRestoreWorkArray(sp->dm,npoints*origNb*origNc*origDim,MPIU_REAL,&inH);
1556:   }
1557:   if (D) {
1558:     PetscReal *phi, *psi;

1560:     DMGetWorkArray(sp->dm,origNc*origDim,MPIU_REAL,&phi);
1561:     DMGetWorkArray(sp->dm,origNc*subDim,MPIU_REAL,&psi);
1562:     for (i = 0; i < npoints * subNb * subNc * subDim; i++) D[i] = 0.0;
1563:     for (i = 0; i < subNb; i++) {
1564:       const PetscReal *subq = &subsp->Q[i * origNb];

1566:       for (j = 0; j < npoints; j++) {
1567:         for (k = 0; k < origNc * origDim; k++) phi[k] = 0.;
1568:         for (k = 0; k < origNc * subDim; k++) psi[k] = 0.;
1569:         for (k = 0; k < origNb; k++) {
1570:           for (l = 0; l < origNc * origDim; l++) {
1571:             phi[l] += inD[(j * origNb + k) * origNc * origDim + l] * subq[k];
1572:           }
1573:         }
1574:         if (subsp->Jx) {
1575:           for (k = 0; k < subNc; k++) {
1576:             for (l = 0; l < subDim; l++) {
1577:               for (m = 0; m < origDim; m++) {
1578:                 psi[k * subDim + l] += subsp->Jx[m * subDim + l] * phi[k * origDim + m];
1579:               }
1580:             }
1581:           }
1582:         } else {
1583:           for (k = 0; k < subNc; k++) {
1584:             for (l = 0; l < PetscMin(subDim, origDim); l++) {
1585:               psi[k * subDim + l] += phi[k * origDim + l];
1586:             }
1587:           }
1588:         }
1589:         if (subsp->Ju) {
1590:           for (k = 0; k < subNc; k++) {
1591:             for (l = 0; l < origNc; l++) {
1592:               for (m = 0; m < subDim; m++) {
1593:                 D[((j * subNb + i) * subNc + k) * subDim + m] += subsp->Ju[k * origNc + l] * psi[l * subDim + m];
1594:               }
1595:             }
1596:           }
1597:         }
1598:         else {
1599:           for (k = 0; k < PetscMin(subNc, origNc); k++) {
1600:             for (l = 0; l < subDim; l++) {
1601:               D[((j * subNb + i) * subNc + k) * subDim + l] += psi[k * subDim + l];
1602:             }
1603:           }
1604:         }
1605:       }
1606:     }
1607:     DMRestoreWorkArray(sp->dm,subNc*origDim,MPIU_REAL,&psi);
1608:     DMRestoreWorkArray(sp->dm,origNc*origDim,MPIU_REAL,&phi);
1609:     DMRestoreWorkArray(sp->dm,npoints*origNb*origNc*origDim,MPIU_REAL,&inD);
1610:   }
1611:   if (B) {
1612:     PetscReal *phi;

1614:     DMGetWorkArray(sp->dm,origNc,MPIU_REAL,&phi);
1615:     if (subsp->u) {
1616:       for (i = 0; i < npoints * subNb; i++) {
1617:         for (j = 0; j < subNc; j++) B[i * subNc + j] = subsp->u[j];
1618:       }
1619:     } else {
1620:       for (i = 0; i < npoints * subNb * subNc; i++) B[i] = 0.0;
1621:     }
1622:     for (i = 0; i < subNb; i++) {
1623:       const PetscReal *subq = &subsp->Q[i * origNb];

1625:       for (j = 0; j < npoints; j++) {
1626:         for (k = 0; k < origNc; k++) phi[k] = 0.;
1627:         for (k = 0; k < origNb; k++) {
1628:           for (l = 0; l < origNc; l++) {
1629:             phi[l] += inB[(j * origNb + k) * origNc + l] * subq[k];
1630:           }
1631:         }
1632:         if (subsp->Ju) {
1633:           for (k = 0; k < subNc; k++) {
1634:             for (l = 0; l < origNc; l++) {
1635:               B[(j * subNb + i) * subNc + k] += subsp->Ju[k * origNc + l] * phi[l];
1636:             }
1637:           }
1638:         }
1639:         else {
1640:           for (k = 0; k < PetscMin(subNc, origNc); k++) {
1641:             B[(j * subNb + i) * subNc + k] += phi[k];
1642:           }
1643:         }
1644:       }
1645:     }
1646:     DMRestoreWorkArray(sp->dm,origNc,MPIU_REAL,&phi);
1647:     DMRestoreWorkArray(sp->dm,npoints*origNb*origNc,MPIU_REAL,&inB);
1648:   }
1649:   DMRestoreWorkArray(sp->dm,npoints*origDim,MPIU_REAL,&inpoints);
1650:   return(0);
1651: }

1653: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_Subspace(PetscSpace sp)
1654: {
1655:   PetscSpace_Subspace *subsp;

1658:   PetscNewLog(sp,&subsp);
1659:   sp->data = (void *) subsp;
1660:   return(0);
1661: }

1663: static PetscErrorCode PetscSpaceGetDimension_Subspace(PetscSpace sp, PetscInt *dim)
1664: {
1665:   PetscSpace_Subspace *subsp;

1668:   subsp = (PetscSpace_Subspace *) sp->data;
1669:   *dim = subsp->Nb;
1670:   return(0);
1671: }

1673: static PetscErrorCode PetscSpaceSetUp_Subspace(PetscSpace sp)
1674: {
1675:   const PetscReal     *x;
1676:   const PetscReal     *Jx;
1677:   const PetscReal     *u;
1678:   const PetscReal     *Ju;
1679:   PetscDualSpace      dualSubspace;
1680:   PetscSpace          origSpace;
1681:   PetscInt            origDim, subDim, origNc, subNc, origNb, subNb, f, i, j, numPoints, offset;
1682:   PetscReal           *allPoints, *allWeights, *B, *V;
1683:   DM                  dm;
1684:   PetscSpace_Subspace *subsp;
1685:   PetscErrorCode      ierr;

1688:   subsp = (PetscSpace_Subspace *) sp->data;
1689:   x            = subsp->x;
1690:   Jx           = subsp->Jx;
1691:   u            = subsp->u;
1692:   Ju           = subsp->Ju;
1693:   origSpace    = subsp->origSpace;
1694:   dualSubspace = subsp->dualSubspace;
1695:   PetscSpaceGetNumComponents(origSpace,&origNc);
1696:   PetscSpaceGetNumVariables(origSpace,&origDim);
1697:   PetscDualSpaceGetDM(dualSubspace,&dm);
1698:   DMGetDimension(dm,&subDim);
1699:   PetscSpaceGetDimension(origSpace,&origNb);
1700:   PetscDualSpaceGetDimension(dualSubspace,&subNb);
1701:   PetscDualSpaceGetNumComponents(dualSubspace,&subNc);

1703:   for (f = 0, numPoints = 0; f < subNb; f++) {
1704:     PetscQuadrature q;
1705:     PetscInt        qNp;

1707:     PetscDualSpaceGetFunctional(dualSubspace,f,&q);
1708:     PetscQuadratureGetData(q,NULL,NULL,&qNp,NULL,NULL);
1709:     numPoints += qNp;
1710:   }
1711:   PetscMalloc1(subNb*origNb,&V);
1712:   PetscMalloc3(numPoints*origDim,&allPoints,numPoints*origNc,&allWeights,numPoints*origNb*origNc,&B);
1713:   for (f = 0, offset = 0; f < subNb; f++) {
1714:     PetscQuadrature q;
1715:     PetscInt        qNp, p;
1716:     const PetscReal *qp;
1717:     const PetscReal *qw;

1719:     PetscDualSpaceGetFunctional(dualSubspace,f,&q);
1720:     PetscQuadratureGetData(q,NULL,NULL,&qNp,&qp,&qw);
1721:     for (p = 0; p < qNp; p++, offset++) {
1722:       if (x) {
1723:         for (i = 0; i < origDim; i++) allPoints[origDim * offset + i] = x[i];
1724:       } else {
1725:         for (i = 0; i < origDim; i++) allPoints[origDim * offset + i] = 0.0;
1726:       }
1727:       if (Jx) {
1728:         for (i = 0; i < origDim; i++) {
1729:           for (j = 0; j < subDim; j++) {
1730:             allPoints[origDim * offset + i] += Jx[i * subDim + j] * qp[j];
1731:           }
1732:         }
1733:       } else {
1734:         for (i = 0; i < PetscMin(subDim, origDim); i++) allPoints[origDim * offset + i] += qp[i];
1735:       }
1736:       for (i = 0; i < origNc; i++) allWeights[origNc * offset + i] = 0.0;
1737:       if (Ju) {
1738:         for (i = 0; i < origNc; i++) {
1739:           for (j = 0; j < subNc; j++) {
1740:             allWeights[offset * origNc + i] += qw[j] * Ju[j * origNc + i];
1741:           }
1742:         }
1743:       } else {
1744:         for (i = 0; i < PetscMin(subNc, origNc); i++) allWeights[offset * origNc + i] += qw[i];
1745:       }
1746:     }
1747:   }
1748:   PetscSpaceEvaluate(origSpace,numPoints,allPoints,B,NULL,NULL);
1749:   for (f = 0, offset = 0; f < subNb; f++) {
1750:     PetscInt b, p, s, qNp;
1751:     PetscQuadrature q;
1752:     const PetscReal *qw;

1754:     PetscDualSpaceGetFunctional(dualSubspace,f,&q);
1755:     PetscQuadratureGetData(q,NULL,NULL,&qNp,NULL,&qw);
1756:     if (u) {
1757:       for (b = 0; b < origNb; b++) {
1758:         for (s = 0; s < subNc; s++) {
1759:           V[f * origNb + b] += qw[s] * u[s];
1760:         }
1761:       }
1762:     } else {
1763:       for (b = 0; b < origNb; b++) V[f * origNb + b] = 0.0;
1764:     }
1765:     for (p = 0; p < qNp; p++, offset++) {
1766:       for (b = 0; b < origNb; b++) {
1767:         for (s = 0; s < origNc; s++) {
1768:           V[f * origNb + b] += B[(offset * origNb + b) * origNc + s] * allWeights[offset * origNc + s];
1769:         }
1770:       }
1771:     }
1772:   }
1773:   /* orthnormalize rows of V */
1774:   for (f = 0; f < subNb; f++) {
1775:     PetscReal rho = 0.0, scal;

1777:     for (i = 0; i < origNb; i++) rho += PetscSqr(V[f * origNb + i]);

1779:     scal = 1. / PetscSqrtReal(rho);

1781:     for (i = 0; i < origNb; i++) V[f * origNb + i] *= scal;
1782:     for (j = f + 1; j < subNb; j++) {
1783:       for (i = 0, scal = 0.; i < origNb; i++) scal += V[f * origNb + i] * V[j * origNb + i];
1784:       for (i = 0; i < origNb; i++) V[j * origNb + i] -= V[f * origNb + i] * scal;
1785:     }
1786:   }
1787:   PetscFree3(allPoints,allWeights,B);
1788:   subsp->Q = V;
1789:   return(0);
1790: }

1792: static PetscErrorCode PetscSpacePolynomialGetTensor_Subspace(PetscSpace sp, PetscBool *poly)
1793: {
1794:   PetscSpace_Subspace *subsp = (PetscSpace_Subspace *) sp->data;

1798:   *poly = PETSC_FALSE;
1799:   PetscSpacePolynomialGetTensor(subsp->origSpace,poly);
1800:   if (*poly) {
1801:     if (subsp->Jx) {
1802:       PetscInt subDim, origDim, i, j;
1803:       PetscInt maxnnz;

1805:       PetscSpaceGetNumVariables(subsp->origSpace,&origDim);
1806:       PetscSpaceGetNumVariables(sp,&subDim);
1807:       maxnnz = 0;
1808:       for (i = 0; i < origDim; i++) {
1809:         PetscInt nnz = 0;

1811:         for (j = 0; j < subDim; j++) nnz += (subsp->Jx[i * subDim + j] != 0.);
1812:         maxnnz = PetscMax(maxnnz,nnz);
1813:       }
1814:       for (j = 0; j < subDim; j++) {
1815:         PetscInt nnz = 0;

1817:         for (i = 0; i < origDim; i++) nnz += (subsp->Jx[i * subDim + j] != 0.);
1818:         maxnnz = PetscMax(maxnnz,nnz);
1819:       }
1820:       if (maxnnz > 1) *poly = PETSC_FALSE;
1821:     }
1822:   }
1823:   return(0);
1824: }

1826: static PetscErrorCode PetscSpaceInitialize_Subspace(PetscSpace sp)
1827: {

1831:   sp->ops->setup = PetscSpaceSetUp_Subspace;
1832:   sp->ops->view  = PetscSpaceView_Subspace;
1833:   sp->ops->destroy  = PetscSpaceDestroy_Subspace;
1834:   sp->ops->getdimension  = PetscSpaceGetDimension_Subspace;
1835:   sp->ops->evaluate = PetscSpaceEvaluate_Subspace;
1836:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", PetscSpacePolynomialGetTensor_Subspace);
1837:   return(0);
1838: }

1840: PetscErrorCode PetscSpaceCreateSubspace(PetscSpace origSpace, PetscDualSpace dualSubspace, PetscReal *x, PetscReal *Jx, PetscReal *u, PetscReal *Ju, PetscCopyMode copymode, PetscSpace *subspace)
1841: {
1842:   PetscSpace_Subspace *subsp;
1843:   PetscInt            origDim, subDim, origNc, subNc, subNb;
1844:   PetscInt            order;
1845:   DM                  dm;
1846:   PetscErrorCode      ierr;

1856:   PetscSpaceGetNumComponents(origSpace,&origNc);
1857:   PetscSpaceGetNumVariables(origSpace,&origDim);
1858:   PetscDualSpaceGetDM(dualSubspace,&dm);
1859:   DMGetDimension(dm,&subDim);
1860:   PetscDualSpaceGetDimension(dualSubspace,&subNb);
1861:   PetscDualSpaceGetNumComponents(dualSubspace,&subNc);
1862:   PetscSpaceCreate(PetscObjectComm((PetscObject)origSpace),subspace);
1863:   PetscSpaceSetType(*subspace,PETSCSPACESUBSPACE);
1864:   PetscSpaceSetNumVariables(*subspace,subDim);
1865:   PetscSpaceSetNumComponents(*subspace,subNc);
1866:   PetscSpaceGetOrder(origSpace,&order);
1867:   PetscSpaceSetOrder(*subspace,order);
1868:   subsp = (PetscSpace_Subspace *) (*subspace)->data;
1869:   subsp->Nb = subNb;
1870:   switch (copymode) {
1871:   case PETSC_OWN_POINTER:
1872:     if (x) subsp->x_alloc = x;
1873:     if (Jx) subsp->Jx_alloc = Jx;
1874:     if (u) subsp->u_alloc = u;
1875:     if (Ju) subsp->Ju_alloc = Ju;
1876:   case PETSC_USE_POINTER:
1877:     if (x) subsp->x = x;
1878:     if (Jx) subsp->Jx = Jx;
1879:     if (u) subsp->u = u;
1880:     if (Ju) subsp->Ju = Ju;
1881:     break;
1882:   case PETSC_COPY_VALUES:
1883:     if (x) {
1884:       PetscMalloc1(origDim,&subsp->x_alloc);
1885:       PetscMemcpy(subsp->x_alloc,x,origDim*sizeof(*subsp->x_alloc));
1886:       subsp->x = subsp->x_alloc;
1887:     }
1888:     if (Jx) {
1889:       PetscMalloc1(origDim * subDim,&subsp->Jx_alloc);
1890:       PetscMemcpy(subsp->Jx_alloc,Jx,origDim * subDim*sizeof(*subsp->Jx_alloc));
1891:       subsp->Jx = subsp->Jx_alloc;
1892:     }
1893:     if (u) {
1894:       PetscMalloc1(subNc,&subsp->u_alloc);
1895:       PetscMemcpy(subsp->u_alloc,u,subNc*sizeof(*subsp->u_alloc));
1896:       subsp->u = subsp->u_alloc;
1897:     }
1898:     if (Ju) {
1899:       PetscMalloc1(origNc * subNc,&subsp->Ju_alloc);
1900:       PetscMemcpy(subsp->Ju_alloc,Ju,origNc * subNc*sizeof(*subsp->Ju_alloc));
1901:       subsp->Ju = subsp->Ju_alloc;
1902:     }
1903:     break;
1904:   default:
1905:     SETERRQ(PetscObjectComm((PetscObject)origSpace),PETSC_ERR_ARG_OUTOFRANGE,"Unknown copy mode");
1906:   }
1907:   PetscObjectReference((PetscObject)origSpace);
1908:   subsp->origSpace = origSpace;
1909:   PetscObjectReference((PetscObject)dualSubspace);
1910:   subsp->dualSubspace = dualSubspace;
1911:   PetscSpaceInitialize_Subspace(*subspace);
1912:   return(0);
1913: }

1915: PetscClassId PETSCDUALSPACE_CLASSID = 0;

1917: PetscFunctionList PetscDualSpaceList              = NULL;
1918: PetscBool         PetscDualSpaceRegisterAllCalled = PETSC_FALSE;

1920: /*@C
1921:   PetscDualSpaceRegister - Adds a new PetscDualSpace implementation

1923:   Not Collective

1925:   Input Parameters:
1926: + name        - The name of a new user-defined creation routine
1927: - create_func - The creation routine itself

1929:   Notes:
1930:   PetscDualSpaceRegister() may be called multiple times to add several user-defined PetscDualSpaces

1932:   Sample usage:
1933: .vb
1934:     PetscDualSpaceRegister("my_space", MyPetscDualSpaceCreate);
1935: .ve

1937:   Then, your PetscDualSpace type can be chosen with the procedural interface via
1938: .vb
1939:     PetscDualSpaceCreate(MPI_Comm, PetscDualSpace *);
1940:     PetscDualSpaceSetType(PetscDualSpace, "my_dual_space");
1941: .ve
1942:    or at runtime via the option
1943: .vb
1944:     -petscdualspace_type my_dual_space
1945: .ve

1947:   Level: advanced

1949: .keywords: PetscDualSpace, register
1950: .seealso: PetscDualSpaceRegisterAll(), PetscDualSpaceRegisterDestroy()

1952: @*/
1953: PetscErrorCode PetscDualSpaceRegister(const char sname[], PetscErrorCode (*function)(PetscDualSpace))
1954: {

1958:   PetscFunctionListAdd(&PetscDualSpaceList, sname, function);
1959:   return(0);
1960: }

1962: /*@C
1963:   PetscDualSpaceSetType - Builds a particular PetscDualSpace

1965:   Collective on PetscDualSpace

1967:   Input Parameters:
1968: + sp   - The PetscDualSpace object
1969: - name - The kind of space

1971:   Options Database Key:
1972: . -petscdualspace_type <type> - Sets the PetscDualSpace type; use -help for a list of available types

1974:   Level: intermediate

1976: .keywords: PetscDualSpace, set, type
1977: .seealso: PetscDualSpaceGetType(), PetscDualSpaceCreate()
1978: @*/
1979: PetscErrorCode PetscDualSpaceSetType(PetscDualSpace sp, PetscDualSpaceType name)
1980: {
1981:   PetscErrorCode (*r)(PetscDualSpace);
1982:   PetscBool      match;

1987:   PetscObjectTypeCompare((PetscObject) sp, name, &match);
1988:   if (match) return(0);

1990:   if (!PetscDualSpaceRegisterAllCalled) {PetscDualSpaceRegisterAll();}
1991:   PetscFunctionListFind(PetscDualSpaceList, name, &r);
1992:   if (!r) SETERRQ1(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown PetscDualSpace type: %s", name);

1994:   if (sp->ops->destroy) {
1995:     (*sp->ops->destroy)(sp);
1996:     sp->ops->destroy = NULL;
1997:   }
1998:   (*r)(sp);
1999:   PetscObjectChangeTypeName((PetscObject) sp, name);
2000:   return(0);
2001: }

2003: /*@C
2004:   PetscDualSpaceGetType - Gets the PetscDualSpace type name (as a string) from the object.

2006:   Not Collective

2008:   Input Parameter:
2009: . sp  - The PetscDualSpace

2011:   Output Parameter:
2012: . name - The PetscDualSpace type name

2014:   Level: intermediate

2016: .keywords: PetscDualSpace, get, type, name
2017: .seealso: PetscDualSpaceSetType(), PetscDualSpaceCreate()
2018: @*/
2019: PetscErrorCode PetscDualSpaceGetType(PetscDualSpace sp, PetscDualSpaceType *name)
2020: {

2026:   if (!PetscDualSpaceRegisterAllCalled) {
2027:     PetscDualSpaceRegisterAll();
2028:   }
2029:   *name = ((PetscObject) sp)->type_name;
2030:   return(0);
2031: }

2033: /*@
2034:   PetscDualSpaceView - Views a PetscDualSpace

2036:   Collective on PetscDualSpace

2038:   Input Parameter:
2039: + sp - the PetscDualSpace object to view
2040: - v  - the viewer

2042:   Level: developer

2044: .seealso PetscDualSpaceDestroy()
2045: @*/
2046: PetscErrorCode PetscDualSpaceView(PetscDualSpace sp, PetscViewer v)
2047: {

2052:   if (!v) {PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) sp), &v);}
2053:   if (sp->ops->view) {(*sp->ops->view)(sp, v);}
2054:   return(0);
2055: }

2057: /*@
2058:   PetscDualSpaceSetFromOptions - sets parameters in a PetscDualSpace from the options database

2060:   Collective on PetscDualSpace

2062:   Input Parameter:
2063: . sp - the PetscDualSpace object to set options for

2065:   Options Database:
2066: . -petscspace_order the approximation order of the space

2068:   Level: developer

2070: .seealso PetscDualSpaceView()
2071: @*/
2072: PetscErrorCode PetscDualSpaceSetFromOptions(PetscDualSpace sp)
2073: {
2074:   const char    *defaultType;
2075:   char           name[256];
2076:   PetscBool      flg;

2081:   if (!((PetscObject) sp)->type_name) {
2082:     defaultType = PETSCDUALSPACELAGRANGE;
2083:   } else {
2084:     defaultType = ((PetscObject) sp)->type_name;
2085:   }
2086:   if (!PetscSpaceRegisterAllCalled) {PetscSpaceRegisterAll();}

2088:   PetscObjectOptionsBegin((PetscObject) sp);
2089:   PetscOptionsFList("-petscdualspace_type", "Dual space", "PetscDualSpaceSetType", PetscDualSpaceList, defaultType, name, 256, &flg);
2090:   if (flg) {
2091:     PetscDualSpaceSetType(sp, name);
2092:   } else if (!((PetscObject) sp)->type_name) {
2093:     PetscDualSpaceSetType(sp, defaultType);
2094:   }
2095:   PetscOptionsInt("-petscdualspace_order", "The approximation order", "PetscDualSpaceSetOrder", sp->order, &sp->order, NULL);
2096:   PetscOptionsInt("-petscdualspace_components", "The number of components", "PetscDualSpaceSetNumComponents", sp->Nc, &sp->Nc, NULL);
2097:   if (sp->ops->setfromoptions) {
2098:     (*sp->ops->setfromoptions)(PetscOptionsObject,sp);
2099:   }
2100:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
2101:   PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) sp);
2102:   PetscOptionsEnd();
2103:   PetscDualSpaceViewFromOptions(sp, NULL, "-petscdualspace_view");
2104:   return(0);
2105: }

2107: /*@
2108:   PetscDualSpaceSetUp - Construct a basis for the PetscDualSpace

2110:   Collective on PetscDualSpace

2112:   Input Parameter:
2113: . sp - the PetscDualSpace object to setup

2115:   Level: developer

2117: .seealso PetscDualSpaceView(), PetscDualSpaceDestroy()
2118: @*/
2119: PetscErrorCode PetscDualSpaceSetUp(PetscDualSpace sp)
2120: {

2125:   if (sp->setupcalled) return(0);
2126:   sp->setupcalled = PETSC_TRUE;
2127:   if (sp->ops->setup) {(*sp->ops->setup)(sp);}
2128:   return(0);
2129: }

2131: /*@
2132:   PetscDualSpaceDestroy - Destroys a PetscDualSpace object

2134:   Collective on PetscDualSpace

2136:   Input Parameter:
2137: . sp - the PetscDualSpace object to destroy

2139:   Level: developer

2141: .seealso PetscDualSpaceView()
2142: @*/
2143: PetscErrorCode PetscDualSpaceDestroy(PetscDualSpace *sp)
2144: {
2145:   PetscInt       dim, f;

2149:   if (!*sp) return(0);

2152:   if (--((PetscObject)(*sp))->refct > 0) {*sp = 0; return(0);}
2153:   ((PetscObject) (*sp))->refct = 0;

2155:   PetscDualSpaceGetDimension(*sp, &dim);
2156:   for (f = 0; f < dim; ++f) {
2157:     PetscQuadratureDestroy(&(*sp)->functional[f]);
2158:   }
2159:   PetscFree((*sp)->functional);
2160:   PetscQuadratureDestroy(&(*sp)->allPoints);
2161:   DMDestroy(&(*sp)->dm);

2163:   if ((*sp)->ops->destroy) {(*(*sp)->ops->destroy)(*sp);}
2164:   PetscHeaderDestroy(sp);
2165:   return(0);
2166: }

2168: /*@
2169:   PetscDualSpaceCreate - Creates an empty PetscDualSpace object. The type can then be set with PetscDualSpaceSetType().

2171:   Collective on MPI_Comm

2173:   Input Parameter:
2174: . comm - The communicator for the PetscDualSpace object

2176:   Output Parameter:
2177: . sp - The PetscDualSpace object

2179:   Level: beginner

2181: .seealso: PetscDualSpaceSetType(), PETSCDUALSPACELAGRANGE
2182: @*/
2183: PetscErrorCode PetscDualSpaceCreate(MPI_Comm comm, PetscDualSpace *sp)
2184: {
2185:   PetscDualSpace s;

2190:   PetscCitationsRegister(FECitation,&FEcite);
2191:   *sp  = NULL;
2192:   PetscFEInitializePackage();

2194:   PetscHeaderCreate(s, PETSCDUALSPACE_CLASSID, "PetscDualSpace", "Dual Space", "PetscDualSpace", comm, PetscDualSpaceDestroy, PetscDualSpaceView);

2196:   s->order = 0;
2197:   s->Nc    = 1;
2198:   s->setupcalled = PETSC_FALSE;

2200:   *sp = s;
2201:   return(0);
2202: }

2204: /*@
2205:   PetscDualSpaceDuplicate - Creates a duplicate PetscDualSpace object, however it is not setup.

2207:   Collective on PetscDualSpace

2209:   Input Parameter:
2210: . sp - The original PetscDualSpace

2212:   Output Parameter:
2213: . spNew - The duplicate PetscDualSpace

2215:   Level: beginner

2217: .seealso: PetscDualSpaceCreate(), PetscDualSpaceSetType()
2218: @*/
2219: PetscErrorCode PetscDualSpaceDuplicate(PetscDualSpace sp, PetscDualSpace *spNew)
2220: {

2226:   (*sp->ops->duplicate)(sp, spNew);
2227:   return(0);
2228: }

2230: /*@
2231:   PetscDualSpaceGetDM - Get the DM representing the reference cell

2233:   Not collective

2235:   Input Parameter:
2236: . sp - The PetscDualSpace

2238:   Output Parameter:
2239: . dm - The reference cell

2241:   Level: intermediate

2243: .seealso: PetscDualSpaceSetDM(), PetscDualSpaceCreate()
2244: @*/
2245: PetscErrorCode PetscDualSpaceGetDM(PetscDualSpace sp, DM *dm)
2246: {
2250:   *dm = sp->dm;
2251:   return(0);
2252: }

2254: /*@
2255:   PetscDualSpaceSetDM - Get the DM representing the reference cell

2257:   Not collective

2259:   Input Parameters:
2260: + sp - The PetscDualSpace
2261: - dm - The reference cell

2263:   Level: intermediate

2265: .seealso: PetscDualSpaceGetDM(), PetscDualSpaceCreate()
2266: @*/
2267: PetscErrorCode PetscDualSpaceSetDM(PetscDualSpace sp, DM dm)
2268: {

2274:   DMDestroy(&sp->dm);
2275:   PetscObjectReference((PetscObject) dm);
2276:   sp->dm = dm;
2277:   return(0);
2278: }

2280: /*@
2281:   PetscDualSpaceGetOrder - Get the order of the dual space

2283:   Not collective

2285:   Input Parameter:
2286: . sp - The PetscDualSpace

2288:   Output Parameter:
2289: . order - The order

2291:   Level: intermediate

2293: .seealso: PetscDualSpaceSetOrder(), PetscDualSpaceCreate()
2294: @*/
2295: PetscErrorCode PetscDualSpaceGetOrder(PetscDualSpace sp, PetscInt *order)
2296: {
2300:   *order = sp->order;
2301:   return(0);
2302: }

2304: /*@
2305:   PetscDualSpaceSetOrder - Set the order of the dual space

2307:   Not collective

2309:   Input Parameters:
2310: + sp - The PetscDualSpace
2311: - order - The order

2313:   Level: intermediate

2315: .seealso: PetscDualSpaceGetOrder(), PetscDualSpaceCreate()
2316: @*/
2317: PetscErrorCode PetscDualSpaceSetOrder(PetscDualSpace sp, PetscInt order)
2318: {
2321:   sp->order = order;
2322:   return(0);
2323: }

2325: /*@
2326:   PetscDualSpaceGetNumComponents - Return the number of components for this space

2328:   Input Parameter:
2329: . sp - The PetscDualSpace

2331:   Output Parameter:
2332: . Nc - The number of components

2334:   Note: A vector space, for example, will have d components, where d is the spatial dimension

2336:   Level: intermediate

2338: .seealso: PetscDualSpaceSetNumComponents(), PetscDualSpaceGetDimension(), PetscDualSpaceCreate(), PetscDualSpace
2339: @*/
2340: PetscErrorCode PetscDualSpaceGetNumComponents(PetscDualSpace sp, PetscInt *Nc)
2341: {
2345:   *Nc = sp->Nc;
2346:   return(0);
2347: }

2349: /*@
2350:   PetscDualSpaceSetNumComponents - Set the number of components for this space

2352:   Input Parameters:
2353: + sp - The PetscDualSpace
2354: - order - The number of components

2356:   Level: intermediate

2358: .seealso: PetscDualSpaceGetNumComponents(), PetscDualSpaceCreate(), PetscDualSpace
2359: @*/
2360: PetscErrorCode PetscDualSpaceSetNumComponents(PetscDualSpace sp, PetscInt Nc)
2361: {
2364:   sp->Nc = Nc;
2365:   return(0);
2366: }

2368: /*@
2369:   PetscDualSpaceLagrangeGetTensor - Get the tensor nature of the dual space

2371:   Not collective

2373:   Input Parameter:
2374: . sp - The PetscDualSpace

2376:   Output Parameter:
2377: . tensor - Whether the dual space has tensor layout (vs. simplicial)

2379:   Level: intermediate

2381: .seealso: PetscDualSpaceLagrangeSetTensor(), PetscDualSpaceCreate()
2382: @*/
2383: PetscErrorCode PetscDualSpaceLagrangeGetTensor(PetscDualSpace sp, PetscBool *tensor)
2384: {

2390:   PetscTryMethod(sp,"PetscDualSpaceLagrangeGetTensor_C",(PetscDualSpace,PetscBool *),(sp,tensor));
2391:   return(0);
2392: }

2394: /*@
2395:   PetscDualSpaceLagrangeSetTensor - Set the tensor nature of the dual space

2397:   Not collective

2399:   Input Parameters:
2400: + sp - The PetscDualSpace
2401: - tensor - Whether the dual space has tensor layout (vs. simplicial)

2403:   Level: intermediate

2405: .seealso: PetscDualSpaceLagrangeGetTensor(), PetscDualSpaceCreate()
2406: @*/
2407: PetscErrorCode PetscDualSpaceLagrangeSetTensor(PetscDualSpace sp, PetscBool tensor)
2408: {

2413:   PetscTryMethod(sp,"PetscDualSpaceLagrangeSetTensor_C",(PetscDualSpace,PetscBool),(sp,tensor));
2414:   return(0);
2415: }

2417: /*@
2418:   PetscDualSpaceGetFunctional - Get the i-th basis functional in the dual space

2420:   Not collective

2422:   Input Parameters:
2423: + sp - The PetscDualSpace
2424: - i  - The basis number

2426:   Output Parameter:
2427: . functional - The basis functional

2429:   Level: intermediate

2431: .seealso: PetscDualSpaceGetDimension(), PetscDualSpaceCreate()
2432: @*/
2433: PetscErrorCode PetscDualSpaceGetFunctional(PetscDualSpace sp, PetscInt i, PetscQuadrature *functional)
2434: {
2435:   PetscInt       dim;

2441:   PetscDualSpaceGetDimension(sp, &dim);
2442:   if ((i < 0) || (i >= dim)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Functional index %d must be in [0, %d)", i, dim);
2443:   *functional = sp->functional[i];
2444:   return(0);
2445: }

2447: /*@
2448:   PetscDualSpaceGetDimension - Get the dimension of the dual space, i.e. the number of basis functionals

2450:   Not collective

2452:   Input Parameter:
2453: . sp - The PetscDualSpace

2455:   Output Parameter:
2456: . dim - The dimension

2458:   Level: intermediate

2460: .seealso: PetscDualSpaceGetFunctional(), PetscDualSpaceCreate()
2461: @*/
2462: PetscErrorCode PetscDualSpaceGetDimension(PetscDualSpace sp, PetscInt *dim)
2463: {

2469:   *dim = 0;
2470:   if (sp->ops->getdimension) {(*sp->ops->getdimension)(sp, dim);}
2471:   return(0);
2472: }

2474: /*@C
2475:   PetscDualSpaceGetNumDof - Get the number of degrees of freedom for each spatial (topological) dimension

2477:   Not collective

2479:   Input Parameter:
2480: . sp - The PetscDualSpace

2482:   Output Parameter:
2483: . numDof - An array of length dim+1 which holds the number of dofs for each dimension

2485:   Level: intermediate

2487: .seealso: PetscDualSpaceGetFunctional(), PetscDualSpaceCreate()
2488: @*/
2489: PetscErrorCode PetscDualSpaceGetNumDof(PetscDualSpace sp, const PetscInt **numDof)
2490: {

2496:   (*sp->ops->getnumdof)(sp, numDof);
2497:   if (!*numDof) SETERRQ(PetscObjectComm((PetscObject) sp), PETSC_ERR_LIB, "Empty numDof[] returned from dual space implementation");
2498:   return(0);
2499: }

2501: PetscErrorCode PetscDualSpaceCreateSection(PetscDualSpace sp, PetscSection *section)
2502: {
2503:   DM             dm;
2504:   PetscInt       pStart, pEnd, depth, h, offset;
2505:   const PetscInt *numDof;

2509:   PetscDualSpaceGetDM(sp,&dm);
2510:   DMPlexGetChart(dm,&pStart,&pEnd);
2511:   PetscSectionCreate(PetscObjectComm((PetscObject)sp),section);
2512:   PetscSectionSetChart(*section,pStart,pEnd);
2513:   DMPlexGetDepth(dm,&depth);
2514:   PetscDualSpaceGetNumDof(sp,&numDof);
2515:   for (h = 0; h <= depth; h++) {
2516:     PetscInt hStart, hEnd, p, dof;

2518:     DMPlexGetHeightStratum(dm,h,&hStart,&hEnd);
2519:     dof = numDof[depth - h];
2520:     for (p = hStart; p < hEnd; p++) {
2521:       PetscSectionSetDof(*section,p,dof);
2522:     }
2523:   }
2524:   PetscSectionSetUp(*section);
2525:   for (h = 0, offset = 0; h <= depth; h++) {
2526:     PetscInt hStart, hEnd, p, dof;

2528:     DMPlexGetHeightStratum(dm,h,&hStart,&hEnd);
2529:     dof = numDof[depth - h];
2530:     for (p = hStart; p < hEnd; p++) {
2531:       PetscSectionGetDof(*section,p,&dof);
2532:       PetscSectionSetOffset(*section,p,offset);
2533:       offset += dof;
2534:     }
2535:   }
2536:   return(0);
2537: }

2539: /*@
2540:   PetscDualSpaceCreateReferenceCell - Create a DMPLEX with the appropriate FEM reference cell

2542:   Collective on PetscDualSpace

2544:   Input Parameters:
2545: + sp      - The PetscDualSpace
2546: . dim     - The spatial/topological dimension
2547: - simplex - Flag for simplex, otherwise use a tensor-product cell

2549:   Output Parameter:
2550: . refdm - The reference cell

2552:   Level: advanced

2554: .keywords: PetscDualSpace, reference cell
2555: .seealso: PetscDualSpaceCreate(), DMPLEX
2556: @*/
2557: PetscErrorCode PetscDualSpaceCreateReferenceCell(PetscDualSpace sp, PetscInt dim, PetscBool simplex, DM *refdm)
2558: {

2562:   DMPlexCreateReferenceCell(PetscObjectComm((PetscObject) sp), dim, simplex, refdm);
2563:   return(0);
2564: }

2566: /*@C
2567:   PetscDualSpaceApply - Apply a functional from the dual space basis to an input function

2569:   Input Parameters:
2570: + sp      - The PetscDualSpace object
2571: . f       - The basis functional index
2572: . time    - The time
2573: . cgeom   - A context with geometric information for this cell, we use v0 (the initial vertex) and J (the Jacobian) (or evaluated at the coordinates of the functional)
2574: . numComp - The number of components for the function
2575: . func    - The input function
2576: - ctx     - A context for the function

2578:   Output Parameter:
2579: . value   - numComp output values

2581:   Note: The calling sequence for the callback func is given by:

2583: $ func(PetscInt dim, PetscReal time, const PetscReal x[],
2584: $      PetscInt numComponents, PetscScalar values[], void *ctx)

2586:   Level: developer

2588: .seealso: PetscDualSpaceCreate()
2589: @*/
2590: PetscErrorCode PetscDualSpaceApply(PetscDualSpace sp, PetscInt f, PetscReal time, PetscFEGeom *cgeom, PetscInt numComp, PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void *ctx, PetscScalar *value)
2591: {

2598:   (*sp->ops->apply)(sp, f, time, cgeom, numComp, func, ctx, value);
2599:   return(0);
2600: }

2602: /*@C
2603:   PetscDualSpaceApplyAll - Apply all functionals from the dual space basis to the result of an evaluation at the points returned by PetscDualSpaceGetAllPoints()

2605:   Input Parameters:
2606: + sp        - The PetscDualSpace object
2607: - pointEval - Evaluation at the points returned by PetscDualSpaceGetAllPoints()

2609:   Output Parameter:
2610: . spValue   - The values of all dual space functionals

2612:   Level: developer

2614: .seealso: PetscDualSpaceCreate()
2615: @*/
2616: PetscErrorCode PetscDualSpaceApplyAll(PetscDualSpace sp, const PetscScalar *pointEval, PetscScalar *spValue)
2617: {

2622:   (*sp->ops->applyall)(sp, pointEval, spValue);
2623:   return(0);
2624: }

2626: /*@C
2627:   PetscDualSpaceApplyDefault - Apply a functional from the dual space basis to an input function by assuming a point evaluation functional.

2629:   Input Parameters:
2630: + sp    - The PetscDualSpace object
2631: . f     - The basis functional index
2632: . time  - The time
2633: . cgeom - A context with geometric information for this cell, we use v0 (the initial vertex) and J (the Jacobian)
2634: . Nc    - The number of components for the function
2635: . func  - The input function
2636: - ctx   - A context for the function

2638:   Output Parameter:
2639: . value   - The output value

2641:   Note: The calling sequence for the callback func is given by:

2643: $ func(PetscInt dim, PetscReal time, const PetscReal x[],
2644: $      PetscInt numComponents, PetscScalar values[], void *ctx)

2646: and the idea is to evaluate the functional as an integral

2648: $ n(f) = int dx n(x) . f(x)

2650: where both n and f have Nc components.

2652:   Level: developer

2654: .seealso: PetscDualSpaceCreate()
2655: @*/
2656: PetscErrorCode PetscDualSpaceApplyDefault(PetscDualSpace sp, PetscInt f, PetscReal time, PetscFEGeom *cgeom, PetscInt Nc, PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void *ctx, PetscScalar *value)
2657: {
2658:   DM               dm;
2659:   PetscQuadrature  n;
2660:   const PetscReal *points, *weights;
2661:   PetscReal        x[3];
2662:   PetscScalar     *val;
2663:   PetscInt         dim, dE, qNc, c, Nq, q;
2664:   PetscBool        isAffine;
2665:   PetscErrorCode   ierr;

2670:   PetscDualSpaceGetDM(sp, &dm);
2671:   PetscDualSpaceGetFunctional(sp, f, &n);
2672:   PetscQuadratureGetData(n, &dim, &qNc, &Nq, &points, &weights);
2673:   if (dim != cgeom->dim) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_SIZ, "The quadrature spatial dimension %D != cell geometry dimension %D", dim, cgeom->dim);
2674:   if (qNc != Nc) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_SIZ, "The quadrature components %D != function components %D", qNc, Nc);
2675:   DMGetWorkArray(dm, Nc, MPIU_SCALAR, &val);
2676:   *value = 0.0;
2677:   isAffine = cgeom->isAffine;
2678:   dE = cgeom->dimEmbed;
2679:   for (q = 0; q < Nq; ++q) {
2680:     if (isAffine) {
2681:       CoordinatesRefToReal(dE, cgeom->dim, cgeom->xi, cgeom->v, cgeom->J, &points[q*dim], x);
2682:       (*func)(dE, time, x, Nc, val, ctx);
2683:     } else {
2684:       (*func)(dE, time, &cgeom->v[dE*q], Nc, val, ctx);
2685:     }
2686:     for (c = 0; c < Nc; ++c) {
2687:       *value += val[c]*weights[q*Nc+c];
2688:     }
2689:   }
2690:   DMRestoreWorkArray(dm, Nc, MPIU_SCALAR, &val);
2691:   return(0);
2692: }

2694: /*@C
2695:   PetscDualSpaceApplyAllDefault - Apply all functionals from the dual space basis to the result of an evaluation at the points returned by PetscDualSpaceGetAllPoints()

2697:   Input Parameters:
2698: + sp        - The PetscDualSpace object
2699: - pointEval - Evaluation at the points returned by PetscDualSpaceGetAllPoints()

2701:   Output Parameter:
2702: . spValue   - The values of all dual space functionals

2704:   Level: developer

2706: .seealso: PetscDualSpaceCreate()
2707: @*/
2708: PetscErrorCode PetscDualSpaceApplyAllDefault(PetscDualSpace sp, const PetscScalar *pointEval, PetscScalar *spValue)
2709: {
2710:   PetscQuadrature  n;
2711:   const PetscReal *points, *weights;
2712:   PetscInt         qNc, c, Nq, q, f, spdim, Nc;
2713:   PetscInt         offset;
2714:   PetscErrorCode   ierr;

2720:   PetscDualSpaceGetDimension(sp, &spdim);
2721:   PetscDualSpaceGetNumComponents(sp, &Nc);
2722:   for (f = 0, offset = 0; f < spdim; f++) {
2723:     PetscDualSpaceGetFunctional(sp, f, &n);
2724:     PetscQuadratureGetData(n, NULL, &qNc, &Nq, &points, &weights);
2725:     if (qNc != Nc) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_SIZ, "The quadrature components %D != function components %D", qNc, Nc);
2726:     spValue[f] = 0.0;
2727:     for (q = 0; q < Nq; ++q) {
2728:       for (c = 0; c < Nc; ++c) {
2729:         spValue[f] += pointEval[offset++]*weights[q*Nc+c];
2730:       }
2731:     }
2732:   }
2733:   return(0);
2734: }

2736: PetscErrorCode PetscDualSpaceGetAllPoints(PetscDualSpace sp, PetscQuadrature *allPoints)
2737: {

2743:   if (!sp->allPoints && sp->ops->createallpoints) {
2744:     (*sp->ops->createallpoints)(sp,&sp->allPoints);
2745:   }
2746:   *allPoints = sp->allPoints;
2747:   return(0);
2748: }

2750: PetscErrorCode PetscDualSpaceCreateAllPointsDefault(PetscDualSpace sp, PetscQuadrature *allPoints)
2751: {
2752:   PetscInt        spdim;
2753:   PetscInt        numPoints, offset;
2754:   PetscReal       *points;
2755:   PetscInt        f, dim;
2756:   PetscQuadrature q;
2757:   PetscErrorCode  ierr;

2760:   PetscDualSpaceGetDimension(sp,&spdim);
2761:   if (!spdim) {
2762:     PetscQuadratureCreate(PETSC_COMM_SELF,allPoints);
2763:     PetscQuadratureSetData(*allPoints,0,0,0,NULL,NULL);
2764:   }
2765:   PetscDualSpaceGetFunctional(sp,0,&q);
2766:   PetscQuadratureGetData(q,&dim,NULL,&numPoints,NULL,NULL);
2767:   for (f = 1; f < spdim; f++) {
2768:     PetscInt Np;

2770:     PetscDualSpaceGetFunctional(sp,f,&q);
2771:     PetscQuadratureGetData(q,NULL,NULL,&Np,NULL,NULL);
2772:     numPoints += Np;
2773:   }
2774:   PetscMalloc1(dim*numPoints,&points);
2775:   for (f = 0, offset = 0; f < spdim; f++) {
2776:     const PetscReal *p;
2777:     PetscInt        Np, i;

2779:     PetscDualSpaceGetFunctional(sp,f,&q);
2780:     PetscQuadratureGetData(q,NULL,NULL,&Np,&p,NULL);
2781:     for (i = 0; i < Np * dim; i++) {
2782:       points[offset + i] = p[i];
2783:     }
2784:     offset += Np * dim;
2785:   }
2786:   PetscQuadratureCreate(PETSC_COMM_SELF,allPoints);
2787:   PetscQuadratureSetData(*allPoints,dim,0,numPoints,points,NULL);
2788:   return(0);
2789: }

2791: /*@C
2792:   PetscDualSpaceApplyFVM - Apply a functional from the dual space basis to an input function by assuming a point evaluation functional at the cell centroid.

2794:   Input Parameters:
2795: + sp    - The PetscDualSpace object
2796: . f     - The basis functional index
2797: . time  - The time
2798: . cgeom - A context with geometric information for this cell, we currently just use the centroid
2799: . Nc    - The number of components for the function
2800: . func  - The input function
2801: - ctx   - A context for the function

2803:   Output Parameter:
2804: . value - The output value (scalar)

2806:   Note: The calling sequence for the callback func is given by:

2808: $ func(PetscInt dim, PetscReal time, const PetscReal x[],
2809: $      PetscInt numComponents, PetscScalar values[], void *ctx)

2811: and the idea is to evaluate the functional as an integral

2813: $ n(f) = int dx n(x) . f(x)

2815: where both n and f have Nc components.

2817:   Level: developer

2819: .seealso: PetscDualSpaceCreate()
2820: @*/
2821: PetscErrorCode PetscDualSpaceApplyFVM(PetscDualSpace sp, PetscInt f, PetscReal time, PetscFVCellGeom *cgeom, PetscInt Nc, PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void *ctx, PetscScalar *value)
2822: {
2823:   DM               dm;
2824:   PetscQuadrature  n;
2825:   const PetscReal *points, *weights;
2826:   PetscScalar     *val;
2827:   PetscInt         dimEmbed, qNc, c, Nq, q;
2828:   PetscErrorCode   ierr;

2833:   PetscDualSpaceGetDM(sp, &dm);
2834:   DMGetCoordinateDim(dm, &dimEmbed);
2835:   PetscDualSpaceGetFunctional(sp, f, &n);
2836:   PetscQuadratureGetData(n, NULL, &qNc, &Nq, &points, &weights);
2837:   if (qNc != Nc) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_SIZ, "The quadrature components %D != function components %D", qNc, Nc);
2838:   DMGetWorkArray(dm, Nc, MPIU_SCALAR, &val);
2839:   *value = 0.;
2840:   for (q = 0; q < Nq; ++q) {
2841:     (*func)(dimEmbed, time, cgeom->centroid, Nc, val, ctx);
2842:     for (c = 0; c < Nc; ++c) {
2843:       *value += val[c]*weights[q*Nc+c];
2844:     }
2845:   }
2846:   DMRestoreWorkArray(dm, Nc, MPIU_SCALAR, &val);
2847:   return(0);
2848: }

2850: /*@
2851:   PetscDualSpaceGetHeightSubspace - Get the subset of the dual space basis that is supported on a mesh point of a
2852:   given height.  This assumes that the reference cell is symmetric over points of this height.

2854:   If the dual space is not defined on mesh points of the given height (e.g. if the space is discontinuous and
2855:   pointwise values are not defined on the element boundaries), or if the implementation of PetscDualSpace does not
2856:   support extracting subspaces, then NULL is returned.

2858:   This does not increment the reference count on the returned dual space, and the user should not destroy it.

2860:   Not collective

2862:   Input Parameters:
2863: + sp - the PetscDualSpace object
2864: - height - the height of the mesh point for which the subspace is desired

2866:   Output Parameter:
2867: . subsp - the subspace.  Note that the functionals in the subspace are with respect to the intrinsic geometry of the
2868:   point, which will be of lesser dimension if height > 0.

2870:   Level: advanced

2872: .seealso: PetscSpaceGetHeightSubspace(), PetscDualSpace
2873: @*/
2874: PetscErrorCode PetscDualSpaceGetHeightSubspace(PetscDualSpace sp, PetscInt height, PetscDualSpace *subsp)
2875: {

2881:   *subsp = NULL;
2882:   if (sp->ops->getheightsubspace) {
2883:     (*sp->ops->getheightsubspace)(sp, height, subsp);
2884:   }
2885:   return(0);
2886: }

2888: /*@
2889:   PetscDualSpaceGetPointSubspace - Get the subset of the dual space basis that is supported on a particular mesh point.

2891:   If the dual space is not defined on the mesh point (e.g. if the space is discontinuous and pointwise values are not
2892:   defined on the element boundaries), or if the implementation of PetscDualSpace does not support extracting
2893:   subspaces, then NULL is returned.

2895:   This does not increment the reference count on the returned dual space, and the user should not destroy it.

2897:   Not collective

2899:   Input Parameters:
2900: + sp - the PetscDualSpace object
2901: - point - the point (in the dual space's DM) for which the subspace is desired

2903:   Output Parameters:
2904:   bdsp - the subspace.  Note that the functionals in the subspace are with respect to the intrinsic geometry of the
2905:   point, which will be of lesser dimension if height > 0.

2907:   Level: advanced

2909: .seealso: PetscDualSpace
2910: @*/
2911: PetscErrorCode PetscDualSpaceGetPointSubspace(PetscDualSpace sp, PetscInt point, PetscDualSpace *bdsp)
2912: {

2918:   *bdsp = NULL;
2919:   if (sp->ops->getpointsubspace) {
2920:     (*sp->ops->getpointsubspace)(sp,point,bdsp);
2921:   } else if (sp->ops->getheightsubspace) {
2922:     DM       dm;
2923:     DMLabel  label;
2924:     PetscInt dim, depth, height;

2926:     PetscDualSpaceGetDM(sp,&dm);
2927:     DMPlexGetDepth(dm,&dim);
2928:     DMPlexGetDepthLabel(dm,&label);
2929:     DMLabelGetValue(label,point,&depth);
2930:     height = dim - depth;
2931:     (*sp->ops->getheightsubspace)(sp,height,bdsp);
2932:   }
2933:   return(0);
2934: }

2936: static PetscErrorCode PetscDualSpaceLagrangeGetTensor_Lagrange(PetscDualSpace sp, PetscBool *tensor)
2937: {
2938:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;

2941:   *tensor = lag->tensorSpace;
2942:   return(0);
2943: }

2945: static PetscErrorCode PetscDualSpaceLagrangeSetTensor_Lagrange(PetscDualSpace sp, PetscBool tensor)
2946: {
2947:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;

2950:   lag->tensorSpace = tensor;
2951:   return(0);
2952: }

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

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

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

2961:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2962:   PetscInt           dim, order, p, Nc;
2963:   PetscErrorCode     ierr;

2966:   PetscDualSpaceGetOrder(sp,&order);
2967:   PetscDualSpaceGetNumComponents(sp,&Nc);
2968:   DMGetDimension(sp->dm,&dim);
2969:   if (!dim || !lag->continuous || order < 3) return(0);
2970:   if (dim > 3) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Lagrange symmetries not implemented for dim = %D > 3",dim);
2971:   if (!lag->symmetries) { /* store symmetries */
2972:     PetscDualSpace hsp;
2973:     DM             K;
2974:     PetscInt       numPoints = 1, d;
2975:     PetscInt       numFaces;
2976:     PetscInt       ***symmetries;
2977:     const PetscInt ***hsymmetries;

2979:     if (lag->simplexCell) {
2980:       numFaces = 1 + dim;
2981:       for (d = 0; d < dim; d++) numPoints = numPoints * 2 + 1;
2982:     }
2983:     else {
2984:       numPoints = PetscPowInt(3,dim);
2985:       numFaces  = 2 * dim;
2986:     }
2987:     PetscCalloc1(numPoints,&symmetries);
2988:     if (0 < dim && dim < 3) { /* compute self symmetries */
2989:       PetscInt **cellSymmetries;

2991:       lag->numSelfSym = 2 * numFaces;
2992:       lag->selfSymOff = numFaces;
2993:       PetscCalloc1(2*numFaces,&cellSymmetries);
2994:       /* we want to be able to index symmetries directly with the orientations, which range from [-numFaces,numFaces) */
2995:       symmetries[0] = &cellSymmetries[numFaces];
2996:       if (dim == 1) {
2997:         PetscInt dofPerEdge = order - 1;

2999:         if (dofPerEdge > 1) {
3000:           PetscInt i, j, *reverse;

3002:           PetscMalloc1(dofPerEdge*Nc,&reverse);
3003:           for (i = 0; i < dofPerEdge; i++) {
3004:             for (j = 0; j < Nc; j++) {
3005:               reverse[i*Nc + j] = Nc * (dofPerEdge - 1 - i) + j;
3006:             }
3007:           }
3008:           symmetries[0][-2] = reverse;

3010:           /* yes, this is redundant, but it makes it easier to cleanup if I don't have to worry about what not to free */
3011:           PetscMalloc1(dofPerEdge*Nc,&reverse);
3012:           for (i = 0; i < dofPerEdge; i++) {
3013:             for (j = 0; j < Nc; j++) {
3014:               reverse[i*Nc + j] = Nc * (dofPerEdge - 1 - i) + j;
3015:             }
3016:           }
3017:           symmetries[0][1] = reverse;
3018:         }
3019:       } else {
3020:         PetscInt dofPerEdge = lag->simplexCell ? (order - 2) : (order - 1), s;
3021:         PetscInt dofPerFace;

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

3027:             if (!s) continue;
3028:             if (lag->simplexCell) {
3029:               dofPerFace = (dofPerEdge * (dofPerEdge + 1))/2;
3030:               PetscMalloc1(Nc*dofPerFace,&sym);
3031:               for (j = 0, l = 0; j < dofPerEdge; j++) {
3032:                 for (k = 0; k < dofPerEdge - j; k++, l++) {
3033:                   i = dofPerEdge - 1 - j - k;
3034:                   switch (s) {
3035:                   case -3:
3036:                     sym[Nc*l] = BaryIndex(dofPerEdge,i,k,j);
3037:                     break;
3038:                   case -2:
3039:                     sym[Nc*l] = BaryIndex(dofPerEdge,j,i,k);
3040:                     break;
3041:                   case -1:
3042:                     sym[Nc*l] = BaryIndex(dofPerEdge,k,j,i);
3043:                     break;
3044:                   case 1:
3045:                     sym[Nc*l] = BaryIndex(dofPerEdge,k,i,j);
3046:                     break;
3047:                   case 2:
3048:                     sym[Nc*l] = BaryIndex(dofPerEdge,j,k,i);
3049:                     break;
3050:                   }
3051:                 }
3052:               }
3053:             } else {
3054:               dofPerFace = dofPerEdge * dofPerEdge;
3055:               PetscMalloc1(Nc*dofPerFace,&sym);
3056:               for (j = 0, l = 0; j < dofPerEdge; j++) {
3057:                 for (k = 0; k < dofPerEdge; k++, l++) {
3058:                   switch (s) {
3059:                   case -4:
3060:                     sym[Nc*l] = CartIndex(dofPerEdge,k,j);
3061:                     break;
3062:                   case -3:
3063:                     sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - j),k);
3064:                     break;
3065:                   case -2:
3066:                     sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - k),(dofPerEdge - 1 - j));
3067:                     break;
3068:                   case -1:
3069:                     sym[Nc*l] = CartIndex(dofPerEdge,j,(dofPerEdge - 1 - k));
3070:                     break;
3071:                   case 1:
3072:                     sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - k),j);
3073:                     break;
3074:                   case 2:
3075:                     sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - j),(dofPerEdge - 1 - k));
3076:                     break;
3077:                   case 3:
3078:                     sym[Nc*l] = CartIndex(dofPerEdge,k,(dofPerEdge - 1 - j));
3079:                     break;
3080:                   }
3081:                 }
3082:               }
3083:             }
3084:             for (i = 0; i < dofPerFace; i++) {
3085:               sym[Nc*i] *= Nc;
3086:               for (j = 1; j < Nc; j++) {
3087:                 sym[Nc*i+j] = sym[Nc*i] + j;
3088:               }
3089:             }
3090:             symmetries[0][s] = sym;
3091:           }
3092:         }
3093:       }
3094:     }
3095:     PetscDualSpaceGetHeightSubspace(sp,1,&hsp);
3096:     PetscDualSpaceGetSymmetries(hsp,&hsymmetries,NULL);
3097:     if (hsymmetries) {
3098:       PetscBool      *seen;
3099:       const PetscInt *cone;
3100:       PetscInt       KclosureSize, *Kclosure = NULL;

3102:       PetscDualSpaceGetDM(sp,&K);
3103:       PetscCalloc1(numPoints,&seen);
3104:       DMPlexGetCone(K,0,&cone);
3105:       DMPlexGetTransitiveClosure(K,0,PETSC_TRUE,&KclosureSize,&Kclosure);
3106:       for (p = 0; p < numFaces; p++) {
3107:         PetscInt closureSize, *closure = NULL, q;

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

3113:           if(!seen[point]) {
3114:             for (r = 0; r < KclosureSize; r++) {
3115:               if (Kclosure[2 * r] == point) break;
3116:             }
3117:             seen[point] = PETSC_TRUE;
3118:             symmetries[r] = (PetscInt **) hsymmetries[q];
3119:           }
3120:         }
3121:         DMPlexRestoreTransitiveClosure(K,cone[p],PETSC_TRUE,&closureSize,&closure);
3122:       }
3123:       DMPlexRestoreTransitiveClosure(K,0,PETSC_TRUE,&KclosureSize,&Kclosure);
3124:       PetscFree(seen);
3125:     }
3126:     lag->symmetries = symmetries;
3127:   }
3128:   if (perms) *perms = (const PetscInt ***) lag->symmetries;
3129:   return(0);
3130: }

3132: /*@C
3133:   PetscDualSpaceGetSymmetries - Returns a description of the symmetries of this basis

3135:   Not collective

3137:   Input Parameter:
3138: . sp - the PetscDualSpace object

3140:   Output Parameters:
3141: + perms - Permutations of the local degrees of freedom, parameterized by the point orientation
3142: - flips - Sign reversal of the local degrees of freedom, parameterized by the point orientation

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

3148:   Level: developer

3150: .seealso: PetscDualSpaceSetSymmetries()
3151: @*/
3152: PetscErrorCode PetscDualSpaceGetSymmetries(PetscDualSpace sp, const PetscInt ****perms, const PetscScalar ****flips)
3153: {

3158:   if (perms) {
3160:     *perms = NULL;
3161:   }
3162:   if (flips) {
3164:     *flips = NULL;
3165:   }
3166:   if (sp->ops->getsymmetries) {
3167:     (sp->ops->getsymmetries)(sp,perms,flips);
3168:   }
3169:   return(0);
3170: }

3172: static PetscErrorCode PetscDualSpaceGetDimension_SingleCell_Lagrange(PetscDualSpace sp, PetscInt order, PetscInt *dim)
3173: {
3174:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
3175:   PetscReal           D   = 1.0;
3176:   PetscInt            n, i;
3177:   PetscErrorCode      ierr;

3180:   *dim = -1;                    /* Ensure that the compiler knows *dim is set. */
3181:   DMGetDimension(sp->dm, &n);
3182:   if (!lag->tensorSpace) {
3183:     for (i = 1; i <= n; ++i) {
3184:       D *= ((PetscReal) (order+i))/i;
3185:     }
3186:     *dim = (PetscInt) (D + 0.5);
3187:   } else {
3188:     *dim = 1;
3189:     for (i = 0; i < n; ++i) *dim *= (order+1);
3190:   }
3191:   *dim *= sp->Nc;
3192:   return(0);
3193: }

3195: static PetscErrorCode PetscDualSpaceCreateHeightSubspace_Lagrange(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
3196: {
3197:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
3198:   PetscBool          continuous, tensor;
3199:   PetscInt           order;
3200:   PetscErrorCode     ierr;

3205:   PetscDualSpaceLagrangeGetContinuity(sp,&continuous);
3206:   PetscDualSpaceGetOrder(sp,&order);
3207:   if (height == 0) {
3208:     PetscObjectReference((PetscObject)sp);
3209:     *bdsp = sp;
3210:   } else if (continuous == PETSC_FALSE || !order) {
3211:     *bdsp = NULL;
3212:   } else {
3213:     DM dm, K;
3214:     PetscInt dim;

3216:     PetscDualSpaceGetDM(sp,&dm);
3217:     DMGetDimension(dm,&dim);
3218:     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);}
3219:     PetscDualSpaceDuplicate(sp,bdsp);
3220:     PetscDualSpaceCreateReferenceCell(*bdsp, dim-height, lag->simplexCell, &K);
3221:     PetscDualSpaceSetDM(*bdsp, K);
3222:     DMDestroy(&K);
3223:     PetscDualSpaceLagrangeGetTensor(sp,&tensor);
3224:     PetscDualSpaceLagrangeSetTensor(*bdsp,tensor);
3225:     PetscDualSpaceSetUp(*bdsp);
3226:   }
3227:   return(0);
3228: }

3230: PetscErrorCode PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp)
3231: {
3232:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
3233:   DM                  dm    = sp->dm;
3234:   PetscInt            order = sp->order;
3235:   PetscInt            Nc    = sp->Nc;
3236:   PetscBool           continuous;
3237:   PetscSection        csection;
3238:   Vec                 coordinates;
3239:   PetscReal          *qpoints, *qweights;
3240:   PetscInt            depth, dim, pdimMax, pStart, pEnd, p, *pStratStart, *pStratEnd, coneSize, d, f = 0, c;
3241:   PetscBool           simplex, tensorSpace;
3242:   PetscErrorCode      ierr;

3245:   /* Classify element type */
3246:   if (!order) lag->continuous = PETSC_FALSE;
3247:   continuous = lag->continuous;
3248:   DMGetDimension(dm, &dim);
3249:   DMPlexGetDepth(dm, &depth);
3250:   DMPlexGetChart(dm, &pStart, &pEnd);
3251:   PetscCalloc1(dim+1, &lag->numDof);
3252:   PetscMalloc2(depth+1,&pStratStart,depth+1,&pStratEnd);
3253:   for (d = 0; d <= depth; ++d) {DMPlexGetDepthStratum(dm, d, &pStratStart[d], &pStratEnd[d]);}
3254:   DMPlexGetConeSize(dm, pStratStart[depth], &coneSize);
3255:   DMGetCoordinateSection(dm, &csection);
3256:   DMGetCoordinatesLocal(dm, &coordinates);
3257:   if (depth == 1) {
3258:     if      (coneSize == dim+1)    simplex = PETSC_TRUE;
3259:     else if (coneSize == 1 << dim) simplex = PETSC_FALSE;
3260:     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
3261:   } else if (depth == dim) {
3262:     if      (coneSize == dim+1)   simplex = PETSC_TRUE;
3263:     else if (coneSize == 2 * dim) simplex = PETSC_FALSE;
3264:     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
3265:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support cell-vertex meshes or interpolated meshes");
3266:   lag->simplexCell = simplex;
3267:   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");
3268:   tensorSpace    = lag->tensorSpace;
3269:   lag->height    = 0;
3270:   lag->subspaces = NULL;
3271:   if (continuous && sp->order > 0 && dim > 0) {
3272:     PetscInt i;

3274:     lag->height = dim;
3275:     PetscMalloc1(dim,&lag->subspaces);
3276:     PetscDualSpaceCreateHeightSubspace_Lagrange(sp,1,&lag->subspaces[0]);
3277:     PetscDualSpaceSetUp(lag->subspaces[0]);
3278:     for (i = 1; i < dim; i++) {
3279:       PetscDualSpaceGetHeightSubspace(lag->subspaces[i-1],1,&lag->subspaces[i]);
3280:       PetscObjectReference((PetscObject)(lag->subspaces[i]));
3281:     }
3282:   }
3283:   PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, sp->order, &pdimMax);
3284:   pdimMax *= (pStratEnd[depth] - pStratStart[depth]);
3285:   PetscMalloc1(pdimMax, &sp->functional);
3286:   if (!dim) {
3287:     for (c = 0; c < Nc; ++c) {
3288:       PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
3289:       PetscCalloc1(Nc, &qweights);
3290:       PetscQuadratureSetOrder(sp->functional[f], 0);
3291:       PetscQuadratureSetData(sp->functional[f], 0, Nc, 1, NULL, qweights);
3292:       qweights[c] = 1.0;
3293:       ++f;
3294:       lag->numDof[0]++;
3295:     }
3296:   } else {
3297:     PetscInt     *tup;
3298:     PetscReal    *v0, *hv0, *J, *invJ, detJ, hdetJ;
3299:     PetscSection section;

3301:     PetscSectionCreate(PETSC_COMM_SELF,&section);
3302:     PetscSectionSetChart(section,pStart,pEnd);
3303:     PetscCalloc5(dim+1,&tup,dim,&v0,dim,&hv0,dim*dim,&J,dim*dim,&invJ);
3304:     for (p = pStart; p < pEnd; p++) {
3305:       PetscInt       pointDim, d, nFunc = 0;
3306:       PetscDualSpace hsp;

3308:       DMPlexComputeCellGeometryFEM(dm, p, NULL, v0, J, invJ, &detJ);
3309:       for (d = 0; d < depth; d++) {if (p >= pStratStart[d] && p < pStratEnd[d]) break;}
3310:       pointDim = (depth == 1 && d == 1) ? dim : d;
3311:       hsp = ((pointDim < dim) && lag->subspaces) ? lag->subspaces[dim - pointDim - 1] : NULL;
3312:       if (hsp) {
3313:         PetscDualSpace_Lag *hlag = (PetscDualSpace_Lag *) hsp->data;
3314:         DM                 hdm;

3316:         PetscDualSpaceGetDM(hsp,&hdm);
3317:         DMPlexComputeCellGeometryFEM(hdm, 0, NULL, hv0, NULL, NULL, &hdetJ);
3318:         nFunc = lag->numDof[pointDim] = hlag->numDof[pointDim];
3319:       }
3320:       if (pointDim == dim) {
3321:         /* Cells, create for self */
3322:         PetscInt     orderEff = continuous ? (!tensorSpace ? order-1-dim : order-2) : order;
3323:         PetscReal    denom    = continuous ? order : (!tensorSpace ? order+1+dim : order+2);
3324:         PetscReal    numer    = (!simplex || !tensorSpace) ? 2. : (2./dim);
3325:         PetscReal    dx = numer/denom;
3326:         PetscInt     cdim, d, d2;

3328:         if (orderEff < 0) continue;
3329:         PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, orderEff, &cdim);
3330:         PetscMemzero(tup,(dim+1)*sizeof(PetscInt));
3331:         if (!tensorSpace) {
3332:           while (!tup[dim]) {
3333:             for (c = 0; c < Nc; ++c) {
3334:               PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
3335:               PetscMalloc1(dim, &qpoints);
3336:               PetscCalloc1(Nc,  &qweights);
3337:               PetscQuadratureSetOrder(sp->functional[f], 0);
3338:               PetscQuadratureSetData(sp->functional[f], dim, Nc, 1, qpoints, qweights);
3339:               for (d = 0; d < dim; ++d) {
3340:                 qpoints[d] = v0[d];
3341:                 for (d2 = 0; d2 < dim; ++d2) qpoints[d] += J[d*dim+d2]*((tup[d2]+1)*dx);
3342:               }
3343:               qweights[c] = 1.0;
3344:               ++f;
3345:             }
3346:             LatticePointLexicographic_Internal(dim, orderEff, tup);
3347:           }
3348:         } else {
3349:           while (!tup[dim]) {
3350:             for (c = 0; c < Nc; ++c) {
3351:               PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
3352:               PetscMalloc1(dim, &qpoints);
3353:               PetscCalloc1(Nc,  &qweights);
3354:               PetscQuadratureSetOrder(sp->functional[f], 0);
3355:               PetscQuadratureSetData(sp->functional[f], dim, Nc, 1, qpoints, qweights);
3356:               for (d = 0; d < dim; ++d) {
3357:                 qpoints[d] = v0[d];
3358:                 for (d2 = 0; d2 < dim; ++d2) qpoints[d] += J[d*dim+d2]*((tup[d2]+1)*dx);
3359:               }
3360:               qweights[c] = 1.0;
3361:               ++f;
3362:             }
3363:             TensorPointLexicographic_Internal(dim, orderEff, tup);
3364:           }
3365:         }
3366:         lag->numDof[dim] = cdim;
3367:       } else { /* transform functionals from subspaces */
3368:         PetscInt q;

3370:         for (q = 0; q < nFunc; q++, f++) {
3371:           PetscQuadrature fn;
3372:           PetscInt        fdim, Nc, c, nPoints, i;
3373:           const PetscReal *points;
3374:           const PetscReal *weights;
3375:           PetscReal       *qpoints;
3376:           PetscReal       *qweights;

3378:           PetscDualSpaceGetFunctional(hsp, q, &fn);
3379:           PetscQuadratureGetData(fn,&fdim,&Nc,&nPoints,&points,&weights);
3380:           if (fdim != pointDim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expected height dual space dim %D, got %D",pointDim,fdim);
3381:           PetscMalloc1(nPoints * dim, &qpoints);
3382:           PetscCalloc1(nPoints * Nc,  &qweights);
3383:           for (i = 0; i < nPoints; i++) {
3384:             PetscInt  j, k;
3385:             PetscReal *qp = &qpoints[i * dim];

3387:             for (c = 0; c < Nc; ++c) qweights[i*Nc+c] = weights[i*Nc+c];
3388:             for (j = 0; j < dim; ++j) qp[j] = v0[j];
3389:             for (j = 0; j < dim; ++j) {
3390:               for (k = 0; k < pointDim; k++) qp[j] += J[dim * j + k] * (points[pointDim * i + k] - hv0[k]);
3391:             }
3392:           }
3393:           PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
3394:           PetscQuadratureSetOrder(sp->functional[f],0);
3395:           PetscQuadratureSetData(sp->functional[f],dim,Nc,nPoints,qpoints,qweights);
3396:         }
3397:       }
3398:       PetscSectionSetDof(section,p,lag->numDof[pointDim]);
3399:     }
3400:     PetscFree5(tup,v0,hv0,J,invJ);
3401:     PetscSectionSetUp(section);
3402:     { /* reorder to closure order */
3403:       PetscInt *key, count;
3404:       PetscQuadrature *reorder = NULL;

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

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

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

3416:           PetscSectionGetDof(section,point,&dof);
3417:           PetscSectionGetOffset(section,point,&off);
3418:           for (i = 0; i < dof; i++) {
3419:             PetscInt fi = i + off;
3420:             if (!key[fi]) {
3421:               key[fi] = 1;
3422:               reorder[count++] = sp->functional[fi];
3423:             }
3424:           }
3425:         }
3426:         DMPlexRestoreTransitiveClosure(dm,p,PETSC_TRUE,&closureSize,&closure);
3427:       }
3428:       PetscFree(sp->functional);
3429:       sp->functional = reorder;
3430:       PetscFree(key);
3431:     }
3432:     PetscSectionDestroy(&section);
3433:   }
3434:   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);
3435:   PetscFree2(pStratStart, pStratEnd);
3436:   if (f > pdimMax) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of dual basis vectors %d is greater than dimension %d", f, pdimMax);
3437:   return(0);
3438: }

3440: PetscErrorCode PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp)
3441: {
3442:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
3443:   PetscInt            i;
3444:   PetscErrorCode      ierr;

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

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

3453:       for (i = 0; i < lag->numSelfSym; i++) {
3454:         PetscFree(allocated[i]);
3455:       }
3456:       PetscFree(allocated);
3457:     }
3458:     PetscFree(lag->symmetries);
3459:   }
3460:   for (i = 0; i < lag->height; i++) {
3461:     PetscDualSpaceDestroy(&lag->subspaces[i]);
3462:   }
3463:   PetscFree(lag->subspaces);
3464:   PetscFree(lag->numDof);
3465:   PetscFree(lag);
3466:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", NULL);
3467:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", NULL);
3468:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", NULL);
3469:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", NULL);
3470:   return(0);
3471: }

3473: static PetscErrorCode PetscDualSpaceLagrangeView_Ascii(PetscDualSpace sp, PetscViewer viewer)
3474: {
3475:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
3476:   PetscErrorCode      ierr;

3479:   PetscViewerASCIIPrintf(viewer, "%s %sLagrange dual space of order %D", lag->continuous ? "Continuous" : "Discontinuous", lag->tensorSpace ? "Tensor " : "", sp->order);
3480:   if (sp->Nc > 1) {PetscViewerASCIIPrintf(viewer, " with %D components", sp->Nc);}
3481:   PetscViewerASCIIPrintf(viewer, "\n");
3482:   return(0);
3483: }

3485: PetscErrorCode PetscDualSpaceView_Lagrange(PetscDualSpace sp, PetscViewer viewer)
3486: {
3487:   PetscBool      iascii;

3493:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
3494:   if (iascii) {PetscDualSpaceLagrangeView_Ascii(sp, viewer);}
3495:   return(0);
3496: }

3498: PetscErrorCode PetscDualSpaceDuplicate_Lagrange(PetscDualSpace sp, PetscDualSpace *spNew)
3499: {
3500:   PetscInt       order, Nc;
3501:   PetscBool      cont, tensor;

3505:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) sp), spNew);
3506:   PetscDualSpaceSetType(*spNew, PETSCDUALSPACELAGRANGE);
3507:   PetscDualSpaceGetOrder(sp, &order);
3508:   PetscDualSpaceSetOrder(*spNew, order);
3509:   PetscDualSpaceGetNumComponents(sp, &Nc);
3510:   PetscDualSpaceSetNumComponents(*spNew, Nc);
3511:   PetscDualSpaceLagrangeGetContinuity(sp, &cont);
3512:   PetscDualSpaceLagrangeSetContinuity(*spNew, cont);
3513:   PetscDualSpaceLagrangeGetTensor(sp, &tensor);
3514:   PetscDualSpaceLagrangeSetTensor(*spNew, tensor);
3515:   return(0);
3516: }

3518: PetscErrorCode PetscDualSpaceSetFromOptions_Lagrange(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp)
3519: {
3520:   PetscBool      continuous, tensor, flg;

3524:   PetscDualSpaceLagrangeGetContinuity(sp, &continuous);
3525:   PetscDualSpaceLagrangeGetTensor(sp, &tensor);
3526:   PetscOptionsHead(PetscOptionsObject,"PetscDualSpace Lagrange Options");
3527:   PetscOptionsBool("-petscdualspace_lagrange_continuity", "Flag for continuous element", "PetscDualSpaceLagrangeSetContinuity", continuous, &continuous, &flg);
3528:   if (flg) {PetscDualSpaceLagrangeSetContinuity(sp, continuous);}
3529:   PetscOptionsBool("-petscdualspace_lagrange_tensor", "Flag for tensor dual space", "PetscDualSpaceLagrangeSetContinuity", tensor, &tensor, &flg);
3530:   if (flg) {PetscDualSpaceLagrangeSetTensor(sp, tensor);}
3531:   PetscOptionsTail();
3532:   return(0);
3533: }

3535: PetscErrorCode PetscDualSpaceGetDimension_Lagrange(PetscDualSpace sp, PetscInt *dim)
3536: {
3537:   DM              K;
3538:   const PetscInt *numDof;
3539:   PetscInt        spatialDim, Nc, size = 0, d;
3540:   PetscErrorCode  ierr;

3543:   PetscDualSpaceGetDM(sp, &K);
3544:   PetscDualSpaceGetNumDof(sp, &numDof);
3545:   DMGetDimension(K, &spatialDim);
3546:   DMPlexGetHeightStratum(K, 0, NULL, &Nc);
3547:   if (Nc == 1) {PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, sp->order, dim); return(0);}
3548:   for (d = 0; d <= spatialDim; ++d) {
3549:     PetscInt pStart, pEnd;

3551:     DMPlexGetDepthStratum(K, d, &pStart, &pEnd);
3552:     size += (pEnd-pStart)*numDof[d];
3553:   }
3554:   *dim = size;
3555:   return(0);
3556: }

3558: PetscErrorCode PetscDualSpaceGetNumDof_Lagrange(PetscDualSpace sp, const PetscInt **numDof)
3559: {
3560:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

3563:   *numDof = lag->numDof;
3564:   return(0);
3565: }

3567: static PetscErrorCode PetscDualSpaceLagrangeGetContinuity_Lagrange(PetscDualSpace sp, PetscBool *continuous)
3568: {
3569:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

3574:   *continuous = lag->continuous;
3575:   return(0);
3576: }

3578: static PetscErrorCode PetscDualSpaceLagrangeSetContinuity_Lagrange(PetscDualSpace sp, PetscBool continuous)
3579: {
3580:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

3584:   lag->continuous = continuous;
3585:   return(0);
3586: }

3588: /*@
3589:   PetscDualSpaceLagrangeGetContinuity - Retrieves the flag for element continuity

3591:   Not Collective

3593:   Input Parameter:
3594: . sp         - the PetscDualSpace

3596:   Output Parameter:
3597: . continuous - flag for element continuity

3599:   Level: intermediate

3601: .keywords: PetscDualSpace, Lagrange, continuous, discontinuous
3602: .seealso: PetscDualSpaceLagrangeSetContinuity()
3603: @*/
3604: PetscErrorCode PetscDualSpaceLagrangeGetContinuity(PetscDualSpace sp, PetscBool *continuous)
3605: {

3611:   PetscUseMethod(sp, "PetscDualSpaceLagrangeGetContinuity_C", (PetscDualSpace,PetscBool*),(sp,continuous));
3612:   return(0);
3613: }

3615: /*@
3616:   PetscDualSpaceLagrangeSetContinuity - Indicate whether the element is continuous

3618:   Logically Collective on PetscDualSpace

3620:   Input Parameters:
3621: + sp         - the PetscDualSpace
3622: - continuous - flag for element continuity

3624:   Options Database:
3625: . -petscdualspace_lagrange_continuity <bool>

3627:   Level: intermediate

3629: .keywords: PetscDualSpace, Lagrange, continuous, discontinuous
3630: .seealso: PetscDualSpaceLagrangeGetContinuity()
3631: @*/
3632: PetscErrorCode PetscDualSpaceLagrangeSetContinuity(PetscDualSpace sp, PetscBool continuous)
3633: {

3639:   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetContinuity_C", (PetscDualSpace,PetscBool),(sp,continuous));
3640:   return(0);
3641: }

3643: PetscErrorCode PetscDualSpaceGetHeightSubspace_Lagrange(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
3644: {
3645:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
3646:   PetscErrorCode     ierr;

3651:   if (height == 0) {
3652:     *bdsp = sp;
3653:   }
3654:   else {
3655:     DM dm;
3656:     PetscInt dim;

3658:     PetscDualSpaceGetDM(sp,&dm);
3659:     DMGetDimension(dm,&dim);
3660:     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);}
3661:     if (height <= lag->height) {
3662:       *bdsp = lag->subspaces[height-1];
3663:     }
3664:     else {
3665:       *bdsp = NULL;
3666:     }
3667:   }
3668:   return(0);
3669: }

3671: PetscErrorCode PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp)
3672: {
3674:   sp->ops->setfromoptions    = PetscDualSpaceSetFromOptions_Lagrange;
3675:   sp->ops->setup             = PetscDualSpaceSetUp_Lagrange;
3676:   sp->ops->view              = PetscDualSpaceView_Lagrange;
3677:   sp->ops->destroy           = PetscDualSpaceDestroy_Lagrange;
3678:   sp->ops->duplicate         = PetscDualSpaceDuplicate_Lagrange;
3679:   sp->ops->getdimension      = PetscDualSpaceGetDimension_Lagrange;
3680:   sp->ops->getnumdof         = PetscDualSpaceGetNumDof_Lagrange;
3681:   sp->ops->getheightsubspace = PetscDualSpaceGetHeightSubspace_Lagrange;
3682:   sp->ops->getsymmetries     = PetscDualSpaceGetSymmetries_Lagrange;
3683:   sp->ops->apply             = PetscDualSpaceApplyDefault;
3684:   sp->ops->applyall          = PetscDualSpaceApplyAllDefault;
3685:   sp->ops->createallpoints   = PetscDualSpaceCreateAllPointsDefault;
3686:   return(0);
3687: }

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

3692:   Level: intermediate

3694: .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
3695: M*/

3697: PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Lagrange(PetscDualSpace sp)
3698: {
3699:   PetscDualSpace_Lag *lag;
3700:   PetscErrorCode      ierr;

3704:   PetscNewLog(sp,&lag);
3705:   sp->data = lag;

3707:   lag->numDof      = NULL;
3708:   lag->simplexCell = PETSC_TRUE;
3709:   lag->tensorSpace = PETSC_FALSE;
3710:   lag->continuous  = PETSC_TRUE;

3712:   PetscDualSpaceInitialize_Lagrange(sp);
3713:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", PetscDualSpaceLagrangeGetContinuity_Lagrange);
3714:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", PetscDualSpaceLagrangeSetContinuity_Lagrange);
3715:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", PetscDualSpaceLagrangeGetTensor_Lagrange);
3716:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", PetscDualSpaceLagrangeSetTensor_Lagrange);
3717:   return(0);
3718: }

3720: PetscErrorCode PetscDualSpaceSetUp_Simple(PetscDualSpace sp)
3721: {
3722:   PetscDualSpace_Simple *s  = (PetscDualSpace_Simple *) sp->data;
3723:   DM                     dm = sp->dm;
3724:   PetscInt               dim;
3725:   PetscErrorCode         ierr;

3728:   DMGetDimension(dm, &dim);
3729:   PetscCalloc1(dim+1, &s->numDof);
3730:   return(0);
3731: }

3733: PetscErrorCode PetscDualSpaceDestroy_Simple(PetscDualSpace sp)
3734: {
3735:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
3736:   PetscErrorCode         ierr;

3739:   PetscFree(s->numDof);
3740:   PetscFree(s);
3741:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetDimension_C", NULL);
3742:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetFunctional_C", NULL);
3743:   return(0);
3744: }

3746: PetscErrorCode PetscDualSpaceDuplicate_Simple(PetscDualSpace sp, PetscDualSpace *spNew)
3747: {
3748:   PetscInt       dim, d, Nc;

3752:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) sp), spNew);
3753:   PetscDualSpaceSetType(*spNew, PETSCDUALSPACESIMPLE);
3754:   PetscDualSpaceGetNumComponents(sp, &Nc);
3755:   PetscDualSpaceSetNumComponents(sp, Nc);
3756:   PetscDualSpaceGetDimension(sp, &dim);
3757:   PetscDualSpaceSimpleSetDimension(*spNew, dim);
3758:   for (d = 0; d < dim; ++d) {
3759:     PetscQuadrature q;

3761:     PetscDualSpaceGetFunctional(sp, d, &q);
3762:     PetscDualSpaceSimpleSetFunctional(*spNew, d, q);
3763:   }
3764:   return(0);
3765: }

3767: PetscErrorCode PetscDualSpaceSetFromOptions_Simple(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp)
3768: {
3770:   return(0);
3771: }

3773: PetscErrorCode PetscDualSpaceGetDimension_Simple(PetscDualSpace sp, PetscInt *dim)
3774: {
3775:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;

3778:   *dim = s->dim;
3779:   return(0);
3780: }

3782: PetscErrorCode PetscDualSpaceSimpleSetDimension_Simple(PetscDualSpace sp, const PetscInt dim)
3783: {
3784:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
3785:   DM                     dm;
3786:   PetscInt               spatialDim, f;
3787:   PetscErrorCode         ierr;

3790:   for (f = 0; f < s->dim; ++f) {PetscQuadratureDestroy(&sp->functional[f]);}
3791:   PetscFree(sp->functional);
3792:   s->dim = dim;
3793:   PetscCalloc1(s->dim, &sp->functional);
3794:   PetscFree(s->numDof);
3795:   PetscDualSpaceGetDM(sp, &dm);
3796:   DMGetDimension(dm, &spatialDim);
3797:   PetscCalloc1(spatialDim+1, &s->numDof);
3798:   s->numDof[spatialDim] = dim;
3799:   return(0);
3800: }

3802: PetscErrorCode PetscDualSpaceGetNumDof_Simple(PetscDualSpace sp, const PetscInt **numDof)
3803: {
3804:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;

3807:   *numDof = s->numDof;
3808:   return(0);
3809: }

3811: PetscErrorCode PetscDualSpaceSimpleSetFunctional_Simple(PetscDualSpace sp, PetscInt f, PetscQuadrature q)
3812: {
3813:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
3814:   PetscReal             *weights;
3815:   PetscInt               Nc, c, Nq, p;
3816:   PetscErrorCode         ierr;

3819:   if ((f < 0) || (f >= s->dim)) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_OUTOFRANGE, "Basis index %d not in [0, %d)", f, s->dim);
3820:   PetscQuadratureDuplicate(q, &sp->functional[f]);
3821:   /* Reweight so that it has unit volume: Do we want to do this for Nc > 1? */
3822:   PetscQuadratureGetData(sp->functional[f], NULL, &Nc, &Nq, NULL, (const PetscReal **) &weights);
3823:   for (c = 0; c < Nc; ++c) {
3824:     PetscReal vol = 0.0;

3826:     for (p = 0; p < Nq; ++p) vol += weights[p*Nc+c];
3827:     for (p = 0; p < Nq; ++p) weights[p*Nc+c] /= (vol == 0.0 ? 1.0 : vol);
3828:   }
3829:   return(0);
3830: }

3832: /*@
3833:   PetscDualSpaceSimpleSetDimension - Set the number of functionals in the dual space basis

3835:   Logically Collective on PetscDualSpace

3837:   Input Parameters:
3838: + sp  - the PetscDualSpace
3839: - dim - the basis dimension

3841:   Level: intermediate

3843: .keywords: PetscDualSpace, dimension
3844: .seealso: PetscDualSpaceSimpleSetFunctional()
3845: @*/
3846: PetscErrorCode PetscDualSpaceSimpleSetDimension(PetscDualSpace sp, PetscInt dim)
3847: {

3853:   PetscTryMethod(sp, "PetscDualSpaceSimpleSetDimension_C", (PetscDualSpace,PetscInt),(sp,dim));
3854:   return(0);
3855: }

3857: /*@
3858:   PetscDualSpaceSimpleSetFunctional - Set the given basis element for this dual space

3860:   Not Collective

3862:   Input Parameters:
3863: + sp  - the PetscDualSpace
3864: . f - the basis index
3865: - q - the basis functional

3867:   Level: intermediate

3869:   Note: The quadrature will be reweighted so that it has unit volume.

3871: .keywords: PetscDualSpace, functional
3872: .seealso: PetscDualSpaceSimpleSetDimension()
3873: @*/
3874: PetscErrorCode PetscDualSpaceSimpleSetFunctional(PetscDualSpace sp, PetscInt func, PetscQuadrature q)
3875: {

3880:   PetscTryMethod(sp, "PetscDualSpaceSimpleSetFunctional_C", (PetscDualSpace,PetscInt,PetscQuadrature),(sp,func,q));
3881:   return(0);
3882: }

3884: PetscErrorCode PetscDualSpaceInitialize_Simple(PetscDualSpace sp)
3885: {
3887:   sp->ops->setfromoptions    = PetscDualSpaceSetFromOptions_Simple;
3888:   sp->ops->setup             = PetscDualSpaceSetUp_Simple;
3889:   sp->ops->view              = NULL;
3890:   sp->ops->destroy           = PetscDualSpaceDestroy_Simple;
3891:   sp->ops->duplicate         = PetscDualSpaceDuplicate_Simple;
3892:   sp->ops->getdimension      = PetscDualSpaceGetDimension_Simple;
3893:   sp->ops->getnumdof         = PetscDualSpaceGetNumDof_Simple;
3894:   sp->ops->getheightsubspace = NULL;
3895:   sp->ops->getsymmetries     = NULL;
3896:   sp->ops->apply             = PetscDualSpaceApplyDefault;
3897:   sp->ops->applyall          = PetscDualSpaceApplyAllDefault;
3898:   sp->ops->createallpoints   = PetscDualSpaceCreateAllPointsDefault;
3899:   return(0);
3900: }

3902: /*MC
3903:   PETSCDUALSPACESIMPLE = "simple" - A PetscDualSpace object that encapsulates a dual space of arbitrary functionals

3905:   Level: intermediate

3907: .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
3908: M*/

3910: PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Simple(PetscDualSpace sp)
3911: {
3912:   PetscDualSpace_Simple *s;
3913:   PetscErrorCode         ierr;

3917:   PetscNewLog(sp,&s);
3918:   sp->data = s;

3920:   s->dim    = 0;
3921:   s->numDof = NULL;

3923:   PetscDualSpaceInitialize_Simple(sp);
3924:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetDimension_C", PetscDualSpaceSimpleSetDimension_Simple);
3925:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetFunctional_C", PetscDualSpaceSimpleSetFunctional_Simple);
3926:   return(0);
3927: }


3930: PetscClassId PETSCFE_CLASSID = 0;

3932: PetscFunctionList PetscFEList              = NULL;
3933: PetscBool         PetscFERegisterAllCalled = PETSC_FALSE;

3935: /*@C
3936:   PetscFERegister - Adds a new PetscFE implementation

3938:   Not Collective

3940:   Input Parameters:
3941: + name        - The name of a new user-defined creation routine
3942: - create_func - The creation routine itself

3944:   Notes:
3945:   PetscFERegister() may be called multiple times to add several user-defined PetscFEs

3947:   Sample usage:
3948: .vb
3949:     PetscFERegister("my_fe", MyPetscFECreate);
3950: .ve

3952:   Then, your PetscFE type can be chosen with the procedural interface via
3953: .vb
3954:     PetscFECreate(MPI_Comm, PetscFE *);
3955:     PetscFESetType(PetscFE, "my_fe");
3956: .ve
3957:    or at runtime via the option
3958: .vb
3959:     -petscfe_type my_fe
3960: .ve

3962:   Level: advanced

3964: .keywords: PetscFE, register
3965: .seealso: PetscFERegisterAll(), PetscFERegisterDestroy()

3967: @*/
3968: PetscErrorCode PetscFERegister(const char sname[], PetscErrorCode (*function)(PetscFE))
3969: {

3973:   PetscFunctionListAdd(&PetscFEList, sname, function);
3974:   return(0);
3975: }

3977: /*@C
3978:   PetscFESetType - Builds a particular PetscFE

3980:   Collective on PetscFE

3982:   Input Parameters:
3983: + fem  - The PetscFE object
3984: - name - The kind of FEM space

3986:   Options Database Key:
3987: . -petscfe_type <type> - Sets the PetscFE type; use -help for a list of available types

3989:   Level: intermediate

3991: .keywords: PetscFE, set, type
3992: .seealso: PetscFEGetType(), PetscFECreate()
3993: @*/
3994: PetscErrorCode PetscFESetType(PetscFE fem, PetscFEType name)
3995: {
3996:   PetscErrorCode (*r)(PetscFE);
3997:   PetscBool      match;

4002:   PetscObjectTypeCompare((PetscObject) fem, name, &match);
4003:   if (match) return(0);

4005:   if (!PetscFERegisterAllCalled) {PetscFERegisterAll();}
4006:   PetscFunctionListFind(PetscFEList, name, &r);
4007:   if (!r) SETERRQ1(PetscObjectComm((PetscObject) fem), PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown PetscFE type: %s", name);

4009:   if (fem->ops->destroy) {
4010:     (*fem->ops->destroy)(fem);
4011:     fem->ops->destroy = NULL;
4012:   }
4013:   (*r)(fem);
4014:   PetscObjectChangeTypeName((PetscObject) fem, name);
4015:   return(0);
4016: }

4018: /*@C
4019:   PetscFEGetType - Gets the PetscFE type name (as a string) from the object.

4021:   Not Collective

4023:   Input Parameter:
4024: . fem  - The PetscFE

4026:   Output Parameter:
4027: . name - The PetscFE type name

4029:   Level: intermediate

4031: .keywords: PetscFE, get, type, name
4032: .seealso: PetscFESetType(), PetscFECreate()
4033: @*/
4034: PetscErrorCode PetscFEGetType(PetscFE fem, PetscFEType *name)
4035: {

4041:   if (!PetscFERegisterAllCalled) {
4042:     PetscFERegisterAll();
4043:   }
4044:   *name = ((PetscObject) fem)->type_name;
4045:   return(0);
4046: }

4048: /*@C
4049:   PetscFEView - Views a PetscFE

4051:   Collective on PetscFE

4053:   Input Parameter:
4054: + fem - the PetscFE object to view
4055: - v   - the viewer

4057:   Level: developer

4059: .seealso PetscFEDestroy()
4060: @*/
4061: PetscErrorCode PetscFEView(PetscFE fem, PetscViewer v)
4062: {

4067:   if (!v) {PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) fem), &v);}
4068:   if (fem->ops->view) {(*fem->ops->view)(fem, v);}
4069:   return(0);
4070: }

4072: /*@
4073:   PetscFESetFromOptions - sets parameters in a PetscFE from the options database

4075:   Collective on PetscFE

4077:   Input Parameter:
4078: . fem - the PetscFE object to set options for

4080:   Options Database:
4081: . -petscfe_num_blocks  the number of cell blocks to integrate concurrently
4082: . -petscfe_num_batches the number of cell batches to integrate serially

4084:   Level: developer

4086: .seealso PetscFEView()
4087: @*/
4088: PetscErrorCode PetscFESetFromOptions(PetscFE fem)
4089: {
4090:   const char    *defaultType;
4091:   char           name[256];
4092:   PetscBool      flg;

4097:   if (!((PetscObject) fem)->type_name) {
4098:     defaultType = PETSCFEBASIC;
4099:   } else {
4100:     defaultType = ((PetscObject) fem)->type_name;
4101:   }
4102:   if (!PetscFERegisterAllCalled) {PetscFERegisterAll();}

4104:   PetscObjectOptionsBegin((PetscObject) fem);
4105:   PetscOptionsFList("-petscfe_type", "Finite element space", "PetscFESetType", PetscFEList, defaultType, name, 256, &flg);
4106:   if (flg) {
4107:     PetscFESetType(fem, name);
4108:   } else if (!((PetscObject) fem)->type_name) {
4109:     PetscFESetType(fem, defaultType);
4110:   }
4111:   PetscOptionsInt("-petscfe_num_blocks", "The number of cell blocks to integrate concurrently", "PetscSpaceSetTileSizes", fem->numBlocks, &fem->numBlocks, NULL);
4112:   PetscOptionsInt("-petscfe_num_batches", "The number of cell batches to integrate serially", "PetscSpaceSetTileSizes", fem->numBatches, &fem->numBatches, NULL);
4113:   if (fem->ops->setfromoptions) {
4114:     (*fem->ops->setfromoptions)(PetscOptionsObject,fem);
4115:   }
4116:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
4117:   PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) fem);
4118:   PetscOptionsEnd();
4119:   PetscFEViewFromOptions(fem, NULL, "-petscfe_view");
4120:   return(0);
4121: }

4123: /*@C
4124:   PetscFESetUp - Construct data structures for the PetscFE

4126:   Collective on PetscFE

4128:   Input Parameter:
4129: . fem - the PetscFE object to setup

4131:   Level: developer

4133: .seealso PetscFEView(), PetscFEDestroy()
4134: @*/
4135: PetscErrorCode PetscFESetUp(PetscFE fem)
4136: {

4141:   if (fem->setupcalled) return(0);
4142:   fem->setupcalled = PETSC_TRUE;
4143:   if (fem->ops->setup) {(*fem->ops->setup)(fem);}
4144:   return(0);
4145: }

4147: /*@
4148:   PetscFEDestroy - Destroys a PetscFE object

4150:   Collective on PetscFE

4152:   Input Parameter:
4153: . fem - the PetscFE object to destroy

4155:   Level: developer

4157: .seealso PetscFEView()
4158: @*/
4159: PetscErrorCode PetscFEDestroy(PetscFE *fem)
4160: {

4164:   if (!*fem) return(0);

4167:   if (--((PetscObject)(*fem))->refct > 0) {*fem = 0; return(0);}
4168:   ((PetscObject) (*fem))->refct = 0;

4170:   if ((*fem)->subspaces) {
4171:     PetscInt dim, d;

4173:     PetscDualSpaceGetDimension((*fem)->dualSpace, &dim);
4174:     for (d = 0; d < dim; ++d) {PetscFEDestroy(&(*fem)->subspaces[d]);}
4175:   }
4176:   PetscFree((*fem)->subspaces);
4177:   PetscFree((*fem)->invV);
4178:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->B, &(*fem)->D, NULL /*&(*fem)->H*/);
4179:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->Bf, &(*fem)->Df, NULL /*&(*fem)->Hf*/);
4180:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->F, NULL, NULL);
4181:   PetscSpaceDestroy(&(*fem)->basisSpace);
4182:   PetscDualSpaceDestroy(&(*fem)->dualSpace);
4183:   PetscQuadratureDestroy(&(*fem)->quadrature);
4184:   PetscQuadratureDestroy(&(*fem)->faceQuadrature);

4186:   if ((*fem)->ops->destroy) {(*(*fem)->ops->destroy)(*fem);}
4187:   PetscHeaderDestroy(fem);
4188:   return(0);
4189: }

4191: /*@
4192:   PetscFECreate - Creates an empty PetscFE object. The type can then be set with PetscFESetType().

4194:   Collective on MPI_Comm

4196:   Input Parameter:
4197: . comm - The communicator for the PetscFE object

4199:   Output Parameter:
4200: . fem - The PetscFE object

4202:   Level: beginner

4204: .seealso: PetscFESetType(), PETSCFEGALERKIN
4205: @*/
4206: PetscErrorCode PetscFECreate(MPI_Comm comm, PetscFE *fem)
4207: {
4208:   PetscFE        f;

4213:   PetscCitationsRegister(FECitation,&FEcite);
4214:   *fem = NULL;
4215:   PetscFEInitializePackage();

4217:   PetscHeaderCreate(f, PETSCFE_CLASSID, "PetscFE", "Finite Element", "PetscFE", comm, PetscFEDestroy, PetscFEView);

4219:   f->basisSpace    = NULL;
4220:   f->dualSpace     = NULL;
4221:   f->numComponents = 1;
4222:   f->subspaces     = NULL;
4223:   f->invV          = NULL;
4224:   f->B             = NULL;
4225:   f->D             = NULL;
4226:   f->H             = NULL;
4227:   f->Bf            = NULL;
4228:   f->Df            = NULL;
4229:   f->Hf            = NULL;
4230:   PetscMemzero(&f->quadrature, sizeof(PetscQuadrature));
4231:   PetscMemzero(&f->faceQuadrature, sizeof(PetscQuadrature));
4232:   f->blockSize     = 0;
4233:   f->numBlocks     = 1;
4234:   f->batchSize     = 0;
4235:   f->numBatches    = 1;

4237:   *fem = f;
4238:   return(0);
4239: }

4241: /*@
4242:   PetscFEGetSpatialDimension - Returns the spatial/topological dimension of the element

4244:   Not collective

4246:   Input Parameter:
4247: . fem - The PetscFE object

4249:   Output Parameter:
4250: . dim - The spatial/topological dimension

4252:   Level: intermediate

4254: .seealso: PetscFECreate()
4255: @*/
4256: PetscErrorCode PetscFEGetSpatialDimension(PetscFE fem, PetscInt *dim)
4257: {
4258:   DM             dm;

4264:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
4265:   DMGetDimension(dm, dim);
4266:   return(0);
4267: }

4269: /*@
4270:   PetscFESetNumComponents - Sets the number of components in the element

4272:   Not collective

4274:   Input Parameters:
4275: + fem - The PetscFE object
4276: - comp - The number of field components

4278:   Level: intermediate

4280: .seealso: PetscFECreate()
4281: @*/
4282: PetscErrorCode PetscFESetNumComponents(PetscFE fem, PetscInt comp)
4283: {
4286:   fem->numComponents = comp;
4287:   return(0);
4288: }

4290: /*@
4291:   PetscFEGetNumComponents - Returns the number of components in the element

4293:   Not collective

4295:   Input Parameter:
4296: . fem - The PetscFE object

4298:   Output Parameter:
4299: . comp - The number of field components

4301:   Level: intermediate

4303: .seealso: PetscFECreate()
4304: @*/
4305: PetscErrorCode PetscFEGetNumComponents(PetscFE fem, PetscInt *comp)
4306: {
4310:   *comp = fem->numComponents;
4311:   return(0);
4312: }

4314: /*@
4315:   PetscFESetTileSizes - Sets the tile sizes for evaluation

4317:   Not collective

4319:   Input Parameters:
4320: + fem - The PetscFE object
4321: . blockSize - The number of elements in a block
4322: . numBlocks - The number of blocks in a batch
4323: . batchSize - The number of elements in a batch
4324: - numBatches - The number of batches in a chunk

4326:   Level: intermediate

4328: .seealso: PetscFECreate()
4329: @*/
4330: PetscErrorCode PetscFESetTileSizes(PetscFE fem, PetscInt blockSize, PetscInt numBlocks, PetscInt batchSize, PetscInt numBatches)
4331: {
4334:   fem->blockSize  = blockSize;
4335:   fem->numBlocks  = numBlocks;
4336:   fem->batchSize  = batchSize;
4337:   fem->numBatches = numBatches;
4338:   return(0);
4339: }

4341: /*@
4342:   PetscFEGetTileSizes - Returns the tile sizes for evaluation

4344:   Not collective

4346:   Input Parameter:
4347: . fem - The PetscFE object

4349:   Output Parameters:
4350: + blockSize - The number of elements in a block
4351: . numBlocks - The number of blocks in a batch
4352: . batchSize - The number of elements in a batch
4353: - numBatches - The number of batches in a chunk

4355:   Level: intermediate

4357: .seealso: PetscFECreate()
4358: @*/
4359: PetscErrorCode PetscFEGetTileSizes(PetscFE fem, PetscInt *blockSize, PetscInt *numBlocks, PetscInt *batchSize, PetscInt *numBatches)
4360: {
4367:   if (blockSize)  *blockSize  = fem->blockSize;
4368:   if (numBlocks)  *numBlocks  = fem->numBlocks;
4369:   if (batchSize)  *batchSize  = fem->batchSize;
4370:   if (numBatches) *numBatches = fem->numBatches;
4371:   return(0);
4372: }

4374: /*@
4375:   PetscFEGetBasisSpace - Returns the PetscSpace used for approximation of the solution

4377:   Not collective

4379:   Input Parameter:
4380: . fem - The PetscFE object

4382:   Output Parameter:
4383: . sp - The PetscSpace object

4385:   Level: intermediate

4387: .seealso: PetscFECreate()
4388: @*/
4389: PetscErrorCode PetscFEGetBasisSpace(PetscFE fem, PetscSpace *sp)
4390: {
4394:   *sp = fem->basisSpace;
4395:   return(0);
4396: }

4398: /*@
4399:   PetscFESetBasisSpace - Sets the PetscSpace used for approximation of the solution

4401:   Not collective

4403:   Input Parameters:
4404: + fem - The PetscFE object
4405: - sp - The PetscSpace object

4407:   Level: intermediate

4409: .seealso: PetscFECreate()
4410: @*/
4411: PetscErrorCode PetscFESetBasisSpace(PetscFE fem, PetscSpace sp)
4412: {

4418:   PetscSpaceDestroy(&fem->basisSpace);
4419:   fem->basisSpace = sp;
4420:   PetscObjectReference((PetscObject) fem->basisSpace);
4421:   return(0);
4422: }

4424: /*@
4425:   PetscFEGetDualSpace - Returns the PetscDualSpace used to define the inner product

4427:   Not collective

4429:   Input Parameter:
4430: . fem - The PetscFE object

4432:   Output Parameter:
4433: . sp - The PetscDualSpace object

4435:   Level: intermediate

4437: .seealso: PetscFECreate()
4438: @*/
4439: PetscErrorCode PetscFEGetDualSpace(PetscFE fem, PetscDualSpace *sp)
4440: {
4444:   *sp = fem->dualSpace;
4445:   return(0);
4446: }

4448: /*@
4449:   PetscFESetDualSpace - Sets the PetscDualSpace used to define the inner product

4451:   Not collective

4453:   Input Parameters:
4454: + fem - The PetscFE object
4455: - sp - The PetscDualSpace object

4457:   Level: intermediate

4459: .seealso: PetscFECreate()
4460: @*/
4461: PetscErrorCode PetscFESetDualSpace(PetscFE fem, PetscDualSpace sp)
4462: {

4468:   PetscDualSpaceDestroy(&fem->dualSpace);
4469:   fem->dualSpace = sp;
4470:   PetscObjectReference((PetscObject) fem->dualSpace);
4471:   return(0);
4472: }

4474: /*@
4475:   PetscFEGetQuadrature - Returns the PetscQuadrature used to calculate inner products

4477:   Not collective

4479:   Input Parameter:
4480: . fem - The PetscFE object

4482:   Output Parameter:
4483: . q - The PetscQuadrature object

4485:   Level: intermediate

4487: .seealso: PetscFECreate()
4488: @*/
4489: PetscErrorCode PetscFEGetQuadrature(PetscFE fem, PetscQuadrature *q)
4490: {
4494:   *q = fem->quadrature;
4495:   return(0);
4496: }

4498: /*@
4499:   PetscFESetQuadrature - Sets the PetscQuadrature used to calculate inner products

4501:   Not collective

4503:   Input Parameters:
4504: + fem - The PetscFE object
4505: - q - The PetscQuadrature object

4507:   Level: intermediate

4509: .seealso: PetscFECreate()
4510: @*/
4511: PetscErrorCode PetscFESetQuadrature(PetscFE fem, PetscQuadrature q)
4512: {
4513:   PetscInt       Nc, qNc;

4518:   PetscFEGetNumComponents(fem, &Nc);
4519:   PetscQuadratureGetNumComponents(q, &qNc);
4520:   if ((qNc != 1) && (Nc != qNc)) SETERRQ2(PetscObjectComm((PetscObject) fem), PETSC_ERR_ARG_SIZ, "FE components %D != Quadrature components %D and non-scalar quadrature", Nc, qNc);
4521:   PetscFERestoreTabulation(fem, 0, NULL, &fem->B, &fem->D, NULL /*&(*fem)->H*/);
4522:   PetscQuadratureDestroy(&fem->quadrature);
4523:   fem->quadrature = q;
4524:   PetscObjectReference((PetscObject) q);
4525:   return(0);
4526: }

4528: /*@
4529:   PetscFEGetFaceQuadrature - Returns the PetscQuadrature used to calculate inner products on faces

4531:   Not collective

4533:   Input Parameter:
4534: . fem - The PetscFE object

4536:   Output Parameter:
4537: . q - The PetscQuadrature object

4539:   Level: intermediate

4541: .seealso: PetscFECreate()
4542: @*/
4543: PetscErrorCode PetscFEGetFaceQuadrature(PetscFE fem, PetscQuadrature *q)
4544: {
4548:   *q = fem->faceQuadrature;
4549:   return(0);
4550: }

4552: /*@
4553:   PetscFESetFaceQuadrature - Sets the PetscQuadrature used to calculate inner products on faces

4555:   Not collective

4557:   Input Parameters:
4558: + fem - The PetscFE object
4559: - q - The PetscQuadrature object

4561:   Level: intermediate

4563: .seealso: PetscFECreate()
4564: @*/
4565: PetscErrorCode PetscFESetFaceQuadrature(PetscFE fem, PetscQuadrature q)
4566: {

4571:   PetscFERestoreTabulation(fem, 0, NULL, &fem->Bf, &fem->Df, NULL /*&(*fem)->Hf*/);
4572:   PetscQuadratureDestroy(&fem->faceQuadrature);
4573:   fem->faceQuadrature = q;
4574:   PetscObjectReference((PetscObject) q);
4575:   return(0);
4576: }

4578: /*@C
4579:   PetscFEGetNumDof - Returns the number of dofs (dual basis vectors) associated to mesh points on the reference cell of a given dimension

4581:   Not collective

4583:   Input Parameter:
4584: . fem - The PetscFE object

4586:   Output Parameter:
4587: . numDof - Array with the number of dofs per dimension

4589:   Level: intermediate

4591: .seealso: PetscFECreate()
4592: @*/
4593: PetscErrorCode PetscFEGetNumDof(PetscFE fem, const PetscInt **numDof)
4594: {

4600:   PetscDualSpaceGetNumDof(fem->dualSpace, numDof);
4601:   return(0);
4602: }

4604: /*@C
4605:   PetscFEGetDefaultTabulation - Returns the tabulation of the basis functions at the quadrature points

4607:   Not collective

4609:   Input Parameter:
4610: . fem - The PetscFE object

4612:   Output Parameters:
4613: + B - The basis function values at quadrature points
4614: . D - The basis function derivatives at quadrature points
4615: - H - The basis function second derivatives at quadrature points

4617:   Note:
4618: $ B[(p*pdim + i)*Nc + c] is the value at point p for basis function i and component c
4619: $ D[((p*pdim + i)*Nc + c)*dim + d] is the derivative value at point p for basis function i, component c, in direction d
4620: $ H[(((p*pdim + i)*Nc + c)*dim + d)*dim + e] is the value at point p for basis function i, component c, in directions d and e

4622:   Level: intermediate

4624: .seealso: PetscFEGetTabulation(), PetscFERestoreTabulation()
4625: @*/
4626: PetscErrorCode PetscFEGetDefaultTabulation(PetscFE fem, PetscReal **B, PetscReal **D, PetscReal **H)
4627: {
4628:   PetscInt         npoints;
4629:   const PetscReal *points;
4630:   PetscErrorCode   ierr;

4637:   PetscQuadratureGetData(fem->quadrature, NULL, NULL, &npoints, &points, NULL);
4638:   if (!fem->B) {PetscFEGetTabulation(fem, npoints, points, &fem->B, &fem->D, NULL/*&fem->H*/);}
4639:   if (B) *B = fem->B;
4640:   if (D) *D = fem->D;
4641:   if (H) *H = fem->H;
4642:   return(0);
4643: }

4645: /* This tabulates the cell basis functions on each face bounding the cell */
4646: PetscErrorCode PetscFEGetFaceTabulation(PetscFE fem, PetscReal **Bf, PetscReal **Df, PetscReal **Hf)
4647: {
4648:   PetscErrorCode   ierr;

4655:   if (!fem->Bf) {
4656:     const PetscReal  xi0[3] = {-1., -1., -1.};
4657:     PetscReal        v0[3], J[9], detJ;
4658:     PetscQuadrature  fq;
4659:     PetscDualSpace   sp;
4660:     DM               dm;
4661:     const PetscInt  *faces;
4662:     PetscInt         dim, numFaces, f, npoints, q;
4663:     const PetscReal *points;
4664:     PetscReal       *facePoints;

4666:     PetscFEGetDualSpace(fem, &sp);
4667:     PetscDualSpaceGetDM(sp, &dm);
4668:     DMGetDimension(dm, &dim);
4669:     DMPlexGetConeSize(dm, 0, &numFaces);
4670:     DMPlexGetCone(dm, 0, &faces);
4671:     PetscFEGetFaceQuadrature(fem, &fq);
4672:     if (fq) {
4673:       PetscQuadratureGetData(fq, NULL, NULL, &npoints, &points, NULL);
4674:       PetscMalloc1(numFaces*npoints*dim, &facePoints);
4675:       for (f = 0; f < numFaces; ++f) {
4676:         DMPlexComputeCellGeometryFEM(dm, faces[f], NULL, v0, J, NULL, &detJ);
4677:         for (q = 0; q < npoints; ++q) CoordinatesRefToReal(dim, dim-1, xi0, v0, J, &points[q*(dim-1)], &facePoints[(f*npoints+q)*dim]);
4678:       }
4679:       PetscFEGetTabulation(fem, numFaces*npoints, facePoints, &fem->Bf, &fem->Df, NULL/*&fem->Hf*/);
4680:       PetscFree(facePoints);
4681:     }
4682:   }
4683:   if (Bf) *Bf = fem->Bf;
4684:   if (Df) *Df = fem->Df;
4685:   if (Hf) *Hf = fem->Hf;
4686:   return(0);
4687: }

4689: PetscErrorCode PetscFEGetFaceCentroidTabulation(PetscFE fem, PetscReal **F)
4690: {
4691:   PetscErrorCode   ierr;

4696:   if (!fem->F) {
4697:     PetscDualSpace  sp;
4698:     DM              dm;
4699:     const PetscInt *cone;
4700:     PetscReal      *centroids;
4701:     PetscInt        dim, numFaces, f;

4703:     PetscFEGetDualSpace(fem, &sp);
4704:     PetscDualSpaceGetDM(sp, &dm);
4705:     DMGetDimension(dm, &dim);
4706:     DMPlexGetConeSize(dm, 0, &numFaces);
4707:     DMPlexGetCone(dm, 0, &cone);
4708:     PetscMalloc1(numFaces*dim, &centroids);
4709:     for (f = 0; f < numFaces; ++f) {DMPlexComputeCellGeometryFVM(dm, cone[f], NULL, &centroids[f*dim], NULL);}
4710:     PetscFEGetTabulation(fem, numFaces, centroids, &fem->F, NULL, NULL);
4711:     PetscFree(centroids);
4712:   }
4713:   *F = fem->F;
4714:   return(0);
4715: }

4717: /*@C
4718:   PetscFEGetTabulation - Tabulates the basis functions, and perhaps derivatives, at the points provided.

4720:   Not collective

4722:   Input Parameters:
4723: + fem     - The PetscFE object
4724: . npoints - The number of tabulation points
4725: - points  - The tabulation point coordinates

4727:   Output Parameters:
4728: + B - The basis function values at tabulation points
4729: . D - The basis function derivatives at tabulation points
4730: - H - The basis function second derivatives at tabulation points

4732:   Note:
4733: $ B[(p*pdim + i)*Nc + c] is the value at point p for basis function i and component c
4734: $ D[((p*pdim + i)*Nc + c)*dim + d] is the derivative value at point p for basis function i, component c, in direction d
4735: $ H[(((p*pdim + i)*Nc + c)*dim + d)*dim + e] is the value at point p for basis function i, component c, in directions d and e

4737:   Level: intermediate

4739: .seealso: PetscFERestoreTabulation(), PetscFEGetDefaultTabulation()
4740: @*/
4741: PetscErrorCode PetscFEGetTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal **B, PetscReal **D, PetscReal **H)
4742: {
4743:   DM               dm;
4744:   PetscInt         pdim; /* Dimension of FE space P */
4745:   PetscInt         dim;  /* Spatial dimension */
4746:   PetscInt         comp; /* Field components */
4747:   PetscErrorCode   ierr;

4750:   if (!npoints) {
4751:     if (B) *B = NULL;
4752:     if (D) *D = NULL;
4753:     if (H) *H = NULL;
4754:     return(0);
4755:   }
4761:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
4762:   DMGetDimension(dm, &dim);
4763:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
4764:   PetscFEGetNumComponents(fem, &comp);
4765:   if (B) {DMGetWorkArray(dm, npoints*pdim*comp, MPIU_REAL, B);}
4766:   if (!dim) {
4767:     if (D) *D = NULL;
4768:     if (H) *H = NULL;
4769:   } else {
4770:     if (D) {DMGetWorkArray(dm, npoints*pdim*comp*dim, MPIU_REAL, D);}
4771:     if (H) {DMGetWorkArray(dm, npoints*pdim*comp*dim*dim, MPIU_REAL, H);}
4772:   }
4773:   (*fem->ops->gettabulation)(fem, npoints, points, B ? *B : NULL, D ? *D : NULL, H ? *H : NULL);
4774:   return(0);
4775: }

4777: PetscErrorCode PetscFERestoreTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal **B, PetscReal **D, PetscReal **H)
4778: {
4779:   DM             dm;

4784:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
4785:   if (B && *B) {DMRestoreWorkArray(dm, 0, MPIU_REAL, B);}
4786:   if (D && *D) {DMRestoreWorkArray(dm, 0, MPIU_REAL, D);}
4787:   if (H && *H) {DMRestoreWorkArray(dm, 0, MPIU_REAL, H);}
4788:   return(0);
4789: }

4791: PetscErrorCode PetscFEDestroy_Basic(PetscFE fem)
4792: {
4793:   PetscFE_Basic *b = (PetscFE_Basic *) fem->data;

4797:   PetscFree(b);
4798:   return(0);
4799: }

4801: PetscErrorCode PetscFEView_Basic_Ascii(PetscFE fe, PetscViewer viewer)
4802: {
4803:   PetscSpace        basis;
4804:   PetscDualSpace    dual;
4805:   PetscQuadrature   q = NULL;
4806:   PetscInt          dim = 0, Nc, Nq = 0;
4807:   PetscViewerFormat format;
4808:   PetscErrorCode    ierr;

4811:   PetscFEGetBasisSpace(fe, &basis);
4812:   PetscFEGetDualSpace(fe, &dual);
4813:   PetscFEGetQuadrature(fe, &q);
4814:   PetscFEGetNumComponents(fe, &Nc);
4815:   if (q) {PetscQuadratureGetData(q, &dim, NULL, &Nq, NULL, NULL);}
4816:   PetscViewerGetFormat(viewer, &format);
4817:   PetscViewerASCIIPrintf(viewer, "Basic Finite Element:\n");
4818:     PetscViewerASCIIPrintf(viewer, "  dimension:       %d\n", dim);
4819:     PetscViewerASCIIPrintf(viewer, "  components:      %d\n", Nc);
4820:     PetscViewerASCIIPrintf(viewer, "  num quad points: %d\n", Nq);
4821:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
4822:     PetscViewerASCIIPushTab(viewer);
4823:     if (q) {PetscQuadratureView(q, viewer);}
4824:     PetscViewerASCIIPopTab(viewer);
4825:   }
4826:   PetscViewerASCIIPushTab(viewer);
4827:   PetscSpaceView(basis, viewer);
4828:   PetscDualSpaceView(dual, viewer);
4829:   PetscViewerASCIIPopTab(viewer);
4830:   return(0);
4831: }

4833: PetscErrorCode PetscFEView_Basic(PetscFE fe, PetscViewer viewer)
4834: {
4835:   PetscBool      iascii;

4841:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
4842:   if (iascii) {PetscFEView_Basic_Ascii(fe, viewer);}
4843:   return(0);
4844: }

4846: /* Construct the change of basis from prime basis to nodal basis */
4847: PetscErrorCode PetscFESetUp_Basic(PetscFE fem)
4848: {
4849:   PetscScalar   *work, *invVscalar;
4850:   PetscBLASInt  *pivots;
4851:   PetscBLASInt   n, info;
4852:   PetscInt       pdim, j;

4856:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
4857:   PetscMalloc1(pdim*pdim,&fem->invV);
4858: #if defined(PETSC_USE_COMPLEX)
4859:   PetscMalloc1(pdim*pdim,&invVscalar);
4860: #else
4861:   invVscalar = fem->invV;
4862: #endif
4863:   for (j = 0; j < pdim; ++j) {
4864:     PetscReal       *Bf;
4865:     PetscQuadrature  f;
4866:     const PetscReal *points, *weights;
4867:     PetscInt         Nc, Nq, q, k, c;

4869:     PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);
4870:     PetscQuadratureGetData(f, NULL, &Nc, &Nq, &points, &weights);
4871:     PetscMalloc1(Nc*Nq*pdim,&Bf);
4872:     PetscSpaceEvaluate(fem->basisSpace, Nq, points, Bf, NULL, NULL);
4873:     for (k = 0; k < pdim; ++k) {
4874:       /* V_{jk} = n_j(\phi_k) = \int \phi_k(x) n_j(x) dx */
4875:       invVscalar[j*pdim+k] = 0.0;

4877:       for (q = 0; q < Nq; ++q) {
4878:         for (c = 0; c < Nc; ++c) invVscalar[j*pdim+k] += Bf[(q*pdim + k)*Nc + c]*weights[q*Nc + c];
4879:       }
4880:     }
4881:     PetscFree(Bf);
4882:   }
4883:   PetscMalloc2(pdim,&pivots,pdim,&work);
4884:   n = pdim;
4885:   PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, invVscalar, &n, pivots, &info));
4886:   PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, invVscalar, &n, pivots, work, &n, &info));
4887: #if defined(PETSC_USE_COMPLEX)
4888:   for (j = 0; j < pdim*pdim; j++) fem->invV[j] = PetscRealPart(invVscalar[j]);
4889:   PetscFree(invVscalar);
4890: #endif
4891:   PetscFree2(pivots,work);
4892:   return(0);
4893: }

4895: PetscErrorCode PetscFEGetDimension_Basic(PetscFE fem, PetscInt *dim)
4896: {

4900:   PetscDualSpaceGetDimension(fem->dualSpace, dim);
4901:   return(0);
4902: }

4904: PetscErrorCode PetscFEGetTabulation_Basic(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H)
4905: {
4906:   DM               dm;
4907:   PetscInt         pdim; /* Dimension of FE space P */
4908:   PetscInt         dim;  /* Spatial dimension */
4909:   PetscInt         Nc;   /* Field components */
4910:   PetscReal       *tmpB, *tmpD, *tmpH;
4911:   PetscInt         p, d, j, k, c;
4912:   PetscErrorCode   ierr;

4915:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
4916:   DMGetDimension(dm, &dim);
4917:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
4918:   PetscFEGetNumComponents(fem, &Nc);
4919:   /* Evaluate the prime basis functions at all points */
4920:   if (B) {DMGetWorkArray(dm, npoints*pdim*Nc, MPIU_REAL, &tmpB);}
4921:   if (D) {DMGetWorkArray(dm, npoints*pdim*Nc*dim, MPIU_REAL, &tmpD);}
4922:   if (H) {DMGetWorkArray(dm, npoints*pdim*Nc*dim*dim, MPIU_REAL, &tmpH);}
4923:   PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);
4924:   /* Translate to the nodal basis */
4925:   for (p = 0; p < npoints; ++p) {
4926:     if (B) {
4927:       /* Multiply by V^{-1} (pdim x pdim) */
4928:       for (j = 0; j < pdim; ++j) {
4929:         const PetscInt i = (p*pdim + j)*Nc;

4931:         for (c = 0; c < Nc; ++c) {
4932:           B[i+c] = 0.0;
4933:           for (k = 0; k < pdim; ++k) {
4934:             B[i+c] += fem->invV[k*pdim+j] * tmpB[(p*pdim + k)*Nc+c];
4935:           }
4936:         }
4937:       }
4938:     }
4939:     if (D) {
4940:       /* Multiply by V^{-1} (pdim x pdim) */
4941:       for (j = 0; j < pdim; ++j) {
4942:         for (c = 0; c < Nc; ++c) {
4943:           for (d = 0; d < dim; ++d) {
4944:             const PetscInt i = ((p*pdim + j)*Nc + c)*dim + d;

4946:             D[i] = 0.0;
4947:             for (k = 0; k < pdim; ++k) {
4948:               D[i] += fem->invV[k*pdim+j] * tmpD[((p*pdim + k)*Nc + c)*dim + d];
4949:             }
4950:           }
4951:         }
4952:       }
4953:     }
4954:     if (H) {
4955:       /* Multiply by V^{-1} (pdim x pdim) */
4956:       for (j = 0; j < pdim; ++j) {
4957:         for (c = 0; c < Nc; ++c) {
4958:           for (d = 0; d < dim*dim; ++d) {
4959:             const PetscInt i = ((p*pdim + j)*Nc + c)*dim*dim + d;

4961:             H[i] = 0.0;
4962:             for (k = 0; k < pdim; ++k) {
4963:               H[i] += fem->invV[k*pdim+j] * tmpH[((p*pdim + k)*Nc + c)*dim*dim + d];
4964:             }
4965:           }
4966:         }
4967:       }
4968:     }
4969:   }
4970:   if (B) {DMRestoreWorkArray(dm, npoints*pdim*Nc, MPIU_REAL, &tmpB);}
4971:   if (D) {DMRestoreWorkArray(dm, npoints*pdim*Nc*dim, MPIU_REAL, &tmpD);}
4972:   if (H) {DMRestoreWorkArray(dm, npoints*pdim*Nc*dim*dim, MPIU_REAL, &tmpH);}
4973:   return(0);
4974: }

4976: PetscErrorCode PetscFEIntegrate_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *cgeom,
4977:                                       const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscScalar integral[])
4978: {
4979:   const PetscInt     debug = 0;
4980:   PetscPointFunc     obj_func;
4981:   PetscQuadrature    quad;
4982:   PetscScalar       *u, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4983:   const PetscScalar *constants;
4984:   PetscReal         *x;
4985:   PetscReal        **B, **D, **BAux = NULL, **DAux = NULL;
4986:   PetscInt          *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4987:   PetscInt           dim, dE, Np, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, e;
4988:   PetscBool          isAffine;
4989:   const PetscReal   *quadPoints, *quadWeights;
4990:   PetscInt           qNc, Nq, q;
4991:   PetscErrorCode     ierr;

4994:   PetscDSGetObjective(prob, field, &obj_func);
4995:   if (!obj_func) return(0);
4996:   PetscFEGetSpatialDimension(fem, &dim);
4997:   PetscFEGetQuadrature(fem, &quad);
4998:   PetscDSGetNumFields(prob, &Nf);
4999:   PetscDSGetTotalDimension(prob, &totDim);
5000:   PetscDSGetDimensions(prob, &Nb);
5001:   PetscDSGetComponents(prob, &Nc);
5002:   PetscDSGetComponentOffsets(prob, &uOff);
5003:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
5004:   PetscDSGetEvaluationArrays(prob, &u, NULL, &u_x);
5005:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
5006:   PetscDSGetTabulation(prob, &B, &D);
5007:   PetscDSGetConstants(prob, &numConstants, &constants);
5008:   if (probAux) {
5009:     PetscDSGetNumFields(probAux, &NfAux);
5010:     PetscDSGetTotalDimension(probAux, &totDimAux);
5011:     PetscDSGetDimensions(probAux, &NbAux);
5012:     PetscDSGetComponents(probAux, &NcAux);
5013:     PetscDSGetComponentOffsets(probAux, &aOff);
5014:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
5015:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
5016:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
5017:     PetscDSGetTabulation(probAux, &BAux, &DAux);
5018:   }
5019:   PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
5020:   Np = cgeom->numPoints;
5021:   dE = cgeom->dimEmbed;
5022:   isAffine = cgeom->isAffine;
5023:   for (e = 0; e < Ne; ++e) {
5024:     const PetscReal *v0   = &cgeom->v[e*Np*dE];
5025:     const PetscReal *J    = &cgeom->J[e*Np*dE*dE];

5027:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
5028:     for (q = 0; q < Nq; ++q) {
5029:       PetscScalar integrand;
5030:       const PetscReal *v;
5031:       const PetscReal *invJ;
5032:       PetscReal detJ;

5034:       if (isAffine) {
5035:         CoordinatesRefToReal(dE, dim, cgeom->xi, v0, J, &quadPoints[q*dim], x);
5036:         v = x;
5037:         invJ = &cgeom->invJ[e*dE*dE];
5038:         detJ = cgeom->detJ[e];
5039:       } else {
5040:         v = &v0[q*dE];
5041:         invJ = &cgeom->invJ[(e*Np+q)*dE*dE];
5042:         detJ = cgeom->detJ[e*Np + q];
5043:       }
5044:       if (debug > 1 && q < Np) {
5045:         PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
5046: #if !defined(PETSC_USE_COMPLEX)
5047:         DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
5048: #endif
5049:       }
5050:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
5051:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], NULL, u, u_x, NULL);
5052:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
5053:       obj_func(dim, Nf, NfAux, uOff, uOff_x, u, NULL, u_x, aOff, aOff_x, a, NULL, a_x, 0.0, v, numConstants, constants, &integrand);
5054:       integrand *= detJ*quadWeights[q];
5055:       integral[e*Nf+field] += integrand;
5056:       if (debug > 1) {PetscPrintf(PETSC_COMM_SELF, "    int: %g %g\n", (double) PetscRealPart(integrand), (double) PetscRealPart(integral[field]));}
5057:     }
5058:     cOffset    += totDim;
5059:     cOffsetAux += totDimAux;
5060:   }
5061:   return(0);
5062: }

5064: PetscErrorCode PetscFEIntegrateResidual_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *cgeom,
5065:                                               const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
5066: {
5067:   const PetscInt     debug = 0;
5068:   PetscPointFunc     f0_func;
5069:   PetscPointFunc     f1_func;
5070:   PetscQuadrature    quad;
5071:   PetscScalar       *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
5072:   const PetscScalar *constants;
5073:   PetscReal         *x;
5074:   PetscReal        **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
5075:   PetscInt          *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
5076:   PetscInt           dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
5077:   PetscInt           dE, Np;
5078:   PetscBool          isAffine;
5079:   const PetscReal   *quadPoints, *quadWeights;
5080:   PetscInt           qNc, Nq, q;
5081:   PetscErrorCode     ierr;

5084:   PetscFEGetSpatialDimension(fem, &dim);
5085:   PetscFEGetQuadrature(fem, &quad);
5086:   PetscDSGetNumFields(prob, &Nf);
5087:   PetscDSGetTotalDimension(prob, &totDim);
5088:   PetscDSGetDimensions(prob, &Nb);
5089:   PetscDSGetComponents(prob, &Nc);
5090:   PetscDSGetComponentOffsets(prob, &uOff);
5091:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
5092:   PetscDSGetFieldOffset(prob, field, &fOffset);
5093:   PetscDSGetResidual(prob, field, &f0_func, &f1_func);
5094:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
5095:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
5096:   PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
5097:   PetscDSGetTabulation(prob, &B, &D);
5098:   PetscDSGetConstants(prob, &numConstants, &constants);
5099:   if (probAux) {
5100:     PetscDSGetNumFields(probAux, &NfAux);
5101:     PetscDSGetTotalDimension(probAux, &totDimAux);
5102:     PetscDSGetDimensions(probAux, &NbAux);
5103:     PetscDSGetComponents(probAux, &NcAux);
5104:     PetscDSGetComponentOffsets(probAux, &aOff);
5105:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
5106:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
5107:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
5108:     PetscDSGetTabulation(probAux, &BAux, &DAux);
5109:   }
5110:   NbI = Nb[field];
5111:   NcI = Nc[field];
5112:   BI  = B[field];
5113:   DI  = D[field];
5114:   PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
5115:   Np = cgeom->numPoints;
5116:   dE = cgeom->dimEmbed;
5117:   isAffine = cgeom->isAffine;
5118:   for (e = 0; e < Ne; ++e) {
5119:     const PetscReal *v0   = &cgeom->v[e*Np*dE];
5120:     const PetscReal *J    = &cgeom->J[e*Np*dE*dE];

5122:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
5123:     PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
5124:     PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
5125:     for (q = 0; q < Nq; ++q) {
5126:       const PetscReal *v;
5127:       const PetscReal *invJ;
5128:       PetscReal detJ;

5130:       if (isAffine) {
5131:         CoordinatesRefToReal(dE, dim, cgeom->xi, v0, J, &quadPoints[q*dim], x);
5132:         v = x;
5133:         invJ = &cgeom->invJ[e*dE*dE];
5134:         detJ = cgeom->detJ[e];
5135:       } else {
5136:         v = &v0[q*dE];
5137:         invJ = &cgeom->invJ[(e*Np+q)*dE*dE];
5138:         detJ = cgeom->detJ[e*Np + q];
5139:       }
5140:       if (debug > 1 && q < Np) {
5141:         PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
5142: #if !defined(PETSC_USE_COMPLEX)
5143:         DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
5144: #endif
5145:       }
5146:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
5147:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
5148:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
5149:       if (f0_func) f0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, v, numConstants, constants, &f0[q*NcI]);
5150:       if (f1_func) {
5151:         PetscMemzero(refSpaceDer, NcI*dim * sizeof(PetscScalar));
5152:         f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, v, numConstants, constants, refSpaceDer);
5153:       }
5154:       TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
5155:     }
5156:     UpdateElementVec(dim, Nq, NbI, NcI, BI, DI, f0, f1, &elemVec[cOffset+fOffset]);
5157:     cOffset    += totDim;
5158:     cOffsetAux += totDimAux;
5159:   }
5160:   return(0);
5161: }

5163: PetscErrorCode PetscFEIntegrateBdResidual_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *fgeom,
5164:                                                 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
5165: {
5166:   const PetscInt     debug = 0;
5167:   PetscBdPointFunc   f0_func;
5168:   PetscBdPointFunc   f1_func;
5169:   PetscQuadrature    quad;
5170:   PetscScalar       *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
5171:   const PetscScalar *constants;
5172:   PetscReal         *x;
5173:   PetscReal        **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
5174:   PetscInt          *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
5175:   PetscInt           dim, dimAux, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
5176:   PetscBool          isAffine, auxOnBd;
5177:   const PetscReal   *quadPoints, *quadWeights;
5178:   PetscInt           qNc, Nq, q, Np, dE;
5179:   PetscErrorCode     ierr;

5182:   PetscFEGetSpatialDimension(fem, &dim);
5183:   PetscFEGetFaceQuadrature(fem, &quad);
5184:   PetscDSGetNumFields(prob, &Nf);
5185:   PetscDSGetTotalDimension(prob, &totDim);
5186:   PetscDSGetDimensions(prob, &Nb);
5187:   PetscDSGetComponents(prob, &Nc);
5188:   PetscDSGetComponentOffsets(prob, &uOff);
5189:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
5190:   PetscDSGetFieldOffset(prob, field, &fOffset);
5191:   PetscDSGetBdResidual(prob, field, &f0_func, &f1_func);
5192:   if (!f0_func && !f1_func) return(0);
5193:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
5194:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
5195:   PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
5196:   PetscDSGetFaceTabulation(prob, &B, &D);
5197:   PetscDSGetConstants(prob, &numConstants, &constants);
5198:   if (probAux) {
5199:     PetscDSGetSpatialDimension(probAux, &dimAux);
5200:     PetscDSGetNumFields(probAux, &NfAux);
5201:     PetscDSGetTotalDimension(probAux, &totDimAux);
5202:     PetscDSGetDimensions(probAux, &NbAux);
5203:     PetscDSGetComponents(probAux, &NcAux);
5204:     PetscDSGetComponentOffsets(probAux, &aOff);
5205:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
5206:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
5207:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
5208:     auxOnBd = dimAux < dim ? PETSC_TRUE : PETSC_FALSE;
5209:     if (auxOnBd) {PetscDSGetTabulation(probAux, &BAux, &DAux);}
5210:     else         {PetscDSGetFaceTabulation(probAux, &BAux, &DAux);}
5211:   }
5212:   NbI = Nb[field];
5213:   NcI = Nc[field];
5214:   BI  = B[field];
5215:   DI  = D[field];
5216:   PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
5217:   Np = fgeom->numPoints;
5218:   dE = fgeom->dimEmbed;
5219:   isAffine = fgeom->isAffine;
5220:   for (e = 0; e < Ne; ++e) {
5221:     const PetscReal *v0   = &fgeom->v[e*Np*dE];
5222:     const PetscReal *J    = &fgeom->J[e*Np*dE*dE];
5223:     const PetscInt   face = fgeom->face[e][0]; /* Local face number in cell */

5225:     PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
5226:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
5227:     PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
5228:     PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
5229:     for (q = 0; q < Nq; ++q) {
5230:       const PetscReal *v;
5231:       const PetscReal *invJ;
5232:       const PetscReal *n;
5233:       PetscReal detJ;
5234:       if (isAffine) {
5235:         CoordinatesRefToReal(dE, dim-1, fgeom->xi, v0, J, &quadPoints[q*(dim-1)], x);
5236:         v = x;
5237:         invJ = &fgeom->suppInvJ[0][e*dE*dE];
5238:         detJ = fgeom->detJ[e];
5239:         n    = &fgeom->n[e*dE];
5240:       } else {
5241:         v = &v0[q*dE];
5242:         invJ = &fgeom->suppInvJ[0][(e*Np+q)*dE*dE];
5243:         detJ = fgeom->detJ[e*Np + q];
5244:         n    = &fgeom->n[(e*Np+q)*dE];
5245:       }
5246:       if (debug > 1 && q < Np) {
5247:         PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
5248: #if !defined(PETSC_USE_COMPLEX)
5249:         DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
5250: #endif
5251:       }
5252:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
5253:       EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
5254:       if (probAux) EvaluateFieldJets(dimAux, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
5255:       if (f0_func) f0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, v, n, numConstants, constants, &f0[q*NcI]);
5256:       if (f1_func) {
5257:         PetscMemzero(refSpaceDer, NcI*dim * sizeof(PetscScalar));
5258:         f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, v, n, numConstants, constants, refSpaceDer);
5259:       }
5260:       TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
5261:     }
5262:     UpdateElementVec(dim, Nq, NbI, NcI, &BI[face*Nq*NbI*NcI], &DI[face*Nq*NbI*NcI*dim], f0, f1, &elemVec[cOffset+fOffset]);
5263:     cOffset    += totDim;
5264:     cOffsetAux += totDimAux;
5265:   }
5266:   return(0);
5267: }

5269: PetscErrorCode PetscFEIntegrateJacobian_Basic(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEGeom *geom,
5270:                                               const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
5271: {
5272:   const PetscInt     debug      = 0;
5273:   PetscPointJac      g0_func;
5274:   PetscPointJac      g1_func;
5275:   PetscPointJac      g2_func;
5276:   PetscPointJac      g3_func;
5277:   PetscInt           cOffset    = 0; /* Offset into coefficients[] for element e */
5278:   PetscInt           cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
5279:   PetscInt           eOffset    = 0; /* Offset into elemMat[] for element e */
5280:   PetscInt           offsetI    = 0; /* Offset into an element vector for fieldI */
5281:   PetscInt           offsetJ    = 0; /* Offset into an element vector for fieldJ */
5282:   PetscQuadrature    quad;
5283:   PetscScalar       *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
5284:   const PetscScalar *constants;
5285:   PetscReal         *x;
5286:   PetscReal        **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
5287:   PetscInt          *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
5288:   PetscInt           NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
5289:   PetscInt           dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, e;
5290:   PetscInt           dE, Np;
5291:   PetscBool          isAffine;
5292:   const PetscReal   *quadPoints, *quadWeights;
5293:   PetscInt           qNc, Nq, q;
5294:   PetscErrorCode     ierr;

5297:   PetscFEGetSpatialDimension(fem, &dim);
5298:   PetscFEGetQuadrature(fem, &quad);
5299:   PetscDSGetNumFields(prob, &Nf);
5300:   PetscDSGetTotalDimension(prob, &totDim);
5301:   PetscDSGetDimensions(prob, &Nb);
5302:   PetscDSGetComponents(prob, &Nc);
5303:   PetscDSGetComponentOffsets(prob, &uOff);
5304:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
5305:   switch(jtype) {
5306:   case PETSCFE_JACOBIAN_DYN: PetscDSGetDynamicJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
5307:   case PETSCFE_JACOBIAN_PRE: PetscDSGetJacobianPreconditioner(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
5308:   case PETSCFE_JACOBIAN:     PetscDSGetJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
5309:   }
5310:   if (!g0_func && !g1_func && !g2_func && !g3_func) return(0);
5311:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
5312:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
5313:   PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
5314:   PetscDSGetTabulation(prob, &B, &D);
5315:   PetscDSGetFieldOffset(prob, fieldI, &offsetI);
5316:   PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
5317:   PetscDSGetConstants(prob, &numConstants, &constants);
5318:   if (probAux) {
5319:     PetscDSGetNumFields(probAux, &NfAux);
5320:     PetscDSGetTotalDimension(probAux, &totDimAux);
5321:     PetscDSGetDimensions(probAux, &NbAux);
5322:     PetscDSGetComponents(probAux, &NcAux);
5323:     PetscDSGetComponentOffsets(probAux, &aOff);
5324:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
5325:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
5326:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
5327:     PetscDSGetTabulation(probAux, &BAux, &DAux);
5328:   }
5329:   NbI = Nb[fieldI], NbJ = Nb[fieldJ];
5330:   NcI = Nc[fieldI], NcJ = Nc[fieldJ];
5331:   BI  = B[fieldI],  BJ  = B[fieldJ];
5332:   DI  = D[fieldI],  DJ  = D[fieldJ];
5333:   /* Initialize here in case the function is not defined */
5334:   PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
5335:   PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
5336:   PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
5337:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
5338:   PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
5339:   Np = geom->numPoints;
5340:   dE = geom->dimEmbed;
5341:   isAffine = geom->isAffine;
5342:   for (e = 0; e < Ne; ++e) {
5343:     const PetscReal *v0   = &geom->v[e*Np*dE];
5344:     const PetscReal *J    = &geom->J[e*Np*dE*dE];

5346:     PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
5347:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
5348:     for (q = 0; q < Nq; ++q) {
5349:       const PetscReal *v;
5350:       const PetscReal *invJ;
5351:       PetscReal detJ;
5352:       const PetscReal *BIq = &BI[q*NbI*NcI], *BJq = &BJ[q*NbJ*NcJ];
5353:       const PetscReal *DIq = &DI[q*NbI*NcI*dim], *DJq = &DJ[q*NbJ*NcJ*dim];
5354:       PetscReal  w;
5355:       PetscInt f, g, fc, gc, c;

5357:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
5358:       if (isAffine) {
5359:         CoordinatesRefToReal(dE, dim, geom->xi, v0, J, &quadPoints[q*dim], x);
5360:         v = x;
5361:         invJ = &geom->invJ[e*dE*dE];
5362:         detJ = geom->detJ[e];
5363:       } else {
5364:         v = &v0[q*dE];
5365:         invJ = &geom->invJ[(e*Np+q)*dE*dE];
5366:         detJ = geom->detJ[e*Np + q];
5367:       }
5368:       w = detJ*quadWeights[q];
5369:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
5370:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
5371:       if (g0_func) {
5372:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
5373:         g0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, numConstants, constants, g0);
5374:         for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
5375:       }
5376:       if (g1_func) {
5377:         PetscInt d, d2;
5378:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
5379:         g1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, numConstants, constants, refSpaceDer);
5380:         for (fc = 0; fc < NcI; ++fc) {
5381:           for (gc = 0; gc < NcJ; ++gc) {
5382:             for (d = 0; d < dim; ++d) {
5383:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
5384:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
5385:               g1[(fc*NcJ+gc)*dim+d] *= w;
5386:             }
5387:           }
5388:         }
5389:       }
5390:       if (g2_func) {
5391:         PetscInt d, d2;
5392:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
5393:         g2_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, numConstants, constants, refSpaceDer);
5394:         for (fc = 0; fc < NcI; ++fc) {
5395:           for (gc = 0; gc < NcJ; ++gc) {
5396:             for (d = 0; d < dim; ++d) {
5397:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
5398:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
5399:               g2[(fc*NcJ+gc)*dim+d] *= w;
5400:             }
5401:           }
5402:         }
5403:       }
5404:       if (g3_func) {
5405:         PetscInt d, d2, dp, d3;
5406:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
5407:         g3_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, numConstants, constants, refSpaceDer);
5408:         for (fc = 0; fc < NcI; ++fc) {
5409:           for (gc = 0; gc < NcJ; ++gc) {
5410:             for (d = 0; d < dim; ++d) {
5411:               for (dp = 0; dp < dim; ++dp) {
5412:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
5413:                 for (d2 = 0; d2 < dim; ++d2) {
5414:                   for (d3 = 0; d3 < dim; ++d3) {
5415:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
5416:                   }
5417:                 }
5418:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
5419:               }
5420:             }
5421:           }
5422:         }
5423:       }

5425:       for (f = 0; f < NbI; ++f) {
5426:         for (fc = 0; fc < NcI; ++fc) {
5427:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
5428:           const PetscInt i    = offsetI+f; /* Element matrix row */
5429:           for (g = 0; g < NbJ; ++g) {
5430:             for (gc = 0; gc < NcJ; ++gc) {
5431:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
5432:               const PetscInt j    = offsetJ+g; /* Element matrix column */
5433:               const PetscInt fOff = eOffset+i*totDim+j;
5434:               PetscInt       d, d2;

5436:               elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
5437:               for (d = 0; d < dim; ++d) {
5438:                 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
5439:                 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
5440:                 for (d2 = 0; d2 < dim; ++d2) {
5441:                   elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
5442:                 }
5443:               }
5444:             }
5445:           }
5446:         }
5447:       }
5448:     }
5449:     if (debug > 1) {
5450:       PetscInt fc, f, gc, g;

5452:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
5453:       for (fc = 0; fc < NcI; ++fc) {
5454:         for (f = 0; f < NbI; ++f) {
5455:           const PetscInt i = offsetI + f*NcI+fc;
5456:           for (gc = 0; gc < NcJ; ++gc) {
5457:             for (g = 0; g < NbJ; ++g) {
5458:               const PetscInt j = offsetJ + g*NcJ+gc;
5459:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
5460:             }
5461:           }
5462:           PetscPrintf(PETSC_COMM_SELF, "\n");
5463:         }
5464:       }
5465:     }
5466:     cOffset    += totDim;
5467:     cOffsetAux += totDimAux;
5468:     eOffset    += PetscSqr(totDim);
5469:   }
5470:   return(0);
5471: }

5473: PetscErrorCode PetscFEIntegrateBdJacobian_Basic(PetscFE fem, PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEGeom *fgeom,
5474:                                                 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
5475: {
5476:   const PetscInt     debug      = 0;
5477:   PetscBdPointJac    g0_func;
5478:   PetscBdPointJac    g1_func;
5479:   PetscBdPointJac    g2_func;
5480:   PetscBdPointJac    g3_func;
5481:   PetscInt           cOffset    = 0; /* Offset into coefficients[] for element e */
5482:   PetscInt           cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
5483:   PetscInt           eOffset    = 0; /* Offset into elemMat[] for element e */
5484:   PetscInt           offsetI    = 0; /* Offset into an element vector for fieldI */
5485:   PetscInt           offsetJ    = 0; /* Offset into an element vector for fieldJ */
5486:   PetscQuadrature    quad;
5487:   PetscScalar       *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
5488:   const PetscScalar *constants;
5489:   PetscReal         *x;
5490:   PetscReal        **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
5491:   PetscInt          *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
5492:   PetscInt           NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
5493:   PetscInt           dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, e;
5494:   PetscBool          isAffine;
5495:   const PetscReal   *quadPoints, *quadWeights;
5496:   PetscInt           qNc, Nq, q, Np, dE;
5497:   PetscErrorCode     ierr;

5500:   PetscFEGetSpatialDimension(fem, &dim);
5501:   PetscFEGetFaceQuadrature(fem, &quad);
5502:   PetscDSGetNumFields(prob, &Nf);
5503:   PetscDSGetTotalDimension(prob, &totDim);
5504:   PetscDSGetDimensions(prob, &Nb);
5505:   PetscDSGetComponents(prob, &Nc);
5506:   PetscDSGetComponentOffsets(prob, &uOff);
5507:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
5508:   PetscDSGetFieldOffset(prob, fieldI, &offsetI);
5509:   PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
5510:   PetscDSGetBdJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);
5511:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
5512:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
5513:   PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
5514:   PetscDSGetFaceTabulation(prob, &B, &D);
5515:   PetscDSGetConstants(prob, &numConstants, &constants);
5516:   if (probAux) {
5517:     PetscDSGetNumFields(probAux, &NfAux);
5518:     PetscDSGetTotalDimension(probAux, &totDimAux);
5519:     PetscDSGetDimensions(probAux, &NbAux);
5520:     PetscDSGetComponents(probAux, &NcAux);
5521:     PetscDSGetComponentOffsets(probAux, &aOff);
5522:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
5523:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
5524:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
5525:     PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
5526:   }
5527:   NbI = Nb[fieldI], NbJ = Nb[fieldJ];
5528:   NcI = Nc[fieldI], NcJ = Nc[fieldJ];
5529:   BI  = B[fieldI],  BJ  = B[fieldJ];
5530:   DI  = D[fieldI],  DJ  = D[fieldJ];
5531:   /* Initialize here in case the function is not defined */
5532:   PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
5533:   PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
5534:   PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
5535:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
5536:   PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
5537:   Np = fgeom->numPoints;
5538:   dE = fgeom->dimEmbed;
5539:   isAffine = fgeom->isAffine;
5540:   for (e = 0; e < Ne; ++e) {
5541:     const PetscReal *v0   = &fgeom->v[e*Np*dE];
5542:     const PetscReal *J    = &fgeom->J[e*Np*dE*dE];
5543:     const PetscInt   face = fgeom->face[e][0];

5545:     PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
5546:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
5547:     for (q = 0; q < Nq; ++q) {
5548:       const PetscReal *BIq = &BI[(face*Nq+q)*NbI*NcI], *BJq = &BJ[(face*Nq+q)*NbJ*NcJ];
5549:       const PetscReal *DIq = &DI[(face*Nq+q)*NbI*NcI*dim], *DJq = &DJ[(face*Nq+q)*NbJ*NcJ*dim];
5550:       PetscReal  w;
5551:       PetscInt f, g, fc, gc, c;
5552:       const PetscReal *v;
5553:       const PetscReal *invJ;
5554:       const PetscReal *n;
5555:       PetscReal detJ;

5557:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
5558:       if (isAffine) {
5559:         CoordinatesRefToReal(dE, dim-1, fgeom->xi, v0, J, &quadPoints[q*(dim-1)], x);
5560:         v = x;
5561:         invJ = &fgeom->suppInvJ[0][e*dE*dE];
5562:         detJ = fgeom->detJ[e];
5563:         n    = &fgeom->n[e*dE];
5564:       } else {
5565:         v = &v0[q*dE];
5566:         invJ = &fgeom->suppInvJ[0][(e*Np+q)*dE*dE];
5567:         detJ = fgeom->detJ[e*Np + q];
5568:         n    = &fgeom->n[(e*Np+q)*dE];
5569:       }
5570:       w = detJ*quadWeights[q];

5572:       EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
5573:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
5574:       if (g0_func) {
5575:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
5576:         g0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, n, numConstants, constants, g0);
5577:         for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
5578:       }
5579:       if (g1_func) {
5580:         PetscInt d, d2;
5581:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
5582:         g1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, n, numConstants, constants, refSpaceDer);
5583:         for (fc = 0; fc < NcI; ++fc) {
5584:           for (gc = 0; gc < NcJ; ++gc) {
5585:             for (d = 0; d < dim; ++d) {
5586:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
5587:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
5588:               g1[(fc*NcJ+gc)*dim+d] *= w;
5589:             }
5590:           }
5591:         }
5592:       }
5593:       if (g2_func) {
5594:         PetscInt d, d2;
5595:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
5596:         g2_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, n, numConstants, constants, refSpaceDer);
5597:         for (fc = 0; fc < NcI; ++fc) {
5598:           for (gc = 0; gc < NcJ; ++gc) {
5599:             for (d = 0; d < dim; ++d) {
5600:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
5601:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
5602:               g2[(fc*NcJ+gc)*dim+d] *= w;
5603:             }
5604:           }
5605:         }
5606:       }
5607:       if (g3_func) {
5608:         PetscInt d, d2, dp, d3;
5609:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
5610:         g3_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, v, n, numConstants, constants, refSpaceDer);
5611:         for (fc = 0; fc < NcI; ++fc) {
5612:           for (gc = 0; gc < NcJ; ++gc) {
5613:             for (d = 0; d < dim; ++d) {
5614:               for (dp = 0; dp < dim; ++dp) {
5615:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
5616:                 for (d2 = 0; d2 < dim; ++d2) {
5617:                   for (d3 = 0; d3 < dim; ++d3) {
5618:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
5619:                   }
5620:                 }
5621:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
5622:               }
5623:             }
5624:           }
5625:         }
5626:       }

5628:       for (f = 0; f < NbI; ++f) {
5629:         for (fc = 0; fc < NcI; ++fc) {
5630:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
5631:           const PetscInt i    = offsetI+f; /* Element matrix row */
5632:           for (g = 0; g < NbJ; ++g) {
5633:             for (gc = 0; gc < NcJ; ++gc) {
5634:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
5635:               const PetscInt j    = offsetJ+g; /* Element matrix column */
5636:               const PetscInt fOff = eOffset+i*totDim+j;
5637:               PetscInt       d, d2;

5639:               elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
5640:               for (d = 0; d < dim; ++d) {
5641:                 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
5642:                 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
5643:                 for (d2 = 0; d2 < dim; ++d2) {
5644:                   elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
5645:                 }
5646:               }
5647:             }
5648:           }
5649:         }
5650:       }
5651:     }
5652:     if (debug > 1) {
5653:       PetscInt fc, f, gc, g;

5655:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
5656:       for (fc = 0; fc < NcI; ++fc) {
5657:         for (f = 0; f < NbI; ++f) {
5658:           const PetscInt i = offsetI + f*NcI+fc;
5659:           for (gc = 0; gc < NcJ; ++gc) {
5660:             for (g = 0; g < NbJ; ++g) {
5661:               const PetscInt j = offsetJ + g*NcJ+gc;
5662:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
5663:             }
5664:           }
5665:           PetscPrintf(PETSC_COMM_SELF, "\n");
5666:         }
5667:       }
5668:     }
5669:     cOffset    += totDim;
5670:     cOffsetAux += totDimAux;
5671:     eOffset    += PetscSqr(totDim);
5672:   }
5673:   return(0);
5674: }

5676: PetscErrorCode PetscFEInitialize_Basic(PetscFE fem)
5677: {
5679:   fem->ops->setfromoptions          = NULL;
5680:   fem->ops->setup                   = PetscFESetUp_Basic;
5681:   fem->ops->view                    = PetscFEView_Basic;
5682:   fem->ops->destroy                 = PetscFEDestroy_Basic;
5683:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
5684:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
5685:   fem->ops->integrate               = PetscFEIntegrate_Basic;
5686:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Basic;
5687:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Basic;
5688:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Basic */;
5689:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
5690:   fem->ops->integratebdjacobian     = PetscFEIntegrateBdJacobian_Basic;
5691:   return(0);
5692: }

5694: /*MC
5695:   PETSCFEBASIC = "basic" - A PetscFE object that integrates with basic tiling and no vectorization

5697:   Level: intermediate

5699: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
5700: M*/

5702: PETSC_EXTERN PetscErrorCode PetscFECreate_Basic(PetscFE fem)
5703: {
5704:   PetscFE_Basic *b;

5709:   PetscNewLog(fem,&b);
5710:   fem->data = b;

5712:   PetscFEInitialize_Basic(fem);
5713:   return(0);
5714: }

5716: #if defined(PETSC_HAVE_OPENCL)

5718: PetscErrorCode PetscFEDestroy_OpenCL(PetscFE fem)
5719: {
5720:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5721:   PetscErrorCode  ierr;

5724:   clReleaseCommandQueue(ocl->queue_id);
5725:   ocl->queue_id = 0;
5726:   clReleaseContext(ocl->ctx_id);
5727:   ocl->ctx_id = 0;
5728:   PetscFree(ocl);
5729:   return(0);
5730: }

5732: #define STRING_ERROR_CHECK(MSG) do { string_tail += count; if (string_tail == end_of_buffer) SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_SUP, MSG);} while(0)
5733: enum {LAPLACIAN = 0, ELASTICITY = 1};

5735: /* NOTE: This is now broken for vector problems. Must redo loops to respect vector basis elements */
5736: /* dim     Number of spatial dimensions:          2                   */
5737: /* N_b     Number of basis functions:             generated           */
5738: /* N_{bt}  Number of total basis functions:       N_b * N_{comp}      */
5739: /* N_q     Number of quadrature points:           generated           */
5740: /* N_{bs}  Number of block cells                  LCM(N_b, N_q)       */
5741: /* N_{bst} Number of block cell components        LCM(N_{bt}, N_q)    */
5742: /* N_{bl}  Number of concurrent blocks            generated           */
5743: /* N_t     Number of threads:                     N_{bl} * N_{bs}     */
5744: /* N_{cbc} Number of concurrent basis      cells: N_{bl} * N_q        */
5745: /* N_{cqc} Number of concurrent quadrature cells: N_{bl} * N_b        */
5746: /* N_{sbc} Number of serial     basis      cells: N_{bs} / N_q        */
5747: /* N_{sqc} Number of serial     quadrature cells: N_{bs} / N_b        */
5748: /* N_{cb}  Number of serial cell batches:         input               */
5749: /* N_c     Number of total cells:                 N_{cb}*N_{t}/N_{comp} */
5750: PetscErrorCode PetscFEOpenCLGenerateIntegrationCode(PetscFE fem, char **string_buffer, PetscInt buffer_length, PetscBool useAux, PetscInt N_bl)
5751: {
5752:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5753:   PetscQuadrature q;
5754:   char           *string_tail   = *string_buffer;
5755:   char           *end_of_buffer = *string_buffer + buffer_length;
5756:   char            float_str[]   = "float", double_str[]  = "double";
5757:   char           *numeric_str   = &(float_str[0]);
5758:   PetscInt        op            = ocl->op;
5759:   PetscBool       useField      = PETSC_FALSE;
5760:   PetscBool       useFieldDer   = PETSC_TRUE;
5761:   PetscBool       useFieldAux   = useAux;
5762:   PetscBool       useFieldDerAux= PETSC_FALSE;
5763:   PetscBool       useF0         = PETSC_TRUE;
5764:   PetscBool       useF1         = PETSC_TRUE;
5765:   const PetscReal *points, *weights;
5766:   PetscReal      *basis, *basisDer;
5767:   PetscInt        dim, qNc, N_b, N_c, N_q, N_t, p, d, b, c;
5768:   size_t          count;
5769:   PetscErrorCode  ierr;

5772:   PetscFEGetSpatialDimension(fem, &dim);
5773:   PetscFEGetDimension(fem, &N_b);
5774:   PetscFEGetNumComponents(fem, &N_c);
5775:   PetscFEGetQuadrature(fem, &q);
5776:   PetscQuadratureGetData(q, NULL, &qNc, &N_q, &points, &weights);
5777:   if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
5778:   N_t  = N_b * N_c * N_q * N_bl;
5779:   /* Enable device extension for double precision */
5780:   if (ocl->realType == PETSC_DOUBLE) {
5781:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5782: "#if defined(cl_khr_fp64)\n"
5783: "#  pragma OPENCL EXTENSION cl_khr_fp64: enable\n"
5784: "#elif defined(cl_amd_fp64)\n"
5785: "#  pragma OPENCL EXTENSION cl_amd_fp64: enable\n"
5786: "#endif\n",
5787:                               &count);STRING_ERROR_CHECK("Message to short");
5788:     numeric_str  = &(double_str[0]);
5789:   }
5790:   /* Kernel API */
5791:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5792: "\n"
5793: "__kernel void integrateElementQuadrature(int N_cb, __global %s *coefficients, __global %s *coefficientsAux, __global %s *jacobianInverses, __global %s *jacobianDeterminants, __global %s *elemVec)\n"
5794: "{\n",
5795:                        &count, numeric_str, numeric_str, numeric_str, numeric_str, numeric_str);STRING_ERROR_CHECK("Message to short");
5796:   /* Quadrature */
5797:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5798: "  /* Quadrature points\n"
5799: "   - (x1,y1,x2,y2,...) */\n"
5800: "  const %s points[%d] = {\n",
5801:                        &count, numeric_str, N_q*dim);STRING_ERROR_CHECK("Message to short");
5802:   for (p = 0; p < N_q; ++p) {
5803:     for (d = 0; d < dim; ++d) {
5804:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "%g,\n", &count, points[p*dim+d]);STRING_ERROR_CHECK("Message to short");
5805:     }
5806:   }
5807:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
5808:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5809: "  /* Quadrature weights\n"
5810: "   - (v1,v2,...) */\n"
5811: "  const %s weights[%d] = {\n",
5812:                        &count, numeric_str, N_q);STRING_ERROR_CHECK("Message to short");
5813:   for (p = 0; p < N_q; ++p) {
5814:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "%g,\n", &count, weights[p]);STRING_ERROR_CHECK("Message to short");
5815:   }
5816:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
5817:   /* Basis Functions */
5818:   PetscFEGetDefaultTabulation(fem, &basis, &basisDer, NULL);
5819:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5820: "  /* Nodal basis function evaluations\n"
5821: "    - basis component is fastest varying, the basis function, then point */\n"
5822: "  const %s Basis[%d] = {\n",
5823:                        &count, numeric_str, N_q*N_b*N_c);STRING_ERROR_CHECK("Message to short");
5824:   for (p = 0; p < N_q; ++p) {
5825:     for (b = 0; b < N_b; ++b) {
5826:       for (c = 0; c < N_c; ++c) {
5827:         PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "%g,\n", &count, basis[(p*N_b + b)*N_c + c]);STRING_ERROR_CHECK("Message to short");
5828:       }
5829:     }
5830:   }
5831:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
5832:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5833: "\n"
5834: "  /* Nodal basis function derivative evaluations,\n"
5835: "      - derivative direction is fastest varying, then basis component, then basis function, then point */\n"
5836: "  const %s%d BasisDerivatives[%d] = {\n",
5837:                        &count, numeric_str, dim, N_q*N_b*N_c);STRING_ERROR_CHECK("Message to short");
5838:   for (p = 0; p < N_q; ++p) {
5839:     for (b = 0; b < N_b; ++b) {
5840:       for (c = 0; c < N_c; ++c) {
5841:         PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "(%s%d)(", &count, numeric_str, dim);STRING_ERROR_CHECK("Message to short");
5842:         for (d = 0; d < dim; ++d) {
5843:           if (d > 0) {
5844:             PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, ", %g", &count, basisDer[((p*N_b + b)*dim + d)*N_c + c]);STRING_ERROR_CHECK("Message to short");
5845:           } else {
5846:             PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "%g", &count, basisDer[((p*N_b + b)*dim + d)*N_c + c]);STRING_ERROR_CHECK("Message to short");
5847:           }
5848:         }
5849:         PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "),\n", &count);STRING_ERROR_CHECK("Message to short");
5850:       }
5851:     }
5852:   }
5853:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
5854:   /* Sizes */
5855:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5856: "  const int dim    = %d;                           // The spatial dimension\n"
5857: "  const int N_bl   = %d;                           // The number of concurrent blocks\n"
5858: "  const int N_b    = %d;                           // The number of basis functions\n"
5859: "  const int N_comp = %d;                           // The number of basis function components\n"
5860: "  const int N_bt   = N_b*N_comp;                    // The total number of scalar basis functions\n"
5861: "  const int N_q    = %d;                           // The number of quadrature points\n"
5862: "  const int N_bst  = N_bt*N_q;                      // The block size, LCM(N_b*N_comp, N_q), Notice that a block is not processed simultaneously\n"
5863: "  const int N_t    = N_bst*N_bl;                    // The number of threads, N_bst * N_bl\n"
5864: "  const int N_bc   = N_t/N_comp;                    // The number of cells per batch (N_b*N_q*N_bl)\n"
5865: "  const int N_sbc  = N_bst / (N_q * N_comp);\n"
5866: "  const int N_sqc  = N_bst / N_bt;\n"
5867: "  /*const int N_c    = N_cb * N_bc;*/\n"
5868: "\n"
5869: "  /* Calculated indices */\n"
5870: "  /*const int tidx    = get_local_id(0) + get_local_size(0)*get_local_id(1);*/\n"
5871: "  const int tidx    = get_local_id(0);\n"
5872: "  const int blidx   = tidx / N_bst;                  // Block number for this thread\n"
5873: "  const int bidx    = tidx %% N_bt;                   // Basis function mapped to this thread\n"
5874: "  const int cidx    = tidx %% N_comp;                 // Basis component mapped to this thread\n"
5875: "  const int qidx    = tidx %% N_q;                    // Quadrature point mapped to this thread\n"
5876: "  const int blbidx  = tidx %% N_q + blidx*N_q;        // Cell mapped to this thread in the basis phase\n"
5877: "  const int blqidx  = tidx %% N_b + blidx*N_b;        // Cell mapped to this thread in the quadrature phase\n"
5878: "  const int gidx    = get_group_id(1)*get_num_groups(0) + get_group_id(0);\n"
5879: "  const int Goffset = gidx*N_cb*N_bc;\n",
5880:                             &count, dim, N_bl, N_b, N_c, N_q);STRING_ERROR_CHECK("Message to short");
5881:   /* Local memory */
5882:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5883: "\n"
5884: "  /* Quadrature data */\n"
5885: "  %s                w;                   // $w_q$, Quadrature weight at $x_q$\n"
5886: "  __local %s         phi_i[%d];    //[N_bt*N_q];  // $\\phi_i(x_q)$, Value of the basis function $i$ at $x_q$\n"
5887: "  __local %s%d       phiDer_i[%d]; //[N_bt*N_q];  // $\\frac{\\partial\\phi_i(x_q)}{\\partial x_d}$, Value of the derivative of basis function $i$ in direction $x_d$ at $x_q$\n"
5888: "  /* Geometric data */\n"
5889: "  __local %s        detJ[%d]; //[N_t];           // $|J(x_q)|$, Jacobian determinant at $x_q$\n"
5890: "  __local %s        invJ[%d];//[N_t*dim*dim];   // $J^{-1}(x_q)$, Jacobian inverse at $x_q$\n",
5891:                             &count, numeric_str, numeric_str, N_b*N_c*N_q, numeric_str, dim, N_b*N_c*N_q, numeric_str, N_t,
5892:                             numeric_str, N_t*dim*dim, numeric_str, N_t*N_b*N_c);STRING_ERROR_CHECK("Message to short");
5893:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5894: "  /* FEM data */\n"
5895: "  __local %s        u_i[%d]; //[N_t*N_bt];       // Coefficients $u_i$ of the field $u|_{\\mathcal{T}} = \\sum_i u_i \\phi_i$\n",
5896:                             &count, numeric_str, N_t*N_b*N_c);STRING_ERROR_CHECK("Message to short");
5897:   if (useAux) {
5898:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5899: "  __local %s        a_i[%d]; //[N_t];            // Coefficients $a_i$ of the auxiliary field $a|_{\\mathcal{T}} = \\sum_i a_i \\phi^R_i$\n",
5900:                             &count, numeric_str, N_t);STRING_ERROR_CHECK("Message to short");
5901:   }
5902:   if (useF0) {
5903:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5904: "  /* Intermediate calculations */\n"
5905: "  __local %s         f_0[%d]; //[N_t*N_sqc];      // $f_0(u(x_q), \\nabla u(x_q)) |J(x_q)| w_q$\n",
5906:                               &count, numeric_str, N_t*N_q);STRING_ERROR_CHECK("Message to short");
5907:   }
5908:   if (useF1) {
5909:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5910: "  __local %s%d       f_1[%d]; //[N_t*N_sqc];      // $f_1(u(x_q), \\nabla u(x_q)) |J(x_q)| w_q$\n",
5911:                               &count, numeric_str, dim, N_t*N_q);STRING_ERROR_CHECK("Message to short");
5912:   }
5913:   /* TODO: If using elasticity, put in mu/lambda coefficients */
5914:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5915: "  /* Output data */\n"
5916: "  %s                e_i;                 // Coefficient $e_i$ of the residual\n\n",
5917:                             &count, numeric_str);STRING_ERROR_CHECK("Message to short");
5918:   /* One-time loads */
5919:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5920: "  /* These should be generated inline */\n"
5921: "  /* Load quadrature weights */\n"
5922: "  w = weights[qidx];\n"
5923: "  /* Load basis tabulation \\phi_i for this cell */\n"
5924: "  if (tidx < N_bt*N_q) {\n"
5925: "    phi_i[tidx]    = Basis[tidx];\n"
5926: "    phiDer_i[tidx] = BasisDerivatives[tidx];\n"
5927: "  }\n\n",
5928:                        &count);STRING_ERROR_CHECK("Message to short");
5929:   /* Batch loads */
5930:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5931: "  for (int batch = 0; batch < N_cb; ++batch) {\n"
5932: "    /* Load geometry */\n"
5933: "    detJ[tidx] = jacobianDeterminants[Goffset+batch*N_bc+tidx];\n"
5934: "    for (int n = 0; n < dim*dim; ++n) {\n"
5935: "      const int offset = n*N_t;\n"
5936: "      invJ[offset+tidx] = jacobianInverses[(Goffset+batch*N_bc)*dim*dim+offset+tidx];\n"
5937: "    }\n"
5938: "    /* Load coefficients u_i for this cell */\n"
5939: "    for (int n = 0; n < N_bt; ++n) {\n"
5940: "      const int offset = n*N_t;\n"
5941: "      u_i[offset+tidx] = coefficients[(Goffset*N_bt)+batch*N_t*N_b+offset+tidx];\n"
5942: "    }\n",
5943:                        &count);STRING_ERROR_CHECK("Message to short");
5944:   if (useAux) {
5945:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5946: "    /* Load coefficients a_i for this cell */\n"
5947: "    /* TODO: This should not be N_t here, it should be N_bc*N_comp_aux */\n"
5948: "    a_i[tidx] = coefficientsAux[Goffset+batch*N_t+tidx];\n",
5949:                             &count);STRING_ERROR_CHECK("Message to short");
5950:   }
5951:   /* Quadrature phase */
5952:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5953: "    barrier(CLK_LOCAL_MEM_FENCE);\n"
5954: "\n"
5955: "    /* Map coefficients to values at quadrature points */\n"
5956: "    for (int c = 0; c < N_sqc; ++c) {\n"
5957: "      const int cell          = c*N_bl*N_b + blqidx;\n"
5958: "      const int fidx          = (cell*N_q + qidx)*N_comp + cidx;\n",
5959:                        &count);STRING_ERROR_CHECK("Message to short");
5960:   if (useField) {
5961:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5962: "      %s  u[%d]; //[N_comp];     // $u(x_q)$, Value of the field at $x_q$\n",
5963:                               &count, numeric_str, N_c);STRING_ERROR_CHECK("Message to short");
5964:   }
5965:   if (useFieldDer) {
5966:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5967: "      %s%d   gradU[%d]; //[N_comp]; // $\\nabla u(x_q)$, Value of the field gradient at $x_q$\n",
5968:                               &count, numeric_str, dim, N_c);STRING_ERROR_CHECK("Message to short");
5969:   }
5970:   if (useFieldAux) {
5971:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5972: "      %s  a[%d]; //[1];     // $a(x_q)$, Value of the auxiliary fields at $x_q$\n",
5973:                               &count, numeric_str, 1);STRING_ERROR_CHECK("Message to short");
5974:   }
5975:   if (useFieldDerAux) {
5976:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5977: "      %s%d   gradA[%d]; //[1]; // $\\nabla a(x_q)$, Value of the auxiliary field gradient at $x_q$\n",
5978:                               &count, numeric_str, dim, 1);STRING_ERROR_CHECK("Message to short");
5979:   }
5980:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5981: "\n"
5982: "      for (int comp = 0; comp < N_comp; ++comp) {\n",
5983:                             &count);STRING_ERROR_CHECK("Message to short");
5984:   if (useField) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "        u[comp] = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");}
5985:   if (useFieldDer) {
5986:     switch (dim) {
5987:     case 1:
5988:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "        gradU[comp].x = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");break;
5989:     case 2:
5990:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "        gradU[comp].x = 0.0; gradU[comp].y = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");break;
5991:     case 3:
5992:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "        gradU[comp].x = 0.0; gradU[comp].y = 0.0; gradU[comp].z = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");break;
5993:     }
5994:   }
5995:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5996: "      }\n",
5997:                             &count);STRING_ERROR_CHECK("Message to short");
5998:   if (useFieldAux) {
5999:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      a[0] = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");
6000:   }
6001:   if (useFieldDerAux) {
6002:     switch (dim) {
6003:     case 1:
6004:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      gradA[0].x = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");break;
6005:     case 2:
6006:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      gradA[0].x = 0.0; gradA[0].y = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");break;
6007:     case 3:
6008:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      gradA[0].x = 0.0; gradA[0].y = 0.0; gradA[0].z = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");break;
6009:     }
6010:   }
6011:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
6012: "      /* Get field and derivatives at this quadrature point */\n"
6013: "      for (int i = 0; i < N_b; ++i) {\n"
6014: "        for (int comp = 0; comp < N_comp; ++comp) {\n"
6015: "          const int b    = i*N_comp+comp;\n"
6016: "          const int pidx = qidx*N_bt + b;\n"
6017: "          const int uidx = cell*N_bt + b;\n"
6018: "          %s%d   realSpaceDer;\n\n",
6019:                             &count, numeric_str, dim);STRING_ERROR_CHECK("Message to short");
6020:   if (useField) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"          u[comp] += u_i[uidx]*phi_i[pidx];\n", &count);STRING_ERROR_CHECK("Message to short");}
6021:   if (useFieldDer) {
6022:     switch (dim) {
6023:     case 2:
6024:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
6025: "          realSpaceDer.x = invJ[cell*dim*dim+0*dim+0]*phiDer_i[pidx].x + invJ[cell*dim*dim+1*dim+0]*phiDer_i[pidx].y;\n"
6026: "          gradU[comp].x += u_i[uidx]*realSpaceDer.x;\n"
6027: "          realSpaceDer.y = invJ[cell*dim*dim+0*dim+1]*phiDer_i[pidx].x + invJ[cell*dim*dim+1*dim+1]*phiDer_i[pidx].y;\n"
6028: "          gradU[comp].y += u_i[uidx]*realSpaceDer.y;\n",
6029:                            &count);STRING_ERROR_CHECK("Message to short");break;
6030:     case 3:
6031:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
6032: "          realSpaceDer.x = invJ[cell*dim*dim+0*dim+0]*phiDer_i[pidx].x + invJ[cell*dim*dim+1*dim+0]*phiDer_i[pidx].y + invJ[cell*dim*dim+2*dim+0]*phiDer_i[pidx].z;\n"
6033: "          gradU[comp].x += u_i[uidx]*realSpaceDer.x;\n"
6034: "          realSpaceDer.y = invJ[cell*dim*dim+0*dim+1]*phiDer_i[pidx].x + invJ[cell*dim*dim+1*dim+1]*phiDer_i[pidx].y + invJ[cell*dim*dim+2*dim+1]*phiDer_i[pidx].z;\n"
6035: "          gradU[comp].y += u_i[uidx]*realSpaceDer.y;\n"
6036: "          realSpaceDer.z = invJ[cell*dim*dim+0*dim+2]*phiDer_i[pidx].x + invJ[cell*dim*dim+1*dim+2]*phiDer_i[pidx].y + invJ[cell*dim*dim+2*dim+2]*phiDer_i[pidx].z;\n"
6037: "          gradU[comp].z += u_i[uidx]*realSpaceDer.z;\n",
6038:                            &count);STRING_ERROR_CHECK("Message to short");break;
6039:     }
6040:   }
6041:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
6042: "        }\n"
6043: "      }\n",
6044:                             &count);STRING_ERROR_CHECK("Message to short");
6045:   if (useFieldAux) {
6046:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"          a[0] += a_i[cell];\n", &count);STRING_ERROR_CHECK("Message to short");
6047:   }
6048:   /* Calculate residual at quadrature points: Should be generated by an weak form egine */
6049:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
6050: "      /* Process values at quadrature points */\n",
6051:                             &count);STRING_ERROR_CHECK("Message to short");
6052:   switch (op) {
6053:   case LAPLACIAN:
6054:     if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      f_0[fidx] = 4.0;\n", &count);STRING_ERROR_CHECK("Message to short");}
6055:     if (useF1) {
6056:       if (useAux) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      f_1[fidx] = a[0]*gradU[cidx];\n", &count);STRING_ERROR_CHECK("Message to short");}
6057:       else        {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      f_1[fidx] = gradU[cidx];\n", &count);STRING_ERROR_CHECK("Message to short");}
6058:     }
6059:     break;
6060:   case ELASTICITY:
6061:     if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      f_0[fidx] = 4.0;\n", &count);STRING_ERROR_CHECK("Message to short");}
6062:     if (useF1) {
6063:     switch (dim) {
6064:     case 2:
6065:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
6066: "      switch (cidx) {\n"
6067: "      case 0:\n"
6068: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[0].x + gradU[0].x);\n"
6069: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[0].y + gradU[1].x);\n"
6070: "        break;\n"
6071: "      case 1:\n"
6072: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[1].x + gradU[0].y);\n"
6073: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[1].y + gradU[1].y);\n"
6074: "      }\n",
6075:                            &count);STRING_ERROR_CHECK("Message to short");break;
6076:     case 3:
6077:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
6078: "      switch (cidx) {\n"
6079: "      case 0:\n"
6080: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[0].x + gradU[0].x);\n"
6081: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[0].y + gradU[1].x);\n"
6082: "        f_1[fidx].z = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[0].z + gradU[2].x);\n"
6083: "        break;\n"
6084: "      case 1:\n"
6085: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[1].x + gradU[0].y);\n"
6086: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[1].y + gradU[1].y);\n"
6087: "        f_1[fidx].z = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[1].y + gradU[2].y);\n"
6088: "        break;\n"
6089: "      case 2:\n"
6090: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[2].x + gradU[0].z);\n"
6091: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[2].y + gradU[1].z);\n"
6092: "        f_1[fidx].z = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[2].y + gradU[2].z);\n"
6093: "      }\n",
6094:                            &count);STRING_ERROR_CHECK("Message to short");break;
6095:     }}
6096:     break;
6097:   default:
6098:     SETERRQ1(PETSC_COMM_WORLD, PETSC_ERR_SUP, "PDE operator %d is not supported", op);
6099:   }
6100:   if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"      f_0[fidx] *= detJ[cell]*w;\n", &count);STRING_ERROR_CHECK("Message to short");}
6101:   if (useF1) {
6102:     switch (dim) {
6103:     case 1:
6104:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"      f_1[fidx].x *= detJ[cell]*w;\n", &count);STRING_ERROR_CHECK("Message to short");break;
6105:     case 2:
6106:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"      f_1[fidx].x *= detJ[cell]*w; f_1[fidx].y *= detJ[cell]*w;\n", &count);STRING_ERROR_CHECK("Message to short");break;
6107:     case 3:
6108:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"      f_1[fidx].x *= detJ[cell]*w; f_1[fidx].y *= detJ[cell]*w; f_1[fidx].z *= detJ[cell]*w;\n", &count);STRING_ERROR_CHECK("Message to short");break;
6109:     }
6110:   }
6111:   /* Thread transpose */
6112:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
6113: "    }\n\n"
6114: "    /* ==== TRANSPOSE THREADS ==== */\n"
6115: "    barrier(CLK_LOCAL_MEM_FENCE);\n\n",
6116:                        &count);STRING_ERROR_CHECK("Message to short");
6117:   /* Basis phase */
6118:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
6119: "    /* Map values at quadrature points to coefficients */\n"
6120: "    for (int c = 0; c < N_sbc; ++c) {\n"
6121: "      const int cell = c*N_bl*N_q + blbidx; /* Cell number in batch */\n"
6122: "\n"
6123: "      e_i = 0.0;\n"
6124: "      for (int q = 0; q < N_q; ++q) {\n"
6125: "        const int pidx = q*N_bt + bidx;\n"
6126: "        const int fidx = (cell*N_q + q)*N_comp + cidx;\n"
6127: "        %s%d   realSpaceDer;\n\n",
6128:                        &count, numeric_str, dim);STRING_ERROR_CHECK("Message to short");

6130:   if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"        e_i += phi_i[pidx]*f_0[fidx];\n", &count);STRING_ERROR_CHECK("Message to short");}
6131:   if (useF1) {
6132:     switch (dim) {
6133:     case 2:
6134:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
6135: "        realSpaceDer.x = invJ[cell*dim*dim+0*dim+0]*phiDer_i[pidx].x + invJ[cell*dim*dim+1*dim+0]*phiDer_i[pidx].y;\n"
6136: "        e_i           += realSpaceDer.x*f_1[fidx].x;\n"
6137: "        realSpaceDer.y = invJ[cell*dim*dim+0*dim+1]*phiDer_i[pidx].x + invJ[cell*dim*dim+1*dim+1]*phiDer_i[pidx].y;\n"
6138: "        e_i           += realSpaceDer.y*f_1[fidx].y;\n",
6139:                            &count);STRING_ERROR_CHECK("Message to short");break;
6140:     case 3:
6141:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
6142: "        realSpaceDer.x = invJ[cell*dim*dim+0*dim+0]*phiDer_i[pidx].x + invJ[cell*dim*dim+1*dim+0]*phiDer_i[pidx].y + invJ[cell*dim*dim+2*dim+0]*phiDer_i[pidx].z;\n"
6143: "        e_i           += realSpaceDer.x*f_1[fidx].x;\n"
6144: "        realSpaceDer.y = invJ[cell*dim*dim+0*dim+1]*phiDer_i[pidx].x + invJ[cell*dim*dim+1*dim+1]*phiDer_i[pidx].y + invJ[cell*dim*dim+2*dim+1]*phiDer_i[pidx].z;\n"
6145: "        e_i           += realSpaceDer.y*f_1[fidx].y;\n"
6146: "        realSpaceDer.z = invJ[cell*dim*dim+0*dim+2]*phiDer_i[pidx].x + invJ[cell*dim*dim+1*dim+2]*phiDer_i[pidx].y + invJ[cell*dim*dim+2*dim+2]*phiDer_i[pidx].z;\n"
6147: "        e_i           += realSpaceDer.z*f_1[fidx].z;\n",
6148:                            &count);STRING_ERROR_CHECK("Message to short");break;
6149:     }
6150:   }
6151:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
6152: "      }\n"
6153: "      /* Write element vector for N_{cbc} cells at a time */\n"
6154: "      elemVec[(Goffset + batch*N_bc + c*N_bl*N_q)*N_bt + tidx] = e_i;\n"
6155: "    }\n"
6156: "    /* ==== Could do one write per batch ==== */\n"
6157: "  }\n"
6158: "  return;\n"
6159: "}\n",
6160:                        &count);STRING_ERROR_CHECK("Message to short");
6161:   return(0);
6162: }

6164: PetscErrorCode PetscFEOpenCLGetIntegrationKernel(PetscFE fem, PetscBool useAux, cl_program *ocl_prog, cl_kernel *ocl_kernel)
6165: {
6166:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
6167:   PetscInt        dim, N_bl;
6168:   PetscBool       flg;
6169:   char           *buffer;
6170:   size_t          len;
6171:   char            errMsg[8192];
6172:   cl_int          ierr2;
6173:   PetscErrorCode  ierr;

6176:   PetscFEGetSpatialDimension(fem, &dim);
6177:   PetscMalloc1(8192, &buffer);
6178:   PetscFEGetTileSizes(fem, NULL, &N_bl, NULL, NULL);
6179:   PetscFEOpenCLGenerateIntegrationCode(fem, &buffer, 8192, useAux, N_bl);
6180:   PetscOptionsHasName(((PetscObject)fem)->options,((PetscObject)fem)->prefix, "-petscfe_opencl_kernel_print", &flg);
6181:   if (flg) {PetscPrintf(PetscObjectComm((PetscObject) fem), "OpenCL FE Integration Kernel:\n%s\n", buffer);}
6182:   len  = strlen(buffer);
6183:   *ocl_prog = clCreateProgramWithSource(ocl->ctx_id, 1, (const char **) &buffer, &len, &ierr2);CHKERRQ(ierr2);
6184:   clBuildProgram(*ocl_prog, 0, NULL, NULL, NULL, NULL);
6185:   if (ierr != CL_SUCCESS) {
6186:     clGetProgramBuildInfo(*ocl_prog, ocl->dev_id, CL_PROGRAM_BUILD_LOG, 8192*sizeof(char), &errMsg, NULL);
6187:     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Build failed! Log:\n %s", errMsg);
6188:   }
6189:   PetscFree(buffer);
6190:   *ocl_kernel = clCreateKernel(*ocl_prog, "integrateElementQuadrature", &ierr);
6191:   return(0);
6192: }

6194: PetscErrorCode PetscFEOpenCLCalculateGrid(PetscFE fem, PetscInt N, PetscInt blockSize, size_t *x, size_t *y, size_t *z)
6195: {
6196:   const PetscInt Nblocks = N/blockSize;

6199:   if (N % blockSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Invalid block size %d for %d elements", blockSize, N);
6200:   *z = 1;
6201:   for (*x = (size_t) (PetscSqrtReal(Nblocks) + 0.5); *x > 0; --*x) {
6202:     *y = Nblocks / *x;
6203:     if (*x * *y == Nblocks) break;
6204:   }
6205:   if (*x * *y != Nblocks) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Could not find partition for %d with block size %d", N, blockSize);
6206:   return(0);
6207: }

6209: PetscErrorCode PetscFEOpenCLLogResidual(PetscFE fem, PetscLogDouble time, PetscLogDouble flops)
6210: {
6211:   PetscFE_OpenCL   *ocl = (PetscFE_OpenCL *) fem->data;
6212:   PetscStageLog     stageLog;
6213:   PetscEventPerfLog eventLog = NULL;
6214:   PetscInt          stage;
6215:   PetscErrorCode    ierr;

6218:   PetscLogGetStageLog(&stageLog);
6219:   PetscStageLogGetCurrent(stageLog, &stage);
6220:   PetscStageLogGetEventPerfLog(stageLog, stage, &eventLog);
6221:     /* Log performance info */
6222:   eventLog->eventInfo[ocl->residualEvent].count++;
6223:   eventLog->eventInfo[ocl->residualEvent].time  += time;
6224:   eventLog->eventInfo[ocl->residualEvent].flops += flops;
6225:   return(0);
6226: }

6228: PetscErrorCode PetscFEIntegrateResidual_OpenCL(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *cgeom,
6229:                                                const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
6230: {
6231:   /* Nbc = batchSize */
6232:   PetscFE_OpenCL   *ocl = (PetscFE_OpenCL *) fem->data;
6233:   PetscPointFunc    f0_func;
6234:   PetscPointFunc    f1_func;
6235:   PetscQuadrature   q;
6236:   PetscInt          dim, qNc;
6237:   PetscInt          N_b;    /* The number of basis functions */
6238:   PetscInt          N_comp; /* The number of basis function components */
6239:   PetscInt          N_bt;   /* The total number of scalar basis functions */
6240:   PetscInt          N_q;    /* The number of quadrature points */
6241:   PetscInt          N_bst;  /* The block size, LCM(N_bt, N_q), Notice that a block is not process simultaneously */
6242:   PetscInt          N_t;    /* The number of threads, N_bst * N_bl */
6243:   PetscInt          N_bl;   /* The number of blocks */
6244:   PetscInt          N_bc;   /* The batch size, N_bl*N_q*N_b */
6245:   PetscInt          N_cb;   /* The number of batches */
6246:   PetscInt          numFlops, f0Flops = 0, f1Flops = 0;
6247:   PetscBool         useAux      = probAux ? PETSC_TRUE : PETSC_FALSE;
6248:   PetscBool         useField    = PETSC_FALSE;
6249:   PetscBool         useFieldDer = PETSC_TRUE;
6250:   PetscBool         useF0       = PETSC_TRUE;
6251:   PetscBool         useF1       = PETSC_TRUE;
6252:   /* OpenCL variables */
6253:   cl_program        ocl_prog;
6254:   cl_kernel         ocl_kernel;
6255:   cl_event          ocl_ev;         /* The event for tracking kernel execution */
6256:   cl_ulong          ns_start;       /* Nanoseconds counter on GPU at kernel start */
6257:   cl_ulong          ns_end;         /* Nanoseconds counter on GPU at kernel stop */
6258:   cl_mem            o_jacobianInverses, o_jacobianDeterminants;
6259:   cl_mem            o_coefficients, o_coefficientsAux, o_elemVec;
6260:   float            *f_coeff = NULL, *f_coeffAux = NULL, *f_invJ = NULL, *f_detJ = NULL;
6261:   double           *d_coeff = NULL, *d_coeffAux = NULL, *d_invJ = NULL, *d_detJ = NULL;
6262:   PetscReal        *r_invJ = NULL, *r_detJ = NULL;
6263:   void             *oclCoeff, *oclCoeffAux, *oclInvJ, *oclDetJ;
6264:   size_t            local_work_size[3], global_work_size[3];
6265:   size_t            realSize, x, y, z;
6266:   const PetscReal   *points, *weights;
6267:   PetscErrorCode    ierr;

6270:   if (!Ne) {PetscFEOpenCLLogResidual(fem, 0.0, 0.0); return(0);}
6271:   PetscFEGetSpatialDimension(fem, &dim);
6272:   PetscFEGetQuadrature(fem, &q);
6273:   PetscQuadratureGetData(q, NULL, &qNc, &N_q, &points, &weights);
6274:   if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
6275:   PetscFEGetDimension(fem, &N_b);
6276:   PetscFEGetNumComponents(fem, &N_comp);
6277:   PetscDSGetResidual(prob, field, &f0_func, &f1_func);
6278:   PetscFEGetTileSizes(fem, NULL, &N_bl, &N_bc, &N_cb);
6279:   N_bt  = N_b*N_comp;
6280:   N_bst = N_bt*N_q;
6281:   N_t   = N_bst*N_bl;
6282:   if (N_bc*N_comp != N_t) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of threads %d should be %d * %d", N_t, N_bc, N_comp);
6283:   /* Calculate layout */
6284:   if (Ne % (N_cb*N_bc)) { /* Remainder cells */
6285:     PetscFEIntegrateResidual_Basic(fem, prob, field, Ne, cgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);
6286:     return(0);
6287:   }
6288:   PetscFEOpenCLCalculateGrid(fem, Ne, N_cb*N_bc, &x, &y, &z);
6289:   local_work_size[0]  = N_bc*N_comp;
6290:   local_work_size[1]  = 1;
6291:   local_work_size[2]  = 1;
6292:   global_work_size[0] = x * local_work_size[0];
6293:   global_work_size[1] = y * local_work_size[1];
6294:   global_work_size[2] = z * local_work_size[2];
6295:   PetscInfo7(fem, "GPU layout grid(%d,%d,%d) block(%d,%d,%d) with %d batches\n", x, y, z, local_work_size[0], local_work_size[1], local_work_size[2], N_cb);
6296:   PetscInfo2(fem, " N_t: %d, N_cb: %d\n", N_t, N_cb);
6297:   /* Generate code */
6298:   if (probAux) {
6299:     PetscSpace P;
6300:     PetscInt   NfAux, order, f;

6302:     PetscDSGetNumFields(probAux, &NfAux);
6303:     for (f = 0; f < NfAux; ++f) {
6304:       PetscFE feAux;

6306:       PetscDSGetDiscretization(probAux, f, (PetscObject *) &feAux);
6307:       PetscFEGetBasisSpace(feAux, &P);
6308:       PetscSpaceGetOrder(P, &order);
6309:       if (order > 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Can only handle P0 coefficient fields");
6310:     }
6311:   }
6312:   PetscFEOpenCLGetIntegrationKernel(fem, useAux, &ocl_prog, &ocl_kernel);
6313:   /* Create buffers on the device and send data over */
6314:   PetscDataTypeGetSize(ocl->realType, &realSize);
6315:   if (cgeom->numPoints > 1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support affine geometry for OpenCL integration right now");
6316:   if (sizeof(PetscReal) != realSize) {
6317:     switch (ocl->realType) {
6318:     case PETSC_FLOAT:
6319:     {
6320:       PetscInt c, b, d;

6322:       PetscMalloc4(Ne*N_bt,&f_coeff,Ne,&f_coeffAux,Ne*dim*dim,&f_invJ,Ne,&f_detJ);
6323:       for (c = 0; c < Ne; ++c) {
6324:         f_detJ[c] = (float) cgeom->detJ[c];
6325:         for (d = 0; d < dim*dim; ++d) {
6326:           f_invJ[c*dim*dim+d] = (float) cgeom->invJ[c * dim * dim + d];
6327:         }
6328:         for (b = 0; b < N_bt; ++b) {
6329:           f_coeff[c*N_bt+b] = (float) coefficients[c*N_bt+b];
6330:         }
6331:       }
6332:       if (coefficientsAux) { /* Assume P0 */
6333:         for (c = 0; c < Ne; ++c) {
6334:           f_coeffAux[c] = (float) coefficientsAux[c];
6335:         }
6336:       }
6337:       oclCoeff      = (void *) f_coeff;
6338:       if (coefficientsAux) {
6339:         oclCoeffAux = (void *) f_coeffAux;
6340:       } else {
6341:         oclCoeffAux = NULL;
6342:       }
6343:       oclInvJ       = (void *) f_invJ;
6344:       oclDetJ       = (void *) f_detJ;
6345:     }
6346:     break;
6347:     case PETSC_DOUBLE:
6348:     {
6349:       PetscInt c, b, d;

6351:       PetscMalloc4(Ne*N_bt,&d_coeff,Ne,&d_coeffAux,Ne*dim*dim,&d_invJ,Ne,&d_detJ);
6352:       for (c = 0; c < Ne; ++c) {
6353:         d_detJ[c] = (double) cgeom->detJ[c];
6354:         for (d = 0; d < dim*dim; ++d) {
6355:           d_invJ[c*dim*dim+d] = (double) cgeom->invJ[c * dim * dim + d];
6356:         }
6357:         for (b = 0; b < N_bt; ++b) {
6358:           d_coeff[c*N_bt+b] = (double) coefficients[c*N_bt+b];
6359:         }
6360:       }
6361:       if (coefficientsAux) { /* Assume P0 */
6362:         for (c = 0; c < Ne; ++c) {
6363:           d_coeffAux[c] = (double) coefficientsAux[c];
6364:         }
6365:       }
6366:       oclCoeff      = (void *) d_coeff;
6367:       if (coefficientsAux) {
6368:         oclCoeffAux = (void *) d_coeffAux;
6369:       } else {
6370:         oclCoeffAux = NULL;
6371:       }
6372:       oclInvJ       = (void *) d_invJ;
6373:       oclDetJ       = (void *) d_detJ;
6374:     }
6375:     break;
6376:     default:
6377:       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported PETSc type %d", ocl->realType);
6378:     }
6379:   } else {
6380:     PetscInt c, d;

6382:     PetscMalloc2(Ne*dim*dim,&r_invJ,Ne,&r_detJ);
6383:     for (c = 0; c < Ne; ++c) {
6384:       r_detJ[c] = cgeom->detJ[c];
6385:       for (d = 0; d < dim*dim; ++d) {
6386:         r_invJ[c*dim*dim+d] = cgeom->invJ[c * dim * dim + d];
6387:       }
6388:     }
6389:     oclCoeff    = (void *) coefficients;
6390:     oclCoeffAux = (void *) coefficientsAux;
6391:     oclInvJ     = (void *) r_invJ;
6392:     oclDetJ     = (void *) r_detJ;
6393:   }
6394:   o_coefficients         = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne*N_bt    * realSize, oclCoeff,    &ierr);
6395:   if (coefficientsAux) {
6396:     o_coefficientsAux    = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne         * realSize, oclCoeffAux, &ierr);
6397:   } else {
6398:     o_coefficientsAux    = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY,                        Ne         * realSize, oclCoeffAux, &ierr);
6399:   }
6400:   o_jacobianInverses     = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne*dim*dim * realSize, oclInvJ,     &ierr);
6401:   o_jacobianDeterminants = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne         * realSize, oclDetJ,     &ierr);
6402:   o_elemVec              = clCreateBuffer(ocl->ctx_id, CL_MEM_WRITE_ONLY,                       Ne*N_bt    * realSize, NULL,        &ierr);
6403:   /* Kernel launch */
6404:   clSetKernelArg(ocl_kernel, 0, sizeof(cl_int), (void*) &N_cb);
6405:   clSetKernelArg(ocl_kernel, 1, sizeof(cl_mem), (void*) &o_coefficients);
6406:   clSetKernelArg(ocl_kernel, 2, sizeof(cl_mem), (void*) &o_coefficientsAux);
6407:   clSetKernelArg(ocl_kernel, 3, sizeof(cl_mem), (void*) &o_jacobianInverses);
6408:   clSetKernelArg(ocl_kernel, 4, sizeof(cl_mem), (void*) &o_jacobianDeterminants);
6409:   clSetKernelArg(ocl_kernel, 5, sizeof(cl_mem), (void*) &o_elemVec);
6410:   clEnqueueNDRangeKernel(ocl->queue_id, ocl_kernel, 3, NULL, global_work_size, local_work_size, 0, NULL, &ocl_ev);
6411:   /* Read data back from device */
6412:   if (sizeof(PetscReal) != realSize) {
6413:     switch (ocl->realType) {
6414:     case PETSC_FLOAT:
6415:     {
6416:       float   *elem;
6417:       PetscInt c, b;

6419:       PetscFree4(f_coeff,f_coeffAux,f_invJ,f_detJ);
6420:       PetscMalloc1(Ne*N_bt, &elem);
6421:       clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elem, 0, NULL, NULL);
6422:       for (c = 0; c < Ne; ++c) {
6423:         for (b = 0; b < N_bt; ++b) {
6424:           elemVec[c*N_bt+b] = (PetscScalar) elem[c*N_bt+b];
6425:         }
6426:       }
6427:       PetscFree(elem);
6428:     }
6429:     break;
6430:     case PETSC_DOUBLE:
6431:     {
6432:       double  *elem;
6433:       PetscInt c, b;

6435:       PetscFree4(d_coeff,d_coeffAux,d_invJ,d_detJ);
6436:       PetscMalloc1(Ne*N_bt, &elem);
6437:       clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elem, 0, NULL, NULL);
6438:       for (c = 0; c < Ne; ++c) {
6439:         for (b = 0; b < N_bt; ++b) {
6440:           elemVec[c*N_bt+b] = (PetscScalar) elem[c*N_bt+b];
6441:         }
6442:       }
6443:       PetscFree(elem);
6444:     }
6445:     break;
6446:     default:
6447:       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported PETSc type %d", ocl->realType);
6448:     }
6449:   } else {
6450:     PetscFree2(r_invJ,r_detJ);
6451:     clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elemVec, 0, NULL, NULL);
6452:   }
6453:   /* Log performance */
6454:   clGetEventProfilingInfo(ocl_ev, CL_PROFILING_COMMAND_START, sizeof(cl_ulong), &ns_start, NULL);
6455:   clGetEventProfilingInfo(ocl_ev, CL_PROFILING_COMMAND_END,   sizeof(cl_ulong), &ns_end,   NULL);
6456:   f0Flops = 0;
6457:   switch (ocl->op) {
6458:   case LAPLACIAN:
6459:     f1Flops = useAux ? dim : 0;break;
6460:   case ELASTICITY:
6461:     f1Flops = 2*dim*dim;break;
6462:   }
6463:   numFlops = Ne*(
6464:     N_q*(
6465:       N_b*N_comp*((useField ? 2 : 0) + (useFieldDer ? 2*dim*(dim + 1) : 0))
6466:       /*+
6467:        N_ba*N_compa*((useFieldAux ? 2 : 0) + (useFieldDerAux ? 2*dim*(dim + 1) : 0))*/
6468:       +
6469:       N_comp*((useF0 ? f0Flops + 2 : 0) + (useF1 ? f1Flops + 2*dim : 0)))
6470:     +
6471:     N_b*((useF0 ? 2 : 0) + (useF1 ? 2*dim*(dim + 1) : 0)));
6472:   PetscFEOpenCLLogResidual(fem, (ns_end - ns_start)*1.0e-9, numFlops);
6473:   /* Cleanup */
6474:   clReleaseMemObject(o_coefficients);
6475:   clReleaseMemObject(o_coefficientsAux);
6476:   clReleaseMemObject(o_jacobianInverses);
6477:   clReleaseMemObject(o_jacobianDeterminants);
6478:   clReleaseMemObject(o_elemVec);
6479:   clReleaseKernel(ocl_kernel);
6480:   clReleaseProgram(ocl_prog);
6481:   return(0);
6482: }

6484: PetscErrorCode PetscFEInitialize_OpenCL(PetscFE fem)
6485: {
6487:   fem->ops->setfromoptions          = NULL;
6488:   fem->ops->setup                   = PetscFESetUp_Basic;
6489:   fem->ops->view                    = NULL;
6490:   fem->ops->destroy                 = PetscFEDestroy_OpenCL;
6491:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
6492:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
6493:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_OpenCL;
6494:   fem->ops->integratebdresidual     = NULL/* PetscFEIntegrateBdResidual_OpenCL */;
6495:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_OpenCL */;
6496:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
6497:   return(0);
6498: }

6500: /*MC
6501:   PETSCFEOPENCL = "opencl" - A PetscFE object that integrates using a vectorized OpenCL implementation

6503:   Level: intermediate

6505: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
6506: M*/

6508: PETSC_EXTERN PetscErrorCode PetscFECreate_OpenCL(PetscFE fem)
6509: {
6510:   PetscFE_OpenCL *ocl;
6511:   cl_uint         num_platforms;
6512:   cl_platform_id  platform_ids[42];
6513:   cl_uint         num_devices;
6514:   cl_device_id    device_ids[42];
6515:   cl_int          ierr2;
6516:   PetscErrorCode  ierr;

6520:   PetscNewLog(fem,&ocl);
6521:   fem->data = ocl;

6523:   /* Init Platform */
6524:   clGetPlatformIDs(42, platform_ids, &num_platforms);
6525:   if (!num_platforms) SETERRQ(PetscObjectComm((PetscObject) fem), PETSC_ERR_SUP, "No OpenCL platform found.");
6526:   ocl->pf_id = platform_ids[0];
6527:   /* Init Device */
6528:   clGetDeviceIDs(ocl->pf_id, CL_DEVICE_TYPE_ALL, 42, device_ids, &num_devices);
6529:   if (!num_devices) SETERRQ(PetscObjectComm((PetscObject) fem), PETSC_ERR_SUP, "No OpenCL device found.");
6530:   ocl->dev_id = device_ids[0];
6531:   /* Create context with one command queue */
6532:   ocl->ctx_id   = clCreateContext(0, 1, &(ocl->dev_id), NULL, NULL, &ierr2);CHKERRQ(ierr2);
6533:   ocl->queue_id = clCreateCommandQueue(ocl->ctx_id, ocl->dev_id, CL_QUEUE_PROFILING_ENABLE, &ierr2);CHKERRQ(ierr2);
6534:   /* Types */
6535:   ocl->realType = PETSC_FLOAT;
6536:   /* Register events */
6537:   PetscLogEventRegister("OpenCL FEResidual", PETSCFE_CLASSID, &ocl->residualEvent);
6538:   /* Equation handling */
6539:   ocl->op = LAPLACIAN;

6541:   PetscFEInitialize_OpenCL(fem);
6542:   return(0);
6543: }

6545: PetscErrorCode PetscFEOpenCLSetRealType(PetscFE fem, PetscDataType realType)
6546: {
6547:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;

6551:   ocl->realType = realType;
6552:   return(0);
6553: }

6555: PetscErrorCode PetscFEOpenCLGetRealType(PetscFE fem, PetscDataType *realType)
6556: {
6557:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;

6562:   *realType = ocl->realType;
6563:   return(0);
6564: }

6566: #endif /* PETSC_HAVE_OPENCL */

6568: PetscErrorCode PetscFEDestroy_Composite(PetscFE fem)
6569: {
6570:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
6571:   PetscErrorCode     ierr;

6574:   CellRefinerRestoreAffineTransforms_Internal(cmp->cellRefiner, &cmp->numSubelements, &cmp->v0, &cmp->jac, &cmp->invjac);
6575:   PetscFree(cmp->embedding);
6576:   PetscFree(cmp);
6577:   return(0);
6578: }

6580: PetscErrorCode PetscFESetUp_Composite(PetscFE fem)
6581: {
6582:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
6583:   DM                 K;
6584:   PetscReal         *subpoint;
6585:   PetscBLASInt      *pivots;
6586:   PetscBLASInt       n, info;
6587:   PetscScalar       *work, *invVscalar;
6588:   PetscInt           dim, pdim, spdim, j, s;
6589:   PetscErrorCode     ierr;

6592:   /* Get affine mapping from reference cell to each subcell */
6593:   PetscDualSpaceGetDM(fem->dualSpace, &K);
6594:   DMGetDimension(K, &dim);
6595:   DMPlexGetCellRefiner_Internal(K, &cmp->cellRefiner);
6596:   CellRefinerGetAffineTransforms_Internal(cmp->cellRefiner, &cmp->numSubelements, &cmp->v0, &cmp->jac, &cmp->invjac);
6597:   /* Determine dof embedding into subelements */
6598:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
6599:   PetscSpaceGetDimension(fem->basisSpace, &spdim);
6600:   PetscMalloc1(cmp->numSubelements*spdim,&cmp->embedding);
6601:   DMGetWorkArray(K, dim, MPIU_REAL, &subpoint);
6602:   for (s = 0; s < cmp->numSubelements; ++s) {
6603:     PetscInt sd = 0;

6605:     for (j = 0; j < pdim; ++j) {
6606:       PetscBool       inside;
6607:       PetscQuadrature f;
6608:       PetscInt        d, e;

6610:       PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);
6611:       /* Apply transform to first point, and check that point is inside subcell */
6612:       for (d = 0; d < dim; ++d) {
6613:         subpoint[d] = -1.0;
6614:         for (e = 0; e < dim; ++e) subpoint[d] += cmp->invjac[(s*dim + d)*dim+e]*(f->points[e] - cmp->v0[s*dim+e]);
6615:       }
6616:       CellRefinerInCellTest_Internal(cmp->cellRefiner, subpoint, &inside);
6617:       if (inside) {cmp->embedding[s*spdim+sd++] = j;}
6618:     }
6619:     if (sd != spdim) SETERRQ3(PetscObjectComm((PetscObject) fem), PETSC_ERR_PLIB, "Subelement %d has %d dual basis vectors != %d", s, sd, spdim);
6620:   }
6621:   DMRestoreWorkArray(K, dim, MPIU_REAL, &subpoint);
6622:   /* Construct the change of basis from prime basis to nodal basis for each subelement */
6623:   PetscMalloc1(cmp->numSubelements*spdim*spdim,&fem->invV);
6624:   PetscMalloc2(spdim,&pivots,spdim,&work);
6625: #if defined(PETSC_USE_COMPLEX)
6626:   PetscMalloc1(cmp->numSubelements*spdim*spdim,&invVscalar);
6627: #else
6628:   invVscalar = fem->invV;
6629: #endif
6630:   for (s = 0; s < cmp->numSubelements; ++s) {
6631:     for (j = 0; j < spdim; ++j) {
6632:       PetscReal       *Bf;
6633:       PetscQuadrature  f;
6634:       const PetscReal *points, *weights;
6635:       PetscInt         Nc, Nq, q, k;

6637:       PetscDualSpaceGetFunctional(fem->dualSpace, cmp->embedding[s*spdim+j], &f);
6638:       PetscQuadratureGetData(f, NULL, &Nc, &Nq, &points, &weights);
6639:       PetscMalloc1(f->numPoints*spdim*Nc,&Bf);
6640:       PetscSpaceEvaluate(fem->basisSpace, Nq, points, Bf, NULL, NULL);
6641:       for (k = 0; k < spdim; ++k) {
6642:         /* n_j \cdot \phi_k */
6643:         invVscalar[(s*spdim + j)*spdim+k] = 0.0;
6644:         for (q = 0; q < Nq; ++q) {
6645:           invVscalar[(s*spdim + j)*spdim+k] += Bf[q*spdim+k]*weights[q];
6646:         }
6647:       }
6648:       PetscFree(Bf);
6649:     }
6650:     n = spdim;
6651:     PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, &invVscalar[s*spdim*spdim], &n, pivots, &info));
6652:     PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, &invVscalar[s*spdim*spdim], &n, pivots, work, &n, &info));
6653:   }
6654: #if defined(PETSC_USE_COMPLEX)
6655:   for (s = 0; s <cmp->numSubelements*spdim*spdim; s++) fem->invV[s] = PetscRealPart(invVscalar[s]);
6656:   PetscFree(invVscalar);
6657: #endif
6658:   PetscFree2(pivots,work);
6659:   return(0);
6660: }

6662: PetscErrorCode PetscFEGetTabulation_Composite(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H)
6663: {
6664:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
6665:   DM                 dm;
6666:   PetscInt           pdim;  /* Dimension of FE space P */
6667:   PetscInt           spdim; /* Dimension of subelement FE space P */
6668:   PetscInt           dim;   /* Spatial dimension */
6669:   PetscInt           comp;  /* Field components */
6670:   PetscInt          *subpoints;
6671:   PetscReal         *tmpB, *tmpD, *tmpH, *subpoint;
6672:   PetscInt           p, s, d, e, j, k;
6673:   PetscErrorCode     ierr;

6676:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
6677:   DMGetDimension(dm, &dim);
6678:   PetscSpaceGetDimension(fem->basisSpace, &spdim);
6679:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
6680:   PetscFEGetNumComponents(fem, &comp);
6681:   /* Divide points into subelements */
6682:   DMGetWorkArray(dm, npoints, MPIU_INT, &subpoints);
6683:   DMGetWorkArray(dm, dim, MPIU_REAL, &subpoint);
6684:   for (p = 0; p < npoints; ++p) {
6685:     for (s = 0; s < cmp->numSubelements; ++s) {
6686:       PetscBool inside;

6688:       /* Apply transform, and check that point is inside cell */
6689:       for (d = 0; d < dim; ++d) {
6690:         subpoint[d] = -1.0;
6691:         for (e = 0; e < dim; ++e) subpoint[d] += cmp->invjac[(s*dim + d)*dim+e]*(points[p*dim+e] - cmp->v0[s*dim+e]);
6692:       }
6693:       CellRefinerInCellTest_Internal(cmp->cellRefiner, subpoint, &inside);
6694:       if (inside) {subpoints[p] = s; break;}
6695:     }
6696:     if (s >= cmp->numSubelements) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %d was not found in any subelement", p);
6697:   }
6698:   DMRestoreWorkArray(dm, dim, MPIU_REAL, &subpoint);
6699:   /* Evaluate the prime basis functions at all points */
6700:   if (B) {DMGetWorkArray(dm, npoints*spdim, MPIU_REAL, &tmpB);}
6701:   if (D) {DMGetWorkArray(dm, npoints*spdim*dim, MPIU_REAL, &tmpD);}
6702:   if (H) {DMGetWorkArray(dm, npoints*spdim*dim*dim, MPIU_REAL, &tmpH);}
6703:   PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);
6704:   /* Translate to the nodal basis */
6705:   if (B) {PetscMemzero(B, npoints*pdim*comp * sizeof(PetscReal));}
6706:   if (D) {PetscMemzero(D, npoints*pdim*comp*dim * sizeof(PetscReal));}
6707:   if (H) {PetscMemzero(H, npoints*pdim*comp*dim*dim * sizeof(PetscReal));}
6708:   for (p = 0; p < npoints; ++p) {
6709:     const PetscInt s = subpoints[p];

6711:     if (B) {
6712:       /* Multiply by V^{-1} (spdim x spdim) */
6713:       for (j = 0; j < spdim; ++j) {
6714:         const PetscInt i = (p*pdim + cmp->embedding[s*spdim+j])*comp;

6716:         B[i] = 0.0;
6717:         for (k = 0; k < spdim; ++k) {
6718:           B[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpB[p*spdim + k];
6719:         }
6720:       }
6721:     }
6722:     if (D) {
6723:       /* Multiply by V^{-1} (spdim x spdim) */
6724:       for (j = 0; j < spdim; ++j) {
6725:         for (d = 0; d < dim; ++d) {
6726:           const PetscInt i = ((p*pdim + cmp->embedding[s*spdim+j])*comp + 0)*dim + d;

6728:           D[i] = 0.0;
6729:           for (k = 0; k < spdim; ++k) {
6730:             D[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpD[(p*spdim + k)*dim + d];
6731:           }
6732:         }
6733:       }
6734:     }
6735:     if (H) {
6736:       /* Multiply by V^{-1} (pdim x pdim) */
6737:       for (j = 0; j < spdim; ++j) {
6738:         for (d = 0; d < dim*dim; ++d) {
6739:           const PetscInt i = ((p*pdim + cmp->embedding[s*spdim+j])*comp + 0)*dim*dim + d;

6741:           H[i] = 0.0;
6742:           for (k = 0; k < spdim; ++k) {
6743:             H[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpH[(p*spdim + k)*dim*dim + d];
6744:           }
6745:         }
6746:       }
6747:     }
6748:   }
6749:   DMRestoreWorkArray(dm, npoints, MPIU_INT, &subpoints);
6750:   if (B) {DMRestoreWorkArray(dm, npoints*spdim, MPIU_REAL, &tmpB);}
6751:   if (D) {DMRestoreWorkArray(dm, npoints*spdim*dim, MPIU_REAL, &tmpD);}
6752:   if (H) {DMRestoreWorkArray(dm, npoints*spdim*dim*dim, MPIU_REAL, &tmpH);}
6753:   return(0);
6754: }

6756: PetscErrorCode PetscFEInitialize_Composite(PetscFE fem)
6757: {
6759:   fem->ops->setfromoptions          = NULL;
6760:   fem->ops->setup                   = PetscFESetUp_Composite;
6761:   fem->ops->view                    = NULL;
6762:   fem->ops->destroy                 = PetscFEDestroy_Composite;
6763:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
6764:   fem->ops->gettabulation           = PetscFEGetTabulation_Composite;
6765:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Basic;
6766:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Basic;
6767:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Basic */;
6768:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
6769:   return(0);
6770: }

6772: /*MC
6773:   PETSCFECOMPOSITE = "composite" - A PetscFE object that represents a composite element

6775:   Level: intermediate

6777: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
6778: M*/
6779: PETSC_EXTERN PetscErrorCode PetscFECreate_Composite(PetscFE fem)
6780: {
6781:   PetscFE_Composite *cmp;
6782:   PetscErrorCode     ierr;

6786:   PetscNewLog(fem, &cmp);
6787:   fem->data = cmp;

6789:   cmp->cellRefiner    = REFINER_NOOP;
6790:   cmp->numSubelements = -1;
6791:   cmp->v0             = NULL;
6792:   cmp->jac            = NULL;

6794:   PetscFEInitialize_Composite(fem);
6795:   return(0);
6796: }

6798: PETSC_EXTERN PetscErrorCode PetscFECreatePointTrace(PetscFE fe, PetscInt refPoint, PetscFE *trFE)
6799: {
6800:   PetscSpace     bsp, bsubsp;
6801:   PetscDualSpace dsp, dsubsp;
6802:   PetscInt       dim, depth, numComp, i, j, coneSize, order;
6803:   PetscFEType    type;
6804:   DM             dm;
6805:   DMLabel        label;
6806:   PetscReal      *xi, *v, *J, detJ;
6807:   PetscQuadrature origin, fullQuad, subQuad;

6813:   PetscFEGetBasisSpace(fe,&bsp);
6814:   PetscFEGetDualSpace(fe,&dsp);
6815:   PetscDualSpaceGetDM(dsp,&dm);
6816:   DMGetDimension(dm,&dim);
6817:   DMPlexGetDepthLabel(dm,&label);
6818:   DMLabelGetValue(label,refPoint,&depth);
6819:   PetscCalloc1(depth,&xi);
6820:   PetscMalloc1(dim,&v);
6821:   PetscMalloc1(dim*dim,&J);
6822:   for (i = 0; i < depth; i++) xi[i] = 0.;
6823:   PetscQuadratureCreate(PETSC_COMM_SELF,&origin);
6824:   PetscQuadratureSetData(origin,depth,0,1,xi,NULL);
6825:   DMPlexComputeCellGeometryFEM(dm,refPoint,origin,v,J,NULL,&detJ);
6826:   /* CellGeometryFEM computes the expanded Jacobian, we want the true jacobian */
6827:   for (i = 1; i < dim; i++) {
6828:     for (j = 0; j < depth; j++) {
6829:       J[i * depth + j] = J[i * dim + j];
6830:     }
6831:   }
6832:   PetscQuadratureDestroy(&origin);
6833:   PetscDualSpaceGetPointSubspace(dsp,refPoint,&dsubsp);
6834:   PetscSpaceCreateSubspace(bsp,dsubsp,v,J,NULL,NULL,PETSC_OWN_POINTER,&bsubsp);
6835:   PetscSpaceSetUp(bsubsp);
6836:   PetscFECreate(PetscObjectComm((PetscObject)fe),trFE);
6837:   PetscFEGetType(fe,&type);
6838:   PetscFESetType(*trFE,type);
6839:   PetscFEGetNumComponents(fe,&numComp);
6840:   PetscFESetNumComponents(*trFE,numComp);
6841:   PetscFESetBasisSpace(*trFE,bsubsp);
6842:   PetscFESetDualSpace(*trFE,dsubsp);
6843:   PetscFEGetQuadrature(fe,&fullQuad);
6844:   PetscQuadratureGetOrder(fullQuad,&order);
6845:   DMPlexGetConeSize(dm,refPoint,&coneSize);
6846:   if (coneSize == 2 * depth) {
6847:     PetscDTGaussTensorQuadrature(depth,1,(order + 1)/2,-1.,1.,&subQuad);
6848:   } else {
6849:     PetscDTGaussJacobiQuadrature(depth,1,(order + 1)/2,-1.,1.,&subQuad);
6850:   }
6851:   PetscFESetQuadrature(*trFE,subQuad);
6852:   PetscFESetUp(*trFE);
6853:   PetscQuadratureDestroy(&subQuad);
6854:   PetscSpaceDestroy(&bsubsp);
6855:   return(0);
6856: }

6858: PetscErrorCode PetscFECreateHeightTrace(PetscFE fe, PetscInt height, PetscFE *trFE)
6859: {
6860:   PetscInt       hStart, hEnd;
6861:   PetscDualSpace dsp;
6862:   DM             dm;

6868:   *trFE = NULL;
6869:   PetscFEGetDualSpace(fe,&dsp);
6870:   PetscDualSpaceGetDM(dsp,&dm);
6871:   DMPlexGetHeightStratum(dm,height,&hStart,&hEnd);
6872:   if (hEnd <= hStart) return(0);
6873:   PetscFECreatePointTrace(fe,hStart,trFE);
6874:   return(0);
6875: }

6877: /*@C
6878:   PetscFECompositeGetMapping - Returns the mappings from the reference element to each subelement

6880:   Not collective

6882:   Input Parameter:
6883: . fem - The PetscFE object

6885:   Output Parameters:
6886: + blockSize - The number of elements in a block
6887: . numBlocks - The number of blocks in a batch
6888: . batchSize - The number of elements in a batch
6889: - numBatches - The number of batches in a chunk

6891:   Level: intermediate

6893: .seealso: PetscFECreate()
6894: @*/
6895: PetscErrorCode PetscFECompositeGetMapping(PetscFE fem, PetscInt *numSubelements, const PetscReal *v0[], const PetscReal *jac[], const PetscReal *invjac[])
6896: {
6897:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;

6905:   return(0);
6906: }

6908: /*@
6909:   PetscFEGetDimension - Get the dimension of the finite element space on a cell

6911:   Not collective

6913:   Input Parameter:
6914: . fe - The PetscFE

6916:   Output Parameter:
6917: . dim - The dimension

6919:   Level: intermediate

6921: .seealso: PetscFECreate(), PetscSpaceGetDimension(), PetscDualSpaceGetDimension()
6922: @*/
6923: PetscErrorCode PetscFEGetDimension(PetscFE fem, PetscInt *dim)
6924: {

6930:   if (fem->ops->getdimension) {(*fem->ops->getdimension)(fem, dim);}
6931:   return(0);
6932: }

6934: /*
6935: Purpose: Compute element vector for chunk of elements

6937: Input:
6938:   Sizes:
6939:      Ne:  number of elements
6940:      Nf:  number of fields
6941:      PetscFE
6942:        dim: spatial dimension
6943:        Nb:  number of basis functions
6944:        Nc:  number of field components
6945:        PetscQuadrature
6946:          Nq:  number of quadrature points

6948:   Geometry:
6949:      PetscFEGeom[Ne] possibly *Nq
6950:        PetscReal v0s[dim]
6951:        PetscReal n[dim]
6952:        PetscReal jacobians[dim*dim]
6953:        PetscReal jacobianInverses[dim*dim]
6954:        PetscReal jacobianDeterminants
6955:   FEM:
6956:      PetscFE
6957:        PetscQuadrature
6958:          PetscReal   quadPoints[Nq*dim]
6959:          PetscReal   quadWeights[Nq]
6960:        PetscReal   basis[Nq*Nb*Nc]
6961:        PetscReal   basisDer[Nq*Nb*Nc*dim]
6962:      PetscScalar coefficients[Ne*Nb*Nc]
6963:      PetscScalar elemVec[Ne*Nb*Nc]

6965:   Problem:
6966:      PetscInt f: the active field
6967:      f0, f1

6969:   Work Space:
6970:      PetscFE
6971:        PetscScalar f0[Nq*dim];
6972:        PetscScalar f1[Nq*dim*dim];
6973:        PetscScalar u[Nc];
6974:        PetscScalar gradU[Nc*dim];
6975:        PetscReal   x[dim];
6976:        PetscScalar realSpaceDer[dim];

6978: Purpose: Compute element vector for N_cb batches of elements

6980: Input:
6981:   Sizes:
6982:      N_cb: Number of serial cell batches

6984:   Geometry:
6985:      PetscReal v0s[Ne*dim]
6986:      PetscReal jacobians[Ne*dim*dim]        possibly *Nq
6987:      PetscReal jacobianInverses[Ne*dim*dim] possibly *Nq
6988:      PetscReal jacobianDeterminants[Ne]     possibly *Nq
6989:   FEM:
6990:      static PetscReal   quadPoints[Nq*dim]
6991:      static PetscReal   quadWeights[Nq]
6992:      static PetscReal   basis[Nq*Nb*Nc]
6993:      static PetscReal   basisDer[Nq*Nb*Nc*dim]
6994:      PetscScalar coefficients[Ne*Nb*Nc]
6995:      PetscScalar elemVec[Ne*Nb*Nc]

6997: ex62.c:
6998:   PetscErrorCode PetscFEIntegrateResidualBatch(PetscInt Ne, PetscInt numFields, PetscInt field, PetscQuadrature quad[], const PetscScalar coefficients[],
6999:                                                const PetscReal v0s[], const PetscReal jacobians[], const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[],
7000:                                                void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f0[]),
7001:                                                void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f1[]), PetscScalar elemVec[])

7003: ex52.c:
7004:   PetscErrorCode IntegrateLaplacianBatchCPU(PetscInt Ne, PetscInt Nb, const PetscScalar coefficients[], const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscInt Nq, const PetscReal quadPoints[], const PetscReal quadWeights[], const PetscReal basisTabulation[], const PetscReal basisDerTabulation[], PetscScalar elemVec[], AppCtx *user)
7005:   PetscErrorCode IntegrateElasticityBatchCPU(PetscInt Ne, PetscInt Nb, PetscInt Ncomp, const PetscScalar coefficients[], const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscInt Nq, const PetscReal quadPoints[], const PetscReal quadWeights[], const PetscReal basisTabulation[], const PetscReal basisDerTabulation[], PetscScalar elemVec[], AppCtx *user)

7007: ex52_integrateElement.cu
7008: __global__ void integrateElementQuadrature(int N_cb, realType *coefficients, realType *jacobianInverses, realType *jacobianDeterminants, realType *elemVec)

7010: PETSC_EXTERN PetscErrorCode IntegrateElementBatchGPU(PetscInt spatial_dim, PetscInt Ne, PetscInt Ncb, PetscInt Nbc, PetscInt Nbl, const PetscScalar coefficients[],
7011:                                                      const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscScalar elemVec[],
7012:                                                      PetscLogEvent event, PetscInt debug, PetscInt pde_op)

7014: ex52_integrateElementOpenCL.c:
7015: PETSC_EXTERN PetscErrorCode IntegrateElementBatchGPU(PetscInt spatial_dim, PetscInt Ne, PetscInt Ncb, PetscInt Nbc, PetscInt N_bl, const PetscScalar coefficients[],
7016:                                                      const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscScalar elemVec[],
7017:                                                      PetscLogEvent event, PetscInt debug, PetscInt pde_op)

7019: __kernel void integrateElementQuadrature(int N_cb, __global float *coefficients, __global float *jacobianInverses, __global float *jacobianDeterminants, __global float *elemVec)
7020: */

7022: /*@C
7023:   PetscFEIntegrate - Produce the integral for the given field for a chunk of elements by quadrature integration

7025:   Not collective

7027:   Input Parameters:
7028: + fem          - The PetscFE object for the field being integrated
7029: . prob         - The PetscDS specifying the discretizations and continuum functions
7030: . field        - The field being integrated
7031: . Ne           - The number of elements in the chunk
7032: . cgeom        - The cell geometry for each cell in the chunk
7033: . coefficients - The array of FEM basis coefficients for the elements
7034: . probAux      - The PetscDS specifying the auxiliary discretizations
7035: - coefficientsAux - The array of FEM auxiliary basis coefficients for the elements

7037:   Output Parameter
7038: . integral     - the integral for this field

7040:   Level: developer

7042: .seealso: PetscFEIntegrateResidual()
7043: @*/
7044: PetscErrorCode PetscFEIntegrate(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *cgeom,
7045:                                 const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscScalar integral[])
7046: {

7052:   if (fem->ops->integrate) {(*fem->ops->integrate)(fem, prob, field, Ne, cgeom, coefficients, probAux, coefficientsAux, integral);}
7053:   return(0);
7054: }

7056: /*@C
7057:   PetscFEIntegrateResidual - Produce the element residual vector for a chunk of elements by quadrature integration

7059:   Not collective

7061:   Input Parameters:
7062: + fem          - The PetscFE object for the field being integrated
7063: . prob         - The PetscDS specifying the discretizations and continuum functions
7064: . field        - The field being integrated
7065: . Ne           - The number of elements in the chunk
7066: . cgeom        - The cell geometry for each cell in the chunk
7067: . coefficients - The array of FEM basis coefficients for the elements
7068: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
7069: . probAux      - The PetscDS specifying the auxiliary discretizations
7070: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
7071: - t            - The time

7073:   Output Parameter
7074: . elemVec      - the element residual vectors from each element

7076:   Note:
7077: $ Loop over batch of elements (e):
7078: $   Loop over quadrature points (q):
7079: $     Make u_q and gradU_q (loops over fields,Nb,Ncomp) and x_q
7080: $     Call f_0 and f_1
7081: $   Loop over element vector entries (f,fc --> i):
7082: $     elemVec[i] += \psi^{fc}_f(q) f0_{fc}(u, \nabla u) + \nabla\psi^{fc}_f(q) \cdot f1_{fc,df}(u, \nabla u)

7084:   Level: developer

7086: .seealso: PetscFEIntegrateResidual()
7087: @*/
7088: PetscErrorCode PetscFEIntegrateResidual(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *cgeom,
7089:                                         const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
7090: {

7096:   if (fem->ops->integrateresidual) {(*fem->ops->integrateresidual)(fem, prob, field, Ne, cgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);}
7097:   return(0);
7098: }

7100: /*@C
7101:   PetscFEIntegrateBdResidual - Produce the element residual vector for a chunk of elements by quadrature integration over a boundary

7103:   Not collective

7105:   Input Parameters:
7106: + fem          - The PetscFE object for the field being integrated
7107: . prob         - The PetscDS specifying the discretizations and continuum functions
7108: . field        - The field being integrated
7109: . Ne           - The number of elements in the chunk
7110: . fgeom        - The face geometry for each cell in the chunk
7111: . coefficients - The array of FEM basis coefficients for the elements
7112: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
7113: . probAux      - The PetscDS specifying the auxiliary discretizations
7114: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
7115: - t            - The time

7117:   Output Parameter
7118: . elemVec      - the element residual vectors from each element

7120:   Level: developer

7122: .seealso: PetscFEIntegrateResidual()
7123: @*/
7124: PetscErrorCode PetscFEIntegrateBdResidual(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEGeom *fgeom,
7125:                                           const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
7126: {

7131:   if (fem->ops->integratebdresidual) {(*fem->ops->integratebdresidual)(fem, prob, field, Ne, fgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);}
7132:   return(0);
7133: }

7135: /*@C
7136:   PetscFEIntegrateJacobian - Produce the element Jacobian for a chunk of elements by quadrature integration

7138:   Not collective

7140:   Input Parameters:
7141: + fem          - The PetscFE object for the field being integrated
7142: . prob         - The PetscDS specifying the discretizations and continuum functions
7143: . jtype        - The type of matrix pointwise functions that should be used
7144: . fieldI       - The test field being integrated
7145: . fieldJ       - The basis field being integrated
7146: . Ne           - The number of elements in the chunk
7147: . cgeom        - The cell geometry for each cell in the chunk
7148: . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
7149: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
7150: . probAux      - The PetscDS specifying the auxiliary discretizations
7151: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
7152: . t            - The time
7153: - u_tShift     - A multiplier for the dF/du_t term (as opposed to the dF/du term)

7155:   Output Parameter
7156: . elemMat      - the element matrices for the Jacobian from each element

7158:   Note:
7159: $ Loop over batch of elements (e):
7160: $   Loop over element matrix entries (f,fc,g,gc --> i,j):
7161: $     Loop over quadrature points (q):
7162: $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
7163: $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
7164: $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
7165: $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
7166: $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
7167:   Level: developer

7169: .seealso: PetscFEIntegrateResidual()
7170: @*/
7171: PetscErrorCode PetscFEIntegrateJacobian(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEGeom *cgeom,
7172:                                         const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
7173: {

7178:   if (fem->ops->integratejacobian) {(*fem->ops->integratejacobian)(fem, prob, jtype, fieldI, fieldJ, Ne, cgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, u_tshift, elemMat);}
7179:   return(0);
7180: }

7182: /*@C
7183:   PetscFEIntegrateBdJacobian - Produce the boundary element Jacobian for a chunk of elements by quadrature integration

7185:   Not collective

7187:   Input Parameters:
7188: + fem          = The PetscFE object for the field being integrated
7189: . prob         - The PetscDS specifying the discretizations and continuum functions
7190: . fieldI       - The test field being integrated
7191: . fieldJ       - The basis field being integrated
7192: . Ne           - The number of elements in the chunk
7193: . fgeom        - The face geometry for each cell in the chunk
7194: . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
7195: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
7196: . probAux      - The PetscDS specifying the auxiliary discretizations
7197: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
7198: . t            - The time
7199: - u_tShift     - A multiplier for the dF/du_t term (as opposed to the dF/du term)

7201:   Output Parameter
7202: . elemMat              - the element matrices for the Jacobian from each element

7204:   Note:
7205: $ Loop over batch of elements (e):
7206: $   Loop over element matrix entries (f,fc,g,gc --> i,j):
7207: $     Loop over quadrature points (q):
7208: $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
7209: $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
7210: $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
7211: $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
7212: $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
7213:   Level: developer

7215: .seealso: PetscFEIntegrateJacobian(), PetscFEIntegrateResidual()
7216: @*/
7217: PetscErrorCode PetscFEIntegrateBdJacobian(PetscFE fem, PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEGeom *fgeom,
7218:                                           const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
7219: {

7224:   if (fem->ops->integratebdjacobian) {(*fem->ops->integratebdjacobian)(fem, prob, fieldI, fieldJ, Ne, fgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, u_tshift, elemMat);}
7225:   return(0);
7226: }

7228: PetscErrorCode PetscFEGetHeightSubspace(PetscFE fe, PetscInt height, PetscFE *subfe)
7229: {
7230:   PetscSpace      P, subP;
7231:   PetscDualSpace  Q, subQ;
7232:   PetscQuadrature subq;
7233:   PetscFEType     fetype;
7234:   PetscInt        dim, Nc;
7235:   PetscErrorCode  ierr;

7240:   if (height == 0) {
7241:     *subfe = fe;
7242:     return(0);
7243:   }
7244:   PetscFEGetBasisSpace(fe, &P);
7245:   PetscFEGetDualSpace(fe, &Q);
7246:   PetscFEGetNumComponents(fe, &Nc);
7247:   PetscFEGetFaceQuadrature(fe, &subq);
7248:   PetscDualSpaceGetDimension(Q, &dim);
7249:   if (height > dim || height < 0) {SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Asked for space at height %D for dimension %D space", height, dim);}
7250:   if (!fe->subspaces) {PetscCalloc1(dim, &fe->subspaces);}
7251:   if (height <= dim) {
7252:     if (!fe->subspaces[height-1]) {
7253:       PetscFE sub;

7255:       PetscSpaceGetHeightSubspace(P, height, &subP);
7256:       PetscDualSpaceGetHeightSubspace(Q, height, &subQ);
7257:       PetscFECreate(PetscObjectComm((PetscObject) fe), &sub);
7258:       PetscFEGetType(fe, &fetype);
7259:       PetscFESetType(sub, fetype);
7260:       PetscFESetBasisSpace(sub, subP);
7261:       PetscFESetDualSpace(sub, subQ);
7262:       PetscFESetNumComponents(sub, Nc);
7263:       PetscFESetUp(sub);
7264:       PetscFESetQuadrature(sub, subq);
7265:       fe->subspaces[height-1] = sub;
7266:     }
7267:     *subfe = fe->subspaces[height-1];
7268:   } else {
7269:     *subfe = NULL;
7270:   }
7271:   return(0);
7272: }

7274: /*@
7275:   PetscFERefine - Create a "refined" PetscFE object that refines the reference cell into smaller copies. This is typically used
7276:   to precondition a higher order method with a lower order method on a refined mesh having the same number of dofs (but more
7277:   sparsity). It is also used to create an interpolation between regularly refined meshes.

7279:   Collective on PetscFE

7281:   Input Parameter:
7282: . fe - The initial PetscFE

7284:   Output Parameter:
7285: . feRef - The refined PetscFE

7287:   Level: developer

7289: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
7290: @*/
7291: PetscErrorCode PetscFERefine(PetscFE fe, PetscFE *feRef)
7292: {
7293:   PetscSpace       P, Pref;
7294:   PetscDualSpace   Q, Qref;
7295:   DM               K, Kref;
7296:   PetscQuadrature  q, qref;
7297:   const PetscReal *v0, *jac;
7298:   PetscInt         numComp, numSubelements;
7299:   PetscErrorCode   ierr;

7302:   PetscFEGetBasisSpace(fe, &P);
7303:   PetscFEGetDualSpace(fe, &Q);
7304:   PetscFEGetQuadrature(fe, &q);
7305:   PetscDualSpaceGetDM(Q, &K);
7306:   /* Create space */
7307:   PetscObjectReference((PetscObject) P);
7308:   Pref = P;
7309:   /* Create dual space */
7310:   PetscDualSpaceDuplicate(Q, &Qref);
7311:   DMRefine(K, PetscObjectComm((PetscObject) fe), &Kref);
7312:   PetscDualSpaceSetDM(Qref, Kref);
7313:   DMDestroy(&Kref);
7314:   PetscDualSpaceSetUp(Qref);
7315:   /* Create element */
7316:   PetscFECreate(PetscObjectComm((PetscObject) fe), feRef);
7317:   PetscFESetType(*feRef, PETSCFECOMPOSITE);
7318:   PetscFESetBasisSpace(*feRef, Pref);
7319:   PetscFESetDualSpace(*feRef, Qref);
7320:   PetscFEGetNumComponents(fe,    &numComp);
7321:   PetscFESetNumComponents(*feRef, numComp);
7322:   PetscFESetUp(*feRef);
7323:   PetscSpaceDestroy(&Pref);
7324:   PetscDualSpaceDestroy(&Qref);
7325:   /* Create quadrature */
7326:   PetscFECompositeGetMapping(*feRef, &numSubelements, &v0, &jac, NULL);
7327:   PetscQuadratureExpandComposite(q, numSubelements, v0, jac, &qref);
7328:   PetscFESetQuadrature(*feRef, qref);
7329:   PetscQuadratureDestroy(&qref);
7330:   return(0);
7331: }

7333: /*@C
7334:   PetscFECreateDefault - Create a PetscFE for basic FEM computation

7336:   Collective on DM

7338:   Input Parameters:
7339: + comm      - The MPI comm
7340: . dim       - The spatial dimension
7341: . Nc        - The number of components
7342: . isSimplex - Flag for simplex reference cell, otherwise its a tensor product
7343: . prefix    - The options prefix, or NULL
7344: - qorder    - The quadrature order

7346:   Output Parameter:
7347: . fem - The PetscFE object

7349:   Level: beginner

7351: .keywords: PetscFE, finite element
7352: .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate()
7353: @*/
7354: PetscErrorCode PetscFECreateDefault(MPI_Comm comm, PetscInt dim, PetscInt Nc, PetscBool isSimplex, const char prefix[], PetscInt qorder, PetscFE *fem)
7355: {
7356:   PetscQuadrature q, fq;
7357:   DM              K;
7358:   PetscSpace      P;
7359:   PetscDualSpace  Q;
7360:   PetscInt        order, quadPointsPerEdge;
7361:   PetscBool       tensor = isSimplex ? PETSC_FALSE : PETSC_TRUE;
7362:   PetscErrorCode  ierr;

7365:   /* Create space */
7366:   PetscSpaceCreate(comm, &P);
7367:   PetscObjectSetOptionsPrefix((PetscObject) P, prefix);
7368:   PetscSpacePolynomialSetTensor(P, tensor);
7369:   PetscSpaceSetFromOptions(P);
7370:   PetscSpaceSetNumComponents(P, Nc);
7371:   PetscSpaceSetNumVariables(P, dim);
7372:   PetscSpaceSetUp(P);
7373:   PetscSpaceGetOrder(P, &order);
7374:   PetscSpacePolynomialGetTensor(P, &tensor);
7375:   /* Create dual space */
7376:   PetscDualSpaceCreate(comm, &Q);
7377:   PetscDualSpaceSetType(Q,PETSCDUALSPACELAGRANGE);
7378:   PetscObjectSetOptionsPrefix((PetscObject) Q, prefix);
7379:   PetscDualSpaceCreateReferenceCell(Q, dim, isSimplex, &K);
7380:   PetscDualSpaceSetDM(Q, K);
7381:   DMDestroy(&K);
7382:   PetscDualSpaceSetNumComponents(Q, Nc);
7383:   PetscDualSpaceSetOrder(Q, order);
7384:   PetscDualSpaceLagrangeSetTensor(Q, tensor);
7385:   PetscDualSpaceSetFromOptions(Q);
7386:   PetscDualSpaceSetUp(Q);
7387:   /* Create element */
7388:   PetscFECreate(comm, fem);
7389:   PetscObjectSetOptionsPrefix((PetscObject) *fem, prefix);
7390:   PetscFESetFromOptions(*fem);
7391:   PetscFESetBasisSpace(*fem, P);
7392:   PetscFESetDualSpace(*fem, Q);
7393:   PetscFESetNumComponents(*fem, Nc);
7394:   PetscFESetUp(*fem);
7395:   PetscSpaceDestroy(&P);
7396:   PetscDualSpaceDestroy(&Q);
7397:   /* Create quadrature (with specified order if given) */
7398:   qorder = qorder >= 0 ? qorder : order;
7399:   PetscObjectOptionsBegin((PetscObject)*fem);
7400:   PetscOptionsInt("-petscfe_default_quadrature_order","Quadrature order is one less than quadture points per edge","PetscFECreateDefault",qorder,&qorder,NULL);
7401:   PetscOptionsEnd();
7402:   quadPointsPerEdge = PetscMax(qorder + 1,1);
7403:   if (isSimplex) {
7404:     PetscDTGaussJacobiQuadrature(dim,   1, quadPointsPerEdge, -1.0, 1.0, &q);
7405:     PetscDTGaussJacobiQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);
7406:   }
7407:   else {
7408:     PetscDTGaussTensorQuadrature(dim,   1, quadPointsPerEdge, -1.0, 1.0, &q);
7409:     PetscDTGaussTensorQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);
7410:   }
7411:   PetscFESetQuadrature(*fem, q);
7412:   PetscFESetFaceQuadrature(*fem, fq);
7413:   PetscQuadratureDestroy(&q);
7414:   PetscQuadratureDestroy(&fq);
7415:   return(0);
7416: }

7418: PetscErrorCode PetscFEGeomCreate(PetscQuadrature quad, PetscInt numCells, PetscInt dimEmbed, PetscBool faceData, PetscFEGeom **geom)
7419: {
7420:   PetscFEGeom     *g;
7421:   PetscInt        dim, numPoints, N;
7422:   const PetscReal *p;
7423:   PetscErrorCode  ierr;

7426:   PetscQuadratureGetData(quad,&dim,NULL,&numPoints,&p,NULL);
7427:   PetscNew(&g);
7428:   g->xi        = p;
7429:   g->numCells  = numCells;
7430:   g->numPoints = numPoints;
7431:   g->dim       = dim;
7432:   g->dimEmbed  = dimEmbed;
7433:   N = numCells * numPoints;
7434:   PetscCalloc3(N * dimEmbed, &g->v, N * dimEmbed * dimEmbed, &g->J, N, &g->detJ);
7435:   if (faceData) {
7436:     PetscCalloc4(numCells, &g->face, N * dimEmbed, &g->n, N * dimEmbed * dimEmbed, &(g->suppInvJ[0]), N * dimEmbed * dimEmbed, &(g->suppInvJ[1]));
7437:   } else {
7438:     PetscCalloc1(N * dimEmbed * dimEmbed, &g->invJ);
7439:   }
7440:   *geom = g;
7441:   return(0);
7442: }

7444: PetscErrorCode PetscFEGeomDestroy(PetscFEGeom **geom)
7445: {

7449:   if (!*geom) return(0);
7450:   PetscFree3((*geom)->v,(*geom)->J,(*geom)->detJ);
7451:   PetscFree((*geom)->invJ);
7452:   PetscFree4((*geom)->face,(*geom)->n,(*geom)->suppInvJ[0],(*geom)->suppInvJ[1]);
7453:   PetscFree(*geom);
7454:   return(0);
7455: }

7457: PetscErrorCode PetscFEGeomGetChunk(PetscFEGeom *geom, PetscInt cStart, PetscInt cEnd, PetscFEGeom **chunkGeom)
7458: {
7459:   PetscInt       Nq;
7460:   PetscInt       dE;

7466:   if (!(*chunkGeom)) {
7467:     PetscNew(chunkGeom);
7468:   }
7469:   Nq = geom->numPoints;
7470:   dE= geom->dimEmbed;
7471:   (*chunkGeom)->dim = geom->dim;
7472:   (*chunkGeom)->dimEmbed = geom->dimEmbed;
7473:   (*chunkGeom)->numPoints = geom->numPoints;
7474:   (*chunkGeom)->numCells = cEnd - cStart;
7475:   (*chunkGeom)->xi = geom->xi;
7476:   (*chunkGeom)->v = &geom->v[Nq*dE*cStart];
7477:   (*chunkGeom)->J = &geom->J[Nq*dE*dE*cStart];
7478:   (*chunkGeom)->invJ = (geom->invJ) ? &geom->invJ[Nq*dE*dE*cStart] : NULL;
7479:   (*chunkGeom)->detJ = &geom->detJ[Nq*cStart];
7480:   (*chunkGeom)->n = geom->n ? &geom->n[Nq*dE*cStart] : NULL;
7481:   (*chunkGeom)->face = geom->face ? &geom->face[cStart] : NULL;
7482:   (*chunkGeom)->suppInvJ[0] = geom->suppInvJ[0] ? &geom->suppInvJ[0][Nq*dE*dE*cStart] : NULL;
7483:   (*chunkGeom)->suppInvJ[1] = geom->suppInvJ[1] ? &geom->suppInvJ[1][Nq*dE*dE*cStart] : NULL;
7484:   (*chunkGeom)->isAffine = geom->isAffine;
7485:   return(0);
7486: }

7488: PetscErrorCode PetscFEGeomRestoreChunk(PetscFEGeom *geom, PetscInt cStart, PetscInt cEnd, PetscFEGeom **chunkGeom)
7489: {

7493:   PetscFree(*chunkGeom);
7494:   return(0);
7495: }

7497: PetscErrorCode PetscFEGeomComplete(PetscFEGeom *geom)
7498: {
7499:   PetscInt i, j, N, dE;

7502:   N = geom->numPoints * geom->numCells;
7503:   dE = geom->dimEmbed;
7504:   switch (dE) {
7505:   case 3:
7506:     for (i = 0; i < N; i++) {
7507:       DMPlex_Det3D_Internal(&geom->detJ[i], &geom->J[dE*dE*i]);
7508:       if (geom->invJ) DMPlex_Invert3D_Internal(&geom->invJ[dE*dE*i], &geom->J[dE*dE*i], geom->detJ[i]);
7509:     }
7510:     break;
7511:   case 2:
7512:     for (i = 0; i < N; i++) {
7513:       DMPlex_Det2D_Internal(&geom->detJ[i], &geom->J[dE*dE*i]);
7514:       if (geom->invJ) DMPlex_Invert2D_Internal(&geom->invJ[dE*dE*i], &geom->J[dE*dE*i], geom->detJ[i]);
7515:     }
7516:     break;
7517:   case 1:
7518:     for (i = 0; i < N; i++) {
7519:       geom->detJ[i] = PetscAbsReal(geom->J[i]);
7520:       if (geom->invJ) geom->invJ[i] = 1. / geom->J[i];
7521:     }
7522:     break;
7523:   }
7524:   if (geom->n) {
7525:     for (i = 0; i < N; i++) {
7526:       for (j = 0; j < dE; j++) {
7527:         geom->n[dE*i + j] = geom->J[dE*dE*i + dE*j + dE-1] * ((dE == 2) ? -1. : 1.);
7528:       }
7529:     }
7530:   }
7531:   return(0);
7532: }