Actual source code: dtfe.c

petsc-master 2017-06-23
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: {

192:   if (!v) {PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) sp), &v);}
193:   if (sp->ops->view) {(*sp->ops->view)(sp, v);}
194:   return(0);
195: }

197: /*@
198:   PetscSpaceSetFromOptions - sets parameters in a PetscSpace from the options database

200:   Collective on PetscSpace

202:   Input Parameter:
203: . sp - the PetscSpace object to set options for

205:   Options Database:
206: . -petscspace_order the approximation order of the space

208:   Level: developer

210: .seealso PetscSpaceView()
211: @*/
212: PetscErrorCode PetscSpaceSetFromOptions(PetscSpace sp)
213: {
214:   const char    *defaultType;
215:   char           name[256];
216:   PetscBool      flg;

221:   if (!((PetscObject) sp)->type_name) {
222:     defaultType = PETSCSPACEPOLYNOMIAL;
223:   } else {
224:     defaultType = ((PetscObject) sp)->type_name;
225:   }
226:   if (!PetscSpaceRegisterAllCalled) {PetscSpaceRegisterAll();}

228:   PetscObjectOptionsBegin((PetscObject) sp);
229:   PetscOptionsFList("-petscspace_type", "Linear space", "PetscSpaceSetType", PetscSpaceList, defaultType, name, 256, &flg);
230:   if (flg) {
231:     PetscSpaceSetType(sp, name);
232:   } else if (!((PetscObject) sp)->type_name) {
233:     PetscSpaceSetType(sp, defaultType);
234:   }
235:   PetscOptionsInt("-petscspace_order", "The approximation order", "PetscSpaceSetOrder", sp->order, &sp->order, NULL);
236:   PetscOptionsInt("-petscspace_components", "The number of components", "PetscSpaceSetNumComponents", sp->Nc, &sp->Nc, NULL);
237:   if (sp->ops->setfromoptions) {
238:     (*sp->ops->setfromoptions)(PetscOptionsObject,sp);
239:   }
240:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
241:   PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) sp);
242:   PetscOptionsEnd();
243:   PetscSpaceViewFromOptions(sp, NULL, "-petscspace_view");
244:   return(0);
245: }

247: /*@C
248:   PetscSpaceSetUp - Construct data structures for the PetscSpace

250:   Collective on PetscSpace

252:   Input Parameter:
253: . sp - the PetscSpace object to setup

255:   Level: developer

257: .seealso PetscSpaceView(), PetscSpaceDestroy()
258: @*/
259: PetscErrorCode PetscSpaceSetUp(PetscSpace sp)
260: {

265:   if (sp->ops->setup) {(*sp->ops->setup)(sp);}
266:   return(0);
267: }

269: /*@
270:   PetscSpaceDestroy - Destroys a PetscSpace object

272:   Collective on PetscSpace

274:   Input Parameter:
275: . sp - the PetscSpace object to destroy

277:   Level: developer

279: .seealso PetscSpaceView()
280: @*/
281: PetscErrorCode PetscSpaceDestroy(PetscSpace *sp)
282: {

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

289:   if (--((PetscObject)(*sp))->refct > 0) {*sp = 0; return(0);}
290:   ((PetscObject) (*sp))->refct = 0;
291:   DMDestroy(&(*sp)->dm);

293:   (*(*sp)->ops->destroy)(*sp);
294:   PetscHeaderDestroy(sp);
295:   return(0);
296: }

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

301:   Collective on MPI_Comm

303:   Input Parameter:
304: . comm - The communicator for the PetscSpace object

306:   Output Parameter:
307: . sp - The PetscSpace object

309:   Level: beginner

311: .seealso: PetscSpaceSetType(), PETSCSPACEPOLYNOMIAL
312: @*/
313: PetscErrorCode PetscSpaceCreate(MPI_Comm comm, PetscSpace *sp)
314: {
315:   PetscSpace     s;

320:   PetscCitationsRegister(FECitation,&FEcite);
321:   *sp  = NULL;
322:   PetscFEInitializePackage();

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

326:   s->order = 0;
327:   s->Nc    = 1;
328:   DMShellCreate(comm, &s->dm);

330:   *sp = s;
331:   return(0);
332: }

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

337:   Input Parameter:
338: . sp - The PetscSpace

340:   Output Parameter:
341: . dim - The dimension

343:   Level: intermediate

345: .seealso: PetscSpaceGetOrder(), PetscSpaceCreate(), PetscSpace
346: @*/
347: PetscErrorCode PetscSpaceGetDimension(PetscSpace sp, PetscInt *dim)
348: {

354:   *dim = 0;
355:   if (sp->ops->getdimension) {(*sp->ops->getdimension)(sp, dim);}
356:   return(0);
357: }

359: /*@
360:   PetscSpaceGetOrder - Return the order of approximation for this space

362:   Input Parameter:
363: . sp - The PetscSpace

365:   Output Parameter:
366: . order - The approximation order

368:   Level: intermediate

370: .seealso: PetscSpaceSetOrder(), PetscSpaceGetDimension(), PetscSpaceCreate(), PetscSpace
371: @*/
372: PetscErrorCode PetscSpaceGetOrder(PetscSpace sp, PetscInt *order)
373: {
377:   *order = sp->order;
378:   return(0);
379: }

381: /*@
382:   PetscSpaceSetOrder - Set the order of approximation for this space

384:   Input Parameters:
385: + sp - The PetscSpace
386: - order - The approximation order

388:   Level: intermediate

390: .seealso: PetscSpaceGetOrder(), PetscSpaceCreate(), PetscSpace
391: @*/
392: PetscErrorCode PetscSpaceSetOrder(PetscSpace sp, PetscInt order)
393: {
396:   sp->order = order;
397:   return(0);
398: }

400: /*@
401:   PetscSpaceGetNumComponents - Return the number of components for this space

403:   Input Parameter:
404: . sp - The PetscSpace

406:   Output Parameter:
407: . Nc - The number of components

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

411:   Level: intermediate

413: .seealso: PetscSpaceSetNumComponents(), PetscSpaceGetDimension(), PetscSpaceCreate(), PetscSpace
414: @*/
415: PetscErrorCode PetscSpaceGetNumComponents(PetscSpace sp, PetscInt *Nc)
416: {
420:   *Nc = sp->Nc;
421:   return(0);
422: }

424: /*@
425:   PetscSpaceSetNumComponents - Set the number of components for this space

427:   Input Parameters:
428: + sp - The PetscSpace
429: - order - The number of components

431:   Level: intermediate

433: .seealso: PetscSpaceGetNumComponents(), PetscSpaceCreate(), PetscSpace
434: @*/
435: PetscErrorCode PetscSpaceSetNumComponents(PetscSpace sp, PetscInt Nc)
436: {
439:   sp->Nc = Nc;
440:   return(0);
441: }

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

446:   Input Parameters:
447: + sp      - The PetscSpace
448: . npoints - The number of evaluation points, in reference coordinates
449: - points  - The point coordinates

451:   Output Parameters:
452: + B - The function evaluations in a npoints x nfuncs array
453: . D - The derivative evaluations in a npoints x nfuncs x dim array
454: - H - The second derivative evaluations in a npoints x nfuncs x dim x dim array

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

459:   Level: advanced

461: .seealso: PetscFEGetTabulation(), PetscFEGetDefaultTabulation(), PetscSpaceCreate()
462: @*/
463: PetscErrorCode PetscSpaceEvaluate(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
464: {

468:   if (!npoints) return(0);
474:   if (sp->ops->evaluate) {(*sp->ops->evaluate)(sp, npoints, points, B, D, H);}
475:   return(0);
476: }

478: PetscErrorCode PetscSpaceSetFromOptions_Polynomial(PetscOptionItems *PetscOptionsObject,PetscSpace sp)
479: {
480:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
481:   PetscErrorCode   ierr;

484:   PetscOptionsHead(PetscOptionsObject,"PetscSpace polynomial options");
485:   PetscOptionsInt("-petscspace_poly_num_variables", "The number of different variables, e.g. x and y", "PetscSpacePolynomialSetNumVariables", poly->numVariables, &poly->numVariables, NULL);
486:   PetscOptionsBool("-petscspace_poly_sym", "Use only symmetric polynomials", "PetscSpacePolynomialSetSymmetric", poly->symmetric, &poly->symmetric, NULL);
487:   PetscOptionsBool("-petscspace_poly_tensor", "Use the tensor product polynomials", "PetscSpacePolynomialSetTensor", poly->tensor, &poly->tensor, NULL);
488:   PetscOptionsTail();
489:   return(0);
490: }

492: static PetscErrorCode PetscSpacePolynomialView_Ascii(PetscSpace sp, PetscViewer viewer)
493: {
494:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
495:   PetscErrorCode   ierr;

498:   if (sp->Nc > 1) {
499:     if (poly->tensor) {PetscViewerASCIIPrintf(viewer, "Tensor polynomial space in %D variables of degree %D with %D components\n", poly->numVariables, sp->order, sp->Nc);}
500:     else              {PetscViewerASCIIPrintf(viewer, "Polynomial space in %D variables of degree %D with %D components\n", poly->numVariables, sp->order, sp->Nc);}
501:   } else {
502:     if (poly->tensor) {PetscViewerASCIIPrintf(viewer, "Tensor polynomial space in %d variables of degree %d\n", poly->numVariables, sp->order);}
503:     else              {PetscViewerASCIIPrintf(viewer, "Polynomial space in %d variables of degree %d\n", poly->numVariables, sp->order);}
504:   }
505:   return(0);
506: }

508: PetscErrorCode PetscSpaceView_Polynomial(PetscSpace sp, PetscViewer viewer)
509: {
510:   PetscBool      iascii;

516:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
517:   if (iascii) {PetscSpacePolynomialView_Ascii(sp, viewer);}
518:   return(0);
519: }

521: PetscErrorCode PetscSpaceSetUp_Polynomial(PetscSpace sp)
522: {
523:   PetscSpace_Poly *poly    = (PetscSpace_Poly *) sp->data;
524:   PetscInt         ndegree = sp->order+1;
525:   PetscInt         deg;
526:   PetscErrorCode   ierr;

529:   PetscMalloc1(ndegree, &poly->degrees);
530:   for (deg = 0; deg < ndegree; ++deg) poly->degrees[deg] = deg;
531:   return(0);
532: }

534: PetscErrorCode PetscSpaceDestroy_Polynomial(PetscSpace sp)
535: {
536:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
537:   PetscErrorCode   ierr;

540:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", NULL);
541:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialSetTensor_C", NULL);
542:   PetscFree(poly->degrees);
543:   PetscFree(poly);
544:   return(0);
545: }

547: /* We treat the space as a tensor product of scalar polynomial spaces, so the dimension is multiplied by Nc */
548: PetscErrorCode PetscSpaceGetDimension_Polynomial(PetscSpace sp, PetscInt *dim)
549: {
550:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
551:   PetscInt         deg  = sp->order;
552:   PetscInt         n    = poly->numVariables, i;
553:   PetscReal        D    = 1.0;

556:   if (poly->tensor) {
557:     *dim = 1;
558:     for (i = 0; i < n; ++i) *dim *= (deg+1);
559:   } else {
560:     for (i = 1; i <= n; ++i) {
561:       D *= ((PetscReal) (deg+i))/i;
562:     }
563:     *dim = (PetscInt) (D + 0.5);
564:   }
565:   *dim *= sp->Nc;
566:   return(0);
567: }

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

572:   Input Parameters:
573: + len - The length of the tuple
574: . sum - The sum of all entries in the tuple
575: - ind - The current multi-index of the tuple, initialized to the 0 tuple

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

581:   Level: developer

583: .seealso:
584: */
585: static PetscErrorCode LatticePoint_Internal(PetscInt len, PetscInt sum, PetscInt ind[], PetscInt tup[])
586: {
587:   PetscInt       i;

591:   if (len == 1) {
592:     ind[0] = -1;
593:     tup[0] = sum;
594:   } else if (sum == 0) {
595:     for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
596:   } else {
597:     tup[0] = sum - ind[0];
598:     LatticePoint_Internal(len-1, ind[0], &ind[1], &tup[1]);
599:     if (ind[1] < 0) {
600:       if (ind[0] == sum) {ind[0] = -1;}
601:       else               {ind[1] = 0; ++ind[0];}
602:     }
603:   }
604:   return(0);
605: }

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

612:   Input Parameters:
613: + len - The length of the tuple
614: . max - The maximum sum
615: - tup - A tuple of length len+1: tup[len] > 0 indicates a stopping condition

617:   Output Parameter:
618: . tup - A tuple of len integers whos sum is at most 'max'
619: */
620: static PetscErrorCode LatticePointLexicographic_Internal(PetscInt len, PetscInt max, PetscInt tup[])
621: {
623:   while (len--) {
624:     max -= tup[len];
625:     if (!max) {
626:       tup[len] = 0;
627:       break;
628:     }
629:   }
630:   tup[++len]++;
631:   return(0);
632: }

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

637:   Input Parameters:
638: + len - The length of the tuple
639: . max - The max for all entries in the tuple
640: - ind - The current multi-index of the tuple, initialized to the 0 tuple

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

646:   Level: developer

648: .seealso:
649: */
650: static PetscErrorCode TensorPoint_Internal(PetscInt len, PetscInt max, PetscInt ind[], PetscInt tup[])
651: {
652:   PetscInt       i;

656:   if (len == 1) {
657:     tup[0] = ind[0]++;
658:     ind[0] = ind[0] >= max ? -1 : ind[0];
659:   } else if (max == 0) {
660:     for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
661:   } else {
662:     tup[0] = ind[0];
663:     TensorPoint_Internal(len-1, max, &ind[1], &tup[1]);
664:     if (ind[1] < 0) {
665:       ind[1] = 0;
666:       if (ind[0] == max-1) {ind[0] = -1;}
667:       else                 {++ind[0];}
668:     }
669:   }
670:   return(0);
671: }

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

678:   Input Parameters:
679: + len - The length of the tuple
680: . max - The maximum value
681: - tup - A tuple of length len+1: tup[len] > 0 indicates a stopping condition

683:   Output Parameter:
684: . tup - A tuple of len integers whos sum is at most 'max'
685: */
686: static PetscErrorCode TensorPointLexicographic_Internal(PetscInt len, PetscInt max, PetscInt tup[])
687: {
688:   PetscInt       i;

691:   for (i = 0; i < len; i++) {
692:     if (tup[i] < max) {
693:       break;
694:     } else {
695:       tup[i] = 0;
696:     }
697:   }
698:   tup[i]++;
699:   return(0);
700: }

702: /*
703:   p in [0, npoints), i in [0, pdim), c in [0, Nc)

705:   B[p][i][c] = B[p][i_scalar][c][c]
706: */
707: PetscErrorCode PetscSpaceEvaluate_Polynomial(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
708: {
709:   PetscSpace_Poly *poly    = (PetscSpace_Poly *) sp->data;
710:   DM               dm      = sp->dm;
711:   PetscInt         Nc      = sp->Nc;
712:   PetscInt         ndegree = sp->order+1;
713:   PetscInt        *degrees = poly->degrees;
714:   PetscInt         dim     = poly->numVariables;
715:   PetscReal       *lpoints, *tmp, *LB, *LD, *LH;
716:   PetscInt        *ind, *tup;
717:   PetscInt         c, pdim, d, der, i, p, deg, o;
718:   PetscErrorCode   ierr;

721:   PetscSpaceGetDimension(sp, &pdim);
722:   pdim /= Nc;
723:   DMGetWorkArray(dm, npoints, PETSC_REAL, &lpoints);
724:   DMGetWorkArray(dm, npoints*ndegree*3, PETSC_REAL, &tmp);
725:   if (B) {DMGetWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LB);}
726:   if (D) {DMGetWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LD);}
727:   if (H) {DMGetWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LH);}
728:   for (d = 0; d < dim; ++d) {
729:     for (p = 0; p < npoints; ++p) {
730:       lpoints[p] = points[p*dim+d];
731:     }
732:     PetscDTLegendreEval(npoints, lpoints, ndegree, degrees, tmp, &tmp[1*npoints*ndegree], &tmp[2*npoints*ndegree]);
733:     /* LB, LD, LH (ndegree * dim x npoints) */
734:     for (deg = 0; deg < ndegree; ++deg) {
735:       for (p = 0; p < npoints; ++p) {
736:         if (B) LB[(deg*dim + d)*npoints + p] = tmp[(0*npoints + p)*ndegree+deg];
737:         if (D) LD[(deg*dim + d)*npoints + p] = tmp[(1*npoints + p)*ndegree+deg];
738:         if (H) LH[(deg*dim + d)*npoints + p] = tmp[(2*npoints + p)*ndegree+deg];
739:       }
740:     }
741:   }
742:   /* Multiply by A (pdim x ndegree * dim) */
743:   PetscMalloc2(dim,&ind,dim,&tup);
744:   if (B) {
745:     /* B (npoints x pdim x Nc) */
746:     PetscMemzero(B, npoints*pdim*Nc*Nc * sizeof(PetscReal));
747:     if (poly->tensor) {
748:       i = 0;
749:       PetscMemzero(ind, dim * sizeof(PetscInt));
750:       while (ind[0] >= 0) {
751:         TensorPoint_Internal(dim, sp->order+1, ind, tup);
752:         for (p = 0; p < npoints; ++p) {
753:           B[(p*pdim + i)*Nc*Nc] = 1.0;
754:           for (d = 0; d < dim; ++d) {
755:             B[(p*pdim + i)*Nc*Nc] *= LB[(tup[d]*dim + d)*npoints + p];
756:           }
757:         }
758:         ++i;
759:       }
760:     } else {
761:       i = 0;
762:       for (o = 0; o <= sp->order; ++o) {
763:         PetscMemzero(ind, dim * sizeof(PetscInt));
764:         while (ind[0] >= 0) {
765:           LatticePoint_Internal(dim, o, ind, tup);
766:           for (p = 0; p < npoints; ++p) {
767:             B[(p*pdim + i)*Nc*Nc] = 1.0;
768:             for (d = 0; d < dim; ++d) {
769:               B[(p*pdim + i)*Nc*Nc] *= LB[(tup[d]*dim + d)*npoints + p];
770:             }
771:           }
772:           ++i;
773:         }
774:       }
775:     }
776:     /* Make direct sum basis for multicomponent space */
777:     for (p = 0; p < npoints; ++p) {
778:       for (i = 0; i < pdim; ++i) {
779:         for (c = 1; c < Nc; ++c) {
780:           B[(p*pdim*Nc + i*Nc + c)*Nc + c] = B[(p*pdim + i)*Nc*Nc];
781:         }
782:       }
783:     }
784:   }
785:   if (D) {
786:     /* D (npoints x pdim x Nc x dim) */
787:     PetscMemzero(D, npoints*pdim*Nc*Nc*dim * sizeof(PetscReal));
788:     if (poly->tensor) {
789:       i = 0;
790:       PetscMemzero(ind, dim * sizeof(PetscInt));
791:       while (ind[0] >= 0) {
792:         TensorPoint_Internal(dim, sp->order+1, ind, tup);
793:         for (p = 0; p < npoints; ++p) {
794:           for (der = 0; der < dim; ++der) {
795:             D[(p*pdim + i)*Nc*Nc*dim + der] = 1.0;
796:             for (d = 0; d < dim; ++d) {
797:               if (d == der) {
798:                 D[(p*pdim + i)*Nc*Nc*dim + der] *= LD[(tup[d]*dim + d)*npoints + p];
799:               } else {
800:                 D[(p*pdim + i)*Nc*Nc*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
801:               }
802:             }
803:           }
804:         }
805:         ++i;
806:       }
807:     } else {
808:       i = 0;
809:       for (o = 0; o <= sp->order; ++o) {
810:         PetscMemzero(ind, dim * sizeof(PetscInt));
811:         while (ind[0] >= 0) {
812:           LatticePoint_Internal(dim, o, ind, tup);
813:           for (p = 0; p < npoints; ++p) {
814:             for (der = 0; der < dim; ++der) {
815:               D[(p*pdim + i)*Nc*Nc*dim + der] = 1.0;
816:               for (d = 0; d < dim; ++d) {
817:                 if (d == der) {
818:                   D[(p*pdim + i)*Nc*Nc*dim + der] *= LD[(tup[d]*dim + d)*npoints + p];
819:                 } else {
820:                   D[(p*pdim + i)*Nc*Nc*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
821:                 }
822:               }
823:             }
824:           }
825:           ++i;
826:         }
827:       }
828:     }
829:     /* Make direct sum basis for multicomponent space */
830:     for (p = 0; p < npoints; ++p) {
831:       for (i = 0; i < pdim; ++i) {
832:         for (c = 1; c < Nc; ++c) {
833:           for (d = 0; d < dim; ++d) {
834:             D[((p*pdim*Nc + i*Nc + c)*Nc + c)*dim + d] = D[(p*pdim + i)*Nc*Nc*dim + d];
835:           }
836:         }
837:       }
838:     }
839:   }
840:   if (H) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Too lazy to code second derivatives");
841:   PetscFree2(ind,tup);
842:   if (B) {DMRestoreWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LB);}
843:   if (D) {DMRestoreWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LD);}
844:   if (H) {DMRestoreWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LH);}
845:   DMRestoreWorkArray(dm, npoints*ndegree*3, PETSC_REAL, &tmp);
846:   DMRestoreWorkArray(dm, npoints, PETSC_REAL, &lpoints);
847:   return(0);
848: }

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

855:   Input Parameters:
856: + sp     - the function space object
857: - tensor - PETSC_TRUE for a tensor polynomial space, PETSC_FALSE for a polynomial space

859:   Level: beginner

861: .seealso: PetscSpacePolynomialGetTensor(), PetscSpaceSetOrder(), PetscSpacePolynomialSetNumVariables()
862: @*/
863: PetscErrorCode PetscSpacePolynomialSetTensor(PetscSpace sp, PetscBool tensor)
864: {

869:   PetscTryMethod(sp,"PetscSpacePolynomialSetTensor_C",(PetscSpace,PetscBool),(sp,tensor));
870:   return(0);
871: }

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

878:   Input Parameters:
879: . sp     - the function space object

881:   Output Parameters:
882: . tensor - PETSC_TRUE for a tensor polynomial space, PETSC_FALSE for a polynomial space

884:   Level: beginner

886: .seealso: PetscSpacePolynomialSetTensor(), PetscSpaceSetOrder(), PetscSpacePolynomialSetNumVariables()
887: @*/
888: PetscErrorCode PetscSpacePolynomialGetTensor(PetscSpace sp, PetscBool *tensor)
889: {

895:   PetscTryMethod(sp,"PetscSpacePolynomialGetTensor_C",(PetscSpace,PetscBool*),(sp,tensor));
896:   return(0);
897: }

899: static PetscErrorCode PetscSpacePolynomialSetTensor_Polynomial(PetscSpace sp, PetscBool tensor)
900: {
901:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

904:   poly->tensor = tensor;
905:   return(0);
906: }

908: static PetscErrorCode PetscSpacePolynomialGetTensor_Polynomial(PetscSpace sp, PetscBool *tensor)
909: {
910:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

915:   *tensor = poly->tensor;
916:   return(0);
917: }

919: PetscErrorCode PetscSpaceInitialize_Polynomial(PetscSpace sp)
920: {

924:   sp->ops->setfromoptions = PetscSpaceSetFromOptions_Polynomial;
925:   sp->ops->setup          = PetscSpaceSetUp_Polynomial;
926:   sp->ops->view           = PetscSpaceView_Polynomial;
927:   sp->ops->destroy        = PetscSpaceDestroy_Polynomial;
928:   sp->ops->getdimension   = PetscSpaceGetDimension_Polynomial;
929:   sp->ops->evaluate       = PetscSpaceEvaluate_Polynomial;
930:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", PetscSpacePolynomialGetTensor_Polynomial);
931:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialSetTensor_C", PetscSpacePolynomialSetTensor_Polynomial);
932:   return(0);
933: }

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

939:   Level: intermediate

941: .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
942: M*/

944: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_Polynomial(PetscSpace sp)
945: {
946:   PetscSpace_Poly *poly;
947:   PetscErrorCode   ierr;

951:   PetscNewLog(sp,&poly);
952:   sp->data = poly;

954:   poly->numVariables = 0;
955:   poly->symmetric    = PETSC_FALSE;
956:   poly->tensor       = PETSC_FALSE;
957:   poly->degrees      = NULL;

959:   PetscSpaceInitialize_Polynomial(sp);
960:   return(0);
961: }

963: PetscErrorCode PetscSpacePolynomialSetSymmetric(PetscSpace sp, PetscBool sym)
964: {
965:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

969:   poly->symmetric = sym;
970:   return(0);
971: }

973: PetscErrorCode PetscSpacePolynomialGetSymmetric(PetscSpace sp, PetscBool *sym)
974: {
975:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

980:   *sym = poly->symmetric;
981:   return(0);
982: }

984: PetscErrorCode PetscSpacePolynomialSetNumVariables(PetscSpace sp, PetscInt n)
985: {
986:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

990:   poly->numVariables = n;
991:   return(0);
992: }

994: PetscErrorCode PetscSpacePolynomialGetNumVariables(PetscSpace sp, PetscInt *n)
995: {
996:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

1001:   *n = poly->numVariables;
1002:   return(0);
1003: }

1005: PetscErrorCode PetscSpaceSetFromOptions_Point(PetscOptionItems *PetscOptionsObject,PetscSpace sp)
1006: {
1007:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1008:   PetscErrorCode    ierr;

1011:   PetscOptionsHead(PetscOptionsObject,"PetscSpace Point options");
1012:   PetscOptionsInt("-petscspace_point_num_variables", "The number of different variables, e.g. x and y", "PetscSpacePointSetNumVariables", pt->numVariables, &pt->numVariables, NULL);
1013:   PetscOptionsTail();
1014:   return(0);
1015: }

1017: PetscErrorCode PetscSpacePointView_Ascii(PetscSpace sp, PetscViewer viewer)
1018: {
1019:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1020:   PetscViewerFormat format;
1021:   PetscErrorCode    ierr;

1024:   PetscViewerGetFormat(viewer, &format);
1025:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
1026:     PetscViewerASCIIPrintf(viewer, "Point space in dimension %d:\n", pt->numVariables);
1027:     PetscViewerASCIIPushTab(viewer);
1028:     PetscQuadratureView(pt->quad, viewer);
1029:     PetscViewerASCIIPopTab(viewer);
1030:   } else {
1031:     PetscViewerASCIIPrintf(viewer, "Point space in dimension %d on %d points\n", pt->numVariables, pt->quad->numPoints);
1032:   }
1033:   return(0);
1034: }

1036: PetscErrorCode PetscSpaceView_Point(PetscSpace sp, PetscViewer viewer)
1037: {
1038:   PetscBool      iascii;

1044:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
1045:   if (iascii) {PetscSpacePointView_Ascii(sp, viewer);}
1046:   return(0);
1047: }

1049: PetscErrorCode PetscSpaceSetUp_Point(PetscSpace sp)
1050: {
1051:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1052:   PetscErrorCode    ierr;

1055:   if (!pt->quad->points && sp->order >= 0) {
1056:     PetscQuadratureDestroy(&pt->quad);
1057:     PetscDTGaussJacobiQuadrature(pt->numVariables, sp->Nc, PetscMax(sp->order + 1, 1), -1.0, 1.0, &pt->quad);
1058:   }
1059:   return(0);
1060: }

1062: PetscErrorCode PetscSpaceDestroy_Point(PetscSpace sp)
1063: {
1064:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1065:   PetscErrorCode    ierr;

1068:   PetscQuadratureDestroy(&pt->quad);
1069:   PetscFree(pt);
1070:   return(0);
1071: }

1073: PetscErrorCode PetscSpaceGetDimension_Point(PetscSpace sp, PetscInt *dim)
1074: {
1075:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;

1078:   *dim = pt->quad->numPoints;
1079:   return(0);
1080: }

1082: PetscErrorCode PetscSpaceEvaluate_Point(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
1083: {
1084:   PetscSpace_Point *pt  = (PetscSpace_Point *) sp->data;
1085:   PetscInt          dim = pt->numVariables, pdim = pt->quad->numPoints, d, p, i, c;
1086:   PetscErrorCode    ierr;

1089:   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);
1090:   PetscMemzero(B, npoints*pdim * sizeof(PetscReal));
1091:   for (p = 0; p < npoints; ++p) {
1092:     for (i = 0; i < pdim; ++i) {
1093:       for (d = 0; d < dim; ++d) {
1094:         if (PetscAbsReal(points[p*dim+d] - pt->quad->points[p*dim+d]) > 1.0e-10) break;
1095:       }
1096:       if (d >= dim) {B[p*pdim+i] = 1.0; break;}
1097:     }
1098:   }
1099:   /* Replicate for other components */
1100:   for (c = 1; c < sp->Nc; ++c) {
1101:     for (p = 0; p < npoints; ++p) {
1102:       for (i = 0; i < pdim; ++i) {
1103:         B[(c*npoints + p)*pdim + i] = B[p*pdim + i];
1104:       }
1105:     }
1106:   }
1107:   if (D) {PetscMemzero(D, npoints*pdim*dim * sizeof(PetscReal));}
1108:   if (H) {PetscMemzero(H, npoints*pdim*dim*dim * sizeof(PetscReal));}
1109:   return(0);
1110: }

