Actual source code: dtfe.c

petsc-master 2017-01-20
Report Typos and Errors
  1: /* Basis Jet Tabulation

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

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

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

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

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

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

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

 22:    \alpha = V^{-1}

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

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

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

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

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

 55: PetscClassId PETSCSPACE_CLASSID = 0;

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

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

 63:   Not Collective

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

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

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

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

 87:   Level: advanced

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

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

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

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

105:   Collective on PetscSpace

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

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

114:   Level: intermediate

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

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

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

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

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

146:   Not Collective

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

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

154:   Level: intermediate

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

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

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

176:   Collective on PetscSpace

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

182:   Level: developer

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

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

201: /*@
202:   PetscSpaceSetFromOptions - sets parameters in a PetscSpace from the options database

204:   Collective on PetscSpace

206:   Input Parameter:
207: . sp - the PetscSpace object to set options for

209:   Options Database:
210: . -petscspace_order the approximation order of the space

212:   Level: developer

214: .seealso PetscSpaceView()
215: @*/
216: PetscErrorCode PetscSpaceSetFromOptions(PetscSpace sp)
217: {
218:   const char    *defaultType;
219:   char           name[256];
220:   PetscBool      flg;

225:   if (!((PetscObject) sp)->type_name) {
226:     defaultType = PETSCSPACEPOLYNOMIAL;
227:   } else {
228:     defaultType = ((PetscObject) sp)->type_name;
229:   }
230:   if (!PetscSpaceRegisterAllCalled) {PetscSpaceRegisterAll();}

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

250: /*@C
251:   PetscSpaceSetUp - Construct data structures for the PetscSpace

253:   Collective on PetscSpace

255:   Input Parameter:
256: . sp - the PetscSpace object to setup

258:   Level: developer

260: .seealso PetscSpaceView(), PetscSpaceDestroy()
261: @*/
262: PetscErrorCode PetscSpaceSetUp(PetscSpace sp)
263: {

268:   if (sp->ops->setup) {(*sp->ops->setup)(sp);}
269:   return(0);
270: }

272: /*@
273:   PetscSpaceDestroy - Destroys a PetscSpace object

275:   Collective on PetscSpace

277:   Input Parameter:
278: . sp - the PetscSpace object to destroy

280:   Level: developer

282: .seealso PetscSpaceView()
283: @*/
284: PetscErrorCode PetscSpaceDestroy(PetscSpace *sp)
285: {

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

292:   if (--((PetscObject)(*sp))->refct > 0) {*sp = 0; return(0);}
293:   ((PetscObject) (*sp))->refct = 0;
294:   DMDestroy(&(*sp)->dm);

296:   (*(*sp)->ops->destroy)(*sp);
297:   PetscHeaderDestroy(sp);
298:   return(0);
299: }

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

304:   Collective on MPI_Comm

306:   Input Parameter:
307: . comm - The communicator for the PetscSpace object

309:   Output Parameter:
310: . sp - The PetscSpace object

312:   Level: beginner

314: .seealso: PetscSpaceSetType(), PETSCSPACEPOLYNOMIAL
315: @*/
316: PetscErrorCode PetscSpaceCreate(MPI_Comm comm, PetscSpace *sp)
317: {
318:   PetscSpace     s;

323:   PetscCitationsRegister(FECitation,&FEcite);
324:   *sp  = NULL;
325:   PetscFEInitializePackage();

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

329:   s->order = 0;
330:   DMShellCreate(comm, &s->dm);

332:   *sp = s;
333:   return(0);
334: }

336: /* Dimension of the space, i.e. number of basis vectors */
337: PetscErrorCode PetscSpaceGetDimension(PetscSpace sp, PetscInt *dim)
338: {

344:   *dim = 0;
345:   if (sp->ops->getdimension) {(*sp->ops->getdimension)(sp, dim);}
346:   return(0);
347: }

349: /*@
350:   PetscSpaceGetOrder - Return the order of approximation for this space

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

355:   Output Parameter:
356: . order - The approximation order

358:   Level: intermediate

360: .seealso: PetscSpaceSetOrder(), PetscSpaceCreate(), PetscSpace
361: @*/
362: PetscErrorCode PetscSpaceGetOrder(PetscSpace sp, PetscInt *order)
363: {
367:   *order = sp->order;
368:   return(0);
369: }

371: /*@
372:   PetscSpaceSetOrder - Set the order of approximation for this space

374:   Input Parameters:
375: + sp - The PetscSpace
376: - order - The approximation order

378:   Level: intermediate

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

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

393:   Input Parameters:
394: + sp      - The PetscSpace
395: . npoints - The number of evaluation points
396: - points  - The point coordinates

398:   Output Parameters:
399: + B - The function evaluations in a npoints x nfuncs array
400: . D - The derivative evaluations in a npoints x nfuncs x dim array
401: - H - The second derivative evaluations in a npoints x nfuncs x dim x dim array

403:   Level: advanced

405: .seealso: PetscFEGetTabulation(), PetscFEGetDefaultTabulation(), PetscSpaceCreate()
406: @*/
407: PetscErrorCode PetscSpaceEvaluate(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
408: {

417:   if (sp->ops->evaluate) {(*sp->ops->evaluate)(sp, npoints, points, B, D, H);}
418:   return(0);
419: }

421: PetscErrorCode PetscSpaceSetFromOptions_Polynomial(PetscOptionItems *PetscOptionsObject,PetscSpace sp)
422: {
423:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
424:   PetscErrorCode   ierr;

427:   PetscOptionsHead(PetscOptionsObject,"PetscSpace polynomial options");
428:   PetscOptionsInt("-petscspace_poly_num_variables", "The number of different variables, e.g. x and y", "PetscSpacePolynomialSetNumVariables", poly->numVariables, &poly->numVariables, NULL);
429:   PetscOptionsBool("-petscspace_poly_sym", "Use only symmetric polynomials", "PetscSpacePolynomialSetSymmetric", poly->symmetric, &poly->symmetric, NULL);
430:   PetscOptionsBool("-petscspace_poly_tensor", "Use the tensor product polynomials", "PetscSpacePolynomialSetTensor", poly->tensor, &poly->tensor, NULL);
431:   PetscOptionsTail();
432:   return(0);
433: }

435: static PetscErrorCode PetscSpacePolynomialView_Ascii(PetscSpace sp, PetscViewer viewer)
436: {
437:   PetscSpace_Poly  *poly = (PetscSpace_Poly *) sp->data;
438:   PetscViewerFormat format;
439:   PetscErrorCode    ierr;

442:   PetscViewerGetFormat(viewer, &format);
443:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
444:     if (poly->tensor) {PetscViewerASCIIPrintf(viewer, "Tensor polynomial space in %d variables of order %d\n", poly->numVariables, sp->order);}
445:     else              {PetscViewerASCIIPrintf(viewer, "Polynomial space in %d variables of order %d\n", poly->numVariables, sp->order);}
446:   } else {
447:     if (poly->tensor) {PetscViewerASCIIPrintf(viewer, "Tensor polynomial space in %d variables of order %d\n", poly->numVariables, sp->order);}
448:     else              {PetscViewerASCIIPrintf(viewer, "Polynomial space in %d variables of order %d\n", poly->numVariables, sp->order);}
449:   }
450:   return(0);
451: }

453: PetscErrorCode PetscSpaceView_Polynomial(PetscSpace sp, PetscViewer viewer)
454: {
455:   PetscBool      iascii;

461:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
462:   if (iascii) {PetscSpacePolynomialView_Ascii(sp, viewer);}
463:   return(0);
464: }

466: PetscErrorCode PetscSpaceSetUp_Polynomial(PetscSpace sp)
467: {
468:   PetscSpace_Poly *poly    = (PetscSpace_Poly *) sp->data;
469:   PetscInt         ndegree = sp->order+1;
470:   PetscInt         deg;
471:   PetscErrorCode   ierr;

474:   PetscMalloc1(ndegree, &poly->degrees);
475:   for (deg = 0; deg < ndegree; ++deg) poly->degrees[deg] = deg;
476:   return(0);
477: }

479: PetscErrorCode PetscSpaceDestroy_Polynomial(PetscSpace sp)
480: {
481:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
482:   PetscErrorCode   ierr;

485:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", NULL);
486:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialSetTensor_C", NULL);
487:   PetscFree(poly->degrees);
488:   PetscFree(poly);
489:   return(0);
490: }

492: PetscErrorCode PetscSpaceGetDimension_Polynomial(PetscSpace sp, PetscInt *dim)
493: {
494:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
495:   PetscInt         deg  = sp->order;
496:   PetscInt         n    = poly->numVariables, i;
497:   PetscReal        D    = 1.0;

500:   if (poly->tensor) {
501:     *dim = 1;
502:     for (i = 0; i < n; ++i) *dim *= (deg+1);
503:   } else {
504:     for (i = 1; i <= n; ++i) {
505:       D *= ((PetscReal) (deg+i))/i;
506:     }
507:     *dim = (PetscInt) (D + 0.5);
508:   }
509:   return(0);
510: }

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

515:   Input Parameters:
516: + len - The length of the tuple
517: . sum - The sum of all entries in the tuple
518: - ind - The current multi-index of the tuple, initialized to the 0 tuple

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

524:   Level: developer

526: .seealso: 
527: */
528: static PetscErrorCode LatticePoint_Internal(PetscInt len, PetscInt sum, PetscInt ind[], PetscInt tup[])
529: {
530:   PetscInt       i;

534:   if (len == 1) {
535:     ind[0] = -1;
536:     tup[0] = sum;
537:   } else if (sum == 0) {
538:     for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
539:   } else {
540:     tup[0] = sum - ind[0];
541:     LatticePoint_Internal(len-1, ind[0], &ind[1], &tup[1]);
542:     if (ind[1] < 0) {
543:       if (ind[0] == sum) {ind[0] = -1;}
544:       else               {ind[1] = 0; ++ind[0];}
545:     }
546:   }
547:   return(0);
548: }

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

555:   Input Parameters:
556: + len - The length of the tuple
557: . max - The maximum sum
558: - tup - A tuple of length len+1: tup[len] > 0 indicates a stopping condition

560:   Output Parameter:
561: . tup - A tuple of len integers whos sum is at most 'max'
562: */
563: static PetscErrorCode LatticePointLexicographic_Internal(PetscInt len, PetscInt max, PetscInt tup[])
564: {
566:   while (len--) {
567:     max -= tup[len];
568:     if (!max) {
569:       tup[len] = 0;
570:       break;
571:     }
572:   }
573:   tup[++len]++;
574:   return(0);
575: }

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

580:   Input Parameters:
581: + len - The length of the tuple
582: . max - The max for all entries in the tuple
583: - ind - The current multi-index of the tuple, initialized to the 0 tuple

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

589:   Level: developer

591: .seealso: 
592: */
593: static PetscErrorCode TensorPoint_Internal(PetscInt len, PetscInt max, PetscInt ind[], PetscInt tup[])
594: {
595:   PetscInt       i;

599:   if (len == 1) {
600:     tup[0] = ind[0]++;
601:     ind[0] = ind[0] >= max ? -1 : ind[0];
602:   } else if (max == 0) {
603:     for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
604:   } else {
605:     tup[0] = ind[0];
606:     TensorPoint_Internal(len-1, max, &ind[1], &tup[1]);
607:     if (ind[1] < 0) {
608:       ind[1] = 0;
609:       if (ind[0] == max-1) {ind[0] = -1;}
610:       else                 {++ind[0];}
611:     }
612:   }
613:   return(0);
614: }

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

621:   Input Parameters:
622: + len - The length of the tuple
623: . max - The maximum value
624: - tup - A tuple of length len+1: tup[len] > 0 indicates a stopping condition

626:   Output Parameter:
627: . tup - A tuple of len integers whos sum is at most 'max'
628: */
629: static PetscErrorCode TensorPointLexicographic_Internal(PetscInt len, PetscInt max, PetscInt tup[])
630: {
631:   PetscInt       i;

634:   for (i = 0; i < len; i++) {
635:     if (tup[i] < max) {
636:       break;
637:     } else {
638:       tup[i] = 0;
639:     }
640:   }
641:   tup[i]++;
642:   return(0);
643: }

645: PetscErrorCode PetscSpaceEvaluate_Polynomial(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
646: {
647:   PetscSpace_Poly *poly    = (PetscSpace_Poly *) sp->data;
648:   DM               dm      = sp->dm;
649:   PetscInt         ndegree = sp->order+1;
650:   PetscInt        *degrees = poly->degrees;
651:   PetscInt         dim     = poly->numVariables;
652:   PetscReal       *lpoints, *tmp, *LB, *LD, *LH;
653:   PetscInt        *ind, *tup;
654:   PetscInt         pdim, d, der, i, p, deg, o;
655:   PetscErrorCode   ierr;

658:   PetscSpaceGetDimension(sp, &pdim);
659:   DMGetWorkArray(dm, npoints, PETSC_REAL, &lpoints);
660:   DMGetWorkArray(dm, npoints*ndegree*3, PETSC_REAL, &tmp);
661:   if (B) {DMGetWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LB);}
662:   if (D) {DMGetWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LD);}
663:   if (H) {DMGetWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LH);}
664:   for (d = 0; d < dim; ++d) {
665:     for (p = 0; p < npoints; ++p) {
666:       lpoints[p] = points[p*dim+d];
667:     }
668:     PetscDTLegendreEval(npoints, lpoints, ndegree, degrees, tmp, &tmp[1*npoints*ndegree], &tmp[2*npoints*ndegree]);
669:     /* LB, LD, LH (ndegree * dim x npoints) */
670:     for (deg = 0; deg < ndegree; ++deg) {
671:       for (p = 0; p < npoints; ++p) {
672:         if (B) LB[(deg*dim + d)*npoints + p] = tmp[(0*npoints + p)*ndegree+deg];
673:         if (D) LD[(deg*dim + d)*npoints + p] = tmp[(1*npoints + p)*ndegree+deg];
674:         if (H) LH[(deg*dim + d)*npoints + p] = tmp[(2*npoints + p)*ndegree+deg];
675:       }
676:     }
677:   }
678:   /* Multiply by A (pdim x ndegree * dim) */
679:   PetscMalloc2(dim,&ind,dim,&tup);
680:   if (B) {
681:     /* B (npoints x pdim) */
682:     if (poly->tensor) {
683:       i = 0;
684:       PetscMemzero(ind, dim * sizeof(PetscInt));
685:       while (ind[0] >= 0) {
686:         TensorPoint_Internal(dim, sp->order+1, ind, tup);
687:         for (p = 0; p < npoints; ++p) {
688:           B[p*pdim + i] = 1.0;
689:           for (d = 0; d < dim; ++d) {
690:             B[p*pdim + i] *= LB[(tup[d]*dim + d)*npoints + p];
691:           }
692:         }
693:         ++i;
694:       }
695:     } else {
696:       i = 0;
697:       for (o = 0; o <= sp->order; ++o) {
698:         PetscMemzero(ind, dim * sizeof(PetscInt));
699:         while (ind[0] >= 0) {
700:           LatticePoint_Internal(dim, o, ind, tup);
701:           for (p = 0; p < npoints; ++p) {
702:             B[p*pdim + i] = 1.0;
703:             for (d = 0; d < dim; ++d) {
704:               B[p*pdim + i] *= LB[(tup[d]*dim + d)*npoints + p];
705:             }
706:           }
707:           ++i;
708:         }
709:       }
710:     }
711:   }
712:   if (D) {
713:     /* D (npoints x pdim x dim) */
714:     if (poly->tensor) {
715:       i = 0;
716:       PetscMemzero(ind, dim * sizeof(PetscInt));
717:       while (ind[0] >= 0) {
718:         TensorPoint_Internal(dim, sp->order+1, ind, tup);
719:         for (p = 0; p < npoints; ++p) {
720:           for (der = 0; der < dim; ++der) {
721:             D[(p*pdim + i)*dim + der] = 1.0;
722:             for (d = 0; d < dim; ++d) {
723:               if (d == der) {
724:                 D[(p*pdim + i)*dim + der] *= LD[(tup[d]*dim + d)*npoints + p];
725:               } else {
726:                 D[(p*pdim + i)*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
727:               }
728:             }
729:           }
730:         }
731:         ++i;
732:       }
733:     } else {
734:       i = 0;
735:       for (o = 0; o <= sp->order; ++o) {
736:         PetscMemzero(ind, dim * sizeof(PetscInt));
737:         while (ind[0] >= 0) {
738:           LatticePoint_Internal(dim, o, ind, tup);
739:           for (p = 0; p < npoints; ++p) {
740:             for (der = 0; der < dim; ++der) {
741:               D[(p*pdim + i)*dim + der] = 1.0;
742:               for (d = 0; d < dim; ++d) {
743:                 if (d == der) {
744:                   D[(p*pdim + i)*dim + der] *= LD[(tup[d]*dim + d)*npoints + p];
745:                 } else {
746:                   D[(p*pdim + i)*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
747:                 }
748:               }
749:             }
750:           }
751:           ++i;
752:         }
753:       }
754:     }
755:   }
756:   if (H) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Too lazy to code second derivatives");
757:   PetscFree2(ind,tup);
758:   if (B) {DMRestoreWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LB);}
759:   if (D) {DMRestoreWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LD);}
760:   if (H) {DMRestoreWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LH);}
761:   DMRestoreWorkArray(dm, npoints*ndegree*3, PETSC_REAL, &tmp);
762:   DMRestoreWorkArray(dm, npoints, PETSC_REAL, &lpoints);
763:   return(0);
764: }

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

771:   Input Parameters:
772: + sp     - the function space object
773: - tensor - PETSC_TRUE for a tensor polynomial space, PETSC_FALSE for a polynomial space

775:   Level: beginner

777: .seealso: PetscSpacePolynomialGetTensor(), PetscSpaceSetOrder(), PetscSpacePolynomialSetNumVariables()
778: @*/
779: PetscErrorCode PetscSpacePolynomialSetTensor(PetscSpace sp, PetscBool tensor)
780: {

785:   PetscTryMethod(sp,"PetscSpacePolynomialSetTensor_C",(PetscSpace,PetscBool),(sp,tensor));
786:   return(0);
787: }

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

794:   Input Parameters:
795: . sp     - the function space object

797:   Output Parameters:
798: . tensor - PETSC_TRUE for a tensor polynomial space, PETSC_FALSE for a polynomial space

800:   Level: beginner

802: .seealso: PetscSpacePolynomialSetTensor(), PetscSpaceSetOrder(), PetscSpacePolynomialSetNumVariables()
803: @*/
804: PetscErrorCode PetscSpacePolynomialGetTensor(PetscSpace sp, PetscBool *tensor)
805: {

811:   PetscTryMethod(sp,"PetscSpacePolynomialGetTensor_C",(PetscSpace,PetscBool*),(sp,tensor));
812:   return(0);
813: }

815: static PetscErrorCode PetscSpacePolynomialSetTensor_Polynomial(PetscSpace sp, PetscBool tensor)
816: {
817:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

820:   poly->tensor = tensor;
821:   return(0);
822: }

824: static PetscErrorCode PetscSpacePolynomialGetTensor_Polynomial(PetscSpace sp, PetscBool *tensor)
825: {
826:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

831:   *tensor = poly->tensor;
832:   return(0);
833: }

835: PetscErrorCode PetscSpaceInitialize_Polynomial(PetscSpace sp)
836: {

840:   sp->ops->setfromoptions = PetscSpaceSetFromOptions_Polynomial;
841:   sp->ops->setup          = PetscSpaceSetUp_Polynomial;
842:   sp->ops->view           = PetscSpaceView_Polynomial;
843:   sp->ops->destroy        = PetscSpaceDestroy_Polynomial;
844:   sp->ops->getdimension   = PetscSpaceGetDimension_Polynomial;
845:   sp->ops->evaluate       = PetscSpaceEvaluate_Polynomial;
846:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", PetscSpacePolynomialGetTensor_Polynomial);
847:   PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialSetTensor_C", PetscSpacePolynomialSetTensor_Polynomial);
848:   return(0);
849: }

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

854:   Level: intermediate

856: .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
857: M*/

859: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_Polynomial(PetscSpace sp)
860: {
861:   PetscSpace_Poly *poly;
862:   PetscErrorCode   ierr;

866:   PetscNewLog(sp,&poly);
867:   sp->data = poly;

869:   poly->numVariables = 0;
870:   poly->symmetric    = PETSC_FALSE;
871:   poly->tensor       = PETSC_FALSE;
872:   poly->degrees      = NULL;

874:   PetscSpaceInitialize_Polynomial(sp);
875:   return(0);
876: }

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

884:   poly->symmetric = sym;
885:   return(0);
886: }

888: PetscErrorCode PetscSpacePolynomialGetSymmetric(PetscSpace sp, PetscBool *sym)
889: {
890:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

895:   *sym = poly->symmetric;
896:   return(0);
897: }

899: PetscErrorCode PetscSpacePolynomialSetNumVariables(PetscSpace sp, PetscInt n)
900: {
901:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

905:   poly->numVariables = n;
906:   return(0);
907: }

909: PetscErrorCode PetscSpacePolynomialGetNumVariables(PetscSpace sp, PetscInt *n)
910: {
911:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

916:   *n = poly->numVariables;
917:   return(0);
918: }

920: PetscErrorCode PetscSpaceSetFromOptions_DG(PetscOptionItems *PetscOptionsObject,PetscSpace sp)
921: {
922:   PetscSpace_DG *dg = (PetscSpace_DG *) sp->data;

926:   PetscOptionsHead(PetscOptionsObject,"PetscSpace DG options");
927:   PetscOptionsInt("-petscspace_dg_num_variables", "The number of different variables, e.g. x and y", "PetscSpaceDGSetNumVariables", dg->numVariables, &dg->numVariables, NULL);
928:   PetscOptionsTail();
929:   return(0);
930: }

932: PetscErrorCode PetscSpaceDGView_Ascii(PetscSpace sp, PetscViewer viewer)
933: {
934:   PetscSpace_DG    *dg = (PetscSpace_DG *) sp->data;
935:   PetscViewerFormat format;
936:   PetscErrorCode    ierr;

939:   PetscViewerGetFormat(viewer, &format);
940:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
941:     PetscViewerASCIIPrintf(viewer, "DG space in dimension %d:\n", dg->numVariables);
942:     PetscViewerASCIIPushTab(viewer);
943:     PetscQuadratureView(dg->quad, viewer);
944:     PetscViewerASCIIPopTab(viewer);
945:   } else {
946:     PetscViewerASCIIPrintf(viewer, "DG space in dimension %d on %d points\n", dg->numVariables, dg->quad->numPoints);
947:   }
948:   return(0);
949: }

951: PetscErrorCode PetscSpaceView_DG(PetscSpace sp, PetscViewer viewer)
952: {
953:   PetscBool      iascii;

959:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
960:   if (iascii) {PetscSpaceDGView_Ascii(sp, viewer);}
961:   return(0);
962: }

964: PetscErrorCode PetscSpaceSetUp_DG(PetscSpace sp)
965: {
966:   PetscSpace_DG *dg = (PetscSpace_DG *) sp->data;

970:   if (!dg->quad->points && sp->order) {
971:     PetscDTGaussJacobiQuadrature(dg->numVariables, sp->order, -1.0, 1.0, &dg->quad);
972:   }
973:   return(0);
974: }

976: PetscErrorCode PetscSpaceDestroy_DG(PetscSpace sp)
977: {
978:   PetscSpace_DG *dg = (PetscSpace_DG *) sp->data;

982:   PetscQuadratureDestroy(&dg->quad);
983:   return(0);
984: }

986: PetscErrorCode PetscSpaceGetDimension_DG(PetscSpace sp, PetscInt *dim)
987: {
988:   PetscSpace_DG *dg = (PetscSpace_DG *) sp->data;

991:   *dim = dg->quad->numPoints;
992:   return(0);
993: }

995: PetscErrorCode PetscSpaceEvaluate_DG(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
996: {
997:   PetscSpace_DG *dg  = (PetscSpace_DG *) sp->data;
998:   PetscInt       dim = dg->numVariables, d, p;

1002:   if (D || H) SETERRQ(PetscObjectComm((PetscObject) sp), PETSC_ERR_SUP, "Cannot calculate derivatives for a DG space");
1003:   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);
1004:   PetscMemzero(B, npoints*npoints * sizeof(PetscReal));
1005:   for (p = 0; p < npoints; ++p) {
1006:     for (d = 0; d < dim; ++d) {
1007:       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]);
1008:     }
1009:     B[p*npoints+p] = 1.0;
1010:   }
1011:   return(0);
1012: }

1014: PetscErrorCode PetscSpaceInitialize_DG(PetscSpace sp)
1015: {
1017:   sp->ops->setfromoptions = PetscSpaceSetFromOptions_DG;
1018:   sp->ops->setup          = PetscSpaceSetUp_DG;
1019:   sp->ops->view           = PetscSpaceView_DG;
1020:   sp->ops->destroy        = PetscSpaceDestroy_DG;
1021:   sp->ops->getdimension   = PetscSpaceGetDimension_DG;
1022:   sp->ops->evaluate       = PetscSpaceEvaluate_DG;
1023:   return(0);
1024: }

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

1029:   Level: intermediate

1031: .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
1032: M*/

1034: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_DG(PetscSpace sp)
1035: {
1036:   PetscSpace_DG *dg;

1041:   PetscNewLog(sp,&dg);
1042:   sp->data = dg;

1044:   dg->numVariables    = 0;
1045:   dg->quad->dim       = 0;
1046:   dg->quad->numPoints = 0;
1047:   dg->quad->points    = NULL;
1048:   dg->quad->weights   = NULL;

1050:   PetscSpaceInitialize_DG(sp);
1051:   return(0);
1052: }


1055: PetscClassId PETSCDUALSPACE_CLASSID = 0;

1057: PetscFunctionList PetscDualSpaceList              = NULL;
1058: PetscBool         PetscDualSpaceRegisterAllCalled = PETSC_FALSE;

1060: /*@C
1061:   PetscDualSpaceRegister - Adds a new PetscDualSpace implementation

1063:   Not Collective

1065:   Input Parameters:
1066: + name        - The name of a new user-defined creation routine
1067: - create_func - The creation routine itself

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

1072:   Sample usage:
1073: .vb
1074:     PetscDualSpaceRegister("my_space", MyPetscDualSpaceCreate);
1075: .ve

1077:   Then, your PetscDualSpace type can be chosen with the procedural interface via
1078: .vb
1079:     PetscDualSpaceCreate(MPI_Comm, PetscDualSpace *);
1080:     PetscDualSpaceSetType(PetscDualSpace, "my_dual_space");
1081: .ve
1082:    or at runtime via the option
1083: .vb
1084:     -petscdualspace_type my_dual_space
1085: .ve

1087:   Level: advanced

1089: .keywords: PetscDualSpace, register
1090: .seealso: PetscDualSpaceRegisterAll(), PetscDualSpaceRegisterDestroy()

1092: @*/
1093: PetscErrorCode PetscDualSpaceRegister(const char sname[], PetscErrorCode (*function)(PetscDualSpace))
1094: {

1098:   PetscFunctionListAdd(&PetscDualSpaceList, sname, function);
1099:   return(0);
1100: }

1102: /*@C
1103:   PetscDualSpaceSetType - Builds a particular PetscDualSpace

1105:   Collective on PetscDualSpace

1107:   Input Parameters:
1108: + sp   - The PetscDualSpace object
1109: - name - The kind of space

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

1114:   Level: intermediate

1116: .keywords: PetscDualSpace, set, type
1117: .seealso: PetscDualSpaceGetType(), PetscDualSpaceCreate()
1118: @*/
1119: PetscErrorCode PetscDualSpaceSetType(PetscDualSpace sp, PetscDualSpaceType name)
1120: {
1121:   PetscErrorCode (*r)(PetscDualSpace);
1122:   PetscBool      match;

1127:   PetscObjectTypeCompare((PetscObject) sp, name, &match);
1128:   if (match) return(0);

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

1134:   if (sp->ops->destroy) {
1135:     (*sp->ops->destroy)(sp);
1136:     sp->ops->destroy = NULL;
1137:   }
1138:   (*r)(sp);
1139:   PetscObjectChangeTypeName((PetscObject) sp, name);
1140:   return(0);
1141: }

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

