Actual source code: dtfe.c

petsc-master 2016-12-06
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;

 62: /*@C
 63:   PetscSpaceRegister - Adds a new PetscSpace implementation

 65:   Not Collective

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

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

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

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

 89:   Level: advanced

 91: .keywords: PetscSpace, register
 92: .seealso: PetscSpaceRegisterAll(), PetscSpaceRegisterDestroy()

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

100:   PetscFunctionListAdd(&PetscSpaceList, sname, function);
101:   return(0);
102: }

106: /*@C
107:   PetscSpaceSetType - Builds a particular PetscSpace

109:   Collective on PetscSpace

111:   Input Parameters:
112: + sp   - The PetscSpace object
113: - name - The kind of space

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

118:   Level: intermediate

120: .keywords: PetscSpace, set, type
121: .seealso: PetscSpaceGetType(), PetscSpaceCreate()
122: @*/
123: PetscErrorCode PetscSpaceSetType(PetscSpace sp, PetscSpaceType name)
124: {
125:   PetscErrorCode (*r)(PetscSpace);
126:   PetscBool      match;

131:   PetscObjectTypeCompare((PetscObject) sp, name, &match);
132:   if (match) return(0);

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

138:   if (sp->ops->destroy) {
139:     (*sp->ops->destroy)(sp);
140:     sp->ops->destroy = NULL;
141:   }
142:   (*r)(sp);
143:   PetscObjectChangeTypeName((PetscObject) sp, name);
144:   return(0);
145: }

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

152:   Not Collective

154:   Input Parameter:
155: . sp  - The PetscSpace

157:   Output Parameter:
158: . name - The PetscSpace type name

160:   Level: intermediate

162: .keywords: PetscSpace, get, type, name
163: .seealso: PetscSpaceSetType(), PetscSpaceCreate()
164: @*/
165: PetscErrorCode PetscSpaceGetType(PetscSpace sp, PetscSpaceType *name)
166: {

172:   if (!PetscSpaceRegisterAllCalled) {
173:     PetscSpaceRegisterAll();
174:   }
175:   *name = ((PetscObject) sp)->type_name;
176:   return(0);
177: }

181: /*@C
182:   PetscSpaceView - Views a PetscSpace

184:   Collective on PetscSpace

186:   Input Parameter:
187: + sp - the PetscSpace object to view
188: - v  - the viewer

190:   Level: developer

192: .seealso PetscSpaceDestroy()
193: @*/
194: PetscErrorCode PetscSpaceView(PetscSpace sp, PetscViewer v)
195: {

200:   if (!v) {
201:     PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) sp), &v);
202:   }
203:   if (sp->ops->view) {
204:     (*sp->ops->view)(sp, v);
205:   }
206:   return(0);
207: }

211: /*@
212:   PetscSpaceSetFromOptions - sets parameters in a PetscSpace from the options database

214:   Collective on PetscSpace

216:   Input Parameter:
217: . sp - the PetscSpace object to set options for

219:   Options Database:
220: . -petscspace_order the approximation order of the space

222:   Level: developer

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

235:   if (!((PetscObject) sp)->type_name) {
236:     defaultType = PETSCSPACEPOLYNOMIAL;
237:   } else {
238:     defaultType = ((PetscObject) sp)->type_name;
239:   }
240:   if (!PetscSpaceRegisterAllCalled) {PetscSpaceRegisterAll();}

242:   PetscObjectOptionsBegin((PetscObject) sp);
243:   PetscOptionsFList("-petscspace_type", "Linear space", "PetscSpaceSetType", PetscSpaceList, defaultType, name, 256, &flg);
244:   if (flg) {
245:     PetscSpaceSetType(sp, name);
246:   } else if (!((PetscObject) sp)->type_name) {
247:     PetscSpaceSetType(sp, defaultType);
248:   }
249:   PetscOptionsInt("-petscspace_order", "The approximation order", "PetscSpaceSetOrder", sp->order, &sp->order, NULL);
250:   if (sp->ops->setfromoptions) {
251:     (*sp->ops->setfromoptions)(PetscOptionsObject,sp);
252:   }
253:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
254:   PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) sp);
255:   PetscOptionsEnd();
256:   PetscSpaceViewFromOptions(sp, NULL, "-petscspace_view");
257:   return(0);
258: }

262: /*@C
263:   PetscSpaceSetUp - Construct data structures for the PetscSpace

265:   Collective on PetscSpace

267:   Input Parameter:
268: . sp - the PetscSpace object to setup

270:   Level: developer

272: .seealso PetscSpaceView(), PetscSpaceDestroy()
273: @*/
274: PetscErrorCode PetscSpaceSetUp(PetscSpace sp)
275: {

280:   if (sp->ops->setup) {(*sp->ops->setup)(sp);}
281:   return(0);
282: }

286: /*@
287:   PetscSpaceDestroy - Destroys a PetscSpace object

289:   Collective on PetscSpace

291:   Input Parameter:
292: . sp - the PetscSpace object to destroy

294:   Level: developer

296: .seealso PetscSpaceView()
297: @*/
298: PetscErrorCode PetscSpaceDestroy(PetscSpace *sp)
299: {

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

306:   if (--((PetscObject)(*sp))->refct > 0) {*sp = 0; return(0);}
307:   ((PetscObject) (*sp))->refct = 0;
308:   DMDestroy(&(*sp)->dm);

310:   (*(*sp)->ops->destroy)(*sp);
311:   PetscHeaderDestroy(sp);
312:   return(0);
313: }

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

320:   Collective on MPI_Comm

322:   Input Parameter:
323: . comm - The communicator for the PetscSpace object

325:   Output Parameter:
326: . sp - The PetscSpace object

328:   Level: beginner

330: .seealso: PetscSpaceSetType(), PETSCSPACEPOLYNOMIAL
331: @*/
332: PetscErrorCode PetscSpaceCreate(MPI_Comm comm, PetscSpace *sp)
333: {
334:   PetscSpace     s;

339:   PetscCitationsRegister(FECitation,&FEcite);
340:   *sp  = NULL;
341:   PetscFEInitializePackage();

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

345:   s->order = 0;
346:   DMShellCreate(comm, &s->dm);

348:   *sp = s;
349:   return(0);
350: }

354: /* Dimension of the space, i.e. number of basis vectors */
355: PetscErrorCode PetscSpaceGetDimension(PetscSpace sp, PetscInt *dim)
356: {

362:   *dim = 0;
363:   if (sp->ops->getdimension) {(*sp->ops->getdimension)(sp, dim);}
364:   return(0);
365: }

369: /*@
370:   PetscSpaceGetOrder - Return the order of approximation for this space

372:   Input Parameter:
373: . sp - The PetscSpace

375:   Output Parameter:
376: . order - The approximation order

378:   Level: intermediate

380: .seealso: PetscSpaceSetOrder(), PetscSpaceCreate(), PetscSpace
381: @*/
382: PetscErrorCode PetscSpaceGetOrder(PetscSpace sp, PetscInt *order)
383: {
387:   *order = sp->order;
388:   return(0);
389: }

393: /*@
394:   PetscSpaceSetOrder - Set the order of approximation for this space

396:   Input Parameters:
397: + sp - The PetscSpace
398: - order - The approximation order

400:   Level: intermediate

402: .seealso: PetscSpaceGetOrder(), PetscSpaceCreate(), PetscSpace
403: @*/
404: PetscErrorCode PetscSpaceSetOrder(PetscSpace sp, PetscInt order)
405: {
408:   sp->order = order;
409:   return(0);
410: }

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

417:   Input Parameters:
418: + sp      - The PetscSpace
419: . npoints - The number of evaluation points
420: - points  - The point coordinates

422:   Output Parameters:
423: + B - The function evaluations in a npoints x nfuncs array
424: . D - The derivative evaluations in a npoints x nfuncs x dim array
425: - H - The second derivative evaluations in a npoints x nfuncs x dim x dim array

427:   Level: advanced

429: .seealso: PetscFEGetTabulation(), PetscFEGetDefaultTabulation(), PetscSpaceCreate()
430: @*/
431: PetscErrorCode PetscSpaceEvaluate(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
432: {

441:   if (sp->ops->evaluate) {(*sp->ops->evaluate)(sp, npoints, points, B, D, H);}
442:   return(0);
443: }

447: PetscErrorCode PetscSpaceSetFromOptions_Polynomial(PetscOptionItems *PetscOptionsObject,PetscSpace sp)
448: {
449:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
450:   PetscErrorCode   ierr;

453:   PetscOptionsHead(PetscOptionsObject,"PetscSpace polynomial options");
454:   PetscOptionsInt("-petscspace_poly_num_variables", "The number of different variables, e.g. x and y", "PetscSpacePolynomialSetNumVariables", poly->numVariables, &poly->numVariables, NULL);
455:   PetscOptionsBool("-petscspace_poly_sym", "Use only symmetric polynomials", "PetscSpacePolynomialSetSymmetric", poly->symmetric, &poly->symmetric, NULL);
456:   PetscOptionsBool("-petscspace_poly_tensor", "Use the tensor product polynomials", "PetscSpacePolynomialSetTensor", poly->tensor, &poly->tensor, NULL);
457:   PetscOptionsTail();
458:   return(0);
459: }

463: static PetscErrorCode PetscSpacePolynomialView_Ascii(PetscSpace sp, PetscViewer viewer)
464: {
465:   PetscSpace_Poly  *poly = (PetscSpace_Poly *) sp->data;
466:   PetscViewerFormat format;
467:   PetscErrorCode    ierr;

470:   PetscViewerGetFormat(viewer, &format);
471:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
472:     if (poly->tensor) {PetscViewerASCIIPrintf(viewer, "Tensor polynomial space in %d variables of order %d\n", poly->numVariables, sp->order);}
473:     else              {PetscViewerASCIIPrintf(viewer, "Polynomial space in %d variables of order %d\n", poly->numVariables, sp->order);}
474:   } else {
475:     if (poly->tensor) {PetscViewerASCIIPrintf(viewer, "Tensor polynomial space in %d variables of order %d\n", poly->numVariables, sp->order);}
476:     else              {PetscViewerASCIIPrintf(viewer, "Polynomial space in %d variables of order %d\n", poly->numVariables, sp->order);}
477:   }
478:   return(0);
479: }

483: PetscErrorCode PetscSpaceView_Polynomial(PetscSpace sp, PetscViewer viewer)
484: {
485:   PetscBool      iascii;

491:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
492:   if (iascii) {PetscSpacePolynomialView_Ascii(sp, viewer);}
493:   return(0);
494: }

498: PetscErrorCode PetscSpaceSetUp_Polynomial(PetscSpace sp)
499: {
500:   PetscSpace_Poly *poly    = (PetscSpace_Poly *) sp->data;
501:   PetscInt         ndegree = sp->order+1;
502:   PetscInt         deg;
503:   PetscErrorCode   ierr;

506:   PetscMalloc1(ndegree, &poly->degrees);
507:   for (deg = 0; deg < ndegree; ++deg) poly->degrees[deg] = deg;
508:   return(0);
509: }

513: PetscErrorCode PetscSpaceDestroy_Polynomial(PetscSpace sp)
514: {
515:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
516:   PetscErrorCode   ierr;

519:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", NULL);
520:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialSetTensor_C", NULL);
521:   PetscFree(poly->degrees);
522:   PetscFree(poly);
523:   return(0);
524: }

528: PetscErrorCode PetscSpaceGetDimension_Polynomial(PetscSpace sp, PetscInt *dim)
529: {
530:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
531:   PetscInt         deg  = sp->order;
532:   PetscInt         n    = poly->numVariables, i;
533:   PetscReal        D    = 1.0;

536:   if (poly->tensor) {
537:     *dim = 1;
538:     for (i = 0; i < n; ++i) *dim *= (deg+1);
539:   } else {
540:     for (i = 1; i <= n; ++i) {
541:       D *= ((PetscReal) (deg+i))/i;
542:     }
543:     *dim = (PetscInt) (D + 0.5);
544:   }
545:   return(0);
546: }

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

553:   Input Parameters:
554: + len - The length of the tuple
555: . sum - The sum of all entries in the tuple
556: - ind - The current multi-index of the tuple, initialized to the 0 tuple

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

562:   Level: developer

564: .seealso: 
565: */
566: static PetscErrorCode LatticePoint_Internal(PetscInt len, PetscInt sum, PetscInt ind[], PetscInt tup[])
567: {
568:   PetscInt       i;

572:   if (len == 1) {
573:     ind[0] = -1;
574:     tup[0] = sum;
575:   } else if (sum == 0) {
576:     for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
577:   } else {
578:     tup[0] = sum - ind[0];
579:     LatticePoint_Internal(len-1, ind[0], &ind[1], &tup[1]);
580:     if (ind[1] < 0) {
581:       if (ind[0] == sum) {ind[0] = -1;}
582:       else               {ind[1] = 0; ++ind[0];}
583:     }
584:   }
585:   return(0);
586: }

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

595:   Input Parameters:
596: + len - The length of the tuple
597: . max - The maximum sum
598: - tup - A tuple of length len+1: tup[len] > 0 indicates a stopping condition

600:   Output Parameter:
601: . tup - A tuple of len integers whos sum is at most 'max'
602: */
603: static PetscErrorCode LatticePointLexicographic_Internal(PetscInt len, PetscInt max, PetscInt tup[])
604: {
606:   while (len--) {
607:     max -= tup[len];
608:     if (!max) {
609:       tup[len] = 0;
610:       break;
611:     }
612:   }
613:   tup[++len]++;
614:   return(0);
615: }

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

622:   Input Parameters:
623: + len - The length of the tuple
624: . max - The max for all entries in the tuple
625: - ind - The current multi-index of the tuple, initialized to the 0 tuple

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

631:   Level: developer

633: .seealso: 
634: */
635: static PetscErrorCode TensorPoint_Internal(PetscInt len, PetscInt max, PetscInt ind[], PetscInt tup[])
636: {
637:   PetscInt       i;

641:   if (len == 1) {
642:     tup[0] = ind[0]++;
643:     ind[0] = ind[0] >= max ? -1 : ind[0];
644:   } else if (max == 0) {
645:     for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
646:   } else {
647:     tup[0] = ind[0];
648:     TensorPoint_Internal(len-1, max, &ind[1], &tup[1]);
649:     if (ind[1] < 0) {
650:       ind[1] = 0;
651:       if (ind[0] == max-1) {ind[0] = -1;}
652:       else                 {++ind[0];}
653:     }
654:   }
655:   return(0);
656: }

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

665:   Input Parameters:
666: + len - The length of the tuple
667: . max - The maximum value
668: - tup - A tuple of length len+1: tup[len] > 0 indicates a stopping condition

670:   Output Parameter:
671: . tup - A tuple of len integers whos sum is at most 'max'
672: */
673: static PetscErrorCode TensorPointLexicographic_Internal(PetscInt len, PetscInt max, PetscInt tup[])
674: {
675:   PetscInt       i;

678:   for (i = 0; i < len; i++) {
679:     if (tup[i] < max) {
680:       break;
681:     } else {
682:       tup[i] = 0;
683:     }
684:   }
685:   tup[i]++;
686:   return(0);
687: }

691: PetscErrorCode PetscSpaceEvaluate_Polynomial(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
692: {
693:   PetscSpace_Poly *poly    = (PetscSpace_Poly *) sp->data;
694:   DM               dm      = sp->dm;
695:   PetscInt         ndegree = sp->order+1;
696:   PetscInt        *degrees = poly->degrees;
697:   PetscInt         dim     = poly->numVariables;
698:   PetscReal       *lpoints, *tmp, *LB, *LD, *LH;
699:   PetscInt        *ind, *tup;
700:   PetscInt         pdim, d, der, i, p, deg, o;
701:   PetscErrorCode   ierr;

704:   PetscSpaceGetDimension(sp, &pdim);
705:   DMGetWorkArray(dm, npoints, PETSC_REAL, &lpoints);
706:   DMGetWorkArray(dm, npoints*ndegree*3, PETSC_REAL, &tmp);
707:   if (B) {DMGetWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LB);}
708:   if (D) {DMGetWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LD);}
709:   if (H) {DMGetWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LH);}
710:   for (d = 0; d < dim; ++d) {
711:     for (p = 0; p < npoints; ++p) {
712:       lpoints[p] = points[p*dim+d];
713:     }
714:     PetscDTLegendreEval(npoints, lpoints, ndegree, degrees, tmp, &tmp[1*npoints*ndegree], &tmp[2*npoints*ndegree]);
715:     /* LB, LD, LH (ndegree * dim x npoints) */
716:     for (deg = 0; deg < ndegree; ++deg) {
717:       for (p = 0; p < npoints; ++p) {
718:         if (B) LB[(deg*dim + d)*npoints + p] = tmp[(0*npoints + p)*ndegree+deg];
719:         if (D) LD[(deg*dim + d)*npoints + p] = tmp[(1*npoints + p)*ndegree+deg];
720:         if (H) LH[(deg*dim + d)*npoints + p] = tmp[(2*npoints + p)*ndegree+deg];
721:       }
722:     }
723:   }
724:   /* Multiply by A (pdim x ndegree * dim) */
725:   PetscMalloc2(dim,&ind,dim,&tup);
726:   if (B) {
727:     /* B (npoints x pdim) */
728:     if (poly->tensor) {
729:       i = 0;
730:       PetscMemzero(ind, dim * sizeof(PetscInt));
731:       while (ind[0] >= 0) {
732:         TensorPoint_Internal(dim, sp->order+1, ind, tup);
733:         for (p = 0; p < npoints; ++p) {
734:           B[p*pdim + i] = 1.0;
735:           for (d = 0; d < dim; ++d) {
736:             B[p*pdim + i] *= LB[(tup[d]*dim + d)*npoints + p];
737:           }
738:         }
739:         ++i;
740:       }
741:     } else {
742:       i = 0;
743:       for (o = 0; o <= sp->order; ++o) {
744:         PetscMemzero(ind, dim * sizeof(PetscInt));
745:         while (ind[0] >= 0) {
746:           LatticePoint_Internal(dim, o, ind, tup);
747:           for (p = 0; p < npoints; ++p) {
748:             B[p*pdim + i] = 1.0;
749:             for (d = 0; d < dim; ++d) {
750:               B[p*pdim + i] *= LB[(tup[d]*dim + d)*npoints + p];
751:             }
752:           }
753:           ++i;
754:         }
755:       }
756:     }
757:   }
758:   if (D) {
759:     /* D (npoints x pdim x dim) */
760:     if (poly->tensor) {
761:       i = 0;
762:       PetscMemzero(ind, dim * sizeof(PetscInt));
763:       while (ind[0] >= 0) {
764:         TensorPoint_Internal(dim, sp->order+1, ind, tup);
765:         for (p = 0; p < npoints; ++p) {
766:           for (der = 0; der < dim; ++der) {
767:             D[(p*pdim + i)*dim + der] = 1.0;
768:             for (d = 0; d < dim; ++d) {
769:               if (d == der) {
770:                 D[(p*pdim + i)*dim + der] *= LD[(tup[d]*dim + d)*npoints + p];
771:               } else {
772:                 D[(p*pdim + i)*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
773:               }
774:             }
775:           }
776:         }
777:         ++i;
778:       }
779:     } else {
780:       i = 0;
781:       for (o = 0; o <= sp->order; ++o) {
782:         PetscMemzero(ind, dim * sizeof(PetscInt));
783:         while (ind[0] >= 0) {
784:           LatticePoint_Internal(dim, o, ind, tup);
785:           for (p = 0; p < npoints; ++p) {
786:             for (der = 0; der < dim; ++der) {
787:               D[(p*pdim + i)*dim + der] = 1.0;
788:               for (d = 0; d < dim; ++d) {
789:                 if (d == der) {
790:                   D[(p*pdim + i)*dim + der] *= LD[(tup[d]*dim + d)*npoints + p];
791:                 } else {
792:                   D[(p*pdim + i)*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
793:                 }
794:               }
795:             }
796:           }
797:           ++i;
798:         }
799:       }
800:     }
801:   }
802:   if (H) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Too lazy to code second derivatives");
803:   PetscFree2(ind,tup);
804:   if (B) {DMRestoreWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LB);}
805:   if (D) {DMRestoreWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LD);}
806:   if (H) {DMRestoreWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LH);}
807:   DMRestoreWorkArray(dm, npoints*ndegree*3, PETSC_REAL, &tmp);
808:   DMRestoreWorkArray(dm, npoints, PETSC_REAL, &lpoints);
809:   return(0);
810: }

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

819:   Input Parameters:
820: + sp     - the function space object
821: - tensor - PETSC_TRUE for a tensor polynomial space, PETSC_FALSE for a polynomial space

823:   Level: beginner

825: .seealso: PetscSpacePolynomialGetTensor(), PetscSpaceSetOrder(), PetscSpacePolynomialSetNumVariables()
826: @*/
827: PetscErrorCode PetscSpacePolynomialSetTensor(PetscSpace sp, PetscBool tensor)
828: {

833:   PetscTryMethod(sp,"PetscSpacePolynomialSetTensor_C",(PetscSpace,PetscBool),(sp,tensor));
834:   return(0);
835: }

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

844:   Input Parameters:
845: . sp     - the function space object

847:   Output Parameters:
848: . tensor - PETSC_TRUE for a tensor polynomial space, PETSC_FALSE for a polynomial space

850:   Level: beginner

852: .seealso: PetscSpacePolynomialSetTensor(), PetscSpaceSetOrder(), PetscSpacePolynomialSetNumVariables()
853: @*/
854: PetscErrorCode PetscSpacePolynomialGetTensor(PetscSpace sp, PetscBool *tensor)
855: {

861:   PetscTryMethod(sp,"PetscSpacePolynomialGetTensor_C",(PetscSpace,PetscBool*),(sp,tensor));
862:   return(0);
863: }

867: static PetscErrorCode PetscSpacePolynomialSetTensor_Polynomial(PetscSpace sp, PetscBool tensor)
868: {
869:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

872:   poly->tensor = tensor;
873:   return(0);
874: }

878: static PetscErrorCode PetscSpacePolynomialGetTensor_Polynomial(PetscSpace sp, PetscBool *tensor)
879: {
880:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

885:   *tensor = poly->tensor;
886:   return(0);
887: }

891: PetscErrorCode PetscSpaceInitialize_Polynomial(PetscSpace sp)
892: {

896:   sp->ops->setfromoptions = PetscSpaceSetFromOptions_Polynomial;
897:   sp->ops->setup          = PetscSpaceSetUp_Polynomial;
898:   sp->ops->view           = PetscSpaceView_Polynomial;
899:   sp->ops->destroy        = PetscSpaceDestroy_Polynomial;
900:   sp->ops->getdimension   = PetscSpaceGetDimension_Polynomial;
901:   sp->ops->evaluate       = PetscSpaceEvaluate_Polynomial;
902:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", PetscSpacePolynomialGetTensor_Polynomial);
903:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialSetTensor_C", PetscSpacePolynomialSetTensor_Polynomial);
904:   return(0);
905: }

907: /*MC
908:   PETSCSPACEPOLYNOMIAL = "poly" - A PetscSpace object that encapsulates a polynomial space, e.g. P1 is the space of linear polynomials.

910:   Level: intermediate

912: .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
913: M*/

917: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_Polynomial(PetscSpace sp)
918: {
919:   PetscSpace_Poly *poly;
920:   PetscErrorCode   ierr;

924:   PetscNewLog(sp,&poly);
925:   sp->data = poly;

927:   poly->numVariables = 0;
928:   poly->symmetric    = PETSC_FALSE;
929:   poly->tensor       = PETSC_FALSE;
930:   poly->degrees      = NULL;

932:   PetscSpaceInitialize_Polynomial(sp);
933:   return(0);
934: }

938: PetscErrorCode PetscSpacePolynomialSetSymmetric(PetscSpace sp, PetscBool sym)
939: {
940:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

944:   poly->symmetric = sym;
945:   return(0);
946: }

950: PetscErrorCode PetscSpacePolynomialGetSymmetric(PetscSpace sp, PetscBool *sym)
951: {
952:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

957:   *sym = poly->symmetric;
958:   return(0);
959: }

963: PetscErrorCode PetscSpacePolynomialSetNumVariables(PetscSpace sp, PetscInt n)
964: {
965:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

969:   poly->numVariables = n;
970:   return(0);
971: }

975: PetscErrorCode PetscSpacePolynomialGetNumVariables(PetscSpace sp, PetscInt *n)
976: {
977:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

982:   *n = poly->numVariables;
983:   return(0);
984: }

988: PetscErrorCode PetscSpaceSetFromOptions_DG(PetscOptionItems *PetscOptionsObject,PetscSpace sp)
989: {
990:   PetscSpace_DG *dg = (PetscSpace_DG *) sp->data;

994:   PetscOptionsHead(PetscOptionsObject,"PetscSpace DG options");
995:   PetscOptionsInt("-petscspace_dg_num_variables", "The number of different variables, e.g. x and y", "PetscSpaceDGSetNumVariables", dg->numVariables, &dg->numVariables, NULL);
996:   PetscOptionsTail();
997:   return(0);
998: }