1112: PetscErrorCode PetscSpaceInitialize_Point(PetscSpace sp)
1113: {
1115:   sp->ops->setfromoptions = PetscSpaceSetFromOptions_Point;
1116:   sp->ops->setup          = PetscSpaceSetUp_Point;
1117:   sp->ops->view           = PetscSpaceView_Point;
1118:   sp->ops->destroy        = PetscSpaceDestroy_Point;
1119:   sp->ops->getdimension   = PetscSpaceGetDimension_Point;
1120:   sp->ops->evaluate       = PetscSpaceEvaluate_Point;
1121:   return(0);
1122: }

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

1127:   Level: intermediate

1129: .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
1130: M*/

1132: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_Point(PetscSpace sp)
1133: {
1134:   PetscSpace_Point *pt;
1135:   PetscErrorCode    ierr;

1139:   PetscNewLog(sp,&pt);
1140:   sp->data = pt;

1142:   pt->numVariables = 0;
1143:   PetscQuadratureCreate(PETSC_COMM_SELF, &pt->quad);
1144:   PetscQuadratureSetData(pt->quad, 0, 1, 0, NULL, NULL);

1146:   PetscSpaceInitialize_Point(sp);
1147:   return(0);
1148: }

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

1153:   Logically collective

1155:   Input Parameters:
1156: + sp - The PetscSpace
1157: - q  - The PetscQuadrature defining the points

1159:   Level: intermediate

1161: .keywords: PetscSpacePoint
1162: .seealso: PetscSpaceCreate(), PetscSpaceSetType()
1163: @*/
1164: PetscErrorCode PetscSpacePointSetPoints(PetscSpace sp, PetscQuadrature q)
1165: {
1166:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1167:   PetscErrorCode    ierr;

1172:   PetscQuadratureDestroy(&pt->quad);
1173:   PetscQuadratureDuplicate(q, &pt->quad);
1174:   return(0);
1175: }

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

1180:   Logically collective

1182:   Input Parameter:
1183: . sp - The PetscSpace

1185:   Output Parameter:
1186: . q  - The PetscQuadrature defining the points

1188:   Level: intermediate

1190: .keywords: PetscSpacePoint
1191: .seealso: PetscSpaceCreate(), PetscSpaceSetType()
1192: @*/
1193: PetscErrorCode PetscSpacePointGetPoints(PetscSpace sp, PetscQuadrature *q)
1194: {
1195:   PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;

1200:   *q = pt->quad;
1201:   return(0);
1202: }


1205: PetscClassId PETSCDUALSPACE_CLASSID = 0;

1207: PetscFunctionList PetscDualSpaceList              = NULL;
1208: PetscBool         PetscDualSpaceRegisterAllCalled = PETSC_FALSE;

1210: /*@C
1211:   PetscDualSpaceRegister - Adds a new PetscDualSpace implementation

1213:   Not Collective

1215:   Input Parameters:
1216: + name        - The name of a new user-defined creation routine
1217: - create_func - The creation routine itself

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

1222:   Sample usage:
1223: .vb
1224:     PetscDualSpaceRegister("my_space", MyPetscDualSpaceCreate);
1225: .ve

1227:   Then, your PetscDualSpace type can be chosen with the procedural interface via
1228: .vb
1229:     PetscDualSpaceCreate(MPI_Comm, PetscDualSpace *);
1230:     PetscDualSpaceSetType(PetscDualSpace, "my_dual_space");
1231: .ve
1232:    or at runtime via the option
1233: .vb
1234:     -petscdualspace_type my_dual_space
1235: .ve

1237:   Level: advanced

1239: .keywords: PetscDualSpace, register
1240: .seealso: PetscDualSpaceRegisterAll(), PetscDualSpaceRegisterDestroy()

1242: @*/
1243: PetscErrorCode PetscDualSpaceRegister(const char sname[], PetscErrorCode (*function)(PetscDualSpace))
1244: {

1248:   PetscFunctionListAdd(&PetscDualSpaceList, sname, function);
1249:   return(0);
1250: }

1252: /*@C
1253:   PetscDualSpaceSetType - Builds a particular PetscDualSpace

1255:   Collective on PetscDualSpace

1257:   Input Parameters:
1258: + sp   - The PetscDualSpace object
1259: - name - The kind of space

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

1264:   Level: intermediate

1266: .keywords: PetscDualSpace, set, type
1267: .seealso: PetscDualSpaceGetType(), PetscDualSpaceCreate()
1268: @*/
1269: PetscErrorCode PetscDualSpaceSetType(PetscDualSpace sp, PetscDualSpaceType name)
1270: {
1271:   PetscErrorCode (*r)(PetscDualSpace);
1272:   PetscBool      match;

1277:   PetscObjectTypeCompare((PetscObject) sp, name, &match);
1278:   if (match) return(0);

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

1284:   if (sp->ops->destroy) {
1285:     (*sp->ops->destroy)(sp);
1286:     sp->ops->destroy = NULL;
1287:   }
1288:   (*r)(sp);
1289:   PetscObjectChangeTypeName((PetscObject) sp, name);
1290:   return(0);
1291: }

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

1296:   Not Collective

1298:   Input Parameter:
1299: . sp  - The PetscDualSpace

1301:   Output Parameter:
1302: . name - The PetscDualSpace type name

1304:   Level: intermediate

1306: .keywords: PetscDualSpace, get, type, name
1307: .seealso: PetscDualSpaceSetType(), PetscDualSpaceCreate()
1308: @*/
1309: PetscErrorCode PetscDualSpaceGetType(PetscDualSpace sp, PetscDualSpaceType *name)
1310: {

1316:   if (!PetscDualSpaceRegisterAllCalled) {
1317:     PetscDualSpaceRegisterAll();
1318:   }
1319:   *name = ((PetscObject) sp)->type_name;
1320:   return(0);
1321: }

1323: /*@
1324:   PetscDualSpaceView - Views a PetscDualSpace

1326:   Collective on PetscDualSpace

1328:   Input Parameter:
1329: + sp - the PetscDualSpace object to view
1330: - v  - the viewer

1332:   Level: developer

1334: .seealso PetscDualSpaceDestroy()
1335: @*/
1336: PetscErrorCode PetscDualSpaceView(PetscDualSpace sp, PetscViewer v)
1337: {

1342:   if (!v) {
1343:     PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) sp), &v);
1344:   }
1345:   if (sp->ops->view) {
1346:     (*sp->ops->view)(sp, v);
1347:   }
1348:   return(0);
1349: }

1351: /*@
1352:   PetscDualSpaceSetFromOptions - sets parameters in a PetscDualSpace from the options database

1354:   Collective on PetscDualSpace

1356:   Input Parameter:
1357: . sp - the PetscDualSpace object to set options for

1359:   Options Database:
1360: . -petscspace_order the approximation order of the space

1362:   Level: developer

1364: .seealso PetscDualSpaceView()
1365: @*/
1366: PetscErrorCode PetscDualSpaceSetFromOptions(PetscDualSpace sp)
1367: {
1368:   const char    *defaultType;
1369:   char           name[256];
1370:   PetscBool      flg;

1375:   if (!((PetscObject) sp)->type_name) {
1376:     defaultType = PETSCDUALSPACELAGRANGE;
1377:   } else {
1378:     defaultType = ((PetscObject) sp)->type_name;
1379:   }
1380:   if (!PetscSpaceRegisterAllCalled) {PetscSpaceRegisterAll();}

1382:   PetscObjectOptionsBegin((PetscObject) sp);
1383:   PetscOptionsFList("-petscdualspace_type", "Dual space", "PetscDualSpaceSetType", PetscDualSpaceList, defaultType, name, 256, &flg);
1384:   if (flg) {
1385:     PetscDualSpaceSetType(sp, name);
1386:   } else if (!((PetscObject) sp)->type_name) {
1387:     PetscDualSpaceSetType(sp, defaultType);
1388:   }
1389:   PetscOptionsInt("-petscdualspace_order", "The approximation order", "PetscDualSpaceSetOrder", sp->order, &sp->order, NULL);
1390:   PetscOptionsInt("-petscdualspace_components", "The number of components", "PetscDualSpaceSetNumComponents", sp->Nc, &sp->Nc, NULL);
1391:   if (sp->ops->setfromoptions) {
1392:     (*sp->ops->setfromoptions)(PetscOptionsObject,sp);
1393:   }
1394:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
1395:   PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) sp);
1396:   PetscOptionsEnd();
1397:   PetscDualSpaceViewFromOptions(sp, NULL, "-petscdualspace_view");
1398:   return(0);
1399: }

1401: /*@
1402:   PetscDualSpaceSetUp - Construct a basis for the PetscDualSpace

1404:   Collective on PetscDualSpace

1406:   Input Parameter:
1407: . sp - the PetscDualSpace object to setup

1409:   Level: developer

1411: .seealso PetscDualSpaceView(), PetscDualSpaceDestroy()
1412: @*/
1413: PetscErrorCode PetscDualSpaceSetUp(PetscDualSpace sp)
1414: {

1419:   if (sp->setupcalled) return(0);
1420:   sp->setupcalled = PETSC_TRUE;
1421:   if (sp->ops->setup) {(*sp->ops->setup)(sp);}
1422:   return(0);
1423: }

1425: /*@
1426:   PetscDualSpaceDestroy - Destroys a PetscDualSpace object

1428:   Collective on PetscDualSpace

1430:   Input Parameter:
1431: . sp - the PetscDualSpace object to destroy

1433:   Level: developer

1435: .seealso PetscDualSpaceView()
1436: @*/
1437: PetscErrorCode PetscDualSpaceDestroy(PetscDualSpace *sp)
1438: {
1439:   PetscInt       dim, f;

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

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

1449:   PetscDualSpaceGetDimension(*sp, &dim);
1450:   for (f = 0; f < dim; ++f) {
1451:     PetscQuadratureDestroy(&(*sp)->functional[f]);
1452:   }
1453:   PetscFree((*sp)->functional);
1454:   DMDestroy(&(*sp)->dm);

1456:   if ((*sp)->ops->destroy) {(*(*sp)->ops->destroy)(*sp);}
1457:   PetscHeaderDestroy(sp);
1458:   return(0);
1459: }

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

1464:   Collective on MPI_Comm

1466:   Input Parameter:
1467: . comm - The communicator for the PetscDualSpace object

1469:   Output Parameter:
1470: . sp - The PetscDualSpace object

1472:   Level: beginner

1474: .seealso: PetscDualSpaceSetType(), PETSCDUALSPACELAGRANGE
1475: @*/
1476: PetscErrorCode PetscDualSpaceCreate(MPI_Comm comm, PetscDualSpace *sp)
1477: {
1478:   PetscDualSpace s;

1483:   PetscCitationsRegister(FECitation,&FEcite);
1484:   *sp  = NULL;
1485:   PetscFEInitializePackage();

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

1489:   s->order = 0;
1490:   s->Nc    = 1;
1491:   s->setupcalled = PETSC_FALSE;

1493:   *sp = s;
1494:   return(0);
1495: }

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

1500:   Collective on PetscDualSpace

1502:   Input Parameter:
1503: . sp - The original PetscDualSpace

1505:   Output Parameter:
1506: . spNew - The duplicate PetscDualSpace

1508:   Level: beginner

1510: .seealso: PetscDualSpaceCreate(), PetscDualSpaceSetType()
1511: @*/
1512: PetscErrorCode PetscDualSpaceDuplicate(PetscDualSpace sp, PetscDualSpace *spNew)
1513: {

1519:   (*sp->ops->duplicate)(sp, spNew);
1520:   return(0);
1521: }

1523: /*@
1524:   PetscDualSpaceGetDM - Get the DM representing the reference cell

1526:   Not collective

1528:   Input Parameter:
1529: . sp - The PetscDualSpace

1531:   Output Parameter:
1532: . dm - The reference cell

1534:   Level: intermediate

1536: .seealso: PetscDualSpaceSetDM(), PetscDualSpaceCreate()
1537: @*/
1538: PetscErrorCode PetscDualSpaceGetDM(PetscDualSpace sp, DM *dm)
1539: {
1543:   *dm = sp->dm;
1544:   return(0);
1545: }

1547: /*@
1548:   PetscDualSpaceSetDM - Get the DM representing the reference cell

1550:   Not collective

1552:   Input Parameters:
1553: + sp - The PetscDualSpace
1554: - dm - The reference cell

1556:   Level: intermediate

1558: .seealso: PetscDualSpaceGetDM(), PetscDualSpaceCreate()
1559: @*/
1560: PetscErrorCode PetscDualSpaceSetDM(PetscDualSpace sp, DM dm)
1561: {

1567:   DMDestroy(&sp->dm);
1568:   PetscObjectReference((PetscObject) dm);
1569:   sp->dm = dm;
1570:   return(0);
1571: }

1573: /*@
1574:   PetscDualSpaceGetOrder - Get the order of the dual space

1576:   Not collective

1578:   Input Parameter:
1579: . sp - The PetscDualSpace

1581:   Output Parameter:
1582: . order - The order

1584:   Level: intermediate

1586: .seealso: PetscDualSpaceSetOrder(), PetscDualSpaceCreate()
1587: @*/
1588: PetscErrorCode PetscDualSpaceGetOrder(PetscDualSpace sp, PetscInt *order)
1589: {
1593:   *order = sp->order;
1594:   return(0);
1595: }

1597: /*@
1598:   PetscDualSpaceSetOrder - Set the order of the dual space

1600:   Not collective

1602:   Input Parameters:
1603: + sp - The PetscDualSpace
1604: - order - The order

1606:   Level: intermediate

1608: .seealso: PetscDualSpaceGetOrder(), PetscDualSpaceCreate()
1609: @*/
1610: PetscErrorCode PetscDualSpaceSetOrder(PetscDualSpace sp, PetscInt order)
1611: {
1614:   sp->order = order;
1615:   return(0);
1616: }

1618: /*@
1619:   PetscDualSpaceGetNumComponents - Return the number of components for this space

1621:   Input Parameter:
1622: . sp - The PetscDualSpace

1624:   Output Parameter:
1625: . Nc - The number of components

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

1629:   Level: intermediate

1631: .seealso: PetscDualSpaceSetNumComponents(), PetscDualSpaceGetDimension(), PetscDualSpaceCreate(), PetscDualSpace
1632: @*/
1633: PetscErrorCode PetscDualSpaceGetNumComponents(PetscDualSpace sp, PetscInt *Nc)
1634: {
1638:   *Nc = sp->Nc;
1639:   return(0);
1640: }

1642: /*@
1643:   PetscDualSpaceSetNumComponents - Set the number of components for this space

1645:   Input Parameters:
1646: + sp - The PetscDualSpace
1647: - order - The number of components

1649:   Level: intermediate

1651: .seealso: PetscDualSpaceGetNumComponents(), PetscDualSpaceCreate(), PetscDualSpace
1652: @*/
1653: PetscErrorCode PetscDualSpaceSetNumComponents(PetscDualSpace sp, PetscInt Nc)
1654: {
1657:   sp->Nc = Nc;
1658:   return(0);
1659: }

1661: /*@
1662:   PetscDualSpaceLagrangeGetTensor - Get the tensor nature of the dual space

1664:   Not collective

1666:   Input Parameter:
1667: . sp - The PetscDualSpace

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

1672:   Level: intermediate

1674: .seealso: PetscDualSpaceLagrangeSetTensor(), PetscDualSpaceCreate()
1675: @*/
1676: PetscErrorCode PetscDualSpaceLagrangeGetTensor(PetscDualSpace sp, PetscBool *tensor)
1677: {

1683:   PetscTryMethod(sp,"PetscDualSpaceLagrangeGetTensor_C",(PetscDualSpace,PetscBool *),(sp,tensor));
1684:   return(0);
1685: }

1687: /*@
1688:   PetscDualSpaceLagrangeSetTensor - Set the tensor nature of the dual space

1690:   Not collective

1692:   Input Parameters:
1693: + sp - The PetscDualSpace
1694: - tensor - Whether the dual space has tensor layout (vs. simplicial)

1696:   Level: intermediate

1698: .seealso: PetscDualSpaceLagrangeGetTensor(), PetscDualSpaceCreate()
1699: @*/
1700: PetscErrorCode PetscDualSpaceLagrangeSetTensor(PetscDualSpace sp, PetscBool tensor)
1701: {

1706:   PetscTryMethod(sp,"PetscDualSpaceLagrangeSetTensor_C",(PetscDualSpace,PetscBool),(sp,tensor));
1707:   return(0);
1708: }

1710: /*@
1711:   PetscDualSpaceGetFunctional - Get the i-th basis functional in the dual space

1713:   Not collective

1715:   Input Parameters:
1716: + sp - The PetscDualSpace
1717: - i  - The basis number

1719:   Output Parameter:
1720: . functional - The basis functional

1722:   Level: intermediate

1724: .seealso: PetscDualSpaceGetDimension(), PetscDualSpaceCreate()
1725: @*/
1726: PetscErrorCode PetscDualSpaceGetFunctional(PetscDualSpace sp, PetscInt i, PetscQuadrature *functional)
1727: {
1728:   PetscInt       dim;

1734:   PetscDualSpaceGetDimension(sp, &dim);
1735:   if ((i < 0) || (i >= dim)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Functional index %d must be in [0, %d)", i, dim);
1736:   *functional = sp->functional[i];
1737:   return(0);
1738: }

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

1743:   Not collective

1745:   Input Parameter:
1746: . sp - The PetscDualSpace

1748:   Output Parameter:
1749: . dim - The dimension

1751:   Level: intermediate

1753: .seealso: PetscDualSpaceGetFunctional(), PetscDualSpaceCreate()
1754: @*/
1755: PetscErrorCode PetscDualSpaceGetDimension(PetscDualSpace sp, PetscInt *dim)
1756: {

1762:   *dim = 0;
1763:   if (sp->ops->getdimension) {(*sp->ops->getdimension)(sp, dim);}
1764:   return(0);
1765: }

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

1770:   Not collective

1772:   Input Parameter:
1773: . sp - The PetscDualSpace

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

1778:   Level: intermediate

1780: .seealso: PetscDualSpaceGetFunctional(), PetscDualSpaceCreate()
1781: @*/
1782: PetscErrorCode PetscDualSpaceGetNumDof(PetscDualSpace sp, const PetscInt **numDof)
1783: {

1789:   (*sp->ops->getnumdof)(sp, numDof);
1790:   if (!*numDof) SETERRQ(PetscObjectComm((PetscObject) sp), PETSC_ERR_LIB, "Empty numDof[] returned from dual space implementation");
1791:   return(0);
1792: }

1794: /*@
1795:   PetscDualSpaceCreateReferenceCell - Create a DMPLEX with the appropriate FEM reference cell

1797:   Collective on PetscDualSpace

1799:   Input Parameters:
1800: + sp      - The PetscDualSpace
1801: . dim     - The spatial dimension
1802: - simplex - Flag for simplex, otherwise use a tensor-product cell

1804:   Output Parameter:
1805: . refdm - The reference cell

1807:   Level: advanced

1809: .keywords: PetscDualSpace, reference cell
1810: .seealso: PetscDualSpaceCreate(), DMPLEX
1811: @*/
1812: PetscErrorCode PetscDualSpaceCreateReferenceCell(PetscDualSpace sp, PetscInt dim, PetscBool simplex, DM *refdm)
1813: {

1817:   DMPlexCreateReferenceCell(PetscObjectComm((PetscObject) sp), dim, simplex, refdm);
1818:   return(0);
1819: }

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

1824:   Input Parameters:
1825: + sp      - The PetscDualSpace object
1826: . f       - The basis functional index
1827: . time    - The time
1828: . cgeom   - A context with geometric information for this cell, we use v0 (the initial vertex) and J (the Jacobian)
1829: . numComp - The number of components for the function
1830: . func    - The input function
1831: - ctx     - A context for the function

1833:   Output Parameter:
1834: . value   - numComp output values

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

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

1841:   Level: developer

1843: .seealso: PetscDualSpaceCreate()
1844: @*/
1845: PetscErrorCode PetscDualSpaceApply(PetscDualSpace sp, PetscInt f, PetscReal time, PetscFECellGeom *cgeom, PetscInt numComp, PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void *ctx, PetscScalar *value)
1846: {

1853:   (*sp->ops->apply)(sp, f, time, cgeom, numComp, func, ctx, value);
1854:   return(0);
1855: }

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

1860:   Input Parameters:
1861: + sp    - The PetscDualSpace object
1862: . f     - The basis functional index
1863: . time  - The time
1864: . cgeom - A context with geometric information for this cell, we use v0 (the initial vertex) and J (the Jacobian)
1865: . Nc    - The number of components for the function
1866: . func  - The input function
1867: - ctx   - A context for the function

1869:   Output Parameter:
1870: . value   - The output value

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

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

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

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

1881: where both n and f have Nc components.

1883:   Level: developer

1885: .seealso: PetscDualSpaceCreate()
1886: @*/
1887: PetscErrorCode PetscDualSpaceApplyDefault(PetscDualSpace sp, PetscInt f, PetscReal time, PetscFECellGeom *cgeom, PetscInt Nc, PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void *ctx, PetscScalar *value)
1888: {
1889:   DM               dm;
1890:   PetscQuadrature  n;
1891:   const PetscReal *points, *weights;
1892:   PetscReal        x[3];
1893:   PetscScalar     *val;
1894:   PetscInt         dim, qNc, c, Nq, q;
1895:   PetscErrorCode   ierr;

1900:   PetscDualSpaceGetDM(sp, &dm);
1901:   PetscDualSpaceGetFunctional(sp, f, &n);
1902:   PetscQuadratureGetData(n, &dim, &qNc, &Nq, &points, &weights);
1903:   if (dim != cgeom->dim) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_SIZ, "The quadrature spatial dimension %D != cell geometry dimension %D", dim, cgeom->dim);
1904:   if (qNc != Nc) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_SIZ, "The quadrature components %D != function components %D", qNc, Nc);
1905:   DMGetWorkArray(dm, Nc, PETSC_SCALAR, &val);
1906:   *value = 0.0;
1907:   for (q = 0; q < Nq; ++q) {
1908:     CoordinatesRefToReal(cgeom->dimEmbed, dim, cgeom->v0, cgeom->J, &points[q*dim], x);
1909:     (*func)(cgeom->dimEmbed, time, x, Nc, val, ctx);
1910:     for (c = 0; c < Nc; ++c) {
1911:       *value += val[c]*weights[q*Nc+c];
1912:     }
1913:   }
1914:   DMRestoreWorkArray(dm, Nc, PETSC_SCALAR, &val);
1915:   return(0);
1916: }

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

1921:   Input Parameters:
1922: + sp    - The PetscDualSpace object
1923: . f     - The basis functional index
1924: . time  - The time
1925: . cgeom - A context with geometric information for this cell, we currently just use the centroid
1926: . Nc    - The number of components for the function
1927: . func  - The input function
1928: - ctx   - A context for the function

1930:   Output Parameter:
1931: . value - The output value

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

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

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

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

1942: where both n and f have Nc components.

1944:   Level: developer

1946: .seealso: PetscDualSpaceCreate()
1947: @*/
1948: 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)
1949: {
1950:   DM               dm;
1951:   PetscQuadrature  n;
1952:   const PetscReal *points, *weights;
1953:   PetscScalar     *val;
1954:   PetscInt         dimEmbed, qNc, c, Nq, q;
1955:   PetscErrorCode   ierr;

1960:   PetscDualSpaceGetDM(sp, &dm);
1961:   DMGetCoordinateDim(dm, &dimEmbed);
1962:   PetscDualSpaceGetFunctional(sp, f, &n);
1963:   PetscQuadratureGetData(n, NULL, &qNc, &Nq, &points, &weights);
1964:   if (qNc != Nc) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_SIZ, "The quadrature components %D != function components %D", qNc, Nc);
1965:   DMGetWorkArray(dm, Nc, PETSC_SCALAR, &val);
1966:   for (c = 0; c < Nc; ++c) value[c] = 0.0;
1967:   for (q = 0; q < Nq; ++q) {
1968:     (*func)(dimEmbed, time, cgeom->centroid, Nc, val, ctx);
1969:     for (c = 0; c < Nc; ++c) {
1970:       value[c] += val[c]*weights[q*Nc+c];
1971:     }
1972:   }
1973:   DMRestoreWorkArray(dm, Nc, PETSC_SCALAR, &val);
1974:   return(0);
1975: }

1977: /*@
1978:   PetscDualSpaceGetHeightSubspace - Get the subset of the dual space basis that is supported on a mesh point of a given height.

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

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

1986:   Not collective

1988:   Input Parameters:
1989: + sp - the PetscDualSpace object
1990: - height - the height of the mesh point for which the subspace is desired

1992:   Output Parameters:
1993:   bdsp - the subspace

1995:   Level: advanced

1997: .seealso: PetscDualSpace
1998: @*/
1999: PetscErrorCode PetscDualSpaceGetHeightSubspace(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
2000: {

2006:   *bdsp = NULL;
2007:   if (sp->ops->getheightsubspace) {
2008:     (*sp->ops->getheightsubspace)(sp,height,bdsp);
2009:   }
2010:   return(0);
2011: }

2013: static PetscErrorCode PetscDualSpaceLagrangeGetTensor_Lagrange(PetscDualSpace sp, PetscBool *tensor)
2014: {
2015:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;

2018:   *tensor = lag->tensorSpace;
2019:   return(0);
2020: }

2022: static PetscErrorCode PetscDualSpaceLagrangeSetTensor_Lagrange(PetscDualSpace sp, PetscBool tensor)
2023: {
2024:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;

2027:   lag->tensorSpace = tensor;
2028:   return(0);
2029: }

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

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

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

2038:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2039:   PetscInt           dim, order, p, Nc;
2040:   PetscErrorCode     ierr;

2043:   PetscDualSpaceGetOrder(sp,&order);
2044:   PetscDualSpaceGetNumComponents(sp,&Nc);
2045:   DMGetDimension(sp->dm,&dim);
2046:   if (!dim || !lag->continuous || order < 3) return(0);
2047:   if (dim > 3) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Lagrange symmetries not implemented for dim = %D > 3",dim);
2048:   if (!lag->symmetries) { /* store symmetries */
2049:     PetscDualSpace hsp;
2050:     DM             K;
2051:     PetscInt       numPoints = 1, d;
2052:     PetscInt       numFaces;
2053:     PetscInt       ***symmetries;
2054:     const PetscInt ***hsymmetries;

2056:     if (lag->simplexCell) {
2057:       numFaces = 1 + dim;
2058:       for (d = 0; d < dim; d++) numPoints = numPoints * 2 + 1;
2059:     }
2060:     else {
2061:       numPoints = PetscPowInt(3,dim);
2062:       numFaces  = 2 * dim;
2063:     }
2064:     PetscCalloc1(numPoints,&symmetries);
2065:     if (0 < dim && dim < 3) { /* compute self symmetries */
2066:       PetscInt **cellSymmetries;

2068:       lag->numSelfSym = 2 * numFaces;
2069:       lag->selfSymOff = numFaces;
2070:       PetscCalloc1(2*numFaces,&cellSymmetries);
2071:       /* we want to be able to index symmetries directly with the orientations, which range from [-numFaces,numFaces) */
2072:       symmetries[0] = &cellSymmetries[numFaces];
2073:       if (dim == 1) {
2074:         PetscInt dofPerEdge = order - 1;

2076:         if (dofPerEdge > 1) {
2077:           PetscInt i, j, *reverse;

2079:           PetscMalloc1(dofPerEdge*Nc,&reverse);
2080:           for (i = 0; i < dofPerEdge; i++) {
2081:             for (j = 0; j < Nc; j++) {
2082:               reverse[i*Nc + j] = Nc * (dofPerEdge - 1 - i) + j;
2083:             }
2084:           }
2085:           symmetries[0][-2] = reverse;

2087:           /* yes, this is redundant, but it makes it easier to cleanup if I don't have to worry about what not to free */
2088:           PetscMalloc1(dofPerEdge*Nc,&reverse);
2089:           for (i = 0; i < dofPerEdge; i++) {
2090:             for (j = 0; j < Nc; j++) {
2091:               reverse[i*Nc + j] = Nc * (dofPerEdge - 1 - i) + j;
2092:             }
2093:           }
2094:           symmetries[0][1] = reverse;
2095:         }
2096:       } else {
2097:         PetscInt dofPerEdge = lag->simplexCell ? (order - 2) : (order - 1), s;
2098:         PetscInt dofPerFace;

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

2104:             if (!s) continue;
2105:             if (lag->simplexCell) {
2106:               dofPerFace = (dofPerEdge * (dofPerEdge + 1))/2;
2107:               PetscMalloc1(Nc*dofPerFace,&sym);
2108:               for (j = 0, l = 0; j < dofPerEdge; j++) {
2109:                 for (k = 0; k < dofPerEdge - j; k++, l++) {
2110:                   i = dofPerEdge - 1 - j - k;
2111:                   switch (s) {
2112:                   case -3:
2113:                     sym[Nc*l] = BaryIndex(dofPerEdge,i,k,j);
2114:                     break;
2115:                   case -2:
2116:                     sym[Nc*l] = BaryIndex(dofPerEdge,j,i,k);
2117:                     break;
2118:                   case -1:
2119:                     sym[Nc*l] = BaryIndex(dofPerEdge,k,j,i);
2120:                     break;
2121:                   case 1:
2122:                     sym[Nc*l] = BaryIndex(dofPerEdge,k,i,j);
2123:                     break;
2124:                   case 2:
2125:                     sym[Nc*l] = BaryIndex(dofPerEdge,j,k,i);
2126:                     break;
2127:                   }
2128:                 }
2129:               }
2130:             } else {
2131:               dofPerFace = dofPerEdge * dofPerEdge;
2132:               PetscMalloc1(Nc*dofPerFace,&sym);
2133:               for (j = 0, l = 0; j < dofPerEdge; j++) {
2134:                 for (k = 0; k < dofPerEdge; k++, l++) {
2135:                   switch (s) {
2136:                   case -4:
2137:                     sym[Nc*l] = CartIndex(dofPerEdge,k,j);
2138:                     break;
2139:                   case -3:
2140:                     sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - j),k);
2141:                     break;
2142:                   case -2:
2143:                     sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - k),(dofPerEdge - 1 - j));
2144:                     break;
2145:                   case -1:
2146:                     sym[Nc*l] = CartIndex(dofPerEdge,j,(dofPerEdge - 1 - k));
2147:                     break;
2148:                   case 1:
2149:                     sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - k),j);
2150:                     break;
2151:                   case 2:
2152:                     sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - j),(dofPerEdge - 1 - k));
2153:                     break;
2154:                   case 3:
2155:                     sym[Nc*l] = CartIndex(dofPerEdge,k,(dofPerEdge - 1 - j));
2156:                     break;
2157:                   }
2158:                 }
2159:               }
2160:             }
2161:             for (i = 0; i < dofPerFace; i++) {
2162:               sym[Nc*i] *= Nc;
2163:               for (j = 1; j < Nc; j++) {
2164:                 sym[Nc*i+j] = sym[Nc*i] + j;
2165:               }
2166:             }
2167:             symmetries[0][s] = sym;
2168:           }
2169:         }
2170:       }
2171:     }
2172:     PetscDualSpaceGetHeightSubspace(sp,1,&hsp);
2173:     PetscDualSpaceGetSymmetries(hsp,&hsymmetries,NULL);
2174:     if (hsymmetries) {
2175:       PetscBool      *seen;
2176:       const PetscInt *cone;
2177:       PetscInt       KclosureSize, *Kclosure = NULL;

2179:       PetscDualSpaceGetDM(sp,&K);
2180:       PetscCalloc1(numPoints,&seen);
2181:       DMPlexGetCone(K,0,&cone);
2182:       DMPlexGetTransitiveClosure(K,0,PETSC_TRUE,&KclosureSize,&Kclosure);
2183:       for (p = 0; p < numFaces; p++) {
2184:         PetscInt closureSize, *closure = NULL, q;

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

2190:           if(!seen[point]) {
2191:             for (r = 0; r < KclosureSize; r++) {
2192:               if (Kclosure[2 * r] == point) break;
2193:             }
2194:             seen[point] = PETSC_TRUE;
2195:             symmetries[r] = (PetscInt **) hsymmetries[q];
2196:           }
2197:         }
2198:         DMPlexRestoreTransitiveClosure(K,cone[p],PETSC_TRUE,&closureSize,&closure);
2199:       }
2200:       DMPlexRestoreTransitiveClosure(K,0,PETSC_TRUE,&KclosureSize,&Kclosure);
2201:       PetscFree(seen);
2202:     }
2203:     lag->symmetries = symmetries;
2204:   }
2205:   if (perms) *perms = (const PetscInt ***) lag->symmetries;
2206:   return(0);
2207: }