1146:   Not Collective

1148:   Input Parameter:
1149: . sp  - The PetscDualSpace

1151:   Output Parameter:
1152: . name - The PetscDualSpace type name

1154:   Level: intermediate

1156: .keywords: PetscDualSpace, get, type, name
1157: .seealso: PetscDualSpaceSetType(), PetscDualSpaceCreate()
1158: @*/
1159: PetscErrorCode PetscDualSpaceGetType(PetscDualSpace sp, PetscDualSpaceType *name)
1160: {

1166:   if (!PetscDualSpaceRegisterAllCalled) {
1167:     PetscDualSpaceRegisterAll();
1168:   }
1169:   *name = ((PetscObject) sp)->type_name;
1170:   return(0);
1171: }

1173: /*@
1174:   PetscDualSpaceView - Views a PetscDualSpace

1176:   Collective on PetscDualSpace

1178:   Input Parameter:
1179: + sp - the PetscDualSpace object to view
1180: - v  - the viewer

1182:   Level: developer

1184: .seealso PetscDualSpaceDestroy()
1185: @*/
1186: PetscErrorCode PetscDualSpaceView(PetscDualSpace sp, PetscViewer v)
1187: {

1192:   if (!v) {
1193:     PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) sp), &v);
1194:   }
1195:   if (sp->ops->view) {
1196:     (*sp->ops->view)(sp, v);
1197:   }
1198:   return(0);
1199: }

1201: /*@
1202:   PetscDualSpaceSetFromOptions - sets parameters in a PetscDualSpace from the options database

1204:   Collective on PetscDualSpace

1206:   Input Parameter:
1207: . sp - the PetscDualSpace object to set options for

1209:   Options Database:
1210: . -petscspace_order the approximation order of the space

1212:   Level: developer

1214: .seealso PetscDualSpaceView()
1215: @*/
1216: PetscErrorCode PetscDualSpaceSetFromOptions(PetscDualSpace sp)
1217: {
1218:   const char    *defaultType;
1219:   char           name[256];
1220:   PetscBool      flg;

1225:   if (!((PetscObject) sp)->type_name) {
1226:     defaultType = PETSCDUALSPACELAGRANGE;
1227:   } else {
1228:     defaultType = ((PetscObject) sp)->type_name;
1229:   }
1230:   if (!PetscSpaceRegisterAllCalled) {PetscSpaceRegisterAll();}

1232:   PetscObjectOptionsBegin((PetscObject) sp);
1233:   PetscOptionsFList("-petscdualspace_type", "Dual space", "PetscDualSpaceSetType", PetscDualSpaceList, defaultType, name, 256, &flg);
1234:   if (flg) {
1235:     PetscDualSpaceSetType(sp, name);
1236:   } else if (!((PetscObject) sp)->type_name) {
1237:     PetscDualSpaceSetType(sp, defaultType);
1238:   }
1239:   PetscOptionsInt("-petscdualspace_order", "The approximation order", "PetscDualSpaceSetOrder", sp->order, &sp->order, NULL);
1240:   if (sp->ops->setfromoptions) {
1241:     (*sp->ops->setfromoptions)(PetscOptionsObject,sp);
1242:   }
1243:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
1244:   PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) sp);
1245:   PetscOptionsEnd();
1246:   PetscDualSpaceViewFromOptions(sp, NULL, "-petscdualspace_view");
1247:   return(0);
1248: }

1250: /*@
1251:   PetscDualSpaceSetUp - Construct a basis for the PetscDualSpace

1253:   Collective on PetscDualSpace

1255:   Input Parameter:
1256: . sp - the PetscDualSpace object to setup

1258:   Level: developer

1260: .seealso PetscDualSpaceView(), PetscDualSpaceDestroy()
1261: @*/
1262: PetscErrorCode PetscDualSpaceSetUp(PetscDualSpace sp)
1263: {

1268:   if (sp->setupcalled) return(0);
1269:   sp->setupcalled = PETSC_TRUE;
1270:   if (sp->ops->setup) {(*sp->ops->setup)(sp);}
1271:   return(0);
1272: }

1274: /*@
1275:   PetscDualSpaceDestroy - Destroys a PetscDualSpace object

1277:   Collective on PetscDualSpace

1279:   Input Parameter:
1280: . sp - the PetscDualSpace object to destroy

1282:   Level: developer

1284: .seealso PetscDualSpaceView()
1285: @*/
1286: PetscErrorCode PetscDualSpaceDestroy(PetscDualSpace *sp)
1287: {
1288:   PetscInt       dim, f;

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

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

1298:   PetscDualSpaceGetDimension(*sp, &dim);
1299:   for (f = 0; f < dim; ++f) {
1300:     PetscQuadratureDestroy(&(*sp)->functional[f]);
1301:   }
1302:   PetscFree((*sp)->functional);
1303:   DMDestroy(&(*sp)->dm);

1305:   if ((*sp)->ops->destroy) {(*(*sp)->ops->destroy)(*sp);}
1306:   PetscHeaderDestroy(sp);
1307:   return(0);
1308: }

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

1313:   Collective on MPI_Comm

1315:   Input Parameter:
1316: . comm - The communicator for the PetscDualSpace object

1318:   Output Parameter:
1319: . sp - The PetscDualSpace object

1321:   Level: beginner

1323: .seealso: PetscDualSpaceSetType(), PETSCDUALSPACELAGRANGE
1324: @*/
1325: PetscErrorCode PetscDualSpaceCreate(MPI_Comm comm, PetscDualSpace *sp)
1326: {
1327:   PetscDualSpace s;

1332:   PetscCitationsRegister(FECitation,&FEcite);
1333:   *sp  = NULL;
1334:   PetscFEInitializePackage();

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

1338:   s->order = 0;
1339:   s->setupcalled = PETSC_FALSE;

1341:   *sp = s;
1342:   return(0);
1343: }

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

1348:   Collective on PetscDualSpace

1350:   Input Parameter:
1351: . sp - The original PetscDualSpace

1353:   Output Parameter:
1354: . spNew - The duplicate PetscDualSpace

1356:   Level: beginner

1358: .seealso: PetscDualSpaceCreate(), PetscDualSpaceSetType()
1359: @*/
1360: PetscErrorCode PetscDualSpaceDuplicate(PetscDualSpace sp, PetscDualSpace *spNew)
1361: {

1367:   (*sp->ops->duplicate)(sp, spNew);
1368:   return(0);
1369: }

1371: /*@
1372:   PetscDualSpaceGetDM - Get the DM representing the reference cell

1374:   Not collective

1376:   Input Parameter:
1377: . sp - The PetscDualSpace

1379:   Output Parameter:
1380: . dm - The reference cell

1382:   Level: intermediate

1384: .seealso: PetscDualSpaceSetDM(), PetscDualSpaceCreate()
1385: @*/
1386: PetscErrorCode PetscDualSpaceGetDM(PetscDualSpace sp, DM *dm)
1387: {
1391:   *dm = sp->dm;
1392:   return(0);
1393: }

1395: /*@
1396:   PetscDualSpaceSetDM - Get the DM representing the reference cell

1398:   Not collective

1400:   Input Parameters:
1401: + sp - The PetscDualSpace
1402: - dm - The reference cell

1404:   Level: intermediate

1406: .seealso: PetscDualSpaceGetDM(), PetscDualSpaceCreate()
1407: @*/
1408: PetscErrorCode PetscDualSpaceSetDM(PetscDualSpace sp, DM dm)
1409: {

1415:   DMDestroy(&sp->dm);
1416:   PetscObjectReference((PetscObject) dm);
1417:   sp->dm = dm;
1418:   return(0);
1419: }

1421: /*@
1422:   PetscDualSpaceGetOrder - Get the order of the dual space

1424:   Not collective

1426:   Input Parameter:
1427: . sp - The PetscDualSpace

1429:   Output Parameter:
1430: . order - The order

1432:   Level: intermediate

1434: .seealso: PetscDualSpaceSetOrder(), PetscDualSpaceCreate()
1435: @*/
1436: PetscErrorCode PetscDualSpaceGetOrder(PetscDualSpace sp, PetscInt *order)
1437: {
1441:   *order = sp->order;
1442:   return(0);
1443: }

1445: /*@
1446:   PetscDualSpaceSetOrder - Set the order of the dual space

1448:   Not collective

1450:   Input Parameters:
1451: + sp - The PetscDualSpace
1452: - order - The order

1454:   Level: intermediate

1456: .seealso: PetscDualSpaceGetOrder(), PetscDualSpaceCreate()
1457: @*/
1458: PetscErrorCode PetscDualSpaceSetOrder(PetscDualSpace sp, PetscInt order)
1459: {
1462:   sp->order = order;
1463:   return(0);
1464: }

1466: /*@
1467:   PetscDualSpaceLagrangeGetTensor - Get the tensor nature of the dual space

1469:   Not collective

1471:   Input Parameter:
1472: . sp - The PetscDualSpace

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

1477:   Level: intermediate

1479: .seealso: PetscDualSpaceLagrangeSetTensor(), PetscDualSpaceCreate()
1480: @*/
1481: PetscErrorCode PetscDualSpaceLagrangeGetTensor(PetscDualSpace sp, PetscBool *tensor)
1482: {

1488:   PetscTryMethod(sp,"PetscDualSpaceLagrangeGetTensor_C",(PetscDualSpace,PetscBool *),(sp,tensor));
1489:   return(0);
1490: }

1492: /*@
1493:   PetscDualSpaceLagrangeSetTensor - Set the tensor nature of the dual space

1495:   Not collective

1497:   Input Parameters:
1498: + sp - The PetscDualSpace
1499: - tensor - Whether the dual space has tensor layout (vs. simplicial)

1501:   Level: intermediate

1503: .seealso: PetscDualSpaceLagrangeGetTensor(), PetscDualSpaceCreate()
1504: @*/
1505: PetscErrorCode PetscDualSpaceLagrangeSetTensor(PetscDualSpace sp, PetscBool tensor)
1506: {

1511:   PetscTryMethod(sp,"PetscDualSpaceLagrangeSetTensor_C",(PetscDualSpace,PetscBool),(sp,tensor));
1512:   return(0);
1513: }

1515: /*@
1516:   PetscDualSpaceGetFunctional - Get the i-th basis functional in the dual space

1518:   Not collective

1520:   Input Parameters:
1521: + sp - The PetscDualSpace
1522: - i  - The basis number

1524:   Output Parameter:
1525: . functional - The basis functional

1527:   Level: intermediate

1529: .seealso: PetscDualSpaceGetDimension(), PetscDualSpaceCreate()
1530: @*/
1531: PetscErrorCode PetscDualSpaceGetFunctional(PetscDualSpace sp, PetscInt i, PetscQuadrature *functional)
1532: {
1533:   PetscInt       dim;

1539:   PetscDualSpaceGetDimension(sp, &dim);
1540:   if ((i < 0) || (i >= dim)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Functional index %d must be in [0, %d)", i, dim);
1541:   *functional = sp->functional[i];
1542:   return(0);
1543: }

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

1548:   Not collective

1550:   Input Parameter:
1551: . sp - The PetscDualSpace

1553:   Output Parameter:
1554: . dim - The dimension

1556:   Level: intermediate

1558: .seealso: PetscDualSpaceGetFunctional(), PetscDualSpaceCreate()
1559: @*/
1560: PetscErrorCode PetscDualSpaceGetDimension(PetscDualSpace sp, PetscInt *dim)
1561: {

1567:   *dim = 0;
1568:   if (sp->ops->getdimension) {(*sp->ops->getdimension)(sp, dim);}
1569:   return(0);
1570: }

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

1575:   Not collective

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

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

1583:   Level: intermediate

1585: .seealso: PetscDualSpaceGetFunctional(), PetscDualSpaceCreate()
1586: @*/
1587: PetscErrorCode PetscDualSpaceGetNumDof(PetscDualSpace sp, const PetscInt **numDof)
1588: {

1594:   (*sp->ops->getnumdof)(sp, numDof);
1595:   if (!*numDof) SETERRQ(PetscObjectComm((PetscObject) sp), PETSC_ERR_LIB, "Empty numDof[] returned from dual space implementation");
1596:   return(0);
1597: }

1599: /*@
1600:   PetscDualSpaceCreateReferenceCell - Create a DMPLEX with the appropriate FEM reference cell

1602:   Collective on PetscDualSpace

1604:   Input Parameters:
1605: + sp      - The PetscDualSpace
1606: . dim     - The spatial dimension
1607: - simplex - Flag for simplex, otherwise use a tensor-product cell

1609:   Output Parameter:
1610: . refdm - The reference cell

1612:   Level: advanced

1614: .keywords: PetscDualSpace, reference cell
1615: .seealso: PetscDualSpaceCreate(), DMPLEX
1616: @*/
1617: PetscErrorCode PetscDualSpaceCreateReferenceCell(PetscDualSpace sp, PetscInt dim, PetscBool simplex, DM *refdm)
1618: {

1622:   DMPlexCreateReferenceCell(PetscObjectComm((PetscObject) sp), dim, simplex, refdm);
1623:   return(0);
1624: }

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

1629:   Input Parameters:
1630: + sp      - The PetscDualSpace object
1631: . f       - The basis functional index
1632: . time    - The time
1633: . cgeom   - A context with geometric information for this cell, we use v0 (the initial vertex) and J (the Jacobian)
1634: . numComp - The number of components for the function
1635: . func    - The input function
1636: - ctx     - A context for the function

1638:   Output Parameter:
1639: . value   - numComp output values

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

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

1646:   Level: developer

1648: .seealso: PetscDualSpaceCreate()
1649: @*/
1650: 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)
1651: {
1652:   DM               dm;
1653:   PetscQuadrature  quad;
1654:   PetscReal        x[3];
1655:   PetscScalar     *val;
1656:   PetscInt         dim, q, c;
1657:   PetscErrorCode   ierr;

1662:   dim  = cgeom->dim;
1663:   PetscDualSpaceGetDM(sp, &dm);
1664:   PetscDualSpaceGetFunctional(sp, f, &quad);
1665:   DMGetWorkArray(dm, numComp, PETSC_SCALAR, &val);
1666:   for (c = 0; c < numComp; ++c) value[c] = 0.0;
1667:   for (q = 0; q < quad->numPoints; ++q) {
1668:     CoordinatesRefToReal(cgeom->dimEmbed, dim, cgeom->v0, cgeom->J, &quad->points[q*dim], x);
1669:     (*func)(cgeom->dimEmbed, time, x, numComp, val, ctx);
1670:     for (c = 0; c < numComp; ++c) {
1671:       value[c] += val[c]*quad->weights[q];
1672:     }
1673:   }
1674:   DMRestoreWorkArray(dm, numComp, PETSC_SCALAR, &val);
1675:   return(0);
1676: }

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

1681:   Input Parameters:
1682: + sp      - The PetscDualSpace object
1683: . f       - The basis functional index
1684: . time    - The time
1685: . cgeom   - A context with geometric information for this cell, we currently just use the centroid
1686: . numComp - The number of components for the function
1687: . func    - The input function
1688: - ctx     - A context for the function

1690:   Output Parameter:
1691: . value   - numComp output values

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

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

1698:   Level: developer

1700: .seealso: PetscDualSpaceCreate()
1701: @*/
1702: 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)
1703: {
1704:   DM               dm;
1705:   PetscQuadrature  quad;
1706:   PetscScalar     *val;
1707:   PetscInt         dimEmbed, q, c;
1708:   PetscErrorCode   ierr;

1713:   PetscDualSpaceGetDM(sp, &dm);
1714:   DMGetCoordinateDim(dm, &dimEmbed);
1715:   PetscDualSpaceGetFunctional(sp, f, &quad);
1716:   DMGetWorkArray(dm, numComp, PETSC_SCALAR, &val);
1717:   for (c = 0; c < numComp; ++c) value[c] = 0.0;
1718:   for (q = 0; q < quad->numPoints; ++q) {
1719:     (*func)(dimEmbed, time, cgeom->centroid, numComp, val, ctx);
1720:     for (c = 0; c < numComp; ++c) {
1721:       value[c] += val[c]*quad->weights[q];
1722:     }
1723:   }
1724:   DMRestoreWorkArray(dm, numComp, PETSC_SCALAR, &val);
1725:   return(0);
1726: }

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

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

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

1737:   Not collective

1739:   Input Parameters:
1740: + sp - the PetscDualSpace object
1741: - height - the height of the mesh point for which the subspace is desired

1743:   Output Parameters:
1744:   bdsp - the subspace: must be destroyed by the user

1746:   Level: advanced

1748: .seealso: PetscDualSpace
1749: @*/
1750: PetscErrorCode PetscDualSpaceGetHeightSubspace(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
1751: {

1757:   *bdsp = NULL;
1758:   if (sp->ops->getheightsubspace) {
1759:     (*sp->ops->getheightsubspace)(sp,height,bdsp);
1760:   }
1761:   return(0);
1762: }

1764: static PetscErrorCode PetscDualSpaceLagrangeGetTensor_Lagrange(PetscDualSpace sp, PetscBool *tensor)
1765: {
1766:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;

1769:   *tensor = lag->tensorSpace;
1770:   return(0);
1771: }

1773: static PetscErrorCode PetscDualSpaceLagrangeSetTensor_Lagrange(PetscDualSpace sp, PetscBool tensor)
1774: {
1775:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;

1778:   lag->tensorSpace = tensor;
1779:   return(0);
1780: }

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

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

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

1789:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
1790:   PetscInt           dim, order, p;
1791:   PetscErrorCode     ierr;

1794:   PetscDualSpaceGetOrder(sp,&order);
1795:   DMGetDimension(sp->dm,&dim);
1796:   if (!dim || !lag->continuous || order < 3) return(0);
1797:   if (dim > 3) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Lagrange symmetries not implemented for dim = %D > 3",dim);
1798:   if (!lag->symmetries) { /* store symmetries */
1799:     PetscDualSpace hsp;
1800:     DM             K;
1801:     PetscInt       numPoints = 1, d;
1802:     PetscInt       numFaces;
1803:     PetscInt       ***symmetries;
1804:     const PetscInt ***hsymmetries;

1806:     if (lag->simplexCell) {
1807:       numFaces = 1 + dim;
1808:       for (d = 0; d < dim; d++) numPoints = numPoints * 2 + 1;
1809:     }
1810:     else {
1811:       numPoints = PetscPowInt(3,dim);
1812:       numFaces  = 2 * dim;
1813:     }
1814:     PetscCalloc1(numPoints,&symmetries);
1815:     if (0 < dim && dim < 3) { /* compute self symmetries */
1816:       PetscInt **cellSymmetries;

1818:       lag->numSelfSym = 2 * numFaces;
1819:       lag->selfSymOff = numFaces;
1820:       PetscCalloc1(2*numFaces,&cellSymmetries);
1821:       /* we want to be able to index symmetries directly with the orientations, which range from [-numFaces,numFaces) */
1822:       symmetries[0] = &cellSymmetries[numFaces];
1823:       if (dim == 1) {
1824:         PetscInt dofPerEdge = order - 1;

1826:         if (dofPerEdge > 1) {
1827:           PetscInt i, *reverse;

1829:           PetscMalloc1(dofPerEdge,&reverse);
1830:           for (i = 0; i < dofPerEdge; i++) reverse[i] = (dofPerEdge - 1 - i);
1831:           symmetries[0][-2] = reverse;

1833:           /* yes, this is redundant, but it makes it easier to cleanup if I don't have to worry about what not to free */
1834:           PetscMalloc1(dofPerEdge,&reverse);
1835:           for (i = 0; i < dofPerEdge; i++) reverse[i] = (dofPerEdge - 1 - i);
1836:           symmetries[0][1] = reverse;
1837:         }
1838:       } else {
1839:         PetscInt dofPerEdge = lag->simplexCell ? (order - 2) : (order - 1), s;

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

1845:             if (!s) continue;
1846:             if (lag->simplexCell) {
1847:               PetscMalloc1((dofPerEdge * (dofPerEdge + 1))/2,&sym);
1848:               for (j = 0, l = 0; j < dofPerEdge; j++) {
1849:                 for (k = 0; k < dofPerEdge - j; k++, l++) {
1850:                   i = dofPerEdge - 1 - j - k;
1851:                   switch (s) {
1852:                   case -3:
1853:                     sym[l] = BaryIndex(dofPerEdge,i,k,j);
1854:                     break;
1855:                   case -2:
1856:                     sym[l] = BaryIndex(dofPerEdge,j,i,k);
1857:                     break;
1858:                   case -1:
1859:                     sym[l] = BaryIndex(dofPerEdge,k,j,i);
1860:                     break;
1861:                   case 1:
1862:                     sym[l] = BaryIndex(dofPerEdge,k,i,j);
1863:                     break;
1864:                   case 2:
1865:                     sym[l] = BaryIndex(dofPerEdge,j,k,i);
1866:                     break;
1867:                   }
1868:                 }
1869:               }
1870:             } else {
1871:               PetscMalloc1(dofPerEdge * dofPerEdge,&sym);
1872:               for (j = 0, l = 0; j < dofPerEdge; j++) {
1873:                 for (k = 0; k < dofPerEdge; k++, l++) {
1874:                   switch (s) {
1875:                   case -4:
1876:                     sym[l] = CartIndex(dofPerEdge,k,j);
1877:                     break;
1878:                   case -3:
1879:                     sym[l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - j),k);
1880:                     break;
1881:                   case -2:
1882:                     sym[l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - k),(dofPerEdge - 1 - j));
1883:                     break;
1884:                   case -1:
1885:                     sym[l] = CartIndex(dofPerEdge,j,(dofPerEdge - 1 - k));
1886:                     break;
1887:                   case 1:
1888:                     sym[l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - k),j);
1889:                     break;
1890:                   case 2:
1891:                     sym[l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - j),(dofPerEdge - 1 - k));
1892:                     break;
1893:                   case 3:
1894:                     sym[l] = CartIndex(dofPerEdge,k,(dofPerEdge - 1 - j));
1895:                     break;
1896:                   }
1897:                 }
1898:               }
1899:             }
1900:             symmetries[0][s] = sym;
1901:           }
1902:         }
1903:       }
1904:     }
1905:     PetscDualSpaceGetHeightSubspace(sp,1,&hsp);
1906:     PetscDualSpaceGetSymmetries(hsp,&hsymmetries,NULL);
1907:     if (hsymmetries) {
1908:       PetscBool      *seen;
1909:       const PetscInt *cone;
1910:       PetscInt       KclosureSize, *Kclosure = NULL;

1912:       PetscDualSpaceGetDM(sp,&K);
1913:       PetscCalloc1(numPoints,&seen);
1914:       DMPlexGetCone(K,0,&cone);
1915:       DMPlexGetTransitiveClosure(K,0,PETSC_TRUE,&KclosureSize,&Kclosure);
1916:       for (p = 0; p < numFaces; p++) {
1917:         PetscInt closureSize, *closure = NULL, q;

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

1923:           if(!seen[point]) {
1924:             for (r = 0; r < KclosureSize; r++) {
1925:               if (Kclosure[2 * r] == point) break;
1926:             }
1927:             seen[point] = PETSC_TRUE;
1928:             symmetries[r] = (PetscInt **) hsymmetries[q];
1929:           }
1930:         }
1931:         DMPlexRestoreTransitiveClosure(K,cone[p],PETSC_TRUE,&closureSize,&closure);
1932:       }
1933:       DMPlexRestoreTransitiveClosure(K,0,PETSC_TRUE,&KclosureSize,&Kclosure);
1934:       PetscFree(seen);
1935:     }
1936:     lag->symmetries = symmetries;
1937:   }
1938:   if (perms) *perms = (const PetscInt ***) lag->symmetries;
1939:   return(0);
1940: }

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

1948:   if (perms) {
1950:     *perms = NULL;
1951:   }
1952:   if (flips) {
1954:     *flips = NULL;
1955:   }
1956:   if (sp->ops->getsymmetries) {
1957:     (sp->ops->getsymmetries)(sp,perms,flips);
1958:   }
1959:   return(0);
1960: }

1962: static PetscErrorCode PetscDualSpaceGetDimension_SingleCell_Lagrange(PetscDualSpace sp, PetscInt order, PetscInt *dim)
1963: {
1964:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
1965:   PetscReal           D   = 1.0;
1966:   PetscInt            n, i;
1967:   PetscErrorCode      ierr;

1970:   *dim = -1;                    /* Ensure that the compiler knows *dim is set. */
1971:   DMGetDimension(sp->dm, &n);
1972:   if (!lag->tensorSpace) {
1973:     for (i = 1; i <= n; ++i) {
1974:       D *= ((PetscReal) (order+i))/i;
1975:     }
1976:     *dim = (PetscInt) (D + 0.5);
1977:   } else {
1978:     *dim = 1;
1979:     for (i = 0; i < n; ++i) *dim *= (order+1);
1980:   }
1981:   return(0);
1982: }

1984: static PetscErrorCode PetscDualSpaceCreateHeightSubspace_Lagrange(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
1985: {
1986:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
1987:   PetscBool          continuous, tensor;
1988:   PetscInt           order;
1989:   PetscErrorCode     ierr;

1994:   PetscDualSpaceLagrangeGetContinuity(sp,&continuous);
1995:   PetscDualSpaceGetOrder(sp,&order);
1996:   if (height == 0) {
1997:     PetscObjectReference((PetscObject)sp);
1998:     *bdsp = sp;
1999:   }
2000:   else if (continuous == PETSC_FALSE || !order) {
2001:     *bdsp = NULL;
2002:   }
2003:   else {
2004:     DM dm, K;
2005:     PetscInt dim;

2007:     PetscDualSpaceGetDM(sp,&dm);
2008:     DMGetDimension(dm,&dim);
2009:     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);}
2010:     PetscDualSpaceDuplicate(sp,bdsp);
2011:     PetscDualSpaceCreateReferenceCell(*bdsp, dim-height, lag->simplexCell, &K);
2012:     PetscDualSpaceSetDM(*bdsp, K);
2013:     DMDestroy(&K);
2014:     PetscDualSpaceLagrangeGetTensor(sp,&tensor);
2015:     PetscDualSpaceLagrangeSetTensor(*bdsp,tensor);
2016:     PetscDualSpaceSetUp(*bdsp);
2017:   }
2018:   return(0);
2019: }