1002: PetscErrorCode PetscSpaceDGView_Ascii(PetscSpace sp, PetscViewer viewer)
1003: {
1004:   PetscSpace_DG    *dg = (PetscSpace_DG *) sp->data;
1005:   PetscViewerFormat format;
1006:   PetscErrorCode    ierr;

1009:   PetscViewerGetFormat(viewer, &format);
1010:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
1011:     PetscViewerASCIIPrintf(viewer, "DG space in dimension %d:\n", dg->numVariables);
1012:     PetscViewerASCIIPushTab(viewer);
1013:     PetscQuadratureView(dg->quad, viewer);
1014:     PetscViewerASCIIPopTab(viewer);
1015:   } else {
1016:     PetscViewerASCIIPrintf(viewer, "DG space in dimension %d on %d points\n", dg->numVariables, dg->quad->numPoints);
1017:   }
1018:   return(0);
1019: }

1023: PetscErrorCode PetscSpaceView_DG(PetscSpace sp, PetscViewer viewer)
1024: {
1025:   PetscBool      iascii;

1031:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
1032:   if (iascii) {PetscSpaceDGView_Ascii(sp, viewer);}
1033:   return(0);
1034: }

1038: PetscErrorCode PetscSpaceSetUp_DG(PetscSpace sp)
1039: {
1040:   PetscSpace_DG *dg = (PetscSpace_DG *) sp->data;

1044:   if (!dg->quad->points && sp->order) {
1045:     PetscDTGaussJacobiQuadrature(dg->numVariables, sp->order, -1.0, 1.0, &dg->quad);
1046:   }
1047:   return(0);
1048: }

1052: PetscErrorCode PetscSpaceDestroy_DG(PetscSpace sp)
1053: {
1054:   PetscSpace_DG *dg = (PetscSpace_DG *) sp->data;

1058:   PetscQuadratureDestroy(&dg->quad);
1059:   return(0);
1060: }

1064: PetscErrorCode PetscSpaceGetDimension_DG(PetscSpace sp, PetscInt *dim)
1065: {
1066:   PetscSpace_DG *dg = (PetscSpace_DG *) sp->data;

1069:   *dim = dg->quad->numPoints;
1070:   return(0);
1071: }

1075: PetscErrorCode PetscSpaceEvaluate_DG(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
1076: {
1077:   PetscSpace_DG *dg  = (PetscSpace_DG *) sp->data;
1078:   PetscInt       dim = dg->numVariables, d, p;

1082:   if (D || H) SETERRQ(PetscObjectComm((PetscObject) sp), PETSC_ERR_SUP, "Cannot calculate derivatives for a DG space");
1083:   if (npoints != dg->quad->numPoints) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot evaluate DG space on %d points != %d size", npoints, dg->quad->numPoints);
1084:   PetscMemzero(B, npoints*npoints * sizeof(PetscReal));
1085:   for (p = 0; p < npoints; ++p) {
1086:     for (d = 0; d < dim; ++d) {
1087:       if (PetscAbsReal(points[p*dim+d] - dg->quad->points[p*dim+d]) > 1.0e-10) SETERRQ4(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cannot evaluate DG point (%d, %d) %g != %g", p, d, points[p*dim+d], dg->quad->points[p*dim+d]);
1088:     }
1089:     B[p*npoints+p] = 1.0;
1090:   }
1091:   return(0);
1092: }

1096: PetscErrorCode PetscSpaceInitialize_DG(PetscSpace sp)
1097: {
1099:   sp->ops->setfromoptions = PetscSpaceSetFromOptions_DG;
1100:   sp->ops->setup          = PetscSpaceSetUp_DG;
1101:   sp->ops->view           = PetscSpaceView_DG;
1102:   sp->ops->destroy        = PetscSpaceDestroy_DG;
1103:   sp->ops->getdimension   = PetscSpaceGetDimension_DG;
1104:   sp->ops->evaluate       = PetscSpaceEvaluate_DG;
1105:   return(0);
1106: }

1108: /*MC
1109:   PETSCSPACEDG = "dg" - A PetscSpace object that encapsulates functions defined on a set of quadrature points.

1111:   Level: intermediate

1113: .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
1114: M*/

1118: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_DG(PetscSpace sp)
1119: {
1120:   PetscSpace_DG *dg;

1125:   PetscNewLog(sp,&dg);
1126:   sp->data = dg;

1128:   dg->numVariables    = 0;
1129:   dg->quad->dim       = 0;
1130:   dg->quad->numPoints = 0;
1131:   dg->quad->points    = NULL;
1132:   dg->quad->weights   = NULL;

1134:   PetscSpaceInitialize_DG(sp);
1135:   return(0);
1136: }


1139: PetscClassId PETSCDUALSPACE_CLASSID = 0;

1141: PetscFunctionList PetscDualSpaceList              = NULL;
1142: PetscBool         PetscDualSpaceRegisterAllCalled = PETSC_FALSE;

1146: /*@C
1147:   PetscDualSpaceRegister - Adds a new PetscDualSpace implementation

1149:   Not Collective

1151:   Input Parameters:
1152: + name        - The name of a new user-defined creation routine
1153: - create_func - The creation routine itself

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

1158:   Sample usage:
1159: .vb
1160:     PetscDualSpaceRegister("my_space", MyPetscDualSpaceCreate);
1161: .ve

1163:   Then, your PetscDualSpace type can be chosen with the procedural interface via
1164: .vb
1165:     PetscDualSpaceCreate(MPI_Comm, PetscDualSpace *);
1166:     PetscDualSpaceSetType(PetscDualSpace, "my_dual_space");
1167: .ve
1168:    or at runtime via the option
1169: .vb
1170:     -petscdualspace_type my_dual_space
1171: .ve

1173:   Level: advanced

1175: .keywords: PetscDualSpace, register
1176: .seealso: PetscDualSpaceRegisterAll(), PetscDualSpaceRegisterDestroy()

1178: @*/
1179: PetscErrorCode PetscDualSpaceRegister(const char sname[], PetscErrorCode (*function)(PetscDualSpace))
1180: {

1184:   PetscFunctionListAdd(&PetscDualSpaceList, sname, function);
1185:   return(0);
1186: }

1190: /*@C
1191:   PetscDualSpaceSetType - Builds a particular PetscDualSpace

1193:   Collective on PetscDualSpace

1195:   Input Parameters:
1196: + sp   - The PetscDualSpace object
1197: - name - The kind of space

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

1202:   Level: intermediate

1204: .keywords: PetscDualSpace, set, type
1205: .seealso: PetscDualSpaceGetType(), PetscDualSpaceCreate()
1206: @*/
1207: PetscErrorCode PetscDualSpaceSetType(PetscDualSpace sp, PetscDualSpaceType name)
1208: {
1209:   PetscErrorCode (*r)(PetscDualSpace);
1210:   PetscBool      match;

1215:   PetscObjectTypeCompare((PetscObject) sp, name, &match);
1216:   if (match) return(0);

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

1222:   if (sp->ops->destroy) {
1223:     (*sp->ops->destroy)(sp);
1224:     sp->ops->destroy = NULL;
1225:   }
1226:   (*r)(sp);
1227:   PetscObjectChangeTypeName((PetscObject) sp, name);
1228:   return(0);
1229: }

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

1236:   Not Collective

1238:   Input Parameter:
1239: . sp  - The PetscDualSpace

1241:   Output Parameter:
1242: . name - The PetscDualSpace type name

1244:   Level: intermediate

1246: .keywords: PetscDualSpace, get, type, name
1247: .seealso: PetscDualSpaceSetType(), PetscDualSpaceCreate()
1248: @*/
1249: PetscErrorCode PetscDualSpaceGetType(PetscDualSpace sp, PetscDualSpaceType *name)
1250: {

1256:   if (!PetscDualSpaceRegisterAllCalled) {
1257:     PetscDualSpaceRegisterAll();
1258:   }
1259:   *name = ((PetscObject) sp)->type_name;
1260:   return(0);
1261: }

1265: /*@
1266:   PetscDualSpaceView - Views a PetscDualSpace

1268:   Collective on PetscDualSpace

1270:   Input Parameter:
1271: + sp - the PetscDualSpace object to view
1272: - v  - the viewer

1274:   Level: developer

1276: .seealso PetscDualSpaceDestroy()
1277: @*/
1278: PetscErrorCode PetscDualSpaceView(PetscDualSpace sp, PetscViewer v)
1279: {

1284:   if (!v) {
1285:     PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) sp), &v);
1286:   }
1287:   if (sp->ops->view) {
1288:     (*sp->ops->view)(sp, v);
1289:   }
1290:   return(0);
1291: }

1295: /*@
1296:   PetscDualSpaceSetFromOptions - sets parameters in a PetscDualSpace from the options database

1298:   Collective on PetscDualSpace

1300:   Input Parameter:
1301: . sp - the PetscDualSpace object to set options for

1303:   Options Database:
1304: . -petscspace_order the approximation order of the space

1306:   Level: developer

1308: .seealso PetscDualSpaceView()
1309: @*/
1310: PetscErrorCode PetscDualSpaceSetFromOptions(PetscDualSpace sp)
1311: {
1312:   const char    *defaultType;
1313:   char           name[256];
1314:   PetscBool      flg;

1319:   if (!((PetscObject) sp)->type_name) {
1320:     defaultType = PETSCDUALSPACELAGRANGE;
1321:   } else {
1322:     defaultType = ((PetscObject) sp)->type_name;
1323:   }
1324:   if (!PetscSpaceRegisterAllCalled) {PetscSpaceRegisterAll();}

1326:   PetscObjectOptionsBegin((PetscObject) sp);
1327:   PetscOptionsFList("-petscdualspace_type", "Dual space", "PetscDualSpaceSetType", PetscDualSpaceList, defaultType, name, 256, &flg);
1328:   if (flg) {
1329:     PetscDualSpaceSetType(sp, name);
1330:   } else if (!((PetscObject) sp)->type_name) {
1331:     PetscDualSpaceSetType(sp, defaultType);
1332:   }
1333:   PetscOptionsInt("-petscdualspace_order", "The approximation order", "PetscDualSpaceSetOrder", sp->order, &sp->order, NULL);
1334:   if (sp->ops->setfromoptions) {
1335:     (*sp->ops->setfromoptions)(PetscOptionsObject,sp);
1336:   }
1337:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
1338:   PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) sp);
1339:   PetscOptionsEnd();
1340:   PetscDualSpaceViewFromOptions(sp, NULL, "-petscdualspace_view");
1341:   return(0);
1342: }

1346: /*@
1347:   PetscDualSpaceSetUp - Construct a basis for the PetscDualSpace

1349:   Collective on PetscDualSpace

1351:   Input Parameter:
1352: . sp - the PetscDualSpace object to setup

1354:   Level: developer

1356: .seealso PetscDualSpaceView(), PetscDualSpaceDestroy()
1357: @*/
1358: PetscErrorCode PetscDualSpaceSetUp(PetscDualSpace sp)
1359: {

1364:   if (sp->setupcalled) return(0);
1365:   sp->setupcalled = PETSC_TRUE;
1366:   if (sp->ops->setup) {(*sp->ops->setup)(sp);}
1367:   return(0);
1368: }

1372: /*@
1373:   PetscDualSpaceDestroy - Destroys a PetscDualSpace object

1375:   Collective on PetscDualSpace

1377:   Input Parameter:
1378: . sp - the PetscDualSpace object to destroy

1380:   Level: developer

1382: .seealso PetscDualSpaceView()
1383: @*/
1384: PetscErrorCode PetscDualSpaceDestroy(PetscDualSpace *sp)
1385: {
1386:   PetscInt       dim, f;

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

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

1396:   PetscDualSpaceGetDimension(*sp, &dim);
1397:   for (f = 0; f < dim; ++f) {
1398:     PetscQuadratureDestroy(&(*sp)->functional[f]);
1399:   }
1400:   PetscFree((*sp)->functional);
1401:   DMDestroy(&(*sp)->dm);

1403:   if ((*sp)->ops->destroy) {(*(*sp)->ops->destroy)(*sp);}
1404:   PetscHeaderDestroy(sp);
1405:   return(0);
1406: }

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

1413:   Collective on MPI_Comm

1415:   Input Parameter:
1416: . comm - The communicator for the PetscDualSpace object

1418:   Output Parameter:
1419: . sp - The PetscDualSpace object

1421:   Level: beginner

1423: .seealso: PetscDualSpaceSetType(), PETSCDUALSPACELAGRANGE
1424: @*/
1425: PetscErrorCode PetscDualSpaceCreate(MPI_Comm comm, PetscDualSpace *sp)
1426: {
1427:   PetscDualSpace s;

1432:   PetscCitationsRegister(FECitation,&FEcite);
1433:   *sp  = NULL;
1434:   PetscFEInitializePackage();

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

1438:   s->order = 0;
1439:   s->setupcalled = PETSC_FALSE;

1441:   *sp = s;
1442:   return(0);
1443: }

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

1450:   Collective on PetscDualSpace

1452:   Input Parameter:
1453: . sp - The original PetscDualSpace

1455:   Output Parameter:
1456: . spNew - The duplicate PetscDualSpace

1458:   Level: beginner

1460: .seealso: PetscDualSpaceCreate(), PetscDualSpaceSetType()
1461: @*/
1462: PetscErrorCode PetscDualSpaceDuplicate(PetscDualSpace sp, PetscDualSpace *spNew)
1463: {

1469:   (*sp->ops->duplicate)(sp, spNew);
1470:   return(0);
1471: }

1475: /*@
1476:   PetscDualSpaceGetDM - Get the DM representing the reference cell

1478:   Not collective

1480:   Input Parameter:
1481: . sp - The PetscDualSpace

1483:   Output Parameter:
1484: . dm - The reference cell

1486:   Level: intermediate

1488: .seealso: PetscDualSpaceSetDM(), PetscDualSpaceCreate()
1489: @*/
1490: PetscErrorCode PetscDualSpaceGetDM(PetscDualSpace sp, DM *dm)
1491: {
1495:   *dm = sp->dm;
1496:   return(0);
1497: }

1501: /*@
1502:   PetscDualSpaceSetDM - Get the DM representing the reference cell

1504:   Not collective

1506:   Input Parameters:
1507: + sp - The PetscDualSpace
1508: - dm - The reference cell

1510:   Level: intermediate

1512: .seealso: PetscDualSpaceGetDM(), PetscDualSpaceCreate()
1513: @*/
1514: PetscErrorCode PetscDualSpaceSetDM(PetscDualSpace sp, DM dm)
1515: {

1521:   DMDestroy(&sp->dm);
1522:   PetscObjectReference((PetscObject) dm);
1523:   sp->dm = dm;
1524:   return(0);
1525: }

1529: /*@
1530:   PetscDualSpaceGetOrder - Get the order of the dual space

1532:   Not collective

1534:   Input Parameter:
1535: . sp - The PetscDualSpace

1537:   Output Parameter:
1538: . order - The order

1540:   Level: intermediate

1542: .seealso: PetscDualSpaceSetOrder(), PetscDualSpaceCreate()
1543: @*/
1544: PetscErrorCode PetscDualSpaceGetOrder(PetscDualSpace sp, PetscInt *order)
1545: {
1549:   *order = sp->order;
1550:   return(0);
1551: }

1555: /*@
1556:   PetscDualSpaceSetOrder - Set the order of the dual space

1558:   Not collective

1560:   Input Parameters:
1561: + sp - The PetscDualSpace
1562: - order - The order

1564:   Level: intermediate

1566: .seealso: PetscDualSpaceGetOrder(), PetscDualSpaceCreate()
1567: @*/
1568: PetscErrorCode PetscDualSpaceSetOrder(PetscDualSpace sp, PetscInt order)
1569: {
1572:   sp->order = order;
1573:   return(0);
1574: }

1578: /*@
1579:   PetscDualSpaceLagrangeGetTensor - Get the tensor nature of the dual space

1581:   Not collective

1583:   Input Parameter:
1584: . sp - The PetscDualSpace

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

1589:   Level: intermediate

1591: .seealso: PetscDualSpaceLagrangeSetTensor(), PetscDualSpaceCreate()
1592: @*/
1593: PetscErrorCode PetscDualSpaceLagrangeGetTensor(PetscDualSpace sp, PetscBool *tensor)
1594: {

1600:   PetscTryMethod(sp,"PetscDualSpaceLagrangeGetTensor_C",(PetscDualSpace,PetscBool *),(sp,tensor));
1601:   return(0);
1602: }

1606: /*@
1607:   PetscDualSpaceLagrangeSetTensor - Set the tensor nature of the dual space

1609:   Not collective

1611:   Input Parameters:
1612: + sp - The PetscDualSpace
1613: - tensor - Whether the dual space has tensor layout (vs. simplicial)

1615:   Level: intermediate

1617: .seealso: PetscDualSpaceLagrangeGetTensor(), PetscDualSpaceCreate()
1618: @*/
1619: PetscErrorCode PetscDualSpaceLagrangeSetTensor(PetscDualSpace sp, PetscBool tensor)
1620: {

1625:   PetscTryMethod(sp,"PetscDualSpaceLagrangeSetTensor_C",(PetscDualSpace,PetscBool),(sp,tensor));
1626:   return(0);
1627: }

1631: /*@
1632:   PetscDualSpaceGetFunctional - Get the i-th basis functional in the dual space

1634:   Not collective

1636:   Input Parameters:
1637: + sp - The PetscDualSpace
1638: - i  - The basis number

1640:   Output Parameter:
1641: . functional - The basis functional

1643:   Level: intermediate

1645: .seealso: PetscDualSpaceGetDimension(), PetscDualSpaceCreate()
1646: @*/
1647: PetscErrorCode PetscDualSpaceGetFunctional(PetscDualSpace sp, PetscInt i, PetscQuadrature *functional)
1648: {
1649:   PetscInt       dim;

1655:   PetscDualSpaceGetDimension(sp, &dim);
1656:   if ((i < 0) || (i >= dim)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Functional index %d must be in [0, %d)", i, dim);
1657:   *functional = sp->functional[i];
1658:   return(0);
1659: }

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

1666:   Not collective

1668:   Input Parameter:
1669: . sp - The PetscDualSpace

1671:   Output Parameter:
1672: . dim - The dimension

1674:   Level: intermediate

1676: .seealso: PetscDualSpaceGetFunctional(), PetscDualSpaceCreate()
1677: @*/
1678: PetscErrorCode PetscDualSpaceGetDimension(PetscDualSpace sp, PetscInt *dim)
1679: {

1685:   *dim = 0;
1686:   if (sp->ops->getdimension) {(*sp->ops->getdimension)(sp, dim);}
1687:   return(0);
1688: }

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

1695:   Not collective

1697:   Input Parameter:
1698: . sp - The PetscDualSpace

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

1703:   Level: intermediate

1705: .seealso: PetscDualSpaceGetFunctional(), PetscDualSpaceCreate()
1706: @*/
1707: PetscErrorCode PetscDualSpaceGetNumDof(PetscDualSpace sp, const PetscInt **numDof)
1708: {

1714:   (*sp->ops->getnumdof)(sp, numDof);
1715:   if (!*numDof) SETERRQ(PetscObjectComm((PetscObject) sp), PETSC_ERR_LIB, "Empty numDof[] returned from dual space implementation");
1716:   return(0);
1717: }

1721: /*@
1722:   PetscDualSpaceCreateReferenceCell - Create a DMPLEX with the appropriate FEM reference cell

1724:   Collective on PetscDualSpace

1726:   Input Parameters:
1727: + sp      - The PetscDualSpace
1728: . dim     - The spatial dimension
1729: - simplex - Flag for simplex, otherwise use a tensor-product cell

1731:   Output Parameter:
1732: . refdm - The reference cell

1734:   Level: advanced

1736: .keywords: PetscDualSpace, reference cell
1737: .seealso: PetscDualSpaceCreate(), DMPLEX
1738: @*/
1739: PetscErrorCode PetscDualSpaceCreateReferenceCell(PetscDualSpace sp, PetscInt dim, PetscBool simplex, DM *refdm)
1740: {

1744:   DMPlexCreateReferenceCell(PetscObjectComm((PetscObject) sp), dim, simplex, refdm);
1745:   return(0);
1746: }

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

1753:   Input Parameters:
1754: + sp      - The PetscDualSpace object
1755: . f       - The basis functional index
1756: . time    - The time
1757: . cgeom   - A context with geometric information for this cell, we use v0 (the initial vertex) and J (the Jacobian)
1758: . numComp - The number of components for the function
1759: . func    - The input function
1760: - ctx     - A context for the function

1762:   Output Parameter:
1763: . value   - numComp output values

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

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

1770:   Level: developer

1772: .seealso: PetscDualSpaceCreate()
1773: @*/
1774: 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)
1775: {
1776:   DM               dm;
1777:   PetscQuadrature  quad;
1778:   PetscReal        x[3];
1779:   PetscScalar     *val;
1780:   PetscInt         dim, q, c;
1781:   PetscErrorCode   ierr;

1786:   dim  = cgeom->dim;
1787:   PetscDualSpaceGetDM(sp, &dm);
1788:   PetscDualSpaceGetFunctional(sp, f, &quad);
1789:   DMGetWorkArray(dm, numComp, PETSC_SCALAR, &val);
1790:   for (c = 0; c < numComp; ++c) value[c] = 0.0;
1791:   for (q = 0; q < quad->numPoints; ++q) {
1792:     CoordinatesRefToReal(cgeom->dimEmbed, dim, cgeom->v0, cgeom->J, &quad->points[q*dim], x);
1793:     (*func)(cgeom->dimEmbed, time, x, numComp, val, ctx);
1794:     for (c = 0; c < numComp; ++c) {
1795:       value[c] += val[c]*quad->weights[q];
1796:     }
1797:   }
1798:   DMRestoreWorkArray(dm, numComp, PETSC_SCALAR, &val);
1799:   return(0);
1800: }

1804: /*@C
1805:   PetscDualSpaceApplyFVM - Apply a functional from the dual space basis to an input function

1807:   Input Parameters:
1808: + sp      - The PetscDualSpace object
1809: . f       - The basis functional index
1810: . time    - The time
1811: . cgeom   - A context with geometric information for this cell, we currently just use the centroid
1812: . numComp - The number of components for the function
1813: . func    - The input function
1814: - ctx     - A context for the function

1816:   Output Parameter:
1817: . value   - numComp output values

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

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

1824:   Level: developer

1826: .seealso: PetscDualSpaceCreate()
1827: @*/
1828: PetscErrorCode PetscDualSpaceApplyFVM(PetscDualSpace sp, PetscInt f, PetscReal time, PetscFVCellGeom *cgeom, PetscInt numComp, PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void *ctx, PetscScalar *value)
1829: {
1830:   DM               dm;
1831:   PetscQuadrature  quad;
1832:   PetscScalar     *val;
1833:   PetscInt         dimEmbed, q, c;
1834:   PetscErrorCode   ierr;

1839:   PetscDualSpaceGetDM(sp, &dm);
1840:   DMGetCoordinateDim(dm, &dimEmbed);
1841:   PetscDualSpaceGetFunctional(sp, f, &quad);
1842:   DMGetWorkArray(dm, numComp, PETSC_SCALAR, &val);
1843:   for (c = 0; c < numComp; ++c) value[c] = 0.0;
1844:   for (q = 0; q < quad->numPoints; ++q) {
1845:     (*func)(dimEmbed, time, cgeom->centroid, numComp, val, ctx);
1846:     for (c = 0; c < numComp; ++c) {
1847:       value[c] += val[c]*quad->weights[q];
1848:     }
1849:   }
1850:   DMRestoreWorkArray(dm, numComp, PETSC_SCALAR, &val);
1851:   return(0);
1852: }

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

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

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

1865:   Not collective

1867:   Input Parameters:
1868: + sp - the PetscDualSpace object
1869: - height - the height of the mesh point for which the subspace is desired

1871:   Output Parameters:
1872:   bdsp - the subspace: must be destroyed by the user

1874:   Level: advanced