2209: /*@C
2210:   PetscDualSpaceGetSymmetries - Returns a description of the symmetries of this basis

2212:   Not collective

2214:   Input Parameter:
2215: . sp - the PetscDualSpace object

2217:   Output Parameters:
2218: + perms - Permutations of the local degrees of freedom, parameterized by the point orientation
2219: - flips - Sign reversal of the local degrees of freedom, parameterized by the point orientation

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

2225:   Level: developer

2227: .seealso: PetscDualSpaceSetSymmetries()
2228: @*/
2229: PetscErrorCode PetscDualSpaceGetSymmetries(PetscDualSpace sp, const PetscInt ****perms, const PetscScalar ****flips)
2230: {

2235:   if (perms) {
2237:     *perms = NULL;
2238:   }
2239:   if (flips) {
2241:     *flips = NULL;
2242:   }
2243:   if (sp->ops->getsymmetries) {
2244:     (sp->ops->getsymmetries)(sp,perms,flips);
2245:   }
2246:   return(0);
2247: }

2249: static PetscErrorCode PetscDualSpaceGetDimension_SingleCell_Lagrange(PetscDualSpace sp, PetscInt order, PetscInt *dim)
2250: {
2251:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2252:   PetscReal           D   = 1.0;
2253:   PetscInt            n, i;
2254:   PetscErrorCode      ierr;

2257:   *dim = -1;                    /* Ensure that the compiler knows *dim is set. */
2258:   DMGetDimension(sp->dm, &n);
2259:   if (!lag->tensorSpace) {
2260:     for (i = 1; i <= n; ++i) {
2261:       D *= ((PetscReal) (order+i))/i;
2262:     }
2263:     *dim = (PetscInt) (D + 0.5);
2264:   } else {
2265:     *dim = 1;
2266:     for (i = 0; i < n; ++i) *dim *= (order+1);
2267:   }
2268:   *dim *= sp->Nc;
2269:   return(0);
2270: }

2272: static PetscErrorCode PetscDualSpaceCreateHeightSubspace_Lagrange(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
2273: {
2274:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2275:   PetscBool          continuous, tensor;
2276:   PetscInt           order;
2277:   PetscErrorCode     ierr;

2282:   PetscDualSpaceLagrangeGetContinuity(sp,&continuous);
2283:   PetscDualSpaceGetOrder(sp,&order);
2284:   if (height == 0) {
2285:     PetscObjectReference((PetscObject)sp);
2286:     *bdsp = sp;
2287:   } else if (continuous == PETSC_FALSE || !order) {
2288:     *bdsp = NULL;
2289:   } else {
2290:     DM dm, K;
2291:     PetscInt dim;

2293:     PetscDualSpaceGetDM(sp,&dm);
2294:     DMGetDimension(dm,&dim);
2295:     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);}
2296:     PetscDualSpaceDuplicate(sp,bdsp);
2297:     PetscDualSpaceCreateReferenceCell(*bdsp, dim-height, lag->simplexCell, &K);
2298:     PetscDualSpaceSetDM(*bdsp, K);
2299:     DMDestroy(&K);
2300:     PetscDualSpaceLagrangeGetTensor(sp,&tensor);
2301:     PetscDualSpaceLagrangeSetTensor(*bdsp,tensor);
2302:     PetscDualSpaceSetUp(*bdsp);
2303:   }
2304:   return(0);
2305: }

2307: PetscErrorCode PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp)
2308: {
2309:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2310:   DM                  dm    = sp->dm;
2311:   PetscInt            order = sp->order;
2312:   PetscInt            Nc    = sp->Nc;
2313:   PetscBool           continuous;
2314:   PetscSection        csection;
2315:   Vec                 coordinates;
2316:   PetscReal          *qpoints, *qweights;
2317:   PetscInt            depth, dim, pdimMax, pStart, pEnd, p, *pStratStart, *pStratEnd, coneSize, d, f = 0, c;
2318:   PetscBool           simplex, tensorSpace;
2319:   PetscErrorCode      ierr;

2322:   /* Classify element type */
2323:   if (!order) lag->continuous = PETSC_FALSE;
2324:   continuous = lag->continuous;
2325:   DMGetDimension(dm, &dim);
2326:   DMPlexGetDepth(dm, &depth);
2327:   DMPlexGetChart(dm, &pStart, &pEnd);
2328:   PetscCalloc1(dim+1, &lag->numDof);
2329:   PetscMalloc2(depth+1,&pStratStart,depth+1,&pStratEnd);
2330:   for (d = 0; d <= depth; ++d) {DMPlexGetDepthStratum(dm, d, &pStratStart[d], &pStratEnd[d]);}
2331:   DMPlexGetConeSize(dm, pStratStart[depth], &coneSize);
2332:   DMGetCoordinateSection(dm, &csection);
2333:   DMGetCoordinatesLocal(dm, &coordinates);
2334:   if (depth == 1) {
2335:     if      (coneSize == dim+1)    simplex = PETSC_TRUE;
2336:     else if (coneSize == 1 << dim) simplex = PETSC_FALSE;
2337:     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
2338:   } else if (depth == dim) {
2339:     if      (coneSize == dim+1)   simplex = PETSC_TRUE;
2340:     else if (coneSize == 2 * dim) simplex = PETSC_FALSE;
2341:     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
2342:   } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support cell-vertex meshes or interpolated meshes");
2343:   lag->simplexCell = simplex;
2344:   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");
2345:   tensorSpace    = lag->tensorSpace;
2346:   lag->height    = 0;
2347:   lag->subspaces = NULL;
2348:   if (continuous && sp->order > 0 && dim > 0) {
2349:     PetscInt i;

2351:     lag->height = dim;
2352:     PetscMalloc1(dim,&lag->subspaces);
2353:     PetscDualSpaceCreateHeightSubspace_Lagrange(sp,1,&lag->subspaces[0]);
2354:     PetscDualSpaceSetUp(lag->subspaces[0]);
2355:     for (i = 1; i < dim; i++) {
2356:       PetscDualSpaceGetHeightSubspace(lag->subspaces[i-1],1,&lag->subspaces[i]);
2357:       PetscObjectReference((PetscObject)(lag->subspaces[i]));
2358:     }
2359:   }
2360:   PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, sp->order, &pdimMax);
2361:   pdimMax *= (pStratEnd[depth] - pStratStart[depth]);
2362:   PetscMalloc1(pdimMax, &sp->functional);
2363:   if (!dim) {
2364:     for (c = 0; c < Nc; ++c) {
2365:       PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2366:       PetscCalloc1(Nc, &qweights);
2367:       PetscQuadratureSetOrder(sp->functional[f], 0);
2368:       PetscQuadratureSetData(sp->functional[f], 0, Nc, 1, NULL, qweights);
2369:       qweights[c] = 1.0;
2370:       ++f;
2371:       lag->numDof[0]++;
2372:     }
2373:   } else {
2374:     PetscInt     *tup;
2375:     PetscReal    *v0, *hv0, *J, *invJ, detJ, hdetJ;
2376:     PetscSection section;

2378:     PetscSectionCreate(PETSC_COMM_SELF,&section);
2379:     PetscSectionSetChart(section,pStart,pEnd);
2380:     PetscCalloc5(dim+1,&tup,dim,&v0,dim,&hv0,dim*dim,&J,dim*dim,&invJ);
2381:     for (p = pStart; p < pEnd; p++) {
2382:       PetscInt       pointDim, d, nFunc = 0;
2383:       PetscDualSpace hsp;

2385:       DMPlexComputeCellGeometryFEM(dm, p, NULL, v0, J, invJ, &detJ);
2386:       for (d = 0; d < depth; d++) {if (p >= pStratStart[d] && p < pStratEnd[d]) break;}
2387:       pointDim = (depth == 1 && d == 1) ? dim : d;
2388:       hsp = ((pointDim < dim) && lag->subspaces) ? lag->subspaces[dim - pointDim - 1] : NULL;
2389:       if (hsp) {
2390:         PetscDualSpace_Lag *hlag = (PetscDualSpace_Lag *) hsp->data;
2391:         DM                 hdm;

2393:         PetscDualSpaceGetDM(hsp,&hdm);
2394:         DMPlexComputeCellGeometryFEM(hdm, 0, NULL, hv0, NULL, NULL, &hdetJ);
2395:         nFunc = lag->numDof[pointDim] = hlag->numDof[pointDim];
2396:       }
2397:       if (pointDim == dim) {
2398:         /* Cells, create for self */
2399:         PetscInt     orderEff = continuous ? (!tensorSpace ? order-1-dim : order-2) : order;
2400:         PetscReal    denom    = continuous ? order : (!tensorSpace ? order+1+dim : order+2);
2401:         PetscReal    numer    = (!simplex || !tensorSpace) ? 2. : (2./dim);
2402:         PetscReal    dx = numer/denom;
2403:         PetscInt     cdim, d, d2;

2405:         if (orderEff < 0) continue;
2406:         PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, orderEff, &cdim);
2407:         PetscMemzero(tup,(dim+1)*sizeof(PetscInt));
2408:         if (!tensorSpace) {
2409:           while (!tup[dim]) {
2410:             for (c = 0; c < Nc; ++c) {
2411:               PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2412:               PetscMalloc1(dim, &qpoints);
2413:               PetscCalloc1(Nc,  &qweights);
2414:               PetscQuadratureSetOrder(sp->functional[f], 0);
2415:               PetscQuadratureSetData(sp->functional[f], dim, Nc, 1, qpoints, qweights);
2416:               for (d = 0; d < dim; ++d) {
2417:                 qpoints[d] = v0[d];
2418:                 for (d2 = 0; d2 < dim; ++d2) qpoints[d] += J[d*dim+d2]*((tup[d2]+1)*dx);
2419:               }
2420:               qweights[c] = 1.0;
2421:               ++f;
2422:             }
2423:             LatticePointLexicographic_Internal(dim, orderEff, tup);
2424:           }
2425:         } else {
2426:           while (!tup[dim]) {
2427:             for (c = 0; c < Nc; ++c) {
2428:               PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2429:               PetscMalloc1(dim, &qpoints);
2430:               PetscCalloc1(Nc,  &qweights);
2431:               PetscQuadratureSetOrder(sp->functional[f], 0);
2432:               PetscQuadratureSetData(sp->functional[f], dim, Nc, 1, qpoints, qweights);
2433:               for (d = 0; d < dim; ++d) {
2434:                 qpoints[d] = v0[d];
2435:                 for (d2 = 0; d2 < dim; ++d2) qpoints[d] += J[d*dim+d2]*((tup[d2]+1)*dx);
2436:               }
2437:               qweights[c] = 1.0;
2438:               ++f;
2439:             }
2440:             TensorPointLexicographic_Internal(dim, orderEff, tup);
2441:           }
2442:         }
2443:         lag->numDof[dim] = cdim;
2444:       } else { /* transform functionals from subspaces */
2445:         PetscInt q;

2447:         for (q = 0; q < nFunc; q++, f++) {
2448:           PetscQuadrature fn;
2449:           PetscInt        fdim, Nc, c, nPoints, i;
2450:           const PetscReal *points;
2451:           const PetscReal *weights;
2452:           PetscReal       *qpoints;
2453:           PetscReal       *qweights;

2455:           PetscDualSpaceGetFunctional(hsp, q, &fn);
2456:           PetscQuadratureGetData(fn,&fdim,&Nc,&nPoints,&points,&weights);
2457:           if (fdim != pointDim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expected height dual space dim %D, got %D",pointDim,fdim);
2458:           PetscMalloc1(nPoints * dim, &qpoints);
2459:           PetscCalloc1(nPoints * Nc,  &qweights);
2460:           for (i = 0; i < nPoints; i++) {
2461:             PetscInt  j, k;
2462:             PetscReal *qp = &qpoints[i * dim];

2464:             for (c = 0; c < Nc; ++c) qweights[i*Nc+c] = weights[i*Nc+c];
2465:             for (j = 0; j < dim; ++j) qp[j] = v0[j];
2466:             for (j = 0; j < dim; ++j) {
2467:               for (k = 0; k < pointDim; k++) qp[j] += J[dim * j + k] * (points[pointDim * i + k] - hv0[k]);
2468:             }
2469:           }
2470:           PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2471:           PetscQuadratureSetOrder(sp->functional[f],0);
2472:           PetscQuadratureSetData(sp->functional[f],dim,Nc,nPoints,qpoints,qweights);
2473:         }
2474:       }
2475:       PetscSectionSetDof(section,p,lag->numDof[pointDim]);
2476:     }
2477:     PetscFree5(tup,v0,hv0,J,invJ);
2478:     PetscSectionSetUp(section);
2479:     { /* reorder to closure order */
2480:       PetscInt *key, count;
2481:       PetscQuadrature *reorder = NULL;

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

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

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

2493:           PetscSectionGetDof(section,point,&dof);
2494:           PetscSectionGetOffset(section,point,&off);
2495:           for (i = 0; i < dof; i++) {
2496:             PetscInt fi = i + off;
2497:             if (!key[fi]) {
2498:               key[fi] = 1;
2499:               reorder[count++] = sp->functional[fi];
2500:             }
2501:           }
2502:         }
2503:         DMPlexRestoreTransitiveClosure(dm,p,PETSC_TRUE,&closureSize,&closure);
2504:       }
2505:       PetscFree(sp->functional);
2506:       sp->functional = reorder;
2507:       PetscFree(key);
2508:     }
2509:     PetscSectionDestroy(&section);
2510:   }
2511:   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);
2512:   PetscFree2(pStratStart, pStratEnd);
2513:   if (f > pdimMax) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of dual basis vectors %d is greater than dimension %d", f, pdimMax);
2514:   return(0);
2515: }

2517: PetscErrorCode PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp)
2518: {
2519:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2520:   PetscInt            i;
2521:   PetscErrorCode      ierr;

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

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

2530:       for (i = 0; i < lag->numSelfSym; i++) {
2531:         PetscFree(allocated[i]);
2532:       }
2533:       PetscFree(allocated);
2534:     }
2535:     PetscFree(lag->symmetries);
2536:   }
2537:   for (i = 0; i < lag->height; i++) {
2538:     PetscDualSpaceDestroy(&lag->subspaces[i]);
2539:   }
2540:   PetscFree(lag->subspaces);
2541:   PetscFree(lag->numDof);
2542:   PetscFree(lag);
2543:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", NULL);
2544:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", NULL);
2545:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", NULL);
2546:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", NULL);
2547:   return(0);
2548: }

2550: PetscErrorCode PetscDualSpaceDuplicate_Lagrange(PetscDualSpace sp, PetscDualSpace *spNew)
2551: {
2552:   PetscInt       order, Nc;
2553:   PetscBool      cont, tensor;

2557:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) sp), spNew);
2558:   PetscDualSpaceSetType(*spNew, PETSCDUALSPACELAGRANGE);
2559:   PetscDualSpaceGetOrder(sp, &order);
2560:   PetscDualSpaceSetOrder(*spNew, order);
2561:   PetscDualSpaceGetNumComponents(sp, &Nc);
2562:   PetscDualSpaceSetNumComponents(*spNew, Nc);
2563:   PetscDualSpaceLagrangeGetContinuity(sp, &cont);
2564:   PetscDualSpaceLagrangeSetContinuity(*spNew, cont);
2565:   PetscDualSpaceLagrangeGetTensor(sp, &tensor);
2566:   PetscDualSpaceLagrangeSetTensor(*spNew, tensor);
2567:   return(0);
2568: }

2570: PetscErrorCode PetscDualSpaceSetFromOptions_Lagrange(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp)
2571: {
2572:   PetscBool      continuous, tensor, flg;

2576:   PetscDualSpaceLagrangeGetContinuity(sp, &continuous);
2577:   PetscDualSpaceLagrangeGetTensor(sp, &tensor);
2578:   PetscOptionsHead(PetscOptionsObject,"PetscDualSpace Lagrange Options");
2579:   PetscOptionsBool("-petscdualspace_lagrange_continuity", "Flag for continuous element", "PetscDualSpaceLagrangeSetContinuity", continuous, &continuous, &flg);
2580:   if (flg) {PetscDualSpaceLagrangeSetContinuity(sp, continuous);}
2581:   PetscOptionsBool("-petscdualspace_lagrange_tensor", "Flag for tensor dual space", "PetscDualSpaceLagrangeSetContinuity", tensor, &tensor, &flg);
2582:   if (flg) {PetscDualSpaceLagrangeSetTensor(sp, tensor);}
2583:   PetscOptionsTail();
2584:   return(0);
2585: }

2587: PetscErrorCode PetscDualSpaceGetDimension_Lagrange(PetscDualSpace sp, PetscInt *dim)
2588: {
2589:   DM              K;
2590:   const PetscInt *numDof;
2591:   PetscInt        spatialDim, Nc, size = 0, d;
2592:   PetscErrorCode  ierr;

2595:   PetscDualSpaceGetDM(sp, &K);
2596:   PetscDualSpaceGetNumDof(sp, &numDof);
2597:   DMGetDimension(K, &spatialDim);
2598:   DMPlexGetHeightStratum(K, 0, NULL, &Nc);
2599:   if (Nc == 1) {PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, sp->order, dim); return(0);}
2600:   for (d = 0; d <= spatialDim; ++d) {
2601:     PetscInt pStart, pEnd;

2603:     DMPlexGetDepthStratum(K, d, &pStart, &pEnd);
2604:     size += (pEnd-pStart)*numDof[d];
2605:   }
2606:   *dim = size;
2607:   return(0);
2608: }

2610: PetscErrorCode PetscDualSpaceGetNumDof_Lagrange(PetscDualSpace sp, const PetscInt **numDof)
2611: {
2612:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

2615:   *numDof = lag->numDof;
2616:   return(0);
2617: }

2619: static PetscErrorCode PetscDualSpaceLagrangeGetContinuity_Lagrange(PetscDualSpace sp, PetscBool *continuous)
2620: {
2621:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

2626:   *continuous = lag->continuous;
2627:   return(0);
2628: }

2630: static PetscErrorCode PetscDualSpaceLagrangeSetContinuity_Lagrange(PetscDualSpace sp, PetscBool continuous)
2631: {
2632:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

2636:   lag->continuous = continuous;
2637:   return(0);
2638: }

2640: /*@
2641:   PetscDualSpaceLagrangeGetContinuity - Retrieves the flag for element continuity

2643:   Not Collective

2645:   Input Parameter:
2646: . sp         - the PetscDualSpace

2648:   Output Parameter:
2649: . continuous - flag for element continuity

2651:   Level: intermediate

2653: .keywords: PetscDualSpace, Lagrange, continuous, discontinuous
2654: .seealso: PetscDualSpaceLagrangeSetContinuity()
2655: @*/
2656: PetscErrorCode PetscDualSpaceLagrangeGetContinuity(PetscDualSpace sp, PetscBool *continuous)
2657: {

2663:   PetscTryMethod(sp, "PetscDualSpaceLagrangeGetContinuity_C", (PetscDualSpace,PetscBool*),(sp,continuous));
2664:   return(0);
2665: }

2667: /*@
2668:   PetscDualSpaceLagrangeSetContinuity - Indicate whether the element is continuous

2670:   Logically Collective on PetscDualSpace

2672:   Input Parameters:
2673: + sp         - the PetscDualSpace
2674: - continuous - flag for element continuity

2676:   Options Database:
2677: . -petscdualspace_lagrange_continuity <bool>

2679:   Level: intermediate

2681: .keywords: PetscDualSpace, Lagrange, continuous, discontinuous
2682: .seealso: PetscDualSpaceLagrangeGetContinuity()
2683: @*/
2684: PetscErrorCode PetscDualSpaceLagrangeSetContinuity(PetscDualSpace sp, PetscBool continuous)
2685: {

2691:   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetContinuity_C", (PetscDualSpace,PetscBool),(sp,continuous));
2692:   return(0);
2693: }

2695: PetscErrorCode PetscDualSpaceGetHeightSubspace_Lagrange(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
2696: {
2697:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2698:   PetscErrorCode     ierr;

2703:   if (height == 0) {
2704:     *bdsp = sp;
2705:   }
2706:   else {
2707:     DM dm;
2708:     PetscInt dim;

2710:     PetscDualSpaceGetDM(sp,&dm);
2711:     DMGetDimension(dm,&dim);
2712:     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);}
2713:     if (height <= lag->height) {
2714:       *bdsp = lag->subspaces[height-1];
2715:     }
2716:     else {
2717:       *bdsp = NULL;
2718:     }
2719:   }
2720:   return(0);
2721: }

2723: PetscErrorCode PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp)
2724: {
2726:   sp->ops->setfromoptions    = PetscDualSpaceSetFromOptions_Lagrange;
2727:   sp->ops->setup             = PetscDualSpaceSetUp_Lagrange;
2728:   sp->ops->view              = NULL;
2729:   sp->ops->destroy           = PetscDualSpaceDestroy_Lagrange;
2730:   sp->ops->duplicate         = PetscDualSpaceDuplicate_Lagrange;
2731:   sp->ops->getdimension      = PetscDualSpaceGetDimension_Lagrange;
2732:   sp->ops->getnumdof         = PetscDualSpaceGetNumDof_Lagrange;
2733:   sp->ops->getheightsubspace = PetscDualSpaceGetHeightSubspace_Lagrange;
2734:   sp->ops->getsymmetries     = PetscDualSpaceGetSymmetries_Lagrange;
2735:   sp->ops->apply             = PetscDualSpaceApplyDefault;
2736:   return(0);
2737: }

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

2742:   Level: intermediate

2744: .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
2745: M*/

2747: PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Lagrange(PetscDualSpace sp)
2748: {
2749:   PetscDualSpace_Lag *lag;
2750:   PetscErrorCode      ierr;

2754:   PetscNewLog(sp,&lag);
2755:   sp->data = lag;

2757:   lag->numDof      = NULL;
2758:   lag->simplexCell = PETSC_TRUE;
2759:   lag->tensorSpace = PETSC_FALSE;
2760:   lag->continuous  = PETSC_TRUE;

2762:   PetscDualSpaceInitialize_Lagrange(sp);
2763:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", PetscDualSpaceLagrangeGetContinuity_Lagrange);
2764:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", PetscDualSpaceLagrangeSetContinuity_Lagrange);
2765:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", PetscDualSpaceLagrangeGetTensor_Lagrange);
2766:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", PetscDualSpaceLagrangeSetTensor_Lagrange);
2767:   return(0);
2768: }

2770: PetscErrorCode PetscDualSpaceSetUp_Simple(PetscDualSpace sp)
2771: {
2772:   PetscDualSpace_Simple *s  = (PetscDualSpace_Simple *) sp->data;
2773:   DM                     dm = sp->dm;
2774:   PetscInt               dim;
2775:   PetscErrorCode         ierr;

2778:   DMGetDimension(dm, &dim);
2779:   PetscCalloc1(dim+1, &s->numDof);
2780:   return(0);
2781: }

2783: PetscErrorCode PetscDualSpaceDestroy_Simple(PetscDualSpace sp)
2784: {
2785:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2786:   PetscErrorCode         ierr;

2789:   PetscFree(s->numDof);
2790:   PetscFree(s);
2791:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetDimension_C", NULL);
2792:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetFunctional_C", NULL);
2793:   return(0);
2794: }

2796: PetscErrorCode PetscDualSpaceDuplicate_Simple(PetscDualSpace sp, PetscDualSpace *spNew)
2797: {
2798:   PetscInt       dim, d, Nc;

2802:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) sp), spNew);
2803:   PetscDualSpaceSetType(*spNew, PETSCDUALSPACESIMPLE);
2804:   PetscDualSpaceGetNumComponents(sp, &Nc);
2805:   PetscDualSpaceSetNumComponents(sp, Nc);
2806:   PetscDualSpaceGetDimension(sp, &dim);
2807:   PetscDualSpaceSimpleSetDimension(*spNew, dim);
2808:   for (d = 0; d < dim; ++d) {
2809:     PetscQuadrature q;

2811:     PetscDualSpaceGetFunctional(sp, d, &q);
2812:     PetscDualSpaceSimpleSetFunctional(*spNew, d, q);
2813:   }
2814:   return(0);
2815: }

2817: PetscErrorCode PetscDualSpaceSetFromOptions_Simple(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp)
2818: {
2820:   return(0);
2821: }

2823: PetscErrorCode PetscDualSpaceGetDimension_Simple(PetscDualSpace sp, PetscInt *dim)
2824: {
2825:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;

2828:   *dim = s->dim;
2829:   return(0);
2830: }

2832: PetscErrorCode PetscDualSpaceSimpleSetDimension_Simple(PetscDualSpace sp, const PetscInt dim)
2833: {
2834:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2835:   DM                     dm;
2836:   PetscInt               spatialDim, f;
2837:   PetscErrorCode         ierr;

2840:   for (f = 0; f < s->dim; ++f) {PetscQuadratureDestroy(&sp->functional[f]);}
2841:   PetscFree(sp->functional);
2842:   s->dim = dim;
2843:   PetscCalloc1(s->dim, &sp->functional);
2844:   PetscFree(s->numDof);
2845:   PetscDualSpaceGetDM(sp, &dm);
2846:   DMGetCoordinateDim(dm, &spatialDim);
2847:   PetscCalloc1(spatialDim+1, &s->numDof);
2848:   s->numDof[spatialDim] = dim;
2849:   return(0);
2850: }

2852: PetscErrorCode PetscDualSpaceGetNumDof_Simple(PetscDualSpace sp, const PetscInt **numDof)
2853: {
2854:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;

2857:   *numDof = s->numDof;
2858:   return(0);
2859: }

2861: PetscErrorCode PetscDualSpaceSimpleSetFunctional_Simple(PetscDualSpace sp, PetscInt f, PetscQuadrature q)
2862: {
2863:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2864:   PetscReal             *weights;
2865:   PetscInt               Nc, c, Nq, p;
2866:   PetscErrorCode         ierr;

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

2876:     for (p = 0; p < Nq; ++p) vol += weights[p*Nc+c];
2877:     for (p = 0; p < Nq; ++p) weights[p*Nc+c] /= (vol == 0.0 ? 1.0 : vol);
2878:   }
2879:   return(0);
2880: }

2882: /*@
2883:   PetscDualSpaceSimpleSetDimension - Set the number of functionals in the dual space basis

2885:   Logically Collective on PetscDualSpace

2887:   Input Parameters:
2888: + sp  - the PetscDualSpace
2889: - dim - the basis dimension

2891:   Level: intermediate

2893: .keywords: PetscDualSpace, dimension
2894: .seealso: PetscDualSpaceSimpleSetFunctional()
2895: @*/
2896: PetscErrorCode PetscDualSpaceSimpleSetDimension(PetscDualSpace sp, PetscInt dim)
2897: {

2903:   PetscTryMethod(sp, "PetscDualSpaceSimpleSetDimension_C", (PetscDualSpace,PetscInt),(sp,dim));
2904:   return(0);
2905: }