2021: PetscErrorCode PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp)
2022: {
2023:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2024:   DM                  dm    = sp->dm;
2025:   PetscInt            order = sp->order;
2026:   PetscBool           continuous;
2027:   PetscSection        csection;
2028:   Vec                 coordinates;
2029:   PetscReal          *qpoints, *qweights;
2030:   PetscInt            depth, dim, pdimMax, pStart, pEnd, p, *pStratStart, *pStratEnd, coneSize, d, f = 0;
2031:   PetscBool           simplex, tensorSpace;
2032:   PetscErrorCode      ierr;

2035:   /* Classify element type */
2036:   if (!order) lag->continuous = PETSC_FALSE;
2037:   continuous = lag->continuous;
2038:   DMGetDimension(dm, &dim);
2039:   DMPlexGetDepth(dm, &depth);
2040:   DMPlexGetChart(dm, &pStart, &pEnd);
2041:   PetscCalloc1(dim+1, &lag->numDof);
2042:   PetscMalloc2(depth+1,&pStratStart,depth+1,&pStratEnd);
2043:   for (d = 0; d <= depth; ++d) {DMPlexGetDepthStratum(dm, d, &pStratStart[d], &pStratEnd[d]);}
2044:   DMPlexGetConeSize(dm, pStratStart[depth], &coneSize);
2045:   DMGetCoordinateSection(dm, &csection);
2046:   DMGetCoordinatesLocal(dm, &coordinates);
2047:   if (depth == 1) {
2048:     if      (coneSize == dim+1)    simplex = PETSC_TRUE;
2049:     else if (coneSize == 1 << dim) simplex = PETSC_FALSE;
2050:     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
2051:   }
2052:   else if (depth == dim) {
2053:     if      (coneSize == dim+1)   simplex = PETSC_TRUE;
2054:     else if (coneSize == 2 * dim) simplex = PETSC_FALSE;
2055:     else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
2056:   }
2057:   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support cell-vertex meshes or interpolated meshes");
2058:   lag->simplexCell = simplex;
2059:   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");
2060:   tensorSpace    = lag->tensorSpace;
2061:   lag->height    = 0;
2062:   lag->subspaces = NULL;
2063:   if (continuous && sp->order > 0 && dim > 0) {
2064:     PetscInt i;

2066:     lag->height = dim;
2067:     PetscMalloc1(dim,&lag->subspaces);
2068:     PetscDualSpaceCreateHeightSubspace_Lagrange(sp,1,&lag->subspaces[0]);
2069:     PetscDualSpaceSetUp(lag->subspaces[0]);
2070:     for (i = 1; i < dim; i++) {
2071:       PetscDualSpaceGetHeightSubspace(lag->subspaces[i-1],1,&lag->subspaces[i]);
2072:       PetscObjectReference((PetscObject)(lag->subspaces[i]));
2073:     }
2074:   }
2075:   PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, sp->order, &pdimMax);
2076:   pdimMax *= (pStratEnd[depth] - pStratStart[depth]);
2077:   PetscMalloc1(pdimMax, &sp->functional);
2078:   if (!dim) {
2079:     PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2080:     PetscMalloc1(1, &qweights);
2081:     PetscQuadratureSetOrder(sp->functional[f], 0);
2082:     PetscQuadratureSetData(sp->functional[f], 0, 1, NULL, qweights);
2083:     qweights[0] = 1.0;
2084:     ++f;
2085:     lag->numDof[0] = 1;
2086:   } else {
2087:     PetscInt     *tup;
2088:     PetscReal    *v0, *hv0, *J, *invJ, detJ, hdetJ;
2089:     PetscSection section;

2091:     PetscSectionCreate(PETSC_COMM_SELF,&section);
2092:     PetscSectionSetChart(section,pStart,pEnd);
2093:     PetscCalloc5(dim+1,&tup,dim,&v0,dim,&hv0,dim*dim,&J,dim*dim,&invJ);
2094:     for (p = pStart; p < pEnd; p++) {
2095:       PetscInt       pointDim, d, nFunc = 0;
2096:       PetscDualSpace hsp;

2098:       DMPlexComputeCellGeometryFEM(dm, p, NULL, v0, J, invJ, &detJ);
2099:       for (d = 0; d < depth; d++) {if (p >= pStratStart[d] && p < pStratEnd[d]) break;}
2100:       pointDim = (depth == 1 && d == 1) ? dim : d;
2101:       hsp = ((pointDim < dim) && lag->subspaces) ? lag->subspaces[dim - pointDim - 1] : NULL;
2102:       if (hsp) {
2103:         PetscDualSpace_Lag *hlag = (PetscDualSpace_Lag *) hsp->data;
2104:         DM                 hdm;

2106:         PetscDualSpaceGetDM(hsp,&hdm);
2107:         DMPlexComputeCellGeometryFEM(hdm, 0, NULL, hv0, NULL, NULL, &hdetJ);
2108:         lag->numDof[pointDim] = nFunc = hlag->numDof[pointDim];
2109:       }
2110:       if (pointDim == dim) {
2111:         /* Cells, create for self */
2112:         PetscInt     orderEff = continuous ? (!tensorSpace ? order-1-dim : order-2) : order;
2113:         PetscReal    denom    = continuous ? order : (!tensorSpace ? order+1+dim : order+2);
2114:         PetscReal    numer    = (!simplex || !tensorSpace) ? 2. : (2./dim);
2115:         PetscReal    dx = numer/denom;
2116:         PetscInt     cdim, d, d2;

2118:         if (orderEff < 0) continue;
2119:         PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, orderEff, &cdim);

2121:         PetscMemzero(tup,(dim+1)*sizeof(PetscInt));
2122:         if (!tensorSpace) {
2123:           while (!tup[dim]) {
2124:             PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2125:             PetscMalloc1(dim, &qpoints);
2126:             PetscMalloc1(1,   &qweights);
2127:             PetscQuadratureSetOrder(sp->functional[f], 0);
2128:             PetscQuadratureSetData(sp->functional[f], dim, 1, qpoints, qweights);
2129:             for (d = 0; d < dim; ++d) {
2130:               qpoints[d] = v0[d];
2131:               for (d2 = 0; d2 < dim; ++d2) qpoints[d] += J[d*dim+d2]*((tup[d2]+1)*dx);
2132:             }
2133:             qweights[0] = 1.0;
2134:             ++f;
2135:             LatticePointLexicographic_Internal(dim, orderEff, tup);
2136:           }
2137:         } else {
2138:           while (!tup[dim]) {
2139:             PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2140:             PetscMalloc1(dim, &qpoints);
2141:             PetscMalloc1(1,   &qweights);
2142:             PetscQuadratureSetOrder(sp->functional[f], 0);
2143:             PetscQuadratureSetData(sp->functional[f], dim, 1, qpoints, qweights);
2144:             for (d = 0; d < dim; ++d) {
2145:               qpoints[d] = v0[d];
2146:               for (d2 = 0; d2 < dim; ++d2) qpoints[d] += J[d*dim+d2]*((tup[d2]+1)*dx);
2147:             }
2148:             qweights[0] = 1.0;
2149:             ++f;
2150:             TensorPointLexicographic_Internal(dim, orderEff, tup);
2151:           }
2152:         }
2153:         lag->numDof[dim] = cdim;
2154:       } else { /* transform functionals from subspaces */
2155:         PetscInt q;

2157:         for (q = 0; q < nFunc; q++, f++) {
2158:           PetscQuadrature fn;
2159:           PetscInt        fdim, nPoints, i;
2160:           const PetscReal *points;
2161:           const PetscReal *weights;
2162:           PetscReal       *qpoints;
2163:           PetscReal       *qweights;

2165:           PetscDualSpaceGetFunctional(hsp, q, &fn);
2166:           PetscQuadratureGetData(fn,&fdim,&nPoints,&points,&weights);
2167:           if (fdim != pointDim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expected height dual space dim %D, got %D",pointDim,fdim);
2168:           PetscMalloc1(nPoints * dim, &qpoints);
2169:           PetscMalloc1(nPoints, &qweights);
2170:           for (i = 0; i < nPoints; i++) {
2171:             PetscInt  j, k;
2172:             PetscReal *qp = &qpoints[i * dim];

2174:             qweights[i] = weights[i];
2175:             for (j = 0; j < dim; j++) qp[j] = v0[j];
2176:             for (j = 0; j < dim; j++) {
2177:               for (k = 0; k < pointDim; k++) qp[j] += J[dim * j + k] * (points[pointDim * i + k] - hv0[k]);
2178:             }
2179:           }
2180:           PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2181:           PetscQuadratureSetOrder(sp->functional[f],0);
2182:           PetscQuadratureSetData(sp->functional[f],dim,nPoints,qpoints,qweights);
2183:         }
2184:       }
2185:       PetscSectionSetDof(section,p,lag->numDof[pointDim]);
2186:     }
2187:     PetscFree5(tup,v0,hv0,J,invJ);
2188:     PetscSectionSetUp(section);
2189:     { /* reorder to closure order */
2190:       PetscInt *key, count;
2191:       PetscQuadrature *reorder = NULL;

2193:       PetscCalloc1(f,&key);
2194:       PetscMalloc1(f,&reorder);

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

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

2203:           PetscSectionGetDof(section,point,&dof);
2204:           PetscSectionGetOffset(section,point,&off);
2205:           for (i = 0; i < dof; i++) {
2206:             PetscInt fi = i + off;
2207:             if (!key[fi]) {
2208:               key[fi] = 1;
2209:               reorder[count++] = sp->functional[fi];
2210:             }
2211:           }
2212:         }
2213:         DMPlexRestoreTransitiveClosure(dm,p,PETSC_TRUE,&closureSize,&closure);
2214:       }
2215:       PetscFree(sp->functional);
2216:       sp->functional = reorder;
2217:       PetscFree(key);
2218:     }
2219:     PetscSectionDestroy(&section);
2220:   }
2221:   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);
2222:   PetscFree2(pStratStart,pStratEnd);
2223:   if (f > pdimMax) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of dual basis vectors %d is greater than dimension %d", f, pdimMax);
2224:   return(0);
2225: }

2227: PetscErrorCode PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp)
2228: {
2229:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2230:   PetscInt            i;
2231:   PetscErrorCode      ierr;

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

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

2240:       for (i = 0; i < lag->numSelfSym; i++) {
2241:         PetscFree(allocated[i]);
2242:       }
2243:       PetscFree(allocated);
2244:     }
2245:     PetscFree(lag->symmetries);
2246:   }
2247:   for (i = 0; i < lag->height; i++) {
2248:     PetscDualSpaceDestroy(&lag->subspaces[i]);
2249:   }
2250:   PetscFree(lag->subspaces);
2251:   PetscFree(lag->numDof);
2252:   PetscFree(lag);
2253:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", NULL);
2254:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", NULL);
2255:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", NULL);
2256:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", NULL);
2257:   return(0);
2258: }

2260: PetscErrorCode PetscDualSpaceDuplicate_Lagrange(PetscDualSpace sp, PetscDualSpace *spNew)
2261: {
2262:   PetscInt       order;
2263:   PetscBool      cont, tensor;

2267:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) sp), spNew);
2268:   PetscDualSpaceSetType(*spNew, PETSCDUALSPACELAGRANGE);
2269:   PetscDualSpaceGetOrder(sp, &order);
2270:   PetscDualSpaceSetOrder(*spNew, order);
2271:   PetscDualSpaceLagrangeGetContinuity(sp, &cont);
2272:   PetscDualSpaceLagrangeSetContinuity(*spNew, cont);
2273:   PetscDualSpaceLagrangeGetTensor(sp, &tensor);
2274:   PetscDualSpaceLagrangeSetTensor(*spNew, tensor);
2275:   return(0);
2276: }

2278: PetscErrorCode PetscDualSpaceSetFromOptions_Lagrange(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp)
2279: {
2280:   PetscBool      continuous, tensor, flg;

2284:   PetscDualSpaceLagrangeGetContinuity(sp, &continuous);
2285:   PetscDualSpaceLagrangeGetTensor(sp, &tensor);
2286:   PetscOptionsHead(PetscOptionsObject,"PetscDualSpace Lagrange Options");
2287:   PetscOptionsBool("-petscdualspace_lagrange_continuity", "Flag for continuous element", "PetscDualSpaceLagrangeSetContinuity", continuous, &continuous, &flg);
2288:   if (flg) {PetscDualSpaceLagrangeSetContinuity(sp, continuous);}
2289:   PetscOptionsBool("-petscdualspace_lagrange_tensor", "Flag for tensor dual space", "PetscDualSpaceLagrangeSetContinuity", tensor, &tensor, &flg);
2290:   if (flg) {PetscDualSpaceLagrangeSetTensor(sp, tensor);}
2291:   PetscOptionsTail();
2292:   return(0);
2293: }

2295: PetscErrorCode PetscDualSpaceGetDimension_Lagrange(PetscDualSpace sp, PetscInt *dim)
2296: {
2297:   DM              K;
2298:   const PetscInt *numDof;
2299:   PetscInt        spatialDim, Nc, size = 0, d;
2300:   PetscErrorCode  ierr;

2303:   PetscDualSpaceGetDM(sp, &K);
2304:   PetscDualSpaceGetNumDof(sp, &numDof);
2305:   DMGetDimension(K, &spatialDim);
2306:   DMPlexGetHeightStratum(K, 0, NULL, &Nc);
2307:   if (Nc == 1) {PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, sp->order, dim); return(0);}
2308:   for (d = 0; d <= spatialDim; ++d) {
2309:     PetscInt pStart, pEnd;

2311:     DMPlexGetDepthStratum(K, d, &pStart, &pEnd);
2312:     size += (pEnd-pStart)*numDof[d];
2313:   }
2314:   *dim = size;
2315:   return(0);
2316: }

2318: PetscErrorCode PetscDualSpaceGetNumDof_Lagrange(PetscDualSpace sp, const PetscInt **numDof)
2319: {
2320:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

2323:   *numDof = lag->numDof;
2324:   return(0);
2325: }

2327: static PetscErrorCode PetscDualSpaceLagrangeGetContinuity_Lagrange(PetscDualSpace sp, PetscBool *continuous)
2328: {
2329:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

2334:   *continuous = lag->continuous;
2335:   return(0);
2336: }

2338: static PetscErrorCode PetscDualSpaceLagrangeSetContinuity_Lagrange(PetscDualSpace sp, PetscBool continuous)
2339: {
2340:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

2344:   lag->continuous = continuous;
2345:   return(0);
2346: }

2348: /*@
2349:   PetscDualSpaceLagrangeGetContinuity - Retrieves the flag for element continuity

2351:   Not Collective

2353:   Input Parameter:
2354: . sp         - the PetscDualSpace

2356:   Output Parameter:
2357: . continuous - flag for element continuity

2359:   Level: intermediate

2361: .keywords: PetscDualSpace, Lagrange, continuous, discontinuous
2362: .seealso: PetscDualSpaceLagrangeSetContinuity()
2363: @*/
2364: PetscErrorCode PetscDualSpaceLagrangeGetContinuity(PetscDualSpace sp, PetscBool *continuous)
2365: {

2371:   PetscTryMethod(sp, "PetscDualSpaceLagrangeGetContinuity_C", (PetscDualSpace,PetscBool*),(sp,continuous));
2372:   return(0);
2373: }

2375: /*@
2376:   PetscDualSpaceLagrangeSetContinuity - Indicate whether the element is continuous

2378:   Logically Collective on PetscDualSpace

2380:   Input Parameters:
2381: + sp         - the PetscDualSpace
2382: - continuous - flag for element continuity

2384:   Options Database:
2385: . -petscdualspace_lagrange_continuity <bool>

2387:   Level: intermediate

2389: .keywords: PetscDualSpace, Lagrange, continuous, discontinuous
2390: .seealso: PetscDualSpaceLagrangeGetContinuity()
2391: @*/
2392: PetscErrorCode PetscDualSpaceLagrangeSetContinuity(PetscDualSpace sp, PetscBool continuous)
2393: {

2399:   PetscTryMethod(sp, "PetscDualSpaceLagrangeSetContinuity_C", (PetscDualSpace,PetscBool),(sp,continuous));
2400:   return(0);
2401: }

2403: PetscErrorCode PetscDualSpaceGetHeightSubspace_Lagrange(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
2404: {
2405:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2406:   PetscErrorCode     ierr;

2411:   if (height == 0) {
2412:     *bdsp = sp;
2413:   }
2414:   else {
2415:     DM dm;
2416:     PetscInt dim;

2418:     PetscDualSpaceGetDM(sp,&dm);
2419:     DMGetDimension(dm,&dim);
2420:     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);}
2421:     if (height <= lag->height) {
2422:       *bdsp = lag->subspaces[height-1];
2423:     }
2424:     else {
2425:       *bdsp = NULL;
2426:     }
2427:   }
2428:   return(0);
2429: }

2431: PetscErrorCode PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp)
2432: {
2434:   sp->ops->setfromoptions    = PetscDualSpaceSetFromOptions_Lagrange;
2435:   sp->ops->setup             = PetscDualSpaceSetUp_Lagrange;
2436:   sp->ops->view              = NULL;
2437:   sp->ops->destroy           = PetscDualSpaceDestroy_Lagrange;
2438:   sp->ops->duplicate         = PetscDualSpaceDuplicate_Lagrange;
2439:   sp->ops->getdimension      = PetscDualSpaceGetDimension_Lagrange;
2440:   sp->ops->getnumdof         = PetscDualSpaceGetNumDof_Lagrange;
2441:   sp->ops->getheightsubspace = PetscDualSpaceGetHeightSubspace_Lagrange;
2442:   sp->ops->getsymmetries     = PetscDualSpaceGetSymmetries_Lagrange;
2443:   return(0);
2444: }

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

2449:   Level: intermediate

2451: .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
2452: M*/

2454: PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Lagrange(PetscDualSpace sp)
2455: {
2456:   PetscDualSpace_Lag *lag;
2457:   PetscErrorCode      ierr;

2461:   PetscNewLog(sp,&lag);
2462:   sp->data = lag;

2464:   lag->numDof      = NULL;
2465:   lag->simplexCell = PETSC_TRUE;
2466:   lag->tensorSpace = PETSC_FALSE;
2467:   lag->continuous  = PETSC_TRUE;

2469:   PetscDualSpaceInitialize_Lagrange(sp);
2470:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", PetscDualSpaceLagrangeGetContinuity_Lagrange);
2471:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", PetscDualSpaceLagrangeSetContinuity_Lagrange);
2472:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", PetscDualSpaceLagrangeGetTensor_Lagrange);
2473:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", PetscDualSpaceLagrangeSetTensor_Lagrange);
2474:   return(0);
2475: }

2477: PetscErrorCode PetscDualSpaceSetUp_Simple(PetscDualSpace sp)
2478: {
2479:   PetscDualSpace_Simple *s  = (PetscDualSpace_Simple *) sp->data;
2480:   DM                     dm = sp->dm;
2481:   PetscInt               dim;
2482:   PetscErrorCode         ierr;

2485:   DMGetDimension(dm, &dim);
2486:   PetscCalloc1(dim+1, &s->numDof);
2487:   return(0);
2488: }

2490: PetscErrorCode PetscDualSpaceDestroy_Simple(PetscDualSpace sp)
2491: {
2492:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2493:   PetscErrorCode         ierr;

2496:   PetscFree(s->numDof);
2497:   PetscFree(s);
2498:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetDimension_C", NULL);
2499:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetFunctional_C", NULL);
2500:   return(0);
2501: }

2503: PetscErrorCode PetscDualSpaceDuplicate_Simple(PetscDualSpace sp, PetscDualSpace *spNew)
2504: {
2505:   PetscInt       dim, d;

2509:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) sp), spNew);
2510:   PetscDualSpaceSetType(*spNew, PETSCDUALSPACESIMPLE);
2511:   PetscDualSpaceGetDimension(sp, &dim);
2512:   PetscDualSpaceSimpleSetDimension(*spNew, dim);
2513:   for (d = 0; d < dim; ++d) {
2514:     PetscQuadrature q;

2516:     PetscDualSpaceGetFunctional(sp, d, &q);
2517:     PetscDualSpaceSimpleSetFunctional(*spNew, d, q);
2518:   }
2519:   return(0);
2520: }

2522: PetscErrorCode PetscDualSpaceSetFromOptions_Simple(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp)
2523: {
2525:   return(0);
2526: }

2528: PetscErrorCode PetscDualSpaceGetDimension_Simple(PetscDualSpace sp, PetscInt *dim)
2529: {
2530:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;

2533:   *dim = s->dim;
2534:   return(0);
2535: }

2537: PetscErrorCode PetscDualSpaceSimpleSetDimension_Simple(PetscDualSpace sp, const PetscInt dim)
2538: {
2539:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2540:   DM                     dm;
2541:   PetscInt               spatialDim, f;
2542:   PetscErrorCode         ierr;

2545:   for (f = 0; f < s->dim; ++f) {PetscQuadratureDestroy(&sp->functional[f]);}
2546:   PetscFree(sp->functional);
2547:   s->dim = dim;
2548:   PetscCalloc1(s->dim, &sp->functional);
2549:   PetscFree(s->numDof);
2550:   PetscDualSpaceGetDM(sp, &dm);
2551:   DMGetCoordinateDim(dm, &spatialDim);
2552:   PetscCalloc1(spatialDim+1, &s->numDof);
2553:   s->numDof[spatialDim] = dim;
2554:   return(0);
2555: }

2557: PetscErrorCode PetscDualSpaceGetNumDof_Simple(PetscDualSpace sp, const PetscInt **numDof)
2558: {
2559:   PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;

2562:   *numDof = s->numDof;
2563:   return(0);
2564: }

2566: PetscErrorCode PetscDualSpaceSimpleSetFunctional_Simple(PetscDualSpace sp, PetscInt f, PetscQuadrature q)
2567: {
2568:   PetscDualSpace_Simple *s   = (PetscDualSpace_Simple *) sp->data;
2569:   PetscReal              vol = 0.0;
2570:   PetscReal             *weights;
2571:   PetscInt               Nq, p;
2572:   PetscErrorCode         ierr;

2575:   if ((f < 0) || (f >= s->dim)) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_OUTOFRANGE, "Basis index %d not in [0, %d)", f, s->dim);
2576:   PetscQuadratureDuplicate(q, &sp->functional[f]);
2577:   /* Reweight so that it has unit volume */
2578:   PetscQuadratureGetData(sp->functional[f], NULL, &Nq, NULL, (const PetscReal **) &weights);
2579:   for (p = 0; p < Nq; ++p) vol += weights[p];
2580:   for (p = 0; p < Nq; ++p) weights[p] /= vol;
2581:   return(0);
2582: }

2584: /*@
2585:   PetscDualSpaceSimpleSetDimension - Set the number of functionals in the dual space basis

2587:   Logically Collective on PetscDualSpace

2589:   Input Parameters:
2590: + sp  - the PetscDualSpace
2591: - dim - the basis dimension

2593:   Level: intermediate

2595: .keywords: PetscDualSpace, dimension
2596: .seealso: PetscDualSpaceSimpleSetFunctional()
2597: @*/
2598: PetscErrorCode PetscDualSpaceSimpleSetDimension(PetscDualSpace sp, PetscInt dim)
2599: {

2605:   PetscTryMethod(sp, "PetscDualSpaceSimpleSetDimension_C", (PetscDualSpace,PetscInt),(sp,dim));
2606:   return(0);
2607: }

2609: /*@
2610:   PetscDualSpaceSimpleSetFunctional - Set the given basis element for this dual space

2612:   Not Collective

2614:   Input Parameters:
2615: + sp  - the PetscDualSpace
2616: . f - the basis index
2617: - q - the basis functional

2619:   Level: intermediate

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

2623: .keywords: PetscDualSpace, functional
2624: .seealso: PetscDualSpaceSimpleSetDimension()
2625: @*/
2626: PetscErrorCode PetscDualSpaceSimpleSetFunctional(PetscDualSpace sp, PetscInt func, PetscQuadrature q)
2627: {

2632:   PetscTryMethod(sp, "PetscDualSpaceSimpleSetFunctional_C", (PetscDualSpace,PetscInt,PetscQuadrature),(sp,func,q));
2633:   return(0);
2634: }

2636: PetscErrorCode PetscDualSpaceInitialize_Simple(PetscDualSpace sp)
2637: {
2639:   sp->ops->setfromoptions = PetscDualSpaceSetFromOptions_Simple;
2640:   sp->ops->setup          = PetscDualSpaceSetUp_Simple;
2641:   sp->ops->view           = NULL;
2642:   sp->ops->destroy        = PetscDualSpaceDestroy_Simple;
2643:   sp->ops->duplicate      = PetscDualSpaceDuplicate_Simple;
2644:   sp->ops->getdimension   = PetscDualSpaceGetDimension_Simple;
2645:   sp->ops->getnumdof      = PetscDualSpaceGetNumDof_Simple;
2646:   return(0);
2647: }

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

2652:   Level: intermediate

2654: .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
2655: M*/

2657: PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Simple(PetscDualSpace sp)
2658: {
2659:   PetscDualSpace_Simple *s;
2660:   PetscErrorCode         ierr;

2664:   PetscNewLog(sp,&s);
2665:   sp->data = s;

2667:   s->dim    = 0;
2668:   s->numDof = NULL;

2670:   PetscDualSpaceInitialize_Simple(sp);
2671:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetDimension_C", PetscDualSpaceSimpleSetDimension_Simple);
2672:   PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetFunctional_C", PetscDualSpaceSimpleSetFunctional_Simple);
2673:   return(0);
2674: }


2677: PetscClassId PETSCFE_CLASSID = 0;

2679: PetscFunctionList PetscFEList              = NULL;
2680: PetscBool         PetscFERegisterAllCalled = PETSC_FALSE;

2682: /*@C
2683:   PetscFERegister - Adds a new PetscFE implementation

2685:   Not Collective

2687:   Input Parameters:
2688: + name        - The name of a new user-defined creation routine
2689: - create_func - The creation routine itself

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

2694:   Sample usage:
2695: .vb
2696:     PetscFERegister("my_fe", MyPetscFECreate);
2697: .ve

2699:   Then, your PetscFE type can be chosen with the procedural interface via
2700: .vb
2701:     PetscFECreate(MPI_Comm, PetscFE *);
2702:     PetscFESetType(PetscFE, "my_fe");
2703: .ve
2704:    or at runtime via the option
2705: .vb
2706:     -petscfe_type my_fe
2707: .ve

2709:   Level: advanced

2711: .keywords: PetscFE, register
2712: .seealso: PetscFERegisterAll(), PetscFERegisterDestroy()

2714: @*/
2715: PetscErrorCode PetscFERegister(const char sname[], PetscErrorCode (*function)(PetscFE))
2716: {

2720:   PetscFunctionListAdd(&PetscFEList, sname, function);
2721:   return(0);
2722: }

2724: /*@C
2725:   PetscFESetType - Builds a particular PetscFE

2727:   Collective on PetscFE

2729:   Input Parameters:
2730: + fem  - The PetscFE object
2731: - name - The kind of FEM space

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

2736:   Level: intermediate

2738: .keywords: PetscFE, set, type
2739: .seealso: PetscFEGetType(), PetscFECreate()
2740: @*/
2741: PetscErrorCode PetscFESetType(PetscFE fem, PetscFEType name)
2742: {
2743:   PetscErrorCode (*r)(PetscFE);
2744:   PetscBool      match;

2749:   PetscObjectTypeCompare((PetscObject) fem, name, &match);
2750:   if (match) return(0);

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

2756:   if (fem->ops->destroy) {
2757:     (*fem->ops->destroy)(fem);
2758:     fem->ops->destroy = NULL;
2759:   }
2760:   (*r)(fem);
2761:   PetscObjectChangeTypeName((PetscObject) fem, name);
2762:   return(0);
2763: }

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

2768:   Not Collective

2770:   Input Parameter:
2771: . fem  - The PetscFE

2773:   Output Parameter:
2774: . name - The PetscFE type name

2776:   Level: intermediate

2778: .keywords: PetscFE, get, type, name
2779: .seealso: PetscFESetType(), PetscFECreate()
2780: @*/
2781: PetscErrorCode PetscFEGetType(PetscFE fem, PetscFEType *name)
2782: {

2788:   if (!PetscFERegisterAllCalled) {
2789:     PetscFERegisterAll();
2790:   }
2791:   *name = ((PetscObject) fem)->type_name;
2792:   return(0);
2793: }

2795: /*@C
2796:   PetscFEView - Views a PetscFE

2798:   Collective on PetscFE

2800:   Input Parameter:
2801: + fem - the PetscFE object to view
2802: - v   - the viewer

2804:   Level: developer

2806: .seealso PetscFEDestroy()
2807: @*/
2808: PetscErrorCode PetscFEView(PetscFE fem, PetscViewer v)
2809: {

2814:   if (!v) {
2815:     PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) fem), &v);
2816:   }
2817:   if (fem->ops->view) {
2818:     (*fem->ops->view)(fem, v);
2819:   }
2820:   return(0);
2821: }