1876: .seealso: PetscDualSpace
1877: @*/
1878: PetscErrorCode PetscDualSpaceGetHeightSubspace(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
1879: {

1885:   *bdsp = NULL;
1886:   if (sp->ops->getheightsubspace) {
1887:     (*sp->ops->getheightsubspace)(sp,height,bdsp);
1888:   }
1889:   return(0);
1890: }

1894: static PetscErrorCode PetscDualSpaceLagrangeGetTensor_Lagrange(PetscDualSpace sp, PetscBool *tensor)
1895: {
1896:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;

1899:   *tensor = lag->tensorSpace;
1900:   return(0);
1901: }

1905: static PetscErrorCode PetscDualSpaceLagrangeSetTensor_Lagrange(PetscDualSpace sp, PetscBool tensor)
1906: {
1907:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;

1910:   lag->tensorSpace = tensor;
1911:   return(0);
1912: }

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

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

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

1923:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
1924:   PetscInt           dim, order, p;
1925:   PetscErrorCode     ierr;

1928:   PetscDualSpaceGetOrder(sp,&order);
1929:   DMGetDimension(sp->dm,&dim);
1930:   if (!dim || !lag->continuous || order < 3) return(0);
1931:   if (dim > 3) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Lagrange symmetries not implemented for dim = %D > 3",dim);
1932:   if (!lag->symmetries) { /* store symmetries */
1933:     PetscDualSpace hsp;
1934:     DM             K;
1935:     PetscInt       numPoints = 1, d;
1936:     PetscInt       numFaces;
1937:     PetscInt       ***symmetries;
1938:     const PetscInt ***hsymmetries;

1940:     if (lag->simplexCell) {
1941:       numFaces = 1 + dim;
1942:       for (d = 0; d < dim; d++) numPoints = numPoints * 2 + 1;
1943:     }
1944:     else {
1945:       numPoints = PetscPowInt(3,dim);
1946:       numFaces  = 2 * dim;
1947:     }
1948:     PetscCalloc1(numPoints,&symmetries);
1949:     if (0 < dim && dim < 3) { /* compute self symmetries */
1950:       PetscInt **cellSymmetries;

1952:       lag->numSelfSym = 2 * numFaces;
1953:       lag->selfSymOff = numFaces;
1954:       PetscCalloc1(2*numFaces,&cellSymmetries);
1955:       /* we want to be able to index symmetries directly with the orientations, which range from [-numFaces,numFaces) */
1956:       symmetries[0] = &cellSymmetries[numFaces];
1957:       if (dim == 1) {
1958:         PetscInt dofPerEdge = order - 1;

1960:         if (dofPerEdge > 1) {
1961:           PetscInt i, *reverse;

1963:           PetscMalloc1(dofPerEdge,&reverse);
1964:           for (i = 0; i < dofPerEdge; i++) reverse[i] = (dofPerEdge - 1 - i);
1965:           symmetries[0][-2] = reverse;

1967:           /* yes, this is redundant, but it makes it easier to cleanup if I don't have to worry about what not to free */
1968:           PetscMalloc1(dofPerEdge,&reverse);
1969:           for (i = 0; i < dofPerEdge; i++) reverse[i] = (dofPerEdge - 1 - i);
1970:           symmetries[0][1] = reverse;
1971:         }
1972:       } else {
1973:         PetscInt dofPerEdge = lag->simplexCell ? (order - 2) : (order - 1), s;

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

1979:             if (!s) continue;
1980:             if (lag->simplexCell) {
1981:               PetscMalloc1((dofPerEdge * (dofPerEdge + 1))/2,&sym);
1982:               for (j = 0, l = 0; j < dofPerEdge; j++) {
1983:                 for (k = 0; k < dofPerEdge - j; k++, l++) {
1984:                   i = dofPerEdge - 1 - j - k;
1985:                   switch (s) {
1986:                   case -3:
1987:                     sym[l] = BaryIndex(dofPerEdge,i,k,j);
1988:                     break;
1989:                   case -2:
1990:                     sym[l] = BaryIndex(dofPerEdge,j,i,k);
1991:                     break;
1992:                   case -1:
1993:                     sym[l] = BaryIndex(dofPerEdge,k,j,i);
1994:                     break;
1995:                   case 1:
1996:                     sym[l] = BaryIndex(dofPerEdge,k,i,j);
1997:                     break;
1998:                   case 2:
1999:                     sym[l] = BaryIndex(dofPerEdge,j,k,i);
2000:                     break;
2001:                   }
2002:                 }
2003:               }
2004:             } else {
2005:               PetscMalloc1(dofPerEdge * dofPerEdge,&sym);
2006:               for (j = 0, l = 0; j < dofPerEdge; j++) {
2007:                 for (k = 0; k < dofPerEdge; k++, l++) {
2008:                   switch (s) {
2009:                   case -4:
2010:                     sym[l] = CartIndex(dofPerEdge,k,j);
2011:                     break;
2012:                   case -3:
2013:                     sym[l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - j),k);
2014:                     break;
2015:                   case -2:
2016:                     sym[l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - k),(dofPerEdge - 1 - j));
2017:                     break;
2018:                   case -1:
2019:                     sym[l] = CartIndex(dofPerEdge,j,(dofPerEdge - 1 - k));
2020:                     break;
2021:                   case 1:
2022:                     sym[l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - k),j);
2023:                     break;
2024:                   case 2:
2025:                     sym[l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - j),(dofPerEdge - 1 - k));
2026:                     break;
2027:                   case 3:
2028:                     sym[l] = CartIndex(dofPerEdge,k,(dofPerEdge - 1 - j));
2029:                     break;
2030:                   }
2031:                 }
2032:               }
2033:             }
2034:             symmetries[0][s] = sym;
2035:           }
2036:         }
2037:       }
2038:     }
2039:     PetscDualSpaceGetHeightSubspace(sp,1,&hsp);
2040:     PetscDualSpaceGetSymmetries(hsp,&hsymmetries,NULL);
2041:     if (hsymmetries) {
2042:       PetscBool      *seen;
2043:       const PetscInt *cone;
2044:       PetscInt       KclosureSize, *Kclosure = NULL;

2046:       PetscDualSpaceGetDM(sp,&K);
2047:       PetscCalloc1(numPoints,&seen);
2048:       DMPlexGetCone(K,0,&cone);
2049:       DMPlexGetTransitiveClosure(K,0,PETSC_TRUE,&KclosureSize,&Kclosure);
2050:       for (p = 0; p < numFaces; p++) {
2051:         PetscInt closureSize, *closure = NULL, q;

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

2057:           if(!seen[point]) {
2058:             for (r = 0; r < KclosureSize; r++) {
2059:               if (Kclosure[2 * r] == point) break;
2060:             }
2061:             seen[point] = PETSC_TRUE;
2062:             symmetries[r] = (PetscInt **) hsymmetries[q];
2063:           }
2064:         }
2065:         DMPlexRestoreTransitiveClosure(K,cone[p],PETSC_TRUE,&closureSize,&closure);
2066:       }
2067:       DMPlexRestoreTransitiveClosure(K,0,PETSC_TRUE,&KclosureSize,&Kclosure);
2068:       PetscFree(seen);
2069:     }
2070:     lag->symmetries = symmetries;
2071:   }
2072:   if (perms) *perms = (const PetscInt ***) lag->symmetries;
2073:   return(0);
2074: }

2078: PETSC_EXTERN PetscErrorCode PetscDualSpaceGetSymmetries(PetscDualSpace sp, const PetscInt ****perms, const PetscScalar ****flips)
2079: {

2084:   if (perms) {
2086:     *perms = NULL;
2087:   }
2088:   if (flips) {
2090:     *flips = NULL;
2091:   }
2092:   if (sp->ops->getsymmetries) {
2093:     (sp->ops->getsymmetries)(sp,perms,flips);
2094:   }
2095:   return(0);
2096: }

2100: static PetscErrorCode PetscDualSpaceGetDimension_SingleCell_Lagrange(PetscDualSpace sp, PetscInt order, PetscInt *dim)
2101: {
2102:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2103:   PetscReal           D   = 1.0;
2104:   PetscInt            n, i;
2105:   PetscErrorCode      ierr;

2108:   *dim = -1;                    /* Ensure that the compiler knows *dim is set. */
2109:   DMGetDimension(sp->dm, &n);
2110:   if (!lag->tensorSpace) {
2111:     for (i = 1; i <= n; ++i) {
2112:       D *= ((PetscReal) (order+i))/i;
2113:     }
2114:     *dim = (PetscInt) (D + 0.5);
2115:   } else {
2116:     *dim = 1;
2117:     for (i = 0; i < n; ++i) *dim *= (order+1);
2118:   }
2119:   return(0);
2120: }

2124: static PetscErrorCode PetscDualSpaceCreateHeightSubspace_Lagrange(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
2125: {
2126:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2127:   PetscBool          continuous, tensor;
2128:   PetscInt           order;
2129:   PetscErrorCode     ierr;

2134:   PetscDualSpaceLagrangeGetContinuity(sp,&continuous);
2135:   PetscDualSpaceGetOrder(sp,&order);
2136:   if (height == 0) {
2137:     PetscObjectReference((PetscObject)sp);
2138:     *bdsp = sp;
2139:   }
2140:   else if (continuous == PETSC_FALSE || !order) {
2141:     *bdsp = NULL;
2142:   }
2143:   else {
2144:     DM dm, K;
2145:     PetscInt dim;

2147:     PetscDualSpaceGetDM(sp,&dm);
2148:     DMGetDimension(dm,&dim);
2149:     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);}
2150:     PetscDualSpaceDuplicate(sp,bdsp);
2151:     PetscDualSpaceCreateReferenceCell(*bdsp, dim-height, lag->simplexCell, &K);
2152:     PetscDualSpaceSetDM(*bdsp, K);
2153:     DMDestroy(&K);
2154:     PetscDualSpaceLagrangeGetTensor(sp,&tensor);
2155:     PetscDualSpaceLagrangeSetTensor(*bdsp,tensor);
2156:     PetscDualSpaceSetUp(*bdsp);
2157:   }
2158:   return(0);
2159: }

2163: PetscErrorCode PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp)
2164: {
2165:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2166:   DM                  dm    = sp->dm;
2167:   PetscInt            order = sp->order;
2168:   PetscBool           continuous;
2169:   PetscSection        csection;
2170:   Vec                 coordinates;
2171:   PetscReal          *qpoints, *qweights;
2172:   PetscInt            depth, dim, pdimMax, pStart, pEnd, p, *pStratStart, *pStratEnd, coneSize, d, f = 0;
2173:   PetscBool           simplex, tensorSpace;
2174:   PetscErrorCode      ierr;

2177:   /* Classify element type */
2178:   if (!order) lag->continuous = PETSC_FALSE;
2179:   continuous = lag->continuous;
2180:   DMGetDimension(dm, &dim);
2181:   DMPlexGetDepth(dm, &depth);
2182:   DMPlexGetChart(dm, &pStart, &pEnd);
2183:   PetscCalloc1(dim+1, &lag->numDof);
2184:   PetscMalloc2(depth+1,&pStratStart,depth+1,&pStratEnd);
2185:   for (d = 0; d <= depth; ++d) {DMPlexGetDepthStratum(dm, d, &pStratStart[d], &pStratEnd[d]);}
2186:   DMPlexGetConeSize(dm, pStratStart[depth], &coneSize);
2187:   DMGetCoordinateSection(dm, &csection);
2188:   DMGetCoordinatesLocal(dm, &coordinates);
2189:   if (depth == 1) {
2190:     if      (coneSize == dim+1)    simplex = PETSC_TRUE;
2191:     else if (coneSize == 1 << dim) simplex = PETSC_FALSE;
2192:     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
2193:   }
2194:   else if (depth == dim) {
2195:     if      (coneSize == dim+1)   simplex = PETSC_TRUE;
2196:     else if (coneSize == 2 * dim) simplex = PETSC_FALSE;
2197:     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
2198:   }
2199:   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support cell-vertex meshes or interpolated meshes");
2200:   lag->simplexCell = simplex;
2201:   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");
2202:   tensorSpace    = lag->tensorSpace;
2203:   lag->height    = 0;
2204:   lag->subspaces = NULL;
2205:   if (continuous && sp->order > 0 && dim > 0) {
2206:     PetscInt i;

2208:     lag->height = dim;
2209:     PetscMalloc1(dim,&lag->subspaces);
2210:     PetscDualSpaceCreateHeightSubspace_Lagrange(sp,1,&lag->subspaces[0]);
2211:     PetscDualSpaceSetUp(lag->subspaces[0]);
2212:     for (i = 1; i < dim; i++) {
2213:       PetscDualSpaceGetHeightSubspace(lag->subspaces[i-1],1,&lag->subspaces[i]);
2214:       PetscObjectReference((PetscObject)(lag->subspaces[i]));
2215:     }
2216:   }
2217:   PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, sp->order, &pdimMax);
2218:   pdimMax *= (pStratEnd[depth] - pStratStart[depth]);
2219:   PetscMalloc1(pdimMax, &sp->functional);
2220:   if (!dim) {
2221:     PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2222:     PetscMalloc1(1, &qweights);
2223:     PetscQuadratureSetOrder(sp->functional[f], 0);
2224:     PetscQuadratureSetData(sp->functional[f], 0, 1, NULL, qweights);
2225:     qweights[0] = 1.0;
2226:     ++f;
2227:     lag->numDof[0] = 1;
2228:   } else {
2229:     PetscInt     *tup;
2230:     PetscReal    *v0, *hv0, *J, *invJ, detJ, hdetJ;
2231:     PetscSection section;

2233:     PetscSectionCreate(PETSC_COMM_SELF,&section);
2234:     PetscSectionSetChart(section,pStart,pEnd);
2235:     PetscCalloc5(dim+1,&tup,dim,&v0,dim,&hv0,dim*dim,&J,dim*dim,&invJ);
2236:     for (p = pStart; p < pEnd; p++) {
2237:       PetscInt       pointDim, d, nFunc = 0;
2238:       PetscDualSpace hsp;

2240:       DMPlexComputeCellGeometryFEM(dm, p, NULL, v0, J, invJ, &detJ);
2241:       for (d = 0; d < depth; d++) {if (p >= pStratStart[d] && p < pStratEnd[d]) break;}
2242:       pointDim = (depth == 1 && d == 1) ? dim : d;
2243:       hsp = ((pointDim < dim) && lag->subspaces) ? lag->subspaces[dim - pointDim - 1] : NULL;
2244:       if (hsp) {
2245:         PetscDualSpace_Lag *hlag = (PetscDualSpace_Lag *) hsp->data;
2246:         DM                 hdm;

2248:         PetscDualSpaceGetDM(hsp,&hdm);
2249:         DMPlexComputeCellGeometryFEM(hdm, 0, NULL, hv0, NULL, NULL, &hdetJ);
2250:         lag->numDof[pointDim] = nFunc = hlag->numDof[pointDim];
2251:       }
2252:       if (pointDim == dim) {
2253:         /* Cells, create for self */
2254:         PetscInt     orderEff = continuous ? (!tensorSpace ? order-1-dim : order-2) : order;
2255:         PetscReal    denom    = continuous ? order : (!tensorSpace ? order+1+dim : order+2);
2256:         PetscReal    numer    = (!simplex || !tensorSpace) ? 2. : (2./dim);
2257:         PetscReal    dx = numer/denom;
2258:         PetscInt     cdim, d, d2;

2260:         if (orderEff < 0) continue;
2261:         PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, orderEff, &cdim);

2263:         PetscMemzero(tup,(dim+1)*sizeof(PetscInt));
2264:         if (!tensorSpace) {
2265:           while (!tup[dim]) {
2266:             PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2267:             PetscMalloc1(dim, &qpoints);
2268:             PetscMalloc1(1,   &qweights);
2269:             PetscQuadratureSetOrder(sp->functional[f], 0);
2270:             PetscQuadratureSetData(sp->functional[f], dim, 1, qpoints, qweights);
2271:             for (d = 0; d < dim; ++d) {
2272:               qpoints[d] = v0[d];
2273:               for (d2 = 0; d2 < dim; ++d2) qpoints[d] += J[d*dim+d2]*((tup[d2]+1)*dx);
2274:             }
2275:             qweights[0] = 1.0;
2276:             ++f;
2277:             LatticePointLexicographic_Internal(dim, orderEff, tup);
2278:           }
2279:         } else {
2280:           while (!tup[dim]) {
2281:             PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2282:             PetscMalloc1(dim, &qpoints);
2283:             PetscMalloc1(1,   &qweights);
2284:             PetscQuadratureSetOrder(sp->functional[f], 0);
2285:             PetscQuadratureSetData(sp->functional[f], dim, 1, qpoints, qweights);
2286:             for (d = 0; d < dim; ++d) {
2287:               qpoints[d] = v0[d];
2288:               for (d2 = 0; d2 < dim; ++d2) qpoints[d] += J[d*dim+d2]*((tup[d2]+1)*dx);
2289:             }
2290:             qweights[0] = 1.0;
2291:             ++f;
2292:             TensorPointLexicographic_Internal(dim, orderEff, tup);
2293:           }
2294:         }
2295:         lag->numDof[dim] = cdim;
2296:       } else { /* transform functionals from subspaces */
2297:         PetscInt q;

2299:         for (q = 0; q < nFunc; q++, f++) {
2300:           PetscQuadrature fn;
2301:           PetscInt        fdim, nPoints, i;
2302:           const PetscReal *points;
2303:           const PetscReal *weights;
2304:           PetscReal       *qpoints;
2305:           PetscReal       *qweights;

2307:           PetscDualSpaceGetFunctional(hsp, q, &fn);
2308:           PetscQuadratureGetData(fn,&fdim,&nPoints,&points,&weights);
2309:           if (fdim != pointDim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expected height dual space dim %D, got %D",pointDim,fdim);
2310:           PetscMalloc1(nPoints * dim, &qpoints);
2311:           PetscMalloc1(nPoints, &qweights);
2312:           for (i = 0; i < nPoints; i++) {
2313:             PetscInt  j, k;
2314:             PetscReal *qp = &qpoints[i * dim];

2316:             qweights[i] = weights[i];
2317:             for (j = 0; j < dim; j++) qp[j] = v0[j];
2318:             for (j = 0; j < dim; j++) {
2319:               for (k = 0; k < pointDim; k++) qp[j] += J[dim * j + k] * (points[pointDim * i + k] - hv0[k]);
2320:             }
2321:           }
2322:           PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2323:           PetscQuadratureSetOrder(sp->functional[f],0);
2324:           PetscQuadratureSetData(sp->functional[f],dim,nPoints,qpoints,qweights);
2325:         }
2326:       }
2327:       PetscSectionSetDof(section,p,lag->numDof[pointDim]);
2328:     }
2329:     PetscFree5(tup,v0,hv0,J,invJ);
2330:     PetscSectionSetUp(section);
2331:     { /* reorder to closure order */
2332:       PetscInt *key, count;
2333:       PetscQuadrature *reorder = NULL;

2335:       PetscCalloc1(f,&key);
2336:       PetscMalloc1(f,&reorder);

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

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

2345:           PetscSectionGetDof(section,point,&dof);
2346:           PetscSectionGetOffset(section,point,&off);
2347:           for (i = 0; i < dof; i++) {
2348:             PetscInt fi = i + off;
2349:             if (!key[fi]) {
2350:               key[fi] = 1;
2351:               reorder[count++] = sp->functional[fi];
2352:             }
2353:           }
2354:         }
2355:         DMPlexRestoreTransitiveClosure(dm,p,PETSC_TRUE,&closureSize,&closure);
2356:       }
2357:       PetscFree(sp->functional);
2358:       sp->functional = reorder;
2359:       PetscFree(key);
2360:     }
2361:     PetscSectionDestroy(&section);
2362:   }
2363:   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);
2364:   PetscFree2(pStratStart,pStratEnd);
2365:   if (f > pdimMax) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of dual basis vectors %d is greater than dimension %d", f, pdimMax);
2366:   return(0);
2367: }

2371: PetscErrorCode PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp)
2372: {
2373:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2374:   PetscInt            i;
2375:   PetscErrorCode      ierr;

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

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

2384:       for (i = 0; i < lag->numSelfSym; i++) {
2385:         PetscFree(allocated[i]);
2386:       }
2387:       PetscFree(allocated);
2388:     }
2389:     PetscFree(lag->symmetries);
2390:   }
2391:   for (i = 0; i < lag->height; i++) {
2392:     PetscDualSpaceDestroy(&lag->subspaces[i]);
2393:   }
2394:   PetscFree(lag->subspaces);
2395:   PetscFree(lag->numDof);
2396:   PetscFree(lag);
2397:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", NULL);
2398:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", NULL);
2399:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", NULL);
2400:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", NULL);
2401:   return(0);
2402: }

2406: PetscErrorCode PetscDualSpaceDuplicate_Lagrange(PetscDualSpace sp, PetscDualSpace *spNew)
2407: {
2408:   PetscInt       order;
2409:   PetscBool      cont, tensor;

2413:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) sp), spNew);
2414:   PetscDualSpaceSetType(*spNew, PETSCDUALSPACELAGRANGE);
2415:   PetscDualSpaceGetOrder(sp, &order);
2416:   PetscDualSpaceSetOrder(*spNew, order);
2417:   PetscDualSpaceLagrangeGetContinuity(sp, &cont);
2418:   PetscDualSpaceLagrangeSetContinuity(*spNew, cont);
2419:   PetscDualSpaceLagrangeGetTensor(sp, &tensor);
2420:   PetscDualSpaceLagrangeSetTensor(*spNew, tensor);
2421:   return(0);
2422: }

2426: PetscErrorCode PetscDualSpaceSetFromOptions_Lagrange(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp)
2427: {
2428:   PetscBool      continuous, tensor, flg;

2432:   PetscDualSpaceLagrangeGetContinuity(sp, &continuous);
2433:   PetscDualSpaceLagrangeGetTensor(sp, &tensor);
2434:   PetscOptionsHead(PetscOptionsObject,"PetscDualSpace Lagrange Options");
2435:   PetscOptionsBool("-petscdualspace_lagrange_continuity", "Flag for continuous element", "PetscDualSpaceLagrangeSetContinuity", continuous, &continuous, &flg);
2436:   if (flg) {PetscDualSpaceLagrangeSetContinuity(sp, continuous);}
2437:   PetscOptionsBool("-petscdualspace_lagrange_tensor", "Flag for tensor dual space", "PetscDualSpaceLagrangeSetContinuity", tensor, &tensor, &flg);
2438:   if (flg) {PetscDualSpaceLagrangeSetTensor(sp, tensor);}
2439:   PetscOptionsTail();
2440:   return(0);
2441: }

2445: PetscErrorCode PetscDualSpaceGetDimension_Lagrange(PetscDualSpace sp, PetscInt *dim)
2446: {
2447:   DM              K;
2448:   const PetscInt *numDof;
2449:   PetscInt        spatialDim, Nc, size = 0, d;
2450:   PetscErrorCode  ierr;

2453:   PetscDualSpaceGetDM(sp, &K);
2454:   PetscDualSpaceGetNumDof(sp, &numDof);
2455:   DMGetDimension(K, &spatialDim);
2456:   DMPlexGetHeightStratum(K, 0, NULL, &Nc);
2457:   if (Nc == 1) {PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, sp->order, dim); return(0);}
2458:   for (d = 0; d <= spatialDim; ++d) {
2459:     PetscInt pStart, pEnd;

2461:     DMPlexGetDepthStratum(K, d, &pStart, &pEnd);
2462:     size += (pEnd-pStart)*numDof[d];
2463:   }
2464:   *dim = size;
2465:   return(0);
2466: }

2470: PetscErrorCode PetscDualSpaceGetNumDof_Lagrange(PetscDualSpace sp, const PetscInt **numDof)
2471: {
2472:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

2475:   *numDof = lag->numDof;
2476:   return(0);
2477: }

2481: static PetscErrorCode PetscDualSpaceLagrangeGetContinuity_Lagrange(PetscDualSpace sp, PetscBool *continuous)
2482: {
2483:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

2488:   *continuous = lag->continuous;
2489:   return(0);
2490: }

2494: static PetscErrorCode PetscDualSpaceLagrangeSetContinuity_Lagrange(PetscDualSpace sp, PetscBool continuous)
2495: {
2496:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

2500:   lag->continuous = continuous;
2501:   return(0);
2502: }

2506: /*@
2507:   PetscDualSpaceLagrangeGetContinuity - Retrieves the flag for element continuity

2509:   Not Collective

2511:   Input Parameter:
2512: . sp         - the PetscDualSpace

2514:   Output Parameter:
2515: . continuous - flag for element continuity

2517:   Level: intermediate

2519: .keywords: PetscDualSpace, Lagrange, continuous, discontinuous
2520: .seealso: PetscDualSpaceLagrangeSetContinuity()
2521: @*/
2522: PetscErrorCode PetscDualSpaceLagrangeGetContinuity(PetscDualSpace sp, PetscBool *continuous)
2523: {

2529:   PetscTryMethod(sp, "PetscDualSpaceLagrangeGetContinuity_C", (PetscDualSpace,PetscBool*),(sp,continuous));
2530:   return(0);
2531: }

2535: /*@
2536:   PetscDualSpaceLagrangeSetContinuity - Indicate whether the element is continuous

2538:   Logically Collective on PetscDualSpace

2540:   Input Parameters:
2541: + sp         - the PetscDualSpace
2542: - continuous - flag for element continuity

2544:   Options Database:
2545: . -petscdualspace_lagrange_continuity <bool>

2547:   Level: intermediate

2549: .keywords: PetscDualSpace, Lagrange, continuous, discontinuous
2550: .seealso: PetscDualSpaceLagrangeGetContinuity()
2551: @*/
2552: PetscErrorCode PetscDualSpaceLagrangeSetContinuity(PetscDualSpace sp, PetscBool continuous)
2553: {

2559:   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetContinuity_C", (PetscDualSpace,PetscBool),(sp,continuous));
2560:   return(0);
2561: }