2907: /*@
2908:   PetscDualSpaceSimpleSetFunctional - Set the given basis element for this dual space

2910:   Not Collective

2912:   Input Parameters:
2913: + sp  - the PetscDualSpace
2914: . f - the basis index
2915: - q - the basis functional

2917:   Level: intermediate

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

2921: .keywords: PetscDualSpace, functional
2922: .seealso: PetscDualSpaceSimpleSetDimension()
2923: @*/
2924: PetscErrorCode PetscDualSpaceSimpleSetFunctional(PetscDualSpace sp, PetscInt func, PetscQuadrature q)
2925: {

2930:   PetscTryMethod(sp, "PetscDualSpaceSimpleSetFunctional_C", (PetscDualSpace,PetscInt,PetscQuadrature),(sp,func,q));
2931:   return(0);
2932: }

2934: PetscErrorCode PetscDualSpaceInitialize_Simple(PetscDualSpace sp)
2935: {
2937:   sp->ops->setfromoptions    = PetscDualSpaceSetFromOptions_Simple;
2938:   sp->ops->setup             = PetscDualSpaceSetUp_Simple;
2939:   sp->ops->view              = NULL;
2940:   sp->ops->destroy           = PetscDualSpaceDestroy_Simple;
2941:   sp->ops->duplicate         = PetscDualSpaceDuplicate_Simple;
2942:   sp->ops->getdimension      = PetscDualSpaceGetDimension_Simple;
2943:   sp->ops->getnumdof         = PetscDualSpaceGetNumDof_Simple;
2944:   sp->ops->getheightsubspace = NULL;
2945:   sp->ops->getsymmetries     = NULL;
2946:   sp->ops->apply             = PetscDualSpaceApplyDefault;
2947:   return(0);
2948: }

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

2953:   Level: intermediate

2955: .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
2956: M*/

2958: PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Simple(PetscDualSpace sp)
2959: {
2960:   PetscDualSpace_Simple *s;
2961:   PetscErrorCode         ierr;

2965:   PetscNewLog(sp,&s);
2966:   sp->data = s;

2968:   s->dim    = 0;
2969:   s->numDof = NULL;

2971:   PetscDualSpaceInitialize_Simple(sp);
2972:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetDimension_C", PetscDualSpaceSimpleSetDimension_Simple);
2973:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetFunctional_C", PetscDualSpaceSimpleSetFunctional_Simple);
2974:   return(0);
2975: }


2978: PetscClassId PETSCFE_CLASSID = 0;

2980: PetscFunctionList PetscFEList              = NULL;
2981: PetscBool         PetscFERegisterAllCalled = PETSC_FALSE;

2983: /*@C
2984:   PetscFERegister - Adds a new PetscFE implementation

2986:   Not Collective

2988:   Input Parameters:
2989: + name        - The name of a new user-defined creation routine
2990: - create_func - The creation routine itself

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

2995:   Sample usage:
2996: .vb
2997:     PetscFERegister("my_fe", MyPetscFECreate);
2998: .ve

3000:   Then, your PetscFE type can be chosen with the procedural interface via
3001: .vb
3002:     PetscFECreate(MPI_Comm, PetscFE *);
3003:     PetscFESetType(PetscFE, "my_fe");
3004: .ve
3005:    or at runtime via the option
3006: .vb
3007:     -petscfe_type my_fe
3008: .ve

3010:   Level: advanced

3012: .keywords: PetscFE, register
3013: .seealso: PetscFERegisterAll(), PetscFERegisterDestroy()

3015: @*/
3016: PetscErrorCode PetscFERegister(const char sname[], PetscErrorCode (*function)(PetscFE))
3017: {

3021:   PetscFunctionListAdd(&PetscFEList, sname, function);
3022:   return(0);
3023: }

3025: /*@C
3026:   PetscFESetType - Builds a particular PetscFE

3028:   Collective on PetscFE

3030:   Input Parameters:
3031: + fem  - The PetscFE object
3032: - name - The kind of FEM space

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

3037:   Level: intermediate

3039: .keywords: PetscFE, set, type
3040: .seealso: PetscFEGetType(), PetscFECreate()
3041: @*/
3042: PetscErrorCode PetscFESetType(PetscFE fem, PetscFEType name)
3043: {
3044:   PetscErrorCode (*r)(PetscFE);
3045:   PetscBool      match;

3050:   PetscObjectTypeCompare((PetscObject) fem, name, &match);
3051:   if (match) return(0);

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

3057:   if (fem->ops->destroy) {
3058:     (*fem->ops->destroy)(fem);
3059:     fem->ops->destroy = NULL;
3060:   }
3061:   (*r)(fem);
3062:   PetscObjectChangeTypeName((PetscObject) fem, name);
3063:   return(0);
3064: }

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

3069:   Not Collective

3071:   Input Parameter:
3072: . fem  - The PetscFE

3074:   Output Parameter:
3075: . name - The PetscFE type name

3077:   Level: intermediate

3079: .keywords: PetscFE, get, type, name
3080: .seealso: PetscFESetType(), PetscFECreate()
3081: @*/
3082: PetscErrorCode PetscFEGetType(PetscFE fem, PetscFEType *name)
3083: {

3089:   if (!PetscFERegisterAllCalled) {
3090:     PetscFERegisterAll();
3091:   }
3092:   *name = ((PetscObject) fem)->type_name;
3093:   return(0);
3094: }

3096: /*@C
3097:   PetscFEView - Views a PetscFE

3099:   Collective on PetscFE

3101:   Input Parameter:
3102: + fem - the PetscFE object to view
3103: - v   - the viewer

3105:   Level: developer

3107: .seealso PetscFEDestroy()
3108: @*/
3109: PetscErrorCode PetscFEView(PetscFE fem, PetscViewer v)
3110: {

3115:   if (!v) {
3116:     PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) fem), &v);
3117:   }
3118:   if (fem->ops->view) {
3119:     (*fem->ops->view)(fem, v);
3120:   }
3121:   return(0);
3122: }

3124: /*@
3125:   PetscFESetFromOptions - sets parameters in a PetscFE from the options database

3127:   Collective on PetscFE

3129:   Input Parameter:
3130: . fem - the PetscFE object to set options for

3132:   Options Database:
3133: . -petscfe_num_blocks  the number of cell blocks to integrate concurrently
3134: . -petscfe_num_batches the number of cell batches to integrate serially

3136:   Level: developer

3138: .seealso PetscFEView()
3139: @*/
3140: PetscErrorCode PetscFESetFromOptions(PetscFE fem)
3141: {
3142:   const char    *defaultType;
3143:   char           name[256];
3144:   PetscBool      flg;

3149:   if (!((PetscObject) fem)->type_name) {
3150:     defaultType = PETSCFEBASIC;
3151:   } else {
3152:     defaultType = ((PetscObject) fem)->type_name;
3153:   }
3154:   if (!PetscFERegisterAllCalled) {PetscFERegisterAll();}

3156:   PetscObjectOptionsBegin((PetscObject) fem);
3157:   PetscOptionsFList("-petscfe_type", "Finite element space", "PetscFESetType", PetscFEList, defaultType, name, 256, &flg);
3158:   if (flg) {
3159:     PetscFESetType(fem, name);
3160:   } else if (!((PetscObject) fem)->type_name) {
3161:     PetscFESetType(fem, defaultType);
3162:   }
3163:   PetscOptionsInt("-petscfe_num_blocks", "The number of cell blocks to integrate concurrently", "PetscSpaceSetTileSizes", fem->numBlocks, &fem->numBlocks, NULL);
3164:   PetscOptionsInt("-petscfe_num_batches", "The number of cell batches to integrate serially", "PetscSpaceSetTileSizes", fem->numBatches, &fem->numBatches, NULL);
3165:   if (fem->ops->setfromoptions) {
3166:     (*fem->ops->setfromoptions)(PetscOptionsObject,fem);
3167:   }
3168:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
3169:   PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) fem);
3170:   PetscOptionsEnd();
3171:   PetscFEViewFromOptions(fem, NULL, "-petscfe_view");
3172:   return(0);
3173: }

3175: /*@C
3176:   PetscFESetUp - Construct data structures for the PetscFE

3178:   Collective on PetscFE

3180:   Input Parameter:
3181: . fem - the PetscFE object to setup

3183:   Level: developer

3185: .seealso PetscFEView(), PetscFEDestroy()
3186: @*/
3187: PetscErrorCode PetscFESetUp(PetscFE fem)
3188: {

3193:   if (fem->ops->setup) {(*fem->ops->setup)(fem);}
3194:   return(0);
3195: }

3197: /*@
3198:   PetscFEDestroy - Destroys a PetscFE object

3200:   Collective on PetscFE

3202:   Input Parameter:
3203: . fem - the PetscFE object to destroy

3205:   Level: developer

3207: .seealso PetscFEView()
3208: @*/
3209: PetscErrorCode PetscFEDestroy(PetscFE *fem)
3210: {

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

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

3220:   PetscFree((*fem)->invV);
3221:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->B, &(*fem)->D, NULL /*&(*fem)->H*/);
3222:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->Bf, &(*fem)->Df, NULL /*&(*fem)->Hf*/);
3223:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->F, NULL, NULL);
3224:   PetscSpaceDestroy(&(*fem)->basisSpace);
3225:   PetscDualSpaceDestroy(&(*fem)->dualSpace);
3226:   PetscQuadratureDestroy(&(*fem)->quadrature);
3227:   PetscQuadratureDestroy(&(*fem)->faceQuadrature);

3229:   if ((*fem)->ops->destroy) {(*(*fem)->ops->destroy)(*fem);}
3230:   PetscHeaderDestroy(fem);
3231:   return(0);
3232: }

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

3237:   Collective on MPI_Comm

3239:   Input Parameter:
3240: . comm - The communicator for the PetscFE object

3242:   Output Parameter:
3243: . fem - The PetscFE object

3245:   Level: beginner

3247: .seealso: PetscFESetType(), PETSCFEGALERKIN
3248: @*/
3249: PetscErrorCode PetscFECreate(MPI_Comm comm, PetscFE *fem)
3250: {
3251:   PetscFE        f;

3256:   PetscCitationsRegister(FECitation,&FEcite);
3257:   *fem = NULL;
3258:   PetscFEInitializePackage();

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

3262:   f->basisSpace    = NULL;
3263:   f->dualSpace     = NULL;
3264:   f->numComponents = 1;
3265:   f->invV          = NULL;
3266:   f->B             = NULL;
3267:   f->D             = NULL;
3268:   f->H             = NULL;
3269:   f->Bf            = NULL;
3270:   f->Df            = NULL;
3271:   f->Hf            = NULL;
3272:   PetscMemzero(&f->quadrature, sizeof(PetscQuadrature));
3273:   PetscMemzero(&f->faceQuadrature, sizeof(PetscQuadrature));
3274:   f->blockSize     = 0;
3275:   f->numBlocks     = 1;
3276:   f->batchSize     = 0;
3277:   f->numBatches    = 1;

3279:   *fem = f;
3280:   return(0);
3281: }

3283: /*@
3284:   PetscFEGetSpatialDimension - Returns the spatial dimension of the element

3286:   Not collective

3288:   Input Parameter:
3289: . fem - The PetscFE object

3291:   Output Parameter:
3292: . dim - The spatial dimension

3294:   Level: intermediate

3296: .seealso: PetscFECreate()
3297: @*/
3298: PetscErrorCode PetscFEGetSpatialDimension(PetscFE fem, PetscInt *dim)
3299: {
3300:   DM             dm;

3306:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
3307:   DMGetDimension(dm, dim);
3308:   return(0);
3309: }

3311: /*@
3312:   PetscFESetNumComponents - Sets the number of components in the element

3314:   Not collective

3316:   Input Parameters:
3317: + fem - The PetscFE object
3318: - comp - The number of field components

3320:   Level: intermediate

3322: .seealso: PetscFECreate()
3323: @*/
3324: PetscErrorCode PetscFESetNumComponents(PetscFE fem, PetscInt comp)
3325: {
3328:   fem->numComponents = comp;
3329:   return(0);
3330: }

3332: /*@
3333:   PetscFEGetNumComponents - Returns the number of components in the element

3335:   Not collective

3337:   Input Parameter:
3338: . fem - The PetscFE object

3340:   Output Parameter:
3341: . comp - The number of field components

3343:   Level: intermediate

3345: .seealso: PetscFECreate()
3346: @*/
3347: PetscErrorCode PetscFEGetNumComponents(PetscFE fem, PetscInt *comp)
3348: {
3352:   *comp = fem->numComponents;
3353:   return(0);
3354: }

3356: /*@
3357:   PetscFESetTileSizes - Sets the tile sizes for evaluation

3359:   Not collective

3361:   Input Parameters:
3362: + fem - The PetscFE object
3363: . blockSize - The number of elements in a block
3364: . numBlocks - The number of blocks in a batch
3365: . batchSize - The number of elements in a batch
3366: - numBatches - The number of batches in a chunk

3368:   Level: intermediate

3370: .seealso: PetscFECreate()
3371: @*/
3372: PetscErrorCode PetscFESetTileSizes(PetscFE fem, PetscInt blockSize, PetscInt numBlocks, PetscInt batchSize, PetscInt numBatches)
3373: {
3376:   fem->blockSize  = blockSize;
3377:   fem->numBlocks  = numBlocks;
3378:   fem->batchSize  = batchSize;
3379:   fem->numBatches = numBatches;
3380:   return(0);
3381: }

3383: /*@
3384:   PetscFEGetTileSizes - Returns the tile sizes for evaluation

3386:   Not collective

3388:   Input Parameter:
3389: . fem - The PetscFE object

3391:   Output Parameters:
3392: + blockSize - The number of elements in a block
3393: . numBlocks - The number of blocks in a batch
3394: . batchSize - The number of elements in a batch
3395: - numBatches - The number of batches in a chunk

3397:   Level: intermediate

3399: .seealso: PetscFECreate()
3400: @*/
3401: PetscErrorCode PetscFEGetTileSizes(PetscFE fem, PetscInt *blockSize, PetscInt *numBlocks, PetscInt *batchSize, PetscInt *numBatches)
3402: {
3409:   if (blockSize)  *blockSize  = fem->blockSize;
3410:   if (numBlocks)  *numBlocks  = fem->numBlocks;
3411:   if (batchSize)  *batchSize  = fem->batchSize;
3412:   if (numBatches) *numBatches = fem->numBatches;
3413:   return(0);
3414: }

3416: /*@
3417:   PetscFEGetBasisSpace - Returns the PetscSpace used for approximation of the solution

3419:   Not collective

3421:   Input Parameter:
3422: . fem - The PetscFE object

3424:   Output Parameter:
3425: . sp - The PetscSpace object

3427:   Level: intermediate

3429: .seealso: PetscFECreate()
3430: @*/
3431: PetscErrorCode PetscFEGetBasisSpace(PetscFE fem, PetscSpace *sp)
3432: {
3436:   *sp = fem->basisSpace;
3437:   return(0);
3438: }

3440: /*@
3441:   PetscFESetBasisSpace - Sets the PetscSpace used for approximation of the solution

3443:   Not collective

3445:   Input Parameters:
3446: + fem - The PetscFE object
3447: - sp - The PetscSpace object

3449:   Level: intermediate

3451: .seealso: PetscFECreate()
3452: @*/
3453: PetscErrorCode PetscFESetBasisSpace(PetscFE fem, PetscSpace sp)
3454: {

3460:   PetscSpaceDestroy(&fem->basisSpace);
3461:   fem->basisSpace = sp;
3462:   PetscObjectReference((PetscObject) fem->basisSpace);
3463:   return(0);
3464: }

3466: /*@
3467:   PetscFEGetDualSpace - Returns the PetscDualSpace used to define the inner product

3469:   Not collective

3471:   Input Parameter:
3472: . fem - The PetscFE object

3474:   Output Parameter:
3475: . sp - The PetscDualSpace object

3477:   Level: intermediate

3479: .seealso: PetscFECreate()
3480: @*/
3481: PetscErrorCode PetscFEGetDualSpace(PetscFE fem, PetscDualSpace *sp)
3482: {
3486:   *sp = fem->dualSpace;
3487:   return(0);
3488: }

3490: /*@
3491:   PetscFESetDualSpace - Sets the PetscDualSpace used to define the inner product

3493:   Not collective

3495:   Input Parameters:
3496: + fem - The PetscFE object
3497: - sp - The PetscDualSpace object

3499:   Level: intermediate

3501: .seealso: PetscFECreate()
3502: @*/
3503: PetscErrorCode PetscFESetDualSpace(PetscFE fem, PetscDualSpace sp)
3504: {

3510:   PetscDualSpaceDestroy(&fem->dualSpace);
3511:   fem->dualSpace = sp;
3512:   PetscObjectReference((PetscObject) fem->dualSpace);
3513:   return(0);
3514: }

3516: /*@
3517:   PetscFEGetQuadrature - Returns the PetscQuadrature used to calculate inner products

3519:   Not collective

3521:   Input Parameter:
3522: . fem - The PetscFE object

3524:   Output Parameter:
3525: . q - The PetscQuadrature object

3527:   Level: intermediate

3529: .seealso: PetscFECreate()
3530: @*/
3531: PetscErrorCode PetscFEGetQuadrature(PetscFE fem, PetscQuadrature *q)
3532: {
3536:   *q = fem->quadrature;
3537:   return(0);
3538: }

3540: /*@
3541:   PetscFESetQuadrature - Sets the PetscQuadrature used to calculate inner products

3543:   Not collective

3545:   Input Parameters:
3546: + fem - The PetscFE object
3547: - q - The PetscQuadrature object

3549:   Level: intermediate

3551: .seealso: PetscFECreate()
3552: @*/
3553: PetscErrorCode PetscFESetQuadrature(PetscFE fem, PetscQuadrature q)
3554: {
3555:   PetscInt       Nc, qNc;

3560:   PetscFEGetNumComponents(fem, &Nc);
3561:   PetscQuadratureGetNumComponents(q, &qNc);
3562:   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);
3563:   PetscFERestoreTabulation(fem, 0, NULL, &fem->B, &fem->D, NULL /*&(*fem)->H*/);
3564:   PetscQuadratureDestroy(&fem->quadrature);
3565:   fem->quadrature = q;
3566:   PetscObjectReference((PetscObject) q);
3567:   return(0);
3568: }

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

3573:   Not collective

3575:   Input Parameter:
3576: . fem - The PetscFE object

3578:   Output Parameter:
3579: . q - The PetscQuadrature object

3581:   Level: intermediate

3583: .seealso: PetscFECreate()
3584: @*/
3585: PetscErrorCode PetscFEGetFaceQuadrature(PetscFE fem, PetscQuadrature *q)
3586: {
3590:   *q = fem->faceQuadrature;
3591:   return(0);
3592: }

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

3597:   Not collective

3599:   Input Parameters:
3600: + fem - The PetscFE object
3601: - q - The PetscQuadrature object

3603:   Level: intermediate

3605: .seealso: PetscFECreate()
3606: @*/
3607: PetscErrorCode PetscFESetFaceQuadrature(PetscFE fem, PetscQuadrature q)
3608: {

3613:   PetscFERestoreTabulation(fem, 0, NULL, &fem->Bf, &fem->Df, NULL /*&(*fem)->Hf*/);
3614:   PetscQuadratureDestroy(&fem->faceQuadrature);
3615:   fem->faceQuadrature = q;
3616:   PetscObjectReference((PetscObject) q);
3617:   return(0);
3618: }

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

3623:   Not collective

3625:   Input Parameter:
3626: . fem - The PetscFE object

3628:   Output Parameter:
3629: . numDof - Array with the number of dofs per dimension

3631:   Level: intermediate

3633: .seealso: PetscFECreate()
3634: @*/
3635: PetscErrorCode PetscFEGetNumDof(PetscFE fem, const PetscInt **numDof)
3636: {

3642:   PetscDualSpaceGetNumDof(fem->dualSpace, numDof);
3643:   return(0);
3644: }

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

3649:   Not collective

3651:   Input Parameter:
3652: . fem - The PetscFE object

3654:   Output Parameters:
3655: + B - The basis function values at quadrature points
3656: . D - The basis function derivatives at quadrature points
3657: - H - The basis function second derivatives at quadrature points

3659:   Note:
3660: $ B[(p*pdim + i)*Nc + c] is the value at point p for basis function i and component c
3661: $ D[((p*pdim + i)*Nc + c)*dim + d] is the derivative value at point p for basis function i, component c, in direction d
3662: $ 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

3664:   Level: intermediate

3666: .seealso: PetscFEGetTabulation(), PetscFERestoreTabulation()
3667: @*/
3668: PetscErrorCode PetscFEGetDefaultTabulation(PetscFE fem, PetscReal **B, PetscReal **D, PetscReal **H)
3669: {
3670:   PetscInt         npoints;
3671:   const PetscReal *points;
3672:   PetscErrorCode   ierr;

3679:   PetscQuadratureGetData(fem->quadrature, NULL, NULL, &npoints, &points, NULL);
3680:   if (!fem->B) {PetscFEGetTabulation(fem, npoints, points, &fem->B, &fem->D, NULL/*&fem->H*/);}
3681:   if (B) *B = fem->B;
3682:   if (D) *D = fem->D;
3683:   if (H) *H = fem->H;
3684:   return(0);
3685: }

3687: PetscErrorCode PetscFEGetFaceTabulation(PetscFE fem, PetscReal **Bf, PetscReal **Df, PetscReal **Hf)
3688: {
3689:   PetscErrorCode   ierr;

3696:   if (!fem->Bf) {
3697:     PetscFECellGeom  cgeom;
3698:     PetscQuadrature  fq;
3699:     PetscDualSpace   sp;
3700:     DM               dm;
3701:     const PetscInt  *faces;
3702:     PetscInt         dim, numFaces, f, npoints, q;
3703:     const PetscReal *points;
3704:     PetscReal       *facePoints;

3706:     PetscFEGetDualSpace(fem, &sp);
3707:     PetscDualSpaceGetDM(sp, &dm);
3708:     DMGetDimension(dm, &dim);
3709:     DMPlexGetConeSize(dm, 0, &numFaces);
3710:     DMPlexGetCone(dm, 0, &faces);
3711:     PetscFEGetFaceQuadrature(fem, &fq);
3712:     PetscQuadratureGetData(fq, NULL, NULL, &npoints, &points, NULL);
3713:     PetscMalloc1(numFaces*npoints*dim, &facePoints);
3714:     for (f = 0; f < numFaces; ++f) {
3715:       DMPlexComputeCellGeometryFEM(dm, faces[f], NULL, cgeom.v0, cgeom.J, NULL, &cgeom.detJ);
3716:       for (q = 0; q < npoints; ++q) CoordinatesRefToReal(dim, dim-1, cgeom.v0, cgeom.J, &points[q*(dim-1)], &facePoints[(f*npoints+q)*dim]);
3717:     }
3718:     PetscFEGetTabulation(fem, numFaces*npoints, facePoints, &fem->Bf, &fem->Df, NULL/*&fem->Hf*/);
3719:     PetscFree(facePoints);
3720:   }
3721:   if (Bf) *Bf = fem->Bf;
3722:   if (Df) *Df = fem->Df;
3723:   if (Hf) *Hf = fem->Hf;
3724:   return(0);
3725: }

3727: PetscErrorCode PetscFEGetFaceCentroidTabulation(PetscFE fem, PetscReal **F)
3728: {
3729:   PetscErrorCode   ierr;

3734:   if (!fem->F) {
3735:     PetscDualSpace  sp;
3736:     DM              dm;
3737:     const PetscInt *cone;
3738:     PetscReal      *centroids;
3739:     PetscInt        dim, numFaces, f;

3741:     PetscFEGetDualSpace(fem, &sp);
3742:     PetscDualSpaceGetDM(sp, &dm);
3743:     DMGetDimension(dm, &dim);
3744:     DMPlexGetConeSize(dm, 0, &numFaces);
3745:     DMPlexGetCone(dm, 0, &cone);
3746:     PetscMalloc1(numFaces*dim, &centroids);
3747:     for (f = 0; f < numFaces; ++f) {DMPlexComputeCellGeometryFVM(dm, cone[f], NULL, &centroids[f*dim], NULL);}
3748:     PetscFEGetTabulation(fem, numFaces, centroids, &fem->F, NULL, NULL);
3749:     PetscFree(centroids);
3750:   }
3751:   *F = fem->F;
3752:   return(0);
3753: }

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

3758:   Not collective

3760:   Input Parameters:
3761: + fem     - The PetscFE object
3762: . npoints - The number of tabulation points
3763: - points  - The tabulation point coordinates

3765:   Output Parameters:
3766: + B - The basis function values at tabulation points
3767: . D - The basis function derivatives at tabulation points
3768: - H - The basis function second derivatives at tabulation points

3770:   Note:
3771: $ B[(p*pdim + i)*Nc + c] is the value at point p for basis function i and component c
3772: $ D[((p*pdim + i)*Nc + c)*dim + d] is the derivative value at point p for basis function i, component c, in direction d
3773: $ 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

3775:   Level: intermediate

3777: .seealso: PetscFERestoreTabulation(), PetscFEGetDefaultTabulation()
3778: @*/
3779: PetscErrorCode PetscFEGetTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal **B, PetscReal **D, PetscReal **H)
3780: {
3781:   DM               dm;
3782:   PetscInt         pdim; /* Dimension of FE space P */
3783:   PetscInt         dim;  /* Spatial dimension */
3784:   PetscInt         comp; /* Field components */
3785:   PetscErrorCode   ierr;

3788:   if (!npoints) {
3789:     if (B) *B = NULL;
3790:     if (D) *D = NULL;
3791:     if (H) *H = NULL;
3792:     return(0);
3793:   }
3799:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
3800:   DMGetDimension(dm, &dim);
3801:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
3802:   PetscFEGetNumComponents(fem, &comp);
3803:   if (B) {DMGetWorkArray(dm, npoints*pdim*comp, PETSC_REAL, B);}
3804:   if (D) {DMGetWorkArray(dm, npoints*pdim*comp*dim, PETSC_REAL, D);}
3805:   if (H) {DMGetWorkArray(dm, npoints*pdim*comp*dim*dim, PETSC_REAL, H);}
3806:   (*fem->ops->gettabulation)(fem, npoints, points, B ? *B : NULL, D ? *D : NULL, H ? *H : NULL);
3807:   return(0);
3808: }

3810: PetscErrorCode PetscFERestoreTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal **B, PetscReal **D, PetscReal **H)
3811: {
3812:   DM             dm;

3817:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
3818:   if (B && *B) {DMRestoreWorkArray(dm, 0, PETSC_REAL, B);}
3819:   if (D && *D) {DMRestoreWorkArray(dm, 0, PETSC_REAL, D);}
3820:   if (H && *H) {DMRestoreWorkArray(dm, 0, PETSC_REAL, H);}
3821:   return(0);
3822: }

3824: PetscErrorCode PetscFEDestroy_Basic(PetscFE fem)
3825: {
3826:   PetscFE_Basic *b = (PetscFE_Basic *) fem->data;

3830:   PetscFree(b);
3831:   return(0);
3832: }

3834: PetscErrorCode PetscFEView_Basic_Ascii(PetscFE fe, PetscViewer viewer)
3835: {
3836:   PetscSpace        basis;
3837:   PetscDualSpace    dual;
3838:   PetscQuadrature   q = NULL;
3839:   PetscInt          dim, Nc, Nq;
3840:   PetscViewerFormat format;
3841:   PetscErrorCode    ierr;

3844:   PetscFEGetBasisSpace(fe, &basis);
3845:   PetscFEGetDualSpace(fe, &dual);
3846:   PetscFEGetQuadrature(fe, &q);
3847:   PetscFEGetNumComponents(fe, &Nc);
3848:   PetscQuadratureGetData(q, &dim, NULL, &Nq, NULL, NULL);
3849:   PetscViewerGetFormat(viewer, &format);
3850:   PetscViewerASCIIPrintf(viewer, "Basic Finite Element:\n");
3851:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
3852:     PetscViewerASCIIPrintf(viewer, "  dimension:       %d\n", dim);
3853:     PetscViewerASCIIPrintf(viewer, "  components:      %d\n", Nc);
3854:     PetscViewerASCIIPrintf(viewer, "  num quad points: %d\n", Nq);
3855:     PetscViewerASCIIPushTab(viewer);
3856:     PetscQuadratureView(q, viewer);
3857:     PetscViewerASCIIPopTab(viewer);
3858:   } else {
3859:     PetscViewerASCIIPrintf(viewer, "  dimension:       %d\n", dim);
3860:     PetscViewerASCIIPrintf(viewer, "  components:      %d\n", Nc);
3861:     PetscViewerASCIIPrintf(viewer, "  num quad points: %d\n", Nq);
3862:   }
3863:   PetscViewerASCIIPushTab(viewer);
3864:   PetscSpaceView(basis, viewer);
3865:   PetscDualSpaceView(dual, viewer);
3866:   PetscViewerASCIIPopTab(viewer);
3867:   return(0);
3868: }

3870: PetscErrorCode PetscFEView_Basic(PetscFE fe, PetscViewer viewer)
3871: {
3872:   PetscBool      iascii;

3878:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
3879:   if (iascii) {PetscFEView_Basic_Ascii(fe, viewer);}
3880:   return(0);
3881: }