2823: /*@
2824:   PetscFESetFromOptions - sets parameters in a PetscFE from the options database

2826:   Collective on PetscFE

2828:   Input Parameter:
2829: . fem - the PetscFE object to set options for

2831:   Options Database:
2832: . -petscfe_num_blocks  the number of cell blocks to integrate concurrently
2833: . -petscfe_num_batches the number of cell batches to integrate serially

2835:   Level: developer

2837: .seealso PetscFEView()
2838: @*/
2839: PetscErrorCode PetscFESetFromOptions(PetscFE fem)
2840: {
2841:   const char    *defaultType;
2842:   char           name[256];
2843:   PetscBool      flg;

2848:   if (!((PetscObject) fem)->type_name) {
2849:     defaultType = PETSCFEBASIC;
2850:   } else {
2851:     defaultType = ((PetscObject) fem)->type_name;
2852:   }
2853:   if (!PetscFERegisterAllCalled) {PetscFERegisterAll();}

2855:   PetscObjectOptionsBegin((PetscObject) fem);
2856:   PetscOptionsFList("-petscfe_type", "Finite element space", "PetscFESetType", PetscFEList, defaultType, name, 256, &flg);
2857:   if (flg) {
2858:     PetscFESetType(fem, name);
2859:   } else if (!((PetscObject) fem)->type_name) {
2860:     PetscFESetType(fem, defaultType);
2861:   }
2862:   PetscOptionsInt("-petscfe_num_blocks", "The number of cell blocks to integrate concurrently", "PetscSpaceSetTileSizes", fem->numBlocks, &fem->numBlocks, NULL);
2863:   PetscOptionsInt("-petscfe_num_batches", "The number of cell batches to integrate serially", "PetscSpaceSetTileSizes", fem->numBatches, &fem->numBatches, NULL);
2864:   if (fem->ops->setfromoptions) {
2865:     (*fem->ops->setfromoptions)(PetscOptionsObject,fem);
2866:   }
2867:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
2868:   PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) fem);
2869:   PetscOptionsEnd();
2870:   PetscFEViewFromOptions(fem, NULL, "-petscfe_view");
2871:   return(0);
2872: }

2874: /*@C
2875:   PetscFESetUp - Construct data structures for the PetscFE

2877:   Collective on PetscFE

2879:   Input Parameter:
2880: . fem - the PetscFE object to setup

2882:   Level: developer

2884: .seealso PetscFEView(), PetscFEDestroy()
2885: @*/
2886: PetscErrorCode PetscFESetUp(PetscFE fem)
2887: {

2892:   if (fem->ops->setup) {(*fem->ops->setup)(fem);}
2893:   return(0);
2894: }

2896: /*@
2897:   PetscFEDestroy - Destroys a PetscFE object

2899:   Collective on PetscFE

2901:   Input Parameter:
2902: . fem - the PetscFE object to destroy

2904:   Level: developer

2906: .seealso PetscFEView()
2907: @*/
2908: PetscErrorCode PetscFEDestroy(PetscFE *fem)
2909: {

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

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

2919:   PetscFree((*fem)->numDof);
2920:   PetscFree((*fem)->invV);
2921:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->B, &(*fem)->D, NULL /*&(*fem)->H*/);
2922:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->Bf, &(*fem)->Df, NULL /*&(*fem)->Hf*/);
2923:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->F, NULL, NULL);
2924:   PetscSpaceDestroy(&(*fem)->basisSpace);
2925:   PetscDualSpaceDestroy(&(*fem)->dualSpace);
2926:   PetscQuadratureDestroy(&(*fem)->quadrature);
2927:   PetscQuadratureDestroy(&(*fem)->faceQuadrature);

2929:   if ((*fem)->ops->destroy) {(*(*fem)->ops->destroy)(*fem);}
2930:   PetscHeaderDestroy(fem);
2931:   return(0);
2932: }

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

2937:   Collective on MPI_Comm

2939:   Input Parameter:
2940: . comm - The communicator for the PetscFE object

2942:   Output Parameter:
2943: . fem - The PetscFE object

2945:   Level: beginner

2947: .seealso: PetscFESetType(), PETSCFEGALERKIN
2948: @*/
2949: PetscErrorCode PetscFECreate(MPI_Comm comm, PetscFE *fem)
2950: {
2951:   PetscFE        f;

2956:   PetscCitationsRegister(FECitation,&FEcite);
2957:   *fem = NULL;
2958:   PetscFEInitializePackage();

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

2962:   f->basisSpace    = NULL;
2963:   f->dualSpace     = NULL;
2964:   f->numComponents = 1;
2965:   f->numDof        = NULL;
2966:   f->invV          = NULL;
2967:   f->B             = NULL;
2968:   f->D             = NULL;
2969:   f->H             = NULL;
2970:   f->Bf            = NULL;
2971:   f->Df            = NULL;
2972:   f->Hf            = NULL;
2973:   PetscMemzero(&f->quadrature, sizeof(PetscQuadrature));
2974:   PetscMemzero(&f->faceQuadrature, sizeof(PetscQuadrature));
2975:   f->blockSize     = 0;
2976:   f->numBlocks     = 1;
2977:   f->batchSize     = 0;
2978:   f->numBatches    = 1;

2980:   *fem = f;
2981:   return(0);
2982: }

2984: /*@
2985:   PetscFEGetSpatialDimension - Returns the spatial dimension of the element

2987:   Not collective

2989:   Input Parameter:
2990: . fem - The PetscFE object

2992:   Output Parameter:
2993: . dim - The spatial dimension

2995:   Level: intermediate

2997: .seealso: PetscFECreate()
2998: @*/
2999: PetscErrorCode PetscFEGetSpatialDimension(PetscFE fem, PetscInt *dim)
3000: {
3001:   DM             dm;

3007:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
3008:   DMGetDimension(dm, dim);
3009:   return(0);
3010: }

3012: /*@
3013:   PetscFESetNumComponents - Sets the number of components in the element

3015:   Not collective

3017:   Input Parameters:
3018: + fem - The PetscFE object
3019: - comp - The number of field components

3021:   Level: intermediate

3023: .seealso: PetscFECreate()
3024: @*/
3025: PetscErrorCode PetscFESetNumComponents(PetscFE fem, PetscInt comp)
3026: {
3029:   fem->numComponents = comp;
3030:   return(0);
3031: }

3033: /*@
3034:   PetscFEGetNumComponents - Returns the number of components in the element

3036:   Not collective

3038:   Input Parameter:
3039: . fem - The PetscFE object

3041:   Output Parameter:
3042: . comp - The number of field components

3044:   Level: intermediate

3046: .seealso: PetscFECreate()
3047: @*/
3048: PetscErrorCode PetscFEGetNumComponents(PetscFE fem, PetscInt *comp)
3049: {
3053:   *comp = fem->numComponents;
3054:   return(0);
3055: }

3057: /*@
3058:   PetscFESetTileSizes - Sets the tile sizes for evaluation

3060:   Not collective

3062:   Input Parameters:
3063: + fem - The PetscFE object
3064: . blockSize - The number of elements in a block
3065: . numBlocks - The number of blocks in a batch
3066: . batchSize - The number of elements in a batch
3067: - numBatches - The number of batches in a chunk

3069:   Level: intermediate

3071: .seealso: PetscFECreate()
3072: @*/
3073: PetscErrorCode PetscFESetTileSizes(PetscFE fem, PetscInt blockSize, PetscInt numBlocks, PetscInt batchSize, PetscInt numBatches)
3074: {
3077:   fem->blockSize  = blockSize;
3078:   fem->numBlocks  = numBlocks;
3079:   fem->batchSize  = batchSize;
3080:   fem->numBatches = numBatches;
3081:   return(0);
3082: }

3084: /*@
3085:   PetscFEGetTileSizes - Returns the tile sizes for evaluation

3087:   Not collective

3089:   Input Parameter:
3090: . fem - The PetscFE object

3092:   Output Parameters:
3093: + blockSize - The number of elements in a block
3094: . numBlocks - The number of blocks in a batch
3095: . batchSize - The number of elements in a batch
3096: - numBatches - The number of batches in a chunk

3098:   Level: intermediate

3100: .seealso: PetscFECreate()
3101: @*/
3102: PetscErrorCode PetscFEGetTileSizes(PetscFE fem, PetscInt *blockSize, PetscInt *numBlocks, PetscInt *batchSize, PetscInt *numBatches)
3103: {
3110:   if (blockSize)  *blockSize  = fem->blockSize;
3111:   if (numBlocks)  *numBlocks  = fem->numBlocks;
3112:   if (batchSize)  *batchSize  = fem->batchSize;
3113:   if (numBatches) *numBatches = fem->numBatches;
3114:   return(0);
3115: }

3117: /*@
3118:   PetscFEGetBasisSpace - Returns the PetscSpace used for approximation of the solution

3120:   Not collective

3122:   Input Parameter:
3123: . fem - The PetscFE object

3125:   Output Parameter:
3126: . sp - The PetscSpace object

3128:   Level: intermediate

3130: .seealso: PetscFECreate()
3131: @*/
3132: PetscErrorCode PetscFEGetBasisSpace(PetscFE fem, PetscSpace *sp)
3133: {
3137:   *sp = fem->basisSpace;
3138:   return(0);
3139: }

3141: /*@
3142:   PetscFESetBasisSpace - Sets the PetscSpace used for approximation of the solution

3144:   Not collective

3146:   Input Parameters:
3147: + fem - The PetscFE object
3148: - sp - The PetscSpace object

3150:   Level: intermediate

3152: .seealso: PetscFECreate()
3153: @*/
3154: PetscErrorCode PetscFESetBasisSpace(PetscFE fem, PetscSpace sp)
3155: {

3161:   PetscSpaceDestroy(&fem->basisSpace);
3162:   fem->basisSpace = sp;
3163:   PetscObjectReference((PetscObject) fem->basisSpace);
3164:   return(0);
3165: }

3167: /*@
3168:   PetscFEGetDualSpace - Returns the PetscDualSpace used to define the inner product

3170:   Not collective

3172:   Input Parameter:
3173: . fem - The PetscFE object

3175:   Output Parameter:
3176: . sp - The PetscDualSpace object

3178:   Level: intermediate

3180: .seealso: PetscFECreate()
3181: @*/
3182: PetscErrorCode PetscFEGetDualSpace(PetscFE fem, PetscDualSpace *sp)
3183: {
3187:   *sp = fem->dualSpace;
3188:   return(0);
3189: }

3191: /*@
3192:   PetscFESetDualSpace - Sets the PetscDualSpace used to define the inner product

3194:   Not collective

3196:   Input Parameters:
3197: + fem - The PetscFE object
3198: - sp - The PetscDualSpace object

3200:   Level: intermediate

3202: .seealso: PetscFECreate()
3203: @*/
3204: PetscErrorCode PetscFESetDualSpace(PetscFE fem, PetscDualSpace sp)
3205: {

3211:   PetscDualSpaceDestroy(&fem->dualSpace);
3212:   fem->dualSpace = sp;
3213:   PetscObjectReference((PetscObject) fem->dualSpace);
3214:   return(0);
3215: }

3217: /*@
3218:   PetscFEGetQuadrature - Returns the PetscQuadrature used to calculate inner products

3220:   Not collective

3222:   Input Parameter:
3223: . fem - The PetscFE object

3225:   Output Parameter:
3226: . q - The PetscQuadrature object

3228:   Level: intermediate

3230: .seealso: PetscFECreate()
3231: @*/
3232: PetscErrorCode PetscFEGetQuadrature(PetscFE fem, PetscQuadrature *q)
3233: {
3237:   *q = fem->quadrature;
3238:   return(0);
3239: }

3241: /*@
3242:   PetscFESetQuadrature - Sets the PetscQuadrature used to calculate inner products

3244:   Not collective

3246:   Input Parameters:
3247: + fem - The PetscFE object
3248: - q - The PetscQuadrature object

3250:   Level: intermediate

3252: .seealso: PetscFECreate()
3253: @*/
3254: PetscErrorCode PetscFESetQuadrature(PetscFE fem, PetscQuadrature q)
3255: {

3260:   PetscFERestoreTabulation(fem, 0, NULL, &fem->B, &fem->D, NULL /*&(*fem)->H*/);
3261:   PetscQuadratureDestroy(&fem->quadrature);
3262:   fem->quadrature = q;
3263:   PetscObjectReference((PetscObject) q);
3264:   return(0);
3265: }

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

3270:   Not collective

3272:   Input Parameter:
3273: . fem - The PetscFE object

3275:   Output Parameter:
3276: . q - The PetscQuadrature object

3278:   Level: intermediate

3280: .seealso: PetscFECreate()
3281: @*/
3282: PetscErrorCode PetscFEGetFaceQuadrature(PetscFE fem, PetscQuadrature *q)
3283: {
3287:   *q = fem->faceQuadrature;
3288:   return(0);
3289: }

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

3294:   Not collective

3296:   Input Parameters:
3297: + fem - The PetscFE object
3298: - q - The PetscQuadrature object

3300:   Level: intermediate

3302: .seealso: PetscFECreate()
3303: @*/
3304: PetscErrorCode PetscFESetFaceQuadrature(PetscFE fem, PetscQuadrature q)
3305: {

3310:   PetscFERestoreTabulation(fem, 0, NULL, &fem->Bf, &fem->Df, NULL /*&(*fem)->Hf*/);
3311:   PetscQuadratureDestroy(&fem->faceQuadrature);
3312:   fem->faceQuadrature = q;
3313:   PetscObjectReference((PetscObject) q);
3314:   return(0);
3315: }

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

3320:   Not collective

3322:   Input Parameter:
3323: . fem - The PetscFE object

3325:   Output Parameter:
3326: . numDof - Array with the number of dofs per dimension

3328:   Level: intermediate

3330: .seealso: PetscFECreate()
3331: @*/
3332: PetscErrorCode PetscFEGetNumDof(PetscFE fem, const PetscInt **numDof)
3333: {
3334:   const PetscInt *numDofDual;
3335:   PetscErrorCode  ierr;

3340:   PetscDualSpaceGetNumDof(fem->dualSpace, &numDofDual);
3341:   if (!fem->numDof) {
3342:     DM       dm;
3343:     PetscInt dim, d;

3345:     PetscDualSpaceGetDM(fem->dualSpace, &dm);
3346:     DMGetDimension(dm, &dim);
3347:     PetscMalloc1(dim+1, &fem->numDof);
3348:     for (d = 0; d <= dim; ++d) {
3349:       fem->numDof[d] = fem->numComponents*numDofDual[d];
3350:     }
3351:   }
3352:   *numDof = fem->numDof;
3353:   return(0);
3354: }

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

3359:   Not collective

3361:   Input Parameter:
3362: . fem - The PetscFE object

3364:   Output Parameters:
3365: + B - The basis function values at quadrature points
3366: . D - The basis function derivatives at quadrature points
3367: - H - The basis function second derivatives at quadrature points

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

3374:   Level: intermediate

3376: .seealso: PetscFEGetTabulation(), PetscFERestoreTabulation()
3377: @*/
3378: PetscErrorCode PetscFEGetDefaultTabulation(PetscFE fem, PetscReal **B, PetscReal **D, PetscReal **H)
3379: {
3380:   PetscInt         npoints;
3381:   const PetscReal *points;
3382:   PetscErrorCode   ierr;

3389:   PetscQuadratureGetData(fem->quadrature, NULL, &npoints, &points, NULL);
3390:   if (!fem->B) {PetscFEGetTabulation(fem, npoints, points, &fem->B, &fem->D, NULL/*&fem->H*/);}
3391:   if (B) *B = fem->B;
3392:   if (D) *D = fem->D;
3393:   if (H) *H = fem->H;
3394:   return(0);
3395: }

3397: PetscErrorCode PetscFEGetFaceTabulation(PetscFE fem, PetscReal **Bf, PetscReal **Df, PetscReal **Hf)
3398: {
3399:   PetscErrorCode   ierr;

3406:   if (!fem->Bf) {
3407:     PetscFECellGeom  cgeom;
3408:     PetscQuadrature  fq;
3409:     PetscDualSpace   sp;
3410:     DM               dm;
3411:     const PetscInt  *faces;
3412:     PetscInt         dim, numFaces, f, npoints, q;
3413:     const PetscReal *points, *weights;
3414:     PetscReal       *facePoints;
3415: 
3416:     PetscFEGetDualSpace(fem, &sp);
3417:     PetscDualSpaceGetDM(sp, &dm);
3418:     DMGetDimension(dm, &dim);
3419:     DMPlexGetConeSize(dm, 0, &numFaces);
3420:     DMPlexGetCone(dm, 0, &faces);
3421:     PetscFEGetFaceQuadrature(fem, &fq);
3422:     PetscQuadratureGetData(fq, NULL, &npoints, &points, &weights);
3423:     PetscMalloc1(numFaces*npoints*dim, &facePoints);
3424:     for (f = 0; f < numFaces; ++f) {
3425:       DMPlexComputeCellGeometryFEM(dm, faces[f], NULL, cgeom.v0, cgeom.J, NULL, &cgeom.detJ);
3426:       for (q = 0; q < npoints; ++q) CoordinatesRefToReal(dim, dim-1, cgeom.v0, cgeom.J, &points[q*(dim-1)], &facePoints[(f*npoints+q)*dim]);
3427:     }
3428:     PetscFEGetTabulation(fem, numFaces*npoints, facePoints, &fem->Bf, &fem->Df, NULL/*&fem->Hf*/);
3429:     PetscFree(facePoints);
3430:   }
3431:   if (Bf) *Bf = fem->Bf;
3432:   if (Df) *Df = fem->Df;
3433:   if (Hf) *Hf = fem->Hf;
3434:   return(0);
3435: }

3437: PetscErrorCode PetscFEGetFaceCentroidTabulation(PetscFE fem, PetscReal **F)
3438: {
3439:   PetscErrorCode   ierr;

3444:   if (!fem->F) {
3445:     PetscDualSpace  sp;
3446:     DM              dm;
3447:     const PetscInt *cone;
3448:     PetscReal      *centroids;
3449:     PetscInt        dim, numFaces, f;

3451:     PetscFEGetDualSpace(fem, &sp);
3452:     PetscDualSpaceGetDM(sp, &dm);
3453:     DMGetDimension(dm, &dim);
3454:     DMPlexGetConeSize(dm, 0, &numFaces);
3455:     DMPlexGetCone(dm, 0, &cone);
3456:     PetscMalloc1(numFaces*dim, &centroids);
3457:     for (f = 0; f < numFaces; ++f) {DMPlexComputeCellGeometryFVM(dm, cone[f], NULL, &centroids[f*dim], NULL);}
3458:     PetscFEGetTabulation(fem, numFaces, centroids, &fem->F, NULL, NULL);
3459:     PetscFree(centroids);
3460:   }
3461:   *F = fem->F;
3462:   return(0);
3463: }

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

3468:   Not collective

3470:   Input Parameters:
3471: + fem     - The PetscFE object
3472: . npoints - The number of tabulation points
3473: - points  - The tabulation point coordinates

3475:   Output Parameters:
3476: + B - The basis function values at tabulation points
3477: . D - The basis function derivatives at tabulation points
3478: - H - The basis function second derivatives at tabulation points

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

3485:   Level: intermediate

3487: .seealso: PetscFERestoreTabulation(), PetscFEGetDefaultTabulation()
3488: @*/
3489: PetscErrorCode PetscFEGetTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal **B, PetscReal **D, PetscReal **H)
3490: {
3491:   DM               dm;
3492:   PetscInt         pdim; /* Dimension of FE space P */
3493:   PetscInt         dim;  /* Spatial dimension */
3494:   PetscInt         comp; /* Field components */
3495:   PetscErrorCode   ierr;

3503:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
3504:   DMGetDimension(dm, &dim);
3505:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
3506:   PetscFEGetNumComponents(fem, &comp);
3507:   if (B) {DMGetWorkArray(dm, npoints*pdim*comp, PETSC_REAL, B);}
3508:   if (D) {DMGetWorkArray(dm, npoints*pdim*comp*dim, PETSC_REAL, D);}
3509:   if (H) {DMGetWorkArray(dm, npoints*pdim*comp*dim*dim, PETSC_REAL, H);}
3510:   (*fem->ops->gettabulation)(fem, npoints, points, B ? *B : NULL, D ? *D : NULL, H ? *H : NULL);
3511:   return(0);
3512: }

3514: PetscErrorCode PetscFERestoreTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal **B, PetscReal **D, PetscReal **H)
3515: {
3516:   DM             dm;

3521:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
3522:   if (B && *B) {DMRestoreWorkArray(dm, 0, PETSC_REAL, B);}
3523:   if (D && *D) {DMRestoreWorkArray(dm, 0, PETSC_REAL, D);}
3524:   if (H && *H) {DMRestoreWorkArray(dm, 0, PETSC_REAL, H);}
3525:   return(0);
3526: }

3528: PetscErrorCode PetscFEDestroy_Basic(PetscFE fem)
3529: {
3530:   PetscFE_Basic *b = (PetscFE_Basic *) fem->data;

3534:   PetscFree(b);
3535:   return(0);
3536: }

3538: PetscErrorCode PetscFEView_Basic_Ascii(PetscFE fe, PetscViewer viewer)
3539: {
3540:   PetscSpace        basis;
3541:   PetscDualSpace    dual;
3542:   PetscQuadrature   q = NULL;
3543:   PetscInt          dim, Nq;
3544:   PetscViewerFormat format;
3545:   PetscErrorCode    ierr;

3548:   PetscFEGetBasisSpace(fe, &basis);
3549:   PetscFEGetDualSpace(fe, &dual);
3550:   PetscFEGetQuadrature(fe, &q);
3551:   PetscQuadratureGetData(q, &dim, &Nq, NULL, NULL);
3552:   PetscViewerGetFormat(viewer, &format);
3553:   PetscViewerASCIIPrintf(viewer, "Basic Finite Element:\n");
3554:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
3555:     PetscViewerASCIIPrintf(viewer, "  dimension:       %d\n", dim);
3556:     PetscViewerASCIIPrintf(viewer, "  num quad points: %d\n", Nq);
3557:     PetscViewerASCIIPushTab(viewer);
3558:     PetscQuadratureView(q, viewer);
3559:     PetscViewerASCIIPopTab(viewer);
3560:   } else {
3561:     PetscViewerASCIIPrintf(viewer, "  dimension:       %d\n", dim);
3562:     PetscViewerASCIIPrintf(viewer, "  num quad points: %d\n", Nq);
3563:   }
3564:   PetscViewerASCIIPushTab(viewer);
3565:   PetscSpaceView(basis, viewer);
3566:   PetscDualSpaceView(dual, viewer);
3567:   PetscViewerASCIIPopTab(viewer);
3568:   return(0);
3569: }

3571: PetscErrorCode PetscFEView_Basic(PetscFE fe, PetscViewer viewer)
3572: {
3573:   PetscBool      iascii;

3579:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
3580:   if (iascii) {PetscFEView_Basic_Ascii(fe, viewer);}
3581:   return(0);
3582: }

3584: /* Construct the change of basis from prime basis to nodal basis */
3585: PetscErrorCode PetscFESetUp_Basic(PetscFE fem)
3586: {
3587:   PetscScalar   *work, *invVscalar;
3588:   PetscBLASInt  *pivots;
3589:   PetscBLASInt   n, info;
3590:   PetscInt       pdim, j;

3594:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
3595:   PetscMalloc1(pdim*pdim,&fem->invV);
3596: #if defined(PETSC_USE_COMPLEX)
3597:   PetscMalloc1(pdim*pdim,&invVscalar);
3598: #else
3599:   invVscalar = fem->invV;
3600: #endif
3601:   for (j = 0; j < pdim; ++j) {
3602:     PetscReal      *Bf;
3603:     PetscQuadrature f;
3604:     PetscInt        q, k;

3606:     PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);
3607:     PetscMalloc1(f->numPoints*pdim,&Bf);
3608:     PetscSpaceEvaluate(fem->basisSpace, f->numPoints, f->points, Bf, NULL, NULL);
3609:     for (k = 0; k < pdim; ++k) {
3610:       /* n_j \cdot \phi_k */
3611:       invVscalar[j*pdim+k] = 0.0;
3612:       for (q = 0; q < f->numPoints; ++q) {
3613:         invVscalar[j*pdim+k] += Bf[q*pdim+k]*f->weights[q];
3614:       }
3615:     }
3616:     PetscFree(Bf);
3617:   }
3618:   PetscMalloc2(pdim,&pivots,pdim,&work);
3619:   n = pdim;
3620:   PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, invVscalar, &n, pivots, &info));
3621:   PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, invVscalar, &n, pivots, work, &n, &info));
3622: #if defined(PETSC_USE_COMPLEX)
3623:   for (j = 0; j < pdim*pdim; j++) fem->invV[j] = PetscRealPart(invVscalar[j]);
3624:   PetscFree(invVscalar);
3625: #endif
3626:   PetscFree2(pivots,work);
3627:   return(0);
3628: }

3630: PetscErrorCode PetscFEGetDimension_Basic(PetscFE fem, PetscInt *dim)
3631: {

3635:   PetscDualSpaceGetDimension(fem->dualSpace, dim);
3636:   return(0);
3637: }

3639: PetscErrorCode PetscFEGetTabulation_Basic(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H)
3640: {
3641:   DM               dm;
3642:   PetscInt         pdim; /* Dimension of FE space P */
3643:   PetscInt         dim;  /* Spatial dimension */
3644:   PetscInt         comp; /* Field components */
3645:   PetscReal       *tmpB, *tmpD, *tmpH;
3646:   PetscInt         p, d, j, k;
3647:   PetscErrorCode   ierr;

3650:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
3651:   DMGetDimension(dm, &dim);
3652:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
3653:   PetscFEGetNumComponents(fem, &comp);
3654:   /* Evaluate the prime basis functions at all points */
3655:   if (B) {DMGetWorkArray(dm, npoints*pdim, PETSC_REAL, &tmpB);}
3656:   if (D) {DMGetWorkArray(dm, npoints*pdim*dim, PETSC_REAL, &tmpD);}
3657:   if (H) {DMGetWorkArray(dm, npoints*pdim*dim*dim, PETSC_REAL, &tmpH);}
3658:   PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);
3659:   /* Translate to the nodal basis */
3660:   for (p = 0; p < npoints; ++p) {
3661:     if (B) {
3662:       /* Multiply by V^{-1} (pdim x pdim) */
3663:       for (j = 0; j < pdim; ++j) {
3664:         const PetscInt i = (p*pdim + j)*comp;
3665:         PetscInt       c;

3667:         B[i] = 0.0;
3668:         for (k = 0; k < pdim; ++k) {
3669:           B[i] += fem->invV[k*pdim+j] * tmpB[p*pdim + k];
3670:         }
3671:         for (c = 1; c < comp; ++c) {
3672:           B[i+c] = B[i];
3673:         }
3674:       }
3675:     }
3676:     if (D) {
3677:       /* Multiply by V^{-1} (pdim x pdim) */
3678:       for (j = 0; j < pdim; ++j) {
3679:         for (d = 0; d < dim; ++d) {
3680:           const PetscInt i = ((p*pdim + j)*comp + 0)*dim + d;
3681:           PetscInt       c;

3683:           D[i] = 0.0;
3684:           for (k = 0; k < pdim; ++k) {
3685:             D[i] += fem->invV[k*pdim+j] * tmpD[(p*pdim + k)*dim + d];
3686:           }
3687:           for (c = 1; c < comp; ++c) {
3688:             D[((p*pdim + j)*comp + c)*dim + d] = D[i];
3689:           }
3690:         }
3691:       }
3692:     }
3693:     if (H) {
3694:       /* Multiply by V^{-1} (pdim x pdim) */
3695:       for (j = 0; j < pdim; ++j) {
3696:         for (d = 0; d < dim*dim; ++d) {
3697:           const PetscInt i = ((p*pdim + j)*comp + 0)*dim*dim + d;
3698:           PetscInt       c;

3700:           H[i] = 0.0;
3701:           for (k = 0; k < pdim; ++k) {
3702:             H[i] += fem->invV[k*pdim+j] * tmpH[(p*pdim + k)*dim*dim + d];
3703:           }
3704:           for (c = 1; c < comp; ++c) {
3705:             H[((p*pdim + j)*comp + c)*dim*dim + d] = H[i];
3706:           }
3707:         }
3708:       }
3709:     }
3710:   }
3711:   if (B) {DMRestoreWorkArray(dm, npoints*pdim, PETSC_REAL, &tmpB);}
3712:   if (D) {DMRestoreWorkArray(dm, npoints*pdim*dim, PETSC_REAL, &tmpD);}
3713:   if (H) {DMRestoreWorkArray(dm, npoints*pdim*dim*dim, PETSC_REAL, &tmpH);}
3714:   return(0);
3715: }