2565: PetscErrorCode PetscDualSpaceGetHeightSubspace_Lagrange(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
2566: {
2567:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2568:   PetscErrorCode     ierr;

2573:   if (height == 0) {
2574:     *bdsp = sp;
2575:   }
2576:   else {
2577:     DM dm;
2578:     PetscInt dim;

2580:     PetscDualSpaceGetDM(sp,&dm);
2581:     DMGetDimension(dm,&dim);
2582:     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);}
2583:     if (height <= lag->height) {
2584:       *bdsp = lag->subspaces[height-1];
2585:     }
2586:     else {
2587:       *bdsp = NULL;
2588:     }
2589:   }
2590:   return(0);
2591: }

2595: PetscErrorCode PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp)
2596: {
2598:   sp->ops->setfromoptions    = PetscDualSpaceSetFromOptions_Lagrange;
2599:   sp->ops->setup             = PetscDualSpaceSetUp_Lagrange;
2600:   sp->ops->view              = NULL;
2601:   sp->ops->destroy           = PetscDualSpaceDestroy_Lagrange;
2602:   sp->ops->duplicate         = PetscDualSpaceDuplicate_Lagrange;
2603:   sp->ops->getdimension      = PetscDualSpaceGetDimension_Lagrange;
2604:   sp->ops->getnumdof         = PetscDualSpaceGetNumDof_Lagrange;
2605:   sp->ops->getheightsubspace = PetscDualSpaceGetHeightSubspace_Lagrange;
2606:   sp->ops->getsymmetries     = PetscDualSpaceGetSymmetries_Lagrange;
2607:   return(0);
2608: }

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

2613:   Level: intermediate

2615: .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
2616: M*/

2620: PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Lagrange(PetscDualSpace sp)
2621: {
2622:   PetscDualSpace_Lag *lag;
2623:   PetscErrorCode      ierr;

2627:   PetscNewLog(sp,&lag);
2628:   sp->data = lag;

2630:   lag->numDof      = NULL;
2631:   lag->simplexCell = PETSC_TRUE;
2632:   lag->tensorSpace = PETSC_FALSE;
2633:   lag->continuous  = PETSC_TRUE;

2635:   PetscDualSpaceInitialize_Lagrange(sp);
2636:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", PetscDualSpaceLagrangeGetContinuity_Lagrange);
2637:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", PetscDualSpaceLagrangeSetContinuity_Lagrange);
2638:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", PetscDualSpaceLagrangeGetTensor_Lagrange);
2639:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", PetscDualSpaceLagrangeSetTensor_Lagrange);
2640:   return(0);
2641: }

2645: PetscErrorCode PetscDualSpaceSetUp_Simple(PetscDualSpace sp)
2646: {
2647:   PetscDualSpace_Simple *s  = (PetscDualSpace_Simple *) sp->data;
2648:   DM                     dm = sp->dm;
2649:   PetscInt               dim;
2650:   PetscErrorCode         ierr;

2653:   DMGetDimension(dm, &dim);
2654:   PetscCalloc1(dim+1, &s->numDof);
2655:   return(0);
2656: }

2660: PetscErrorCode PetscDualSpaceDestroy_Simple(PetscDualSpace sp)
2661: {
2662:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2663:   PetscErrorCode         ierr;

2666:   PetscFree(s->numDof);
2667:   PetscFree(s);
2668:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetDimension_C", NULL);
2669:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetFunctional_C", NULL);
2670:   return(0);
2671: }

2675: PetscErrorCode PetscDualSpaceDuplicate_Simple(PetscDualSpace sp, PetscDualSpace *spNew)
2676: {
2677:   PetscInt       dim, d;

2681:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) sp), spNew);
2682:   PetscDualSpaceSetType(*spNew, PETSCDUALSPACESIMPLE);
2683:   PetscDualSpaceGetDimension(sp, &dim);
2684:   PetscDualSpaceSimpleSetDimension(*spNew, dim);
2685:   for (d = 0; d < dim; ++d) {
2686:     PetscQuadrature q;

2688:     PetscDualSpaceGetFunctional(sp, d, &q);
2689:     PetscDualSpaceSimpleSetFunctional(*spNew, d, q);
2690:   }
2691:   return(0);
2692: }

2696: PetscErrorCode PetscDualSpaceSetFromOptions_Simple(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp)
2697: {
2699:   return(0);
2700: }

2704: PetscErrorCode PetscDualSpaceGetDimension_Simple(PetscDualSpace sp, PetscInt *dim)
2705: {
2706:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;

2709:   *dim = s->dim;
2710:   return(0);
2711: }

2715: PetscErrorCode PetscDualSpaceSimpleSetDimension_Simple(PetscDualSpace sp, const PetscInt dim)
2716: {
2717:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2718:   DM                     dm;
2719:   PetscInt               spatialDim, f;
2720:   PetscErrorCode         ierr;

2723:   for (f = 0; f < s->dim; ++f) {PetscQuadratureDestroy(&sp->functional[f]);}
2724:   PetscFree(sp->functional);
2725:   s->dim = dim;
2726:   PetscCalloc1(s->dim, &sp->functional);
2727:   PetscFree(s->numDof);
2728:   PetscDualSpaceGetDM(sp, &dm);
2729:   DMGetCoordinateDim(dm, &spatialDim);
2730:   PetscCalloc1(spatialDim+1, &s->numDof);
2731:   s->numDof[spatialDim] = dim;
2732:   return(0);
2733: }

2737: PetscErrorCode PetscDualSpaceGetNumDof_Simple(PetscDualSpace sp, const PetscInt **numDof)
2738: {
2739:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;

2742:   *numDof = s->numDof;
2743:   return(0);
2744: }

2748: PetscErrorCode PetscDualSpaceSimpleSetFunctional_Simple(PetscDualSpace sp, PetscInt f, PetscQuadrature q)
2749: {
2750:   PetscDualSpace_Simple *s   = (PetscDualSpace_Simple *) sp->data;
2751:   PetscReal              vol = 0.0;
2752:   PetscReal             *weights;
2753:   PetscInt               Nq, p;
2754:   PetscErrorCode         ierr;

2757:   if ((f < 0) || (f >= s->dim)) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_OUTOFRANGE, "Basis index %d not in [0, %d)", f, s->dim);
2758:   PetscQuadratureDuplicate(q, &sp->functional[f]);
2759:   /* Reweight so that it has unit volume */
2760:   PetscQuadratureGetData(sp->functional[f], NULL, &Nq, NULL, (const PetscReal **) &weights);
2761:   for (p = 0; p < Nq; ++p) vol += weights[p];
2762:   for (p = 0; p < Nq; ++p) weights[p] /= vol;
2763:   return(0);
2764: }

2768: /*@
2769:   PetscDualSpaceSimpleSetDimension - Set the number of functionals in the dual space basis

2771:   Logically Collective on PetscDualSpace

2773:   Input Parameters:
2774: + sp  - the PetscDualSpace
2775: - dim - the basis dimension

2777:   Level: intermediate

2779: .keywords: PetscDualSpace, dimension
2780: .seealso: PetscDualSpaceSimpleSetFunctional()
2781: @*/
2782: PetscErrorCode PetscDualSpaceSimpleSetDimension(PetscDualSpace sp, PetscInt dim)
2783: {

2789:   PetscTryMethod(sp, "PetscDualSpaceSimpleSetDimension_C", (PetscDualSpace,PetscInt),(sp,dim));
2790:   return(0);
2791: }

2795: /*@
2796:   PetscDualSpaceSimpleSetFunctional - Set the given basis element for this dual space

2798:   Not Collective

2800:   Input Parameters:
2801: + sp  - the PetscDualSpace
2802: . f - the basis index
2803: - q - the basis functional

2805:   Level: intermediate

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

2809: .keywords: PetscDualSpace, functional
2810: .seealso: PetscDualSpaceSimpleSetDimension()
2811: @*/
2812: PetscErrorCode PetscDualSpaceSimpleSetFunctional(PetscDualSpace sp, PetscInt func, PetscQuadrature q)
2813: {

2818:   PetscTryMethod(sp, "PetscDualSpaceSimpleSetFunctional_C", (PetscDualSpace,PetscInt,PetscQuadrature),(sp,func,q));
2819:   return(0);
2820: }

2824: PetscErrorCode PetscDualSpaceInitialize_Simple(PetscDualSpace sp)
2825: {
2827:   sp->ops->setfromoptions = PetscDualSpaceSetFromOptions_Simple;
2828:   sp->ops->setup          = PetscDualSpaceSetUp_Simple;
2829:   sp->ops->view           = NULL;
2830:   sp->ops->destroy        = PetscDualSpaceDestroy_Simple;
2831:   sp->ops->duplicate      = PetscDualSpaceDuplicate_Simple;
2832:   sp->ops->getdimension   = PetscDualSpaceGetDimension_Simple;
2833:   sp->ops->getnumdof      = PetscDualSpaceGetNumDof_Simple;
2834:   return(0);
2835: }

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

2840:   Level: intermediate

2842: .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
2843: M*/

2847: PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Simple(PetscDualSpace sp)
2848: {
2849:   PetscDualSpace_Simple *s;
2850:   PetscErrorCode         ierr;

2854:   PetscNewLog(sp,&s);
2855:   sp->data = s;

2857:   s->dim    = 0;
2858:   s->numDof = NULL;

2860:   PetscDualSpaceInitialize_Simple(sp);
2861:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetDimension_C", PetscDualSpaceSimpleSetDimension_Simple);
2862:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetFunctional_C", PetscDualSpaceSimpleSetFunctional_Simple);
2863:   return(0);
2864: }


2867: PetscClassId PETSCFE_CLASSID = 0;

2869: PetscFunctionList PetscFEList              = NULL;
2870: PetscBool         PetscFERegisterAllCalled = PETSC_FALSE;

2874: /*@C
2875:   PetscFERegister - Adds a new PetscFE implementation

2877:   Not Collective

2879:   Input Parameters:
2880: + name        - The name of a new user-defined creation routine
2881: - create_func - The creation routine itself

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

2886:   Sample usage:
2887: .vb
2888:     PetscFERegister("my_fe", MyPetscFECreate);
2889: .ve

2891:   Then, your PetscFE type can be chosen with the procedural interface via
2892: .vb
2893:     PetscFECreate(MPI_Comm, PetscFE *);
2894:     PetscFESetType(PetscFE, "my_fe");
2895: .ve
2896:    or at runtime via the option
2897: .vb
2898:     -petscfe_type my_fe
2899: .ve

2901:   Level: advanced

2903: .keywords: PetscFE, register
2904: .seealso: PetscFERegisterAll(), PetscFERegisterDestroy()

2906: @*/
2907: PetscErrorCode PetscFERegister(const char sname[], PetscErrorCode (*function)(PetscFE))
2908: {

2912:   PetscFunctionListAdd(&PetscFEList, sname, function);
2913:   return(0);
2914: }

2918: /*@C
2919:   PetscFESetType - Builds a particular PetscFE

2921:   Collective on PetscFE

2923:   Input Parameters:
2924: + fem  - The PetscFE object
2925: - name - The kind of FEM space

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

2930:   Level: intermediate

2932: .keywords: PetscFE, set, type
2933: .seealso: PetscFEGetType(), PetscFECreate()
2934: @*/
2935: PetscErrorCode PetscFESetType(PetscFE fem, PetscFEType name)
2936: {
2937:   PetscErrorCode (*r)(PetscFE);
2938:   PetscBool      match;

2943:   PetscObjectTypeCompare((PetscObject) fem, name, &match);
2944:   if (match) return(0);

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

2950:   if (fem->ops->destroy) {
2951:     (*fem->ops->destroy)(fem);
2952:     fem->ops->destroy = NULL;
2953:   }
2954:   (*r)(fem);
2955:   PetscObjectChangeTypeName((PetscObject) fem, name);
2956:   return(0);
2957: }

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

2964:   Not Collective

2966:   Input Parameter:
2967: . fem  - The PetscFE

2969:   Output Parameter:
2970: . name - The PetscFE type name

2972:   Level: intermediate

2974: .keywords: PetscFE, get, type, name
2975: .seealso: PetscFESetType(), PetscFECreate()
2976: @*/
2977: PetscErrorCode PetscFEGetType(PetscFE fem, PetscFEType *name)
2978: {

2984:   if (!PetscFERegisterAllCalled) {
2985:     PetscFERegisterAll();
2986:   }
2987:   *name = ((PetscObject) fem)->type_name;
2988:   return(0);
2989: }

2993: /*@C
2994:   PetscFEView - Views a PetscFE

2996:   Collective on PetscFE

2998:   Input Parameter:
2999: + fem - the PetscFE object to view
3000: - v   - the viewer

3002:   Level: developer

3004: .seealso PetscFEDestroy()
3005: @*/
3006: PetscErrorCode PetscFEView(PetscFE fem, PetscViewer v)
3007: {

3012:   if (!v) {
3013:     PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) fem), &v);
3014:   }
3015:   if (fem->ops->view) {
3016:     (*fem->ops->view)(fem, v);
3017:   }
3018:   return(0);
3019: }

3023: /*@
3024:   PetscFESetFromOptions - sets parameters in a PetscFE from the options database

3026:   Collective on PetscFE

3028:   Input Parameter:
3029: . fem - the PetscFE object to set options for

3031:   Options Database:
3032: . -petscfe_num_blocks  the number of cell blocks to integrate concurrently
3033: . -petscfe_num_batches the number of cell batches to integrate serially

3035:   Level: developer

3037: .seealso PetscFEView()
3038: @*/
3039: PetscErrorCode PetscFESetFromOptions(PetscFE fem)
3040: {
3041:   const char    *defaultType;
3042:   char           name[256];
3043:   PetscBool      flg;

3048:   if (!((PetscObject) fem)->type_name) {
3049:     defaultType = PETSCFEBASIC;
3050:   } else {
3051:     defaultType = ((PetscObject) fem)->type_name;
3052:   }
3053:   if (!PetscFERegisterAllCalled) {PetscFERegisterAll();}

3055:   PetscObjectOptionsBegin((PetscObject) fem);
3056:   PetscOptionsFList("-petscfe_type", "Finite element space", "PetscFESetType", PetscFEList, defaultType, name, 256, &flg);
3057:   if (flg) {
3058:     PetscFESetType(fem, name);
3059:   } else if (!((PetscObject) fem)->type_name) {
3060:     PetscFESetType(fem, defaultType);
3061:   }
3062:   PetscOptionsInt("-petscfe_num_blocks", "The number of cell blocks to integrate concurrently", "PetscSpaceSetTileSizes", fem->numBlocks, &fem->numBlocks, NULL);
3063:   PetscOptionsInt("-petscfe_num_batches", "The number of cell batches to integrate serially", "PetscSpaceSetTileSizes", fem->numBatches, &fem->numBatches, NULL);
3064:   if (fem->ops->setfromoptions) {
3065:     (*fem->ops->setfromoptions)(PetscOptionsObject,fem);
3066:   }
3067:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
3068:   PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) fem);
3069:   PetscOptionsEnd();
3070:   PetscFEViewFromOptions(fem, NULL, "-petscfe_view");
3071:   return(0);
3072: }

3076: /*@C
3077:   PetscFESetUp - Construct data structures for the PetscFE

3079:   Collective on PetscFE

3081:   Input Parameter:
3082: . fem - the PetscFE object to setup

3084:   Level: developer

3086: .seealso PetscFEView(), PetscFEDestroy()
3087: @*/
3088: PetscErrorCode PetscFESetUp(PetscFE fem)
3089: {

3094:   if (fem->ops->setup) {(*fem->ops->setup)(fem);}
3095:   return(0);
3096: }

3100: /*@
3101:   PetscFEDestroy - Destroys a PetscFE object

3103:   Collective on PetscFE

3105:   Input Parameter:
3106: . fem - the PetscFE object to destroy

3108:   Level: developer

3110: .seealso PetscFEView()
3111: @*/
3112: PetscErrorCode PetscFEDestroy(PetscFE *fem)
3113: {

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

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

3123:   PetscFree((*fem)->numDof);
3124:   PetscFree((*fem)->invV);
3125:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->B, &(*fem)->D, NULL /*&(*fem)->H*/);
3126:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->Bf, &(*fem)->Df, NULL /*&(*fem)->Hf*/);
3127:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->F, NULL, NULL);
3128:   PetscSpaceDestroy(&(*fem)->basisSpace);
3129:   PetscDualSpaceDestroy(&(*fem)->dualSpace);
3130:   PetscQuadratureDestroy(&(*fem)->quadrature);
3131:   PetscQuadratureDestroy(&(*fem)->faceQuadrature);

3133:   if ((*fem)->ops->destroy) {(*(*fem)->ops->destroy)(*fem);}
3134:   PetscHeaderDestroy(fem);
3135:   return(0);
3136: }

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

3143:   Collective on MPI_Comm

3145:   Input Parameter:
3146: . comm - The communicator for the PetscFE object

3148:   Output Parameter:
3149: . fem - The PetscFE object

3151:   Level: beginner

3153: .seealso: PetscFESetType(), PETSCFEGALERKIN
3154: @*/
3155: PetscErrorCode PetscFECreate(MPI_Comm comm, PetscFE *fem)
3156: {
3157:   PetscFE        f;

3162:   PetscCitationsRegister(FECitation,&FEcite);
3163:   *fem = NULL;
3164:   PetscFEInitializePackage();

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

3168:   f->basisSpace    = NULL;
3169:   f->dualSpace     = NULL;
3170:   f->numComponents = 1;
3171:   f->numDof        = NULL;
3172:   f->invV          = NULL;
3173:   f->B             = NULL;
3174:   f->D             = NULL;
3175:   f->H             = NULL;
3176:   f->Bf            = NULL;
3177:   f->Df            = NULL;
3178:   f->Hf            = NULL;
3179:   PetscMemzero(&f->quadrature, sizeof(PetscQuadrature));
3180:   PetscMemzero(&f->faceQuadrature, sizeof(PetscQuadrature));
3181:   f->blockSize     = 0;
3182:   f->numBlocks     = 1;
3183:   f->batchSize     = 0;
3184:   f->numBatches    = 1;

3186:   *fem = f;
3187:   return(0);
3188: }

3192: /*@
3193:   PetscFEGetSpatialDimension - Returns the spatial dimension of the element

3195:   Not collective

3197:   Input Parameter:
3198: . fem - The PetscFE object

3200:   Output Parameter:
3201: . dim - The spatial dimension

3203:   Level: intermediate

3205: .seealso: PetscFECreate()
3206: @*/
3207: PetscErrorCode PetscFEGetSpatialDimension(PetscFE fem, PetscInt *dim)
3208: {
3209:   DM             dm;

3215:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
3216:   DMGetDimension(dm, dim);
3217:   return(0);
3218: }

3222: /*@
3223:   PetscFESetNumComponents - Sets the number of components in the element

3225:   Not collective

3227:   Input Parameters:
3228: + fem - The PetscFE object
3229: - comp - The number of field components

3231:   Level: intermediate

3233: .seealso: PetscFECreate()
3234: @*/
3235: PetscErrorCode PetscFESetNumComponents(PetscFE fem, PetscInt comp)
3236: {
3239:   fem->numComponents = comp;
3240:   return(0);
3241: }

3245: /*@
3246:   PetscFEGetNumComponents - Returns the number of components in the element

3248:   Not collective

3250:   Input Parameter:
3251: . fem - The PetscFE object

3253:   Output Parameter:
3254: . comp - The number of field components

3256:   Level: intermediate

3258: .seealso: PetscFECreate()
3259: @*/
3260: PetscErrorCode PetscFEGetNumComponents(PetscFE fem, PetscInt *comp)
3261: {
3265:   *comp = fem->numComponents;
3266:   return(0);
3267: }

3271: /*@
3272:   PetscFESetTileSizes - Sets the tile sizes for evaluation

3274:   Not collective

3276:   Input Parameters:
3277: + fem - The PetscFE object
3278: . blockSize - The number of elements in a block
3279: . numBlocks - The number of blocks in a batch
3280: . batchSize - The number of elements in a batch
3281: - numBatches - The number of batches in a chunk

3283:   Level: intermediate

3285: .seealso: PetscFECreate()
3286: @*/
3287: PetscErrorCode PetscFESetTileSizes(PetscFE fem, PetscInt blockSize, PetscInt numBlocks, PetscInt batchSize, PetscInt numBatches)
3288: {
3291:   fem->blockSize  = blockSize;
3292:   fem->numBlocks  = numBlocks;
3293:   fem->batchSize  = batchSize;
3294:   fem->numBatches = numBatches;
3295:   return(0);
3296: }

3300: /*@
3301:   PetscFEGetTileSizes - Returns the tile sizes for evaluation

3303:   Not collective

3305:   Input Parameter:
3306: . fem - The PetscFE object

3308:   Output Parameters:
3309: + blockSize - The number of elements in a block
3310: . numBlocks - The number of blocks in a batch
3311: . batchSize - The number of elements in a batch
3312: - numBatches - The number of batches in a chunk

3314:   Level: intermediate

3316: .seealso: PetscFECreate()
3317: @*/
3318: PetscErrorCode PetscFEGetTileSizes(PetscFE fem, PetscInt *blockSize, PetscInt *numBlocks, PetscInt *batchSize, PetscInt *numBatches)
3319: {
3326:   if (blockSize)  *blockSize  = fem->blockSize;
3327:   if (numBlocks)  *numBlocks  = fem->numBlocks;
3328:   if (batchSize)  *batchSize  = fem->batchSize;
3329:   if (numBatches) *numBatches = fem->numBatches;
3330:   return(0);
3331: }

3335: /*@
3336:   PetscFEGetBasisSpace - Returns the PetscSpace used for approximation of the solution

3338:   Not collective

3340:   Input Parameter:
3341: . fem - The PetscFE object

3343:   Output Parameter:
3344: . sp - The PetscSpace object

3346:   Level: intermediate

3348: .seealso: PetscFECreate()
3349: @*/
3350: PetscErrorCode PetscFEGetBasisSpace(PetscFE fem, PetscSpace *sp)
3351: {
3355:   *sp = fem->basisSpace;
3356:   return(0);
3357: }

3361: /*@
3362:   PetscFESetBasisSpace - Sets the PetscSpace used for approximation of the solution

3364:   Not collective

3366:   Input Parameters:
3367: + fem - The PetscFE object
3368: - sp - The PetscSpace object

3370:   Level: intermediate

3372: .seealso: PetscFECreate()
3373: @*/
3374: PetscErrorCode PetscFESetBasisSpace(PetscFE fem, PetscSpace sp)
3375: {

3381:   PetscSpaceDestroy(&fem->basisSpace);
3382:   fem->basisSpace = sp;
3383:   PetscObjectReference((PetscObject) fem->basisSpace);
3384:   return(0);
3385: }

3389: /*@
3390:   PetscFEGetDualSpace - Returns the PetscDualSpace used to define the inner product

3392:   Not collective

3394:   Input Parameter:
3395: . fem - The PetscFE object

3397:   Output Parameter:
3398: . sp - The PetscDualSpace object

3400:   Level: intermediate

3402: .seealso: PetscFECreate()
3403: @*/
3404: PetscErrorCode PetscFEGetDualSpace(PetscFE fem, PetscDualSpace *sp)
3405: {
3409:   *sp = fem->dualSpace;
3410:   return(0);
3411: }

3415: /*@
3416:   PetscFESetDualSpace - Sets the PetscDualSpace used to define the inner product

3418:   Not collective

3420:   Input Parameters:
3421: + fem - The PetscFE object
3422: - sp - The PetscDualSpace object

3424:   Level: intermediate

3426: .seealso: PetscFECreate()
3427: @*/
3428: PetscErrorCode PetscFESetDualSpace(PetscFE fem, PetscDualSpace sp)
3429: {

3435:   PetscDualSpaceDestroy(&fem->dualSpace);
3436:   fem->dualSpace = sp;
3437:   PetscObjectReference((PetscObject) fem->dualSpace);
3438:   return(0);
3439: }

3443: /*@
3444:   PetscFEGetQuadrature - Returns the PetscQuadrature used to calculate inner products

3446:   Not collective

3448:   Input Parameter:
3449: . fem - The PetscFE object

3451:   Output Parameter:
3452: . q - The PetscQuadrature object

3454:   Level: intermediate

3456: .seealso: PetscFECreate()
3457: @*/
3458: PetscErrorCode PetscFEGetQuadrature(PetscFE fem, PetscQuadrature *q)
3459: {
3463:   *q = fem->quadrature;
3464:   return(0);
3465: }

3469: /*@
3470:   PetscFESetQuadrature - Sets the PetscQuadrature used to calculate inner products

3472:   Not collective

3474:   Input Parameters:
3475: + fem - The PetscFE object
3476: - q - The PetscQuadrature object

3478:   Level: intermediate

3480: .seealso: PetscFECreate()
3481: @*/
3482: PetscErrorCode PetscFESetQuadrature(PetscFE fem, PetscQuadrature q)
3483: {

3488:   PetscFERestoreTabulation(fem, 0, NULL, &fem->B, &fem->D, NULL /*&(*fem)->H*/);
3489:   PetscQuadratureDestroy(&fem->quadrature);
3490:   fem->quadrature = q;
3491:   PetscObjectReference((PetscObject) q);
3492:   return(0);
3493: }

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