3883: /* Construct the change of basis from prime basis to nodal basis */
3884: PetscErrorCode PetscFESetUp_Basic(PetscFE fem)
3885: {
3886:   PetscScalar   *work, *invVscalar;
3887:   PetscBLASInt  *pivots;
3888:   PetscBLASInt   n, info;
3889:   PetscInt       pdim, j;

3893:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
3894:   PetscMalloc1(pdim*pdim,&fem->invV);
3895: #if defined(PETSC_USE_COMPLEX)
3896:   PetscMalloc1(pdim*pdim,&invVscalar);
3897: #else
3898:   invVscalar = fem->invV;
3899: #endif
3900:   for (j = 0; j < pdim; ++j) {
3901:     PetscReal       *Bf;
3902:     PetscQuadrature  f;
3903:     const PetscReal *points, *weights;
3904:     PetscInt         Nc, Nq, q, k, c;

3906:     PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);
3907:     PetscQuadratureGetData(f, NULL, &Nc, &Nq, &points, &weights);
3908:     PetscMalloc1(Nc*Nq*pdim,&Bf);
3909:     PetscSpaceEvaluate(fem->basisSpace, Nq, points, Bf, NULL, NULL);
3910:     for (k = 0; k < pdim; ++k) {
3911:       /* V_{jk} = n_j(\phi_k) = \int \phi_k(x) n_j(x) dx */
3912:       invVscalar[j*pdim+k] = 0.0;

3914:       for (q = 0; q < Nq; ++q) {
3915:         for (c = 0; c < Nc; ++c) invVscalar[j*pdim+k] += Bf[(q*pdim + k)*Nc + c]*weights[q*Nc + c];
3916:       }
3917:     }
3918:     PetscFree(Bf);
3919:   }
3920:   PetscMalloc2(pdim,&pivots,pdim,&work);
3921:   n = pdim;
3922:   PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, invVscalar, &n, pivots, &info));
3923:   PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, invVscalar, &n, pivots, work, &n, &info));
3924: #if defined(PETSC_USE_COMPLEX)
3925:   for (j = 0; j < pdim*pdim; j++) fem->invV[j] = PetscRealPart(invVscalar[j]);
3926:   PetscFree(invVscalar);
3927: #endif
3928:   PetscFree2(pivots,work);
3929:   return(0);
3930: }

3932: PetscErrorCode PetscFEGetDimension_Basic(PetscFE fem, PetscInt *dim)
3933: {

3937:   PetscDualSpaceGetDimension(fem->dualSpace, dim);
3938:   return(0);
3939: }

3941: PetscErrorCode PetscFEGetTabulation_Basic(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H)
3942: {
3943:   DM               dm;
3944:   PetscInt         pdim; /* Dimension of FE space P */
3945:   PetscInt         dim;  /* Spatial dimension */
3946:   PetscInt         Nc;   /* Field components */
3947:   PetscReal       *tmpB, *tmpD, *tmpH;
3948:   PetscInt         p, d, j, k, c;
3949:   PetscErrorCode   ierr;

3952:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
3953:   DMGetDimension(dm, &dim);
3954:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
3955:   PetscFEGetNumComponents(fem, &Nc);
3956:   /* Evaluate the prime basis functions at all points */
3957:   if (B) {DMGetWorkArray(dm, npoints*pdim*Nc, PETSC_REAL, &tmpB);}
3958:   if (D) {DMGetWorkArray(dm, npoints*pdim*Nc*dim, PETSC_REAL, &tmpD);}
3959:   if (H) {DMGetWorkArray(dm, npoints*pdim*Nc*dim*dim, PETSC_REAL, &tmpH);}
3960:   PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);
3961:   /* Translate to the nodal basis */
3962:   for (p = 0; p < npoints; ++p) {
3963:     if (B) {
3964:       /* Multiply by V^{-1} (pdim x pdim) */
3965:       for (j = 0; j < pdim; ++j) {
3966:         const PetscInt i = (p*pdim + j)*Nc;

3968:         for (c = 0; c < Nc; ++c) {
3969:           B[i+c] = 0.0;
3970:           for (k = 0; k < pdim; ++k) {
3971:             B[i+c] += fem->invV[k*pdim+j] * tmpB[(p*pdim + k)*Nc+c];
3972:           }
3973:         }
3974:       }
3975:     }
3976:     if (D) {
3977:       /* Multiply by V^{-1} (pdim x pdim) */
3978:       for (j = 0; j < pdim; ++j) {
3979:         for (c = 0; c < Nc; ++c) {
3980:           for (d = 0; d < dim; ++d) {
3981:             const PetscInt i = ((p*pdim + j)*Nc + c)*dim + d;

3983:             D[i] = 0.0;
3984:             for (k = 0; k < pdim; ++k) {
3985:               D[i] += fem->invV[k*pdim+j] * tmpD[((p*pdim + k)*Nc + c)*dim + d];
3986:             }
3987:           }
3988:         }
3989:       }
3990:     }
3991:     if (H) {
3992:       /* Multiply by V^{-1} (pdim x pdim) */
3993:       for (j = 0; j < pdim; ++j) {
3994:         for (c = 0; c < Nc; ++c) {
3995:           for (d = 0; d < dim*dim; ++d) {
3996:             const PetscInt i = ((p*pdim + j)*Nc + c)*dim*dim + d;

3998:             H[i] = 0.0;
3999:             for (k = 0; k < pdim; ++k) {
4000:               H[i] += fem->invV[k*pdim+j] * tmpH[((p*pdim + k)*Nc + c)*dim*dim + d];
4001:             }
4002:           }
4003:         }
4004:       }
4005:     }
4006:   }
4007:   if (B) {DMRestoreWorkArray(dm, npoints*pdim*Nc, PETSC_REAL, &tmpB);}
4008:   if (D) {DMRestoreWorkArray(dm, npoints*pdim*Nc*dim, PETSC_REAL, &tmpD);}
4009:   if (H) {DMRestoreWorkArray(dm, npoints*pdim*Nc*dim*dim, PETSC_REAL, &tmpH);}
4010:   return(0);
4011: }

4013: PetscErrorCode PetscFEIntegrate_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
4014:                                       const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal integral[])
4015: {
4016:   const PetscInt     debug = 0;
4017:   PetscPointFunc     obj_func;
4018:   PetscQuadrature    quad;
4019:   PetscScalar       *u, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4020:   const PetscScalar *constants;
4021:   PetscReal         *x;
4022:   PetscReal        **B, **D, **BAux = NULL, **DAux = NULL;
4023:   PetscInt          *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4024:   PetscInt           dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, e;
4025:   PetscErrorCode     ierr;

4028:   PetscDSGetObjective(prob, field, &obj_func);
4029:   if (!obj_func) return(0);
4030:   PetscFEGetSpatialDimension(fem, &dim);
4031:   PetscFEGetQuadrature(fem, &quad);
4032:   PetscDSGetNumFields(prob, &Nf);
4033:   PetscDSGetTotalDimension(prob, &totDim);
4034:   PetscDSGetDimensions(prob, &Nb);
4035:   PetscDSGetComponents(prob, &Nc);
4036:   PetscDSGetComponentOffsets(prob, &uOff);
4037:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4038:   PetscDSGetEvaluationArrays(prob, &u, NULL, &u_x);
4039:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4040:   PetscDSGetTabulation(prob, &B, &D);
4041:   PetscDSGetConstants(prob, &numConstants, &constants);
4042:   if (probAux) {
4043:     PetscDSGetNumFields(probAux, &NfAux);
4044:     PetscDSGetTotalDimension(probAux, &totDimAux);
4045:     PetscDSGetDimensions(probAux, &NbAux);
4046:     PetscDSGetComponents(probAux, &NcAux);
4047:     PetscDSGetComponentOffsets(probAux, &aOff);
4048:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4049:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4050:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4051:     PetscDSGetTabulation(probAux, &BAux, &DAux);
4052:   }
4053:   for (e = 0; e < Ne; ++e) {
4054:     const PetscReal *v0   = cgeom[e].v0;
4055:     const PetscReal *J    = cgeom[e].J;
4056:     const PetscReal *invJ = cgeom[e].invJ;
4057:     const PetscReal  detJ = cgeom[e].detJ;
4058:     const PetscReal *quadPoints, *quadWeights;
4059:     PetscInt         qNc, Nq, q;

4061:     PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4062:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4063:     if (debug > 1) {
4064:       PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
4065: #ifndef PETSC_USE_COMPLEX
4066:       DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
4067: #endif
4068:     }
4069:     for (q = 0; q < Nq; ++q) {
4070:       PetscScalar integrand;

4072:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4073:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4074:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], NULL, u, u_x, NULL);
4075:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4076:       obj_func(dim, Nf, NfAux, uOff, uOff_x, u, NULL, u_x, aOff, aOff_x, a, NULL, a_x, 0.0, x, numConstants, constants, &integrand);
4077:       integrand *= detJ*quadWeights[q];
4078:       integral[field] += PetscRealPart(integrand);
4079:       if (debug > 1) {PetscPrintf(PETSC_COMM_SELF, "    int: %g %g\n", PetscRealPart(integrand), integral[field]);}
4080:     }
4081:     cOffset    += totDim;
4082:     cOffsetAux += totDimAux;
4083:   }
4084:   return(0);
4085: }

4087: PetscErrorCode PetscFEIntegrateResidual_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
4088:                                               const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4089: {
4090:   const PetscInt     debug = 0;
4091:   PetscPointFunc     f0_func;
4092:   PetscPointFunc     f1_func;
4093:   PetscQuadrature    quad;
4094:   PetscScalar       *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4095:   const PetscScalar *constants;
4096:   PetscReal         *x;
4097:   PetscReal        **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4098:   PetscInt          *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4099:   PetscInt           dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
4100:   PetscErrorCode     ierr;

4103:   PetscFEGetSpatialDimension(fem, &dim);
4104:   PetscFEGetQuadrature(fem, &quad);
4105:   PetscDSGetNumFields(prob, &Nf);
4106:   PetscDSGetTotalDimension(prob, &totDim);
4107:   PetscDSGetDimensions(prob, &Nb);
4108:   PetscDSGetComponents(prob, &Nc);
4109:   PetscDSGetComponentOffsets(prob, &uOff);
4110:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4111:   PetscDSGetFieldOffset(prob, field, &fOffset);
4112:   PetscDSGetResidual(prob, field, &f0_func, &f1_func);
4113:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4114:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4115:   PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4116:   PetscDSGetTabulation(prob, &B, &D);
4117:   PetscDSGetConstants(prob, &numConstants, &constants);
4118:   if (probAux) {
4119:     PetscDSGetNumFields(probAux, &NfAux);
4120:     PetscDSGetTotalDimension(probAux, &totDimAux);
4121:     PetscDSGetDimensions(probAux, &NbAux);
4122:     PetscDSGetComponents(probAux, &NcAux);
4123:     PetscDSGetComponentOffsets(probAux, &aOff);
4124:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4125:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4126:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4127:     PetscDSGetTabulation(probAux, &BAux, &DAux);
4128:   }
4129:   NbI = Nb[field];
4130:   NcI = Nc[field];
4131:   BI  = B[field];
4132:   DI  = D[field];
4133:   for (e = 0; e < Ne; ++e) {
4134:     const PetscReal *v0   = cgeom[e].v0;
4135:     const PetscReal *J    = cgeom[e].J;
4136:     const PetscReal *invJ = cgeom[e].invJ;
4137:     const PetscReal  detJ = cgeom[e].detJ;
4138:     const PetscReal *quadPoints, *quadWeights;
4139:     PetscInt         qNc, Nq, q;

4141:     PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4142:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4143:     PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
4144:     PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
4145:     if (debug > 1) {
4146:       PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
4147: #ifndef PETSC_USE_COMPLEX
4148:       DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
4149: #endif
4150:     }
4151:     for (q = 0; q < Nq; ++q) {
4152:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4153:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4154:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4155:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4156:       if (f0_func) f0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, numConstants, constants, &f0[q*NcI]);
4157:       if (f1_func) {
4158:         PetscMemzero(refSpaceDer, NcI*dim * sizeof(PetscScalar));
4159:         f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, numConstants, constants, refSpaceDer);
4160:       }
4161:       TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
4162:     }
4163:     UpdateElementVec(dim, Nq, NbI, NcI, BI, DI, f0, f1, &elemVec[cOffset+fOffset]);
4164:     cOffset    += totDim;
4165:     cOffsetAux += totDimAux;
4166:   }
4167:   return(0);
4168: }

4170: PetscErrorCode PetscFEIntegrateBdResidual_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEFaceGeom *fgeom,
4171:                                                 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4172: {
4173:   const PetscInt     debug = 0;
4174:   PetscBdPointFunc   f0_func;
4175:   PetscBdPointFunc   f1_func;
4176:   PetscQuadrature    quad;
4177:   PetscScalar       *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4178:   const PetscScalar *constants;
4179:   PetscReal         *x;
4180:   PetscReal        **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4181:   PetscInt          *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4182:   PetscInt           dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
4183:   PetscErrorCode     ierr;

4186:   PetscFEGetSpatialDimension(fem, &dim);
4187:   PetscFEGetFaceQuadrature(fem, &quad);
4188:   PetscDSGetNumFields(prob, &Nf);
4189:   PetscDSGetTotalDimension(prob, &totDim);
4190:   PetscDSGetDimensions(prob, &Nb);
4191:   PetscDSGetComponents(prob, &Nc);
4192:   PetscDSGetComponentOffsets(prob, &uOff);
4193:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4194:   PetscDSGetFieldOffset(prob, field, &fOffset);
4195:   PetscDSGetBdResidual(prob, field, &f0_func, &f1_func);
4196:   if (!f0_func && !f1_func) return(0);
4197:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4198:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4199:   PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4200:   PetscDSGetFaceTabulation(prob, &B, &D);
4201:   PetscDSGetConstants(prob, &numConstants, &constants);
4202:   if (probAux) {
4203:     PetscDSGetNumFields(probAux, &NfAux);
4204:     PetscDSGetTotalDimension(probAux, &totDimAux);
4205:     PetscDSGetDimensions(probAux, &NbAux);
4206:     PetscDSGetComponents(probAux, &NcAux);
4207:     PetscDSGetComponentOffsets(probAux, &aOff);
4208:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4209:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4210:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4211:     PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
4212:   }
4213:   NbI = Nb[field];
4214:   NcI = Nc[field];
4215:   BI  = B[field];
4216:   DI  = D[field];
4217:   for (e = 0; e < Ne; ++e) {
4218:     const PetscReal *quadPoints, *quadWeights;
4219:     const PetscReal *v0   = fgeom[e].v0;
4220:     const PetscReal *J    = fgeom[e].J;
4221:     const PetscReal *invJ = fgeom[e].invJ[0];
4222:     const PetscReal  detJ = fgeom[e].detJ;
4223:     const PetscReal *n    = fgeom[e].n;
4224:     const PetscInt   face = fgeom[e].face[0];
4225:     PetscInt         qNc, Nq, q;

4227:     PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4228:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4229:     PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
4230:     PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
4231:     if (debug > 1) {
4232:       PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
4233: #ifndef PETSC_USE_COMPLEX
4234:       DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
4235: #endif
4236:      }
4237:      for (q = 0; q < Nq; ++q) {
4238:        if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4239:        CoordinatesRefToReal(dim, dim-1, v0, J, &quadPoints[q*(dim-1)], x);
4240:        EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4241:        if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4242:        if (f0_func) f0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, n, numConstants, constants, &f0[q*NcI]);
4243:        if (f1_func) {
4244:          PetscMemzero(refSpaceDer, NcI*dim * sizeof(PetscScalar));
4245:          f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, n, numConstants, constants, refSpaceDer);
4246:        }
4247:        TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
4248:      }
4249:      UpdateElementVec(dim, Nq, NbI, NcI, &BI[face*Nq*NbI*NcI], &DI[face*Nq*NbI*NcI*dim], f0, f1, &elemVec[cOffset+fOffset]);
4250:      cOffset    += totDim;
4251:      cOffsetAux += totDimAux;
4252:    }
4253:    return(0);
4254: }

4256: PetscErrorCode PetscFEIntegrateJacobian_Basic(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFECellGeom *geom,
4257:                                               const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
4258: {
4259:   const PetscInt     debug      = 0;
4260:   PetscPointJac      g0_func;
4261:   PetscPointJac      g1_func;
4262:   PetscPointJac      g2_func;
4263:   PetscPointJac      g3_func;
4264:   PetscInt           cOffset    = 0; /* Offset into coefficients[] for element e */
4265:   PetscInt           cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
4266:   PetscInt           eOffset    = 0; /* Offset into elemMat[] for element e */
4267:   PetscInt           offsetI    = 0; /* Offset into an element vector for fieldI */
4268:   PetscInt           offsetJ    = 0; /* Offset into an element vector for fieldJ */
4269:   PetscQuadrature    quad;
4270:   PetscScalar       *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4271:   const PetscScalar *constants;
4272:   PetscReal         *x;
4273:   PetscReal        **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
4274:   PetscInt          *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4275:   PetscInt           NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
4276:   PetscInt           dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, e;
4277:   PetscErrorCode     ierr;

4280:   PetscFEGetSpatialDimension(fem, &dim);
4281:   PetscFEGetQuadrature(fem, &quad);
4282:   PetscDSGetNumFields(prob, &Nf);
4283:   PetscDSGetTotalDimension(prob, &totDim);
4284:   PetscDSGetDimensions(prob, &Nb);
4285:   PetscDSGetComponents(prob, &Nc);
4286:   PetscDSGetComponentOffsets(prob, &uOff);
4287:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4288:   switch(jtype) {
4289:   case PETSCFE_JACOBIAN_DYN: PetscDSGetDynamicJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4290:   case PETSCFE_JACOBIAN_PRE: PetscDSGetJacobianPreconditioner(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4291:   case PETSCFE_JACOBIAN:     PetscDSGetJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4292:   }
4293:   if (!g0_func && !g1_func && !g2_func && !g3_func) return(0);
4294:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4295:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4296:   PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
4297:   PetscDSGetTabulation(prob, &B, &D);
4298:   PetscDSGetFieldOffset(prob, fieldI, &offsetI);
4299:   PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
4300:   PetscDSGetConstants(prob, &numConstants, &constants);
4301:   if (probAux) {
4302:     PetscDSGetNumFields(probAux, &NfAux);
4303:     PetscDSGetTotalDimension(probAux, &totDimAux);
4304:     PetscDSGetDimensions(probAux, &NbAux);
4305:     PetscDSGetComponents(probAux, &NcAux);
4306:     PetscDSGetComponentOffsets(probAux, &aOff);
4307:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4308:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4309:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4310:     PetscDSGetTabulation(probAux, &BAux, &DAux);
4311:   }
4312:   NbI = Nb[fieldI], NbJ = Nb[fieldJ];
4313:   NcI = Nc[fieldI], NcJ = Nc[fieldJ];
4314:   BI  = B[fieldI],  BJ  = B[fieldJ];
4315:   DI  = D[fieldI],  DJ  = D[fieldJ];
4316:   /* Initialize here in case the function is not defined */
4317:   PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4318:   PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
4319:   PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
4320:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4321:   for (e = 0; e < Ne; ++e) {
4322:     const PetscReal *v0   = geom[e].v0;
4323:     const PetscReal *J    = geom[e].J;
4324:     const PetscReal *invJ = geom[e].invJ;
4325:     const PetscReal  detJ = geom[e].detJ;
4326:     const PetscReal *quadPoints, *quadWeights;
4327:     PetscInt         qNc, Nq, q;

4329:     PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4330:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4331:     for (q = 0; q < Nq; ++q) {
4332:       const PetscReal *BIq = &BI[q*NbI*NcI], *BJq = &BJ[q*NbJ*NcJ];
4333:       const PetscReal *DIq = &DI[q*NbI*NcI*dim], *DJq = &DJ[q*NbJ*NcJ*dim];
4334:       const PetscReal  w = detJ*quadWeights[q];
4335:       PetscInt f, g, fc, gc, c;

4337:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4338:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4339:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4340:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4341:       if (g0_func) {
4342:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4343:         g0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, g0);
4344:         for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
4345:       }
4346:       if (g1_func) {
4347:         PetscInt d, d2;
4348:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4349:         g1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, refSpaceDer);
4350:         for (fc = 0; fc < NcI; ++fc) {
4351:           for (gc = 0; gc < NcJ; ++gc) {
4352:             for (d = 0; d < dim; ++d) {
4353:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
4354:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4355:               g1[(fc*NcJ+gc)*dim+d] *= w;
4356:             }
4357:           }
4358:         }
4359:       }
4360:       if (g2_func) {
4361:         PetscInt d, d2;
4362:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4363:         g2_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, refSpaceDer);
4364:         for (fc = 0; fc < NcI; ++fc) {
4365:           for (gc = 0; gc < NcJ; ++gc) {
4366:             for (d = 0; d < dim; ++d) {
4367:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
4368:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4369:               g2[(fc*NcJ+gc)*dim+d] *= w;
4370:             }
4371:           }
4372:         }
4373:       }
4374:       if (g3_func) {
4375:         PetscInt d, d2, dp, d3;
4376:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4377:         g3_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, refSpaceDer);
4378:         for (fc = 0; fc < NcI; ++fc) {
4379:           for (gc = 0; gc < NcJ; ++gc) {
4380:             for (d = 0; d < dim; ++d) {
4381:               for (dp = 0; dp < dim; ++dp) {
4382:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
4383:                 for (d2 = 0; d2 < dim; ++d2) {
4384:                   for (d3 = 0; d3 < dim; ++d3) {
4385:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
4386:                   }
4387:                 }
4388:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
4389:               }
4390:             }
4391:           }
4392:         }
4393:       }

4395:       for (f = 0; f < NbI; ++f) {
4396:         for (fc = 0; fc < NcI; ++fc) {
4397:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
4398:           const PetscInt i    = offsetI+f; /* Element matrix row */
4399:           for (g = 0; g < NbJ; ++g) {
4400:             for (gc = 0; gc < NcJ; ++gc) {
4401:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
4402:               const PetscInt j    = offsetJ+g; /* Element matrix column */
4403:               const PetscInt fOff = eOffset+i*totDim+j;
4404:               PetscInt       d, d2;

4406:               elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
4407:               for (d = 0; d < dim; ++d) {
4408:                 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
4409:                 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
4410:                 for (d2 = 0; d2 < dim; ++d2) {
4411:                   elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
4412:                 }
4413:               }
4414:             }
4415:           }
4416:         }
4417:       }
4418:     }
4419:     if (debug > 1) {
4420:       PetscInt fc, f, gc, g;

4422:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
4423:       for (fc = 0; fc < NcI; ++fc) {
4424:         for (f = 0; f < NbI; ++f) {
4425:           const PetscInt i = offsetI + f*NcI+fc;
4426:           for (gc = 0; gc < NcJ; ++gc) {
4427:             for (g = 0; g < NbJ; ++g) {
4428:               const PetscInt j = offsetJ + g*NcJ+gc;
4429:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
4430:             }
4431:           }
4432:           PetscPrintf(PETSC_COMM_SELF, "\n");
4433:         }
4434:       }
4435:     }
4436:     cOffset    += totDim;
4437:     cOffsetAux += totDimAux;
4438:     eOffset    += PetscSqr(totDim);
4439:   }
4440:   return(0);
4441: }

4443: PetscErrorCode PetscFEIntegrateBdJacobian_Basic(PetscFE fem, PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEFaceGeom *fgeom,
4444:                                                 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
4445: {
4446:   const PetscInt     debug      = 0;
4447:   PetscBdPointJac    g0_func;
4448:   PetscBdPointJac    g1_func;
4449:   PetscBdPointJac    g2_func;
4450:   PetscBdPointJac    g3_func;
4451:   PetscInt           cOffset    = 0; /* Offset into coefficients[] for element e */
4452:   PetscInt           cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
4453:   PetscInt           eOffset    = 0; /* Offset into elemMat[] for element e */
4454:   PetscInt           offsetI    = 0; /* Offset into an element vector for fieldI */
4455:   PetscInt           offsetJ    = 0; /* Offset into an element vector for fieldJ */
4456:   PetscQuadrature    quad;
4457:   PetscScalar       *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4458:   const PetscScalar *constants;
4459:   PetscReal         *x;
4460:   PetscReal        **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
4461:   PetscInt          *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4462:   PetscInt           NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
4463:   PetscInt           dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, e;
4464:   PetscErrorCode     ierr;

4467:   PetscFEGetSpatialDimension(fem, &dim);
4468:   PetscFEGetFaceQuadrature(fem, &quad);
4469:   PetscDSGetNumFields(prob, &Nf);
4470:   PetscDSGetTotalDimension(prob, &totDim);
4471:   PetscDSGetDimensions(prob, &Nb);
4472:   PetscDSGetComponents(prob, &Nc);
4473:   PetscDSGetComponentOffsets(prob, &uOff);
4474:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4475:   PetscDSGetFieldOffset(prob, fieldI, &offsetI);
4476:   PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
4477:   PetscDSGetBdJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);
4478:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4479:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4480:   PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
4481:   PetscDSGetFaceTabulation(prob, &B, &D);
4482:   PetscDSGetConstants(prob, &numConstants, &constants);
4483:   if (probAux) {
4484:     PetscDSGetNumFields(probAux, &NfAux);
4485:     PetscDSGetTotalDimension(probAux, &totDimAux);
4486:     PetscDSGetDimensions(probAux, &NbAux);
4487:     PetscDSGetComponents(probAux, &NcAux);
4488:     PetscDSGetComponentOffsets(probAux, &aOff);
4489:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4490:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4491:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4492:     PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
4493:   }
4494:   NbI = Nb[fieldI], NbJ = Nb[fieldJ];
4495:   NcI = Nc[fieldI], NcJ = Nc[fieldJ];
4496:   BI  = B[fieldI],  BJ  = B[fieldJ];
4497:   DI  = D[fieldI],  DJ  = D[fieldJ];
4498:   /* Initialize here in case the function is not defined */
4499:   PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4500:   PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
4501:   PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
4502:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4503:   for (e = 0; e < Ne; ++e) {
4504:     const PetscReal *quadPoints, *quadWeights;
4505:     const PetscReal *v0   = fgeom[e].v0;
4506:     const PetscReal *J    = fgeom[e].J;
4507:     const PetscReal *invJ = fgeom[e].invJ[0];
4508:     const PetscReal  detJ = fgeom[e].detJ;
4509:     const PetscReal *n    = fgeom[e].n;
4510:     const PetscInt   face = fgeom[e].face[0];
4511:     PetscInt         qNc, Nq, q;

4513:     PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4514:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4515:     for (q = 0; q < Nq; ++q) {
4516:       const PetscReal *BIq = &BI[(face*Nq+q)*NbI*NcI], *BJq = &BJ[(face*Nq+q)*NbJ*NcJ];
4517:       const PetscReal *DIq = &DI[(face*Nq+q)*NbI*NcI*dim], *DJq = &DJ[(face*Nq+q)*NbJ*NcJ*dim];
4518:       const PetscReal  w = detJ*quadWeights[q];
4519:       PetscInt f, g, fc, gc, c;

4521:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4522:       CoordinatesRefToReal(dim, dim-1, v0, J, &quadPoints[q*(dim-1)], x);
4523:       EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4524:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4525:       if (g0_func) {
4526:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4527:         g0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, n, numConstants, constants, g0);
4528:         for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
4529:       }
4530:       if (g1_func) {
4531:         PetscInt d, d2;
4532:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4533:         g1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, n, numConstants, constants, refSpaceDer);
4534:         for (fc = 0; fc < NcI; ++fc) {
4535:           for (gc = 0; gc < NcJ; ++gc) {
4536:             for (d = 0; d < dim; ++d) {
4537:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
4538:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4539:               g1[(fc*NcJ+gc)*dim+d] *= w;
4540:             }
4541:           }
4542:         }
4543:       }
4544:       if (g2_func) {
4545:         PetscInt d, d2;
4546:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4547:         g2_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, n, numConstants, constants, refSpaceDer);
4548:         for (fc = 0; fc < NcI; ++fc) {
4549:           for (gc = 0; gc < NcJ; ++gc) {
4550:             for (d = 0; d < dim; ++d) {
4551:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
4552:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4553:               g2[(fc*NcJ+gc)*dim+d] *= w;
4554:             }
4555:           }
4556:         }
4557:       }
4558:       if (g3_func) {
4559:         PetscInt d, d2, dp, d3;
4560:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4561:         g3_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, n, numConstants, constants, refSpaceDer);
4562:         for (fc = 0; fc < NcI; ++fc) {
4563:           for (gc = 0; gc < NcJ; ++gc) {
4564:             for (d = 0; d < dim; ++d) {
4565:               for (dp = 0; dp < dim; ++dp) {
4566:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
4567:                 for (d2 = 0; d2 < dim; ++d2) {
4568:                   for (d3 = 0; d3 < dim; ++d3) {
4569:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
4570:                   }
4571:                 }
4572:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
4573:               }
4574:             }
4575:           }
4576:         }
4577:       }