3717: PetscErrorCode PetscFEIntegrate_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
3718:                                       const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal integral[])
3719: {
3720:   const PetscInt  debug = 0;
3721:   PetscPointFunc  obj_func;
3722:   PetscQuadrature quad;
3723:   PetscScalar    *u, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
3724:   PetscReal      *x;
3725:   PetscReal     **B, **D, **BAux = NULL, **DAux = NULL;
3726:   PetscInt       *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
3727:   PetscInt       dim, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, e;

3731:   PetscDSGetObjective(prob, field, &obj_func);
3732:   if (!obj_func) return(0);
3733:   PetscFEGetSpatialDimension(fem, &dim);
3734:   PetscFEGetQuadrature(fem, &quad);
3735:   PetscDSGetNumFields(prob, &Nf);
3736:   PetscDSGetTotalDimension(prob, &totDim);
3737:   PetscDSGetDimensions(prob, &Nb);
3738:   PetscDSGetComponents(prob, &Nc);
3739:   PetscDSGetComponentOffsets(prob, &uOff);
3740:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
3741:   PetscDSGetEvaluationArrays(prob, &u, NULL, &u_x);
3742:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
3743:   PetscDSGetTabulation(prob, &B, &D);
3744:   if (probAux) {
3745:     PetscDSGetNumFields(probAux, &NfAux);
3746:     PetscDSGetTotalDimension(probAux, &totDimAux);
3747:     PetscDSGetDimensions(probAux, &NbAux);
3748:     PetscDSGetComponents(probAux, &NcAux);
3749:     PetscDSGetComponentOffsets(probAux, &aOff);
3750:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
3751:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
3752:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
3753:     PetscDSGetTabulation(probAux, &BAux, &DAux);
3754:   }
3755:   for (e = 0; e < Ne; ++e) {
3756:     const PetscReal *v0   = cgeom[e].v0;
3757:     const PetscReal *J    = cgeom[e].J;
3758:     const PetscReal *invJ = cgeom[e].invJ;
3759:     const PetscReal  detJ = cgeom[e].detJ;
3760:     const PetscReal *quadPoints, *quadWeights;
3761:     PetscInt         Nq, q;

3763:     PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
3764:     if (debug > 1) {
3765:       PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
3766: #ifndef PETSC_USE_COMPLEX
3767:       DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
3768: #endif
3769:     }
3770:     for (q = 0; q < Nq; ++q) {
3771:       PetscScalar integrand;

3773:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
3774:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
3775:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], NULL, u, u_x, NULL);
3776:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
3777:       obj_func(dim, Nf, NfAux, uOff, uOff_x, u, NULL, u_x, aOff, aOff_x, a, NULL, a_x, 0.0, x, &integrand);
3778:       integrand *= detJ*quadWeights[q];
3779:       integral[field] += PetscRealPart(integrand);
3780:       if (debug > 1) {PetscPrintf(PETSC_COMM_SELF, "    int: %g %g\n", PetscRealPart(integrand), integral[field]);}
3781:     }
3782:     cOffset    += totDim;
3783:     cOffsetAux += totDimAux;
3784:   }
3785:   return(0);
3786: }

3788: PetscErrorCode PetscFEIntegrateResidual_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
3789:                                               const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
3790: {
3791:   const PetscInt  debug = 0;
3792:   PetscPointFunc  f0_func;
3793:   PetscPointFunc  f1_func;
3794:   PetscQuadrature quad;
3795:   PetscScalar    *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
3796:   PetscReal      *x;
3797:   PetscReal     **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
3798:   PetscInt       *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
3799:   PetscInt        dim, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
3800:   PetscErrorCode  ierr;

3803:   PetscFEGetSpatialDimension(fem, &dim);
3804:   PetscFEGetQuadrature(fem, &quad);
3805:   PetscDSGetNumFields(prob, &Nf);
3806:   PetscDSGetTotalDimension(prob, &totDim);
3807:   PetscDSGetDimensions(prob, &Nb);
3808:   PetscDSGetComponents(prob, &Nc);
3809:   PetscDSGetComponentOffsets(prob, &uOff);
3810:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
3811:   PetscDSGetFieldOffset(prob, field, &fOffset);
3812:   PetscDSGetResidual(prob, field, &f0_func, &f1_func);
3813:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
3814:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
3815:   PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
3816:   PetscDSGetTabulation(prob, &B, &D);
3817:   if (probAux) {
3818:     PetscDSGetNumFields(probAux, &NfAux);
3819:     PetscDSGetTotalDimension(probAux, &totDimAux);
3820:     PetscDSGetDimensions(probAux, &NbAux);
3821:     PetscDSGetComponents(probAux, &NcAux);
3822:     PetscDSGetComponentOffsets(probAux, &aOff);
3823:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
3824:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
3825:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
3826:     PetscDSGetTabulation(probAux, &BAux, &DAux);
3827:   }
3828:   NbI = Nb[field];
3829:   NcI = Nc[field];
3830:   BI  = B[field];
3831:   DI  = D[field];
3832:   for (e = 0; e < Ne; ++e) {
3833:     const PetscReal *v0   = cgeom[e].v0;
3834:     const PetscReal *J    = cgeom[e].J;
3835:     const PetscReal *invJ = cgeom[e].invJ;
3836:     const PetscReal  detJ = cgeom[e].detJ;
3837:     const PetscReal *quadPoints, *quadWeights;
3838:     PetscInt         Nq, q;

3840:     PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
3841:     PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
3842:     PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
3843:     if (debug > 1) {
3844:       PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
3845: #ifndef PETSC_USE_COMPLEX
3846:       DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
3847: #endif
3848:     }
3849:     for (q = 0; q < Nq; ++q) {
3850:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
3851:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
3852:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
3853:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
3854:       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]);
3855:       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);
3856:       TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
3857:     }
3858:     UpdateElementVec(dim, Nq, NbI, NcI, BI, DI, f0, f1, &elemVec[cOffset+fOffset]);
3859:     cOffset    += totDim;
3860:     cOffsetAux += totDimAux;
3861:   }
3862:   return(0);
3863: }

3865: PetscErrorCode PetscFEIntegrateBdResidual_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEFaceGeom *fgeom,
3866:                                                 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
3867: {
3868:    const PetscInt   debug = 0;
3869:    PetscBdPointFunc f0_func;
3870:    PetscBdPointFunc f1_func;
3871:    PetscQuadrature  quad;
3872:    PetscScalar     *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
3873:    PetscReal       *x;
3874:    PetscReal      **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
3875:    PetscInt        *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
3876:    PetscInt         dim, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
3877:    PetscErrorCode   ierr;
3878: 
3880:    PetscFEGetSpatialDimension(fem, &dim);
3881:    PetscFEGetFaceQuadrature(fem, &quad);
3882:    PetscDSGetNumFields(prob, &Nf);
3883:    PetscDSGetTotalDimension(prob, &totDim);
3884:    PetscDSGetDimensions(prob, &Nb);
3885:    PetscDSGetComponents(prob, &Nc);
3886:    PetscDSGetComponentOffsets(prob, &uOff);
3887:    PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
3888:    PetscDSGetFieldOffset(prob, field, &fOffset);
3889:    PetscDSGetBdResidual(prob, field, &f0_func, &f1_func);
3890:    if (!f0_func && !f1_func) return(0);
3891:    PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
3892:    PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
3893:    PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
3894:    PetscDSGetFaceTabulation(prob, &B, &D);
3895:    if (probAux) {
3896:      PetscDSGetNumFields(probAux, &NfAux);
3897:      PetscDSGetTotalDimension(probAux, &totDimAux);
3898:      PetscDSGetDimensions(probAux, &NbAux);
3899:      PetscDSGetComponents(probAux, &NcAux);
3900:      PetscDSGetComponentOffsets(probAux, &aOff);
3901:      PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
3902:      PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
3903:      PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
3904:      PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
3905:    }
3906:    NbI = Nb[field];
3907:    NcI = Nc[field];
3908:    BI  = B[field];
3909:    DI  = D[field];
3910:    for (e = 0; e < Ne; ++e) {
3911:      const PetscReal *quadPoints, *quadWeights;
3912:      const PetscReal *v0   = fgeom[e].v0;
3913:      const PetscReal *J    = fgeom[e].J;
3914:      const PetscReal *invJ = fgeom[e].invJ[0];
3915:      const PetscReal  detJ = fgeom[e].detJ;
3916:      const PetscReal *n    = fgeom[e].n;
3917:      const PetscInt   face = fgeom[e].face[0];
3918:      PetscInt         Nq, q;
3919: 
3920:      PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
3921:      PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
3922:      PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
3923:      if (debug > 1) {
3924:        PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
3925: #ifndef PETSC_USE_COMPLEX
3926:        DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
3927: #endif
3928:      }
3929:      for (q = 0; q < Nq; ++q) {
3930:        if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
3931:        CoordinatesRefToReal(dim, dim-1, v0, J, &quadPoints[q*(dim-1)], x);
3932:        EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
3933:        if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
3934:        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]);
3935:        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);
3936:        TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
3937:      }
3938:      UpdateElementVec(dim, Nq, NbI, NcI, &BI[face*Nq*NbI*NcI], &DI[face*Nq*NbI*NcI*dim], f0, f1, &elemVec[cOffset+fOffset]);
3939:      cOffset    += totDim;
3940:      cOffsetAux += totDimAux;
3941:    }
3942:    return(0);
3943: }
3944: 

3946: PetscErrorCode PetscFEIntegrateJacobian_Basic(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFECellGeom *geom,
3947:                                               const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
3948: {
3949:   const PetscInt  debug      = 0;
3950:   PetscPointJac   g0_func;
3951:   PetscPointJac   g1_func;
3952:   PetscPointJac   g2_func;
3953:   PetscPointJac   g3_func;
3954:   PetscInt        cOffset    = 0; /* Offset into coefficients[] for element e */
3955:   PetscInt        cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
3956:   PetscInt        eOffset    = 0; /* Offset into elemMat[] for element e */
3957:   PetscInt        offsetI    = 0; /* Offset into an element vector for fieldI */
3958:   PetscInt        offsetJ    = 0; /* Offset into an element vector for fieldJ */
3959:   PetscQuadrature quad;
3960:   PetscScalar    *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
3961:   PetscReal      *x;
3962:   PetscReal     **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
3963:   PetscInt       *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
3964:   PetscInt        NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
3965:   PetscInt        dim, Nf, NfAux = 0, totDim, totDimAux = 0, e;
3966:   PetscErrorCode  ierr;

3969:   PetscFEGetSpatialDimension(fem, &dim);
3970:   PetscFEGetQuadrature(fem, &quad);
3971:   PetscDSGetNumFields(prob, &Nf);
3972:   PetscDSGetTotalDimension(prob, &totDim);
3973:   PetscDSGetDimensions(prob, &Nb);
3974:   PetscDSGetComponents(prob, &Nc);
3975:   PetscDSGetComponentOffsets(prob, &uOff);
3976:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
3977:   switch(jtype) {
3978:   case PETSCFE_JACOBIAN_DYN: PetscDSGetDynamicJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
3979:   case PETSCFE_JACOBIAN_PRE: PetscDSGetJacobianPreconditioner(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
3980:   case PETSCFE_JACOBIAN:     PetscDSGetJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
3981:   }
3982:   if (!g0_func && !g1_func && !g2_func && !g3_func) return(0);
3983:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
3984:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
3985:   PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
3986:   PetscDSGetTabulation(prob, &B, &D);
3987:   PetscDSGetFieldOffset(prob, fieldI, &offsetI);
3988:   PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
3989:   if (probAux) {
3990:     PetscDSGetNumFields(probAux, &NfAux);
3991:     PetscDSGetTotalDimension(probAux, &totDimAux);
3992:     PetscDSGetDimensions(probAux, &NbAux);
3993:     PetscDSGetComponents(probAux, &NcAux);
3994:     PetscDSGetComponentOffsets(probAux, &aOff);
3995:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
3996:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
3997:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
3998:     PetscDSGetTabulation(probAux, &BAux, &DAux);
3999:   }
4000:   NbI = Nb[fieldI], NbJ = Nb[fieldJ];
4001:   NcI = Nc[fieldI], NcJ = Nc[fieldJ];
4002:   BI  = B[fieldI],  BJ  = B[fieldJ];
4003:   DI  = D[fieldI],  DJ  = D[fieldJ];
4004:   /* Initialize here in case the function is not defined */
4005:   PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4006:   PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
4007:   PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
4008:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4009:   for (e = 0; e < Ne; ++e) {
4010:     const PetscReal *v0   = geom[e].v0;
4011:     const PetscReal *J    = geom[e].J;
4012:     const PetscReal *invJ = geom[e].invJ;
4013:     const PetscReal  detJ = geom[e].detJ;
4014:     const PetscReal *quadPoints, *quadWeights;
4015:     PetscInt         Nq, q;

4017:     PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4018:     for (q = 0; q < Nq; ++q) {
4019:       const PetscReal *BIq = &BI[q*NbI*NcI], *BJq = &BJ[q*NbJ*NcJ];
4020:       const PetscReal *DIq = &DI[q*NbI*NcI*dim], *DJq = &DJ[q*NbJ*NcJ*dim];
4021:       const PetscReal  w = detJ*quadWeights[q];
4022:       PetscInt f, g, fc, gc, c;

4024:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4025:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4026:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4027:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4028:       if (g0_func) {
4029:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4030:         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);
4031:         for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
4032:       }
4033:       if (g1_func) {
4034:         PetscInt d, d2;
4035:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4036:         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);
4037:         for (fc = 0; fc < NcI; ++fc) {
4038:           for (gc = 0; gc < NcJ; ++gc) {
4039:             for (d = 0; d < dim; ++d) {
4040:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
4041:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4042:               g1[(fc*NcJ+gc)*dim+d] *= w;
4043:             }
4044:           }
4045:         }
4046:       }
4047:       if (g2_func) {
4048:         PetscInt d, d2;
4049:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4050:         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);
4051:         for (fc = 0; fc < NcI; ++fc) {
4052:           for (gc = 0; gc < NcJ; ++gc) {
4053:             for (d = 0; d < dim; ++d) {
4054:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
4055:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4056:               g2[(fc*NcJ+gc)*dim+d] *= w;
4057:             }
4058:           }
4059:         }
4060:       }
4061:       if (g3_func) {
4062:         PetscInt d, d2, dp, d3;
4063:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4064:         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);
4065:         for (fc = 0; fc < NcI; ++fc) {
4066:           for (gc = 0; gc < NcJ; ++gc) {
4067:             for (d = 0; d < dim; ++d) {
4068:               for (dp = 0; dp < dim; ++dp) {
4069:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
4070:                 for (d2 = 0; d2 < dim; ++d2) {
4071:                   for (d3 = 0; d3 < dim; ++d3) {
4072:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
4073:                   }
4074:                 }
4075:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
4076:               }
4077:             }
4078:           }
4079:         }
4080:       }

4082:       for (f = 0; f < NbI; ++f) {
4083:         for (fc = 0; fc < NcI; ++fc) {
4084:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
4085:           const PetscInt i    = offsetI+fidx; /* Element matrix row */
4086:           for (g = 0; g < NbJ; ++g) {
4087:             for (gc = 0; gc < NcJ; ++gc) {
4088:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
4089:               const PetscInt j    = offsetJ+gidx; /* Element matrix column */
4090:               const PetscInt fOff = eOffset+i*totDim+j;
4091:               PetscInt       d, d2;

4093:               elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
4094:               for (d = 0; d < dim; ++d) {
4095:                 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
4096:                 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
4097:                 for (d2 = 0; d2 < dim; ++d2) {
4098:                   elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
4099:                 }
4100:               }
4101:             }
4102:           }
4103:         }
4104:       }
4105:     }
4106:     if (debug > 1) {
4107:       PetscInt fc, f, gc, g;

4109:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
4110:       for (fc = 0; fc < NcI; ++fc) {
4111:         for (f = 0; f < NbI; ++f) {
4112:           const PetscInt i = offsetI + f*NcI+fc;
4113:           for (gc = 0; gc < NcJ; ++gc) {
4114:             for (g = 0; g < NbJ; ++g) {
4115:               const PetscInt j = offsetJ + g*NcJ+gc;
4116:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
4117:             }
4118:           }
4119:           PetscPrintf(PETSC_COMM_SELF, "\n");
4120:         }
4121:       }
4122:     }
4123:     cOffset    += totDim;
4124:     cOffsetAux += totDimAux;
4125:     eOffset    += PetscSqr(totDim);
4126:   }
4127:   return(0);
4128: }

4130: PetscErrorCode PetscFEIntegrateBdJacobian_Basic(PetscFE fem, PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEFaceGeom *fgeom,
4131:                                                 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
4132: {
4133:   const PetscInt  debug      = 0;
4134:   PetscBdPointJac g0_func;
4135:   PetscBdPointJac g1_func;
4136:   PetscBdPointJac g2_func;
4137:   PetscBdPointJac g3_func;
4138:   PetscInt        cOffset    = 0; /* Offset into coefficients[] for element e */
4139:   PetscInt        cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
4140:   PetscInt        eOffset    = 0; /* Offset into elemMat[] for element e */
4141:   PetscInt        offsetI    = 0; /* Offset into an element vector for fieldI */
4142:   PetscInt        offsetJ    = 0; /* Offset into an element vector for fieldJ */
4143:   PetscQuadrature quad;
4144:   PetscScalar    *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4145:   PetscReal      *x;
4146:   PetscReal     **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
4147:   PetscInt       *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4148:   PetscInt        NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
4149:   PetscInt        dim, Nf, NfAux = 0, totDim, totDimAux = 0, e;
4150:   PetscErrorCode  ierr;

4153:   PetscFEGetSpatialDimension(fem, &dim);
4154:   PetscFEGetFaceQuadrature(fem, &quad);
4155:   PetscDSGetNumFields(prob, &Nf);
4156:   PetscDSGetTotalDimension(prob, &totDim);
4157:   PetscDSGetDimensions(prob, &Nb);
4158:   PetscDSGetComponents(prob, &Nc);
4159:   PetscDSGetComponentOffsets(prob, &uOff);
4160:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4161:   PetscDSGetFieldOffset(prob, fieldI, &offsetI);
4162:   PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
4163:   PetscDSGetBdJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);
4164:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4165:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4166:   PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
4167:   PetscDSGetFaceTabulation(prob, &B, &D);
4168:   if (probAux) {
4169:     PetscDSGetNumFields(probAux, &NfAux);
4170:     PetscDSGetTotalDimension(probAux, &totDimAux);
4171:     PetscDSGetDimensions(probAux, &NbAux);
4172:     PetscDSGetComponents(probAux, &NcAux);
4173:     PetscDSGetComponentOffsets(probAux, &aOff);
4174:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4175:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4176:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4177:     PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
4178:   }
4179:   NbI = Nb[fieldI], NbJ = Nb[fieldJ];
4180:   NcI = Nc[fieldI], NcJ = Nc[fieldJ];
4181:   BI  = B[fieldI],  BJ  = B[fieldJ];
4182:   DI  = D[fieldI],  DJ  = D[fieldJ];
4183:   /* Initialize here in case the function is not defined */
4184:   PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4185:   PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
4186:   PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
4187:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4188:   for (e = 0; e < Ne; ++e) {
4189:     const PetscReal *quadPoints, *quadWeights;
4190:     const PetscReal *v0   = fgeom[e].v0;
4191:     const PetscReal *J    = fgeom[e].J;
4192:     const PetscReal *invJ = fgeom[e].invJ[0];
4193:     const PetscReal  detJ = fgeom[e].detJ;
4194:     const PetscReal *n    = fgeom[e].n;
4195:     const PetscInt   face = fgeom[e].face[0];
4196:     PetscInt         Nq, q;

4198:     PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4199:     for (q = 0; q < Nq; ++q) {
4200:       const PetscReal *BIq = &BI[(face*Nq+q)*NbI*NcI], *BJq = &BJ[(face*Nq+q)*NbJ*NcJ];
4201:       const PetscReal *DIq = &DI[(face*Nq+q)*NbI*NcI*dim], *DJq = &DJ[(face*Nq+q)*NbJ*NcJ*dim];
4202:       const PetscReal  w = detJ*quadWeights[q];
4203:       PetscInt f, g, fc, gc, c;

4205:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4206:       CoordinatesRefToReal(dim, dim-1, v0, J, &quadPoints[q*(dim-1)], x);
4207:       EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4208:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4209:       if (g0_func) {
4210:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4211:         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);
4212:         for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
4213:       }
4214:       if (g1_func) {
4215:         PetscInt d, d2;
4216:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4217:         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);
4218:         for (fc = 0; fc < NcI; ++fc) {
4219:           for (gc = 0; gc < NcJ; ++gc) {
4220:             for (d = 0; d < dim; ++d) {
4221:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
4222:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4223:               g1[(fc*NcJ+gc)*dim+d] *= w;
4224:             }
4225:           }
4226:         }
4227:       }
4228:       if (g2_func) {
4229:         PetscInt d, d2;
4230:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4231:         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);
4232:         for (fc = 0; fc < NcI; ++fc) {
4233:           for (gc = 0; gc < NcJ; ++gc) {
4234:             for (d = 0; d < dim; ++d) {
4235:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
4236:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4237:               g2[(fc*NcJ+gc)*dim+d] *= w;
4238:             }
4239:           }
4240:         }
4241:       }
4242:       if (g3_func) {
4243:         PetscInt d, d2, dp, d3;
4244:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4245:         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);
4246:         for (fc = 0; fc < NcI; ++fc) {
4247:           for (gc = 0; gc < NcJ; ++gc) {
4248:             for (d = 0; d < dim; ++d) {
4249:               for (dp = 0; dp < dim; ++dp) {
4250:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
4251:                 for (d2 = 0; d2 < dim; ++d2) {
4252:                   for (d3 = 0; d3 < dim; ++d3) {
4253:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
4254:                   }
4255:                 }
4256:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
4257:               }
4258:             }
4259:           }
4260:         }
4261:       }

4263:       for (f = 0; f < NbI; ++f) {
4264:         for (fc = 0; fc < NcI; ++fc) {
4265:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
4266:           const PetscInt i    = offsetI+fidx; /* Element matrix row */
4267:           for (g = 0; g < NbJ; ++g) {
4268:             for (gc = 0; gc < NcJ; ++gc) {
4269:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
4270:               const PetscInt j    = offsetJ+gidx; /* Element matrix column */
4271:               const PetscInt fOff = eOffset+i*totDim+j;
4272:               PetscInt       d, d2;

4274:               elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
4275:               for (d = 0; d < dim; ++d) {
4276:                 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
4277:                 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
4278:                 for (d2 = 0; d2 < dim; ++d2) {
4279:                   elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
4280:                 }
4281:               }
4282:             }
4283:           }
4284:         }
4285:       }
4286:     }
4287:     if (debug > 1) {
4288:       PetscInt fc, f, gc, g;

4290:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
4291:       for (fc = 0; fc < NcI; ++fc) {
4292:         for (f = 0; f < NbI; ++f) {
4293:           const PetscInt i = offsetI + f*NcI+fc;
4294:           for (gc = 0; gc < NcJ; ++gc) {
4295:             for (g = 0; g < NbJ; ++g) {
4296:               const PetscInt j = offsetJ + g*NcJ+gc;
4297:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
4298:             }
4299:           }
4300:           PetscPrintf(PETSC_COMM_SELF, "\n");
4301:         }
4302:       }
4303:     }
4304:     cOffset    += totDim;
4305:     cOffsetAux += totDimAux;
4306:     eOffset    += PetscSqr(totDim);
4307:   }
4308:   return(0);
4309: }

4311: PetscErrorCode PetscFEInitialize_Basic(PetscFE fem)
4312: {
4314:   fem->ops->setfromoptions          = NULL;
4315:   fem->ops->setup                   = PetscFESetUp_Basic;
4316:   fem->ops->view                    = PetscFEView_Basic;
4317:   fem->ops->destroy                 = PetscFEDestroy_Basic;
4318:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
4319:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
4320:   fem->ops->integrate               = PetscFEIntegrate_Basic;
4321:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Basic;
4322:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Basic;
4323:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Basic */;
4324:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
4325:   fem->ops->integratebdjacobian     = PetscFEIntegrateBdJacobian_Basic;
4326:   return(0);
4327: }

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

4332:   Level: intermediate

4334: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
4335: M*/

4337: PETSC_EXTERN PetscErrorCode PetscFECreate_Basic(PetscFE fem)
4338: {
4339:   PetscFE_Basic *b;

4344:   PetscNewLog(fem,&b);
4345:   fem->data = b;

4347:   PetscFEInitialize_Basic(fem);
4348:   return(0);
4349: }

4351: PetscErrorCode PetscFEDestroy_Nonaffine(PetscFE fem)
4352: {
4353:   PetscFE_Nonaffine *na = (PetscFE_Nonaffine *) fem->data;

4357:   PetscFree(na);
4358:   return(0);
4359: }

4361: PetscErrorCode PetscFEIntegrateResidual_Nonaffine(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
4362:                                                   const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4363: {
4364:   const PetscInt  debug = 0;
4365:   PetscPointFunc  f0_func;
4366:   PetscPointFunc  f1_func;
4367:   PetscQuadrature quad;
4368:   PetscScalar    *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4369:   PetscReal      *x;
4370:   PetscReal     **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4371:   PetscInt       *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4372:   PetscInt       dim, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;

4376:   PetscFEGetSpatialDimension(fem, &dim);
4377:   PetscFEGetQuadrature(fem, &quad);
4378:   PetscDSGetNumFields(prob, &Nf);
4379:   PetscDSGetTotalDimension(prob, &totDim);
4380:   PetscDSGetDimensions(prob, &Nb);
4381:   PetscDSGetComponents(prob, &Nc);
4382:   PetscDSGetComponentOffsets(prob, &uOff);
4383:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4384:   PetscDSGetFieldOffset(prob, field, &fOffset);
4385:   PetscDSGetResidual(prob, field, &f0_func, &f1_func);
4386:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4387:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4388:   PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4389:   PetscDSGetTabulation(prob, &B, &D);
4390:   if (probAux) {
4391:     PetscDSGetNumFields(probAux, &NfAux);
4392:     PetscDSGetTotalDimension(probAux, &totDimAux);
4393:     PetscDSGetDimensions(probAux, &NbAux);
4394:     PetscDSGetComponents(probAux, &NcAux);
4395:     PetscDSGetComponentOffsets(probAux, &aOff);
4396:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4397:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4398:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4399:     PetscDSGetTabulation(probAux, &BAux, &DAux);
4400:   }
4401:   NbI = Nb[field];
4402:   NcI = Nc[field];
4403:   BI  = B[field];
4404:   DI  = D[field];
4405:   for (e = 0; e < Ne; ++e) {
4406:     const PetscReal *quadPoints, *quadWeights;
4407:     PetscInt         Nq, q;

4409:     PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4410:     PetscMemzero(f0, Nq*Nc[field]* sizeof(PetscScalar));
4411:     PetscMemzero(f1, Nq*Nc[field]*dim * sizeof(PetscScalar));
4412:     for (q = 0; q < Nq; ++q) {
4413:       const PetscReal *v0   = cgeom[e*Nq+q].v0;
4414:       const PetscReal *J    = cgeom[e*Nq+q].J;
4415:       const PetscReal *invJ = cgeom[e*Nq+q].invJ;
4416:       const PetscReal  detJ = cgeom[e*Nq+q].detJ;

4418:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4419:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4420:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4421:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4422:       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]);
4423:       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);
4424:       TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0, f1);
4425:     }
4426:     UpdateElementVec(dim, Nq, NbI, NcI, BI, DI, f0, f1, &elemVec[cOffset+fOffset]);
4427:     cOffset    += totDim;
4428:     cOffsetAux += totDimAux;
4429:   }
4430:   return(0);
4431: }