3500:   Not collective

3502:   Input Parameter:
3503: . fem - The PetscFE object

3505:   Output Parameter:
3506: . q - The PetscQuadrature object

3508:   Level: intermediate

3510: .seealso: PetscFECreate()
3511: @*/
3512: PetscErrorCode PetscFEGetFaceQuadrature(PetscFE fem, PetscQuadrature *q)
3513: {
3517:   *q = fem->faceQuadrature;
3518:   return(0);
3519: }

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

3526:   Not collective

3528:   Input Parameters:
3529: + fem - The PetscFE object
3530: - q - The PetscQuadrature object

3532:   Level: intermediate

3534: .seealso: PetscFECreate()
3535: @*/
3536: PetscErrorCode PetscFESetFaceQuadrature(PetscFE fem, PetscQuadrature q)
3537: {

3542:   PetscFERestoreTabulation(fem, 0, NULL, &fem->Bf, &fem->Df, NULL /*&(*fem)->Hf*/);
3543:   PetscQuadratureDestroy(&fem->faceQuadrature);
3544:   fem->faceQuadrature = q;
3545:   PetscObjectReference((PetscObject) q);
3546:   return(0);
3547: }

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

3554:   Not collective

3556:   Input Parameter:
3557: . fem - The PetscFE object

3559:   Output Parameter:
3560: . numDof - Array with the number of dofs per dimension

3562:   Level: intermediate

3564: .seealso: PetscFECreate()
3565: @*/
3566: PetscErrorCode PetscFEGetNumDof(PetscFE fem, const PetscInt **numDof)
3567: {
3568:   const PetscInt *numDofDual;
3569:   PetscErrorCode  ierr;

3574:   PetscDualSpaceGetNumDof(fem->dualSpace, &numDofDual);
3575:   if (!fem->numDof) {
3576:     DM       dm;
3577:     PetscInt dim, d;

3579:     PetscDualSpaceGetDM(fem->dualSpace, &dm);
3580:     DMGetDimension(dm, &dim);
3581:     PetscMalloc1(dim+1, &fem->numDof);
3582:     for (d = 0; d <= dim; ++d) {
3583:       fem->numDof[d] = fem->numComponents*numDofDual[d];
3584:     }
3585:   }
3586:   *numDof = fem->numDof;
3587:   return(0);
3588: }

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

3595:   Not collective

3597:   Input Parameter:
3598: . fem - The PetscFE object

3600:   Output Parameters:
3601: + B - The basis function values at quadrature points
3602: . D - The basis function derivatives at quadrature points
3603: - H - The basis function second derivatives at quadrature points

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

3610:   Level: intermediate

3612: .seealso: PetscFEGetTabulation(), PetscFERestoreTabulation()
3613: @*/
3614: PetscErrorCode PetscFEGetDefaultTabulation(PetscFE fem, PetscReal **B, PetscReal **D, PetscReal **H)
3615: {
3616:   PetscInt         npoints;
3617:   const PetscReal *points;
3618:   PetscErrorCode   ierr;

3625:   PetscQuadratureGetData(fem->quadrature, NULL, &npoints, &points, NULL);
3626:   if (!fem->B) {PetscFEGetTabulation(fem, npoints, points, &fem->B, &fem->D, NULL/*&fem->H*/);}
3627:   if (B) *B = fem->B;
3628:   if (D) *D = fem->D;
3629:   if (H) *H = fem->H;
3630:   return(0);
3631: }

3635: PetscErrorCode PetscFEGetFaceTabulation(PetscFE fem, PetscReal **Bf, PetscReal **Df, PetscReal **Hf)
3636: {
3637:   PetscErrorCode   ierr;

3644:   if (!fem->Bf) {
3645:     PetscFECellGeom  cgeom;
3646:     PetscQuadrature  fq;
3647:     PetscDualSpace   sp;
3648:     DM               dm;
3649:     const PetscInt  *faces;
3650:     PetscInt         dim, numFaces, f, npoints, q;
3651:     const PetscReal *points, *weights;
3652:     PetscReal       *facePoints;
3653: 
3654:     PetscFEGetDualSpace(fem, &sp);
3655:     PetscDualSpaceGetDM(sp, &dm);
3656:     DMGetDimension(dm, &dim);
3657:     DMPlexGetConeSize(dm, 0, &numFaces);
3658:     DMPlexGetCone(dm, 0, &faces);
3659:     PetscFEGetFaceQuadrature(fem, &fq);
3660:     PetscQuadratureGetData(fq, NULL, &npoints, &points, &weights);
3661:     PetscMalloc1(numFaces*npoints*dim, &facePoints);
3662:     for (f = 0; f < numFaces; ++f) {
3663:       DMPlexComputeCellGeometryFEM(dm, faces[f], NULL, cgeom.v0, cgeom.J, NULL, &cgeom.detJ);
3664:       for (q = 0; q < npoints; ++q) CoordinatesRefToReal(dim, dim-1, cgeom.v0, cgeom.J, &points[q*(dim-1)], &facePoints[(f*npoints+q)*dim]);
3665:     }
3666:     PetscFEGetTabulation(fem, numFaces*npoints, facePoints, &fem->Bf, &fem->Df, NULL/*&fem->Hf*/);
3667:     PetscFree(facePoints);
3668:   }
3669:   if (Bf) *Bf = fem->Bf;
3670:   if (Df) *Df = fem->Df;
3671:   if (Hf) *Hf = fem->Hf;
3672:   return(0);
3673: }

3677: PetscErrorCode PetscFEGetFaceCentroidTabulation(PetscFE fem, PetscReal **F)
3678: {
3679:   PetscErrorCode   ierr;

3684:   if (!fem->F) {
3685:     PetscDualSpace  sp;
3686:     DM              dm;
3687:     const PetscInt *cone;
3688:     PetscReal      *centroids;
3689:     PetscInt        dim, numFaces, f;

3691:     PetscFEGetDualSpace(fem, &sp);
3692:     PetscDualSpaceGetDM(sp, &dm);
3693:     DMGetDimension(dm, &dim);
3694:     DMPlexGetConeSize(dm, 0, &numFaces);
3695:     DMPlexGetCone(dm, 0, &cone);
3696:     PetscMalloc1(numFaces*dim, &centroids);
3697:     for (f = 0; f < numFaces; ++f) {DMPlexComputeCellGeometryFVM(dm, cone[f], NULL, &centroids[f*dim], NULL);}
3698:     PetscFEGetTabulation(fem, numFaces, centroids, &fem->F, NULL, NULL);
3699:     PetscFree(centroids);
3700:   }
3701:   *F = fem->F;
3702:   return(0);
3703: }

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

3710:   Not collective

3712:   Input Parameters:
3713: + fem     - The PetscFE object
3714: . npoints - The number of tabulation points
3715: - points  - The tabulation point coordinates

3717:   Output Parameters:
3718: + B - The basis function values at tabulation points
3719: . D - The basis function derivatives at tabulation points
3720: - H - The basis function second derivatives at tabulation points

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

3727:   Level: intermediate

3729: .seealso: PetscFERestoreTabulation(), PetscFEGetDefaultTabulation()
3730: @*/
3731: PetscErrorCode PetscFEGetTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal **B, PetscReal **D, PetscReal **H)
3732: {
3733:   DM               dm;
3734:   PetscInt         pdim; /* Dimension of FE space P */
3735:   PetscInt         dim;  /* Spatial dimension */
3736:   PetscInt         comp; /* Field components */
3737:   PetscErrorCode   ierr;

3745:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
3746:   DMGetDimension(dm, &dim);
3747:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
3748:   PetscFEGetNumComponents(fem, &comp);
3749:   if (B) {DMGetWorkArray(dm, npoints*pdim*comp, PETSC_REAL, B);}
3750:   if (D) {DMGetWorkArray(dm, npoints*pdim*comp*dim, PETSC_REAL, D);}
3751:   if (H) {DMGetWorkArray(dm, npoints*pdim*comp*dim*dim, PETSC_REAL, H);}
3752:   (*fem->ops->gettabulation)(fem, npoints, points, B ? *B : NULL, D ? *D : NULL, H ? *H : NULL);
3753:   return(0);
3754: }

3758: PetscErrorCode PetscFERestoreTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal **B, PetscReal **D, PetscReal **H)
3759: {
3760:   DM             dm;

3765:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
3766:   if (B && *B) {DMRestoreWorkArray(dm, 0, PETSC_REAL, B);}
3767:   if (D && *D) {DMRestoreWorkArray(dm, 0, PETSC_REAL, D);}
3768:   if (H && *H) {DMRestoreWorkArray(dm, 0, PETSC_REAL, H);}
3769:   return(0);
3770: }

3774: PetscErrorCode PetscFEDestroy_Basic(PetscFE fem)
3775: {
3776:   PetscFE_Basic *b = (PetscFE_Basic *) fem->data;

3780:   PetscFree(b);
3781:   return(0);
3782: }

3786: PetscErrorCode PetscFEView_Basic_Ascii(PetscFE fe, PetscViewer viewer)
3787: {
3788:   PetscSpace        basis;
3789:   PetscDualSpace    dual;
3790:   PetscQuadrature   q = NULL;
3791:   PetscInt          dim, Nq;
3792:   PetscViewerFormat format;
3793:   PetscErrorCode    ierr;

3796:   PetscFEGetBasisSpace(fe, &basis);
3797:   PetscFEGetDualSpace(fe, &dual);
3798:   PetscFEGetQuadrature(fe, &q);
3799:   PetscQuadratureGetData(q, &dim, &Nq, NULL, NULL);
3800:   PetscViewerGetFormat(viewer, &format);
3801:   PetscViewerASCIIPrintf(viewer, "Basic Finite Element:\n");
3802:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
3803:     PetscViewerASCIIPrintf(viewer, "  dimension:       %d\n", dim);
3804:     PetscViewerASCIIPrintf(viewer, "  num quad points: %d\n", Nq);
3805:     PetscViewerASCIIPushTab(viewer);
3806:     PetscQuadratureView(q, viewer);
3807:     PetscViewerASCIIPopTab(viewer);
3808:   } else {
3809:     PetscViewerASCIIPrintf(viewer, "  dimension:       %d\n", dim);
3810:     PetscViewerASCIIPrintf(viewer, "  num quad points: %d\n", Nq);
3811:   }
3812:   PetscViewerASCIIPushTab(viewer);
3813:   PetscSpaceView(basis, viewer);
3814:   PetscDualSpaceView(dual, viewer);
3815:   PetscViewerASCIIPopTab(viewer);
3816:   return(0);
3817: }

3821: PetscErrorCode PetscFEView_Basic(PetscFE fe, PetscViewer viewer)
3822: {
3823:   PetscBool      iascii;

3829:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
3830:   if (iascii) {PetscFEView_Basic_Ascii(fe, viewer);}
3831:   return(0);
3832: }

3836: /* Construct the change of basis from prime basis to nodal basis */
3837: PetscErrorCode PetscFESetUp_Basic(PetscFE fem)
3838: {
3839:   PetscScalar   *work, *invVscalar;
3840:   PetscBLASInt  *pivots;
3841:   PetscBLASInt   n, info;
3842:   PetscInt       pdim, j;

3846:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
3847:   PetscMalloc1(pdim*pdim,&fem->invV);
3848: #if defined(PETSC_USE_COMPLEX)
3849:   PetscMalloc1(pdim*pdim,&invVscalar);
3850: #else
3851:   invVscalar = fem->invV;
3852: #endif
3853:   for (j = 0; j < pdim; ++j) {
3854:     PetscReal      *Bf;
3855:     PetscQuadrature f;
3856:     PetscInt        q, k;

3858:     PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);
3859:     PetscMalloc1(f->numPoints*pdim,&Bf);
3860:     PetscSpaceEvaluate(fem->basisSpace, f->numPoints, f->points, Bf, NULL, NULL);
3861:     for (k = 0; k < pdim; ++k) {
3862:       /* n_j \cdot \phi_k */
3863:       invVscalar[j*pdim+k] = 0.0;
3864:       for (q = 0; q < f->numPoints; ++q) {
3865:         invVscalar[j*pdim+k] += Bf[q*pdim+k]*f->weights[q];
3866:       }
3867:     }
3868:     PetscFree(Bf);
3869:   }
3870:   PetscMalloc2(pdim,&pivots,pdim,&work);
3871:   n = pdim;
3872:   PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, invVscalar, &n, pivots, &info));
3873:   PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, invVscalar, &n, pivots, work, &n, &info));
3874: #if defined(PETSC_USE_COMPLEX)
3875:   for (j = 0; j < pdim*pdim; j++) fem->invV[j] = PetscRealPart(invVscalar[j]);
3876:   PetscFree(invVscalar);
3877: #endif
3878:   PetscFree2(pivots,work);
3879:   return(0);
3880: }

3884: PetscErrorCode PetscFEGetDimension_Basic(PetscFE fem, PetscInt *dim)
3885: {

3889:   PetscDualSpaceGetDimension(fem->dualSpace, dim);
3890:   return(0);
3891: }

3895: PetscErrorCode PetscFEGetTabulation_Basic(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H)
3896: {
3897:   DM               dm;
3898:   PetscInt         pdim; /* Dimension of FE space P */
3899:   PetscInt         dim;  /* Spatial dimension */
3900:   PetscInt         comp; /* Field components */
3901:   PetscReal       *tmpB, *tmpD, *tmpH;
3902:   PetscInt         p, d, j, k;
3903:   PetscErrorCode   ierr;

3906:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
3907:   DMGetDimension(dm, &dim);
3908:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
3909:   PetscFEGetNumComponents(fem, &comp);
3910:   /* Evaluate the prime basis functions at all points */
3911:   if (B) {DMGetWorkArray(dm, npoints*pdim, PETSC_REAL, &tmpB);}
3912:   if (D) {DMGetWorkArray(dm, npoints*pdim*dim, PETSC_REAL, &tmpD);}
3913:   if (H) {DMGetWorkArray(dm, npoints*pdim*dim*dim, PETSC_REAL, &tmpH);}
3914:   PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);
3915:   /* Translate to the nodal basis */
3916:   for (p = 0; p < npoints; ++p) {
3917:     if (B) {
3918:       /* Multiply by V^{-1} (pdim x pdim) */
3919:       for (j = 0; j < pdim; ++j) {
3920:         const PetscInt i = (p*pdim + j)*comp;
3921:         PetscInt       c;

3923:         B[i] = 0.0;
3924:         for (k = 0; k < pdim; ++k) {
3925:           B[i] += fem->invV[k*pdim+j] * tmpB[p*pdim + k];
3926:         }
3927:         for (c = 1; c < comp; ++c) {
3928:           B[i+c] = B[i];
3929:         }
3930:       }
3931:     }
3932:     if (D) {
3933:       /* Multiply by V^{-1} (pdim x pdim) */
3934:       for (j = 0; j < pdim; ++j) {
3935:         for (d = 0; d < dim; ++d) {
3936:           const PetscInt i = ((p*pdim + j)*comp + 0)*dim + d;
3937:           PetscInt       c;

3939:           D[i] = 0.0;
3940:           for (k = 0; k < pdim; ++k) {
3941:             D[i] += fem->invV[k*pdim+j] * tmpD[(p*pdim + k)*dim + d];
3942:           }
3943:           for (c = 1; c < comp; ++c) {
3944:             D[((p*pdim + j)*comp + c)*dim + d] = D[i];
3945:           }
3946:         }
3947:       }
3948:     }
3949:     if (H) {
3950:       /* Multiply by V^{-1} (pdim x pdim) */
3951:       for (j = 0; j < pdim; ++j) {
3952:         for (d = 0; d < dim*dim; ++d) {
3953:           const PetscInt i = ((p*pdim + j)*comp + 0)*dim*dim + d;
3954:           PetscInt       c;

3956:           H[i] = 0.0;
3957:           for (k = 0; k < pdim; ++k) {
3958:             H[i] += fem->invV[k*pdim+j] * tmpH[(p*pdim + k)*dim*dim + d];
3959:           }
3960:           for (c = 1; c < comp; ++c) {
3961:             H[((p*pdim + j)*comp + c)*dim*dim + d] = H[i];
3962:           }
3963:         }
3964:       }
3965:     }
3966:   }
3967:   if (B) {DMRestoreWorkArray(dm, npoints*pdim, PETSC_REAL, &tmpB);}
3968:   if (D) {DMRestoreWorkArray(dm, npoints*pdim*dim, PETSC_REAL, &tmpD);}
3969:   if (H) {DMRestoreWorkArray(dm, npoints*pdim*dim*dim, PETSC_REAL, &tmpH);}
3970:   return(0);
3971: }

3975: PetscErrorCode PetscFEIntegrate_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
3976:                                       const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal integral[])
3977: {
3978:   const PetscInt  debug = 0;
3979:   PetscPointFunc  obj_func;
3980:   PetscQuadrature quad;
3981:   PetscScalar    *u, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
3982:   PetscReal      *x;
3983:   PetscReal     **B, **D, **BAux = NULL, **DAux = NULL;
3984:   PetscInt       *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
3985:   PetscInt       dim, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, e;

3989:   PetscDSGetObjective(prob, field, &obj_func);
3990:   if (!obj_func) return(0);
3991:   PetscFEGetSpatialDimension(fem, &dim);
3992:   PetscFEGetQuadrature(fem, &quad);
3993:   PetscDSGetNumFields(prob, &Nf);
3994:   PetscDSGetTotalDimension(prob, &totDim);
3995:   PetscDSGetDimensions(prob, &Nb);
3996:   PetscDSGetComponents(prob, &Nc);
3997:   PetscDSGetComponentOffsets(prob, &uOff);
3998:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
3999:   PetscDSGetEvaluationArrays(prob, &u, NULL, &u_x);
4000:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4001:   PetscDSGetTabulation(prob, &B, &D);
4002:   if (probAux) {
4003:     PetscDSGetNumFields(probAux, &NfAux);
4004:     PetscDSGetTotalDimension(probAux, &totDimAux);
4005:     PetscDSGetDimensions(probAux, &NbAux);
4006:     PetscDSGetComponents(probAux, &NcAux);
4007:     PetscDSGetComponentOffsets(probAux, &aOff);
4008:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4009:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4010:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4011:     PetscDSGetTabulation(probAux, &BAux, &DAux);
4012:   }
4013:   for (e = 0; e < Ne; ++e) {
4014:     const PetscReal *v0   = cgeom[e].v0;
4015:     const PetscReal *J    = cgeom[e].J;
4016:     const PetscReal *invJ = cgeom[e].invJ;
4017:     const PetscReal  detJ = cgeom[e].detJ;
4018:     const PetscReal *quadPoints, *quadWeights;
4019:     PetscInt         Nq, q;

4021:     PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4022:     if (debug > 1) {
4023:       PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
4024: #ifndef PETSC_USE_COMPLEX
4025:       DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
4026: #endif
4027:     }
4028:     for (q = 0; q < Nq; ++q) {
4029:       PetscScalar integrand;

4031:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4032:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4033:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], NULL, u, u_x, NULL);
4034:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4035:       obj_func(dim, Nf, NfAux, uOff, uOff_x, u, NULL, u_x, aOff, aOff_x, a, NULL, a_x, 0.0, x, &integrand);
4036:       integrand *= detJ*quadWeights[q];
4037:       integral[field] += PetscRealPart(integrand);
4038:       if (debug > 1) {PetscPrintf(PETSC_COMM_SELF, "    int: %g %g\n", PetscRealPart(integrand), integral[field]);}
4039:     }
4040:     cOffset    += totDim;
4041:     cOffsetAux += totDimAux;
4042:   }
4043:   return(0);
4044: }

4048: PetscErrorCode PetscFEIntegrateResidual_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
4049:                                               const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4050: {
4051:   const PetscInt  debug = 0;
4052:   PetscPointFunc  f0_func;
4053:   PetscPointFunc  f1_func;
4054:   PetscQuadrature quad;
4055:   PetscScalar    *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4056:   PetscReal      *x;
4057:   PetscReal     **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4058:   PetscInt       *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4059:   PetscInt        dim, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
4060:   PetscErrorCode  ierr;

4063:   PetscFEGetSpatialDimension(fem, &dim);
4064:   PetscFEGetQuadrature(fem, &quad);
4065:   PetscDSGetNumFields(prob, &Nf);
4066:   PetscDSGetTotalDimension(prob, &totDim);
4067:   PetscDSGetDimensions(prob, &Nb);
4068:   PetscDSGetComponents(prob, &Nc);
4069:   PetscDSGetComponentOffsets(prob, &uOff);
4070:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4071:   PetscDSGetFieldOffset(prob, field, &fOffset);
4072:   PetscDSGetResidual(prob, field, &f0_func, &f1_func);
4073:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4074:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4075:   PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4076:   PetscDSGetTabulation(prob, &B, &D);
4077:   if (probAux) {
4078:     PetscDSGetNumFields(probAux, &NfAux);
4079:     PetscDSGetTotalDimension(probAux, &totDimAux);
4080:     PetscDSGetDimensions(probAux, &NbAux);
4081:     PetscDSGetComponents(probAux, &NcAux);
4082:     PetscDSGetComponentOffsets(probAux, &aOff);
4083:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4084:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4085:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4086:     PetscDSGetTabulation(probAux, &BAux, &DAux);
4087:   }
4088:   NbI = Nb[field];
4089:   NcI = Nc[field];
4090:   BI  = B[field];
4091:   DI  = D[field];
4092:   for (e = 0; e < Ne; ++e) {
4093:     const PetscReal *v0   = cgeom[e].v0;
4094:     const PetscReal *J    = cgeom[e].J;
4095:     const PetscReal *invJ = cgeom[e].invJ;
4096:     const PetscReal  detJ = cgeom[e].detJ;
4097:     const PetscReal *quadPoints, *quadWeights;
4098:     PetscInt         Nq, q;

4100:     PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4101:     PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
4102:     PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
4103:     if (debug > 1) {
4104:       PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
4105: #ifndef PETSC_USE_COMPLEX
4106:       DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
4107: #endif
4108:     }
4109:     for (q = 0; q < Nq; ++q) {
4110:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4111:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4112:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4113:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4114:       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, &f0[q*NcI]);
4115:       if (f1_func) f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, refSpaceDer);
4116:       TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
4117:     }
4118:     UpdateElementVec(dim, Nq, NbI, NcI, BI, DI, f0, f1, &elemVec[cOffset+fOffset]);
4119:     cOffset    += totDim;
4120:     cOffsetAux += totDimAux;
4121:   }
4122:   return(0);
4123: }

4127: PetscErrorCode PetscFEIntegrateBdResidual_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEFaceGeom *fgeom,
4128:                                                 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4129: {
4130:    const PetscInt   debug = 0;
4131:    PetscBdPointFunc f0_func;
4132:    PetscBdPointFunc f1_func;
4133:    PetscQuadrature  quad;
4134:    PetscScalar     *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4135:    PetscReal       *x;
4136:    PetscReal      **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4137:    PetscInt        *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4138:    PetscInt         dim, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
4139:    PetscErrorCode   ierr;
4140: 
4142:    PetscFEGetSpatialDimension(fem, &dim);
4143:    PetscFEGetFaceQuadrature(fem, &quad);
4144:    PetscDSGetNumFields(prob, &Nf);
4145:    PetscDSGetTotalDimension(prob, &totDim);
4146:    PetscDSGetDimensions(prob, &Nb);
4147:    PetscDSGetComponents(prob, &Nc);
4148:    PetscDSGetComponentOffsets(prob, &uOff);
4149:    PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4150:    PetscDSGetFieldOffset(prob, field, &fOffset);
4151:    PetscDSGetBdResidual(prob, field, &f0_func, &f1_func);
4152:    if (!f0_func && !f1_func) return(0);
4153:    PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4154:    PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4155:    PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4156:    PetscDSGetFaceTabulation(prob, &B, &D);
4157:    if (probAux) {
4158:      PetscDSGetNumFields(probAux, &NfAux);
4159:      PetscDSGetTotalDimension(probAux, &totDimAux);
4160:      PetscDSGetDimensions(probAux, &NbAux);
4161:      PetscDSGetComponents(probAux, &NcAux);
4162:      PetscDSGetComponentOffsets(probAux, &aOff);
4163:      PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4164:      PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4165:      PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4166:      PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
4167:    }
4168:    NbI = Nb[field];
4169:    NcI = Nc[field];
4170:    BI  = B[field];
4171:    DI  = D[field];
4172:    for (e = 0; e < Ne; ++e) {
4173:      const PetscReal *quadPoints, *quadWeights;
4174:      const PetscReal *v0   = fgeom[e].v0;
4175:      const PetscReal *J    = fgeom[e].J;
4176:      const PetscReal *invJ = fgeom[e].invJ[0];
4177:      const PetscReal  detJ = fgeom[e].detJ;
4178:      const PetscReal *n    = fgeom[e].n;
4179:      const PetscInt   face = fgeom[e].face[0];
4180:      PetscInt         Nq, q;
4181: 
4182:      PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4183:      PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
4184:      PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
4185:      if (debug > 1) {
4186:        PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
4187: #ifndef PETSC_USE_COMPLEX
4188:        DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
4189: #endif
4190:      }
4191:      for (q = 0; q < Nq; ++q) {
4192:        if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4193:        CoordinatesRefToReal(dim, dim-1, v0, J, &quadPoints[q*(dim-1)], x);
4194:        EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4195:        if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4196:        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, &f0[q*NcI]);
4197:        if (f1_func) f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, n, refSpaceDer);
4198:        TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
4199:      }
4200:      UpdateElementVec(dim, Nq, NbI, NcI, &BI[face*Nq*NbI*NcI], &DI[face*Nq*NbI*NcI*dim], f0, f1, &elemVec[cOffset+fOffset]);
4201:      cOffset    += totDim;
4202:      cOffsetAux += totDimAux;
4203:    }
4204:    return(0);
4205: }
4206: 