4579:       for (f = 0; f < NbI; ++f) {
4580:         for (fc = 0; fc < NcI; ++fc) {
4581:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
4582:           const PetscInt i    = offsetI+f; /* Element matrix row */
4583:           for (g = 0; g < NbJ; ++g) {
4584:             for (gc = 0; gc < NcJ; ++gc) {
4585:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
4586:               const PetscInt j    = offsetJ+g; /* Element matrix column */
4587:               const PetscInt fOff = eOffset+i*totDim+j;
4588:               PetscInt       d, d2;

4590:               elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
4591:               for (d = 0; d < dim; ++d) {
4592:                 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
4593:                 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
4594:                 for (d2 = 0; d2 < dim; ++d2) {
4595:                   elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
4596:                 }
4597:               }
4598:             }
4599:           }
4600:         }
4601:       }
4602:     }
4603:     if (debug > 1) {
4604:       PetscInt fc, f, gc, g;

4606:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
4607:       for (fc = 0; fc < NcI; ++fc) {
4608:         for (f = 0; f < NbI; ++f) {
4609:           const PetscInt i = offsetI + f*NcI+fc;
4610:           for (gc = 0; gc < NcJ; ++gc) {
4611:             for (g = 0; g < NbJ; ++g) {
4612:               const PetscInt j = offsetJ + g*NcJ+gc;
4613:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
4614:             }
4615:           }
4616:           PetscPrintf(PETSC_COMM_SELF, "\n");
4617:         }
4618:       }
4619:     }
4620:     cOffset    += totDim;
4621:     cOffsetAux += totDimAux;
4622:     eOffset    += PetscSqr(totDim);
4623:   }
4624:   return(0);
4625: }

4627: PetscErrorCode PetscFEInitialize_Basic(PetscFE fem)
4628: {
4630:   fem->ops->setfromoptions          = NULL;
4631:   fem->ops->setup                   = PetscFESetUp_Basic;
4632:   fem->ops->view                    = PetscFEView_Basic;
4633:   fem->ops->destroy                 = PetscFEDestroy_Basic;
4634:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
4635:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
4636:   fem->ops->integrate               = PetscFEIntegrate_Basic;
4637:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Basic;
4638:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Basic;
4639:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Basic */;
4640:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
4641:   fem->ops->integratebdjacobian     = PetscFEIntegrateBdJacobian_Basic;
4642:   return(0);
4643: }

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

4648:   Level: intermediate

4650: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
4651: M*/

4653: PETSC_EXTERN PetscErrorCode PetscFECreate_Basic(PetscFE fem)
4654: {
4655:   PetscFE_Basic *b;

4660:   PetscNewLog(fem,&b);
4661:   fem->data = b;

4663:   PetscFEInitialize_Basic(fem);
4664:   return(0);
4665: }

4667: PetscErrorCode PetscFEDestroy_Nonaffine(PetscFE fem)
4668: {
4669:   PetscFE_Nonaffine *na = (PetscFE_Nonaffine *) fem->data;

4673:   PetscFree(na);
4674:   return(0);
4675: }

4677: PetscErrorCode PetscFEIntegrateResidual_Nonaffine(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
4678:                                                   const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4679: {
4680:   const PetscInt     debug = 0;
4681:   PetscPointFunc     f0_func;
4682:   PetscPointFunc     f1_func;
4683:   PetscQuadrature    quad;
4684:   PetscScalar       *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4685:   const PetscScalar *constants;
4686:   PetscReal         *x;
4687:   PetscReal        **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4688:   PetscInt          *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4689:   PetscInt          dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
4690:   PetscErrorCode    ierr;

4693:   PetscFEGetSpatialDimension(fem, &dim);
4694:   PetscFEGetQuadrature(fem, &quad);
4695:   PetscDSGetNumFields(prob, &Nf);
4696:   PetscDSGetTotalDimension(prob, &totDim);
4697:   PetscDSGetDimensions(prob, &Nb);
4698:   PetscDSGetComponents(prob, &Nc);
4699:   PetscDSGetComponentOffsets(prob, &uOff);
4700:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4701:   PetscDSGetFieldOffset(prob, field, &fOffset);
4702:   PetscDSGetResidual(prob, field, &f0_func, &f1_func);
4703:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4704:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4705:   PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4706:   PetscDSGetTabulation(prob, &B, &D);
4707:   PetscDSGetConstants(prob, &numConstants, &constants);
4708:   if (probAux) {
4709:     PetscDSGetNumFields(probAux, &NfAux);
4710:     PetscDSGetTotalDimension(probAux, &totDimAux);
4711:     PetscDSGetDimensions(probAux, &NbAux);
4712:     PetscDSGetComponents(probAux, &NcAux);
4713:     PetscDSGetComponentOffsets(probAux, &aOff);
4714:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4715:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4716:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4717:     PetscDSGetTabulation(probAux, &BAux, &DAux);
4718:   }
4719:   NbI = Nb[field];
4720:   NcI = Nc[field];
4721:   BI  = B[field];
4722:   DI  = D[field];
4723:   for (e = 0; e < Ne; ++e) {
4724:     const PetscReal *quadPoints, *quadWeights;
4725:     PetscInt         qNc, Nq, q;

4727:     PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4728:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4729:     PetscMemzero(f0, Nq*Nc[field]* sizeof(PetscScalar));
4730:     PetscMemzero(f1, Nq*Nc[field]*dim * sizeof(PetscScalar));
4731:     for (q = 0; q < Nq; ++q) {
4732:       const PetscReal *v0   = cgeom[e*Nq+q].v0;
4733:       const PetscReal *J    = cgeom[e*Nq+q].J;
4734:       const PetscReal *invJ = cgeom[e*Nq+q].invJ;
4735:       const PetscReal  detJ = cgeom[e*Nq+q].detJ;

4737:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4738:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4739:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4740:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4741:       if (f0_func) f0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, numConstants, constants, &f0[q*NcI]);
4742:       if (f1_func) {
4743:         PetscMemzero(refSpaceDer, NcI*dim * sizeof(PetscScalar));
4744:         f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, numConstants, constants, refSpaceDer);
4745:       }
4746:       TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0, f1);
4747:     }
4748:     UpdateElementVec(dim, Nq, NbI, NcI, BI, DI, f0, f1, &elemVec[cOffset+fOffset]);
4749:     cOffset    += totDim;
4750:     cOffsetAux += totDimAux;
4751:   }
4752:   return(0);
4753: }

4755: PetscErrorCode PetscFEIntegrateBdResidual_Nonaffine(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEFaceGeom *fgeom,
4756:                                                 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4757: {
4758:   const PetscInt      debug = 0;
4759:   PetscBdPointFunc    f0_func;
4760:   PetscBdPointFunc    f1_func;
4761:   PetscQuadrature     quad;
4762:   PetscScalar        *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4763:   const PetscScalar *constants;
4764:   PetscReal          *x;
4765:   PetscReal         **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4766:   PetscInt           *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4767:   PetscInt            dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
4768:   PetscErrorCode      ierr;

4771:   PetscFEGetSpatialDimension(fem, &dim);
4772:   PetscFEGetFaceQuadrature(fem, &quad);
4773:   PetscDSGetNumFields(prob, &Nf);
4774:   PetscDSGetTotalDimension(prob, &totDim);
4775:   PetscDSGetDimensions(prob, &Nb);
4776:   PetscDSGetComponents(prob, &Nc);
4777:   PetscDSGetComponentOffsets(prob, &uOff);
4778:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4779:   PetscDSGetFieldOffset(prob, field, &fOffset);
4780:   PetscDSGetBdResidual(prob, field, &f0_func, &f1_func);
4781:   if (!f0_func && !f1_func) return(0);
4782:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4783:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4784:   PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4785:   PetscDSGetFaceTabulation(prob, &B, &D);
4786:   PetscDSGetConstants(prob, &numConstants, &constants);
4787:   if (probAux) {
4788:     PetscDSGetNumFields(probAux, &NfAux);
4789:     PetscDSGetTotalDimension(probAux, &totDimAux);
4790:     PetscDSGetDimensions(probAux, &NbAux);
4791:     PetscDSGetComponents(probAux, &NcAux);
4792:     PetscDSGetComponentOffsets(probAux, &aOff);
4793:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4794:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4795:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4796:     PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
4797:   }
4798:   NbI = Nb[field];
4799:   NcI = Nc[field];
4800:   BI  = B[field];
4801:   DI  = D[field];
4802:   for (e = 0; e < Ne; ++e) {
4803:     const PetscReal *quadPoints, *quadWeights;
4804:     PetscInt         qNc, Nq, q, face;

4806:     PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4807:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4808:      face = fgeom[e*Nq].face[0];
4809:      PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
4810:      PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
4811:      for (q = 0; q < Nq; ++q) {
4812:        const PetscReal *v0   = fgeom[e*Nq+q].v0;
4813:        const PetscReal *J    = fgeom[e*Nq+q].J;
4814:        const PetscReal *invJ = fgeom[e*Nq+q].invJ[0];
4815:        const PetscReal  detJ = fgeom[e*Nq+q].detJ;
4816:        const PetscReal *n    = fgeom[e*Nq+q].n;

4818:        if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4819:        CoordinatesRefToReal(dim, dim-1, v0, J, &quadPoints[q*(dim-1)], x);
4820:        EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4821:        if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4822:        if (f0_func) f0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, n, numConstants, constants, &f0[q*NcI]);
4823:        if (f1_func) {
4824:          PetscMemzero(refSpaceDer, NcI*dim * sizeof(PetscScalar));
4825:          f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, n, numConstants, constants, refSpaceDer);
4826:        }
4827:        TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
4828:      }
4829:      UpdateElementVec(dim, Nq, NbI, NcI, &BI[face*Nq*NbI*NcI], &DI[face*Nq*NbI*NcI*dim], f0, f1, &elemVec[cOffset+fOffset]);
4830:      cOffset    += totDim;
4831:      cOffsetAux += totDimAux;
4832:    }
4833:    return(0);
4834: }

4836: PetscErrorCode PetscFEIntegrateJacobian_Nonaffine(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFECellGeom *cgeom,
4837:                                                   const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
4838: {
4839:   const PetscInt     debug      = 0;
4840:   PetscPointJac      g0_func;
4841:   PetscPointJac      g1_func;
4842:   PetscPointJac      g2_func;
4843:   PetscPointJac      g3_func;
4844:   PetscInt           cOffset    = 0; /* Offset into coefficients[] for element e */
4845:   PetscInt           cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
4846:   PetscInt           eOffset    = 0; /* Offset into elemMat[] for element e */
4847:   PetscInt           offsetI    = 0; /* Offset into an element vector for fieldI */
4848:   PetscInt           offsetJ    = 0; /* Offset into an element vector for fieldJ */
4849:   PetscQuadrature    quad;
4850:   PetscScalar       *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4851:   const PetscScalar *constants;
4852:   PetscReal         *x;
4853:   PetscReal        **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
4854:   PetscInt           NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
4855:   PetscInt          *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4856:   PetscInt           dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, e;
4857:   PetscErrorCode     ierr;

4860:   PetscFEGetSpatialDimension(fem, &dim);
4861:   PetscFEGetQuadrature(fem, &quad);
4862:   PetscDSGetNumFields(prob, &Nf);
4863:   PetscDSGetTotalDimension(prob, &totDim);
4864:   PetscDSGetDimensions(prob, &Nb);
4865:   PetscDSGetComponents(prob, &Nc);
4866:   PetscDSGetComponentOffsets(prob, &uOff);
4867:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4868:   switch(jtype) {
4869:   case PETSCFE_JACOBIAN_DYN: PetscDSGetDynamicJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4870:   case PETSCFE_JACOBIAN_PRE: PetscDSGetJacobianPreconditioner(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4871:   case PETSCFE_JACOBIAN:     PetscDSGetJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4872:   }
4873:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4874:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4875:   PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
4876:   PetscDSGetTabulation(prob, &B, &D);
4877:   PetscDSGetFieldOffset(prob, fieldI, &offsetI);
4878:   PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
4879:   PetscDSGetConstants(prob, &numConstants, &constants);
4880:   if (probAux) {
4881:     PetscDSGetNumFields(probAux, &NfAux);
4882:     PetscDSGetTotalDimension(probAux, &totDimAux);
4883:     PetscDSGetDimensions(probAux, &NbAux);
4884:     PetscDSGetComponents(probAux, &NcAux);
4885:     PetscDSGetComponentOffsets(probAux, &aOff);
4886:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4887:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4888:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4889:     PetscDSGetTabulation(probAux, &BAux, &DAux);
4890:   }
4891:   NbI = Nb[fieldI], NbJ = Nb[fieldJ];
4892:   NcI = Nc[fieldI], NcJ = Nc[fieldJ];
4893:   BI  = B[fieldI],  BJ  = B[fieldJ];
4894:   DI  = D[fieldI],  DJ  = D[fieldJ];
4895:   /* Initialize here in case the function is not defined */
4896:   PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4897:   PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
4898:   PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
4899:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4900:   for (e = 0; e < Ne; ++e) {
4901:     const PetscReal *quadPoints, *quadWeights;
4902:     PetscInt         qNc, Nq, q;

4904:     PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4905:     if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4906:     for (q = 0; q < Nq; ++q) {
4907:       const PetscReal *v0   = cgeom[e*Nq+q].v0;
4908:       const PetscReal *J    = cgeom[e*Nq+q].J;
4909:       const PetscReal *invJ = cgeom[e*Nq+q].invJ;
4910:       const PetscReal  detJ = cgeom[e*Nq+q].detJ;
4911:       const PetscReal *BIq = &BI[q*NbI*NcI], *BJq = &BJ[q*NbJ*NcJ];
4912:       const PetscReal *DIq = &DI[q*NbI*NcI*dim], *DJq = &DJ[q*NbJ*NcJ*dim];
4913:       const PetscReal  w = detJ*quadWeights[q];
4914:       PetscInt         f, g, fc, gc, c;

4916:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4917:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4918:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4919:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4920:       if (g0_func) {
4921:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4922:         g0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, g0);
4923:         for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
4924:       }
4925:       if (g1_func) {
4926:         PetscInt d, d2;
4927:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4928:         g1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, refSpaceDer);
4929:         for (fc = 0; fc < NcI; ++fc) {
4930:           for (gc = 0; gc < NcJ; ++gc) {
4931:             for (d = 0; d < dim; ++d) {
4932:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
4933:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4934:               g1[(fc*NcJ+gc)*dim+d] *= w;
4935:             }
4936:           }
4937:         }
4938:       }
4939:       if (g2_func) {
4940:         PetscInt d, d2;
4941:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4942:         g2_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, refSpaceDer);
4943:         for (fc = 0; fc < NcI; ++fc) {
4944:           for (gc = 0; gc < NcJ; ++gc) {
4945:             for (d = 0; d < dim; ++d) {
4946:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
4947:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4948:               g2[(fc*NcJ+gc)*dim+d] *= w;
4949:             }
4950:           }
4951:         }
4952:       }
4953:       if (g3_func) {
4954:         PetscInt d, d2, dp, d3;
4955:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4956:         g3_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, refSpaceDer);
4957:         for (fc = 0; fc < NcI; ++fc) {
4958:           for (gc = 0; gc < NcJ; ++gc) {
4959:             for (d = 0; d < dim; ++d) {
4960:               for (dp = 0; dp < dim; ++dp) {
4961:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
4962:                 for (d2 = 0; d2 < dim; ++d2) {
4963:                   for (d3 = 0; d3 < dim; ++d3) {
4964:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
4965:                   }
4966:                 }
4967:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
4968:               }
4969:             }
4970:           }
4971:         }
4972:       }

4974:       for (f = 0; f < NbI; ++f) {
4975:         for (fc = 0; fc < NcI; ++fc) {
4976:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
4977:           const PetscInt i    = offsetI+f; /* Element matrix row */
4978:           for (g = 0; g < NbJ; ++g) {
4979:             for (gc = 0; gc < NcJ; ++gc) {
4980:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
4981:               const PetscInt j    = offsetJ+g; /* Element matrix column */
4982:               const PetscInt fOff = eOffset+i*totDim+j;
4983:               PetscInt       d, d2;

4985:               elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
4986:               for (d = 0; d < dim; ++d) {
4987:                 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
4988:                 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
4989:                 for (d2 = 0; d2 < dim; ++d2) {
4990:                   elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
4991:                 }
4992:               }
4993:             }
4994:           }
4995:         }
4996:       }
4997:     }
4998:     if (debug > 1) {
4999:       PetscInt fc, f, gc, g;

5001:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
5002:       for (fc = 0; fc < NcI; ++fc) {
5003:         for (f = 0; f < NbI; ++f) {
5004:           const PetscInt i = offsetI + f*NcI+fc;
5005:           for (gc = 0; gc < NcJ; ++gc) {
5006:             for (g = 0; g < NbJ; ++g) {
5007:               const PetscInt j = offsetJ + g*NcJ+gc;
5008:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
5009:             }
5010:           }
5011:           PetscPrintf(PETSC_COMM_SELF, "\n");
5012:         }
5013:       }
5014:     }
5015:     cOffset    += totDim;
5016:     cOffsetAux += totDimAux;
5017:     eOffset    += PetscSqr(totDim);
5018:   }
5019:   return(0);
5020: }

5022: PetscErrorCode PetscFEInitialize_Nonaffine(PetscFE fem)
5023: {
5025:   fem->ops->setfromoptions          = NULL;
5026:   fem->ops->setup                   = PetscFESetUp_Basic;
5027:   fem->ops->view                    = NULL;
5028:   fem->ops->destroy                 = PetscFEDestroy_Nonaffine;
5029:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
5030:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
5031:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Nonaffine;
5032:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Nonaffine;
5033:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Nonaffine */;
5034:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Nonaffine;
5035:   return(0);
5036: }

5038: /*MC
5039:   PETSCFENONAFFINE = "nonaffine" - A PetscFE object that integrates with basic tiling and no vectorization for non-affine mappings

5041:   Level: intermediate

5043: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
5044: M*/

5046: PETSC_EXTERN PetscErrorCode PetscFECreate_Nonaffine(PetscFE fem)
5047: {
5048:   PetscFE_Nonaffine *na;
5049:   PetscErrorCode     ierr;

5053:   PetscNewLog(fem, &na);
5054:   fem->data = na;

5056:   PetscFEInitialize_Nonaffine(fem);
5057:   return(0);
5058: }

5060: #ifdef PETSC_HAVE_OPENCL

5062: PetscErrorCode PetscFEDestroy_OpenCL(PetscFE fem)
5063: {
5064:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5065:   PetscErrorCode  ierr;

5068:   clReleaseCommandQueue(ocl->queue_id);
5069:   ocl->queue_id = 0;
5070:   clReleaseContext(ocl->ctx_id);
5071:   ocl->ctx_id = 0;
5072:   PetscFree(ocl);
5073:   return(0);
5074: }

5076: #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)
5077: enum {LAPLACIAN = 0, ELASTICITY = 1};

5079: /* NOTE: This is now broken for vector problems. Must redo loops to respect vector basis elements */
5080: /* dim     Number of spatial dimensions:          2                   */
5081: /* N_b     Number of basis functions:             generated           */
5082: /* N_{bt}  Number of total basis functions:       N_b * N_{comp}      */
5083: /* N_q     Number of quadrature points:           generated           */
5084: /* N_{bs}  Number of block cells                  LCM(N_b, N_q)       */
5085: /* N_{bst} Number of block cell components        LCM(N_{bt}, N_q)    */
5086: /* N_{bl}  Number of concurrent blocks            generated           */
5087: /* N_t     Number of threads:                     N_{bl} * N_{bs}     */
5088: /* N_{cbc} Number of concurrent basis      cells: N_{bl} * N_q        */
5089: /* N_{cqc} Number of concurrent quadrature cells: N_{bl} * N_b        */
5090: /* N_{sbc} Number of serial     basis      cells: N_{bs} / N_q        */
5091: /* N_{sqc} Number of serial     quadrature cells: N_{bs} / N_b        */
5092: /* N_{cb}  Number of serial cell batches:         input               */
5093: /* N_c     Number of total cells:                 N_{cb}*N_{t}/N_{comp} */
5094: PetscErrorCode PetscFEOpenCLGenerateIntegrationCode(PetscFE fem, char **string_buffer, PetscInt buffer_length, PetscBool useAux, PetscInt N_bl)
5095: {
5096:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5097:   PetscQuadrature q;
5098:   char           *string_tail   = *string_buffer;
5099:   char           *end_of_buffer = *string_buffer + buffer_length;
5100:   char            float_str[]   = "float", double_str[]  = "double";
5101:   char           *numeric_str   = &(float_str[0]);
5102:   PetscInt        op            = ocl->op;
5103:   PetscBool       useField      = PETSC_FALSE;
5104:   PetscBool       useFieldDer   = PETSC_TRUE;
5105:   PetscBool       useFieldAux   = useAux;
5106:   PetscBool       useFieldDerAux= PETSC_FALSE;
5107:   PetscBool       useF0         = PETSC_TRUE;
5108:   PetscBool       useF1         = PETSC_TRUE;
5109:   const PetscReal *points, *weights;
5110:   PetscReal      *basis, *basisDer;
5111:   PetscInt        dim, qNc, N_b, N_c, N_q, N_t, p, d, b, c;
5112:   size_t          count;
5113:   PetscErrorCode  ierr;

5116:   PetscFEGetSpatialDimension(fem, &dim);
5117:   PetscFEGetDimension(fem, &N_b);
5118:   PetscFEGetNumComponents(fem, &N_c);
5119:   PetscFEGetQuadrature(fem, &q);
5120:   PetscQuadratureGetData(q, NULL, &qNc, &N_q, &points, &weights);
5121:   if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
5122:   N_t  = N_b * N_c * N_q * N_bl;
5123:   /* Enable device extension for double precision */
5124:   if (ocl->realType == PETSC_DOUBLE) {
5125:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5126: "#if defined(cl_khr_fp64)\n"
5127: "#  pragma OPENCL EXTENSION cl_khr_fp64: enable\n"
5128: "#elif defined(cl_amd_fp64)\n"
5129: "#  pragma OPENCL EXTENSION cl_amd_fp64: enable\n"
5130: "#endif\n",
5131:                               &count);STRING_ERROR_CHECK("Message to short");
5132:     numeric_str  = &(double_str[0]);
5133:   }
5134:   /* Kernel API */
5135:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5136: "\n"
5137: "__kernel void integrateElementQuadrature(int N_cb, __global %s *coefficients, __global %s *coefficientsAux, __global %s *jacobianInverses, __global %s *jacobianDeterminants, __global %s *elemVec)\n"
5138: "{\n",
5139:                        &count, numeric_str, numeric_str, numeric_str, numeric_str, numeric_str);STRING_ERROR_CHECK("Message to short");
5140:   /* Quadrature */
5141:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5142: "  /* Quadrature points\n"
5143: "   - (x1,y1,x2,y2,...) */\n"
5144: "  const %s points[%d] = {\n",
5145:                        &count, numeric_str, N_q*dim);STRING_ERROR_CHECK("Message to short");
5146:   for (p = 0; p < N_q; ++p) {
5147:     for (d = 0; d < dim; ++d) {
5148:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "%g,\n", &count, points[p*dim+d]);STRING_ERROR_CHECK("Message to short");
5149:     }
5150:   }
5151:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
5152:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5153: "  /* Quadrature weights\n"
5154: "   - (v1,v2,...) */\n"
5155: "  const %s weights[%d] = {\n",
5156:                        &count, numeric_str, N_q);STRING_ERROR_CHECK("Message to short");
5157:   for (p = 0; p < N_q; ++p) {
5158:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "%g,\n", &count, weights[p]);STRING_ERROR_CHECK("Message to short");
5159:   }
5160:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
5161:   /* Basis Functions */
5162:   PetscFEGetDefaultTabulation(fem, &basis, &basisDer, NULL);
5163:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5164: "  /* Nodal basis function evaluations\n"
5165: "    - basis component is fastest varying, the basis function, then point */\n"
5166: "  const %s Basis[%d] = {\n",
5167:                        &count, numeric_str, N_q*N_b*N_c);STRING_ERROR_CHECK("Message to short");
5168:   for (p = 0; p < N_q; ++p) {
5169:     for (b = 0; b < N_b; ++b) {
5170:       for (c = 0; c < N_c; ++c) {
5171:         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");
5172:       }
5173:     }
5174:   }
5175:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
5176:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5177: "\n"
5178: "  /* Nodal basis function derivative evaluations,\n"
5179: "      - derivative direction is fastest varying, then basis component, then basis function, then point */\n"
5180: "  const %s%d BasisDerivatives[%d] = {\n",
5181:                        &count, numeric_str, dim, N_q*N_b*N_c);STRING_ERROR_CHECK("Message to short");
5182:   for (p = 0; p < N_q; ++p) {
5183:     for (b = 0; b < N_b; ++b) {
5184:       for (c = 0; c < N_c; ++c) {
5185:         PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "(%s%d)(", &count, numeric_str, dim);STRING_ERROR_CHECK("Message to short");
5186:         for (d = 0; d < dim; ++d) {
5187:           if (d > 0) {
5188:             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");
5189:           } else {
5190:             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");
5191:           }
5192:         }
5193:         PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "),\n", &count);STRING_ERROR_CHECK("Message to short");
5194:       }
5195:     }
5196:   }
5197:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
5198:   /* Sizes */
5199:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5200: "  const int dim    = %d;                           // The spatial dimension\n"
5201: "  const int N_bl   = %d;                           // The number of concurrent blocks\n"
5202: "  const int N_b    = %d;                           // The number of basis functions\n"
5203: "  const int N_comp = %d;                           // The number of basis function components\n"
5204: "  const int N_bt   = N_b*N_comp;                    // The total number of scalar basis functions\n"
5205: "  const int N_q    = %d;                           // The number of quadrature points\n"
5206: "  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"
5207: "  const int N_t    = N_bst*N_bl;                    // The number of threads, N_bst * N_bl\n"
5208: "  const int N_bc   = N_t/N_comp;                    // The number of cells per batch (N_b*N_q*N_bl)\n"
5209: "  const int N_sbc  = N_bst / (N_q * N_comp);\n"
5210: "  const int N_sqc  = N_bst / N_bt;\n"
5211: "  /*const int N_c    = N_cb * N_bc;*/\n"
5212: "\n"
5213: "  /* Calculated indices */\n"
5214: "  /*const int tidx    = get_local_id(0) + get_local_size(0)*get_local_id(1);*/\n"
5215: "  const int tidx    = get_local_id(0);\n"
5216: "  const int blidx   = tidx / N_bst;                  // Block number for this thread\n"
5217: "  const int bidx    = tidx %% N_bt;                   // Basis function mapped to this thread\n"
5218: "  const int cidx    = tidx %% N_comp;                 // Basis component mapped to this thread\n"
5219: "  const int qidx    = tidx %% N_q;                    // Quadrature point mapped to this thread\n"
5220: "  const int blbidx  = tidx %% N_q + blidx*N_q;        // Cell mapped to this thread in the basis phase\n"
5221: "  const int blqidx  = tidx %% N_b + blidx*N_b;        // Cell mapped to this thread in the quadrature phase\n"
5222: "  const int gidx    = get_group_id(1)*get_num_groups(0) + get_group_id(0);\n"
5223: "  const int Goffset = gidx*N_cb*N_bc;\n",
5224:                             &count, dim, N_bl, N_b, N_c, N_q);STRING_ERROR_CHECK("Message to short");
5225:   /* Local memory */
5226:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5227: "\n"
5228: "  /* Quadrature data */\n"
5229: "  %s                w;                   // $w_q$, Quadrature weight at $x_q$\n"
5230: "  __local %s         phi_i[%d];    //[N_bt*N_q];  // $\\phi_i(x_q)$, Value of the basis function $i$ at $x_q$\n"
5231: "  __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"
5232: "  /* Geometric data */\n"
5233: "  __local %s        detJ[%d]; //[N_t];           // $|J(x_q)|$, Jacobian determinant at $x_q$\n"
5234: "  __local %s        invJ[%d];//[N_t*dim*dim];   // $J^{-1}(x_q)$, Jacobian inverse at $x_q$\n",
5235:                             &count, numeric_str, numeric_str, N_b*N_c*N_q, numeric_str, dim, N_b*N_c*N_q, numeric_str, N_t,
5236:                             numeric_str, N_t*dim*dim, numeric_str, N_t*N_b*N_c);STRING_ERROR_CHECK("Message to short");
5237:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5238: "  /* FEM data */\n"
5239: "  __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",
5240:                             &count, numeric_str, N_t*N_b*N_c);STRING_ERROR_CHECK("Message to short");
5241:   if (useAux) {
5242:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5243: "  __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",
5244:                             &count, numeric_str, N_t);STRING_ERROR_CHECK("Message to short");
5245:   }
5246:   if (useF0) {
5247:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5248: "  /* Intermediate calculations */\n"
5249: "  __local %s         f_0[%d]; //[N_t*N_sqc];      // $f_0(u(x_q), \\nabla u(x_q)) |J(x_q)| w_q$\n",
5250:                               &count, numeric_str, N_t*N_q);STRING_ERROR_CHECK("Message to short");
5251:   }
5252:   if (useF1) {
5253:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5254: "  __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",
5255:                               &count, numeric_str, dim, N_t*N_q);STRING_ERROR_CHECK("Message to short");
5256:   }
5257:   /* TODO: If using elasticity, put in mu/lambda coefficients */
5258:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5259: "  /* Output data */\n"
5260: "  %s                e_i;                 // Coefficient $e_i$ of the residual\n\n",
5261:                             &count, numeric_str);STRING_ERROR_CHECK("Message to short");
5262:   /* One-time loads */
5263:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5264: "  /* These should be generated inline */\n"
5265: "  /* Load quadrature weights */\n"
5266: "  w = weights[qidx];\n"
5267: "  /* Load basis tabulation \\phi_i for this cell */\n"
5268: "  if (tidx < N_bt*N_q) {\n"
5269: "    phi_i[tidx]    = Basis[tidx];\n"
5270: "    phiDer_i[tidx] = BasisDerivatives[tidx];\n"
5271: "  }\n\n",
5272:                        &count);STRING_ERROR_CHECK("Message to short");
5273:   /* Batch loads */
5274:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5275: "  for (int batch = 0; batch < N_cb; ++batch) {\n"
5276: "    /* Load geometry */\n"
5277: "    detJ[tidx] = jacobianDeterminants[Goffset+batch*N_bc+tidx];\n"
5278: "    for (int n = 0; n < dim*dim; ++n) {\n"
5279: "      const int offset = n*N_t;\n"
5280: "      invJ[offset+tidx] = jacobianInverses[(Goffset+batch*N_bc)*dim*dim+offset+tidx];\n"
5281: "    }\n"
5282: "    /* Load coefficients u_i for this cell */\n"
5283: "    for (int n = 0; n < N_bt; ++n) {\n"
5284: "      const int offset = n*N_t;\n"
5285: "      u_i[offset+tidx] = coefficients[(Goffset*N_bt)+batch*N_t*N_b+offset+tidx];\n"
5286: "    }\n",
5287:                        &count);STRING_ERROR_CHECK("Message to short");
5288:   if (useAux) {
5289:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5290: "    /* Load coefficients a_i for this cell */\n"
5291: "    /* TODO: This should not be N_t here, it should be N_bc*N_comp_aux */\n"
5292: "    a_i[tidx] = coefficientsAux[Goffset+batch*N_t+tidx];\n",
5293:                             &count);STRING_ERROR_CHECK("Message to short");
5294:   }
5295:   /* Quadrature phase */
5296:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5297: "    barrier(CLK_LOCAL_MEM_FENCE);\n"
5298: "\n"
5299: "    /* Map coefficients to values at quadrature points */\n"
5300: "    for (int c = 0; c < N_sqc; ++c) {\n"
5301: "      const int cell          = c*N_bl*N_b + blqidx;\n"
5302: "      const int fidx          = (cell*N_q + qidx)*N_comp + cidx;\n",
5303:                        &count);STRING_ERROR_CHECK("Message to short");
5304:   if (useField) {
5305:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5306: "      %s  u[%d]; //[N_comp];     // $u(x_q)$, Value of the field at $x_q$\n",
5307:                               &count, numeric_str, N_c);STRING_ERROR_CHECK("Message to short");
5308:   }
5309:   if (useFieldDer) {
5310:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5311: "      %s%d   gradU[%d]; //[N_comp]; // $\\nabla u(x_q)$, Value of the field gradient at $x_q$\n",
5312:                               &count, numeric_str, dim, N_c);STRING_ERROR_CHECK("Message to short");
5313:   }
5314:   if (useFieldAux) {
5315:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5316: "      %s  a[%d]; //[1];     // $a(x_q)$, Value of the auxiliary fields at $x_q$\n",
5317:                               &count, numeric_str, 1);STRING_ERROR_CHECK("Message to short");
5318:   }
5319:   if (useFieldDerAux) {
5320:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5321: "      %s%d   gradA[%d]; //[1]; // $\\nabla a(x_q)$, Value of the auxiliary field gradient at $x_q$\n",
5322:                               &count, numeric_str, dim, 1);STRING_ERROR_CHECK("Message to short");
5323:   }
5324:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5325: "\n"
5326: "      for (int comp = 0; comp < N_comp; ++comp) {\n",
5327:                             &count);STRING_ERROR_CHECK("Message to short");
5328:   if (useField) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "        u[comp] = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");}
5329:   if (useFieldDer) {
5330:     switch (dim) {
5331:     case 1:
5332:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "        gradU[comp].x = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");break;
5333:     case 2:
5334:       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;
5335:     case 3:
5336:       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;
5337:     }
5338:   }
5339:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5340: "      }\n",
5341:                             &count);STRING_ERROR_CHECK("Message to short");
5342:   if (useFieldAux) {
5343:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      a[0] = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");
5344:   }
5345:   if (useFieldDerAux) {
5346:     switch (dim) {
5347:     case 1:
5348:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      gradA[0].x = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");break;
5349:     case 2:
5350:       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;
5351:     case 3:
5352:       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;
5353:     }
5354:   }
5355:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5356: "      /* Get field and derivatives at this quadrature point */\n"
5357: "      for (int i = 0; i < N_b; ++i) {\n"
5358: "        for (int comp = 0; comp < N_comp; ++comp) {\n"
5359: "          const int b    = i*N_comp+comp;\n"
5360: "          const int pidx = qidx*N_bt + b;\n"
5361: "          const int uidx = cell*N_bt + b;\n"
5362: "          %s%d   realSpaceDer;\n\n",
5363:                             &count, numeric_str, dim);STRING_ERROR_CHECK("Message to short");
5364:   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");}
5365:   if (useFieldDer) {
5366:     switch (dim) {
5367:     case 2:
5368:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5369: "          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"
5370: "          gradU[comp].x += u_i[uidx]*realSpaceDer.x;\n"
5371: "          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"
5372: "          gradU[comp].y += u_i[uidx]*realSpaceDer.y;\n",
5373:                            &count);STRING_ERROR_CHECK("Message to short");break;
5374:     case 3:
5375:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5376: "          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"
5377: "          gradU[comp].x += u_i[uidx]*realSpaceDer.x;\n"
5378: "          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"
5379: "          gradU[comp].y += u_i[uidx]*realSpaceDer.y;\n"
5380: "          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"
5381: "          gradU[comp].z += u_i[uidx]*realSpaceDer.z;\n",
5382:                            &count);STRING_ERROR_CHECK("Message to short");break;
5383:     }
5384:   }
5385:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5386: "        }\n"
5387: "      }\n",
5388:                             &count);STRING_ERROR_CHECK("Message to short");
5389:   if (useFieldAux) {
5390:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"          a[0] += a_i[cell];\n", &count);STRING_ERROR_CHECK("Message to short");
5391:   }
5392:   /* Calculate residual at quadrature points: Should be generated by an weak form egine */
5393:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5394: "      /* Process values at quadrature points */\n",
5395:                             &count);STRING_ERROR_CHECK("Message to short");
5396:   switch (op) {
5397:   case LAPLACIAN:
5398:     if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      f_0[fidx] = 4.0;\n", &count);STRING_ERROR_CHECK("Message to short");}
5399:     if (useF1) {
5400:       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");}
5401:       else        {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      f_1[fidx] = gradU[cidx];\n", &count);STRING_ERROR_CHECK("Message to short");}
5402:     }
5403:     break;
5404:   case ELASTICITY:
5405:     if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      f_0[fidx] = 4.0;\n", &count);STRING_ERROR_CHECK("Message to short");}
5406:     if (useF1) {
5407:     switch (dim) {
5408:     case 2:
5409:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5410: "      switch (cidx) {\n"
5411: "      case 0:\n"
5412: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[0].x + gradU[0].x);\n"
5413: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[0].y + gradU[1].x);\n"
5414: "        break;\n"
5415: "      case 1:\n"
5416: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[1].x + gradU[0].y);\n"
5417: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[1].y + gradU[1].y);\n"
5418: "      }\n",
5419:                            &count);STRING_ERROR_CHECK("Message to short");break;
5420:     case 3:
5421:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5422: "      switch (cidx) {\n"
5423: "      case 0:\n"
5424: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[0].x + gradU[0].x);\n"
5425: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[0].y + gradU[1].x);\n"
5426: "        f_1[fidx].z = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[0].z + gradU[2].x);\n"
5427: "        break;\n"
5428: "      case 1:\n"
5429: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[1].x + gradU[0].y);\n"
5430: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[1].y + gradU[1].y);\n"
5431: "        f_1[fidx].z = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[1].y + gradU[2].y);\n"
5432: "        break;\n"
5433: "      case 2:\n"
5434: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[2].x + gradU[0].z);\n"
5435: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[2].y + gradU[1].z);\n"
5436: "        f_1[fidx].z = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[2].y + gradU[2].z);\n"
5437: "      }\n",
5438:                            &count);STRING_ERROR_CHECK("Message to short");break;
5439:     }}
5440:     break;
5441:   default:
5442:     SETERRQ1(PETSC_COMM_WORLD, PETSC_ERR_SUP, "PDE operator %d is not supported", op);
5443:   }
5444:   if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"      f_0[fidx] *= detJ[cell]*w;\n", &count);STRING_ERROR_CHECK("Message to short");}
5445:   if (useF1) {
5446:     switch (dim) {
5447:     case 1:
5448:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"      f_1[fidx].x *= detJ[cell]*w;\n", &count);STRING_ERROR_CHECK("Message to short");break;
5449:     case 2:
5450:       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;
5451:     case 3:
5452:       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;
5453:     }
5454:   }
5455:   /* Thread transpose */
5456:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5457: "    }\n\n"
5458: "    /* ==== TRANSPOSE THREADS ==== */\n"
5459: "    barrier(CLK_LOCAL_MEM_FENCE);\n\n",
5460:                        &count);STRING_ERROR_CHECK("Message to short");
5461:   /* Basis phase */
5462:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5463: "    /* Map values at quadrature points to coefficients */\n"
5464: "    for (int c = 0; c < N_sbc; ++c) {\n"
5465: "      const int cell = c*N_bl*N_q + blbidx; /* Cell number in batch */\n"
5466: "\n"
5467: "      e_i = 0.0;\n"
5468: "      for (int q = 0; q < N_q; ++q) {\n"
5469: "        const int pidx = q*N_bt + bidx;\n"
5470: "        const int fidx = (cell*N_q + q)*N_comp + cidx;\n"
5471: "        %s%d   realSpaceDer;\n\n",
5472:                        &count, numeric_str, dim);STRING_ERROR_CHECK("Message to short");