4433: PetscErrorCode PetscFEIntegrateBdResidual_Nonaffine(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEFaceGeom *fgeom,
4434:                                                 const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4435: {
4436:    const PetscInt   debug = 0;
4437:    PetscBdPointFunc f0_func;
4438:    PetscBdPointFunc f1_func;
4439:    PetscQuadrature  quad;
4440:    PetscScalar     *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4441:    PetscReal       *x;
4442:    PetscReal      **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4443:    PetscInt        *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4444:    PetscInt         dim, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
4445:    PetscErrorCode   ierr;
4446: 
4448:    PetscFEGetSpatialDimension(fem, &dim);
4449:    PetscFEGetFaceQuadrature(fem, &quad);
4450:    PetscDSGetNumFields(prob, &Nf);
4451:    PetscDSGetTotalDimension(prob, &totDim);
4452:    PetscDSGetDimensions(prob, &Nb);
4453:    PetscDSGetComponents(prob, &Nc);
4454:    PetscDSGetComponentOffsets(prob, &uOff);
4455:    PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4456:    PetscDSGetFieldOffset(prob, field, &fOffset);
4457:    PetscDSGetBdResidual(prob, field, &f0_func, &f1_func);
4458:    if (!f0_func && !f1_func) return(0);
4459:    PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4460:    PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4461:    PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4462:    PetscDSGetFaceTabulation(prob, &B, &D);
4463:    if (probAux) {
4464:      PetscDSGetNumFields(probAux, &NfAux);
4465:      PetscDSGetTotalDimension(probAux, &totDimAux);
4466:      PetscDSGetDimensions(probAux, &NbAux);
4467:      PetscDSGetComponents(probAux, &NcAux);
4468:      PetscDSGetComponentOffsets(probAux, &aOff);
4469:      PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4470:      PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4471:      PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4472:      PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
4473:    }
4474:    NbI = Nb[field];
4475:    NcI = Nc[field];
4476:    BI  = B[field];
4477:    DI  = D[field];
4478:    for (e = 0; e < Ne; ++e) {
4479:      const PetscReal *quadPoints, *quadWeights;
4480:      PetscInt         Nq, q, face;
4481: 
4482:      PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4483:      face = fgeom[e*Nq].face[0];
4484:      PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
4485:      PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
4486:      for (q = 0; q < Nq; ++q) {
4487:        const PetscReal *v0   = fgeom[e*Nq+q].v0;
4488:        const PetscReal *J    = fgeom[e*Nq+q].J;
4489:        const PetscReal *invJ = fgeom[e*Nq+q].invJ[0];
4490:        const PetscReal  detJ = fgeom[e*Nq+q].detJ;
4491:        const PetscReal *n    = fgeom[e*Nq+q].n;

4493:        if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4494:        CoordinatesRefToReal(dim, dim-1, v0, J, &quadPoints[q*(dim-1)], x);
4495:        EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4496:        if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4497:        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]);
4498:        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);
4499:        TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
4500:      }
4501:      UpdateElementVec(dim, Nq, NbI, NcI, &BI[face*Nq*NbI*NcI], &DI[face*Nq*NbI*NcI*dim], f0, f1, &elemVec[cOffset+fOffset]);
4502:      cOffset    += totDim;
4503:      cOffsetAux += totDimAux;
4504:    }
4505:    return(0);
4506: }

4508: PetscErrorCode PetscFEIntegrateJacobian_Nonaffine(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFECellGeom *cgeom,
4509:                                                   const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
4510: {
4511:   const PetscInt  debug      = 0;
4512:   PetscPointJac   g0_func;
4513:   PetscPointJac   g1_func;
4514:   PetscPointJac   g2_func;
4515:   PetscPointJac   g3_func;
4516:   PetscInt        cOffset    = 0; /* Offset into coefficients[] for element e */
4517:   PetscInt        cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
4518:   PetscInt        eOffset    = 0; /* Offset into elemMat[] for element e */
4519:   PetscInt        offsetI    = 0; /* Offset into an element vector for fieldI */
4520:   PetscInt        offsetJ    = 0; /* Offset into an element vector for fieldJ */
4521:   PetscQuadrature quad;
4522:   PetscScalar    *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4523:   PetscReal      *x;
4524:   PetscReal     **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
4525:   PetscInt        NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
4526:   PetscInt       *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4527:   PetscInt        dim, Nf, NfAux = 0, totDim, totDimAux = 0, e;
4528:   PetscErrorCode  ierr;

4531:   PetscFEGetSpatialDimension(fem, &dim);
4532:   PetscFEGetQuadrature(fem, &quad);
4533:   PetscDSGetNumFields(prob, &Nf);
4534:   PetscDSGetTotalDimension(prob, &totDim);
4535:   PetscDSGetDimensions(prob, &Nb);
4536:   PetscDSGetComponents(prob, &Nc);
4537:   PetscDSGetComponentOffsets(prob, &uOff);
4538:   PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4539:   switch(jtype) {
4540:   case PETSCFE_JACOBIAN_DYN: PetscDSGetDynamicJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4541:   case PETSCFE_JACOBIAN_PRE: PetscDSGetJacobianPreconditioner(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4542:   case PETSCFE_JACOBIAN:     PetscDSGetJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4543:   }
4544:   PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4545:   PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4546:   PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
4547:   PetscDSGetTabulation(prob, &B, &D);
4548:   PetscDSGetFieldOffset(prob, fieldI, &offsetI);
4549:   PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
4550:   if (probAux) {
4551:     PetscDSGetNumFields(probAux, &NfAux);
4552:     PetscDSGetTotalDimension(probAux, &totDimAux);
4553:     PetscDSGetDimensions(probAux, &NbAux);
4554:     PetscDSGetComponents(probAux, &NcAux);
4555:     PetscDSGetComponentOffsets(probAux, &aOff);
4556:     PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4557:     PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4558:     PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4559:     PetscDSGetTabulation(probAux, &BAux, &DAux);
4560:   }
4561:   NbI = Nb[fieldI], NbJ = Nb[fieldJ];
4562:   NcI = Nc[fieldI], NcJ = Nc[fieldJ];
4563:   BI  = B[fieldI],  BJ  = B[fieldJ];
4564:   DI  = D[fieldI],  DJ  = D[fieldJ];
4565:   /* Initialize here in case the function is not defined */
4566:   PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4567:   PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
4568:   PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
4569:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4570:   for (e = 0; e < Ne; ++e) {
4571:     const PetscReal *quadPoints, *quadWeights;
4572:     PetscInt         Nq, q;

4574:     PetscQuadratureGetData(quad, NULL, &Nq, &quadPoints, &quadWeights);
4575:     for (q = 0; q < Nq; ++q) {
4576:       const PetscReal *v0   = cgeom[e*Nq+q].v0;
4577:       const PetscReal *J    = cgeom[e*Nq+q].J;
4578:       const PetscReal *invJ = cgeom[e*Nq+q].invJ;
4579:       const PetscReal  detJ = cgeom[e*Nq+q].detJ;
4580:       const PetscReal *BIq = &BI[q*NbI*NcI], *BJq = &BJ[q*NbJ*NcJ];
4581:       const PetscReal *DIq = &DI[q*NbI*NcI*dim], *DJq = &DJ[q*NbJ*NcJ*dim];
4582:       const PetscReal  w = detJ*quadWeights[q];
4583:       PetscInt         f, g, fc, gc, c;

4585:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4586:       CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4587:       EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4588:       if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4589:       if (g0_func) {
4590:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4591:         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);
4592:         for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
4593:       }
4594:       if (g1_func) {
4595:         PetscInt d, d2;
4596:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4597:         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);
4598:         for (fc = 0; fc < NcI; ++fc) {
4599:           for (gc = 0; gc < NcJ; ++gc) {
4600:             for (d = 0; d < dim; ++d) {
4601:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
4602:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4603:               g1[(fc*NcJ+gc)*dim+d] *= w;
4604:             }
4605:           }
4606:         }
4607:       }
4608:       if (g2_func) {
4609:         PetscInt d, d2;
4610:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4611:         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);
4612:         for (fc = 0; fc < NcI; ++fc) {
4613:           for (gc = 0; gc < NcJ; ++gc) {
4614:             for (d = 0; d < dim; ++d) {
4615:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
4616:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4617:               g2[(fc*NcJ+gc)*dim+d] *= w;
4618:             }
4619:           }
4620:         }
4621:       }
4622:       if (g3_func) {
4623:         PetscInt d, d2, dp, d3;
4624:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4625:         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);
4626:         for (fc = 0; fc < NcI; ++fc) {
4627:           for (gc = 0; gc < NcJ; ++gc) {
4628:             for (d = 0; d < dim; ++d) {
4629:               for (dp = 0; dp < dim; ++dp) {
4630:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
4631:                 for (d2 = 0; d2 < dim; ++d2) {
4632:                   for (d3 = 0; d3 < dim; ++d3) {
4633:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
4634:                   }
4635:                 }
4636:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
4637:               }
4638:             }
4639:           }
4640:         }
4641:       }

4643:       for (f = 0; f < NbI; ++f) {
4644:         for (fc = 0; fc < NcI; ++fc) {
4645:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
4646:           const PetscInt i    = offsetI+fidx; /* Element matrix row */
4647:           for (g = 0; g < NbJ; ++g) {
4648:             for (gc = 0; gc < NcJ; ++gc) {
4649:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
4650:               const PetscInt j    = offsetJ+gidx; /* Element matrix column */
4651:               const PetscInt fOff = eOffset+i*totDim+j;
4652:               PetscInt       d, d2;

4654:               elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
4655:               for (d = 0; d < dim; ++d) {
4656:                 elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
4657:                 elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
4658:                 for (d2 = 0; d2 < dim; ++d2) {
4659:                   elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
4660:                 }
4661:               }
4662:             }
4663:           }
4664:         }
4665:       }
4666:     }
4667:     if (debug > 1) {
4668:       PetscInt fc, f, gc, g;

4670:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
4671:       for (fc = 0; fc < NcI; ++fc) {
4672:         for (f = 0; f < NbI; ++f) {
4673:           const PetscInt i = offsetI + f*NcI+fc;
4674:           for (gc = 0; gc < NcJ; ++gc) {
4675:             for (g = 0; g < NbJ; ++g) {
4676:               const PetscInt j = offsetJ + g*NcJ+gc;
4677:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
4678:             }
4679:           }
4680:           PetscPrintf(PETSC_COMM_SELF, "\n");
4681:         }
4682:       }
4683:     }
4684:     cOffset    += totDim;
4685:     cOffsetAux += totDimAux;
4686:     eOffset    += PetscSqr(totDim);
4687:   }
4688:   return(0);
4689: }

4691: PetscErrorCode PetscFEInitialize_Nonaffine(PetscFE fem)
4692: {
4694:   fem->ops->setfromoptions          = NULL;
4695:   fem->ops->setup                   = PetscFESetUp_Basic;
4696:   fem->ops->view                    = NULL;
4697:   fem->ops->destroy                 = PetscFEDestroy_Nonaffine;
4698:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
4699:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
4700:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Nonaffine;
4701:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Nonaffine;
4702:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Nonaffine */;
4703:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Nonaffine;
4704:   return(0);
4705: }

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

4710:   Level: intermediate

4712: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
4713: M*/

4715: PETSC_EXTERN PetscErrorCode PetscFECreate_Nonaffine(PetscFE fem)
4716: {
4717:   PetscFE_Nonaffine *na;
4718:   PetscErrorCode     ierr;

4722:   PetscNewLog(fem, &na);
4723:   fem->data = na;

4725:   PetscFEInitialize_Nonaffine(fem);
4726:   return(0);
4727: }

4729: #ifdef PETSC_HAVE_OPENCL

4731: PetscErrorCode PetscFEDestroy_OpenCL(PetscFE fem)
4732: {
4733:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
4734:   PetscErrorCode  ierr;

4737:   clReleaseCommandQueue(ocl->queue_id);
4738:   ocl->queue_id = 0;
4739:   clReleaseContext(ocl->ctx_id);
4740:   ocl->ctx_id = 0;
4741:   PetscFree(ocl);
4742:   return(0);
4743: }

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

4748: /* dim     Number of spatial dimensions:          2                   */
4749: /* N_b     Number of basis functions:             generated           */
4750: /* N_{bt}  Number of total basis functions:       N_b * N_{comp}      */
4751: /* N_q     Number of quadrature points:           generated           */
4752: /* N_{bs}  Number of block cells                  LCM(N_b, N_q)       */
4753: /* N_{bst} Number of block cell components        LCM(N_{bt}, N_q)    */
4754: /* N_{bl}  Number of concurrent blocks            generated           */
4755: /* N_t     Number of threads:                     N_{bl} * N_{bs}     */
4756: /* N_{cbc} Number of concurrent basis      cells: N_{bl} * N_q        */
4757: /* N_{cqc} Number of concurrent quadrature cells: N_{bl} * N_b        */
4758: /* N_{sbc} Number of serial     basis      cells: N_{bs} / N_q        */
4759: /* N_{sqc} Number of serial     quadrature cells: N_{bs} / N_b        */
4760: /* N_{cb}  Number of serial cell batches:         input               */
4761: /* N_c     Number of total cells:                 N_{cb}*N_{t}/N_{comp} */
4762: PetscErrorCode PetscFEOpenCLGenerateIntegrationCode(PetscFE fem, char **string_buffer, PetscInt buffer_length, PetscBool useAux, PetscInt N_bl)
4763: {
4764:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
4765:   PetscQuadrature q;
4766:   char           *string_tail   = *string_buffer;
4767:   char           *end_of_buffer = *string_buffer + buffer_length;
4768:   char            float_str[]   = "float", double_str[]  = "double";
4769:   char           *numeric_str   = &(float_str[0]);
4770:   PetscInt        op            = ocl->op;
4771:   PetscBool       useField      = PETSC_FALSE;
4772:   PetscBool       useFieldDer   = PETSC_TRUE;
4773:   PetscBool       useFieldAux   = useAux;
4774:   PetscBool       useFieldDerAux= PETSC_FALSE;
4775:   PetscBool       useF0         = PETSC_TRUE;
4776:   PetscBool       useF1         = PETSC_TRUE;
4777:   PetscReal      *basis, *basisDer;
4778:   PetscInt        dim, N_b, N_c, N_q, N_t, p, d, b, c;
4779:   size_t          count;
4780:   PetscErrorCode  ierr;

4783:   PetscFEGetSpatialDimension(fem, &dim);
4784:   PetscFEGetDimension(fem, &N_b);
4785:   PetscFEGetNumComponents(fem, &N_c);
4786:   PetscFEGetQuadrature(fem, &q);
4787:   N_q  = q->numPoints;
4788:   N_t  = N_b * N_c * N_q * N_bl;
4789:   /* Enable device extension for double precision */
4790:   if (ocl->realType == PETSC_DOUBLE) {
4791:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4792: "#if defined(cl_khr_fp64)\n"
4793: "#  pragma OPENCL EXTENSION cl_khr_fp64: enable\n"
4794: "#elif defined(cl_amd_fp64)\n"
4795: "#  pragma OPENCL EXTENSION cl_amd_fp64: enable\n"
4796: "#endif\n",
4797:                               &count);STRING_ERROR_CHECK("Message to short");
4798:     numeric_str  = &(double_str[0]);
4799:   }
4800:   /* Kernel API */
4801:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4802: "\n"
4803: "__kernel void integrateElementQuadrature(int N_cb, __global %s *coefficients, __global %s *coefficientsAux, __global %s *jacobianInverses, __global %s *jacobianDeterminants, __global %s *elemVec)\n"
4804: "{\n",
4805:                        &count, numeric_str, numeric_str, numeric_str, numeric_str, numeric_str);STRING_ERROR_CHECK("Message to short");
4806:   /* Quadrature */
4807:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4808: "  /* Quadrature points\n"
4809: "   - (x1,y1,x2,y2,...) */\n"
4810: "  const %s points[%d] = {\n",
4811:                        &count, numeric_str, N_q*dim);STRING_ERROR_CHECK("Message to short");
4812:   for (p = 0; p < N_q; ++p) {
4813:     for (d = 0; d < dim; ++d) {
4814:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "%g,\n", &count, q->points[p*dim+d]);STRING_ERROR_CHECK("Message to short");
4815:     }
4816:   }
4817:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
4818:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4819: "  /* Quadrature weights\n"
4820: "   - (v1,v2,...) */\n"
4821: "  const %s weights[%d] = {\n",
4822:                        &count, numeric_str, N_q);STRING_ERROR_CHECK("Message to short");
4823:   for (p = 0; p < N_q; ++p) {
4824:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "%g,\n", &count, q->weights[p]);STRING_ERROR_CHECK("Message to short");
4825:   }
4826:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
4827:   /* Basis Functions */
4828:   PetscFEGetDefaultTabulation(fem, &basis, &basisDer, NULL);
4829:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4830: "  /* Nodal basis function evaluations\n"
4831: "    - basis component is fastest varying, the basis function, then point */\n"
4832: "  const %s Basis[%d] = {\n",
4833:                        &count, numeric_str, N_q*N_b*N_c);STRING_ERROR_CHECK("Message to short");
4834:   for (p = 0; p < N_q; ++p) {
4835:     for (b = 0; b < N_b; ++b) {
4836:       for (c = 0; c < N_c; ++c) {
4837:         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");
4838:       }
4839:     }
4840:   }
4841:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
4842:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4843: "\n"
4844: "  /* Nodal basis function derivative evaluations,\n"
4845: "      - derivative direction is fastest varying, then basis component, then basis function, then point */\n"
4846: "  const %s%d BasisDerivatives[%d] = {\n",
4847:                        &count, numeric_str, dim, N_q*N_b*N_c);STRING_ERROR_CHECK("Message to short");
4848:   for (p = 0; p < N_q; ++p) {
4849:     for (b = 0; b < N_b; ++b) {
4850:       for (c = 0; c < N_c; ++c) {
4851:         PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "(%s%d)(", &count, numeric_str, dim);STRING_ERROR_CHECK("Message to short");
4852:         for (d = 0; d < dim; ++d) {
4853:           if (d > 0) {
4854:             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");
4855:           } else {
4856:             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");
4857:           }
4858:         }
4859:         PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "),\n", &count);STRING_ERROR_CHECK("Message to short");
4860:       }
4861:     }
4862:   }
4863:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
4864:   /* Sizes */
4865:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4866: "  const int dim    = %d;                           // The spatial dimension\n"
4867: "  const int N_bl   = %d;                           // The number of concurrent blocks\n"
4868: "  const int N_b    = %d;                           // The number of basis functions\n"
4869: "  const int N_comp = %d;                           // The number of basis function components\n"
4870: "  const int N_bt   = N_b*N_comp;                    // The total number of scalar basis functions\n"
4871: "  const int N_q    = %d;                           // The number of quadrature points\n"
4872: "  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"
4873: "  const int N_t    = N_bst*N_bl;                    // The number of threads, N_bst * N_bl\n"
4874: "  const int N_bc   = N_t/N_comp;                    // The number of cells per batch (N_b*N_q*N_bl)\n"
4875: "  const int N_sbc  = N_bst / (N_q * N_comp);\n"
4876: "  const int N_sqc  = N_bst / N_bt;\n"
4877: "  /*const int N_c    = N_cb * N_bc;*/\n"
4878: "\n"
4879: "  /* Calculated indices */\n"
4880: "  /*const int tidx    = get_local_id(0) + get_local_size(0)*get_local_id(1);*/\n"
4881: "  const int tidx    = get_local_id(0);\n"
4882: "  const int blidx   = tidx / N_bst;                  // Block number for this thread\n"
4883: "  const int bidx    = tidx %% N_bt;                   // Basis function mapped to this thread\n"
4884: "  const int cidx    = tidx %% N_comp;                 // Basis component mapped to this thread\n"
4885: "  const int qidx    = tidx %% N_q;                    // Quadrature point mapped to this thread\n"
4886: "  const int blbidx  = tidx %% N_q + blidx*N_q;        // Cell mapped to this thread in the basis phase\n"
4887: "  const int blqidx  = tidx %% N_b + blidx*N_b;        // Cell mapped to this thread in the quadrature phase\n"
4888: "  const int gidx    = get_group_id(1)*get_num_groups(0) + get_group_id(0);\n"
4889: "  const int Goffset = gidx*N_cb*N_bc;\n",
4890:                             &count, dim, N_bl, N_b, N_c, N_q);STRING_ERROR_CHECK("Message to short");
4891:   /* Local memory */
4892:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4893: "\n"
4894: "  /* Quadrature data */\n"
4895: "  %s                w;                   // $w_q$, Quadrature weight at $x_q$\n"
4896: "  __local %s         phi_i[%d];    //[N_bt*N_q];  // $\\phi_i(x_q)$, Value of the basis function $i$ at $x_q$\n"
4897: "  __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"
4898: "  /* Geometric data */\n"
4899: "  __local %s        detJ[%d]; //[N_t];           // $|J(x_q)|$, Jacobian determinant at $x_q$\n"
4900: "  __local %s        invJ[%d];//[N_t*dim*dim];   // $J^{-1}(x_q)$, Jacobian inverse at $x_q$\n",
4901:                             &count, numeric_str, numeric_str, N_b*N_c*N_q, numeric_str, dim, N_b*N_c*N_q, numeric_str, N_t,
4902:                             numeric_str, N_t*dim*dim, numeric_str, N_t*N_b*N_c);STRING_ERROR_CHECK("Message to short");
4903:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4904: "  /* FEM data */\n"
4905: "  __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",
4906:                             &count, numeric_str, N_t*N_b*N_c);STRING_ERROR_CHECK("Message to short");
4907:   if (useAux) {
4908:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4909: "  __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",
4910:                             &count, numeric_str, N_t);STRING_ERROR_CHECK("Message to short");
4911:   }
4912:   if (useF0) {
4913:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4914: "  /* Intermediate calculations */\n"
4915: "  __local %s         f_0[%d]; //[N_t*N_sqc];      // $f_0(u(x_q), \\nabla u(x_q)) |J(x_q)| w_q$\n",
4916:                               &count, numeric_str, N_t*N_q);STRING_ERROR_CHECK("Message to short");
4917:   }
4918:   if (useF1) {
4919:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4920: "  __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",
4921:                               &count, numeric_str, dim, N_t*N_q);STRING_ERROR_CHECK("Message to short");
4922:   }
4923:   /* TODO: If using elasticity, put in mu/lambda coefficients */
4924:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4925: "  /* Output data */\n"
4926: "  %s                e_i;                 // Coefficient $e_i$ of the residual\n\n",
4927:                             &count, numeric_str);STRING_ERROR_CHECK("Message to short");
4928:   /* One-time loads */
4929:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4930: "  /* These should be generated inline */\n"
4931: "  /* Load quadrature weights */\n"
4932: "  w = weights[qidx];\n"
4933: "  /* Load basis tabulation \\phi_i for this cell */\n"
4934: "  if (tidx < N_bt*N_q) {\n"
4935: "    phi_i[tidx]    = Basis[tidx];\n"
4936: "    phiDer_i[tidx] = BasisDerivatives[tidx];\n"
4937: "  }\n\n",
4938:                        &count);STRING_ERROR_CHECK("Message to short");
4939:   /* Batch loads */
4940:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4941: "  for (int batch = 0; batch < N_cb; ++batch) {\n"
4942: "    /* Load geometry */\n"
4943: "    detJ[tidx] = jacobianDeterminants[Goffset+batch*N_bc+tidx];\n"
4944: "    for (int n = 0; n < dim*dim; ++n) {\n"
4945: "      const int offset = n*N_t;\n"
4946: "      invJ[offset+tidx] = jacobianInverses[(Goffset+batch*N_bc)*dim*dim+offset+tidx];\n"
4947: "    }\n"
4948: "    /* Load coefficients u_i for this cell */\n"
4949: "    for (int n = 0; n < N_bt; ++n) {\n"
4950: "      const int offset = n*N_t;\n"
4951: "      u_i[offset+tidx] = coefficients[(Goffset*N_bt)+batch*N_t*N_b+offset+tidx];\n"
4952: "    }\n",
4953:                        &count);STRING_ERROR_CHECK("Message to short");
4954:   if (useAux) {
4955:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4956: "    /* Load coefficients a_i for this cell */\n"
4957: "    /* TODO: This should not be N_t here, it should be N_bc*N_comp_aux */\n"
4958: "    a_i[tidx] = coefficientsAux[Goffset+batch*N_t+tidx];\n",
4959:                             &count);STRING_ERROR_CHECK("Message to short");
4960:   }
4961:   /* Quadrature phase */
4962:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4963: "    barrier(CLK_LOCAL_MEM_FENCE);\n"
4964: "\n"
4965: "    /* Map coefficients to values at quadrature points */\n"
4966: "    for (int c = 0; c < N_sqc; ++c) {\n"
4967: "      const int cell          = c*N_bl*N_b + blqidx;\n"
4968: "      const int fidx          = (cell*N_q + qidx)*N_comp + cidx;\n",
4969:                        &count);STRING_ERROR_CHECK("Message to short");
4970:   if (useField) {
4971:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4972: "      %s  u[%d]; //[N_comp];     // $u(x_q)$, Value of the field at $x_q$\n",
4973:                               &count, numeric_str, N_c);STRING_ERROR_CHECK("Message to short");
4974:   }
4975:   if (useFieldDer) {
4976:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4977: "      %s%d   gradU[%d]; //[N_comp]; // $\\nabla u(x_q)$, Value of the field gradient at $x_q$\n",
4978:                               &count, numeric_str, dim, N_c);STRING_ERROR_CHECK("Message to short");
4979:   }
4980:   if (useFieldAux) {
4981:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4982: "      %s  a[%d]; //[1];     // $a(x_q)$, Value of the auxiliary fields at $x_q$\n",
4983:                               &count, numeric_str, 1);STRING_ERROR_CHECK("Message to short");
4984:   }
4985:   if (useFieldDerAux) {
4986:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4987: "      %s%d   gradA[%d]; //[1]; // $\\nabla a(x_q)$, Value of the auxiliary field gradient at $x_q$\n",
4988:                               &count, numeric_str, dim, 1);STRING_ERROR_CHECK("Message to short");
4989:   }
4990:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
4991: "\n"
4992: "      for (int comp = 0; comp < N_comp; ++comp) {\n",
4993:                             &count);STRING_ERROR_CHECK("Message to short");
4994:   if (useField) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "        u[comp] = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");}
4995:   if (useFieldDer) {
4996:     switch (dim) {
4997:     case 1:
4998:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "        gradU[comp].x = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");break;
4999:     case 2:
5000:       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;
5001:     case 3:
5002:       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;
5003:     }
5004:   }
5005:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5006: "      }\n",
5007:                             &count);STRING_ERROR_CHECK("Message to short");
5008:   if (useFieldAux) {
5009:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      a[0] = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");
5010:   }
5011:   if (useFieldDerAux) {
5012:     switch (dim) {
5013:     case 1:
5014:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      gradA[0].x = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");break;
5015:     case 2:
5016:       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;
5017:     case 3:
5018:       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;
5019:     }
5020:   }
5021:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5022: "      /* Get field and derivatives at this quadrature point */\n"
5023: "      for (int i = 0; i < N_b; ++i) {\n"
5024: "        for (int comp = 0; comp < N_comp; ++comp) {\n"
5025: "          const int b    = i*N_comp+comp;\n"
5026: "          const int pidx = qidx*N_bt + b;\n"
5027: "          const int uidx = cell*N_bt + b;\n"
5028: "          %s%d   realSpaceDer;\n\n",
5029:                             &count, numeric_str, dim);STRING_ERROR_CHECK("Message to short");
5030:   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");}
5031:   if (useFieldDer) {
5032:     switch (dim) {
5033:     case 2:
5034:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5035: "          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"
5036: "          gradU[comp].x += u_i[uidx]*realSpaceDer.x;\n"
5037: "          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"
5038: "          gradU[comp].y += u_i[uidx]*realSpaceDer.y;\n",
5039:                            &count);STRING_ERROR_CHECK("Message to short");break;
5040:     case 3:
5041:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5042: "          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"
5043: "          gradU[comp].x += u_i[uidx]*realSpaceDer.x;\n"
5044: "          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"
5045: "          gradU[comp].y += u_i[uidx]*realSpaceDer.y;\n"
5046: "          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"
5047: "          gradU[comp].z += u_i[uidx]*realSpaceDer.z;\n",
5048:                            &count);STRING_ERROR_CHECK("Message to short");break;
5049:     }
5050:   }
5051:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5052: "        }\n"
5053: "      }\n",
5054:                             &count);STRING_ERROR_CHECK("Message to short");
5055:   if (useFieldAux) {
5056:     PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"          a[0] += a_i[cell];\n", &count);STRING_ERROR_CHECK("Message to short");
5057:   }
5058:   /* Calculate residual at quadrature points: Should be generated by an weak form egine */
5059:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5060: "      /* Process values at quadrature points */\n",
5061:                             &count);STRING_ERROR_CHECK("Message to short");
5062:   switch (op) {
5063:   case LAPLACIAN:
5064:     if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      f_0[fidx] = 4.0;\n", &count);STRING_ERROR_CHECK("Message to short");}
5065:     if (useF1) {
5066:       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");}
5067:       else        {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      f_1[fidx] = gradU[cidx];\n", &count);STRING_ERROR_CHECK("Message to short");}
5068:     }
5069:     break;
5070:   case ELASTICITY:
5071:     if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "      f_0[fidx] = 4.0;\n", &count);STRING_ERROR_CHECK("Message to short");}
5072:     if (useF1) {
5073:     switch (dim) {
5074:     case 2:
5075:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5076: "      switch (cidx) {\n"
5077: "      case 0:\n"
5078: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[0].x + gradU[0].x);\n"
5079: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[0].y + gradU[1].x);\n"
5080: "        break;\n"
5081: "      case 1:\n"
5082: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[1].x + gradU[0].y);\n"
5083: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[1].y + gradU[1].y);\n"
5084: "      }\n",
5085:                            &count);STRING_ERROR_CHECK("Message to short");break;
5086:     case 3:
5087:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5088: "      switch (cidx) {\n"
5089: "      case 0:\n"
5090: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[0].x + gradU[0].x);\n"
5091: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[0].y + gradU[1].x);\n"
5092: "        f_1[fidx].z = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[0].z + gradU[2].x);\n"
5093: "        break;\n"
5094: "      case 1:\n"
5095: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[1].x + gradU[0].y);\n"
5096: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[1].y + gradU[1].y);\n"
5097: "        f_1[fidx].z = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[1].y + gradU[2].y);\n"
5098: "        break;\n"
5099: "      case 2:\n"
5100: "        f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[2].x + gradU[0].z);\n"
5101: "        f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[2].y + gradU[1].z);\n"
5102: "        f_1[fidx].z = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[2].y + gradU[2].z);\n"
5103: "      }\n",
5104:                            &count);STRING_ERROR_CHECK("Message to short");break;
5105:     }}
5106:     break;
5107:   default:
5108:     SETERRQ1(PETSC_COMM_WORLD, PETSC_ERR_SUP, "PDE operator %d is not supported", op);
5109:   }
5110:   if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"      f_0[fidx] *= detJ[cell]*w;\n", &count);STRING_ERROR_CHECK("Message to short");}
5111:   if (useF1) {
5112:     switch (dim) {
5113:     case 1:
5114:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,"      f_1[fidx].x *= detJ[cell]*w;\n", &count);STRING_ERROR_CHECK("Message to short");break;
5115:     case 2:
5116:       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;
5117:     case 3:
5118:       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;
5119:     }
5120:   }
5121:   /* Thread transpose */
5122:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5123: "    }\n\n"
5124: "    /* ==== TRANSPOSE THREADS ==== */\n"
5125: "    barrier(CLK_LOCAL_MEM_FENCE);\n\n",
5126:                        &count);STRING_ERROR_CHECK("Message to short");
5127:   /* Basis phase */
5128:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5129: "    /* Map values at quadrature points to coefficients */\n"
5130: "    for (int c = 0; c < N_sbc; ++c) {\n"
5131: "      const int cell = c*N_bl*N_q + blbidx; /* Cell number in batch */\n"
5132: "\n"
5133: "      e_i = 0.0;\n"
5134: "      for (int q = 0; q < N_q; ++q) {\n"
5135: "        const int pidx = q*N_bt + bidx;\n"
5136: "        const int fidx = (cell*N_q + q)*N_comp + cidx;\n"
5137: "        %s%d   realSpaceDer;\n\n",
5138:                        &count, numeric_str, dim);STRING_ERROR_CHECK("Message to short");