4210: PetscErrorCode PetscFEIntegrateJacobian_Basic(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFECellGeom *geom,
4211:                                               const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
4212: {
4213:   const PetscInt  debug      = 0;
4214:   PetscPointJac   g0_func;
4215:   PetscPointJac   g1_func;
4216:   PetscPointJac   g2_func;
4217:   PetscPointJac   g3_func;
4218:   PetscInt        cOffset    = 0; /* Offset into coefficients[] for element e */
4219:   PetscInt        cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
4220:   PetscInt        eOffset    = 0; /* Offset into elemMat[] for element e */
4221:   PetscInt        offsetI    = 0; /* Offset into an element vector for fieldI */
4222:   PetscInt        offsetJ    = 0; /* Offset into an element vector for fieldJ */
4223:   PetscQuadrature quad;
4224:   PetscScalar    *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4225:   PetscReal      *x;
4226:   PetscReal     **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
4227:   PetscInt       *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4228:   PetscInt        NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
4229:   PetscInt        dim, Nf, NfAux = 0, totDim, totDimAux = 0, e;
4230:   PetscErrorCode  ierr;

4233:   PetscFEGetSpatialDimension(fem, &dim);
4234:   PetscFEGetQuadrature(fem, &quad);
4235:   PetscDSGetNumFields(prob, &Nf);
4236:   PetscDSGetTotalDimension(prob, &totDim);
4237:   PetscDSGetDimensions(prob, &Nb);
4238:   PetscDSGetComponents(prob, &Nc);
4239:   PetscDSGetComponentOffsets(prob, &uOff);
4240:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4241:   switch(jtype) {
4242:   case PETSCFE_JACOBIAN_DYN: PetscDSGetDynamicJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4243:   case PETSCFE_JACOBIAN_PRE: PetscDSGetJacobianPreconditioner(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4244:   case PETSCFE_JACOBIAN:     PetscDSGetJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4245:   }
4246:   if (!g0_func && !g1_func && !g2_func && !g3_func) return(0);
4247:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4248:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4249:   PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
4250:   PetscDSGetTabulation(prob, &B, &D);
4251:   PetscDSGetFieldOffset(prob, fieldI, &offsetI);
4252:   PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
4253:   if (probAux) {
4254:     PetscDSGetNumFields(probAux, &NfAux);
4255:     PetscDSGetTotalDimension(probAux, &totDimAux);
4256:     PetscDSGetDimensions(probAux, &NbAux);
4257:     PetscDSGetComponents(probAux, &NcAux);
4258:     PetscDSGetComponentOffsets(probAux, &aOff);
4259:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4260:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4261:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4262:     PetscDSGetTabulation(probAux, &BAux, &DAux);
4263:   }
4264:   NbI = Nb[fieldI], NbJ = Nb[fieldJ];
4265:   NcI = Nc[fieldI], NcJ = Nc[fieldJ];
4266:   BI  = B[fieldI],  BJ  = B[fieldJ];
4267:   DI  = D[fieldI],  DJ  = D[fieldJ];
4268:   /* Initialize here in case the function is not defined */
4269:   PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4270:   PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
4271:   PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
4272:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4273:   for (e = 0; e < Ne; ++e) {
4274:     const PetscReal *v0   = geom[e].v0;
4275:     const PetscReal *J    = geom[e].J;
4276:     const PetscReal *invJ = geom[e].invJ;
4277:     const PetscReal  detJ = geom[e].detJ;
4278:     const PetscReal *quadPoints, *quadWeights;
4279:     PetscInt         Nq, q;

4281:     PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4282:     for (q = 0; q < Nq; ++q) {
4283:       const PetscReal *BIq = &BI[q*NbI*NcI], *BJq = &BJ[q*NbJ*NcJ];
4284:       const PetscReal *DIq = &DI[q*NbI*NcI*dim], *DJq = &DJ[q*NbJ*NcJ*dim];
4285:       const PetscReal  w = detJ*quadWeights[q];
4286:       PetscInt f, g, fc, gc, c;

4288:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4289:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4290:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4291:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4292:       if (g0_func) {
4293:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4294:         g0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, g0);
4295:         for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
4296:       }
4297:       if (g1_func) {
4298:         PetscInt d, d2;
4299:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4300:         g1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, refSpaceDer);
4301:         for (fc = 0; fc < NcI; ++fc) {
4302:           for (gc = 0; gc < NcJ; ++gc) {
4303:             for (d = 0; d < dim; ++d) {
4304:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
4305:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4306:               g1[(fc*NcJ+gc)*dim+d] *= w;
4307:             }
4308:           }
4309:         }
4310:       }
4311:       if (g2_func) {
4312:         PetscInt d, d2;
4313:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4314:         g2_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, refSpaceDer);
4315:         for (fc = 0; fc < NcI; ++fc) {
4316:           for (gc = 0; gc < NcJ; ++gc) {
4317:             for (d = 0; d < dim; ++d) {
4318:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
4319:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4320:               g2[(fc*NcJ+gc)*dim+d] *= w;
4321:             }
4322:           }
4323:         }
4324:       }
4325:       if (g3_func) {
4326:         PetscInt d, d2, dp, d3;
4327:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4328:         g3_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, refSpaceDer);
4329:         for (fc = 0; fc < NcI; ++fc) {
4330:           for (gc = 0; gc < NcJ; ++gc) {
4331:             for (d = 0; d < dim; ++d) {
4332:               for (dp = 0; dp < dim; ++dp) {
4333:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
4334:                 for (d2 = 0; d2 < dim; ++d2) {
4335:                   for (d3 = 0; d3 < dim; ++d3) {
4336:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
4337:                   }
4338:                 }
4339:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
4340:               }
4341:             }
4342:           }
4343:         }
4344:       }

4346:       for (f = 0; f < NbI; ++f) {
4347:         for (fc = 0; fc < NcI; ++fc) {
4348:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
4349:           const PetscInt i    = offsetI+fidx; /* Element matrix row */
4350:           for (g = 0; g < NbJ; ++g) {
4351:             for (gc = 0; gc < NcJ; ++gc) {
4352:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
4353:               const PetscInt j    = offsetJ+gidx; /* Element matrix column */
4354:               const PetscInt fOff = eOffset+i*totDim+j;
4355:               PetscInt       d, d2;

4357:               elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
4358:               for (d = 0; d < dim; ++d) {
4359:                 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
4360:                 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
4361:                 for (d2 = 0; d2 < dim; ++d2) {
4362:                   elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
4363:                 }
4364:               }
4365:             }
4366:           }
4367:         }
4368:       }
4369:     }
4370:     if (debug > 1) {
4371:       PetscInt fc, f, gc, g;

4373:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
4374:       for (fc = 0; fc < NcI; ++fc) {
4375:         for (f = 0; f < NbI; ++f) {
4376:           const PetscInt i = offsetI + f*NcI+fc;
4377:           for (gc = 0; gc < NcJ; ++gc) {
4378:             for (g = 0; g < NbJ; ++g) {
4379:               const PetscInt j = offsetJ + g*NcJ+gc;
4380:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
4381:             }
4382:           }
4383:           PetscPrintf(PETSC_COMM_SELF, "\n");
4384:         }
4385:       }
4386:     }
4387:     cOffset    += totDim;
4388:     cOffsetAux += totDimAux;
4389:     eOffset    += PetscSqr(totDim);
4390:   }
4391:   return(0);
4392: }

4396: PetscErrorCode PetscFEIntegrateBdJacobian_Basic(PetscFE fem, PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEFaceGeom *fgeom,
4397:                                                 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
4398: {
4399:   const PetscInt  debug      = 0;
4400:   PetscBdPointJac g0_func;
4401:   PetscBdPointJac g1_func;
4402:   PetscBdPointJac g2_func;
4403:   PetscBdPointJac g3_func;
4404:   PetscInt        cOffset    = 0; /* Offset into coefficients[] for element e */
4405:   PetscInt        cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
4406:   PetscInt        eOffset    = 0; /* Offset into elemMat[] for element e */
4407:   PetscInt        offsetI    = 0; /* Offset into an element vector for fieldI */
4408:   PetscInt        offsetJ    = 0; /* Offset into an element vector for fieldJ */
4409:   PetscQuadrature quad;
4410:   PetscScalar    *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4411:   PetscReal      *x;
4412:   PetscReal     **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
4413:   PetscInt       *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4414:   PetscInt        NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
4415:   PetscInt        dim, Nf, NfAux = 0, totDim, totDimAux = 0, e;
4416:   PetscErrorCode  ierr;

4419:   PetscFEGetSpatialDimension(fem, &dim);
4420:   PetscFEGetFaceQuadrature(fem, &quad);
4421:   PetscDSGetNumFields(prob, &Nf);
4422:   PetscDSGetTotalDimension(prob, &totDim);
4423:   PetscDSGetDimensions(prob, &Nb);
4424:   PetscDSGetComponents(prob, &Nc);
4425:   PetscDSGetComponentOffsets(prob, &uOff);
4426:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4427:   PetscDSGetFieldOffset(prob, fieldI, &offsetI);
4428:   PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
4429:   PetscDSGetBdJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);
4430:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4431:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4432:   PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
4433:   PetscDSGetFaceTabulation(prob, &B, &D);
4434:   if (probAux) {
4435:     PetscDSGetNumFields(probAux, &NfAux);
4436:     PetscDSGetTotalDimension(probAux, &totDimAux);
4437:     PetscDSGetDimensions(probAux, &NbAux);
4438:     PetscDSGetComponents(probAux, &NcAux);
4439:     PetscDSGetComponentOffsets(probAux, &aOff);
4440:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4441:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4442:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4443:     PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
4444:   }
4445:   NbI = Nb[fieldI], NbJ = Nb[fieldJ];
4446:   NcI = Nc[fieldI], NcJ = Nc[fieldJ];
4447:   BI  = B[fieldI],  BJ  = B[fieldJ];
4448:   DI  = D[fieldI],  DJ  = D[fieldJ];
4449:   /* Initialize here in case the function is not defined */
4450:   PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4451:   PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
4452:   PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
4453:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4454:   for (e = 0; e < Ne; ++e) {
4455:     const PetscReal *quadPoints, *quadWeights;
4456:     const PetscReal *v0   = fgeom[e].v0;
4457:     const PetscReal *J    = fgeom[e].J;
4458:     const PetscReal *invJ = fgeom[e].invJ[0];
4459:     const PetscReal  detJ = fgeom[e].detJ;
4460:     const PetscReal *n    = fgeom[e].n;
4461:     const PetscInt   face = fgeom[e].face[0];
4462:     PetscInt         Nq, q;

4464:     PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4465:     for (q = 0; q < Nq; ++q) {
4466:       const PetscReal *BIq = &BI[(face*Nq+q)*NbI*NcI], *BJq = &BJ[(face*Nq+q)*NbJ*NcJ];
4467:       const PetscReal *DIq = &DI[(face*Nq+q)*NbI*NcI*dim], *DJq = &DJ[(face*Nq+q)*NbJ*NcJ*dim];
4468:       const PetscReal  w = detJ*quadWeights[q];
4469:       PetscInt f, g, fc, gc, c;

4471:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4472:       CoordinatesRefToReal(dim, dim-1, v0, J, &quadPoints[q*(dim-1)], x);
4473:       EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4474:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4475:       if (g0_func) {
4476:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4477:         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, g0);
4478:         for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
4479:       }
4480:       if (g1_func) {
4481:         PetscInt d, d2;
4482:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4483:         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, refSpaceDer);
4484:         for (fc = 0; fc < NcI; ++fc) {
4485:           for (gc = 0; gc < NcJ; ++gc) {
4486:             for (d = 0; d < dim; ++d) {
4487:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
4488:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4489:               g1[(fc*NcJ+gc)*dim+d] *= w;
4490:             }
4491:           }
4492:         }
4493:       }
4494:       if (g2_func) {
4495:         PetscInt d, d2;
4496:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4497:         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, refSpaceDer);
4498:         for (fc = 0; fc < NcI; ++fc) {
4499:           for (gc = 0; gc < NcJ; ++gc) {
4500:             for (d = 0; d < dim; ++d) {
4501:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
4502:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4503:               g2[(fc*NcJ+gc)*dim+d] *= w;
4504:             }
4505:           }
4506:         }
4507:       }
4508:       if (g3_func) {
4509:         PetscInt d, d2, dp, d3;
4510:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4511:         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, refSpaceDer);
4512:         for (fc = 0; fc < NcI; ++fc) {
4513:           for (gc = 0; gc < NcJ; ++gc) {
4514:             for (d = 0; d < dim; ++d) {
4515:               for (dp = 0; dp < dim; ++dp) {
4516:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
4517:                 for (d2 = 0; d2 < dim; ++d2) {
4518:                   for (d3 = 0; d3 < dim; ++d3) {
4519:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
4520:                   }
4521:                 }
4522:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
4523:               }
4524:             }
4525:           }
4526:         }
4527:       }

4529:       for (f = 0; f < NbI; ++f) {
4530:         for (fc = 0; fc < NcI; ++fc) {
4531:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
4532:           const PetscInt i    = offsetI+fidx; /* Element matrix row */
4533:           for (g = 0; g < NbJ; ++g) {
4534:             for (gc = 0; gc < NcJ; ++gc) {
4535:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
4536:               const PetscInt j    = offsetJ+gidx; /* Element matrix column */
4537:               const PetscInt fOff = eOffset+i*totDim+j;
4538:               PetscInt       d, d2;

4540:               elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
4541:               for (d = 0; d < dim; ++d) {
4542:                 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
4543:                 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
4544:                 for (d2 = 0; d2 < dim; ++d2) {
4545:                   elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
4546:                 }
4547:               }
4548:             }
4549:           }
4550:         }
4551:       }
4552:     }
4553:     if (debug > 1) {
4554:       PetscInt fc, f, gc, g;

4556:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
4557:       for (fc = 0; fc < NcI; ++fc) {
4558:         for (f = 0; f < NbI; ++f) {
4559:           const PetscInt i = offsetI + f*NcI+fc;
4560:           for (gc = 0; gc < NcJ; ++gc) {
4561:             for (g = 0; g < NbJ; ++g) {
4562:               const PetscInt j = offsetJ + g*NcJ+gc;
4563:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
4564:             }
4565:           }
4566:           PetscPrintf(PETSC_COMM_SELF, "\n");
4567:         }
4568:       }
4569:     }
4570:     cOffset    += totDim;
4571:     cOffsetAux += totDimAux;
4572:     eOffset    += PetscSqr(totDim);
4573:   }
4574:   return(0);
4575: }

4579: PetscErrorCode PetscFEInitialize_Basic(PetscFE fem)
4580: {
4582:   fem->ops->setfromoptions          = NULL;
4583:   fem->ops->setup                   = PetscFESetUp_Basic;
4584:   fem->ops->view                    = PetscFEView_Basic;
4585:   fem->ops->destroy                 = PetscFEDestroy_Basic;
4586:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
4587:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
4588:   fem->ops->integrate               = PetscFEIntegrate_Basic;
4589:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Basic;
4590:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Basic;
4591:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Basic */;
4592:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
4593:   fem->ops->integratebdjacobian     = PetscFEIntegrateBdJacobian_Basic;
4594:   return(0);
4595: }

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

4600:   Level: intermediate

4602: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
4603: M*/

4607: PETSC_EXTERN PetscErrorCode PetscFECreate_Basic(PetscFE fem)
4608: {
4609:   PetscFE_Basic *b;

4614:   PetscNewLog(fem,&b);
4615:   fem->data = b;

4617:   PetscFEInitialize_Basic(fem);
4618:   return(0);
4619: }

4623: PetscErrorCode PetscFEDestroy_Nonaffine(PetscFE fem)
4624: {
4625:   PetscFE_Nonaffine *na = (PetscFE_Nonaffine *) fem->data;

4629:   PetscFree(na);
4630:   return(0);
4631: }

4635: PetscErrorCode PetscFEIntegrateResidual_Nonaffine(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
4636:                                                   const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4637: {
4638:   const PetscInt  debug = 0;
4639:   PetscPointFunc  f0_func;
4640:   PetscPointFunc  f1_func;
4641:   PetscQuadrature quad;
4642:   PetscScalar    *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4643:   PetscReal      *x;
4644:   PetscReal     **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4645:   PetscInt       *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4646:   PetscInt       dim, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;

4650:   PetscFEGetSpatialDimension(fem, &dim);
4651:   PetscFEGetQuadrature(fem, &quad);
4652:   PetscDSGetNumFields(prob, &Nf);
4653:   PetscDSGetTotalDimension(prob, &totDim);
4654:   PetscDSGetDimensions(prob, &Nb);
4655:   PetscDSGetComponents(prob, &Nc);
4656:   PetscDSGetComponentOffsets(prob, &uOff);
4657:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4658:   PetscDSGetFieldOffset(prob, field, &fOffset);
4659:   PetscDSGetResidual(prob, field, &f0_func, &f1_func);
4660:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4661:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4662:   PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4663:   PetscDSGetTabulation(prob, &B, &D);
4664:   if (probAux) {
4665:     PetscDSGetNumFields(probAux, &NfAux);
4666:     PetscDSGetTotalDimension(probAux, &totDimAux);
4667:     PetscDSGetDimensions(probAux, &NbAux);
4668:     PetscDSGetComponents(probAux, &NcAux);
4669:     PetscDSGetComponentOffsets(probAux, &aOff);
4670:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4671:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4672:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4673:     PetscDSGetTabulation(probAux, &BAux, &DAux);
4674:   }
4675:   NbI = Nb[field];
4676:   NcI = Nc[field];
4677:   BI  = B[field];
4678:   DI  = D[field];
4679:   for (e = 0; e < Ne; ++e) {
4680:     const PetscReal *quadPoints, *quadWeights;
4681:     PetscInt         Nq, q;

4683:     PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4684:     PetscMemzero(f0, Nq*Nc[field]* sizeof(PetscScalar));
4685:     PetscMemzero(f1, Nq*Nc[field]*dim * sizeof(PetscScalar));
4686:     for (q = 0; q < Nq; ++q) {
4687:       const PetscReal *v0   = cgeom[e*Nq+q].v0;
4688:       const PetscReal *J    = cgeom[e*Nq+q].J;
4689:       const PetscReal *invJ = cgeom[e*Nq+q].invJ;
4690:       const PetscReal  detJ = cgeom[e*Nq+q].detJ;

4692:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4693:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4694:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4695:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4696:       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, &f0[q*NcI]);
4697:       if (f1_func) f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, refSpaceDer);
4698:       TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0, f1);
4699:     }
4700:     UpdateElementVec(dim, Nq, NbI, NcI, BI, DI, f0, f1, &elemVec[cOffset+fOffset]);
4701:     cOffset    += totDim;
4702:     cOffsetAux += totDimAux;
4703:   }
4704:   return(0);
4705: }

4709: PetscErrorCode PetscFEIntegrateBdResidual_Nonaffine(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEFaceGeom *fgeom,
4710:                                                 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4711: {
4712:    const PetscInt   debug = 0;
4713:    PetscBdPointFunc f0_func;
4714:    PetscBdPointFunc f1_func;
4715:    PetscQuadrature  quad;
4716:    PetscScalar     *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4717:    PetscReal       *x;
4718:    PetscReal      **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4719:    PetscInt        *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4720:    PetscInt         dim, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
4721:    PetscErrorCode   ierr;
4722: 
4724:    PetscFEGetSpatialDimension(fem, &dim);
4725:    PetscFEGetFaceQuadrature(fem, &quad);
4726:    PetscDSGetNumFields(prob, &Nf);
4727:    PetscDSGetTotalDimension(prob, &totDim);
4728:    PetscDSGetDimensions(prob, &Nb);
4729:    PetscDSGetComponents(prob, &Nc);
4730:    PetscDSGetComponentOffsets(prob, &uOff);
4731:    PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4732:    PetscDSGetFieldOffset(prob, field, &fOffset);
4733:    PetscDSGetBdResidual(prob, field, &f0_func, &f1_func);
4734:    if (!f0_func && !f1_func) return(0);
4735:    PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4736:    PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4737:    PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4738:    PetscDSGetFaceTabulation(prob, &B, &D);
4739:    if (probAux) {
4740:      PetscDSGetNumFields(probAux, &NfAux);
4741:      PetscDSGetTotalDimension(probAux, &totDimAux);
4742:      PetscDSGetDimensions(probAux, &NbAux);
4743:      PetscDSGetComponents(probAux, &NcAux);
4744:      PetscDSGetComponentOffsets(probAux, &aOff);
4745:      PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4746:      PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4747:      PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4748:      PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
4749:    }
4750:    NbI = Nb[field];
4751:    NcI = Nc[field];
4752:    BI  = B[field];
4753:    DI  = D[field];
4754:    for (e = 0; e < Ne; ++e) {
4755:      const PetscReal *quadPoints, *quadWeights;
4756:      PetscInt         Nq, q, face;
4757: 
4758:      PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4759:      face = fgeom[e*Nq].face[0];
4760:      PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
4761:      PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
4762:      for (q = 0; q < Nq; ++q) {
4763:        const PetscReal *v0   = fgeom[e*Nq+q].v0;
4764:        const PetscReal *J    = fgeom[e*Nq+q].J;
4765:        const PetscReal *invJ = fgeom[e*Nq+q].invJ[0];
4766:        const PetscReal  detJ = fgeom[e*Nq+q].detJ;
4767:        const PetscReal *n    = fgeom[e*Nq+q].n;

4769:        if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4770:        CoordinatesRefToReal(dim, dim-1, v0, J, &quadPoints[q*(dim-1)], x);
4771:        EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4772:        if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4773:        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, &f0[q*NcI]);
4774:        if (f1_func) f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, n, refSpaceDer);
4775:        TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
4776:      }
4777:      UpdateElementVec(dim, Nq, NbI, NcI, &BI[face*Nq*NbI*NcI], &DI[face*Nq*NbI*NcI*dim], f0, f1, &elemVec[cOffset+fOffset]);
4778:      cOffset    += totDim;
4779:      cOffsetAux += totDimAux;
4780:    }
4781:    return(0);
4782: }