5474:   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");}
5475:   if (useF1) {
5476:     switch (dim) {
5477:     case 2:
5478:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5479: "        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"
5480: "        e_i           += realSpaceDer.x*f_1[fidx].x;\n"
5481: "        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"
5482: "        e_i           += realSpaceDer.y*f_1[fidx].y;\n",
5483:                            &count);STRING_ERROR_CHECK("Message to short");break;
5484:     case 3:
5485:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5486: "        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"
5487: "        e_i           += realSpaceDer.x*f_1[fidx].x;\n"
5488: "        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"
5489: "        e_i           += realSpaceDer.y*f_1[fidx].y;\n"
5490: "        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"
5491: "        e_i           += realSpaceDer.z*f_1[fidx].z;\n",
5492:                            &count);STRING_ERROR_CHECK("Message to short");break;
5493:     }
5494:   }
5495:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5496: "      }\n"
5497: "      /* Write element vector for N_{cbc} cells at a time */\n"
5498: "      elemVec[(Goffset + batch*N_bc + c*N_bl*N_q)*N_bt + tidx] = e_i;\n"
5499: "    }\n"
5500: "    /* ==== Could do one write per batch ==== */\n"
5501: "  }\n"
5502: "  return;\n"
5503: "}\n",
5504:                        &count);STRING_ERROR_CHECK("Message to short");
5505:   return(0);
5506: }

5508: PetscErrorCode PetscFEOpenCLGetIntegrationKernel(PetscFE fem, PetscBool useAux, cl_program *ocl_prog, cl_kernel *ocl_kernel)
5509: {
5510:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5511:   PetscInt        dim, N_bl;
5512:   PetscBool       flg;
5513:   char           *buffer;
5514:   size_t          len;
5515:   char            errMsg[8192];
5516:   cl_int          ierr2;
5517:   PetscErrorCode  ierr;

5520:   PetscFEGetSpatialDimension(fem, &dim);
5521:   PetscMalloc1(8192, &buffer);
5522:   PetscFEGetTileSizes(fem, NULL, &N_bl, NULL, NULL);
5523:   PetscFEOpenCLGenerateIntegrationCode(fem, &buffer, 8192, useAux, N_bl);
5524:   PetscOptionsHasName(((PetscObject)fem)->options,((PetscObject)fem)->prefix, "-petscfe_opencl_kernel_print", &flg);
5525:   if (flg) {PetscPrintf(PetscObjectComm((PetscObject) fem), "OpenCL FE Integration Kernel:\n%s\n", buffer);}
5526:   len  = strlen(buffer);
5527:   *ocl_prog = clCreateProgramWithSource(ocl->ctx_id, 1, (const char **) &buffer, &len, &ierr2);CHKERRQ(ierr2);
5528:   clBuildProgram(*ocl_prog, 0, NULL, NULL, NULL, NULL);
5529:   if (ierr != CL_SUCCESS) {
5530:     clGetProgramBuildInfo(*ocl_prog, ocl->dev_id, CL_PROGRAM_BUILD_LOG, 8192*sizeof(char), &errMsg, NULL);
5531:     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Build failed! Log:\n %s", errMsg);
5532:   }
5533:   PetscFree(buffer);
5534:   *ocl_kernel = clCreateKernel(*ocl_prog, "integrateElementQuadrature", &ierr);
5535:   return(0);
5536: }

5538: PetscErrorCode PetscFEOpenCLCalculateGrid(PetscFE fem, PetscInt N, PetscInt blockSize, size_t *x, size_t *y, size_t *z)
5539: {
5540:   const PetscInt Nblocks = N/blockSize;

5543:   if (N % blockSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Invalid block size %d for %d elements", blockSize, N);
5544:   *z = 1;
5545:   for (*x = (size_t) (PetscSqrtReal(Nblocks) + 0.5); *x > 0; --*x) {
5546:     *y = Nblocks / *x;
5547:     if (*x * *y == Nblocks) break;
5548:   }
5549:   if (*x * *y != Nblocks) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Could not find partition for %d with block size %d", N, blockSize);
5550:   return(0);
5551: }

5553: PetscErrorCode PetscFEOpenCLLogResidual(PetscFE fem, PetscLogDouble time, PetscLogDouble flops)
5554: {
5555:   PetscFE_OpenCL   *ocl = (PetscFE_OpenCL *) fem->data;
5556:   PetscStageLog     stageLog;
5557:   PetscEventPerfLog eventLog = NULL;
5558:   PetscInt          stage;
5559:   PetscErrorCode    ierr;

5562:   PetscLogGetStageLog(&stageLog);
5563:   PetscStageLogGetCurrent(stageLog, &stage);
5564:   PetscStageLogGetEventPerfLog(stageLog, stage, &eventLog);
5565:     /* Log performance info */
5566:   eventLog->eventInfo[ocl->residualEvent].count++;
5567:   eventLog->eventInfo[ocl->residualEvent].time  += time;
5568:   eventLog->eventInfo[ocl->residualEvent].flops += flops;
5569:   return(0);
5570: }

5572: PetscErrorCode PetscFEIntegrateResidual_OpenCL(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
5573:                                                const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
5574: {
5575:   /* Nbc = batchSize */
5576:   PetscFE_OpenCL   *ocl = (PetscFE_OpenCL *) fem->data;
5577:   PetscPointFunc    f0_func;
5578:   PetscPointFunc    f1_func;
5579:   PetscQuadrature   q;
5580:   PetscInt          dim, qNc;
5581:   PetscInt          N_b;    /* The number of basis functions */
5582:   PetscInt          N_comp; /* The number of basis function components */
5583:   PetscInt          N_bt;   /* The total number of scalar basis functions */
5584:   PetscInt          N_q;    /* The number of quadrature points */
5585:   PetscInt          N_bst;  /* The block size, LCM(N_bt, N_q), Notice that a block is not process simultaneously */
5586:   PetscInt          N_t;    /* The number of threads, N_bst * N_bl */
5587:   PetscInt          N_bl;   /* The number of blocks */
5588:   PetscInt          N_bc;   /* The batch size, N_bl*N_q*N_b */
5589:   PetscInt          N_cb;   /* The number of batches */
5590:   PetscInt          numFlops, f0Flops = 0, f1Flops = 0;
5591:   PetscBool         useAux      = probAux ? PETSC_TRUE : PETSC_FALSE;
5592:   PetscBool         useField    = PETSC_FALSE;
5593:   PetscBool         useFieldDer = PETSC_TRUE;
5594:   PetscBool         useF0       = PETSC_TRUE;
5595:   PetscBool         useF1       = PETSC_TRUE;
5596:   /* OpenCL variables */
5597:   cl_program        ocl_prog;
5598:   cl_kernel         ocl_kernel;
5599:   cl_event          ocl_ev;         /* The event for tracking kernel execution */
5600:   cl_ulong          ns_start;       /* Nanoseconds counter on GPU at kernel start */
5601:   cl_ulong          ns_end;         /* Nanoseconds counter on GPU at kernel stop */
5602:   cl_mem            o_jacobianInverses, o_jacobianDeterminants;
5603:   cl_mem            o_coefficients, o_coefficientsAux, o_elemVec;
5604:   float            *f_coeff = NULL, *f_coeffAux = NULL, *f_invJ = NULL, *f_detJ = NULL;
5605:   double           *d_coeff = NULL, *d_coeffAux = NULL, *d_invJ = NULL, *d_detJ = NULL;
5606:   PetscReal        *r_invJ = NULL, *r_detJ = NULL;
5607:   void             *oclCoeff, *oclCoeffAux, *oclInvJ, *oclDetJ;
5608:   size_t            local_work_size[3], global_work_size[3];
5609:   size_t            realSize, x, y, z;
5610:   const PetscReal   *points, *weights;
5611:   PetscErrorCode    ierr;

5614:   if (!Ne) {PetscFEOpenCLLogResidual(fem, 0.0, 0.0); return(0);}
5615:   PetscFEGetSpatialDimension(fem, &dim);
5616:   PetscFEGetQuadrature(fem, &q);
5617:   PetscQuadratureGetData(q, NULL, &qNc, &N_q, &points, &weights);
5618:   if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
5619:   PetscFEGetDimension(fem, &N_b);
5620:   PetscFEGetNumComponents(fem, &N_comp);
5621:   PetscDSGetResidual(prob, field, &f0_func, &f1_func);
5622:   PetscFEGetTileSizes(fem, NULL, &N_bl, &N_bc, &N_cb);
5623:   N_bt  = N_b*N_comp;
5624:   N_bst = N_bt*N_q;
5625:   N_t   = N_bst*N_bl;
5626:   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);
5627:   /* Calculate layout */
5628:   if (Ne % (N_cb*N_bc)) { /* Remainder cells */
5629:     PetscFEIntegrateResidual_Basic(fem, prob, field, Ne, cgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);
5630:     return(0);
5631:   }
5632:   PetscFEOpenCLCalculateGrid(fem, Ne, N_cb*N_bc, &x, &y, &z);
5633:   local_work_size[0]  = N_bc*N_comp;
5634:   local_work_size[1]  = 1;
5635:   local_work_size[2]  = 1;
5636:   global_work_size[0] = x * local_work_size[0];
5637:   global_work_size[1] = y * local_work_size[1];
5638:   global_work_size[2] = z * local_work_size[2];
5639:   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);
5640:   PetscInfo2(fem, " N_t: %d, N_cb: %d\n", N_t, N_cb);
5641:   /* Generate code */
5642:   if (probAux) {
5643:     PetscSpace P;
5644:     PetscInt   NfAux, order, f;

5646:     PetscDSGetNumFields(probAux, &NfAux);
5647:     for (f = 0; f < NfAux; ++f) {
5648:       PetscFE feAux;

5650:       PetscDSGetDiscretization(probAux, f, (PetscObject *) &feAux);
5651:       PetscFEGetBasisSpace(feAux, &P);
5652:       PetscSpaceGetOrder(P, &order);
5653:       if (order > 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Can only handle P0 coefficient fields");
5654:     }
5655:   }
5656:   PetscFEOpenCLGetIntegrationKernel(fem, useAux, &ocl_prog, &ocl_kernel);
5657:   /* Create buffers on the device and send data over */
5658:   PetscDataTypeGetSize(ocl->realType, &realSize);
5659:   if (sizeof(PetscReal) != realSize) {
5660:     switch (ocl->realType) {
5661:     case PETSC_FLOAT:
5662:     {
5663:       PetscInt c, b, d;

5665:       PetscMalloc4(Ne*N_bt,&f_coeff,Ne,&f_coeffAux,Ne*dim*dim,&f_invJ,Ne,&f_detJ);
5666:       for (c = 0; c < Ne; ++c) {
5667:         f_detJ[c] = (float) cgeom[c].detJ;
5668:         for (d = 0; d < dim*dim; ++d) {
5669:           f_invJ[c*dim*dim+d] = (float) cgeom[c].invJ[d];
5670:         }
5671:         for (b = 0; b < N_bt; ++b) {
5672:           f_coeff[c*N_bt+b] = (float) coefficients[c*N_bt+b];
5673:         }
5674:       }
5675:       if (coefficientsAux) { /* Assume P0 */
5676:         for (c = 0; c < Ne; ++c) {
5677:           f_coeffAux[c] = (float) coefficientsAux[c];
5678:         }
5679:       }
5680:       oclCoeff      = (void *) f_coeff;
5681:       if (coefficientsAux) {
5682:         oclCoeffAux = (void *) f_coeffAux;
5683:       } else {
5684:         oclCoeffAux = NULL;
5685:       }
5686:       oclInvJ       = (void *) f_invJ;
5687:       oclDetJ       = (void *) f_detJ;
5688:     }
5689:     break;
5690:     case PETSC_DOUBLE:
5691:     {
5692:       PetscInt c, b, d;

5694:       PetscMalloc4(Ne*N_bt,&d_coeff,Ne,&d_coeffAux,Ne*dim*dim,&d_invJ,Ne,&d_detJ);
5695:       for (c = 0; c < Ne; ++c) {
5696:         d_detJ[c] = (double) cgeom[c].detJ;
5697:         for (d = 0; d < dim*dim; ++d) {
5698:           d_invJ[c*dim*dim+d] = (double) cgeom[c].invJ[d];
5699:         }
5700:         for (b = 0; b < N_bt; ++b) {
5701:           d_coeff[c*N_bt+b] = (double) coefficients[c*N_bt+b];
5702:         }
5703:       }
5704:       if (coefficientsAux) { /* Assume P0 */
5705:         for (c = 0; c < Ne; ++c) {
5706:           d_coeffAux[c] = (double) coefficientsAux[c];
5707:         }
5708:       }
5709:       oclCoeff      = (void *) d_coeff;
5710:       if (coefficientsAux) {
5711:         oclCoeffAux = (void *) d_coeffAux;
5712:       } else {
5713:         oclCoeffAux = NULL;
5714:       }
5715:       oclInvJ       = (void *) d_invJ;
5716:       oclDetJ       = (void *) d_detJ;
5717:     }
5718:     break;
5719:     default:
5720:       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported PETSc type %d", ocl->realType);
5721:     }
5722:   } else {
5723:     PetscInt c, d;

5725:     PetscMalloc2(Ne*dim*dim,&r_invJ,Ne,&r_detJ);
5726:     for (c = 0; c < Ne; ++c) {
5727:       r_detJ[c] = cgeom[c].detJ;
5728:       for (d = 0; d < dim*dim; ++d) {
5729:         r_invJ[c*dim*dim+d] = cgeom[c].invJ[d];
5730:       }
5731:     }
5732:     oclCoeff    = (void *) coefficients;
5733:     oclCoeffAux = (void *) coefficientsAux;
5734:     oclInvJ     = (void *) r_invJ;
5735:     oclDetJ     = (void *) r_detJ;
5736:   }
5737:   o_coefficients         = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne*N_bt    * realSize, oclCoeff,    &ierr);
5738:   if (coefficientsAux) {
5739:     o_coefficientsAux    = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne         * realSize, oclCoeffAux, &ierr);
5740:   } else {
5741:     o_coefficientsAux    = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY,                        Ne         * realSize, oclCoeffAux, &ierr);
5742:   }
5743:   o_jacobianInverses     = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne*dim*dim * realSize, oclInvJ,     &ierr);
5744:   o_jacobianDeterminants = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne         * realSize, oclDetJ,     &ierr);
5745:   o_elemVec              = clCreateBuffer(ocl->ctx_id, CL_MEM_WRITE_ONLY,                       Ne*N_bt    * realSize, NULL,        &ierr);
5746:   /* Kernel launch */
5747:   clSetKernelArg(ocl_kernel, 0, sizeof(cl_int), (void*) &N_cb);
5748:   clSetKernelArg(ocl_kernel, 1, sizeof(cl_mem), (void*) &o_coefficients);
5749:   clSetKernelArg(ocl_kernel, 2, sizeof(cl_mem), (void*) &o_coefficientsAux);
5750:   clSetKernelArg(ocl_kernel, 3, sizeof(cl_mem), (void*) &o_jacobianInverses);
5751:   clSetKernelArg(ocl_kernel, 4, sizeof(cl_mem), (void*) &o_jacobianDeterminants);
5752:   clSetKernelArg(ocl_kernel, 5, sizeof(cl_mem), (void*) &o_elemVec);
5753:   clEnqueueNDRangeKernel(ocl->queue_id, ocl_kernel, 3, NULL, global_work_size, local_work_size, 0, NULL, &ocl_ev);
5754:   /* Read data back from device */
5755:   if (sizeof(PetscReal) != realSize) {
5756:     switch (ocl->realType) {
5757:     case PETSC_FLOAT:
5758:     {
5759:       float   *elem;
5760:       PetscInt c, b;

5762:       PetscFree4(f_coeff,f_coeffAux,f_invJ,f_detJ);
5763:       PetscMalloc1(Ne*N_bt, &elem);
5764:       clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elem, 0, NULL, NULL);
5765:       for (c = 0; c < Ne; ++c) {
5766:         for (b = 0; b < N_bt; ++b) {
5767:           elemVec[c*N_bt+b] = (PetscScalar) elem[c*N_bt+b];
5768:         }
5769:       }
5770:       PetscFree(elem);
5771:     }
5772:     break;
5773:     case PETSC_DOUBLE:
5774:     {
5775:       double  *elem;
5776:       PetscInt c, b;

5778:       PetscFree4(d_coeff,d_coeffAux,d_invJ,d_detJ);
5779:       PetscMalloc1(Ne*N_bt, &elem);
5780:       clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elem, 0, NULL, NULL);
5781:       for (c = 0; c < Ne; ++c) {
5782:         for (b = 0; b < N_bt; ++b) {
5783:           elemVec[c*N_bt+b] = (PetscScalar) elem[c*N_bt+b];
5784:         }
5785:       }
5786:       PetscFree(elem);
5787:     }
5788:     break;
5789:     default:
5790:       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported PETSc type %d", ocl->realType);
5791:     }
5792:   } else {
5793:     PetscFree2(r_invJ,r_detJ);
5794:     clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elemVec, 0, NULL, NULL);
5795:   }
5796:   /* Log performance */
5797:   clGetEventProfilingInfo(ocl_ev, CL_PROFILING_COMMAND_START, sizeof(cl_ulong), &ns_start, NULL);
5798:   clGetEventProfilingInfo(ocl_ev, CL_PROFILING_COMMAND_END,   sizeof(cl_ulong), &ns_end,   NULL);
5799:   f0Flops = 0;
5800:   switch (ocl->op) {
5801:   case LAPLACIAN:
5802:     f1Flops = useAux ? dim : 0;break;
5803:   case ELASTICITY:
5804:     f1Flops = 2*dim*dim;break;
5805:   }
5806:   numFlops = Ne*(
5807:     N_q*(
5808:       N_b*N_comp*((useField ? 2 : 0) + (useFieldDer ? 2*dim*(dim + 1) : 0))
5809:       /*+
5810:        N_ba*N_compa*((useFieldAux ? 2 : 0) + (useFieldDerAux ? 2*dim*(dim + 1) : 0))*/
5811:       +
5812:       N_comp*((useF0 ? f0Flops + 2 : 0) + (useF1 ? f1Flops + 2*dim : 0)))
5813:     +
5814:     N_b*((useF0 ? 2 : 0) + (useF1 ? 2*dim*(dim + 1) : 0)));
5815:   PetscFEOpenCLLogResidual(fem, (ns_end - ns_start)*1.0e-9, numFlops);
5816:   /* Cleanup */
5817:   clReleaseMemObject(o_coefficients);
5818:   clReleaseMemObject(o_coefficientsAux);
5819:   clReleaseMemObject(o_jacobianInverses);
5820:   clReleaseMemObject(o_jacobianDeterminants);
5821:   clReleaseMemObject(o_elemVec);
5822:   clReleaseKernel(ocl_kernel);
5823:   clReleaseProgram(ocl_prog);
5824:   return(0);
5825: }

5827: PetscErrorCode PetscFEInitialize_OpenCL(PetscFE fem)
5828: {
5830:   fem->ops->setfromoptions          = NULL;
5831:   fem->ops->setup                   = PetscFESetUp_Basic;
5832:   fem->ops->view                    = NULL;
5833:   fem->ops->destroy                 = PetscFEDestroy_OpenCL;
5834:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
5835:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
5836:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_OpenCL;
5837:   fem->ops->integratebdresidual     = NULL/* PetscFEIntegrateBdResidual_OpenCL */;
5838:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_OpenCL */;
5839:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
5840:   return(0);
5841: }

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

5846:   Level: intermediate

5848: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
5849: M*/