5140:   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");}
5141:   if (useF1) {
5142:     switch (dim) {
5143:     case 2:
5144:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5145: "        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"
5146: "        e_i           += realSpaceDer.x*f_1[fidx].x;\n"
5147: "        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"
5148: "        e_i           += realSpaceDer.y*f_1[fidx].y;\n",
5149:                            &count);STRING_ERROR_CHECK("Message to short");break;
5150:     case 3:
5151:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5152: "        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"
5153: "        e_i           += realSpaceDer.x*f_1[fidx].x;\n"
5154: "        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"
5155: "        e_i           += realSpaceDer.y*f_1[fidx].y;\n"
5156: "        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"
5157: "        e_i           += realSpaceDer.z*f_1[fidx].z;\n",
5158:                            &count);STRING_ERROR_CHECK("Message to short");break;
5159:     }
5160:   }
5161:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5162: "      }\n"
5163: "      /* Write element vector for N_{cbc} cells at a time */\n"
5164: "      elemVec[(Goffset + batch*N_bc + c*N_bl*N_q)*N_bt + tidx] = e_i;\n"
5165: "    }\n"
5166: "    /* ==== Could do one write per batch ==== */\n"
5167: "  }\n"
5168: "  return;\n"
5169: "}\n",
5170:                        &count);STRING_ERROR_CHECK("Message to short");
5171:   return(0);
5172: }

5174: PetscErrorCode PetscFEOpenCLGetIntegrationKernel(PetscFE fem, PetscBool useAux, cl_program *ocl_prog, cl_kernel *ocl_kernel)
5175: {
5176:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5177:   PetscInt        dim, N_bl;
5178:   PetscBool       flg;
5179:   char           *buffer;
5180:   size_t          len;
5181:   char            errMsg[8192];
5182:   cl_int          ierr2;
5183:   PetscErrorCode  ierr;

5186:   PetscFEGetSpatialDimension(fem, &dim);
5187:   PetscMalloc1(8192, &buffer);
5188:   PetscFEGetTileSizes(fem, NULL, &N_bl, NULL, NULL);
5189:   PetscFEOpenCLGenerateIntegrationCode(fem, &buffer, 8192, useAux, N_bl);
5190:   PetscOptionsHasName(((PetscObject)fem)->options,((PetscObject)fem)->prefix, "-petscfe_opencl_kernel_print", &flg);
5191:   if (flg) {PetscPrintf(PetscObjectComm((PetscObject) fem), "OpenCL FE Integration Kernel:\n%s\n", buffer);}
5192:   len  = strlen(buffer);
5193:   *ocl_prog = clCreateProgramWithSource(ocl->ctx_id, 1, (const char **) &buffer, &len, &ierr2);CHKERRQ(ierr2);
5194:   clBuildProgram(*ocl_prog, 0, NULL, NULL, NULL, NULL);
5195:   if (ierr != CL_SUCCESS) {
5196:     clGetProgramBuildInfo(*ocl_prog, ocl->dev_id, CL_PROGRAM_BUILD_LOG, 8192*sizeof(char), &errMsg, NULL);
5197:     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Build failed! Log:\n %s", errMsg);
5198:   }
5199:   PetscFree(buffer);
5200:   *ocl_kernel = clCreateKernel(*ocl_prog, "integrateElementQuadrature", &ierr);
5201:   return(0);
5202: }

5204: PetscErrorCode PetscFEOpenCLCalculateGrid(PetscFE fem, PetscInt N, PetscInt blockSize, size_t *x, size_t *y, size_t *z)
5205: {
5206:   const PetscInt Nblocks = N/blockSize;

5209:   if (N % blockSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Invalid block size %d for %d elements", blockSize, N);
5210:   *z = 1;
5211:   for (*x = (size_t) (PetscSqrtReal(Nblocks) + 0.5); *x > 0; --*x) {
5212:     *y = Nblocks / *x;
5213:     if (*x * *y == Nblocks) break;
5214:   }
5215:   if (*x * *y != Nblocks) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Could not find partition for %d with block size %d", N, blockSize);
5216:   return(0);
5217: }

5219: PetscErrorCode PetscFEOpenCLLogResidual(PetscFE fem, PetscLogDouble time, PetscLogDouble flops)
5220: {
5221:   PetscFE_OpenCL   *ocl = (PetscFE_OpenCL *) fem->data;
5222:   PetscStageLog     stageLog;
5223:   PetscEventPerfLog eventLog = NULL;
5224:   PetscInt          stage;
5225:   PetscErrorCode    ierr;

5228:   PetscLogGetStageLog(&stageLog);
5229:   PetscStageLogGetCurrent(stageLog, &stage);
5230:   PetscStageLogGetEventPerfLog(stageLog, stage, &eventLog);
5231:     /* Log performance info */
5232:   eventLog->eventInfo[ocl->residualEvent].count++;
5233:   eventLog->eventInfo[ocl->residualEvent].time  += time;
5234:   eventLog->eventInfo[ocl->residualEvent].flops += flops;
5235:   return(0);
5236: }

5238: PetscErrorCode PetscFEIntegrateResidual_OpenCL(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
5239:                                                const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
5240: {
5241:   /* Nbc = batchSize */
5242:   PetscFE_OpenCL   *ocl = (PetscFE_OpenCL *) fem->data;
5243:   PetscPointFunc    f0_func;
5244:   PetscPointFunc    f1_func;
5245:   PetscQuadrature   q;
5246:   PetscInt          dim;
5247:   PetscInt          N_b;    /* The number of basis functions */
5248:   PetscInt          N_comp; /* The number of basis function components */
5249:   PetscInt          N_bt;   /* The total number of scalar basis functions */
5250:   PetscInt          N_q;    /* The number of quadrature points */
5251:   PetscInt          N_bst;  /* The block size, LCM(N_bt, N_q), Notice that a block is not process simultaneously */
5252:   PetscInt          N_t;    /* The number of threads, N_bst * N_bl */
5253:   PetscInt          N_bl;   /* The number of blocks */
5254:   PetscInt          N_bc;   /* The batch size, N_bl*N_q*N_b */
5255:   PetscInt          N_cb;   /* The number of batches */
5256:   PetscInt          numFlops, f0Flops = 0, f1Flops = 0;
5257:   PetscBool         useAux      = probAux ? PETSC_TRUE : PETSC_FALSE;
5258:   PetscBool         useField    = PETSC_FALSE;
5259:   PetscBool         useFieldDer = PETSC_TRUE;
5260:   PetscBool         useF0       = PETSC_TRUE;
5261:   PetscBool         useF1       = PETSC_TRUE;
5262:   /* OpenCL variables */
5263:   cl_program        ocl_prog;
5264:   cl_kernel         ocl_kernel;
5265:   cl_event          ocl_ev;         /* The event for tracking kernel execution */
5266:   cl_ulong          ns_start;       /* Nanoseconds counter on GPU at kernel start */
5267:   cl_ulong          ns_end;         /* Nanoseconds counter on GPU at kernel stop */
5268:   cl_mem            o_jacobianInverses, o_jacobianDeterminants;
5269:   cl_mem            o_coefficients, o_coefficientsAux, o_elemVec;
5270:   float            *f_coeff = NULL, *f_coeffAux = NULL, *f_invJ = NULL, *f_detJ = NULL;
5271:   double           *d_coeff = NULL, *d_coeffAux = NULL, *d_invJ = NULL, *d_detJ = NULL;
5272:   PetscReal        *r_invJ = NULL, *r_detJ = NULL;
5273:   void             *oclCoeff, *oclCoeffAux, *oclInvJ, *oclDetJ;
5274:   size_t            local_work_size[3], global_work_size[3];
5275:   size_t            realSize, x, y, z;
5276:   PetscErrorCode    ierr;

5279:   if (!Ne) {PetscFEOpenCLLogResidual(fem, 0.0, 0.0); return(0);}
5280:   PetscFEGetSpatialDimension(fem, &dim);
5281:   PetscFEGetQuadrature(fem, &q);
5282:   PetscFEGetDimension(fem, &N_b);
5283:   PetscFEGetNumComponents(fem, &N_comp);
5284:   PetscDSGetResidual(prob, field, &f0_func, &f1_func);
5285:   PetscFEGetTileSizes(fem, NULL, &N_bl, &N_bc, &N_cb);
5286:   N_bt  = N_b*N_comp;
5287:   N_q   = q->numPoints;
5288:   N_bst = N_bt*N_q;
5289:   N_t   = N_bst*N_bl;
5290:   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);
5291:   /* Calculate layout */
5292:   if (Ne % (N_cb*N_bc)) { /* Remainder cells */
5293:     PetscFEIntegrateResidual_Basic(fem, prob, field, Ne, cgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);
5294:     return(0);
5295:   }
5296:   PetscFEOpenCLCalculateGrid(fem, Ne, N_cb*N_bc, &x, &y, &z);
5297:   local_work_size[0]  = N_bc*N_comp;
5298:   local_work_size[1]  = 1;
5299:   local_work_size[2]  = 1;
5300:   global_work_size[0] = x * local_work_size[0];
5301:   global_work_size[1] = y * local_work_size[1];
5302:   global_work_size[2] = z * local_work_size[2];
5303:   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);
5304:   PetscInfo2(fem, " N_t: %d, N_cb: %d\n", N_t, N_cb);
5305:   /* Generate code */
5306:   if (probAux) {
5307:     PetscSpace P;
5308:     PetscInt   NfAux, order, f;

5310:     PetscDSGetNumFields(probAux, &NfAux);
5311:     for (f = 0; f < NfAux; ++f) {
5312:       PetscFE feAux;

5314:       PetscDSGetDiscretization(probAux, f, (PetscObject *) &feAux);
5315:       PetscFEGetBasisSpace(feAux, &P);
5316:       PetscSpaceGetOrder(P, &order);
5317:       if (order > 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Can only handle P0 coefficient fields");
5318:     }
5319:   }
5320:   PetscFEOpenCLGetIntegrationKernel(fem, useAux, &ocl_prog, &ocl_kernel);
5321:   /* Create buffers on the device and send data over */
5322:   PetscDataTypeGetSize(ocl->realType, &realSize);
5323:   if (sizeof(PetscReal) != realSize) {
5324:     switch (ocl->realType) {
5325:     case PETSC_FLOAT:
5326:     {
5327:       PetscInt c, b, d;

5329:       PetscMalloc4(Ne*N_bt,&f_coeff,Ne,&f_coeffAux,Ne*dim*dim,&f_invJ,Ne,&f_detJ);
5330:       for (c = 0; c < Ne; ++c) {
5331:         f_detJ[c] = (float) cgeom[c].detJ;
5332:         for (d = 0; d < dim*dim; ++d) {
5333:           f_invJ[c*dim*dim+d] = (float) cgeom[c].invJ[d];
5334:         }
5335:         for (b = 0; b < N_bt; ++b) {
5336:           f_coeff[c*N_bt+b] = (float) coefficients[c*N_bt+b];
5337:         }
5338:       }
5339:       if (coefficientsAux) { /* Assume P0 */
5340:         for (c = 0; c < Ne; ++c) {
5341:           f_coeffAux[c] = (float) coefficientsAux[c];
5342:         }
5343:       }
5344:       oclCoeff      = (void *) f_coeff;
5345:       if (coefficientsAux) {
5346:         oclCoeffAux = (void *) f_coeffAux;
5347:       } else {
5348:         oclCoeffAux = NULL;
5349:       }
5350:       oclInvJ       = (void *) f_invJ;
5351:       oclDetJ       = (void *) f_detJ;
5352:     }
5353:     break;
5354:     case PETSC_DOUBLE:
5355:     {
5356:       PetscInt c, b, d;

5358:       PetscMalloc4(Ne*N_bt,&d_coeff,Ne,&d_coeffAux,Ne*dim*dim,&d_invJ,Ne,&d_detJ);
5359:       for (c = 0; c < Ne; ++c) {
5360:         d_detJ[c] = (double) cgeom[c].detJ;
5361:         for (d = 0; d < dim*dim; ++d) {
5362:           d_invJ[c*dim*dim+d] = (double) cgeom[c].invJ[d];
5363:         }
5364:         for (b = 0; b < N_bt; ++b) {
5365:           d_coeff[c*N_bt+b] = (double) coefficients[c*N_bt+b];
5366:         }
5367:       }
5368:       if (coefficientsAux) { /* Assume P0 */
5369:         for (c = 0; c < Ne; ++c) {
5370:           d_coeffAux[c] = (double) coefficientsAux[c];
5371:         }
5372:       }
5373:       oclCoeff      = (void *) d_coeff;
5374:       if (coefficientsAux) {
5375:         oclCoeffAux = (void *) d_coeffAux;
5376:       } else {
5377:         oclCoeffAux = NULL;
5378:       }
5379:       oclInvJ       = (void *) d_invJ;
5380:       oclDetJ       = (void *) d_detJ;
5381:     }
5382:     break;
5383:     default:
5384:       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported PETSc type %d", ocl->realType);
5385:     }
5386:   } else {
5387:     PetscInt c, d;

5389:     PetscMalloc2(Ne*dim*dim,&r_invJ,Ne,&r_detJ);
5390:     for (c = 0; c < Ne; ++c) {
5391:       r_detJ[c] = cgeom[c].detJ;
5392:       for (d = 0; d < dim*dim; ++d) {
5393:         r_invJ[c*dim*dim+d] = cgeom[c].invJ[d];
5394:       }
5395:     }
5396:     oclCoeff    = (void *) coefficients;
5397:     oclCoeffAux = (void *) coefficientsAux;
5398:     oclInvJ     = (void *) r_invJ;
5399:     oclDetJ     = (void *) r_detJ;
5400:   }
5401:   o_coefficients         = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne*N_bt    * realSize, oclCoeff,    &ierr);
5402:   if (coefficientsAux) {
5403:     o_coefficientsAux    = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne         * realSize, oclCoeffAux, &ierr);
5404:   } else {
5405:     o_coefficientsAux    = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY,                        Ne         * realSize, oclCoeffAux, &ierr);
5406:   }
5407:   o_jacobianInverses     = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne*dim*dim * realSize, oclInvJ,     &ierr);
5408:   o_jacobianDeterminants = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne         * realSize, oclDetJ,     &ierr);
5409:   o_elemVec              = clCreateBuffer(ocl->ctx_id, CL_MEM_WRITE_ONLY,                       Ne*N_bt    * realSize, NULL,        &ierr);
5410:   /* Kernel launch */
5411:   clSetKernelArg(ocl_kernel, 0, sizeof(cl_int), (void*) &N_cb);
5412:   clSetKernelArg(ocl_kernel, 1, sizeof(cl_mem), (void*) &o_coefficients);
5413:   clSetKernelArg(ocl_kernel, 2, sizeof(cl_mem), (void*) &o_coefficientsAux);
5414:   clSetKernelArg(ocl_kernel, 3, sizeof(cl_mem), (void*) &o_jacobianInverses);
5415:   clSetKernelArg(ocl_kernel, 4, sizeof(cl_mem), (void*) &o_jacobianDeterminants);
5416:   clSetKernelArg(ocl_kernel, 5, sizeof(cl_mem), (void*) &o_elemVec);
5417:   clEnqueueNDRangeKernel(ocl->queue_id, ocl_kernel, 3, NULL, global_work_size, local_work_size, 0, NULL, &ocl_ev);
5418:   /* Read data back from device */
5419:   if (sizeof(PetscReal) != realSize) {
5420:     switch (ocl->realType) {
5421:     case PETSC_FLOAT:
5422:     {
5423:       float   *elem;
5424:       PetscInt c, b;

5426:       PetscFree4(f_coeff,f_coeffAux,f_invJ,f_detJ);
5427:       PetscMalloc1(Ne*N_bt, &elem);
5428:       clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elem, 0, NULL, NULL);
5429:       for (c = 0; c < Ne; ++c) {
5430:         for (b = 0; b < N_bt; ++b) {
5431:           elemVec[c*N_bt+b] = (PetscScalar) elem[c*N_bt+b];
5432:         }
5433:       }
5434:       PetscFree(elem);
5435:     }
5436:     break;
5437:     case PETSC_DOUBLE:
5438:     {
5439:       double  *elem;
5440:       PetscInt c, b;

5442:       PetscFree4(d_coeff,d_coeffAux,d_invJ,d_detJ);
5443:       PetscMalloc1(Ne*N_bt, &elem);
5444:       clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elem, 0, NULL, NULL);
5445:       for (c = 0; c < Ne; ++c) {
5446:         for (b = 0; b < N_bt; ++b) {
5447:           elemVec[c*N_bt+b] = (PetscScalar) elem[c*N_bt+b];
5448:         }
5449:       }
5450:       PetscFree(elem);
5451:     }
5452:     break;
5453:     default:
5454:       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported PETSc type %d", ocl->realType);
5455:     }
5456:   } else {
5457:     PetscFree2(r_invJ,r_detJ);
5458:     clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elemVec, 0, NULL, NULL);
5459:   }
5460:   /* Log performance */
5461:   clGetEventProfilingInfo(ocl_ev, CL_PROFILING_COMMAND_START, sizeof(cl_ulong), &ns_start, NULL);
5462:   clGetEventProfilingInfo(ocl_ev, CL_PROFILING_COMMAND_END,   sizeof(cl_ulong), &ns_end,   NULL);
5463:   f0Flops = 0;
5464:   switch (ocl->op) {
5465:   case LAPLACIAN:
5466:     f1Flops = useAux ? dim : 0;break;
5467:   case ELASTICITY:
5468:     f1Flops = 2*dim*dim;break;
5469:   }
5470:   numFlops = Ne*(
5471:     N_q*(
5472:       N_b*N_comp*((useField ? 2 : 0) + (useFieldDer ? 2*dim*(dim + 1) : 0))
5473:       /*+
5474:        N_ba*N_compa*((useFieldAux ? 2 : 0) + (useFieldDerAux ? 2*dim*(dim + 1) : 0))*/
5475:       +
5476:       N_comp*((useF0 ? f0Flops + 2 : 0) + (useF1 ? f1Flops + 2*dim : 0)))
5477:     +
5478:     N_b*((useF0 ? 2 : 0) + (useF1 ? 2*dim*(dim + 1) : 0)));
5479:   PetscFEOpenCLLogResidual(fem, (ns_end - ns_start)*1.0e-9, numFlops);
5480:   /* Cleanup */
5481:   clReleaseMemObject(o_coefficients);
5482:   clReleaseMemObject(o_coefficientsAux);
5483:   clReleaseMemObject(o_jacobianInverses);
5484:   clReleaseMemObject(o_jacobianDeterminants);
5485:   clReleaseMemObject(o_elemVec);
5486:   clReleaseKernel(ocl_kernel);
5487:   clReleaseProgram(ocl_prog);
5488:   return(0);
5489: }

5491: PetscErrorCode PetscFEInitialize_OpenCL(PetscFE fem)
5492: {
5494:   fem->ops->setfromoptions          = NULL;
5495:   fem->ops->setup                   = PetscFESetUp_Basic;
5496:   fem->ops->view                    = NULL;
5497:   fem->ops->destroy                 = PetscFEDestroy_OpenCL;
5498:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
5499:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
5500:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_OpenCL;
5501:   fem->ops->integratebdresidual     = NULL/* PetscFEIntegrateBdResidual_OpenCL */;
5502:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_OpenCL */;
5503:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
5504:   return(0);
5505: }

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

5510:   Level: intermediate

5512: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
5513: M*/

5515: PETSC_EXTERN PetscErrorCode PetscFECreate_OpenCL(PetscFE fem)
5516: {
5517:   PetscFE_OpenCL *ocl;
5518:   cl_uint         num_platforms;
5519:   cl_platform_id  platform_ids[42];
5520:   cl_uint         num_devices;
5521:   cl_device_id    device_ids[42];
5522:   cl_int          ierr2;
5523:   PetscErrorCode  ierr;

5527:   PetscNewLog(fem,&ocl);
5528:   fem->data = ocl;

5530:   /* Init Platform */
5531:   clGetPlatformIDs(42, platform_ids, &num_platforms);
5532:   if (!num_platforms) SETERRQ(PetscObjectComm((PetscObject) fem), PETSC_ERR_SUP, "No OpenCL platform found.");
5533:   ocl->pf_id = platform_ids[0];
5534:   /* Init Device */
5535:   clGetDeviceIDs(ocl->pf_id, CL_DEVICE_TYPE_ALL, 42, device_ids, &num_devices);
5536:   if (!num_devices) SETERRQ(PetscObjectComm((PetscObject) fem), PETSC_ERR_SUP, "No OpenCL device found.");
5537:   ocl->dev_id = device_ids[0];
5538:   /* Create context with one command queue */
5539:   ocl->ctx_id   = clCreateContext(0, 1, &(ocl->dev_id), NULL, NULL, &ierr2);CHKERRQ(ierr2);
5540:   ocl->queue_id = clCreateCommandQueue(ocl->ctx_id, ocl->dev_id, CL_QUEUE_PROFILING_ENABLE, &ierr2);CHKERRQ(ierr2);
5541:   /* Types */
5542:   ocl->realType = PETSC_FLOAT;
5543:   /* Register events */
5544:   PetscLogEventRegister("OpenCL FEResidual", PETSCFE_CLASSID, &ocl->residualEvent);
5545:   /* Equation handling */
5546:   ocl->op = LAPLACIAN;

5548:   PetscFEInitialize_OpenCL(fem);
5549:   return(0);
5550: }

5552: PetscErrorCode PetscFEOpenCLSetRealType(PetscFE fem, PetscDataType realType)
5553: {
5554:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;

5558:   ocl->realType = realType;
5559:   return(0);
5560: }

5562: PetscErrorCode PetscFEOpenCLGetRealType(PetscFE fem, PetscDataType *realType)
5563: {
5564:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;

5569:   *realType = ocl->realType;
5570:   return(0);
5571: }

5573: #endif /* PETSC_HAVE_OPENCL */