4786: PetscErrorCode PetscFEIntegrateJacobian_Nonaffine(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFECellGeom *cgeom,
4787:                                                   const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
4788: {
4789:   const PetscInt  debug      = 0;
4790:   PetscPointJac   g0_func;
4791:   PetscPointJac   g1_func;
4792:   PetscPointJac   g2_func;
4793:   PetscPointJac   g3_func;
4794:   PetscInt        cOffset    = 0; /* Offset into coefficients[] for element e */
4795:   PetscInt        cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
4796:   PetscInt        eOffset    = 0; /* Offset into elemMat[] for element e */
4797:   PetscInt        offsetI    = 0; /* Offset into an element vector for fieldI */
4798:   PetscInt        offsetJ    = 0; /* Offset into an element vector for fieldJ */
4799:   PetscQuadrature quad;
4800:   PetscScalar    *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4801:   PetscReal      *x;
4802:   PetscReal     **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
4803:   PetscInt        NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
4804:   PetscInt       *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4805:   PetscInt        dim, Nf, NfAux = 0, totDim, totDimAux = 0, e;
4806:   PetscErrorCode  ierr;

4809:   PetscFEGetSpatialDimension(fem, &dim);
4810:   PetscFEGetQuadrature(fem, &quad);
4811:   PetscDSGetNumFields(prob, &Nf);
4812:   PetscDSGetTotalDimension(prob, &totDim);
4813:   PetscDSGetDimensions(prob, &Nb);
4814:   PetscDSGetComponents(prob, &Nc);
4815:   PetscDSGetComponentOffsets(prob, &uOff);
4816:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4817:   switch(jtype) {
4818:   case PETSCFE_JACOBIAN_DYN: PetscDSGetDynamicJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4819:   case PETSCFE_JACOBIAN_PRE: PetscDSGetJacobianPreconditioner(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4820:   case PETSCFE_JACOBIAN:     PetscDSGetJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4821:   }
4822:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4823:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4824:   PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
4825:   PetscDSGetTabulation(prob, &B, &D);
4826:   PetscDSGetFieldOffset(prob, fieldI, &offsetI);
4827:   PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
4828:   if (probAux) {
4829:     PetscDSGetNumFields(probAux, &NfAux);
4830:     PetscDSGetTotalDimension(probAux, &totDimAux);
4831:     PetscDSGetDimensions(probAux, &NbAux);
4832:     PetscDSGetComponents(probAux, &NcAux);
4833:     PetscDSGetComponentOffsets(probAux, &aOff);
4834:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4835:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4836:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4837:     PetscDSGetTabulation(probAux, &BAux, &DAux);
4838:   }
4839:   NbI = Nb[fieldI], NbJ = Nb[fieldJ];
4840:   NcI = Nc[fieldI], NcJ = Nc[fieldJ];
4841:   BI  = B[fieldI],  BJ  = B[fieldJ];
4842:   DI  = D[fieldI],  DJ  = D[fieldJ];
4843:   /* Initialize here in case the function is not defined */
4844:   PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4845:   PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
4846:   PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
4847:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4848:   for (e = 0; e < Ne; ++e) {
4849:     const PetscReal *quadPoints, *quadWeights;
4850:     PetscInt         Nq, q;

4852:     PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4853:     for (q = 0; q < Nq; ++q) {
4854:       const PetscReal *v0   = cgeom[e*Nq+q].v0;
4855:       const PetscReal *J    = cgeom[e*Nq+q].J;
4856:       const PetscReal *invJ = cgeom[e*Nq+q].invJ;
4857:       const PetscReal  detJ = cgeom[e*Nq+q].detJ;
4858:       const PetscReal *BIq = &BI[q*NbI*NcI], *BJq = &BJ[q*NbJ*NcJ];
4859:       const PetscReal *DIq = &DI[q*NbI*NcI*dim], *DJq = &DJ[q*NbJ*NcJ*dim];
4860:       const PetscReal  w = detJ*quadWeights[q];
4861:       PetscInt         f, g, fc, gc, c;

4863:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4864:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4865:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4866:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4867:       if (g0_func) {
4868:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4869:         g0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, g0);
4870:         for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
4871:       }
4872:       if (g1_func) {
4873:         PetscInt d, d2;
4874:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4875:         g1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, refSpaceDer);
4876:         for (fc = 0; fc < NcI; ++fc) {
4877:           for (gc = 0; gc < NcJ; ++gc) {
4878:             for (d = 0; d < dim; ++d) {
4879:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
4880:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4881:               g1[(fc*NcJ+gc)*dim+d] *= w;
4882:             }
4883:           }
4884:         }
4885:       }
4886:       if (g2_func) {
4887:         PetscInt d, d2;
4888:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4889:         g2_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, refSpaceDer);
4890:         for (fc = 0; fc < NcI; ++fc) {
4891:           for (gc = 0; gc < NcJ; ++gc) {
4892:             for (d = 0; d < dim; ++d) {
4893:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
4894:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4895:               g2[(fc*NcJ+gc)*dim+d] *= w;
4896:             }
4897:           }
4898:         }
4899:       }
4900:       if (g3_func) {
4901:         PetscInt d, d2, dp, d3;
4902:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4903:         g3_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, refSpaceDer);
4904:         for (fc = 0; fc < NcI; ++fc) {
4905:           for (gc = 0; gc < NcJ; ++gc) {
4906:             for (d = 0; d < dim; ++d) {
4907:               for (dp = 0; dp < dim; ++dp) {
4908:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
4909:                 for (d2 = 0; d2 < dim; ++d2) {
4910:                   for (d3 = 0; d3 < dim; ++d3) {
4911:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
4912:                   }
4913:                 }
4914:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
4915:               }
4916:             }
4917:           }
4918:         }
4919:       }

4921:       for (f = 0; f < NbI; ++f) {
4922:         for (fc = 0; fc < NcI; ++fc) {
4923:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
4924:           const PetscInt i    = offsetI+fidx; /* Element matrix row */
4925:           for (g = 0; g < NbJ; ++g) {
4926:             for (gc = 0; gc < NcJ; ++gc) {
4927:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
4928:               const PetscInt j    = offsetJ+gidx; /* Element matrix column */
4929:               const PetscInt fOff = eOffset+i*totDim+j;
4930:               PetscInt       d, d2;

4932:               elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
4933:               for (d = 0; d < dim; ++d) {
4934:                 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
4935:                 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
4936:                 for (d2 = 0; d2 < dim; ++d2) {
4937:                   elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
4938:                 }
4939:               }
4940:             }
4941:           }
4942:         }
4943:       }
4944:     }
4945:     if (debug > 1) {
4946:       PetscInt fc, f, gc, g;

4948:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
4949:       for (fc = 0; fc < NcI; ++fc) {
4950:         for (f = 0; f < NbI; ++f) {
4951:           const PetscInt i = offsetI + f*NcI+fc;
4952:           for (gc = 0; gc < NcJ; ++gc) {
4953:             for (g = 0; g < NbJ; ++g) {
4954:               const PetscInt j = offsetJ + g*NcJ+gc;
4955:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
4956:             }
4957:           }
4958:           PetscPrintf(PETSC_COMM_SELF, "\n");
4959:         }
4960:       }
4961:     }
4962:     cOffset    += totDim;
4963:     cOffsetAux += totDimAux;
4964:     eOffset    += PetscSqr(totDim);
4965:   }
4966:   return(0);
4967: }

4971: PetscErrorCode PetscFEInitialize_Nonaffine(PetscFE fem)
4972: {
4974:   fem->ops->setfromoptions          = NULL;
4975:   fem->ops->setup                   = PetscFESetUp_Basic;
4976:   fem->ops->view                    = NULL;
4977:   fem->ops->destroy                 = PetscFEDestroy_Nonaffine;
4978:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
4979:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
4980:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Nonaffine;
4981:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Nonaffine;
4982:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Nonaffine */;
4983:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Nonaffine;
4984:   return(0);
4985: }

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

4990:   Level: intermediate

4992: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
4993: M*/

4997: PETSC_EXTERN PetscErrorCode PetscFECreate_Nonaffine(PetscFE fem)
4998: {
4999:   PetscFE_Nonaffine *na;
5000:   PetscErrorCode     ierr;

5004:   PetscNewLog(fem, &na);
5005:   fem->data = na;

5007:   PetscFEInitialize_Nonaffine(fem);
5008:   return(0);
5009: }

5011: #ifdef PETSC_HAVE_OPENCL

5015: PetscErrorCode PetscFEDestroy_OpenCL(PetscFE fem)
5016: {
5017:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5018:   PetscErrorCode  ierr;

5021:   clReleaseCommandQueue(ocl->queue_id);
5022:   ocl->queue_id = 0;
5023:   clReleaseContext(ocl->ctx_id);
5024:   ocl->ctx_id = 0;
5025:   PetscFree(ocl);
5026:   return(0);
5027: }

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

5034: /* dim     Number of spatial dimensions:          2                   */
5035: /* N_b     Number of basis functions:             generated           */
5036: /* N_{bt}  Number of total basis functions:       N_b * N_{comp}      */
5037: /* N_q     Number of quadrature points:           generated           */
5038: /* N_{bs}  Number of block cells                  LCM(N_b, N_q)       */
5039: /* N_{bst} Number of block cell components        LCM(N_{bt}, N_q)    */
5040: /* N_{bl}  Number of concurrent blocks            generated           */
5041: /* N_t     Number of threads:                     N_{bl} * N_{bs}     */
5042: /* N_{cbc} Number of concurrent basis      cells: N_{bl} * N_q        */
5043: /* N_{cqc} Number of concurrent quadrature cells: N_{bl} * N_b        */
5044: /* N_{sbc} Number of serial     basis      cells: N_{bs} / N_q        */
5045: /* N_{sqc} Number of serial     quadrature cells: N_{bs} / N_b        */
5046: /* N_{cb}  Number of serial cell batches:         input               */
5047: /* N_c     Number of total cells:                 N_{cb}*N_{t}/N_{comp} */
5048: PetscErrorCode PetscFEOpenCLGenerateIntegrationCode(PetscFE fem, char **string_buffer, PetscInt buffer_length, PetscBool useAux, PetscInt N_bl)
5049: {
5050:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5051:   PetscQuadrature q;
5052:   char           *string_tail   = *string_buffer;
5053:   char           *end_of_buffer = *string_buffer + buffer_length;
5054:   char            float_str[]   = "float", double_str[]  = "double";
5055:   char           *numeric_str   = &(float_str[0]);
5056:   PetscInt        op            = ocl->op;
5057:   PetscBool       useField      = PETSC_FALSE;
5058:   PetscBool       useFieldDer   = PETSC_TRUE;
5059:   PetscBool       useFieldAux   = useAux;
5060:   PetscBool       useFieldDerAux= PETSC_FALSE;
5061:   PetscBool       useF0         = PETSC_TRUE;
5062:   PetscBool       useF1         = PETSC_TRUE;
5063:   PetscReal      *basis, *basisDer;
5064:   PetscInt        dim, N_b, N_c, N_q, N_t, p, d, b, c;
5065:   size_t          count;
5066:   PetscErrorCode  ierr;

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

5426:   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");}
5427:   if (useF1) {
5428:     switch (dim) {
5429:     case 2:
5430:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5431: "        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"
5432: "        e_i           += realSpaceDer.x*f_1[fidx].x;\n"
5433: "        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"
5434: "        e_i           += realSpaceDer.y*f_1[fidx].y;\n",
5435:                            &count);STRING_ERROR_CHECK("Message to short");break;
5436:     case 3:
5437:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5438: "        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"
5439: "        e_i           += realSpaceDer.x*f_1[fidx].x;\n"
5440: "        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"
5441: "        e_i           += realSpaceDer.y*f_1[fidx].y;\n"
5442: "        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"
5443: "        e_i           += realSpaceDer.z*f_1[fidx].z;\n",
5444:                            &count);STRING_ERROR_CHECK("Message to short");break;
5445:     }
5446:   }
5447:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5448: "      }\n"
5449: "      /* Write element vector for N_{cbc} cells at a time */\n"
5450: "      elemVec[(Goffset + batch*N_bc + c*N_bl*N_q)*N_bt + tidx] = e_i;\n"
5451: "    }\n"
5452: "    /* ==== Could do one write per batch ==== */\n"
5453: "  }\n"
5454: "  return;\n"
5455: "}\n",
5456:                        &count);STRING_ERROR_CHECK("Message to short");
5457:   return(0);
5458: }

5462: PetscErrorCode PetscFEOpenCLGetIntegrationKernel(PetscFE fem, PetscBool useAux, cl_program *ocl_prog, cl_kernel *ocl_kernel)
5463: {
5464:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5465:   PetscInt        dim, N_bl;
5466:   PetscBool       flg;
5467:   char           *buffer;
5468:   size_t          len;
5469:   char            errMsg[8192];
5470:   cl_int          ierr2;
5471:   PetscErrorCode  ierr;

5474:   PetscFEGetSpatialDimension(fem, &dim);
5475:   PetscMalloc1(8192, &buffer);
5476:   PetscFEGetTileSizes(fem, NULL, &N_bl, NULL, NULL);
5477:   PetscFEOpenCLGenerateIntegrationCode(fem, &buffer, 8192, useAux, N_bl);
5478:   PetscOptionsHasName(((PetscObject)fem)->options,((PetscObject)fem)->prefix, "-petscfe_opencl_kernel_print", &flg);
5479:   if (flg) {PetscPrintf(PetscObjectComm((PetscObject) fem), "OpenCL FE Integration Kernel:\n%s\n", buffer);}
5480:   len  = strlen(buffer);
5481:   *ocl_prog = clCreateProgramWithSource(ocl->ctx_id, 1, (const char **) &buffer, &len, &ierr2);CHKERRQ(ierr2);
5482:   clBuildProgram(*ocl_prog, 0, NULL, NULL, NULL, NULL);
5483:   if (ierr != CL_SUCCESS) {
5484:     clGetProgramBuildInfo(*ocl_prog, ocl->dev_id, CL_PROGRAM_BUILD_LOG, 8192*sizeof(char), &errMsg, NULL);
5485:     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Build failed! Log:\n %s", errMsg);
5486:   }
5487:   PetscFree(buffer);
5488:   *ocl_kernel = clCreateKernel(*ocl_prog, "integrateElementQuadrature", &ierr);
5489:   return(0);
5490: }

5494: PetscErrorCode PetscFEOpenCLCalculateGrid(PetscFE fem, PetscInt N, PetscInt blockSize, size_t *x, size_t *y, size_t *z)
5495: {
5496:   const PetscInt Nblocks = N/blockSize;

5499:   if (N % blockSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Invalid block size %d for %d elements", blockSize, N);
5500:   *z = 1;
5501:   for (*x = (size_t) (PetscSqrtReal(Nblocks) + 0.5); *x > 0; --*x) {
5502:     *y = Nblocks / *x;
5503:     if (*x * *y == Nblocks) break;
5504:   }
5505:   if (*x * *y != Nblocks) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Could not find partition for %d with block size %d", N, blockSize);
5506:   return(0);
5507: }

5511: PetscErrorCode PetscFEOpenCLLogResidual(PetscFE fem, PetscLogDouble time, PetscLogDouble flops)
5512: {
5513:   PetscFE_OpenCL   *ocl = (PetscFE_OpenCL *) fem->data;
5514:   PetscStageLog     stageLog;
5515:   PetscEventPerfLog eventLog = NULL;
5516:   PetscInt          stage;
5517:   PetscErrorCode    ierr;

5520:   PetscLogGetStageLog(&stageLog);
5521:   PetscStageLogGetCurrent(stageLog, &stage);
5522:   PetscStageLogGetEventPerfLog(stageLog, stage, &eventLog);
5523:     /* Log performance info */
5524:   eventLog->eventInfo[ocl->residualEvent].count++;
5525:   eventLog->eventInfo[ocl->residualEvent].time  += time;
5526:   eventLog->eventInfo[ocl->residualEvent].flops += flops;
5527:   return(0);
5528: }

5532: PetscErrorCode PetscFEIntegrateResidual_OpenCL(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
5533:                                                const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
5534: {
5535:   /* Nbc = batchSize */
5536:   PetscFE_OpenCL   *ocl = (PetscFE_OpenCL *) fem->data;
5537:   PetscPointFunc    f0_func;
5538:   PetscPointFunc    f1_func;
5539:   PetscQuadrature   q;
5540:   PetscInt          dim;
5541:   PetscInt          N_b;    /* The number of basis functions */
5542:   PetscInt          N_comp; /* The number of basis function components */
5543:   PetscInt          N_bt;   /* The total number of scalar basis functions */
5544:   PetscInt          N_q;    /* The number of quadrature points */
5545:   PetscInt          N_bst;  /* The block size, LCM(N_bt, N_q), Notice that a block is not process simultaneously */
5546:   PetscInt          N_t;    /* The number of threads, N_bst * N_bl */
5547:   PetscInt          N_bl;   /* The number of blocks */
5548:   PetscInt          N_bc;   /* The batch size, N_bl*N_q*N_b */
5549:   PetscInt          N_cb;   /* The number of batches */
5550:   PetscInt          numFlops, f0Flops = 0, f1Flops = 0;
5551:   PetscBool         useAux      = probAux ? PETSC_TRUE : PETSC_FALSE;
5552:   PetscBool         useField    = PETSC_FALSE;
5553:   PetscBool         useFieldDer = PETSC_TRUE;
5554:   PetscBool         useF0       = PETSC_TRUE;
5555:   PetscBool         useF1       = PETSC_TRUE;
5556:   /* OpenCL variables */
5557:   cl_program        ocl_prog;
5558:   cl_kernel         ocl_kernel;
5559:   cl_event          ocl_ev;         /* The event for tracking kernel execution */
5560:   cl_ulong          ns_start;       /* Nanoseconds counter on GPU at kernel start */
5561:   cl_ulong          ns_end;         /* Nanoseconds counter on GPU at kernel stop */
5562:   cl_mem            o_jacobianInverses, o_jacobianDeterminants;
5563:   cl_mem            o_coefficients, o_coefficientsAux, o_elemVec;
5564:   float            *f_coeff = NULL, *f_coeffAux = NULL, *f_invJ = NULL, *f_detJ = NULL;
5565:   double           *d_coeff = NULL, *d_coeffAux = NULL, *d_invJ = NULL, *d_detJ = NULL;
5566:   PetscReal        *r_invJ = NULL, *r_detJ = NULL;
5567:   void             *oclCoeff, *oclCoeffAux, *oclInvJ, *oclDetJ;
5568:   size_t            local_work_size[3], global_work_size[3];
5569:   size_t            realSize, x, y, z;
5570:   PetscErrorCode    ierr;

5573:   if (!Ne) {PetscFEOpenCLLogResidual(fem, 0.0, 0.0); return(0);}
5574:   PetscFEGetSpatialDimension(fem, &dim);
5575:   PetscFEGetQuadrature(fem, &q);
5576:   PetscFEGetDimension(fem, &N_b);
5577:   PetscFEGetNumComponents(fem, &N_comp);
5578:   PetscDSGetResidual(prob, field, &f0_func, &f1_func);
5579:   PetscFEGetTileSizes(fem, NULL, &N_bl, &N_bc, &N_cb);
5580:   N_bt  = N_b*N_comp;
5581:   N_q   = q->numPoints;
5582:   N_bst = N_bt*N_q;
5583:   N_t   = N_bst*N_bl;
5584:   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);
5585:   /* Calculate layout */
5586:   if (Ne % (N_cb*N_bc)) { /* Remainder cells */
5587:     PetscFEIntegrateResidual_Basic(fem, prob, field, Ne, cgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);
5588:     return(0);
5589:   }
5590:   PetscFEOpenCLCalculateGrid(fem, Ne, N_cb*N_bc, &x, &y, &z);
5591:   local_work_size[0]  = N_bc*N_comp;
5592:   local_work_size[1]  = 1;
5593:   local_work_size[2]  = 1;
5594:   global_work_size[0] = x * local_work_size[0];
5595:   global_work_size[1] = y * local_work_size[1];
5596:   global_work_size[2] = z * local_work_size[2];
5597:   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);
5598:   PetscInfo2(fem, " N_t: %d, N_cb: %d\n", N_t, N_cb);
5599:   /* Generate code */
5600:   if (probAux) {
5601:     PetscSpace P;
5602:     PetscInt   NfAux, order, f;

5604:     PetscDSGetNumFields(probAux, &NfAux);
5605:     for (f = 0; f < NfAux; ++f) {
5606:       PetscFE feAux;

5608:       PetscDSGetDiscretization(probAux, f, (PetscObject *) &feAux);
5609:       PetscFEGetBasisSpace(feAux, &P);
5610:       PetscSpaceGetOrder(P, &order);
5611:       if (order > 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Can only handle P0 coefficient fields");
5612:     }
5613:   }
5614:   PetscFEOpenCLGetIntegrationKernel(fem, useAux, &ocl_prog, &ocl_kernel);
5615:   /* Create buffers on the device and send data over */
5616:   PetscDataTypeGetSize(ocl->realType, &realSize);
5617:   if (sizeof(PetscReal) != realSize) {
5618:     switch (ocl->realType) {
5619:     case PETSC_FLOAT:
5620:     {
5621:       PetscInt c, b, d;

5623:       PetscMalloc4(Ne*N_bt,&f_coeff,Ne,&f_coeffAux,Ne*dim*dim,&f_invJ,Ne,&f_detJ);
5624:       for (c = 0; c < Ne; ++c) {
5625:         f_detJ[c] = (float) cgeom[c].detJ;
5626:         for (d = 0; d < dim*dim; ++d) {
5627:           f_invJ[c*dim*dim+d] = (float) cgeom[c].invJ[d];
5628:         }
5629:         for (b = 0; b < N_bt; ++b) {
5630:           f_coeff[c*N_bt+b] = (float) coefficients[c*N_bt+b];
5631:         }
5632:       }
5633:       if (coefficientsAux) { /* Assume P0 */
5634:         for (c = 0; c < Ne; ++c) {
5635:           f_coeffAux[c] = (float) coefficientsAux[c];
5636:         }
5637:       }
5638:       oclCoeff      = (void *) f_coeff;
5639:       if (coefficientsAux) {
5640:         oclCoeffAux = (void *) f_coeffAux;
5641:       } else {
5642:         oclCoeffAux = NULL;
5643:       }
5644:       oclInvJ       = (void *) f_invJ;
5645:       oclDetJ       = (void *) f_detJ;
5646:     }
5647:     break;
5648:     case PETSC_DOUBLE:
5649:     {
5650:       PetscInt c, b, d;

5652:       PetscMalloc4(Ne*N_bt,&d_coeff,Ne,&d_coeffAux,Ne*dim*dim,&d_invJ,Ne,&d_detJ);
5653:       for (c = 0; c < Ne; ++c) {
5654:         d_detJ[c] = (double) cgeom[c].detJ;
5655:         for (d = 0; d < dim*dim; ++d) {
5656:           d_invJ[c*dim*dim+d] = (double) cgeom[c].invJ[d];
5657:         }
5658:         for (b = 0; b < N_bt; ++b) {
5659:           d_coeff[c*N_bt+b] = (double) coefficients[c*N_bt+b];
5660:         }
5661:       }
5662:       if (coefficientsAux) { /* Assume P0 */
5663:         for (c = 0; c < Ne; ++c) {
5664:           d_coeffAux[c] = (double) coefficientsAux[c];
5665:         }
5666:       }
5667:       oclCoeff      = (void *) d_coeff;
5668:       if (coefficientsAux) {
5669:         oclCoeffAux = (void *) d_coeffAux;
5670:       } else {
5671:         oclCoeffAux = NULL;
5672:       }
5673:       oclInvJ       = (void *) d_invJ;
5674:       oclDetJ       = (void *) d_detJ;
5675:     }
5676:     break;
5677:     default:
5678:       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported PETSc type %d", ocl->realType);
5679:     }
5680:   } else {
5681:     PetscInt c, d;

5683:     PetscMalloc2(Ne*dim*dim,&r_invJ,Ne,&r_detJ);
5684:     for (c = 0; c < Ne; ++c) {
5685:       r_detJ[c] = cgeom[c].detJ;
5686:       for (d = 0; d < dim*dim; ++d) {
5687:         r_invJ[c*dim*dim+d] = cgeom[c].invJ[d];
5688:       }
5689:     }
5690:     oclCoeff    = (void *) coefficients;
5691:     oclCoeffAux = (void *) coefficientsAux;
5692:     oclInvJ     = (void *) r_invJ;
5693:     oclDetJ     = (void *) r_detJ;
5694:   }
5695:   o_coefficients         = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne*N_bt    * realSize, oclCoeff,    &ierr);
5696:   if (coefficientsAux) {
5697:     o_coefficientsAux    = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne         * realSize, oclCoeffAux, &ierr);
5698:   } else {
5699:     o_coefficientsAux    = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY,                        Ne         * realSize, oclCoeffAux, &ierr);
5700:   }
5701:   o_jacobianInverses     = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne*dim*dim * realSize, oclInvJ,     &ierr);
5702:   o_jacobianDeterminants = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne         * realSize, oclDetJ,     &ierr);
5703:   o_elemVec              = clCreateBuffer(ocl->ctx_id, CL_MEM_WRITE_ONLY,                       Ne*N_bt    * realSize, NULL,        &ierr);
5704:   /* Kernel launch */
5705:   clSetKernelArg(ocl_kernel, 0, sizeof(cl_int), (void*) &N_cb);
5706:   clSetKernelArg(ocl_kernel, 1, sizeof(cl_mem), (void*) &o_coefficients);
5707:   clSetKernelArg(ocl_kernel, 2, sizeof(cl_mem), (void*) &o_coefficientsAux);
5708:   clSetKernelArg(ocl_kernel, 3, sizeof(cl_mem), (void*) &o_jacobianInverses);
5709:   clSetKernelArg(ocl_kernel, 4, sizeof(cl_mem), (void*) &o_jacobianDeterminants);
5710:   clSetKernelArg(ocl_kernel, 5, sizeof(cl_mem), (void*) &o_elemVec);
5711:   clEnqueueNDRangeKernel(ocl->queue_id, ocl_kernel, 3, NULL, global_work_size, local_work_size, 0, NULL, &ocl_ev);
5712:   /* Read data back from device */
5713:   if (sizeof(PetscReal) != realSize) {
5714:     switch (ocl->realType) {
5715:     case PETSC_FLOAT:
5716:     {
5717:       float   *elem;
5718:       PetscInt c, b;

5720:       PetscFree4(f_coeff,f_coeffAux,f_invJ,f_detJ);
5721:       PetscMalloc1(Ne*N_bt, &elem);
5722:       clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elem, 0, NULL, NULL);
5723:       for (c = 0; c < Ne; ++c) {
5724:         for (b = 0; b < N_bt; ++b) {
5725:           elemVec[c*N_bt+b] = (PetscScalar) elem[c*N_bt+b];
5726:         }
5727:       }
5728:       PetscFree(elem);
5729:     }
5730:     break;
5731:     case PETSC_DOUBLE:
5732:     {
5733:       double  *elem;
5734:       PetscInt c, b;

5736:       PetscFree4(d_coeff,d_coeffAux,d_invJ,d_detJ);
5737:       PetscMalloc1(Ne*N_bt, &elem);
5738:       clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elem, 0, NULL, NULL);
5739:       for (c = 0; c < Ne; ++c) {
5740:         for (b = 0; b < N_bt; ++b) {
5741:           elemVec[c*N_bt+b] = (PetscScalar) elem[c*N_bt+b];
5742:         }
5743:       }
5744:       PetscFree(elem);
5745:     }
5746:     break;
5747:     default:
5748:       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported PETSc type %d", ocl->realType);
5749:     }
5750:   } else {
5751:     PetscFree2(r_invJ,r_detJ);
5752:     clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elemVec, 0, NULL, NULL);
5753:   }
5754:   /* Log performance */
5755:   clGetEventProfilingInfo(ocl_ev, CL_PROFILING_COMMAND_START, sizeof(cl_ulong), &ns_start, NULL);
5756:   clGetEventProfilingInfo(ocl_ev, CL_PROFILING_COMMAND_END,   sizeof(cl_ulong), &ns_end,   NULL);
5757:   f0Flops = 0;
5758:   switch (ocl->op) {
5759:   case LAPLACIAN:
5760:     f1Flops = useAux ? dim : 0;break;
5761:   case ELASTICITY:
5762:     f1Flops = 2*dim*dim;break;
5763:   }
5764:   numFlops = Ne*(
5765:     N_q*(
5766:       N_b*N_comp*((useField ? 2 : 0) + (useFieldDer ? 2*dim*(dim + 1) : 0))
5767:       /*+
5768:        N_ba*N_compa*((useFieldAux ? 2 : 0) + (useFieldDerAux ? 2*dim*(dim + 1) : 0))*/
5769:       +
5770:       N_comp*((useF0 ? f0Flops + 2 : 0) + (useF1 ? f1Flops + 2*dim : 0)))
5771:     +
5772:     N_b*((useF0 ? 2 : 0) + (useF1 ? 2*dim*(dim + 1) : 0)));
5773:   PetscFEOpenCLLogResidual(fem, (ns_end - ns_start)*1.0e-9, numFlops);
5774:   /* Cleanup */
5775:   clReleaseMemObject(o_coefficients);
5776:   clReleaseMemObject(o_coefficientsAux);
5777:   clReleaseMemObject(o_jacobianInverses);
5778:   clReleaseMemObject(o_jacobianDeterminants);
5779:   clReleaseMemObject(o_elemVec);
5780:   clReleaseKernel(ocl_kernel);
5781:   clReleaseProgram(ocl_prog);
5782:   return(0);
5783: }