5851: PETSC_EXTERN PetscErrorCode PetscFECreate_OpenCL(PetscFE fem)
5852: {
5853:   PetscFE_OpenCL *ocl;
5854:   cl_uint         num_platforms;
5855:   cl_platform_id  platform_ids[42];
5856:   cl_uint         num_devices;
5857:   cl_device_id    device_ids[42];
5858:   cl_int          ierr2;
5859:   PetscErrorCode  ierr;

5863:   PetscNewLog(fem,&ocl);
5864:   fem->data = ocl;

5866:   /* Init Platform */
5867:   clGetPlatformIDs(42, platform_ids, &num_platforms);
5868:   if (!num_platforms) SETERRQ(PetscObjectComm((PetscObject) fem), PETSC_ERR_SUP, "No OpenCL platform found.");
5869:   ocl->pf_id = platform_ids[0];
5870:   /* Init Device */
5871:   clGetDeviceIDs(ocl->pf_id, CL_DEVICE_TYPE_ALL, 42, device_ids, &num_devices);
5872:   if (!num_devices) SETERRQ(PetscObjectComm((PetscObject) fem), PETSC_ERR_SUP, "No OpenCL device found.");
5873:   ocl->dev_id = device_ids[0];
5874:   /* Create context with one command queue */
5875:   ocl->ctx_id   = clCreateContext(0, 1, &(ocl->dev_id), NULL, NULL, &ierr2);CHKERRQ(ierr2);
5876:   ocl->queue_id = clCreateCommandQueue(ocl->ctx_id, ocl->dev_id, CL_QUEUE_PROFILING_ENABLE, &ierr2);CHKERRQ(ierr2);
5877:   /* Types */
5878:   ocl->realType = PETSC_FLOAT;
5879:   /* Register events */
5880:   PetscLogEventRegister("OpenCL FEResidual", PETSCFE_CLASSID, &ocl->residualEvent);
5881:   /* Equation handling */
5882:   ocl->op = LAPLACIAN;

5884:   PetscFEInitialize_OpenCL(fem);
5885:   return(0);
5886: }

5888: PetscErrorCode PetscFEOpenCLSetRealType(PetscFE fem, PetscDataType realType)
5889: {
5890:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;

5894:   ocl->realType = realType;
5895:   return(0);
5896: }

5898: PetscErrorCode PetscFEOpenCLGetRealType(PetscFE fem, PetscDataType *realType)
5899: {
5900:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;

5905:   *realType = ocl->realType;
5906:   return(0);
5907: }

5909: #endif /* PETSC_HAVE_OPENCL */

5911: PetscErrorCode PetscFEDestroy_Composite(PetscFE fem)
5912: {
5913:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
5914:   PetscErrorCode     ierr;

5917:   CellRefinerRestoreAffineTransforms_Internal(cmp->cellRefiner, &cmp->numSubelements, &cmp->v0, &cmp->jac, &cmp->invjac);
5918:   PetscFree(cmp->embedding);
5919:   PetscFree(cmp);
5920:   return(0);
5921: }

5923: PetscErrorCode PetscFESetUp_Composite(PetscFE fem)
5924: {
5925:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
5926:   DM                 K;
5927:   PetscReal         *subpoint;
5928:   PetscBLASInt      *pivots;
5929:   PetscBLASInt       n, info;
5930:   PetscScalar       *work, *invVscalar;
5931:   PetscInt           dim, pdim, spdim, j, s;
5932:   PetscErrorCode     ierr;

5935:   /* Get affine mapping from reference cell to each subcell */
5936:   PetscDualSpaceGetDM(fem->dualSpace, &K);
5937:   DMGetDimension(K, &dim);
5938:   DMPlexGetCellRefiner_Internal(K, &cmp->cellRefiner);
5939:   CellRefinerGetAffineTransforms_Internal(cmp->cellRefiner, &cmp->numSubelements, &cmp->v0, &cmp->jac, &cmp->invjac);
5940:   /* Determine dof embedding into subelements */
5941:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
5942:   PetscSpaceGetDimension(fem->basisSpace, &spdim);
5943:   PetscMalloc1(cmp->numSubelements*spdim,&cmp->embedding);
5944:   DMGetWorkArray(K, dim, PETSC_REAL, &subpoint);
5945:   for (s = 0; s < cmp->numSubelements; ++s) {
5946:     PetscInt sd = 0;

5948:     for (j = 0; j < pdim; ++j) {
5949:       PetscBool       inside;
5950:       PetscQuadrature f;
5951:       PetscInt        d, e;

5953:       PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);
5954:       /* Apply transform to first point, and check that point is inside subcell */
5955:       for (d = 0; d < dim; ++d) {
5956:         subpoint[d] = -1.0;
5957:         for (e = 0; e < dim; ++e) subpoint[d] += cmp->invjac[(s*dim + d)*dim+e]*(f->points[e] - cmp->v0[s*dim+e]);
5958:       }
5959:       CellRefinerInCellTest_Internal(cmp->cellRefiner, subpoint, &inside);
5960:       if (inside) {cmp->embedding[s*spdim+sd++] = j;}
5961:     }
5962:     if (sd != spdim) SETERRQ3(PetscObjectComm((PetscObject) fem), PETSC_ERR_PLIB, "Subelement %d has %d dual basis vectors != %d", s, sd, spdim);
5963:   }
5964:   DMRestoreWorkArray(K, dim, PETSC_REAL, &subpoint);
5965:   /* Construct the change of basis from prime basis to nodal basis for each subelement */
5966:   PetscMalloc1(cmp->numSubelements*spdim*spdim,&fem->invV);
5967:   PetscMalloc2(spdim,&pivots,spdim,&work);
5968: #if defined(PETSC_USE_COMPLEX)
5969:   PetscMalloc1(cmp->numSubelements*spdim*spdim,&invVscalar);
5970: #else
5971:   invVscalar = fem->invV;
5972: #endif
5973:   for (s = 0; s < cmp->numSubelements; ++s) {
5974:     for (j = 0; j < spdim; ++j) {
5975:       PetscReal       *Bf;
5976:       PetscQuadrature  f;
5977:       const PetscReal *points, *weights;
5978:       PetscInt         Nc, Nq, q, k;

5980:       PetscDualSpaceGetFunctional(fem->dualSpace, cmp->embedding[s*spdim+j], &f);
5981:       PetscQuadratureGetData(f, NULL, &Nc, &Nq, &points, &weights);
5982:       PetscMalloc1(f->numPoints*spdim*Nc,&Bf);
5983:       PetscSpaceEvaluate(fem->basisSpace, Nq, points, Bf, NULL, NULL);
5984:       for (k = 0; k < spdim; ++k) {
5985:         /* n_j \cdot \phi_k */
5986:         invVscalar[(s*spdim + j)*spdim+k] = 0.0;
5987:         for (q = 0; q < Nq; ++q) {
5988:           invVscalar[(s*spdim + j)*spdim+k] += Bf[q*spdim+k]*weights[q];
5989:         }
5990:       }
5991:       PetscFree(Bf);
5992:     }
5993:     n = spdim;
5994:     PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, &invVscalar[s*spdim*spdim], &n, pivots, &info));
5995:     PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, &invVscalar[s*spdim*spdim], &n, pivots, work, &n, &info));
5996:   }
5997: #if defined(PETSC_USE_COMPLEX)
5998:   for (s = 0; s <cmp->numSubelements*spdim*spdim; s++) fem->invV[s] = PetscRealPart(invVscalar[s]);
5999:   PetscFree(invVscalar);
6000: #endif
6001:   PetscFree2(pivots,work);
6002:   return(0);
6003: }

6005: PetscErrorCode PetscFEGetTabulation_Composite(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H)
6006: {
6007:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
6008:   DM                 dm;
6009:   PetscInt           pdim;  /* Dimension of FE space P */
6010:   PetscInt           spdim; /* Dimension of subelement FE space P */
6011:   PetscInt           dim;   /* Spatial dimension */
6012:   PetscInt           comp;  /* Field components */
6013:   PetscInt          *subpoints;
6014:   PetscReal         *tmpB, *tmpD, *tmpH, *subpoint;
6015:   PetscInt           p, s, d, e, j, k;
6016:   PetscErrorCode     ierr;

6019:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
6020:   DMGetDimension(dm, &dim);
6021:   PetscSpaceGetDimension(fem->basisSpace, &spdim);
6022:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
6023:   PetscFEGetNumComponents(fem, &comp);
6024:   /* Divide points into subelements */
6025:   DMGetWorkArray(dm, npoints, PETSC_INT, &subpoints);
6026:   DMGetWorkArray(dm, dim, PETSC_REAL, &subpoint);
6027:   for (p = 0; p < npoints; ++p) {
6028:     for (s = 0; s < cmp->numSubelements; ++s) {
6029:       PetscBool inside;

6031:       /* Apply transform, and check that point is inside cell */
6032:       for (d = 0; d < dim; ++d) {
6033:         subpoint[d] = -1.0;
6034:         for (e = 0; e < dim; ++e) subpoint[d] += cmp->invjac[(s*dim + d)*dim+e]*(points[p*dim+e] - cmp->v0[s*dim+e]);
6035:       }
6036:       CellRefinerInCellTest_Internal(cmp->cellRefiner, subpoint, &inside);
6037:       if (inside) {subpoints[p] = s; break;}
6038:     }
6039:     if (s >= cmp->numSubelements) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %d was not found in any subelement", p);
6040:   }
6041:   DMRestoreWorkArray(dm, dim, PETSC_REAL, &subpoint);
6042:   /* Evaluate the prime basis functions at all points */
6043:   if (B) {DMGetWorkArray(dm, npoints*spdim, PETSC_REAL, &tmpB);}
6044:   if (D) {DMGetWorkArray(dm, npoints*spdim*dim, PETSC_REAL, &tmpD);}
6045:   if (H) {DMGetWorkArray(dm, npoints*spdim*dim*dim, PETSC_REAL, &tmpH);}
6046:   PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);
6047:   /* Translate to the nodal basis */
6048:   if (B) {PetscMemzero(B, npoints*pdim*comp * sizeof(PetscReal));}
6049:   if (D) {PetscMemzero(D, npoints*pdim*comp*dim * sizeof(PetscReal));}
6050:   if (H) {PetscMemzero(H, npoints*pdim*comp*dim*dim * sizeof(PetscReal));}
6051:   for (p = 0; p < npoints; ++p) {
6052:     const PetscInt s = subpoints[p];

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

6059:         B[i] = 0.0;
6060:         for (k = 0; k < spdim; ++k) {
6061:           B[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpB[p*spdim + k];
6062:         }
6063:       }
6064:     }
6065:     if (D) {
6066:       /* Multiply by V^{-1} (spdim x spdim) */
6067:       for (j = 0; j < spdim; ++j) {
6068:         for (d = 0; d < dim; ++d) {
6069:           const PetscInt i = ((p*pdim + cmp->embedding[s*spdim+j])*comp + 0)*dim + d;

6071:           D[i] = 0.0;
6072:           for (k = 0; k < spdim; ++k) {
6073:             D[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpD[(p*spdim + k)*dim + d];
6074:           }
6075:         }
6076:       }
6077:     }
6078:     if (H) {
6079:       /* Multiply by V^{-1} (pdim x pdim) */
6080:       for (j = 0; j < spdim; ++j) {
6081:         for (d = 0; d < dim*dim; ++d) {
6082:           const PetscInt i = ((p*pdim + cmp->embedding[s*spdim+j])*comp + 0)*dim*dim + d;

6084:           H[i] = 0.0;
6085:           for (k = 0; k < spdim; ++k) {
6086:             H[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpH[(p*spdim + k)*dim*dim + d];
6087:           }
6088:         }
6089:       }
6090:     }
6091:   }
6092:   DMRestoreWorkArray(dm, npoints, PETSC_INT, &subpoints);
6093:   if (B) {DMRestoreWorkArray(dm, npoints*spdim, PETSC_REAL, &tmpB);}
6094:   if (D) {DMRestoreWorkArray(dm, npoints*spdim*dim, PETSC_REAL, &tmpD);}
6095:   if (H) {DMRestoreWorkArray(dm, npoints*spdim*dim*dim, PETSC_REAL, &tmpH);}
6096:   return(0);
6097: }

6099: PetscErrorCode PetscFEInitialize_Composite(PetscFE fem)
6100: {
6102:   fem->ops->setfromoptions          = NULL;
6103:   fem->ops->setup                   = PetscFESetUp_Composite;
6104:   fem->ops->view                    = NULL;
6105:   fem->ops->destroy                 = PetscFEDestroy_Composite;
6106:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
6107:   fem->ops->gettabulation           = PetscFEGetTabulation_Composite;
6108:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Basic;
6109:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Basic;
6110:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Basic */;
6111:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
6112:   return(0);
6113: }

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

6118:   Level: intermediate

6120: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
6121: M*/

6123: PETSC_EXTERN PetscErrorCode PetscFECreate_Composite(PetscFE fem)
6124: {
6125:   PetscFE_Composite *cmp;
6126:   PetscErrorCode     ierr;

6130:   PetscNewLog(fem, &cmp);
6131:   fem->data = cmp;

6133:   cmp->cellRefiner    = REFINER_NOOP;
6134:   cmp->numSubelements = -1;
6135:   cmp->v0             = NULL;
6136:   cmp->jac            = NULL;

6138:   PetscFEInitialize_Composite(fem);
6139:   return(0);
6140: }

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

6145:   Not collective

6147:   Input Parameter:
6148: . fem - The PetscFE object

6150:   Output Parameters:
6151: + blockSize - The number of elements in a block
6152: . numBlocks - The number of blocks in a batch
6153: . batchSize - The number of elements in a batch
6154: - numBatches - The number of batches in a chunk

6156:   Level: intermediate

6158: .seealso: PetscFECreate()
6159: @*/
6160: PetscErrorCode PetscFECompositeGetMapping(PetscFE fem, PetscInt *numSubelements, const PetscReal *v0[], const PetscReal *jac[], const PetscReal *invjac[])
6161: {
6162:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;

6170:   return(0);
6171: }

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

6176:   Not collective

6178:   Input Parameter:
6179: . fe - The PetscFE

6181:   Output Parameter:
6182: . dim - The dimension

6184:   Level: intermediate

6186: .seealso: PetscFECreate(), PetscSpaceGetDimension(), PetscDualSpaceGetDimension()
6187: @*/
6188: PetscErrorCode PetscFEGetDimension(PetscFE fem, PetscInt *dim)
6189: {

6195:   if (fem->ops->getdimension) {(*fem->ops->getdimension)(fem, dim);}
6196:   return(0);
6197: }

6199: /*
6200: Purpose: Compute element vector for chunk of elements

6202: Input:
6203:   Sizes:
6204:      Ne:  number of elements
6205:      Nf:  number of fields
6206:      PetscFE
6207:        dim: spatial dimension
6208:        Nb:  number of basis functions
6209:        Nc:  number of field components
6210:        PetscQuadrature
6211:          Nq:  number of quadrature points

6213:   Geometry:
6214:      PetscFECellGeom[Ne] possibly *Nq
6215:        PetscReal v0s[dim]
6216:        PetscReal n[dim]
6217:        PetscReal jacobians[dim*dim]
6218:        PetscReal jacobianInverses[dim*dim]
6219:        PetscReal jacobianDeterminants
6220:   FEM:
6221:      PetscFE
6222:        PetscQuadrature
6223:          PetscReal   quadPoints[Nq*dim]
6224:          PetscReal   quadWeights[Nq]
6225:        PetscReal   basis[Nq*Nb*Nc]
6226:        PetscReal   basisDer[Nq*Nb*Nc*dim]
6227:      PetscScalar coefficients[Ne*Nb*Nc]
6228:      PetscScalar elemVec[Ne*Nb*Nc]

6230:   Problem:
6231:      PetscInt f: the active field
6232:      f0, f1

6234:   Work Space:
6235:      PetscFE
6236:        PetscScalar f0[Nq*dim];
6237:        PetscScalar f1[Nq*dim*dim];
6238:        PetscScalar u[Nc];
6239:        PetscScalar gradU[Nc*dim];
6240:        PetscReal   x[dim];
6241:        PetscScalar realSpaceDer[dim];

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

6245: Input:
6246:   Sizes:
6247:      N_cb: Number of serial cell batches

6249:   Geometry:
6250:      PetscReal v0s[Ne*dim]
6251:      PetscReal jacobians[Ne*dim*dim]        possibly *Nq
6252:      PetscReal jacobianInverses[Ne*dim*dim] possibly *Nq
6253:      PetscReal jacobianDeterminants[Ne]     possibly *Nq
6254:   FEM:
6255:      static PetscReal   quadPoints[Nq*dim]
6256:      static PetscReal   quadWeights[Nq]
6257:      static PetscReal   basis[Nq*Nb*Nc]
6258:      static PetscReal   basisDer[Nq*Nb*Nc*dim]
6259:      PetscScalar coefficients[Ne*Nb*Nc]
6260:      PetscScalar elemVec[Ne*Nb*Nc]

6262: ex62.c:
6263:   PetscErrorCode PetscFEIntegrateResidualBatch(PetscInt Ne, PetscInt numFields, PetscInt field, PetscQuadrature quad[], const PetscScalar coefficients[],
6264:                                                const PetscReal v0s[], const PetscReal jacobians[], const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[],
6265:                                                void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f0[]),
6266:                                                void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f1[]), PetscScalar elemVec[])

6268: ex52.c:
6269:   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)
6270:   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)

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

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

6279: ex52_integrateElementOpenCL.c:
6280: PETSC_EXTERN PetscErrorCode IntegrateElementBatchGPU(PetscInt spatial_dim, PetscInt Ne, PetscInt Ncb, PetscInt Nbc, PetscInt N_bl, const PetscScalar coefficients[],
6281:                                                      const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscScalar elemVec[],
6282:                                                      PetscLogEvent event, PetscInt debug, PetscInt pde_op)

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

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

6290:   Not collective

6292:   Input Parameters:
6293: + fem          - The PetscFE object for the field being integrated
6294: . prob         - The PetscDS specifying the discretizations and continuum functions
6295: . field        - The field being integrated
6296: . Ne           - The number of elements in the chunk
6297: . cgeom        - The cell geometry for each cell in the chunk
6298: . coefficients - The array of FEM basis coefficients for the elements
6299: . probAux      - The PetscDS specifying the auxiliary discretizations
6300: - coefficientsAux - The array of FEM auxiliary basis coefficients for the elements

6302:   Output Parameter
6303: . integral     - the integral for this field

6305:   Level: developer

6307: .seealso: PetscFEIntegrateResidual()
6308: @*/
6309: PetscErrorCode PetscFEIntegrate(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
6310:                                 const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal integral[])
6311: {

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

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

6324:   Not collective

6326:   Input Parameters:
6327: + fem          - The PetscFE object for the field being integrated
6328: . prob         - The PetscDS specifying the discretizations and continuum functions
6329: . field        - The field being integrated
6330: . Ne           - The number of elements in the chunk
6331: . cgeom        - The cell geometry for each cell in the chunk
6332: . coefficients - The array of FEM basis coefficients for the elements
6333: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
6334: . probAux      - The PetscDS specifying the auxiliary discretizations
6335: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6336: - t            - The time

6338:   Output Parameter
6339: . elemVec      - the element residual vectors from each element

6341:   Note:
6342: $ Loop over batch of elements (e):
6343: $   Loop over quadrature points (q):
6344: $     Make u_q and gradU_q (loops over fields,Nb,Ncomp) and x_q
6345: $     Call f_0 and f_1
6346: $   Loop over element vector entries (f,fc --> i):
6347: $     elemVec[i] += \psi^{fc}_f(q) f0_{fc}(u, \nabla u) + \nabla\psi^{fc}_f(q) \cdot f1_{fc,df}(u, \nabla u)

6349:   Level: developer

6351: .seealso: PetscFEIntegrateResidual()
6352: @*/
6353: PetscErrorCode PetscFEIntegrateResidual(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
6354:                                         const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
6355: {

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

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

6368:   Not collective

6370:   Input Parameters:
6371: + fem          - The PetscFE object for the field being integrated
6372: . prob         - The PetscDS specifying the discretizations and continuum functions
6373: . field        - The field being integrated
6374: . Ne           - The number of elements in the chunk
6375: . fgeom        - The face geometry for each cell in the chunk
6376: . coefficients - The array of FEM basis coefficients for the elements
6377: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
6378: . probAux      - The PetscDS specifying the auxiliary discretizations
6379: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6380: - t            - The time

6382:   Output Parameter
6383: . elemVec      - the element residual vectors from each element

6385:   Level: developer

6387: .seealso: PetscFEIntegrateResidual()
6388: @*/
6389: PetscErrorCode PetscFEIntegrateBdResidual(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEFaceGeom *fgeom,
6390:                                           const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
6391: {

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

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

6403:   Not collective

6405:   Input Parameters:
6406: + fem          - The PetscFE object for the field being integrated
6407: . prob         - The PetscDS specifying the discretizations and continuum functions
6408: . jtype        - The type of matrix pointwise functions that should be used
6409: . fieldI       - The test field being integrated
6410: . fieldJ       - The basis field being integrated
6411: . Ne           - The number of elements in the chunk
6412: . cgeom        - The cell geometry for each cell in the chunk
6413: . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
6414: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
6415: . probAux      - The PetscDS specifying the auxiliary discretizations
6416: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6417: . t            - The time
6418: - u_tShift     - A multiplier for the dF/du_t term (as opposed to the dF/du term)

6420:   Output Parameter
6421: . elemMat      - the element matrices for the Jacobian from each element

6423:   Note:
6424: $ Loop over batch of elements (e):
6425: $   Loop over element matrix entries (f,fc,g,gc --> i,j):
6426: $     Loop over quadrature points (q):
6427: $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
6428: $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
6429: $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6430: $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
6431: $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6432:   Level: developer

6434: .seealso: PetscFEIntegrateResidual()
6435: @*/
6436: PetscErrorCode PetscFEIntegrateJacobian(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFECellGeom *cgeom,
6437:                                         const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
6438: {

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

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

6450:   Not collective

6452:   Input Parameters:
6453: + fem          = The PetscFE object for the field being integrated
6454: . prob         - The PetscDS specifying the discretizations and continuum functions
6455: . fieldI       - The test field being integrated
6456: . fieldJ       - The basis field being integrated
6457: . Ne           - The number of elements in the chunk
6458: . fgeom        - The face geometry for each cell in the chunk
6459: . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
6460: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
6461: . probAux      - The PetscDS specifying the auxiliary discretizations
6462: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6463: . t            - The time
6464: - u_tShift     - A multiplier for the dF/du_t term (as opposed to the dF/du term)

6466:   Output Parameter
6467: . elemMat              - the element matrices for the Jacobian from each element

6469:   Note:
6470: $ Loop over batch of elements (e):
6471: $   Loop over element matrix entries (f,fc,g,gc --> i,j):
6472: $     Loop over quadrature points (q):
6473: $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
6474: $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
6475: $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6476: $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
6477: $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6478:   Level: developer

6480: .seealso: PetscFEIntegrateJacobian(), PetscFEIntegrateResidual()
6481: @*/
6482: PetscErrorCode PetscFEIntegrateBdJacobian(PetscFE fem, PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEFaceGeom *fgeom,
6483:                                           const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
6484: {

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

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

6498:   Collective on PetscFE

6500:   Input Parameter:
6501: . fe - The initial PetscFE

6503:   Output Parameter:
6504: . feRef - The refined PetscFE

6506:   Level: developer

6508: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
6509: @*/
6510: PetscErrorCode PetscFERefine(PetscFE fe, PetscFE *feRef)
6511: {
6512:   PetscSpace       P, Pref;
6513:   PetscDualSpace   Q, Qref;
6514:   DM               K, Kref;
6515:   PetscQuadrature  q, qref;
6516:   const PetscReal *v0, *jac;
6517:   PetscInt         numComp, numSubelements;
6518:   PetscErrorCode   ierr;

6521:   PetscFEGetBasisSpace(fe, &P);
6522:   PetscFEGetDualSpace(fe, &Q);
6523:   PetscFEGetQuadrature(fe, &q);
6524:   PetscDualSpaceGetDM(Q, &K);
6525:   /* Create space */
6526:   PetscObjectReference((PetscObject) P);
6527:   Pref = P;
6528:   /* Create dual space */
6529:   PetscDualSpaceDuplicate(Q, &Qref);
6530:   DMRefine(K, PetscObjectComm((PetscObject) fe), &Kref);
6531:   PetscDualSpaceSetDM(Qref, Kref);
6532:   DMDestroy(&Kref);
6533:   PetscDualSpaceSetUp(Qref);
6534:   /* Create element */
6535:   PetscFECreate(PetscObjectComm((PetscObject) fe), feRef);
6536:   PetscFESetType(*feRef, PETSCFECOMPOSITE);
6537:   PetscFESetBasisSpace(*feRef, Pref);
6538:   PetscFESetDualSpace(*feRef, Qref);
6539:   PetscFEGetNumComponents(fe,    &numComp);
6540:   PetscFESetNumComponents(*feRef, numComp);
6541:   PetscFESetUp(*feRef);
6542:   PetscSpaceDestroy(&Pref);
6543:   PetscDualSpaceDestroy(&Qref);
6544:   /* Create quadrature */
6545:   PetscFECompositeGetMapping(*feRef, &numSubelements, &v0, &jac, NULL);
6546:   PetscQuadratureExpandComposite(q, numSubelements, v0, jac, &qref);
6547:   PetscFESetQuadrature(*feRef, qref);
6548:   PetscQuadratureDestroy(&qref);
6549:   return(0);
6550: }

6552: /*@C
6553:   PetscFECreateDefault - Create a PetscFE for basic FEM computation

6555:   Collective on DM

6557:   Input Parameters:
6558: + dm        - The underlying DM for the domain
6559: . dim       - The spatial dimension
6560: . Nc        - The number of components
6561: . isSimplex - Flag for simplex reference cell, otherwise its a tensor product
6562: . prefix    - The options prefix, or NULL
6563: - qorder    - The quadrature order

6565:   Output Parameter:
6566: . fem - The PetscFE object

6568:   Level: beginner

6570: .keywords: PetscFE, finite element
6571: .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate()
6572: @*/
6573: PetscErrorCode PetscFECreateDefault(DM dm, PetscInt dim, PetscInt Nc, PetscBool isSimplex, const char prefix[], PetscInt qorder, PetscFE *fem)
6574: {
6575:   PetscQuadrature q, fq;
6576:   DM              K;
6577:   PetscSpace      P;
6578:   PetscDualSpace  Q;
6579:   PetscInt        order, quadPointsPerEdge;
6580:   PetscBool       tensor = isSimplex ? PETSC_FALSE : PETSC_TRUE;
6581:   PetscErrorCode  ierr;

6584:   /* Create space */
6585:   PetscSpaceCreate(PetscObjectComm((PetscObject) dm), &P);
6586:   PetscObjectSetOptionsPrefix((PetscObject) P, prefix);
6587:   PetscSpaceSetFromOptions(P);
6588:   PetscSpaceSetNumComponents(P, Nc);
6589:   PetscSpacePolynomialSetNumVariables(P, dim);
6590:   PetscSpaceSetUp(P);
6591:   PetscSpaceGetOrder(P, &order);
6592:   PetscSpacePolynomialGetTensor(P, &tensor);
6593:   /* Create dual space */
6594:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) dm), &Q);
6595:   PetscDualSpaceSetType(Q,PETSCDUALSPACELAGRANGE);
6596:   PetscObjectSetOptionsPrefix((PetscObject) Q, prefix);
6597:   PetscDualSpaceCreateReferenceCell(Q, dim, isSimplex, &K);
6598:   PetscDualSpaceSetDM(Q, K);
6599:   DMDestroy(&K);
6600:   PetscDualSpaceSetNumComponents(Q, Nc);
6601:   PetscDualSpaceSetOrder(Q, order);
6602:   PetscDualSpaceLagrangeSetTensor(Q, tensor);
6603:   PetscDualSpaceSetFromOptions(Q);
6604:   PetscDualSpaceSetUp(Q);
6605:   /* Create element */
6606:   PetscFECreate(PetscObjectComm((PetscObject) dm), fem);
6607:   PetscObjectSetOptionsPrefix((PetscObject) *fem, prefix);
6608:   PetscFESetFromOptions(*fem);
6609:   PetscFESetBasisSpace(*fem, P);
6610:   PetscFESetDualSpace(*fem, Q);
6611:   PetscFESetNumComponents(*fem, Nc);
6612:   PetscFESetUp(*fem);
6613:   PetscSpaceDestroy(&P);
6614:   PetscDualSpaceDestroy(&Q);
6615:   /* Create quadrature (with specified order if given) */
6616:   qorder = qorder >= 0 ? qorder : order;
6617:   PetscObjectOptionsBegin((PetscObject)*fem);
6618:   PetscOptionsInt("-petscfe_default_quadrature_order","Quadrature order is one less than quadture points per edge","PetscFECreateDefault",qorder,&qorder,NULL);
6619:   PetscOptionsEnd();
6620:   quadPointsPerEdge = PetscMax(qorder + 1,1);
6621:   if (isSimplex) {
6622:     PetscDTGaussJacobiQuadrature(dim,   1, quadPointsPerEdge, -1.0, 1.0, &q);
6623:     PetscDTGaussJacobiQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);
6624:   }
6625:   else {
6626:     PetscDTGaussTensorQuadrature(dim,   1, quadPointsPerEdge, -1.0, 1.0, &q);
6627:     PetscDTGaussTensorQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);
6628:   }
6629:   PetscFESetQuadrature(*fem, q);
6630:   PetscFESetFaceQuadrature(*fem, fq);
6631:   PetscQuadratureDestroy(&q);
6632:   PetscQuadratureDestroy(&fq);
6633:   return(0);
6634: }