5575: PetscErrorCode PetscFEDestroy_Composite(PetscFE fem)
5576: {
5577:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
5578:   PetscErrorCode     ierr;

5581:   CellRefinerRestoreAffineTransforms_Internal(cmp->cellRefiner, &cmp->numSubelements, &cmp->v0, &cmp->jac, &cmp->invjac);
5582:   PetscFree(cmp->embedding);
5583:   PetscFree(cmp);
5584:   return(0);
5585: }

5587: PetscErrorCode PetscFESetUp_Composite(PetscFE fem)
5588: {
5589:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
5590:   DM                 K;
5591:   PetscReal         *subpoint;
5592:   PetscBLASInt      *pivots;
5593:   PetscBLASInt       n, info;
5594:   PetscScalar       *work, *invVscalar;
5595:   PetscInt           dim, pdim, spdim, j, s;
5596:   PetscErrorCode     ierr;

5599:   /* Get affine mapping from reference cell to each subcell */
5600:   PetscDualSpaceGetDM(fem->dualSpace, &K);
5601:   DMGetDimension(K, &dim);
5602:   DMPlexGetCellRefiner_Internal(K, &cmp->cellRefiner);
5603:   CellRefinerGetAffineTransforms_Internal(cmp->cellRefiner, &cmp->numSubelements, &cmp->v0, &cmp->jac, &cmp->invjac);
5604:   /* Determine dof embedding into subelements */
5605:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
5606:   PetscSpaceGetDimension(fem->basisSpace, &spdim);
5607:   PetscMalloc1(cmp->numSubelements*spdim,&cmp->embedding);
5608:   DMGetWorkArray(K, dim, PETSC_REAL, &subpoint);
5609:   for (s = 0; s < cmp->numSubelements; ++s) {
5610:     PetscInt sd = 0;

5612:     for (j = 0; j < pdim; ++j) {
5613:       PetscBool       inside;
5614:       PetscQuadrature f;
5615:       PetscInt        d, e;

5617:       PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);
5618:       /* Apply transform to first point, and check that point is inside subcell */
5619:       for (d = 0; d < dim; ++d) {
5620:         subpoint[d] = -1.0;
5621:         for (e = 0; e < dim; ++e) subpoint[d] += cmp->invjac[(s*dim + d)*dim+e]*(f->points[e] - cmp->v0[s*dim+e]);
5622:       }
5623:       CellRefinerInCellTest_Internal(cmp->cellRefiner, subpoint, &inside);
5624:       if (inside) {cmp->embedding[s*spdim+sd++] = j;}
5625:     }
5626:     if (sd != spdim) SETERRQ3(PetscObjectComm((PetscObject) fem), PETSC_ERR_PLIB, "Subelement %d has %d dual basis vectors != %d", s, sd, spdim);
5627:   }
5628:   DMRestoreWorkArray(K, dim, PETSC_REAL, &subpoint);
5629:   /* Construct the change of basis from prime basis to nodal basis for each subelement */
5630:   PetscMalloc1(cmp->numSubelements*spdim*spdim,&fem->invV);
5631:   PetscMalloc2(spdim,&pivots,spdim,&work);
5632: #if defined(PETSC_USE_COMPLEX)
5633:   PetscMalloc1(cmp->numSubelements*spdim*spdim,&invVscalar);
5634: #else
5635:   invVscalar = fem->invV;
5636: #endif
5637:   for (s = 0; s < cmp->numSubelements; ++s) {
5638:     for (j = 0; j < spdim; ++j) {
5639:       PetscReal      *Bf;
5640:       PetscQuadrature f;
5641:       PetscInt        q, k;

5643:       PetscDualSpaceGetFunctional(fem->dualSpace, cmp->embedding[s*spdim+j], &f);
5644:       PetscMalloc1(f->numPoints*spdim,&Bf);
5645:       PetscSpaceEvaluate(fem->basisSpace, f->numPoints, f->points, Bf, NULL, NULL);
5646:       for (k = 0; k < spdim; ++k) {
5647:         /* n_j \cdot \phi_k */
5648:         invVscalar[(s*spdim + j)*spdim+k] = 0.0;
5649:         for (q = 0; q < f->numPoints; ++q) {
5650:           invVscalar[(s*spdim + j)*spdim+k] += Bf[q*spdim+k]*f->weights[q];
5651:         }
5652:       }
5653:       PetscFree(Bf);
5654:     }
5655:     n = spdim;
5656:     PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, &invVscalar[s*spdim*spdim], &n, pivots, &info));
5657:     PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, &invVscalar[s*spdim*spdim], &n, pivots, work, &n, &info));
5658:   }
5659: #if defined(PETSC_USE_COMPLEX)
5660:   for (s = 0; s <cmp->numSubelements*spdim*spdim; s++) fem->invV[s] = PetscRealPart(invVscalar[s]);
5661:   PetscFree(invVscalar);
5662: #endif
5663:   PetscFree2(pivots,work);
5664:   return(0);
5665: }

5667: PetscErrorCode PetscFEGetTabulation_Composite(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H)
5668: {
5669:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
5670:   DM                 dm;
5671:   PetscInt           pdim;  /* Dimension of FE space P */
5672:   PetscInt           spdim; /* Dimension of subelement FE space P */
5673:   PetscInt           dim;   /* Spatial dimension */
5674:   PetscInt           comp;  /* Field components */
5675:   PetscInt          *subpoints;
5676:   PetscReal         *tmpB, *tmpD, *tmpH, *subpoint;
5677:   PetscInt           p, s, d, e, j, k;
5678:   PetscErrorCode     ierr;

5681:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
5682:   DMGetDimension(dm, &dim);
5683:   PetscSpaceGetDimension(fem->basisSpace, &spdim);
5684:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
5685:   PetscFEGetNumComponents(fem, &comp);
5686:   /* Divide points into subelements */
5687:   DMGetWorkArray(dm, npoints, PETSC_INT, &subpoints);
5688:   DMGetWorkArray(dm, dim, PETSC_REAL, &subpoint);
5689:   for (p = 0; p < npoints; ++p) {
5690:     for (s = 0; s < cmp->numSubelements; ++s) {
5691:       PetscBool inside;

5693:       /* Apply transform, and check that point is inside cell */
5694:       for (d = 0; d < dim; ++d) {
5695:         subpoint[d] = -1.0;
5696:         for (e = 0; e < dim; ++e) subpoint[d] += cmp->invjac[(s*dim + d)*dim+e]*(points[p*dim+e] - cmp->v0[s*dim+e]);
5697:       }
5698:       CellRefinerInCellTest_Internal(cmp->cellRefiner, subpoint, &inside);
5699:       if (inside) {subpoints[p] = s; break;}
5700:     }
5701:     if (s >= cmp->numSubelements) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %d was not found in any subelement", p);
5702:   }
5703:   DMRestoreWorkArray(dm, dim, PETSC_REAL, &subpoint);
5704:   /* Evaluate the prime basis functions at all points */
5705:   if (B) {DMGetWorkArray(dm, npoints*spdim, PETSC_REAL, &tmpB);}
5706:   if (D) {DMGetWorkArray(dm, npoints*spdim*dim, PETSC_REAL, &tmpD);}
5707:   if (H) {DMGetWorkArray(dm, npoints*spdim*dim*dim, PETSC_REAL, &tmpH);}
5708:   PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);
5709:   /* Translate to the nodal basis */
5710:   if (B) {PetscMemzero(B, npoints*pdim*comp * sizeof(PetscReal));}
5711:   if (D) {PetscMemzero(D, npoints*pdim*comp*dim * sizeof(PetscReal));}
5712:   if (H) {PetscMemzero(H, npoints*pdim*comp*dim*dim * sizeof(PetscReal));}
5713:   for (p = 0; p < npoints; ++p) {
5714:     const PetscInt s = subpoints[p];

5716:     if (B) {
5717:       /* Multiply by V^{-1} (spdim x spdim) */
5718:       for (j = 0; j < spdim; ++j) {
5719:         const PetscInt i = (p*pdim + cmp->embedding[s*spdim+j])*comp;
5720:         PetscInt       c;

5722:         B[i] = 0.0;
5723:         for (k = 0; k < spdim; ++k) {
5724:           B[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpB[p*spdim + k];
5725:         }
5726:         for (c = 1; c < comp; ++c) {
5727:           B[i+c] = B[i];
5728:         }
5729:       }
5730:     }
5731:     if (D) {
5732:       /* Multiply by V^{-1} (spdim x spdim) */
5733:       for (j = 0; j < spdim; ++j) {
5734:         for (d = 0; d < dim; ++d) {
5735:           const PetscInt i = ((p*pdim + cmp->embedding[s*spdim+j])*comp + 0)*dim + d;
5736:           PetscInt       c;

5738:           D[i] = 0.0;
5739:           for (k = 0; k < spdim; ++k) {
5740:             D[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpD[(p*spdim + k)*dim + d];
5741:           }
5742:           for (c = 1; c < comp; ++c) {
5743:             D[((p*pdim + cmp->embedding[s*spdim+j])*comp + c)*dim + d] = D[i];
5744:           }
5745:         }
5746:       }
5747:     }
5748:     if (H) {
5749:       /* Multiply by V^{-1} (pdim x pdim) */
5750:       for (j = 0; j < spdim; ++j) {
5751:         for (d = 0; d < dim*dim; ++d) {
5752:           const PetscInt i = ((p*pdim + cmp->embedding[s*spdim+j])*comp + 0)*dim*dim + d;
5753:           PetscInt       c;

5755:           H[i] = 0.0;
5756:           for (k = 0; k < spdim; ++k) {
5757:             H[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpH[(p*spdim + k)*dim*dim + d];
5758:           }
5759:           for (c = 1; c < comp; ++c) {
5760:             H[((p*pdim + cmp->embedding[s*spdim+j])*comp + c)*dim*dim + d] = H[i];
5761:           }
5762:         }
5763:       }
5764:     }
5765:   }
5766:   DMRestoreWorkArray(dm, npoints, PETSC_INT, &subpoints);
5767:   if (B) {DMRestoreWorkArray(dm, npoints*spdim, PETSC_REAL, &tmpB);}
5768:   if (D) {DMRestoreWorkArray(dm, npoints*spdim*dim, PETSC_REAL, &tmpD);}
5769:   if (H) {DMRestoreWorkArray(dm, npoints*spdim*dim*dim, PETSC_REAL, &tmpH);}
5770:   return(0);
5771: }

5773: PetscErrorCode PetscFEInitialize_Composite(PetscFE fem)
5774: {
5776:   fem->ops->setfromoptions          = NULL;
5777:   fem->ops->setup                   = PetscFESetUp_Composite;
5778:   fem->ops->view                    = NULL;
5779:   fem->ops->destroy                 = PetscFEDestroy_Composite;
5780:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
5781:   fem->ops->gettabulation           = PetscFEGetTabulation_Composite;
5782:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Basic;
5783:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Basic;
5784:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Basic */;
5785:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
5786:   return(0);
5787: }

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

5792:   Level: intermediate

5794: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
5795: M*/

5797: PETSC_EXTERN PetscErrorCode PetscFECreate_Composite(PetscFE fem)
5798: {
5799:   PetscFE_Composite *cmp;
5800:   PetscErrorCode     ierr;

5804:   PetscNewLog(fem, &cmp);
5805:   fem->data = cmp;

5807:   cmp->cellRefiner    = REFINER_NOOP;
5808:   cmp->numSubelements = -1;
5809:   cmp->v0             = NULL;
5810:   cmp->jac            = NULL;

5812:   PetscFEInitialize_Composite(fem);
5813:   return(0);
5814: }

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

5819:   Not collective

5821:   Input Parameter:
5822: . fem - The PetscFE object

5824:   Output Parameters:
5825: + blockSize - The number of elements in a block
5826: . numBlocks - The number of blocks in a batch
5827: . batchSize - The number of elements in a batch
5828: - numBatches - The number of batches in a chunk

5830:   Level: intermediate

5832: .seealso: PetscFECreate()
5833: @*/
5834: PetscErrorCode PetscFECompositeGetMapping(PetscFE fem, PetscInt *numSubelements, const PetscReal *v0[], const PetscReal *jac[], const PetscReal *invjac[])
5835: {
5836:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;

5844:   return(0);
5845: }

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

5850:   Not collective

5852:   Input Parameter:
5853: . fe - The PetscFE

5855:   Output Parameter:
5856: . dim - The dimension

5858:   Level: intermediate

5860: .seealso: PetscFECreate(), PetscSpaceGetDimension(), PetscDualSpaceGetDimension()
5861: @*/
5862: PetscErrorCode PetscFEGetDimension(PetscFE fem, PetscInt *dim)
5863: {

5869:   if (fem->ops->getdimension) {(*fem->ops->getdimension)(fem, dim);}
5870:   return(0);
5871: }

5873: /*
5874: Purpose: Compute element vector for chunk of elements

5876: Input:
5877:   Sizes:
5878:      Ne:  number of elements
5879:      Nf:  number of fields
5880:      PetscFE
5881:        dim: spatial dimension
5882:        Nb:  number of basis functions
5883:        Nc:  number of field components
5884:        PetscQuadrature
5885:          Nq:  number of quadrature points

5887:   Geometry:
5888:      PetscFECellGeom[Ne] possibly *Nq
5889:        PetscReal v0s[dim]
5890:        PetscReal n[dim]
5891:        PetscReal jacobians[dim*dim]
5892:        PetscReal jacobianInverses[dim*dim]
5893:        PetscReal jacobianDeterminants
5894:   FEM:
5895:      PetscFE
5896:        PetscQuadrature
5897:          PetscReal   quadPoints[Nq*dim]
5898:          PetscReal   quadWeights[Nq]
5899:        PetscReal   basis[Nq*Nb*Nc]
5900:        PetscReal   basisDer[Nq*Nb*Nc*dim]
5901:      PetscScalar coefficients[Ne*Nb*Nc]
5902:      PetscScalar elemVec[Ne*Nb*Nc]

5904:   Problem:
5905:      PetscInt f: the active field
5906:      f0, f1

5908:   Work Space:
5909:      PetscFE
5910:        PetscScalar f0[Nq*dim];
5911:        PetscScalar f1[Nq*dim*dim];
5912:        PetscScalar u[Nc];
5913:        PetscScalar gradU[Nc*dim];
5914:        PetscReal   x[dim];
5915:        PetscScalar realSpaceDer[dim];

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

5919: Input:
5920:   Sizes:
5921:      N_cb: Number of serial cell batches

5923:   Geometry:
5924:      PetscReal v0s[Ne*dim]
5925:      PetscReal jacobians[Ne*dim*dim]        possibly *Nq
5926:      PetscReal jacobianInverses[Ne*dim*dim] possibly *Nq
5927:      PetscReal jacobianDeterminants[Ne]     possibly *Nq
5928:   FEM:
5929:      static PetscReal   quadPoints[Nq*dim]
5930:      static PetscReal   quadWeights[Nq]
5931:      static PetscReal   basis[Nq*Nb*Nc]
5932:      static PetscReal   basisDer[Nq*Nb*Nc*dim]
5933:      PetscScalar coefficients[Ne*Nb*Nc]
5934:      PetscScalar elemVec[Ne*Nb*Nc]

5936: ex62.c:
5937:   PetscErrorCode PetscFEIntegrateResidualBatch(PetscInt Ne, PetscInt numFields, PetscInt field, PetscQuadrature quad[], const PetscScalar coefficients[],
5938:                                                const PetscReal v0s[], const PetscReal jacobians[], const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[],
5939:                                                void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f0[]),
5940:                                                void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f1[]), PetscScalar elemVec[])

5942: ex52.c:
5943:   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)
5944:   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)

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

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

5953: ex52_integrateElementOpenCL.c:
5954: PETSC_EXTERN PetscErrorCode IntegrateElementBatchGPU(PetscInt spatial_dim, PetscInt Ne, PetscInt Ncb, PetscInt Nbc, PetscInt N_bl, const PetscScalar coefficients[],
5955:                                                      const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscScalar elemVec[],
5956:                                                      PetscLogEvent event, PetscInt debug, PetscInt pde_op)

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

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

5964:   Not collective

5966:   Input Parameters:
5967: + fem          - The PetscFE object for the field being integrated
5968: . prob         - The PetscDS specifying the discretizations and continuum functions
5969: . field        - The field being integrated
5970: . Ne           - The number of elements in the chunk
5971: . cgeom        - The cell geometry for each cell in the chunk
5972: . coefficients - The array of FEM basis coefficients for the elements
5973: . probAux      - The PetscDS specifying the auxiliary discretizations
5974: - coefficientsAux - The array of FEM auxiliary basis coefficients for the elements

5976:   Output Parameter
5977: . integral     - the integral for this field

5979:   Level: developer

5981: .seealso: PetscFEIntegrateResidual()
5982: @*/
5983: PetscErrorCode PetscFEIntegrate(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
5984:                                 const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal integral[])
5985: {

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

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

5998:   Not collective

6000:   Input Parameters:
6001: + fem          - The PetscFE object for the field being integrated
6002: . prob         - The PetscDS specifying the discretizations and continuum functions
6003: . field        - The field being integrated
6004: . Ne           - The number of elements in the chunk
6005: . cgeom        - The cell geometry for each cell in the chunk
6006: . coefficients - The array of FEM basis coefficients for the elements
6007: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
6008: . probAux      - The PetscDS specifying the auxiliary discretizations
6009: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6010: - t            - The time

6012:   Output Parameter
6013: . elemVec      - the element residual vectors from each element

6015:   Note:
6016: $ Loop over batch of elements (e):
6017: $   Loop over quadrature points (q):
6018: $     Make u_q and gradU_q (loops over fields,Nb,Ncomp) and x_q
6019: $     Call f_0 and f_1
6020: $   Loop over element vector entries (f,fc --> i):
6021: $     elemVec[i] += \psi^{fc}_f(q) f0_{fc}(u, \nabla u) + \nabla\psi^{fc}_f(q) \cdot f1_{fc,df}(u, \nabla u)

6023:   Level: developer

6025: .seealso: PetscFEIntegrateResidual()
6026: @*/
6027: PetscErrorCode PetscFEIntegrateResidual(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
6028:                                         const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
6029: {

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

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

6042:   Not collective

6044:   Input Parameters:
6045: + fem          - The PetscFE object for the field being integrated
6046: . prob         - The PetscDS specifying the discretizations and continuum functions
6047: . field        - The field being integrated
6048: . Ne           - The number of elements in the chunk
6049: . fgeom        - The face geometry for each cell in the chunk
6050: . coefficients - The array of FEM basis coefficients for the elements
6051: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
6052: . probAux      - The PetscDS specifying the auxiliary discretizations
6053: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6054: - t            - The time

6056:   Output Parameter
6057: . elemVec      - the element residual vectors from each element

6059:   Level: developer

6061: .seealso: PetscFEIntegrateResidual()
6062: @*/
6063: PetscErrorCode PetscFEIntegrateBdResidual(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEFaceGeom *fgeom,
6064:                                           const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
6065: {

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

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

6077:   Not collective

6079:   Input Parameters:
6080: + fem          - The PetscFE object for the field being integrated
6081: . prob         - The PetscDS specifying the discretizations and continuum functions
6082: . jtype        - The type of matrix pointwise functions that should be used
6083: . fieldI       - The test field being integrated
6084: . fieldJ       - The basis field being integrated
6085: . Ne           - The number of elements in the chunk
6086: . cgeom        - The cell geometry for each cell in the chunk
6087: . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
6088: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
6089: . probAux      - The PetscDS specifying the auxiliary discretizations
6090: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6091: . t            - The time
6092: - u_tShift     - A multiplier for the dF/du_t term (as opposed to the dF/du term)

6094:   Output Parameter
6095: . elemMat      - the element matrices for the Jacobian from each element

6097:   Note:
6098: $ Loop over batch of elements (e):
6099: $   Loop over element matrix entries (f,fc,g,gc --> i,j):
6100: $     Loop over quadrature points (q):
6101: $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
6102: $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
6103: $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6104: $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
6105: $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6106: */
6107: PetscErrorCode PetscFEIntegrateJacobian(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFECellGeom *cgeom,
6108:                                         const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
6109: {

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

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

6121:   Not collective

6123:   Input Parameters:
6124: + fem          = The PetscFE object for the field being integrated
6125: . prob         - The PetscDS specifying the discretizations and continuum functions
6126: . fieldI       - The test field being integrated
6127: . fieldJ       - The basis field being integrated
6128: . Ne           - The number of elements in the chunk
6129: . fgeom        - The face geometry for each cell in the chunk
6130: . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
6131: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
6132: . probAux      - The PetscDS specifying the auxiliary discretizations
6133: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6134: . t            - The time
6135: - u_tShift     - A multiplier for the dF/du_t term (as opposed to the dF/du term)

6137:   Output Parameter
6138: . elemMat              - the element matrices for the Jacobian from each element

6140:   Note:
6141: $ Loop over batch of elements (e):
6142: $   Loop over element matrix entries (f,fc,g,gc --> i,j):
6143: $     Loop over quadrature points (q):
6144: $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
6145: $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
6146: $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6147: $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
6148: $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6149: */
6150: PetscErrorCode PetscFEIntegrateBdJacobian(PetscFE fem, PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEFaceGeom *fgeom,
6151:                                           const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
6152: {

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

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

6166:   Input Parameter:
6167: . fe - The initial PetscFE

6169:   Output Parameter:
6170: . feRef - The refined PetscFE

6172:   Level: developer

6174: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
6175: @*/
6176: PetscErrorCode PetscFERefine(PetscFE fe, PetscFE *feRef)
6177: {
6178:   PetscSpace       P, Pref;
6179:   PetscDualSpace   Q, Qref;
6180:   DM               K, Kref;
6181:   PetscQuadrature  q, qref;
6182:   const PetscReal *v0, *jac;
6183:   PetscInt         numComp, numSubelements;
6184:   PetscErrorCode   ierr;

6187:   PetscFEGetBasisSpace(fe, &P);
6188:   PetscFEGetDualSpace(fe, &Q);
6189:   PetscFEGetQuadrature(fe, &q);
6190:   PetscDualSpaceGetDM(Q, &K);
6191:   /* Create space */
6192:   PetscObjectReference((PetscObject) P);
6193:   Pref = P;
6194:   /* Create dual space */
6195:   PetscDualSpaceDuplicate(Q, &Qref);
6196:   DMRefine(K, PetscObjectComm((PetscObject) fe), &Kref);
6197:   PetscDualSpaceSetDM(Qref, Kref);
6198:   DMDestroy(&Kref);
6199:   PetscDualSpaceSetUp(Qref);
6200:   /* Create element */
6201:   PetscFECreate(PetscObjectComm((PetscObject) fe), feRef);
6202:   PetscFESetType(*feRef, PETSCFECOMPOSITE);
6203:   PetscFESetBasisSpace(*feRef, Pref);
6204:   PetscFESetDualSpace(*feRef, Qref);
6205:   PetscFEGetNumComponents(fe,    &numComp);
6206:   PetscFESetNumComponents(*feRef, numComp);
6207:   PetscFESetUp(*feRef);
6208:   PetscSpaceDestroy(&Pref);
6209:   PetscDualSpaceDestroy(&Qref);
6210:   /* Create quadrature */
6211:   PetscFECompositeGetMapping(*feRef, &numSubelements, &v0, &jac, NULL);
6212:   PetscQuadratureExpandComposite(q, numSubelements, v0, jac, &qref);
6213:   PetscFESetQuadrature(*feRef, qref);
6214:   PetscQuadratureDestroy(&qref);
6215:   return(0);
6216: }

6218: /*@
6219:   PetscFECreateDefault - Create a PetscFE for basic FEM computation

6221:   Collective on DM

6223:   Input Parameters:
6224: + dm         - The underlying DM for the domain
6225: . dim        - The spatial dimension
6226: . numComp    - The number of components
6227: . isSimplex  - Flag for simplex reference cell, otherwise its a tensor product
6228: . prefix     - The options prefix, or NULL
6229: - qorder     - The quadrature order

6231:   Output Parameter:
6232: . fem - The PetscFE object

6234:   Level: beginner

6236: .keywords: PetscFE, finite element
6237: .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate()
6238: @*/
6239: PetscErrorCode PetscFECreateDefault(DM dm, PetscInt dim, PetscInt numComp, PetscBool isSimplex, const char prefix[], PetscInt qorder, PetscFE *fem)
6240: {
6241:   PetscQuadrature q, fq;
6242:   DM              K;
6243:   PetscSpace      P;
6244:   PetscDualSpace  Q;
6245:   PetscInt        order, quadPointsPerEdge;
6246:   PetscBool       tensor = isSimplex ? PETSC_FALSE : PETSC_TRUE;
6247:   PetscErrorCode  ierr;

6250:   /* Create space */
6251:   PetscSpaceCreate(PetscObjectComm((PetscObject) dm), &P);
6252:   PetscObjectSetOptionsPrefix((PetscObject) P, prefix);
6253:   PetscSpaceSetFromOptions(P);
6254:   PetscSpacePolynomialSetNumVariables(P, dim);
6255:   PetscSpaceSetUp(P);
6256:   PetscSpaceGetOrder(P, &order);
6257:   PetscSpacePolynomialGetTensor(P, &tensor);
6258:   /* Create dual space */
6259:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) dm), &Q);
6260:   PetscDualSpaceSetType(Q,PETSCDUALSPACELAGRANGE);
6261:   PetscObjectSetOptionsPrefix((PetscObject) Q, prefix);
6262:   PetscDualSpaceCreateReferenceCell(Q, dim, isSimplex, &K);
6263:   PetscDualSpaceSetDM(Q, K);
6264:   DMDestroy(&K);
6265:   PetscDualSpaceSetOrder(Q, order);
6266:   PetscDualSpaceLagrangeSetTensor(Q, tensor);
6267:   PetscDualSpaceSetFromOptions(Q);
6268:   PetscDualSpaceSetUp(Q);
6269:   /* Create element */
6270:   PetscFECreate(PetscObjectComm((PetscObject) dm), fem);
6271:   PetscObjectSetOptionsPrefix((PetscObject) *fem, prefix);
6272:   PetscFESetFromOptions(*fem);
6273:   PetscFESetBasisSpace(*fem, P);
6274:   PetscFESetDualSpace(*fem, Q);
6275:   PetscFESetNumComponents(*fem, numComp);
6276:   PetscFESetUp(*fem);
6277:   PetscSpaceDestroy(&P);
6278:   PetscDualSpaceDestroy(&Q);
6279:   /* Create quadrature (with specified order if given) */
6280:   qorder = qorder >= 0 ? qorder : order;
6281:   PetscObjectOptionsBegin((PetscObject)*fem);
6282:   PetscOptionsInt("-petscfe_default_quadrature_order","Quadrature order is one less than quadture points per edge","PetscFECreateDefault",qorder,&qorder,NULL);
6283:   PetscOptionsEnd();
6284:   quadPointsPerEdge = PetscMax(qorder + 1,1);
6285:   if (isSimplex) {
6286:     PetscDTGaussJacobiQuadrature(dim,   quadPointsPerEdge, -1.0, 1.0, &q);
6287:     PetscDTGaussJacobiQuadrature(dim-1, quadPointsPerEdge, -1.0, 1.0, &fq);
6288:   }
6289:   else {
6290:     PetscDTGaussTensorQuadrature(dim,   quadPointsPerEdge, -1.0, 1.0, &q);
6291:     PetscDTGaussTensorQuadrature(dim-1, quadPointsPerEdge, -1.0, 1.0, &fq);
6292:   }
6293:   PetscFESetQuadrature(*fem, q);
6294:   PetscFESetFaceQuadrature(*fem, fq);
6295:   PetscQuadratureDestroy(&q);
6296:   PetscQuadratureDestroy(&fq);
6297:   return(0);
6298: }