5787: PetscErrorCode PetscFEInitialize_OpenCL(PetscFE fem)
5788: {
5790:   fem->ops->setfromoptions          = NULL;
5791:   fem->ops->setup                   = PetscFESetUp_Basic;
5792:   fem->ops->view                    = NULL;
5793:   fem->ops->destroy                 = PetscFEDestroy_OpenCL;
5794:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
5795:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
5796:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_OpenCL;
5797:   fem->ops->integratebdresidual     = NULL/* PetscFEIntegrateBdResidual_OpenCL */;
5798:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_OpenCL */;
5799:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
5800:   return(0);
5801: }

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

5806:   Level: intermediate

5808: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
5809: M*/

5813: PETSC_EXTERN PetscErrorCode PetscFECreate_OpenCL(PetscFE fem)
5814: {
5815:   PetscFE_OpenCL *ocl;
5816:   cl_uint         num_platforms;
5817:   cl_platform_id  platform_ids[42];
5818:   cl_uint         num_devices;
5819:   cl_device_id    device_ids[42];
5820:   cl_int          ierr2;
5821:   PetscErrorCode  ierr;

5825:   PetscNewLog(fem,&ocl);
5826:   fem->data = ocl;

5828:   /* Init Platform */
5829:   clGetPlatformIDs(42, platform_ids, &num_platforms);
5830:   if (!num_platforms) SETERRQ(PetscObjectComm((PetscObject) fem), PETSC_ERR_SUP, "No OpenCL platform found.");
5831:   ocl->pf_id = platform_ids[0];
5832:   /* Init Device */
5833:   clGetDeviceIDs(ocl->pf_id, CL_DEVICE_TYPE_ALL, 42, device_ids, &num_devices);
5834:   if (!num_devices) SETERRQ(PetscObjectComm((PetscObject) fem), PETSC_ERR_SUP, "No OpenCL device found.");
5835:   ocl->dev_id = device_ids[0];
5836:   /* Create context with one command queue */
5837:   ocl->ctx_id   = clCreateContext(0, 1, &(ocl->dev_id), NULL, NULL, &ierr2);CHKERRQ(ierr2);
5838:   ocl->queue_id = clCreateCommandQueue(ocl->ctx_id, ocl->dev_id, CL_QUEUE_PROFILING_ENABLE, &ierr2);CHKERRQ(ierr2);
5839:   /* Types */
5840:   ocl->realType = PETSC_FLOAT;
5841:   /* Register events */
5842:   PetscLogEventRegister("OpenCL FEResidual", PETSCFE_CLASSID, &ocl->residualEvent);
5843:   /* Equation handling */
5844:   ocl->op = LAPLACIAN;

5846:   PetscFEInitialize_OpenCL(fem);
5847:   return(0);
5848: }

5852: PetscErrorCode PetscFEOpenCLSetRealType(PetscFE fem, PetscDataType realType)
5853: {
5854:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;

5858:   ocl->realType = realType;
5859:   return(0);
5860: }

5864: PetscErrorCode PetscFEOpenCLGetRealType(PetscFE fem, PetscDataType *realType)
5865: {
5866:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;

5871:   *realType = ocl->realType;
5872:   return(0);
5873: }

5875: #endif /* PETSC_HAVE_OPENCL */

5879: PetscErrorCode PetscFEDestroy_Composite(PetscFE fem)
5880: {
5881:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
5882:   PetscErrorCode     ierr;

5885:   CellRefinerRestoreAffineTransforms_Internal(cmp->cellRefiner, &cmp->numSubelements, &cmp->v0, &cmp->jac, &cmp->invjac);
5886:   PetscFree(cmp->embedding);
5887:   PetscFree(cmp);
5888:   return(0);
5889: }

5893: PetscErrorCode PetscFESetUp_Composite(PetscFE fem)
5894: {
5895:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
5896:   DM                 K;
5897:   PetscReal         *subpoint;
5898:   PetscBLASInt      *pivots;
5899:   PetscBLASInt       n, info;
5900:   PetscScalar       *work, *invVscalar;
5901:   PetscInt           dim, pdim, spdim, j, s;
5902:   PetscErrorCode     ierr;

5905:   /* Get affine mapping from reference cell to each subcell */
5906:   PetscDualSpaceGetDM(fem->dualSpace, &K);
5907:   DMGetDimension(K, &dim);
5908:   DMPlexGetCellRefiner_Internal(K, &cmp->cellRefiner);
5909:   CellRefinerGetAffineTransforms_Internal(cmp->cellRefiner, &cmp->numSubelements, &cmp->v0, &cmp->jac, &cmp->invjac);
5910:   /* Determine dof embedding into subelements */
5911:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
5912:   PetscSpaceGetDimension(fem->basisSpace, &spdim);
5913:   PetscMalloc1(cmp->numSubelements*spdim,&cmp->embedding);
5914:   DMGetWorkArray(K, dim, PETSC_REAL, &subpoint);
5915:   for (s = 0; s < cmp->numSubelements; ++s) {
5916:     PetscInt sd = 0;

5918:     for (j = 0; j < pdim; ++j) {
5919:       PetscBool       inside;
5920:       PetscQuadrature f;
5921:       PetscInt        d, e;

5923:       PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);
5924:       /* Apply transform to first point, and check that point is inside subcell */
5925:       for (d = 0; d < dim; ++d) {
5926:         subpoint[d] = -1.0;
5927:         for (e = 0; e < dim; ++e) subpoint[d] += cmp->invjac[(s*dim + d)*dim+e]*(f->points[e] - cmp->v0[s*dim+e]);
5928:       }
5929:       CellRefinerInCellTest_Internal(cmp->cellRefiner, subpoint, &inside);
5930:       if (inside) {cmp->embedding[s*spdim+sd++] = j;}
5931:     }
5932:     if (sd != spdim) SETERRQ3(PetscObjectComm((PetscObject) fem), PETSC_ERR_PLIB, "Subelement %d has %d dual basis vectors != %d", s, sd, spdim);
5933:   }
5934:   DMRestoreWorkArray(K, dim, PETSC_REAL, &subpoint);
5935:   /* Construct the change of basis from prime basis to nodal basis for each subelement */
5936:   PetscMalloc1(cmp->numSubelements*spdim*spdim,&fem->invV);
5937:   PetscMalloc2(spdim,&pivots,spdim,&work);
5938: #if defined(PETSC_USE_COMPLEX)
5939:   PetscMalloc1(cmp->numSubelements*spdim*spdim,&invVscalar);
5940: #else
5941:   invVscalar = fem->invV;
5942: #endif
5943:   for (s = 0; s < cmp->numSubelements; ++s) {
5944:     for (j = 0; j < spdim; ++j) {
5945:       PetscReal      *Bf;
5946:       PetscQuadrature f;
5947:       PetscInt        q, k;

5949:       PetscDualSpaceGetFunctional(fem->dualSpace, cmp->embedding[s*spdim+j], &f);
5950:       PetscMalloc1(f->numPoints*spdim,&Bf);
5951:       PetscSpaceEvaluate(fem->basisSpace, f->numPoints, f->points, Bf, NULL, NULL);
5952:       for (k = 0; k < spdim; ++k) {
5953:         /* n_j \cdot \phi_k */
5954:         invVscalar[(s*spdim + j)*spdim+k] = 0.0;
5955:         for (q = 0; q < f->numPoints; ++q) {
5956:           invVscalar[(s*spdim + j)*spdim+k] += Bf[q*spdim+k]*f->weights[q];
5957:         }
5958:       }
5959:       PetscFree(Bf);
5960:     }
5961:     n = spdim;
5962:     PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, &invVscalar[s*spdim*spdim], &n, pivots, &info));
5963:     PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, &invVscalar[s*spdim*spdim], &n, pivots, work, &n, &info));
5964:   }
5965: #if defined(PETSC_USE_COMPLEX)
5966:   for (s = 0; s <cmp->numSubelements*spdim*spdim; s++) fem->invV[s] = PetscRealPart(invVscalar[s]);
5967:   PetscFree(invVscalar);
5968: #endif
5969:   PetscFree2(pivots,work);
5970:   return(0);
5971: }

5975: PetscErrorCode PetscFEGetTabulation_Composite(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H)
5976: {
5977:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
5978:   DM                 dm;
5979:   PetscInt           pdim;  /* Dimension of FE space P */
5980:   PetscInt           spdim; /* Dimension of subelement FE space P */
5981:   PetscInt           dim;   /* Spatial dimension */
5982:   PetscInt           comp;  /* Field components */
5983:   PetscInt          *subpoints;
5984:   PetscReal         *tmpB, *tmpD, *tmpH, *subpoint;
5985:   PetscInt           p, s, d, e, j, k;
5986:   PetscErrorCode     ierr;

5989:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
5990:   DMGetDimension(dm, &dim);
5991:   PetscSpaceGetDimension(fem->basisSpace, &spdim);
5992:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
5993:   PetscFEGetNumComponents(fem, &comp);
5994:   /* Divide points into subelements */
5995:   DMGetWorkArray(dm, npoints, PETSC_INT, &subpoints);
5996:   DMGetWorkArray(dm, dim, PETSC_REAL, &subpoint);
5997:   for (p = 0; p < npoints; ++p) {
5998:     for (s = 0; s < cmp->numSubelements; ++s) {
5999:       PetscBool inside;

6001:       /* Apply transform, and check that point is inside cell */
6002:       for (d = 0; d < dim; ++d) {
6003:         subpoint[d] = -1.0;
6004:         for (e = 0; e < dim; ++e) subpoint[d] += cmp->invjac[(s*dim + d)*dim+e]*(points[p*dim+e] - cmp->v0[s*dim+e]);
6005:       }
6006:       CellRefinerInCellTest_Internal(cmp->cellRefiner, subpoint, &inside);
6007:       if (inside) {subpoints[p] = s; break;}
6008:     }
6009:     if (s >= cmp->numSubelements) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %d was not found in any subelement", p);
6010:   }
6011:   DMRestoreWorkArray(dm, dim, PETSC_REAL, &subpoint);
6012:   /* Evaluate the prime basis functions at all points */
6013:   if (B) {DMGetWorkArray(dm, npoints*spdim, PETSC_REAL, &tmpB);}
6014:   if (D) {DMGetWorkArray(dm, npoints*spdim*dim, PETSC_REAL, &tmpD);}
6015:   if (H) {DMGetWorkArray(dm, npoints*spdim*dim*dim, PETSC_REAL, &tmpH);}
6016:   PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);
6017:   /* Translate to the nodal basis */
6018:   if (B) {PetscMemzero(B, npoints*pdim*comp * sizeof(PetscReal));}
6019:   if (D) {PetscMemzero(D, npoints*pdim*comp*dim * sizeof(PetscReal));}
6020:   if (H) {PetscMemzero(H, npoints*pdim*comp*dim*dim * sizeof(PetscReal));}
6021:   for (p = 0; p < npoints; ++p) {
6022:     const PetscInt s = subpoints[p];

6024:     if (B) {
6025:       /* Multiply by V^{-1} (spdim x spdim) */
6026:       for (j = 0; j < spdim; ++j) {
6027:         const PetscInt i = (p*pdim + cmp->embedding[s*spdim+j])*comp;
6028:         PetscInt       c;

6030:         B[i] = 0.0;
6031:         for (k = 0; k < spdim; ++k) {
6032:           B[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpB[p*spdim + k];
6033:         }
6034:         for (c = 1; c < comp; ++c) {
6035:           B[i+c] = B[i];
6036:         }
6037:       }
6038:     }
6039:     if (D) {
6040:       /* Multiply by V^{-1} (spdim x spdim) */
6041:       for (j = 0; j < spdim; ++j) {
6042:         for (d = 0; d < dim; ++d) {
6043:           const PetscInt i = ((p*pdim + cmp->embedding[s*spdim+j])*comp + 0)*dim + d;
6044:           PetscInt       c;

6046:           D[i] = 0.0;
6047:           for (k = 0; k < spdim; ++k) {
6048:             D[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpD[(p*spdim + k)*dim + d];
6049:           }
6050:           for (c = 1; c < comp; ++c) {
6051:             D[((p*pdim + cmp->embedding[s*spdim+j])*comp + c)*dim + d] = D[i];
6052:           }
6053:         }
6054:       }
6055:     }
6056:     if (H) {
6057:       /* Multiply by V^{-1} (pdim x pdim) */
6058:       for (j = 0; j < spdim; ++j) {
6059:         for (d = 0; d < dim*dim; ++d) {
6060:           const PetscInt i = ((p*pdim + cmp->embedding[s*spdim+j])*comp + 0)*dim*dim + d;
6061:           PetscInt       c;

6063:           H[i] = 0.0;
6064:           for (k = 0; k < spdim; ++k) {
6065:             H[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpH[(p*spdim + k)*dim*dim + d];
6066:           }
6067:           for (c = 1; c < comp; ++c) {
6068:             H[((p*pdim + cmp->embedding[s*spdim+j])*comp + c)*dim*dim + d] = H[i];
6069:           }
6070:         }
6071:       }
6072:     }
6073:   }
6074:   DMRestoreWorkArray(dm, npoints, PETSC_INT, &subpoints);
6075:   if (B) {DMRestoreWorkArray(dm, npoints*spdim, PETSC_REAL, &tmpB);}
6076:   if (D) {DMRestoreWorkArray(dm, npoints*spdim*dim, PETSC_REAL, &tmpD);}
6077:   if (H) {DMRestoreWorkArray(dm, npoints*spdim*dim*dim, PETSC_REAL, &tmpH);}
6078:   return(0);
6079: }

6083: PetscErrorCode PetscFEInitialize_Composite(PetscFE fem)
6084: {
6086:   fem->ops->setfromoptions          = NULL;
6087:   fem->ops->setup                   = PetscFESetUp_Composite;
6088:   fem->ops->view                    = NULL;
6089:   fem->ops->destroy                 = PetscFEDestroy_Composite;
6090:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
6091:   fem->ops->gettabulation           = PetscFEGetTabulation_Composite;
6092:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Basic;
6093:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Basic;
6094:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Basic */;
6095:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
6096:   return(0);
6097: }

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

6102:   Level: intermediate

6104: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
6105: M*/

6109: PETSC_EXTERN PetscErrorCode PetscFECreate_Composite(PetscFE fem)
6110: {
6111:   PetscFE_Composite *cmp;
6112:   PetscErrorCode     ierr;

6116:   PetscNewLog(fem, &cmp);
6117:   fem->data = cmp;

6119:   cmp->cellRefiner    = REFINER_NOOP;
6120:   cmp->numSubelements = -1;
6121:   cmp->v0             = NULL;
6122:   cmp->jac            = NULL;

6124:   PetscFEInitialize_Composite(fem);
6125:   return(0);
6126: }

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

6133:   Not collective

6135:   Input Parameter:
6136: . fem - The PetscFE object

6138:   Output Parameters:
6139: + blockSize - The number of elements in a block
6140: . numBlocks - The number of blocks in a batch
6141: . batchSize - The number of elements in a batch
6142: - numBatches - The number of batches in a chunk

6144:   Level: intermediate

6146: .seealso: PetscFECreate()
6147: @*/
6148: PetscErrorCode PetscFECompositeGetMapping(PetscFE fem, PetscInt *numSubelements, const PetscReal *v0[], const PetscReal *jac[], const PetscReal *invjac[])
6149: {
6150:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;

6158:   return(0);
6159: }

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

6166:   Not collective

6168:   Input Parameter:
6169: . fe - The PetscFE

6171:   Output Parameter:
6172: . dim - The dimension

6174:   Level: intermediate

6176: .seealso: PetscFECreate(), PetscSpaceGetDimension(), PetscDualSpaceGetDimension()
6177: @*/
6178: PetscErrorCode PetscFEGetDimension(PetscFE fem, PetscInt *dim)
6179: {

6185:   if (fem->ops->getdimension) {(*fem->ops->getdimension)(fem, dim);}
6186:   return(0);
6187: }

6189: /*
6190: Purpose: Compute element vector for chunk of elements

6192: Input:
6193:   Sizes:
6194:      Ne:  number of elements
6195:      Nf:  number of fields
6196:      PetscFE
6197:        dim: spatial dimension
6198:        Nb:  number of basis functions
6199:        Nc:  number of field components
6200:        PetscQuadrature
6201:          Nq:  number of quadrature points

6203:   Geometry:
6204:      PetscFECellGeom[Ne] possibly *Nq
6205:        PetscReal v0s[dim]
6206:        PetscReal n[dim]
6207:        PetscReal jacobians[dim*dim]
6208:        PetscReal jacobianInverses[dim*dim]
6209:        PetscReal jacobianDeterminants
6210:   FEM:
6211:      PetscFE
6212:        PetscQuadrature
6213:          PetscReal   quadPoints[Nq*dim]
6214:          PetscReal   quadWeights[Nq]
6215:        PetscReal   basis[Nq*Nb*Nc]
6216:        PetscReal   basisDer[Nq*Nb*Nc*dim]
6217:      PetscScalar coefficients[Ne*Nb*Nc]
6218:      PetscScalar elemVec[Ne*Nb*Nc]

6220:   Problem:
6221:      PetscInt f: the active field
6222:      f0, f1

6224:   Work Space:
6225:      PetscFE
6226:        PetscScalar f0[Nq*dim];
6227:        PetscScalar f1[Nq*dim*dim];
6228:        PetscScalar u[Nc];
6229:        PetscScalar gradU[Nc*dim];
6230:        PetscReal   x[dim];
6231:        PetscScalar realSpaceDer[dim];

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

6235: Input:
6236:   Sizes:
6237:      N_cb: Number of serial cell batches

6239:   Geometry:
6240:      PetscReal v0s[Ne*dim]
6241:      PetscReal jacobians[Ne*dim*dim]        possibly *Nq
6242:      PetscReal jacobianInverses[Ne*dim*dim] possibly *Nq
6243:      PetscReal jacobianDeterminants[Ne]     possibly *Nq
6244:   FEM:
6245:      static PetscReal   quadPoints[Nq*dim]
6246:      static PetscReal   quadWeights[Nq]
6247:      static PetscReal   basis[Nq*Nb*Nc]
6248:      static PetscReal   basisDer[Nq*Nb*Nc*dim]
6249:      PetscScalar coefficients[Ne*Nb*Nc]
6250:      PetscScalar elemVec[Ne*Nb*Nc]

6252: ex62.c:
6253:   PetscErrorCode PetscFEIntegrateResidualBatch(PetscInt Ne, PetscInt numFields, PetscInt field, PetscQuadrature quad[], const PetscScalar coefficients[],
6254:                                                const PetscReal v0s[], const PetscReal jacobians[], const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[],
6255:                                                void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f0[]),
6256:                                                void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f1[]), PetscScalar elemVec[])

6258: ex52.c:
6259:   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)
6260:   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)

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

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

6269: ex52_integrateElementOpenCL.c:
6270: PETSC_EXTERN PetscErrorCode IntegrateElementBatchGPU(PetscInt spatial_dim, PetscInt Ne, PetscInt Ncb, PetscInt Nbc, PetscInt N_bl, const PetscScalar coefficients[],
6271:                                                      const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscScalar elemVec[],
6272:                                                      PetscLogEvent event, PetscInt debug, PetscInt pde_op)

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

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

6282:   Not collective

6284:   Input Parameters:
6285: + fem          - The PetscFE object for the field being integrated
6286: . prob         - The PetscDS specifying the discretizations and continuum functions
6287: . field        - The field being integrated
6288: . Ne           - The number of elements in the chunk
6289: . cgeom        - The cell geometry for each cell in the chunk
6290: . coefficients - The array of FEM basis coefficients for the elements
6291: . probAux      - The PetscDS specifying the auxiliary discretizations
6292: - coefficientsAux - The array of FEM auxiliary basis coefficients for the elements

6294:   Output Parameter
6295: . integral     - the integral for this field

6297:   Level: developer

6299: .seealso: PetscFEIntegrateResidual()
6300: @*/
6301: PetscErrorCode PetscFEIntegrate(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
6302:                                 const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal integral[])
6303: {

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

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

6318:   Not collective

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

6332:   Output Parameter
6333: . elemVec      - the element residual vectors from each element

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

6343:   Level: developer

6345: .seealso: PetscFEIntegrateResidual()
6346: @*/
6347: PetscErrorCode PetscFEIntegrateResidual(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
6348:                                         const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
6349: {

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

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

6364:   Not collective

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

6378:   Output Parameter
6379: . elemVec      - the element residual vectors from each element

6381:   Level: developer

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

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

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

6401:   Not collective

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

6418:   Output Parameter
6419: . elemMat      - the element matrices for the Jacobian from each element

6421:   Note:
6422: $ Loop over batch of elements (e):
6423: $   Loop over element matrix entries (f,fc,g,gc --> i,j):
6424: $     Loop over quadrature points (q):
6425: $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
6426: $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
6427: $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6428: $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
6429: $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6430: */
6431: PetscErrorCode PetscFEIntegrateJacobian(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFECellGeom *cgeom,
6432:                                         const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
6433: {

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

6444: /*C
6445:   PetscFEIntegrateBdJacobian - Produce the boundary element Jacobian for a chunk of elements by quadrature integration

6447:   Not collective

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

6463:   Output Parameter
6464: . elemMat              - the element matrices for the Jacobian from each element

6466:   Note:
6467: $ Loop over batch of elements (e):
6468: $   Loop over element matrix entries (f,fc,g,gc --> i,j):
6469: $     Loop over quadrature points (q):
6470: $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
6471: $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
6472: $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6473: $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
6474: $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6475: */
6476: PetscErrorCode PetscFEIntegrateBdJacobian(PetscFE fem, PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEFaceGeom *fgeom,
6477:                                           const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
6478: {

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

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

6494:   Input Parameter:
6495: . fe - The initial PetscFE

6497:   Output Parameter:
6498: . feRef - The refined PetscFE

6500:   Level: developer

6502: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
6503: @*/
6504: PetscErrorCode PetscFERefine(PetscFE fe, PetscFE *feRef)
6505: {
6506:   PetscSpace       P, Pref;
6507:   PetscDualSpace   Q, Qref;
6508:   DM               K, Kref;
6509:   PetscQuadrature  q, qref;
6510:   const PetscReal *v0, *jac;
6511:   PetscInt         numComp, numSubelements;
6512:   PetscErrorCode   ierr;

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

6548: /*@
6549:   PetscFECreateDefault - Create a PetscFE for basic FEM computation

6551:   Collective on DM

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

6561:   Output Parameter:
6562: . fem - The PetscFE object

6564:   Level: beginner

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

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