Actual source code: dtfe.c

petsc-dev 2014-04-16
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> /*I "petscfe.h" I*/
 38: #include <petsc-private/dtimpl.h>
 39: #include <petsc-private/dmpleximpl.h>
 40: #include <petscdmshell.h>
 41: #include <petscdmplex.h>
 42: #include <petscblaslapack.h>

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

 55: PetscClassId PETSCSPACE_CLASSID = 0;

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

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

 65:   Not Collective

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

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

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

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

 89:   Level: advanced

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

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

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

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

109:   Collective on PetscSpace

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

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

118:   Level: intermediate

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

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

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

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

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

152:   Not Collective

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

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

160:   Level: intermediate

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

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

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

184:   Collective on PetscSpace

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

190:   Level: developer

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

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

211: /*
212:   PetscSpaceViewFromOptions - Processes command line options to determine if/how a PetscSpace is to be viewed.

214:   Collective on PetscSpace

216:   Input Parameters:
217: + sp   - the PetscSpace
218: . prefix - prefix to use for viewing, or NULL to use prefix of 'rnd'
219: - optionname - option to activate viewing

221:   Level: intermediate

223: .keywords: PetscSpace, view, options, database
224: .seealso: VecViewFromOptions(), MatViewFromOptions()
225: */
226: PetscErrorCode PetscSpaceViewFromOptions(PetscSpace sp, const char prefix[], const char optionname[])
227: {
228:   PetscViewer       viewer;
229:   PetscViewerFormat format;
230:   PetscBool         flg;
231:   PetscErrorCode    ierr;

234:   if (prefix) {
235:     PetscOptionsGetViewer(PetscObjectComm((PetscObject) sp), prefix, optionname, &viewer, &format, &flg);
236:   } else {
237:     PetscOptionsGetViewer(PetscObjectComm((PetscObject) sp), ((PetscObject) sp)->prefix, optionname, &viewer, &format, &flg);
238:   }
239:   if (flg) {
240:     PetscViewerPushFormat(viewer, format);
241:     PetscSpaceView(sp, viewer);
242:     PetscViewerPopFormat(viewer);
243:     PetscViewerDestroy(&viewer);
244:   }
245:   return(0);
246: }

250: /*@
251:   PetscSpaceSetFromOptions - sets parameters in a PetscSpace from the options database

253:   Collective on PetscSpace

255:   Input Parameter:
256: . sp - the PetscSpace object to set options for

258:   Options Database:
259: . -petscspace_order the approximation order of the space

261:   Level: developer

263: .seealso PetscSpaceView()
264: @*/
265: PetscErrorCode PetscSpaceSetFromOptions(PetscSpace sp)
266: {
267:   const char    *defaultType;
268:   char           name[256];
269:   PetscBool      flg;

274:   if (!((PetscObject) sp)->type_name) {
275:     defaultType = PETSCSPACEPOLYNOMIAL;
276:   } else {
277:     defaultType = ((PetscObject) sp)->type_name;
278:   }
279:   if (!PetscSpaceRegisterAllCalled) {PetscSpaceRegisterAll();}

281:   PetscObjectOptionsBegin((PetscObject) sp);
282:   PetscOptionsFList("-petscspace_type", "Linear space", "PetscSpaceSetType", PetscSpaceList, defaultType, name, 256, &flg);
283:   if (flg) {
284:     PetscSpaceSetType(sp, name);
285:   } else if (!((PetscObject) sp)->type_name) {
286:     PetscSpaceSetType(sp, defaultType);
287:   }
288:   PetscOptionsInt("-petscspace_order", "The approximation order", "PetscSpaceSetOrder", sp->order, &sp->order, NULL);
289:   if (sp->ops->setfromoptions) {
290:     (*sp->ops->setfromoptions)(sp);
291:   }
292:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
293:   PetscObjectProcessOptionsHandlers((PetscObject) sp);
294:   PetscOptionsEnd();
295:   PetscSpaceViewFromOptions(sp, NULL, "-petscspace_view");
296:   return(0);
297: }

301: /*@C
302:   PetscSpaceSetUp - Construct data structures for the PetscSpace

304:   Collective on PetscSpace

306:   Input Parameter:
307: . sp - the PetscSpace object to setup

309:   Level: developer

311: .seealso PetscSpaceView(), PetscSpaceDestroy()
312: @*/
313: PetscErrorCode PetscSpaceSetUp(PetscSpace sp)
314: {

319:   if (sp->ops->setup) {(*sp->ops->setup)(sp);}
320:   return(0);
321: }

325: /*@
326:   PetscSpaceDestroy - Destroys a PetscSpace object

328:   Collective on PetscSpace

330:   Input Parameter:
331: . sp - the PetscSpace object to destroy

333:   Level: developer

335: .seealso PetscSpaceView()
336: @*/
337: PetscErrorCode PetscSpaceDestroy(PetscSpace *sp)
338: {

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

345:   if (--((PetscObject)(*sp))->refct > 0) {*sp = 0; return(0);}
346:   ((PetscObject) (*sp))->refct = 0;
347:   DMDestroy(&(*sp)->dm);

349:   (*(*sp)->ops->destroy)(*sp);
350:   PetscHeaderDestroy(sp);
351:   return(0);
352: }

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

359:   Collective on MPI_Comm

361:   Input Parameter:
362: . comm - The communicator for the PetscSpace object

364:   Output Parameter:
365: . sp - The PetscSpace object

367:   Level: beginner

369: .seealso: PetscSpaceSetType(), PETSCSPACEPOLYNOMIAL
370: @*/
371: PetscErrorCode PetscSpaceCreate(MPI_Comm comm, PetscSpace *sp)
372: {
373:   PetscSpace     s;

378:   PetscCitationsRegister(FECitation,&FEcite);
379:   *sp  = NULL;
380:   PetscFEInitializePackage();

382:   PetscHeaderCreate(s, _p_PetscSpace, struct _PetscSpaceOps, PETSCSPACE_CLASSID, "PetscSpace", "Linear Space", "PetscSpace", comm, PetscSpaceDestroy, PetscSpaceView);
383:   PetscMemzero(s->ops, sizeof(struct _PetscSpaceOps));

385:   s->order = 0;
386:   DMShellCreate(comm, &s->dm);

388:   *sp = s;
389:   return(0);
390: }

394: /* Dimension of the space, i.e. number of basis vectors */
395: PetscErrorCode PetscSpaceGetDimension(PetscSpace sp, PetscInt *dim)
396: {

402:   *dim = 0;
403:   if (sp->ops->getdimension) {(*sp->ops->getdimension)(sp, dim);}
404:   return(0);
405: }

409: PetscErrorCode PetscSpaceGetOrder(PetscSpace sp, PetscInt *order)
410: {
414:   *order = sp->order;
415:   return(0);
416: }

420: PetscErrorCode PetscSpaceSetOrder(PetscSpace sp, PetscInt order)
421: {
424:   sp->order = order;
425:   return(0);
426: }

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

433:   Input Parameters:
434: + sp      - The PetscSpace
435: . npoints - The number of evaluation points
436: - points  - The point coordinates

438:   Output Parameters:
439: + B - The function evaluations in a npoints x nfuncs array
440: . D - The derivative evaluations in a npoints x nfuncs x dim array
441: - H - The second derivative evaluations in a npoints x nfuncs x dim x dim array

443:   Level: advanced

445: .seealso: PetscFEGetTabulation(), PetscFEGetDefaultTabulation(), PetscSpaceCreate()
446: @*/
447: PetscErrorCode PetscSpaceEvaluate(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
448: {

457:   if (sp->ops->evaluate) {(*sp->ops->evaluate)(sp, npoints, points, B, D, H);}
458:   return(0);
459: }

463: PetscErrorCode PetscSpaceSetFromOptions_Polynomial(PetscSpace sp)
464: {
465:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
466:   PetscErrorCode   ierr;

469:   PetscObjectOptionsBegin((PetscObject) sp);
470:   PetscOptionsInt("-petscspace_poly_num_variables", "The number of different variables, e.g. x and y", "PetscSpacePolynomialSetNumVariables", poly->numVariables, &poly->numVariables, NULL);
471:   PetscOptionsBool("-petscspace_poly_sym", "Use only symmetric polynomials", "PetscSpacePolynomialSetSymmetric", poly->symmetric, &poly->symmetric, NULL);
472:   PetscOptionsBool("-petscspace_poly_tensor", "Use the tensor product polynomials", "PetscSpacePolynomialSetTensor", poly->tensor, &poly->tensor, NULL);
473:   PetscOptionsEnd();
474:   return(0);
475: }

479: PetscErrorCode PetscSpacePolynomialView_Ascii(PetscSpace sp, PetscViewer viewer)
480: {
481:   PetscSpace_Poly  *poly = (PetscSpace_Poly *) sp->data;
482:   PetscViewerFormat format;
483:   PetscErrorCode    ierr;

486:   PetscViewerGetFormat(viewer, &format);
487:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
488:     PetscViewerASCIIPrintf(viewer, "Polynomial space in %d variables of order %d\n", poly->numVariables, sp->order);
489:   } else {
490:     PetscViewerASCIIPrintf(viewer, "Polynomial space in %d variables of order %d\n", poly->numVariables, sp->order);
491:   }
492:   return(0);
493: }

497: PetscErrorCode PetscSpaceView_Polynomial(PetscSpace sp, PetscViewer viewer)
498: {
499:   PetscBool      iascii;

505:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
506:   if (iascii) {PetscSpacePolynomialView_Ascii(sp, viewer);}
507:   return(0);
508: }

512: PetscErrorCode PetscSpaceSetUp_Polynomial(PetscSpace sp)
513: {
514:   PetscSpace_Poly *poly    = (PetscSpace_Poly *) sp->data;
515:   PetscInt         ndegree = sp->order+1;
516:   PetscInt         deg;
517:   PetscErrorCode   ierr;

520:   PetscMalloc1(ndegree, &poly->degrees);
521:   for (deg = 0; deg < ndegree; ++deg) poly->degrees[deg] = deg;
522:   return(0);
523: }

527: PetscErrorCode PetscSpaceDestroy_Polynomial(PetscSpace sp)
528: {
529:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
530:   PetscErrorCode   ierr;

533:   PetscFree(poly->degrees);
534:   PetscFree(poly);
535:   return(0);
536: }

540: PetscErrorCode PetscSpaceGetDimension_Polynomial(PetscSpace sp, PetscInt *dim)
541: {
542:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
543:   PetscInt         deg  = sp->order;
544:   PetscInt         n    = poly->numVariables, i;
545:   PetscReal        D    = 1.0;

548:   if (poly->tensor) {
549:     *dim = 1;
550:     for (i = 0; i < n; ++i) *dim *= (deg+1);
551:   } else {
552:     for (i = 1; i <= n; ++i) {
553:       D *= ((PetscReal) (deg+i))/i;
554:     }
555:     *dim = (PetscInt) (D + 0.5);
556:   }
557:   return(0);
558: }

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

565:   Input Parameters:
566: + len - The length of the tuple
567: . sum - The sum of all entries in the tuple
568: - ind - The current multi-index of the tuple, initialized to the 0 tuple

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

574:   Level: developer

576: .seealso: 
577: */
578: static PetscErrorCode LatticePoint_Internal(PetscInt len, PetscInt sum, PetscInt ind[], PetscInt tup[])
579: {
580:   PetscInt       i;

584:   if (len == 1) {
585:     ind[0] = -1;
586:     tup[0] = sum;
587:   } else if (sum == 0) {
588:     for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
589:   } else {
590:     tup[0] = sum - ind[0];
591:     LatticePoint_Internal(len-1, ind[0], &ind[1], &tup[1]);
592:     if (ind[1] < 0) {
593:       if (ind[0] == sum) {ind[0] = -1;}
594:       else               {ind[1] = 0; ++ind[0];}
595:     }
596:   }
597:   return(0);
598: }

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

605:   Input Parameters:
606: + len - The length of the tuple
607: . max - The max for all entries in the tuple
608: - ind - The current multi-index of the tuple, initialized to the 0 tuple

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

614:   Level: developer

616: .seealso: 
617: */
618: static PetscErrorCode TensorPoint_Internal(PetscInt len, PetscInt max, PetscInt ind[], PetscInt tup[])
619: {
620:   PetscInt       i;

624:   if (len == 1) {
625:     tup[0] = ind[0]++;
626:     ind[0] = ind[0] >= max ? -1 : ind[0];
627:   } else if (max == 0) {
628:     for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
629:   } else {
630:     tup[0] = ind[0];
631:     TensorPoint_Internal(len-1, max, &ind[1], &tup[1]);
632:     if (ind[1] < 0) {
633:       if (ind[0] == max-1) {ind[0] = -1;}
634:       else                 {ind[1] = 0; ++ind[0];}
635:     }
636:   }
637:   return(0);
638: }

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

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

765: PetscErrorCode PetscSpaceInitialize_Polynomial(PetscSpace sp)
766: {
768:   sp->ops->setfromoptions = PetscSpaceSetFromOptions_Polynomial;
769:   sp->ops->setup          = PetscSpaceSetUp_Polynomial;
770:   sp->ops->view           = PetscSpaceView_Polynomial;
771:   sp->ops->destroy        = PetscSpaceDestroy_Polynomial;
772:   sp->ops->getdimension   = PetscSpaceGetDimension_Polynomial;
773:   sp->ops->evaluate       = PetscSpaceEvaluate_Polynomial;
774:   return(0);
775: }

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

780:   Level: intermediate

782: .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
783: M*/

787: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_Polynomial(PetscSpace sp)
788: {
789:   PetscSpace_Poly *poly;
790:   PetscErrorCode   ierr;

794:   PetscNewLog(sp,&poly);
795:   sp->data = poly;

797:   poly->numVariables = 0;
798:   poly->symmetric    = PETSC_FALSE;
799:   poly->tensor       = PETSC_FALSE;
800:   poly->degrees      = NULL;

802:   PetscSpaceInitialize_Polynomial(sp);
803:   return(0);
804: }

808: PetscErrorCode PetscSpacePolynomialSetSymmetric(PetscSpace sp, PetscBool sym)
809: {
810:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

814:   poly->symmetric = sym;
815:   return(0);
816: }

820: PetscErrorCode PetscSpacePolynomialGetSymmetric(PetscSpace sp, PetscBool *sym)
821: {
822:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

827:   *sym = poly->symmetric;
828:   return(0);
829: }

833: PetscErrorCode PetscSpacePolynomialSetTensor(PetscSpace sp, PetscBool tensor)
834: {
835:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

839:   poly->tensor = tensor;
840:   return(0);
841: }

845: PetscErrorCode PetscSpacePolynomialGetTensor(PetscSpace sp, PetscBool *tensor)
846: {
847:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

852:   *tensor = poly->tensor;
853:   return(0);
854: }

858: PetscErrorCode PetscSpacePolynomialSetNumVariables(PetscSpace sp, PetscInt n)
859: {
860:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

864:   poly->numVariables = n;
865:   return(0);
866: }

870: PetscErrorCode PetscSpacePolynomialGetNumVariables(PetscSpace sp, PetscInt *n)
871: {
872:   PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;

877:   *n = poly->numVariables;
878:   return(0);
879: }

883: PetscErrorCode PetscSpaceSetFromOptions_DG(PetscSpace sp)
884: {
885:   PetscSpace_DG *dg = (PetscSpace_DG *) sp->data;

889:   PetscObjectOptionsBegin((PetscObject) sp);
890:   PetscOptionsInt("-petscspace_dg_num_variables", "The number of different variables, e.g. x and y", "PetscSpaceDGSetNumVariables", dg->numVariables, &dg->numVariables, NULL);
891:   PetscOptionsEnd();
892:   return(0);
893: }

897: PetscErrorCode PetscSpaceDGView_Ascii(PetscSpace sp, PetscViewer viewer)
898: {
899:   PetscSpace_DG    *dg = (PetscSpace_DG *) sp->data;
900:   PetscViewerFormat format;
901:   PetscErrorCode    ierr;

904:   PetscViewerGetFormat(viewer, &format);
905:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
906:     PetscViewerASCIIPrintf(viewer, "DG space in dimension %d:\n", dg->numVariables);
907:     PetscViewerASCIIPushTab(viewer);
908:     PetscQuadratureView(dg->quad, viewer);
909:     PetscViewerASCIIPopTab(viewer);
910:   } else {
911:     PetscViewerASCIIPrintf(viewer, "DG space in dimension %d on %d points\n", dg->numVariables, dg->quad->numPoints);
912:   }
913:   return(0);
914: }

918: PetscErrorCode PetscSpaceView_DG(PetscSpace sp, PetscViewer viewer)
919: {
920:   PetscBool      iascii;

926:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
927:   if (iascii) {PetscSpaceDGView_Ascii(sp, viewer);}
928:   return(0);
929: }

933: PetscErrorCode PetscSpaceSetUp_DG(PetscSpace sp)
934: {
935:   PetscSpace_DG *dg = (PetscSpace_DG *) sp->data;

939:   if (!dg->quad->points && sp->order) {
940:     PetscDTGaussJacobiQuadrature(dg->numVariables, sp->order, -1.0, 1.0, &dg->quad);
941:   }
942:   return(0);
943: }

947: PetscErrorCode PetscSpaceDestroy_DG(PetscSpace sp)
948: {
949:   PetscSpace_DG *dg = (PetscSpace_DG *) sp->data;

953:   PetscQuadratureDestroy(&dg->quad);
954:   return(0);
955: }

959: PetscErrorCode PetscSpaceGetDimension_DG(PetscSpace sp, PetscInt *dim)
960: {
961:   PetscSpace_DG *dg = (PetscSpace_DG *) sp->data;

964:   *dim = dg->quad->numPoints;
965:   return(0);
966: }

970: PetscErrorCode PetscSpaceEvaluate_DG(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
971: {
972:   PetscSpace_DG *dg  = (PetscSpace_DG *) sp->data;
973:   PetscInt       dim = dg->numVariables, d, p;

977:   if (D || H) SETERRQ(PetscObjectComm((PetscObject) sp), PETSC_ERR_SUP, "Cannot calculate derivatives for a DG space");
978:   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);
979:   PetscMemzero(B, npoints*npoints * sizeof(PetscReal));
980:   for (p = 0; p < npoints; ++p) {
981:     for (d = 0; d < dim; ++d) {
982:       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]);
983:     }
984:     B[p*npoints+p] = 1.0;
985:   }
986:   return(0);
987: }

991: PetscErrorCode PetscSpaceInitialize_DG(PetscSpace sp)
992: {
994:   sp->ops->setfromoptions = PetscSpaceSetFromOptions_DG;
995:   sp->ops->setup          = PetscSpaceSetUp_DG;
996:   sp->ops->view           = PetscSpaceView_DG;
997:   sp->ops->destroy        = PetscSpaceDestroy_DG;
998:   sp->ops->getdimension   = PetscSpaceGetDimension_DG;
999:   sp->ops->evaluate       = PetscSpaceEvaluate_DG;
1000:   return(0);
1001: }

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

1006:   Level: intermediate

1008: .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
1009: M*/

1013: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_DG(PetscSpace sp)
1014: {
1015:   PetscSpace_DG *dg;

1020:   PetscNewLog(sp,&dg);
1021:   sp->data = dg;

1023:   dg->numVariables    = 0;
1024:   dg->quad->dim       = 0;
1025:   dg->quad->numPoints = 0;
1026:   dg->quad->points    = NULL;
1027:   dg->quad->weights   = NULL;

1029:   PetscSpaceInitialize_DG(sp);
1030:   return(0);
1031: }


1034: PetscClassId PETSCDUALSPACE_CLASSID = 0;

1036: PetscFunctionList PetscDualSpaceList              = NULL;
1037: PetscBool         PetscDualSpaceRegisterAllCalled = PETSC_FALSE;

1041: /*@C
1042:   PetscDualSpaceRegister - Adds a new PetscDualSpace implementation

1044:   Not Collective

1046:   Input Parameters:
1047: + name        - The name of a new user-defined creation routine
1048: - create_func - The creation routine itself

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

1053:   Sample usage:
1054: .vb
1055:     PetscDualSpaceRegister("my_space", MyPetscDualSpaceCreate);
1056: .ve

1058:   Then, your PetscDualSpace type can be chosen with the procedural interface via
1059: .vb
1060:     PetscDualSpaceCreate(MPI_Comm, PetscDualSpace *);
1061:     PetscDualSpaceSetType(PetscDualSpace, "my_dual_space");
1062: .ve
1063:    or at runtime via the option
1064: .vb
1065:     -petscdualspace_type my_dual_space
1066: .ve

1068:   Level: advanced

1070: .keywords: PetscDualSpace, register
1071: .seealso: PetscDualSpaceRegisterAll(), PetscDualSpaceRegisterDestroy()

1073: @*/
1074: PetscErrorCode PetscDualSpaceRegister(const char sname[], PetscErrorCode (*function)(PetscDualSpace))
1075: {

1079:   PetscFunctionListAdd(&PetscDualSpaceList, sname, function);
1080:   return(0);
1081: }

1085: /*@C
1086:   PetscDualSpaceSetType - Builds a particular PetscDualSpace

1088:   Collective on PetscDualSpace

1090:   Input Parameters:
1091: + sp   - The PetscDualSpace object
1092: - name - The kind of space

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

1097:   Level: intermediate

1099: .keywords: PetscDualSpace, set, type
1100: .seealso: PetscDualSpaceGetType(), PetscDualSpaceCreate()
1101: @*/
1102: PetscErrorCode PetscDualSpaceSetType(PetscDualSpace sp, PetscDualSpaceType name)
1103: {
1104:   PetscErrorCode (*r)(PetscDualSpace);
1105:   PetscBool      match;

1110:   PetscObjectTypeCompare((PetscObject) sp, name, &match);
1111:   if (match) return(0);

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

1117:   if (sp->ops->destroy) {
1118:     (*sp->ops->destroy)(sp);
1119:     sp->ops->destroy = NULL;
1120:   }
1121:   (*r)(sp);
1122:   PetscObjectChangeTypeName((PetscObject) sp, name);
1123:   return(0);
1124: }

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

1131:   Not Collective

1133:   Input Parameter:
1134: . dm  - The PetscDualSpace

1136:   Output Parameter:
1137: . name - The PetscDualSpace type name

1139:   Level: intermediate

1141: .keywords: PetscDualSpace, get, type, name
1142: .seealso: PetscDualSpaceSetType(), PetscDualSpaceCreate()
1143: @*/
1144: PetscErrorCode PetscDualSpaceGetType(PetscDualSpace sp, PetscDualSpaceType *name)
1145: {

1151:   if (!PetscDualSpaceRegisterAllCalled) {
1152:     PetscDualSpaceRegisterAll();
1153:   }
1154:   *name = ((PetscObject) sp)->type_name;
1155:   return(0);
1156: }

1160: /*@C
1161:   PetscDualSpaceView - Views a PetscDualSpace

1163:   Collective on PetscDualSpace

1165:   Input Parameter:
1166: + sp - the PetscDualSpace object to view
1167: - v  - the viewer

1169:   Level: developer

1171: .seealso PetscDualSpaceDestroy()
1172: @*/
1173: PetscErrorCode PetscDualSpaceView(PetscDualSpace sp, PetscViewer v)
1174: {

1179:   if (!v) {
1180:     PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) sp), &v);
1181:   }
1182:   if (sp->ops->view) {
1183:     (*sp->ops->view)(sp, v);
1184:   }
1185:   return(0);
1186: }

1190: /*
1191:   PetscDualSpaceViewFromOptions - Processes command line options to determine if/how a PetscDualSpace is to be viewed.

1193:   Collective on PetscDualSpace

1195:   Input Parameters:
1196: + sp   - the PetscDualSpace
1197: . prefix - prefix to use for viewing, or NULL to use prefix of 'rnd'
1198: - optionname - option to activate viewing

1200:   Level: intermediate

1202: .keywords: PetscDualSpace, view, options, database
1203: .seealso: VecViewFromOptions(), MatViewFromOptions()
1204: */
1205: PetscErrorCode PetscDualSpaceViewFromOptions(PetscDualSpace sp, const char prefix[], const char optionname[])
1206: {
1207:   PetscViewer       viewer;
1208:   PetscViewerFormat format;
1209:   PetscBool         flg;
1210:   PetscErrorCode    ierr;

1213:   if (prefix) {
1214:     PetscOptionsGetViewer(PetscObjectComm((PetscObject) sp), prefix, optionname, &viewer, &format, &flg);
1215:   } else {
1216:     PetscOptionsGetViewer(PetscObjectComm((PetscObject) sp), ((PetscObject) sp)->prefix, optionname, &viewer, &format, &flg);
1217:   }
1218:   if (flg) {
1219:     PetscViewerPushFormat(viewer, format);
1220:     PetscDualSpaceView(sp, viewer);
1221:     PetscViewerPopFormat(viewer);
1222:     PetscViewerDestroy(&viewer);
1223:   }
1224:   return(0);
1225: }

1229: /*@
1230:   PetscDualSpaceSetFromOptions - sets parameters in a PetscDualSpace from the options database

1232:   Collective on PetscDualSpace

1234:   Input Parameter:
1235: . sp - the PetscDualSpace object to set options for

1237:   Options Database:
1238: . -petscspace_order the approximation order of the space

1240:   Level: developer

1242: .seealso PetscDualSpaceView()
1243: @*/
1244: PetscErrorCode PetscDualSpaceSetFromOptions(PetscDualSpace sp)
1245: {
1246:   const char    *defaultType;
1247:   char           name[256];
1248:   PetscBool      flg;

1253:   if (!((PetscObject) sp)->type_name) {
1254:     defaultType = PETSCDUALSPACELAGRANGE;
1255:   } else {
1256:     defaultType = ((PetscObject) sp)->type_name;
1257:   }
1258:   if (!PetscSpaceRegisterAllCalled) {PetscSpaceRegisterAll();}

1260:   PetscObjectOptionsBegin((PetscObject) sp);
1261:   PetscOptionsFList("-petscdualspace_type", "Dual space", "PetscDualSpaceSetType", PetscDualSpaceList, defaultType, name, 256, &flg);
1262:   if (flg) {
1263:     PetscDualSpaceSetType(sp, name);
1264:   } else if (!((PetscObject) sp)->type_name) {
1265:     PetscDualSpaceSetType(sp, defaultType);
1266:   }
1267:   PetscOptionsInt("-petscdualspace_order", "The approximation order", "PetscDualSpaceSetOrder", sp->order, &sp->order, NULL);
1268:   if (sp->ops->setfromoptions) {
1269:     (*sp->ops->setfromoptions)(sp);
1270:   }
1271:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
1272:   PetscObjectProcessOptionsHandlers((PetscObject) sp);
1273:   PetscOptionsEnd();
1274:   PetscDualSpaceViewFromOptions(sp, NULL, "-petscdualspace_view");
1275:   return(0);
1276: }

1280: /*@C
1281:   PetscDualSpaceSetUp - Construct a basis for the PetscDualSpace

1283:   Collective on PetscDualSpace

1285:   Input Parameter:
1286: . sp - the PetscDualSpace object to setup

1288:   Level: developer

1290: .seealso PetscDualSpaceView(), PetscDualSpaceDestroy()
1291: @*/
1292: PetscErrorCode PetscDualSpaceSetUp(PetscDualSpace sp)
1293: {

1298:   if (sp->ops->setup) {(*sp->ops->setup)(sp);}
1299:   return(0);
1300: }

1304: /*@
1305:   PetscDualSpaceDestroy - Destroys a PetscDualSpace object

1307:   Collective on PetscDualSpace

1309:   Input Parameter:
1310: . sp - the PetscDualSpace object to destroy

1312:   Level: developer

1314: .seealso PetscDualSpaceView()
1315: @*/
1316: PetscErrorCode PetscDualSpaceDestroy(PetscDualSpace *sp)
1317: {
1318:   PetscInt       dim, f;

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

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

1328:   PetscDualSpaceGetDimension(*sp, &dim);
1329:   for (f = 0; f < dim; ++f) {
1330:     PetscQuadratureDestroy(&(*sp)->functional[f]);
1331:   }
1332:   PetscFree((*sp)->functional);
1333:   DMDestroy(&(*sp)->dm);

1335:   if ((*sp)->ops->destroy) {(*(*sp)->ops->destroy)(*sp);}
1336:   PetscHeaderDestroy(sp);
1337:   return(0);
1338: }

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

1345:   Collective on MPI_Comm

1347:   Input Parameter:
1348: . comm - The communicator for the PetscDualSpace object

1350:   Output Parameter:
1351: . sp - The PetscDualSpace object

1353:   Level: beginner

1355: .seealso: PetscDualSpaceSetType(), PETSCDUALSPACELAGRANGE
1356: @*/
1357: PetscErrorCode PetscDualSpaceCreate(MPI_Comm comm, PetscDualSpace *sp)
1358: {
1359:   PetscDualSpace s;

1364:   PetscCitationsRegister(FECitation,&FEcite);
1365:   *sp  = NULL;
1366:   PetscFEInitializePackage();

1368:   PetscHeaderCreate(s, _p_PetscDualSpace, struct _PetscDualSpaceOps, PETSCDUALSPACE_CLASSID, "PetscDualSpace", "Dual Space", "PetscDualSpace", comm, PetscDualSpaceDestroy, PetscDualSpaceView);
1369:   PetscMemzero(s->ops, sizeof(struct _PetscDualSpaceOps));

1371:   s->order = 0;

1373:   *sp = s;
1374:   return(0);
1375: }

1379: PetscErrorCode PetscDualSpaceGetDM(PetscDualSpace sp, DM *dm)
1380: {
1384:   *dm = sp->dm;
1385:   return(0);
1386: }

1390: PetscErrorCode PetscDualSpaceSetDM(PetscDualSpace sp, DM dm)
1391: {

1397:   DMDestroy(&sp->dm);
1398:   PetscObjectReference((PetscObject) dm);
1399:   sp->dm = dm;
1400:   return(0);
1401: }

1405: PetscErrorCode PetscDualSpaceGetOrder(PetscDualSpace sp, PetscInt *order)
1406: {
1410:   *order = sp->order;
1411:   return(0);
1412: }

1416: PetscErrorCode PetscDualSpaceSetOrder(PetscDualSpace sp, PetscInt order)
1417: {
1420:   sp->order = order;
1421:   return(0);
1422: }

1426: PetscErrorCode PetscDualSpaceGetFunctional(PetscDualSpace sp, PetscInt i, PetscQuadrature *functional)
1427: {
1428:   PetscInt       dim;

1434:   PetscDualSpaceGetDimension(sp, &dim);
1435:   if ((i < 0) || (i >= dim)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Functional index %d must be in [0, %d)", i, dim);
1436:   *functional = sp->functional[i];
1437:   return(0);
1438: }

1442: /* Dimension of the space, i.e. number of basis vectors */
1443: PetscErrorCode PetscDualSpaceGetDimension(PetscDualSpace sp, PetscInt *dim)
1444: {

1450:   *dim = 0;
1451:   if (sp->ops->getdimension) {(*sp->ops->getdimension)(sp, dim);}
1452:   return(0);
1453: }

1457: PetscErrorCode PetscDualSpaceGetNumDof(PetscDualSpace sp, const PetscInt **numDof)
1458: {

1464:   *numDof = NULL;
1465:   if (sp->ops->getnumdof) {(*sp->ops->getnumdof)(sp, numDof);}
1466:   return(0);
1467: }

1471: /*@C
1472:   PetscDualSpaceCreateReferenceCell - Create a DMPLEX with the appropriate FEM reference cell

1474:   Collective on PetscDualSpace

1476:   Input Parameters:
1477: + sp      - The PetscDualSpace
1478: . dim     - The spatial dimension
1479: - simplex - Flag for simplex, otherwise use a tensor-product cell

1481:   Output Parameter:
1482: . refdm - The reference cell

1484:   Level: advanced

1486: .keywords: PetscDualSpace, reference cell
1487: .seealso: PetscDualSpaceCreate(), DMPLEX
1488: @*/
1489: PetscErrorCode PetscDualSpaceCreateReferenceCell(PetscDualSpace sp, PetscInt dim, PetscBool simplex, DM *refdm)
1490: {
1491:   DM             rdm;

1495:   DMCreate(PetscObjectComm((PetscObject) sp), &rdm);
1496:   DMSetType(rdm, DMPLEX);
1497:   DMPlexSetDimension(rdm, dim);
1498:   switch (dim) {
1499:   case 0:
1500:   {
1501:     PetscInt    numPoints[1]        = {1};
1502:     PetscInt    coneSize[1]         = {0};
1503:     PetscInt    cones[1]            = {0};
1504:     PetscInt    coneOrientations[1] = {0};
1505:     PetscScalar vertexCoords[1]     = {0.0};

1507:     DMPlexCreateFromDAG(rdm, 0, numPoints, coneSize, cones, coneOrientations, vertexCoords);
1508:   }
1509:   break;
1510:   case 1:
1511:   {
1512:     PetscInt    numPoints[2]        = {2, 1};
1513:     PetscInt    coneSize[3]         = {2, 0, 0};
1514:     PetscInt    cones[2]            = {1, 2};
1515:     PetscInt    coneOrientations[2] = {0, 0};
1516:     PetscScalar vertexCoords[2]     = {-1.0,  1.0};

1518:     DMPlexCreateFromDAG(rdm, 1, numPoints, coneSize, cones, coneOrientations, vertexCoords);
1519:   }
1520:   break;
1521:   case 2:
1522:     if (simplex) {
1523:       PetscInt    numPoints[2]        = {3, 1};
1524:       PetscInt    coneSize[4]         = {3, 0, 0, 0};
1525:       PetscInt    cones[3]            = {1, 2, 3};
1526:       PetscInt    coneOrientations[3] = {0, 0, 0};
1527:       PetscScalar vertexCoords[6]     = {-1.0, -1.0,  1.0, -1.0,  -1.0, 1.0};

1529:       DMPlexCreateFromDAG(rdm, 1, numPoints, coneSize, cones, coneOrientations, vertexCoords);
1530:     } else {
1531:       PetscInt    numPoints[2]        = {4, 1};
1532:       PetscInt    coneSize[5]         = {4, 0, 0, 0, 0};
1533:       PetscInt    cones[4]            = {1, 2, 3, 4};
1534:       PetscInt    coneOrientations[4] = {0, 0, 0, 0};
1535:       PetscScalar vertexCoords[8]     = {-1.0, -1.0,  1.0, -1.0,  1.0, 1.0,  -1.0, 1.0};

1537:       DMPlexCreateFromDAG(rdm, 1, numPoints, coneSize, cones, coneOrientations, vertexCoords);
1538:     }
1539:   break;
1540:   case 3:
1541:     if (simplex) {
1542:       PetscInt    numPoints[2]        = {4, 1};
1543:       PetscInt    coneSize[5]         = {4, 0, 0, 0, 0};
1544:       PetscInt    cones[4]            = {1, 3, 2, 4};
1545:       PetscInt    coneOrientations[4] = {0, 0, 0, 0};
1546:       PetscScalar vertexCoords[12]    = {-1.0, -1.0, -1.0,  1.0, -1.0, -1.0,  -1.0, 1.0, -1.0,  -1.0, -1.0, 1.0};

1548:       DMPlexCreateFromDAG(rdm, 1, numPoints, coneSize, cones, coneOrientations, vertexCoords);
1549:     } else {
1550:       PetscInt    numPoints[2]        = {8, 1};
1551:       PetscInt    coneSize[9]         = {8, 0, 0, 0, 0, 0, 0, 0, 0};
1552:       PetscInt    cones[8]            = {1, 4, 3, 2, 5, 6, 7, 8};
1553:       PetscInt    coneOrientations[8] = {0, 0, 0, 0, 0, 0, 0, 0};
1554:       PetscScalar vertexCoords[24]    = {-1.0, -1.0, -1.0,  1.0, -1.0, -1.0,  1.0, 1.0, -1.0,  -1.0, 1.0, -1.0,
1555:                                          -1.0, -1.0,  1.0,  1.0, -1.0,  1.0,  1.0, 1.0,  1.0,  -1.0, 1.0,  1.0};

1557:       DMPlexCreateFromDAG(rdm, 1, numPoints, coneSize, cones, coneOrientations, vertexCoords);
1558:     }
1559:   break;
1560:   default:
1561:     SETERRQ1(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_WRONG, "Cannot create reference cell for dimension %d", dim);
1562:   }
1563:   *refdm = NULL;
1564:   DMPlexInterpolate(rdm, refdm);
1565:   DMPlexCopyCoordinates(rdm, *refdm);
1566:   DMDestroy(&rdm);
1567:   return(0);
1568: }

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

1575:   Input Parameters:
1576: + sp      - The PetscDualSpace object
1577: . f       - The basis functional index
1578: . geom    - A context with geometric information for this cell, we use v0 (the initial vertex) and J (the Jacobian)
1579: . numComp - The number of components for the function
1580: . func    - The input function
1581: - ctx     - A context for the function

1583:   Output Parameter:
1584: . value   - numComp output values

1586:   Level: developer

1588: .seealso: PetscDualSpaceCreate()
1589: @*/
1590: PetscErrorCode PetscDualSpaceApply(PetscDualSpace sp, PetscInt f, PetscCellGeometry geom, PetscInt numComp, void (*func)(const PetscReal [], PetscScalar *, void *), void *ctx, PetscScalar *value)
1591: {
1592:   DM               dm;
1593:   PetscQuadrature  quad;
1594:   const PetscReal *v0 = geom.v0;
1595:   const PetscReal *J  = geom.J;
1596:   PetscReal        x[3];
1597:   PetscScalar     *val;
1598:   PetscInt         dim, q, c, d, d2;
1599:   PetscErrorCode   ierr;

1604:   PetscDualSpaceGetDM(sp, &dm);
1605:   DMPlexGetDimension(dm, &dim);
1606:   PetscDualSpaceGetFunctional(sp, f, &quad);
1607:   DMGetWorkArray(dm, numComp, PETSC_SCALAR, &val);
1608:   for (c = 0; c < numComp; ++c) value[c] = 0.0;
1609:   for (q = 0; q < quad->numPoints; ++q) {
1610:     for (d = 0; d < dim; ++d) {
1611:       x[d] = v0[d];
1612:       for (d2 = 0; d2 < dim; ++d2) {
1613:         x[d] += J[d*dim+d2]*(quad->points[q*dim+d2] + 1.0);
1614:       }
1615:     }
1616:     (*func)(x, val, ctx);
1617:     for (c = 0; c < numComp; ++c) {
1618:       value[c] += val[c]*quad->weights[q];
1619:     }
1620:   }
1621:   DMRestoreWorkArray(dm, numComp, PETSC_SCALAR, &val);
1622:   return(0);
1623: }

1627: PetscErrorCode PetscDualSpaceGetDimension_SingleCell_Lagrange(PetscDualSpace sp, PetscInt *dim)
1628: {
1629:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
1630:   PetscInt            deg = sp->order;
1631:   PetscReal           D   = 1.0;
1632:   PetscInt            n, i;
1633:   PetscErrorCode      ierr;

1636:   DMPlexGetDimension(sp->dm, &n);
1637:   if (lag->simplex) {
1638:     for (i = 1; i <= n; ++i) {
1639:       D *= ((PetscReal) (deg+i))/i;
1640:     }
1641:     *dim = (PetscInt) (D + 0.5);
1642:   } else {
1643:     *dim = 1;
1644:     for (i = 0; i < n; ++i) *dim *= (deg+1);
1645:   }
1646:   return(0);
1647: }

1651: PetscErrorCode PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp)
1652: {
1653:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
1654:   DM                  dm    = sp->dm;
1655:   PetscInt            order = sp->order;
1656:   PetscSection        csection;
1657:   Vec                 coordinates;
1658:   PetscReal          *qpoints, *qweights;
1659:   PetscInt           *closure = NULL, closureSize, c;
1660:   PetscInt            depth, dim, pdimMax, *pStart, *pEnd, cell, coneSize, d, n, f = 0;
1661:   PetscBool           simplex;
1662:   PetscErrorCode      ierr;

1665:   /* Classify element type */
1666:   DMPlexGetDimension(dm, &dim);
1667:   DMPlexGetDepth(dm, &depth);
1668:   PetscCalloc1(dim+1, &lag->numDof);
1669:   PetscMalloc2(depth+1,&pStart,depth+1,&pEnd);
1670:   for (d = 0; d <= depth; ++d) {
1671:     DMPlexGetDepthStratum(dm, d, &pStart[d], &pEnd[d]);
1672:   }
1673:   DMPlexGetConeSize(dm, pStart[depth], &coneSize);
1674:   DMGetCoordinateSection(dm, &csection);
1675:   DMGetCoordinatesLocal(dm, &coordinates);
1676:   if      (coneSize == dim+1)    simplex = PETSC_TRUE;
1677:   else if (coneSize == 1 << dim) simplex = PETSC_FALSE;
1678:   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
1679:   lag->simplex = simplex;
1680:   PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, &pdimMax);
1681:   pdimMax *= (pEnd[dim] - pStart[dim]);
1682:   PetscMalloc1(pdimMax, &sp->functional);
1683:   if (!dim) {
1684:     PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
1685:     PetscMalloc1(1, &qpoints);
1686:     PetscMalloc1(1, &qweights);
1687:     PetscQuadratureSetData(sp->functional[f], PETSC_DETERMINE, 1, qpoints, qweights);
1688:     qpoints[0]  = 0.0;
1689:     qweights[0] = 1.0;
1690:     ++f;
1691:     lag->numDof[0] = 1;
1692:   } else {
1693:     PetscBT seen;

1695:     PetscBTCreate(pEnd[dim-1], &seen);
1696:     PetscBTMemzero(pEnd[dim-1], seen);
1697:     for (cell = pStart[depth]; cell < pEnd[depth]; ++cell) {
1698:       DMPlexGetTransitiveClosure(dm, cell, PETSC_TRUE, &closureSize, &closure);
1699:       for (c = 0; c < closureSize*2; c += 2) {
1700:         const PetscInt p = closure[c];

1702:         if (PetscBTLookup(seen, p)) continue;
1703:         PetscBTSet(seen, p);
1704:         if ((p >= pStart[0]) && (p < pEnd[0])) {
1705:           /* Vertices */
1706:           const PetscScalar *coords;
1707:           PetscInt           dof, off, d;

1709:           if (order < 1) continue;
1710:           PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
1711:           PetscMalloc1(dim, &qpoints);
1712:           PetscMalloc1(1, &qweights);
1713:           PetscQuadratureSetData(sp->functional[f], dim, 1, qpoints, qweights);
1714:           VecGetArrayRead(coordinates, &coords);
1715:           PetscSectionGetDof(csection, p, &dof);
1716:           PetscSectionGetOffset(csection, p, &off);
1717:           if (dof != dim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Number of coordinates %d does not match spatial dimension %d", dof, dim);
1718:           for (d = 0; d < dof; ++d) {qpoints[d] = PetscRealPart(coords[off+d]);}
1719:           qweights[0] = 1.0;
1720:           ++f;
1721:           VecRestoreArrayRead(coordinates, &coords);
1722:           lag->numDof[0] = 1;
1723:         } else if ((p >= pStart[1]) && (p < pEnd[1])) {
1724:           /* Edges */
1725:           PetscScalar *coords;
1726:           PetscInt     num = order-1, k;

1728:           if (order < 2) continue;
1729:           coords = NULL;
1730:           DMPlexVecGetClosure(dm, csection, coordinates, p, &n, &coords);
1731:           if (n != dim*2) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %d has %d coordinate values instead of %d", p, n, dim*2);
1732:           for (k = 1; k <= num; ++k) {
1733:             PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
1734:             PetscMalloc1(dim, &qpoints);
1735:             PetscMalloc1(1, &qweights);
1736:             PetscQuadratureSetData(sp->functional[f], dim, 1, qpoints, qweights);
1737:             for (d = 0; d < dim; ++d) {qpoints[d] = k*PetscRealPart(coords[1*dim+d] - coords[0*dim+d])/order + PetscRealPart(coords[0*dim+d]);}
1738:             qweights[0] = 1.0;
1739:             ++f;
1740:           }
1741:           DMPlexVecRestoreClosure(dm, csection, coordinates, p, &n, &coords);
1742:           lag->numDof[1] = num;
1743:         } else if ((p >= pStart[depth-1]) && (p < pEnd[depth-1])) {
1744:           /* Faces */

1746:           if ( simplex && (order < 3)) continue;
1747:           if (!simplex && (order < 2)) continue;
1748:           lag->numDof[depth-1] = 0;
1749:           SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Too lazy to implement faces");
1750:         } else if ((p >= pStart[depth]) && (p < pEnd[depth])) {
1751:           /* Cells */
1752:           PetscScalar *coords = NULL;
1753:           PetscInt     csize, v, d;

1755:           if ( simplex && (order > 0) && (order < 3)) continue;
1756:           if (!simplex && (order > 0) && (order < 2)) continue;
1757:           lag->numDof[depth] = 0;
1758:           if ( simplex && (order > 3)) {SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Too lazy to implement cells");}
1759:           if (!simplex && (order > 2)) {SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Too lazy to implement cells");}

1761:           PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
1762:           PetscMalloc1(dim, &qpoints);
1763:           PetscMalloc1(1, &qweights);
1764:           PetscQuadratureSetData(sp->functional[f], dim, 1, qpoints, qweights);
1765:           DMPlexVecGetClosure(dm, csection, coordinates, p, &csize, &coords);
1766:           if (csize%dim) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Coordinate size %d is not divisible by spatial dimension %d", csize, dim);
1767:           for (d = 0; d < dim; ++d) {
1768:             const PetscInt numVertices = csize/dim;

1770:             qpoints[d] = 0.0;
1771:             for (v = 0; v < numVertices; ++v) {
1772:               qpoints[d] += PetscRealPart(coords[v*dim+d]);
1773:             }
1774:             qpoints[d] /= numVertices;
1775:           }
1776:           DMPlexVecRestoreClosure(dm, csection, coordinates, p, &csize, &coords);
1777:           qweights[0] = 1.0;
1778:           ++f;
1779:           lag->numDof[depth] = 1;
1780:         }
1781:       }
1782:       DMPlexRestoreTransitiveClosure(dm, pStart[depth], PETSC_TRUE, &closureSize, &closure);
1783:     }
1784:     PetscBTDestroy(&seen);
1785:   }
1786:   if (pEnd[dim] == 1 && f != pdimMax) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of dual basis vectors %d not equal to dimension %d", f, pdimMax);
1787:   PetscFree2(pStart,pEnd);
1788:   if (f > pdimMax) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of dual basis vectors %d is greater than dimension %d", f, pdimMax);
1789:   return(0);
1790: }

1794: PetscErrorCode PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp)
1795: {
1796:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
1797:   PetscErrorCode      ierr;

1800:   PetscFree(lag->numDof);
1801:   PetscFree(lag);
1802:   return(0);
1803: }

1807: PetscErrorCode PetscDualSpaceGetDimension_Lagrange(PetscDualSpace sp, PetscInt *dim)
1808: {
1809:   DM              K;
1810:   const PetscInt *numDof;
1811:   PetscInt        spatialDim, Nc, size = 0, d;
1812:   PetscErrorCode  ierr;

1815:   PetscDualSpaceGetDM(sp, &K);
1816:   PetscDualSpaceGetNumDof(sp, &numDof);
1817:   DMPlexGetDimension(K, &spatialDim);
1818:   DMPlexGetHeightStratum(K, 0, NULL, &Nc);
1819:   if (Nc == 1) {PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, dim); return(0);}
1820:   for (d = 0; d <= spatialDim; ++d) {
1821:     PetscInt pStart, pEnd;

1823:     DMPlexGetDepthStratum(K, d, &pStart, &pEnd);
1824:     size += (pEnd-pStart)*numDof[d];
1825:   }
1826:   *dim = size;
1827:   return(0);
1828: }

1832: PetscErrorCode PetscDualSpaceGetNumDof_Lagrange(PetscDualSpace sp, const PetscInt **numDof)
1833: {
1834:   PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;

1837:   *numDof = lag->numDof;
1838:   return(0);
1839: }

1843: PetscErrorCode PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp)
1844: {
1846:   sp->ops->setfromoptions = NULL;
1847:   sp->ops->setup          = PetscDualSpaceSetUp_Lagrange;
1848:   sp->ops->view           = NULL;
1849:   sp->ops->destroy        = PetscDualSpaceDestroy_Lagrange;
1850:   sp->ops->getdimension   = PetscDualSpaceGetDimension_Lagrange;
1851:   sp->ops->getnumdof      = PetscDualSpaceGetNumDof_Lagrange;
1852:   return(0);
1853: }

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

1858:   Level: intermediate

1860: .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
1861: M*/

1865: PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Lagrange(PetscDualSpace sp)
1866: {
1867:   PetscDualSpace_Lag *lag;
1868:   PetscErrorCode      ierr;

1872:   PetscNewLog(sp,&lag);
1873:   sp->data = lag;

1875:   lag->numDof  = NULL;
1876:   lag->simplex = PETSC_TRUE;

1878:   PetscDualSpaceInitialize_Lagrange(sp);
1879:   return(0);
1880: }


1883: PetscClassId PETSCFE_CLASSID = 0;

1885: PetscFunctionList PetscFEList              = NULL;
1886: PetscBool         PetscFERegisterAllCalled = PETSC_FALSE;

1890: /*@C
1891:   PetscFERegister - Adds a new PetscFE implementation

1893:   Not Collective

1895:   Input Parameters:
1896: + name        - The name of a new user-defined creation routine
1897: - create_func - The creation routine itself

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

1902:   Sample usage:
1903: .vb
1904:     PetscFERegister("my_fe", MyPetscFECreate);
1905: .ve

1907:   Then, your PetscFE type can be chosen with the procedural interface via
1908: .vb
1909:     PetscFECreate(MPI_Comm, PetscFE *);
1910:     PetscFESetType(PetscFE, "my_fe");
1911: .ve
1912:    or at runtime via the option
1913: .vb
1914:     -petscfe_type my_fe
1915: .ve

1917:   Level: advanced

1919: .keywords: PetscFE, register
1920: .seealso: PetscFERegisterAll(), PetscFERegisterDestroy()

1922: @*/
1923: PetscErrorCode PetscFERegister(const char sname[], PetscErrorCode (*function)(PetscFE))
1924: {

1928:   PetscFunctionListAdd(&PetscFEList, sname, function);
1929:   return(0);
1930: }

1934: /*@C
1935:   PetscFESetType - Builds a particular PetscFE

1937:   Collective on PetscFE

1939:   Input Parameters:
1940: + fem  - The PetscFE object
1941: - name - The kind of FEM space

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

1946:   Level: intermediate

1948: .keywords: PetscFE, set, type
1949: .seealso: PetscFEGetType(), PetscFECreate()
1950: @*/
1951: PetscErrorCode PetscFESetType(PetscFE fem, PetscFEType name)
1952: {
1953:   PetscErrorCode (*r)(PetscFE);
1954:   PetscBool      match;

1959:   PetscObjectTypeCompare((PetscObject) fem, name, &match);
1960:   if (match) return(0);

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

1966:   if (fem->ops->destroy) {
1967:     (*fem->ops->destroy)(fem);
1968:     fem->ops->destroy = NULL;
1969:   }
1970:   (*r)(fem);
1971:   PetscObjectChangeTypeName((PetscObject) fem, name);
1972:   return(0);
1973: }

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

1980:   Not Collective

1982:   Input Parameter:
1983: . dm  - The PetscFE

1985:   Output Parameter:
1986: . name - The PetscFE type name

1988:   Level: intermediate

1990: .keywords: PetscFE, get, type, name
1991: .seealso: PetscFESetType(), PetscFECreate()
1992: @*/
1993: PetscErrorCode PetscFEGetType(PetscFE fem, PetscFEType *name)
1994: {

2000:   if (!PetscFERegisterAllCalled) {
2001:     PetscFERegisterAll();
2002:   }
2003:   *name = ((PetscObject) fem)->type_name;
2004:   return(0);
2005: }

2009: /*@C
2010:   PetscFEView - Views a PetscFE

2012:   Collective on PetscFE

2014:   Input Parameter:
2015: + fem - the PetscFE object to view
2016: - v   - the viewer

2018:   Level: developer

2020: .seealso PetscFEDestroy()
2021: @*/
2022: PetscErrorCode PetscFEView(PetscFE fem, PetscViewer v)
2023: {

2028:   if (!v) {
2029:     PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) fem), &v);
2030:   }
2031:   if (fem->ops->view) {
2032:     (*fem->ops->view)(fem, v);
2033:   }
2034:   return(0);
2035: }

2039: /*
2040:   PetscFEViewFromOptions - Processes command line options to determine if/how a PetscFE is to be viewed.

2042:   Collective on PetscFE

2044:   Input Parameters:
2045: + fem    - the PetscFE
2046: . prefix - prefix to use for viewing, or NULL to use prefix of 'rnd'
2047: - optionname - option to activate viewing

2049:   Level: intermediate

2051: .keywords: PetscFE, view, options, database
2052: .seealso: VecViewFromOptions(), MatViewFromOptions()
2053: */
2054: PetscErrorCode PetscFEViewFromOptions(PetscFE fem, const char prefix[], const char optionname[])
2055: {
2056:   PetscViewer       viewer;
2057:   PetscViewerFormat format;
2058:   PetscBool         flg;
2059:   PetscErrorCode    ierr;

2062:   if (prefix) {
2063:     PetscOptionsGetViewer(PetscObjectComm((PetscObject) fem), prefix, optionname, &viewer, &format, &flg);
2064:   } else {
2065:     PetscOptionsGetViewer(PetscObjectComm((PetscObject) fem), ((PetscObject) fem)->prefix, optionname, &viewer, &format, &flg);
2066:   }
2067:   if (flg) {
2068:     PetscViewerPushFormat(viewer, format);
2069:     PetscFEView(fem, viewer);
2070:     PetscViewerPopFormat(viewer);
2071:     PetscViewerDestroy(&viewer);
2072:   }
2073:   return(0);
2074: }

2078: /*@
2079:   PetscFESetFromOptions - sets parameters in a PetscFE from the options database

2081:   Collective on PetscFE

2083:   Input Parameter:
2084: . fem - the PetscFE object to set options for

2086:   Options Database:
2087: . -petscfe_num_blocks  the number of cell blocks to integrate concurrently
2088: . -petscfe_num_batches the number of cell batches to integrate serially

2090:   Level: developer

2092: .seealso PetscFEView()
2093: @*/
2094: PetscErrorCode PetscFESetFromOptions(PetscFE fem)
2095: {
2096:   const char    *defaultType;
2097:   char           name[256];
2098:   PetscBool      flg;

2103:   if (!((PetscObject) fem)->type_name) {
2104:     defaultType = PETSCFEBASIC;
2105:   } else {
2106:     defaultType = ((PetscObject) fem)->type_name;
2107:   }
2108:   if (!PetscFERegisterAllCalled) {PetscFERegisterAll();}

2110:   PetscObjectOptionsBegin((PetscObject) fem);
2111:   PetscOptionsFList("-petscfe_type", "Finite element space", "PetscFESetType", PetscFEList, defaultType, name, 256, &flg);
2112:   if (flg) {
2113:     PetscFESetType(fem, name);
2114:   } else if (!((PetscObject) fem)->type_name) {
2115:     PetscFESetType(fem, defaultType);
2116:   }
2117:   PetscOptionsInt("-petscfe_num_blocks", "The number of cell blocks to integrate concurrently", "PetscSpaceSetTileSizes", fem->numBlocks, &fem->numBlocks, NULL);
2118:   PetscOptionsInt("-petscfe_num_batches", "The number of cell batches to integrate serially", "PetscSpaceSetTileSizes", fem->numBatches, &fem->numBatches, NULL);
2119:   if (fem->ops->setfromoptions) {
2120:     (*fem->ops->setfromoptions)(fem);
2121:   }
2122:   /* process any options handlers added with PetscObjectAddOptionsHandler() */
2123:   PetscObjectProcessOptionsHandlers((PetscObject) fem);
2124:   PetscOptionsEnd();
2125:   PetscFEViewFromOptions(fem, NULL, "-petscfe_view");
2126:   return(0);
2127: }

2131: /*@C
2132:   PetscFESetUp - Construct data structures for the PetscFE

2134:   Collective on PetscFE

2136:   Input Parameter:
2137: . fem - the PetscFE object to setup

2139:   Level: developer

2141: .seealso PetscFEView(), PetscFEDestroy()
2142: @*/
2143: PetscErrorCode PetscFESetUp(PetscFE fem)
2144: {

2149:   if (fem->ops->setup) {(*fem->ops->setup)(fem);}
2150:   return(0);
2151: }

2155: /*@
2156:   PetscFEDestroy - Destroys a PetscFE object

2158:   Collective on PetscFE

2160:   Input Parameter:
2161: . fem - the PetscFE object to destroy

2163:   Level: developer

2165: .seealso PetscFEView()
2166: @*/
2167: PetscErrorCode PetscFEDestroy(PetscFE *fem)
2168: {

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

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

2178:   PetscFree((*fem)->numDof);
2179:   PetscFree((*fem)->invV);
2180:   PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->B, &(*fem)->D, NULL /*&(*fem)->H*/);
2181:   PetscSpaceDestroy(&(*fem)->basisSpace);
2182:   PetscDualSpaceDestroy(&(*fem)->dualSpace);
2183:   PetscQuadratureDestroy(&(*fem)->quadrature);

2185:   if ((*fem)->ops->destroy) {(*(*fem)->ops->destroy)(*fem);}
2186:   PetscHeaderDestroy(fem);
2187:   return(0);
2188: }

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

2195:   Collective on MPI_Comm

2197:   Input Parameter:
2198: . comm - The communicator for the PetscFE object

2200:   Output Parameter:
2201: . fem - The PetscFE object

2203:   Level: beginner

2205: .seealso: PetscFESetType(), PETSCFEGALERKIN
2206: @*/
2207: PetscErrorCode PetscFECreate(MPI_Comm comm, PetscFE *fem)
2208: {
2209:   PetscFE        f;

2214:   PetscCitationsRegister(FECitation,&FEcite);
2215:   *fem = NULL;
2216:   PetscFEInitializePackage();

2218:   PetscHeaderCreate(f, _p_PetscFE, struct _PetscFEOps, PETSCFE_CLASSID, "PetscFE", "Finite Element", "PetscFE", comm, PetscFEDestroy, PetscFEView);
2219:   PetscMemzero(f->ops, sizeof(struct _PetscFEOps));

2221:   f->basisSpace    = NULL;
2222:   f->dualSpace     = NULL;
2223:   f->numComponents = 1;
2224:   f->numDof        = NULL;
2225:   f->invV          = NULL;
2226:   f->B             = NULL;
2227:   f->D             = NULL;
2228:   f->H             = NULL;
2229:   PetscMemzero(&f->quadrature, sizeof(PetscQuadrature));
2230:   f->blockSize     = 0;
2231:   f->numBlocks     = 1;
2232:   f->batchSize     = 0;
2233:   f->numBatches    = 1;

2235:   *fem = f;
2236:   return(0);
2237: }

2241: PetscErrorCode PetscFEGetSpatialDimension(PetscFE fem, PetscInt *dim)
2242: {
2243:   DM             dm;

2249:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
2250:   DMPlexGetDimension(dm, dim);
2251:   return(0);
2252: }

2256: PetscErrorCode PetscFESetNumComponents(PetscFE fem, PetscInt comp)
2257: {
2260:   fem->numComponents = comp;
2261:   return(0);
2262: }

2266: PetscErrorCode PetscFEGetNumComponents(PetscFE fem, PetscInt *comp)
2267: {
2271:   *comp = fem->numComponents;
2272:   return(0);
2273: }

2277: PetscErrorCode PetscFESetTileSizes(PetscFE fem, PetscInt blockSize, PetscInt numBlocks, PetscInt batchSize, PetscInt numBatches)
2278: {
2281:   fem->blockSize  = blockSize;
2282:   fem->numBlocks  = numBlocks;
2283:   fem->batchSize  = batchSize;
2284:   fem->numBatches = numBatches;
2285:   return(0);
2286: }

2290: PetscErrorCode PetscFEGetTileSizes(PetscFE fem, PetscInt *blockSize, PetscInt *numBlocks, PetscInt *batchSize, PetscInt *numBatches)
2291: {
2298:   if (blockSize)  *blockSize  = fem->blockSize;
2299:   if (numBlocks)  *numBlocks  = fem->numBlocks;
2300:   if (batchSize)  *batchSize  = fem->batchSize;
2301:   if (numBatches) *numBatches = fem->numBatches;
2302:   return(0);
2303: }

2307: PetscErrorCode PetscFEGetBasisSpace(PetscFE fem, PetscSpace *sp)
2308: {
2312:   *sp = fem->basisSpace;
2313:   return(0);
2314: }

2318: PetscErrorCode PetscFESetBasisSpace(PetscFE fem, PetscSpace sp)
2319: {

2325:   PetscSpaceDestroy(&fem->basisSpace);
2326:   fem->basisSpace = sp;
2327:   PetscObjectReference((PetscObject) fem->basisSpace);
2328:   return(0);
2329: }

2333: PetscErrorCode PetscFEGetDualSpace(PetscFE fem, PetscDualSpace *sp)
2334: {
2338:   *sp = fem->dualSpace;
2339:   return(0);
2340: }

2344: PetscErrorCode PetscFESetDualSpace(PetscFE fem, PetscDualSpace sp)
2345: {

2351:   PetscDualSpaceDestroy(&fem->dualSpace);
2352:   fem->dualSpace = sp;
2353:   PetscObjectReference((PetscObject) fem->dualSpace);
2354:   return(0);
2355: }

2359: PetscErrorCode PetscFEGetQuadrature(PetscFE fem, PetscQuadrature *q)
2360: {
2364:   *q = fem->quadrature;
2365:   return(0);
2366: }

2370: PetscErrorCode PetscFESetQuadrature(PetscFE fem, PetscQuadrature q)
2371: {

2376:   PetscFERestoreTabulation(fem, 0, NULL, &fem->B, &fem->D, NULL /*&(*fem)->H*/);
2377:   PetscQuadratureDestroy(&fem->quadrature);
2378:   fem->quadrature = q;
2379:   PetscObjectReference((PetscObject) q);
2380:   return(0);
2381: }

2385: PetscErrorCode PetscFEGetNumDof(PetscFE fem, const PetscInt **numDof)
2386: {
2387:   const PetscInt *numDofDual;
2388:   PetscErrorCode  ierr;

2393:   PetscDualSpaceGetNumDof(fem->dualSpace, &numDofDual);
2394:   if (!fem->numDof) {
2395:     DM       dm;
2396:     PetscInt dim, d;

2398:     PetscDualSpaceGetDM(fem->dualSpace, &dm);
2399:     DMPlexGetDimension(dm, &dim);
2400:     PetscMalloc1((dim+1), &fem->numDof);
2401:     for (d = 0; d <= dim; ++d) {
2402:       fem->numDof[d] = fem->numComponents*numDofDual[d];
2403:     }
2404:   }
2405:   *numDof = fem->numDof;
2406:   return(0);
2407: }

2411: PetscErrorCode PetscFEGetDefaultTabulation(PetscFE fem, PetscReal **B, PetscReal **D, PetscReal **H)
2412: {
2413:   PetscInt         npoints = fem->quadrature->numPoints;
2414:   const PetscReal *points  = fem->quadrature->points;
2415:   PetscErrorCode   ierr;

2422:   if (!fem->B) {PetscFEGetTabulation(fem, npoints, points, &fem->B, &fem->D, NULL/*&fem->H*/);}
2423:   if (B) *B = fem->B;
2424:   if (D) *D = fem->D;
2425:   if (H) *H = fem->H;
2426:   return(0);
2427: }

2431: PetscErrorCode PetscFEGetTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal **B, PetscReal **D, PetscReal **H)
2432: {
2433:   DM               dm;
2434:   PetscInt         pdim; /* Dimension of FE space P */
2435:   PetscInt         dim;  /* Spatial dimension */
2436:   PetscInt         comp; /* Field components */
2437:   PetscErrorCode   ierr;

2445:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
2446:   DMPlexGetDimension(dm, &dim);
2447:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
2448:   PetscFEGetNumComponents(fem, &comp);
2449:   if (B) {DMGetWorkArray(dm, npoints*pdim*comp, PETSC_REAL, B);}
2450:   if (D) {DMGetWorkArray(dm, npoints*pdim*comp*dim, PETSC_REAL, D);}
2451:   if (H) {DMGetWorkArray(dm, npoints*pdim*comp*dim*dim, PETSC_REAL, H);}
2452:   (*fem->ops->gettabulation)(fem, npoints, points, B ? *B : NULL, D ? *D : NULL, H ? *H : NULL);
2453:   return(0);
2454: }

2458: PetscErrorCode PetscFERestoreTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal **B, PetscReal **D, PetscReal **H)
2459: {
2460:   DM             dm;

2465:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
2466:   if (B && *B) {DMRestoreWorkArray(dm, 0, PETSC_REAL, B);}
2467:   if (D && *D) {DMRestoreWorkArray(dm, 0, PETSC_REAL, D);}
2468:   if (H && *H) {DMRestoreWorkArray(dm, 0, PETSC_REAL, H);}
2469:   return(0);
2470: }

2474: PetscErrorCode PetscFEDestroy_Basic(PetscFE fem)
2475: {
2476:   PetscFE_Basic *b = (PetscFE_Basic *) fem->data;

2480:   PetscFree(b);
2481:   return(0);
2482: }

2486: PetscErrorCode PetscFEView_Basic_Ascii(PetscFE fe, PetscViewer viewer)
2487: {
2488:   PetscSpace        basis;
2489:   PetscDualSpace    dual;
2490:   PetscQuadrature   q;
2491:   PetscInt          dim, Nq;
2492:   PetscViewerFormat format;
2493:   PetscErrorCode    ierr;

2496:   PetscFEGetBasisSpace(fe, &basis);
2497:   PetscFEGetDualSpace(fe, &dual);
2498:   PetscFEGetQuadrature(fe, &q);
2499:   PetscQuadratureGetData(q, &dim, &Nq, NULL, NULL);
2500:   PetscViewerGetFormat(viewer, &format);
2501:   PetscViewerASCIIPrintf(viewer, "Basic Finite Element:\n");
2502:   if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
2503:     PetscViewerASCIIPrintf(viewer, "  dimension:       %d\n", dim);
2504:     PetscViewerASCIIPrintf(viewer, "  num quad points: %d\n", Nq);
2505:     PetscViewerASCIIPushTab(viewer);
2506:     PetscQuadratureView(q, viewer);
2507:     PetscViewerASCIIPopTab(viewer);
2508:   } else {
2509:     PetscViewerASCIIPrintf(viewer, "  dimension:       %d\n", dim);
2510:     PetscViewerASCIIPrintf(viewer, "  num quad points: %d\n", Nq);
2511:   }
2512:   PetscViewerASCIIPushTab(viewer);
2513:   PetscSpaceView(basis, viewer);
2514:   PetscDualSpaceView(dual, viewer);
2515:   PetscViewerASCIIPopTab(viewer);
2516:   return(0);
2517: }

2521: PetscErrorCode PetscFEView_Basic(PetscFE fe, PetscViewer viewer)
2522: {
2523:   PetscBool      iascii;

2529:   PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
2530:   if (iascii) {PetscFEView_Basic_Ascii(fe, viewer);}
2531:   return(0);
2532: }

2536: /* Construct the change of basis from prime basis to nodal basis */
2537: PetscErrorCode PetscFESetUp_Basic(PetscFE fem)
2538: {
2539:   PetscReal     *work;
2540:   PetscBLASInt  *pivots;
2541: #ifndef PETSC_USE_COMPLEX
2542:   PetscBLASInt   n, info;
2543: #endif
2544:   PetscInt       pdim, j;

2548:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
2549:   PetscMalloc1(pdim*pdim,&fem->invV);
2550:   for (j = 0; j < pdim; ++j) {
2551:     PetscReal      *Bf;
2552:     PetscQuadrature f;
2553:     PetscInt        q, k;

2555:     PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);
2556:     PetscMalloc1(f->numPoints*pdim,&Bf);
2557:     PetscSpaceEvaluate(fem->basisSpace, f->numPoints, f->points, Bf, NULL, NULL);
2558:     for (k = 0; k < pdim; ++k) {
2559:       /* n_j \cdot \phi_k */
2560:       fem->invV[j*pdim+k] = 0.0;
2561:       for (q = 0; q < f->numPoints; ++q) {
2562:         fem->invV[j*pdim+k] += Bf[q*pdim+k]*f->weights[q];
2563:       }
2564:     }
2565:     PetscFree(Bf);
2566:   }
2567:   PetscMalloc2(pdim,&pivots,pdim,&work);
2568: #ifndef PETSC_USE_COMPLEX
2569:   n = pdim;
2570:   PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, fem->invV, &n, pivots, &info));
2571:   PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, fem->invV, &n, pivots, work, &n, &info));
2572: #endif
2573:   PetscFree2(pivots,work);
2574:   return(0);
2575: }

2579: PetscErrorCode PetscFEGetDimension_Basic(PetscFE fem, PetscInt *dim)
2580: {

2584:   PetscDualSpaceGetDimension(fem->dualSpace, dim);
2585:   return(0);
2586: }

2590: PetscErrorCode PetscFEGetTabulation_Basic(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H)
2591: {
2592:   DM               dm;
2593:   PetscInt         pdim; /* Dimension of FE space P */
2594:   PetscInt         dim;  /* Spatial dimension */
2595:   PetscInt         comp; /* Field components */
2596:   PetscReal       *tmpB, *tmpD, *tmpH;
2597:   PetscInt         p, d, j, k;
2598:   PetscErrorCode   ierr;

2601:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
2602:   DMPlexGetDimension(dm, &dim);
2603:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
2604:   PetscFEGetNumComponents(fem, &comp);
2605:   /* Evaluate the prime basis functions at all points */
2606:   if (B) {DMGetWorkArray(dm, npoints*pdim, PETSC_REAL, &tmpB);}
2607:   if (D) {DMGetWorkArray(dm, npoints*pdim*dim, PETSC_REAL, &tmpD);}
2608:   if (H) {DMGetWorkArray(dm, npoints*pdim*dim*dim, PETSC_REAL, &tmpH);}
2609:   PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);
2610:   /* Translate to the nodal basis */
2611:   for (p = 0; p < npoints; ++p) {
2612:     if (B) {
2613:       /* Multiply by V^{-1} (pdim x pdim) */
2614:       for (j = 0; j < pdim; ++j) {
2615:         const PetscInt i = (p*pdim + j)*comp;
2616:         PetscInt       c;

2618:         B[i] = 0.0;
2619:         for (k = 0; k < pdim; ++k) {
2620:           B[i] += fem->invV[k*pdim+j] * tmpB[p*pdim + k];
2621:         }
2622:         for (c = 1; c < comp; ++c) {
2623:           B[i+c] = B[i];
2624:         }
2625:       }
2626:     }
2627:     if (D) {
2628:       /* Multiply by V^{-1} (pdim x pdim) */
2629:       for (j = 0; j < pdim; ++j) {
2630:         for (d = 0; d < dim; ++d) {
2631:           const PetscInt i = ((p*pdim + j)*comp + 0)*dim + d;
2632:           PetscInt       c;

2634:           D[i] = 0.0;
2635:           for (k = 0; k < pdim; ++k) {
2636:             D[i] += fem->invV[k*pdim+j] * tmpD[(p*pdim + k)*dim + d];
2637:           }
2638:           for (c = 1; c < comp; ++c) {
2639:             D[((p*pdim + j)*comp + c)*dim + d] = D[i];
2640:           }
2641:         }
2642:       }
2643:     }
2644:     if (H) {
2645:       /* Multiply by V^{-1} (pdim x pdim) */
2646:       for (j = 0; j < pdim; ++j) {
2647:         for (d = 0; d < dim*dim; ++d) {
2648:           const PetscInt i = ((p*pdim + j)*comp + 0)*dim*dim + d;
2649:           PetscInt       c;

2651:           H[i] = 0.0;
2652:           for (k = 0; k < pdim; ++k) {
2653:             H[i] += fem->invV[k*pdim+j] * tmpH[(p*pdim + k)*dim*dim + d];
2654:           }
2655:           for (c = 1; c < comp; ++c) {
2656:             H[((p*pdim + j)*comp + c)*dim*dim + d] = H[i];
2657:           }
2658:         }
2659:       }
2660:     }
2661:   }
2662:   if (B) {DMRestoreWorkArray(dm, npoints*pdim, PETSC_REAL, &tmpB);}
2663:   if (D) {DMRestoreWorkArray(dm, npoints*pdim*dim, PETSC_REAL, &tmpD);}
2664:   if (H) {DMRestoreWorkArray(dm, npoints*pdim*dim*dim, PETSC_REAL, &tmpH);}
2665:   return(0);
2666: }

2670: PetscErrorCode PetscFEIntegrateResidual_Basic(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt field, PetscCellGeometry geom, const PetscScalar coefficients[],
2671:                                               PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
2672:                                               void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f0[]),
2673:                                               void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f1[]),
2674:                                               PetscScalar elemVec[])
2675: {
2676:   const PetscInt  debug = 0;
2677:   PetscQuadrature quad;
2678:   PetscScalar    *f0, *f1, *u, *gradU, *a, *gradA = NULL, *refSpaceDer;
2679:   PetscReal      *x;
2680:   PetscInt        dim, Ncomp, numComponents = 0, numComponentsAux = 0, cOffset = 0, cOffsetAux = 0, eOffset = 0, e, f;
2681:   PetscErrorCode  ierr;

2684:   PetscFEGetSpatialDimension(fe[field], &dim);
2685:   PetscFEGetNumComponents(fe[field], &Ncomp);
2686:   for (f = 0; f < Nf; ++f) {
2687:     PetscInt Nc;
2688:     PetscFEGetNumComponents(fe[f], &Nc);
2689:     numComponents += Nc;
2690:   }
2691:   PetscFEGetQuadrature(fe[field], &quad);
2692:   PetscMalloc6(quad->numPoints*Ncomp,&f0,quad->numPoints*dim*Ncomp,&f1,numComponents,&u,numComponents*dim,&gradU,dim,&x,numComponents*dim,&refSpaceDer);
2693:   for (f = 0; f < NfAux; ++f) {
2694:     PetscInt Nc;
2695:     PetscFEGetNumComponents(feAux[f], &Nc);
2696:     numComponentsAux += Nc;
2697:   }
2698:   if (NfAux) {PetscMalloc2(numComponentsAux,&a,numComponentsAux*dim,&gradA);}
2699:   for (e = 0; e < Ne; ++e) {
2700:     const PetscReal  detJ        = geom.detJ[e];
2701:     const PetscReal *v0          = &geom.v0[e*dim];
2702:     const PetscReal *J           = &geom.J[e*dim*dim];
2703:     const PetscReal *invJ        = &geom.invJ[e*dim*dim];
2704:     const PetscInt   Nq          = quad->numPoints;
2705:     const PetscReal *quadPoints  = quad->points;
2706:     const PetscReal *quadWeights = quad->weights;
2707:     PetscInt         q, f;

2709:     if (debug > 1) {
2710:       PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
2711: #ifndef PETSC_USE_COMPLEX
2712:       DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
2713: #endif
2714:     }
2715:     for (q = 0; q < Nq; ++q) {
2716:       PetscInt         fOffset = 0,       fOffsetAux = 0;
2717:       PetscInt         dOffset = cOffset, dOffsetAux = cOffsetAux;
2718:       PetscInt         d, d2, f, i;

2720:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
2721:       for (d = 0; d < numComponents; ++d)       {u[d]     = 0.0;}
2722:       for (d = 0; d < dim*(numComponents); ++d) {gradU[d] = 0.0; refSpaceDer[d] = 0.0;}
2723:       for (d = 0; d < dim; ++d) {
2724:         x[d] = v0[d];
2725:         for (d2 = 0; d2 < dim; ++d2) {
2726:           x[d] += J[d*dim+d2]*(quadPoints[q*dim+d2] + 1.0);
2727:         }
2728:       }
2729:       for (f = 0; f < Nf; ++f) {
2730:         PetscReal *basis, *basisDer;
2731:         PetscInt   Nb, Ncomp, b, comp, d, g;

2733:         PetscFEGetDimension(fe[f], &Nb);
2734:         PetscFEGetNumComponents(fe[f], &Ncomp);
2735:         PetscFEGetDefaultTabulation(fe[f], &basis, &basisDer, NULL);
2736:         for (b = 0; b < Nb; ++b) {
2737:           for (comp = 0; comp < Ncomp; ++comp) {
2738:             const PetscInt cidx = b*Ncomp+comp;

2740:             u[fOffset+comp] += coefficients[dOffset+cidx]*basis[q*Nb*Ncomp+cidx];
2741:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficients[dOffset+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
2742:           }
2743:         }
2744:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (g = 0; g < dim; ++g) gradU[(fOffset+comp)*dim+d] += invJ[g*dim+d]*refSpaceDer[comp*dim+g];
2745:         if (debug > 1) {
2746:           PetscInt d;
2747:           for (comp = 0; comp < Ncomp; ++comp) {
2748:             PetscPrintf(PETSC_COMM_SELF, "    u[%d,%d]: %g\n", f, comp, PetscRealPart(u[fOffset+comp]));
2749:             for (d = 0; d < dim; ++d) {
2750:               PetscPrintf(PETSC_COMM_SELF, "    gradU[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradU[(fOffset+comp)*dim+d]));
2751:             }
2752:           }
2753:         }
2754:         fOffset += Ncomp;
2755:         dOffset += Nb*Ncomp;
2756:       }
2757:       for (d = 0; d < numComponentsAux; ++d)       {a[d]     = 0.0;}
2758:       for (d = 0; d < dim*(numComponentsAux); ++d) {gradA[d] = 0.0; refSpaceDer[d] = 0.0;}
2759:       for (f = 0; f < NfAux; ++f) {
2760:         PetscReal *basis, *basisDer;
2761:         PetscInt   Nb, Ncomp, b, comp, d, g;

2763:         PetscFEGetDimension(feAux[f], &Nb);
2764:         PetscFEGetNumComponents(feAux[f], &Ncomp);
2765:         PetscFEGetDefaultTabulation(feAux[f], &basis, &basisDer, NULL);
2766:         for (b = 0; b < Nb; ++b) {
2767:           for (comp = 0; comp < Ncomp; ++comp) {
2768:             const PetscInt cidx = b*Ncomp+comp;

2770:             a[fOffsetAux+comp] += coefficientsAux[dOffsetAux+cidx]*basis[q*Nb*Ncomp+cidx];
2771:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficientsAux[dOffsetAux+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
2772:           }
2773:         }
2774:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (g = 0; g < dim; ++g) gradA[(fOffsetAux+comp)*dim+d] += invJ[g*dim+d]*refSpaceDer[comp*dim+g];
2775:         if (debug > 1) {
2776:           PetscInt d;
2777:           for (comp = 0; comp < Ncomp; ++comp) {
2778:             PetscPrintf(PETSC_COMM_SELF, "    a[%d,%d]: %g\n", f, comp, PetscRealPart(a[fOffsetAux+comp]));
2779:             for (d = 0; d < dim; ++d) {
2780:               PetscPrintf(PETSC_COMM_SELF, "    gradA[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradA[(fOffsetAux+comp)*dim+d]));
2781:             }
2782:           }
2783:         }
2784:         fOffsetAux += Ncomp;
2785:         dOffsetAux += Nb*Ncomp;
2786:       }

2788:       f0_func(u, gradU, a, gradA, x, &f0[q*Ncomp]);
2789:       for (i = 0; i < Ncomp; ++i) f0[q*Ncomp+i] *= detJ*quadWeights[q];
2790:       f1_func(u, gradU, a, gradA, x, refSpaceDer);
2791:       for (i = 0; i < Ncomp; ++i) {
2792:         for (d = 0; d < dim; ++d) {
2793:           PetscInt g;
2794:           f1[(q*Ncomp + i)*dim+d] = 0.0;
2795:           for (g = 0; g < dim; ++g) f1[(q*Ncomp + i)*dim+d] += invJ[d*dim+g]*refSpaceDer[i*dim+g];
2796:           f1[(q*Ncomp + i)*dim+d] *= detJ*quadWeights[q];
2797:         }
2798:       }
2799:       if (debug > 1) {
2800:         PetscInt c,d;
2801:         for (c = 0; c < Ncomp; ++c) {
2802:           PetscPrintf(PETSC_COMM_SELF, "    f0[%d]: %g\n", c, PetscRealPart(f0[q*Ncomp+c]));
2803:           for (d = 0; d < dim; ++d) {
2804:             PetscPrintf(PETSC_COMM_SELF, "    f1[%d]_%c: %g\n", c, 'x'+d, PetscRealPart(f1[(q*Ncomp + c)*dim+d]));
2805:           }
2806:         }
2807:       }
2808:       if (q == Nq-1) {cOffset = dOffset; cOffsetAux = dOffsetAux;}
2809:     }
2810:     for (f = 0; f < Nf; ++f) {
2811:       PetscInt   Nb, Ncomp, b, comp;

2813:       PetscFEGetDimension(fe[f], &Nb);
2814:       PetscFEGetNumComponents(fe[f], &Ncomp);
2815:       if (f == field) {
2816:         PetscReal *basis;
2817:         PetscReal *basisDer;

2819:         PetscFEGetDefaultTabulation(fe[f], &basis, &basisDer, NULL);
2820:         for (b = 0; b < Nb; ++b) {
2821:           for (comp = 0; comp < Ncomp; ++comp) {
2822:             const PetscInt cidx = b*Ncomp+comp;
2823:             PetscInt       q;

2825:             elemVec[eOffset+cidx] = 0.0;
2826:             for (q = 0; q < Nq; ++q) {
2827:               PetscInt d;

2829:               elemVec[eOffset+cidx] += basis[q*Nb*Ncomp+cidx]*f0[q*Ncomp+comp];
2830:               for (d = 0; d < dim; ++d) elemVec[eOffset+cidx] += basisDer[(q*Nb*Ncomp+cidx)*dim+d]*f1[(q*Ncomp+comp)*dim+d];
2831:             }
2832:           }
2833:         }
2834:         if (debug > 1) {
2835:           PetscInt b, comp;

2837:           for (b = 0; b < Nb; ++b) {
2838:             for (comp = 0; comp < Ncomp; ++comp) {
2839:               PetscPrintf(PETSC_COMM_SELF, "    elemVec[%d,%d]: %g\n", b, comp, PetscRealPart(elemVec[eOffset+b*Ncomp+comp]));
2840:             }
2841:           }
2842:         }
2843:       }
2844:       eOffset += Nb*Ncomp;
2845:     }
2846:   }
2847:   PetscFree6(f0,f1,u,gradU,x,refSpaceDer);
2848:   if (NfAux) {PetscFree2(a,gradA);}
2849:   return(0);
2850: }

2854: PetscErrorCode PetscFEIntegrateIFunction_Basic(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt field, PetscCellGeometry geom, const PetscScalar coefficients[], const PetscScalar coefficients_t[],
2855:                                                PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
2856:                                                void (*f0_func)(const PetscScalar u[], const PetscScalar u_t[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f0[]),
2857:                                                void (*f1_func)(const PetscScalar u[], const PetscScalar u_t[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f1[]),
2858:                                                PetscScalar elemVec[])
2859: {
2860:   const PetscInt  debug = 0;
2861:   PetscQuadrature quad;
2862:   PetscScalar    *f0, *f1, *u, *u_t, *gradU, *a, *gradA = NULL, *refSpaceDer;
2863:   PetscReal      *x;
2864:   PetscInt        dim, Ncomp, numComponents = 0, numComponentsAux = 0, cOffset = 0, cOffsetAux = 0, eOffset = 0, e, f;
2865:   PetscErrorCode  ierr;

2868:   PetscFEGetSpatialDimension(fe[field], &dim);
2869:   PetscFEGetNumComponents(fe[field], &Ncomp);
2870:   for (f = 0; f < Nf; ++f) {
2871:     PetscInt Nc;
2872:     PetscFEGetNumComponents(fe[f], &Nc);
2873:     numComponents += Nc;
2874:   }
2875:   PetscFEGetQuadrature(fe[field], &quad);
2876:   PetscMalloc7(quad->numPoints*Ncomp,&f0,quad->numPoints*dim*Ncomp,&f1,numComponents,&u,numComponents,&u_t,numComponents*dim,&gradU,dim,&x,numComponents*dim,&refSpaceDer);
2877:   for (f = 0; f < NfAux; ++f) {
2878:     PetscInt Nc;
2879:     PetscFEGetNumComponents(feAux[f], &Nc);
2880:     numComponentsAux += Nc;
2881:   }
2882:   if (NfAux) {PetscMalloc2(numComponentsAux,&a,numComponentsAux*dim,&gradA);}
2883:   for (e = 0; e < Ne; ++e) {
2884:     const PetscReal  detJ        = geom.detJ[e];
2885:     const PetscReal *v0          = &geom.v0[e*dim];
2886:     const PetscReal *J           = &geom.J[e*dim*dim];
2887:     const PetscReal *invJ        = &geom.invJ[e*dim*dim];
2888:     const PetscInt   Nq          = quad->numPoints;
2889:     const PetscReal *quadPoints  = quad->points;
2890:     const PetscReal *quadWeights = quad->weights;
2891:     PetscInt         q, f;

2893:     if (debug > 1) {
2894:       PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
2895: #ifndef PETSC_USE_COMPLEX
2896:       DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
2897: #endif
2898:     }
2899:     for (q = 0; q < Nq; ++q) {
2900:       PetscInt         fOffset = 0,       fOffsetAux = 0;
2901:       PetscInt         dOffset = cOffset, dOffsetAux = cOffsetAux;
2902:       PetscInt         d, d2, f, i;

2904:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
2905:       for (d = 0; d < numComponents; ++d)       {u[d]     = 0.0;}
2906:       for (d = 0; d < numComponents; ++d)       {u_t[d]   = 0.0;}
2907:       for (d = 0; d < dim*(numComponents); ++d) {gradU[d] = 0.0; refSpaceDer[d] = 0.0;}
2908:       for (d = 0; d < dim; ++d) {
2909:         x[d] = v0[d];
2910:         for (d2 = 0; d2 < dim; ++d2) {
2911:           x[d] += J[d*dim+d2]*(quadPoints[q*dim+d2] + 1.0);
2912:         }
2913:       }
2914:       for (f = 0; f < Nf; ++f) {
2915:         PetscReal *basis, *basisDer;
2916:         PetscInt   Nb, Ncomp, b, comp, d, g;

2918:         PetscFEGetDimension(fe[f], &Nb);
2919:         PetscFEGetNumComponents(fe[f], &Ncomp);
2920:         PetscFEGetDefaultTabulation(fe[f], &basis, &basisDer, NULL);
2921:         for (b = 0; b < Nb; ++b) {
2922:           for (comp = 0; comp < Ncomp; ++comp) {
2923:             const PetscInt cidx = b*Ncomp+comp;

2925:             u[fOffset+comp] += coefficients[dOffset+cidx]*basis[q*Nb*Ncomp+cidx];
2926:             u_t[fOffset+comp] += coefficients_t[dOffset+cidx]*basis[q*Nb*Ncomp+cidx];
2927:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficients[dOffset+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
2928:           }
2929:         }
2930:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (g = 0; g < dim; ++g) gradU[(fOffset+comp)*dim+d] += invJ[g*dim+d]*refSpaceDer[comp*dim+g];
2931:         if (debug > 1) {
2932:           for (comp = 0; comp < Ncomp; ++comp) {
2933:             PetscPrintf(PETSC_COMM_SELF, "    u[%d,%d]: %g\n", f, comp, PetscRealPart(u[fOffset+comp]));
2934:             PetscPrintf(PETSC_COMM_SELF, "    u_t[%d,%d]: %g\n", f, comp, PetscRealPart(u_t[fOffset+comp]));
2935:             for (d = 0; d < dim; ++d) {
2936:               PetscPrintf(PETSC_COMM_SELF, "    gradU[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradU[(fOffset+comp)*dim+d]));
2937:             }
2938:           }
2939:         }
2940:         fOffset += Ncomp;
2941:         dOffset += Nb*Ncomp;
2942:       }
2943:       for (d = 0; d < numComponentsAux; ++d)       {a[d]     = 0.0;}
2944:       for (d = 0; d < dim*(numComponentsAux); ++d) {gradA[d] = 0.0; refSpaceDer[d] = 0.0;}
2945:       for (f = 0; f < NfAux; ++f) {
2946:         PetscReal *basis, *basisDer;
2947:         PetscInt   Nb, Ncomp, b, comp, d, g;

2949:         PetscFEGetDimension(feAux[f], &Nb);
2950:         PetscFEGetNumComponents(feAux[f], &Ncomp);
2951:         PetscFEGetDefaultTabulation(feAux[f], &basis, &basisDer, NULL);
2952:         for (b = 0; b < Nb; ++b) {
2953:           for (comp = 0; comp < Ncomp; ++comp) {
2954:             const PetscInt cidx = b*Ncomp+comp;

2956:             a[fOffsetAux+comp] += coefficientsAux[dOffsetAux+cidx]*basis[q*Nb*Ncomp+cidx];
2957:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficientsAux[dOffsetAux+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
2958:           }
2959:         }
2960:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (g = 0; g < dim; ++g) gradA[(fOffsetAux+comp)*dim+d] += invJ[g*dim+d]*refSpaceDer[comp*dim+g];
2961:         if (debug > 1) {
2962:           for (comp = 0; comp < Ncomp; ++comp) {
2963:             PetscPrintf(PETSC_COMM_SELF, "    a[%d,%d]: %g\n", f, comp, PetscRealPart(a[fOffsetAux+comp]));
2964:             for (d = 0; d < dim; ++d) {
2965:               PetscPrintf(PETSC_COMM_SELF, "    gradA[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradA[(fOffsetAux+comp)*dim+d]));
2966:             }
2967:           }
2968:         }
2969:         fOffsetAux += Ncomp;
2970:         dOffsetAux += Nb*Ncomp;
2971:       }

2973:       f0_func(u, u_t, gradU, a, gradA, x, &f0[q*Ncomp]);
2974:       for (i = 0; i < Ncomp; ++i) {
2975:         f0[q*Ncomp+i] *= detJ*quadWeights[q];
2976:       }
2977:       f1_func(u, u_t, gradU, a, gradA, x, refSpaceDer);
2978:       for (i = 0; i < Ncomp; ++i) {
2979:         for (d = 0; d < dim; ++d) {
2980:           PetscInt g;
2981:           f1[(q*Ncomp + i)*dim+d] = 0.0;
2982:           for (g = 0; g < dim; ++g) f1[(q*Ncomp + i)*dim+d] += invJ[d*dim+g]*refSpaceDer[i*dim+g];
2983:           f1[(q*Ncomp + i)*dim+d] *= detJ*quadWeights[q];
2984:         }
2985:       }
2986:       if (debug > 1) {
2987:         PetscInt c,d;
2988:         for (c = 0; c < Ncomp; ++c) {
2989:           PetscPrintf(PETSC_COMM_SELF, "    f0[%d]: %g\n", c, PetscRealPart(f0[q*Ncomp+c]));
2990:           for (d = 0; d < dim; ++d) {
2991:             PetscPrintf(PETSC_COMM_SELF, "    f1[%d]_%c: %g\n", c, 'x'+d, PetscRealPart(f1[(q*Ncomp + c)*dim+d]));
2992:           }
2993:         }
2994:       }
2995:       if (q == Nq-1) {cOffset = dOffset; cOffsetAux = dOffsetAux;}
2996:     }
2997:     for (f = 0; f < Nf; ++f) {
2998:       PetscInt   Nb, Ncomp, b, comp;

3000:       PetscFEGetDimension(fe[f], &Nb);
3001:       PetscFEGetNumComponents(fe[f], &Ncomp);
3002:       if (f == field) {
3003:         PetscReal *basis;
3004:         PetscReal *basisDer;

3006:         PetscFEGetDefaultTabulation(fe[f], &basis, &basisDer, NULL);
3007:         for (b = 0; b < Nb; ++b) {
3008:           for (comp = 0; comp < Ncomp; ++comp) {
3009:             const PetscInt cidx = b*Ncomp+comp;
3010:             PetscInt       q, d;

3012:             elemVec[eOffset+cidx] = 0.0;
3013:             for (q = 0; q < Nq; ++q) {
3014:               elemVec[eOffset+cidx] += basis[q*Nb*Ncomp+cidx]*f0[q*Ncomp+comp];
3015:               for (d = 0; d < dim; ++d) elemVec[eOffset+cidx] += basisDer[(q*Nb*Ncomp+cidx)*dim+d]*f1[(q*Ncomp+comp)*dim+d];
3016:             }
3017:           }
3018:         }
3019:         if (debug > 1) {
3020:           PetscInt b, comp;

3022:           for (b = 0; b < Nb; ++b) {
3023:             for (comp = 0; comp < Ncomp; ++comp) {
3024:               PetscPrintf(PETSC_COMM_SELF, "    elemVec[%d,%d]: %g\n", b, comp, PetscRealPart(elemVec[eOffset+b*Ncomp+comp]));
3025:             }
3026:           }
3027:         }
3028:       }
3029:       eOffset += Nb*Ncomp;
3030:     }
3031:   }
3032:   PetscFree7(f0,f1,u,u_t,gradU,x,refSpaceDer);
3033:   if (NfAux) {PetscFree2(a,gradA);}
3034:   return(0);
3035: }

3039: PetscErrorCode PetscFEIntegrateBdResidual_Basic(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt field, PetscCellGeometry geom, const PetscScalar coefficients[],
3040:                                                  PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
3041:                                                  void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar f0[]),
3042:                                                  void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar f1[]),
3043:                                                  PetscScalar elemVec[])
3044: {
3045:   const PetscInt  debug = 0;
3046:   PetscQuadrature quad;
3047:   PetscScalar    *f0, *f1, *u, *gradU, *a, *gradA = NULL, *refSpaceDer;
3048:   PetscReal      *x;
3049:   PetscInt        dim, numComponents = 0, numComponentsAux = 0, cOffset = 0, cOffsetAux = 0, eOffset = 0, e, f;
3050:   PetscErrorCode  ierr;

3053:   PetscFEGetSpatialDimension(fe[0], &dim);
3054:   dim += 1; /* Spatial dimension is one higher than topological dimension */
3055:   for (f = 0; f < Nf; ++f) {
3056:     PetscInt Nc;
3057:     PetscFEGetNumComponents(fe[f], &Nc);
3058:     numComponents += Nc;
3059:   }
3060:   PetscFEGetQuadrature(fe[field], &quad);
3061:   PetscMalloc6(quad->numPoints*dim,&f0,quad->numPoints*dim*dim,&f1,numComponents,&u,numComponents*dim,&gradU,dim,&x,numComponents*dim,&refSpaceDer);
3062:   for (f = 0; f < NfAux; ++f) {
3063:     PetscInt Nc;
3064:     PetscFEGetNumComponents(feAux[f], &Nc);
3065:     numComponentsAux += Nc;
3066:   }
3067:   if (NfAux) {PetscMalloc2(numComponentsAux,&a,numComponentsAux*dim,&gradA);}
3068:   for (e = 0; e < Ne; ++e) {
3069:     const PetscReal  detJ        = geom.detJ[e];
3070:     const PetscReal *v0          = &geom.v0[e*dim];
3071:     const PetscReal *n           = &geom.n[e*dim];
3072:     const PetscReal *J           = &geom.J[e*dim*dim];
3073:     const PetscReal *invJ        = &geom.invJ[e*dim*dim];
3074:     const PetscInt   Nq          = quad->numPoints;
3075:     const PetscReal *quadPoints  = quad->points;
3076:     const PetscReal *quadWeights = quad->weights;
3077:     PetscInt         q, f;

3079:     if (debug > 1) {
3080:       PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
3081: #ifndef PETSC_USE_COMPLEX
3082:       DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
3083: #endif
3084:     }
3085:     for (q = 0; q < Nq; ++q) {
3086:       PetscInt         fOffset = 0,       fOffsetAux = 0;
3087:       PetscInt         dOffset = cOffset, dOffsetAux = cOffsetAux;
3088:       PetscInt         Ncomp, d, d2, f, i;
3089:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}

3091:       PetscFEGetNumComponents(fe[field], &Ncomp);
3092:       for (d = 0; d < numComponents; ++d)       {u[d]     = 0.0;}
3093:       for (d = 0; d < dim*(numComponents); ++d) {gradU[d] = 0.0; refSpaceDer[d] = 0.0;}
3094:       for (d = 0; d < dim; ++d) {
3095:         x[d] = v0[d];
3096:         for (d2 = 0; d2 < dim-1; ++d2) {
3097:           x[d] += J[d*dim+d2]*(quadPoints[q*(dim-1)+d2] + 1.0);
3098:         }
3099:       }
3100:       for (f = 0; f < Nf; ++f) {
3101:         PetscReal *basis, *basisDer;
3102:         PetscInt   Nb, Ncomp, b, comp, d, g;

3104:         PetscFEGetDimension(fe[f], &Nb);
3105:         PetscFEGetNumComponents(fe[f], &Ncomp);
3106:         PetscFEGetDefaultTabulation(fe[f], &basis, &basisDer, NULL);
3107:         for (b = 0; b < Nb; ++b) {
3108:           for (comp = 0; comp < Ncomp; ++comp) {
3109:             const PetscInt cidx = b*Ncomp+comp;

3111:             u[fOffset+comp] += coefficients[dOffset+cidx]*basis[q*Nb*Ncomp+cidx];
3112:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficients[dOffset+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
3113:           }
3114:         }
3115:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (g = 0; g < dim; ++g) gradU[(fOffset+comp)*dim+d] += invJ[g*dim+d]*refSpaceDer[comp*dim+g];
3116:         if (debug > 1) {
3117:           for (comp = 0; comp < Ncomp; ++comp) {
3118:             PetscPrintf(PETSC_COMM_SELF, "    u[%d,%d]: %g\n", f, comp, PetscRealPart(u[fOffset+comp]));
3119:             for (d = 0; d < dim; ++d) {
3120:               PetscPrintf(PETSC_COMM_SELF, "    gradU[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradU[(fOffset+comp)*dim+d]));
3121:             }
3122:           }
3123:         }
3124:         fOffset += Ncomp;
3125:         dOffset += Nb*Ncomp;
3126:       }
3127:       for (d = 0; d < numComponentsAux; ++d)       {a[d]     = 0.0;}
3128:       for (d = 0; d < dim*(numComponentsAux); ++d) {gradA[d] = 0.0; refSpaceDer[d] = 0.0;}
3129:       for (f = 0; f < NfAux; ++f) {
3130:         PetscReal *basis, *basisDer;
3131:         PetscInt   Nb, Ncomp, b, comp, d, g;

3133:         PetscFEGetDimension(feAux[f], &Nb);
3134:         PetscFEGetNumComponents(feAux[f], &Ncomp);
3135:         PetscFEGetDefaultTabulation(feAux[f], &basis, &basisDer, NULL);
3136:         for (b = 0; b < Nb; ++b) {
3137:           for (comp = 0; comp < Ncomp; ++comp) {
3138:             const PetscInt cidx = b*Ncomp+comp;

3140:             a[fOffsetAux+comp] += coefficientsAux[dOffsetAux+cidx]*basis[q*Nb*Ncomp+cidx];
3141:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficientsAux[dOffsetAux+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
3142:           }
3143:         }
3144:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (g = 0; g < dim; ++g) gradA[(fOffsetAux+comp)*dim+d] += invJ[g*dim+d]*refSpaceDer[comp*dim+g];
3145:         if (debug > 1) {
3146:           for (comp = 0; comp < Ncomp; ++comp) {
3147:             PetscPrintf(PETSC_COMM_SELF, "    a[%d,%d]: %g\n", f, comp, PetscRealPart(a[fOffsetAux+comp]));
3148:             for (d = 0; d < dim; ++d) {
3149:               PetscPrintf(PETSC_COMM_SELF, "    gradA[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradA[(fOffsetAux+comp)*dim+d]));
3150:             }
3151:           }
3152:         }
3153:         fOffsetAux += Ncomp;
3154:         dOffsetAux += Nb*Ncomp;
3155:       }

3157:       f0_func(u, gradU, a, gradA, x, n, &f0[q*Ncomp]);
3158:       for (i = 0; i < Ncomp; ++i) {
3159:         f0[q*Ncomp+i] *= detJ*quadWeights[q];
3160:       }
3161:       f1_func(u, gradU, a, gradA, x, n, refSpaceDer);
3162:       for (i = 0; i < Ncomp; ++i) {
3163:         for (d = 0; d < dim; ++d) {
3164:           PetscInt g;
3165:           f1[(q*Ncomp + i)*dim+d] = 0.0;
3166:           for (g = 0; g < dim; ++g) f1[(q*Ncomp + i)*dim+d] += invJ[d*dim+g]*refSpaceDer[i*dim+g];
3167:           f1[(q*Ncomp + i)*dim+d] *= detJ*quadWeights[q];
3168:         }
3169:       }
3170:       if (debug > 1) {
3171:         PetscInt c,d;
3172:         for (c = 0; c < Ncomp; ++c) {
3173:           PetscPrintf(PETSC_COMM_SELF, "    f0[%d]: %g\n", c, PetscRealPart(f0[q*Ncomp+c]));
3174:           for (d = 0; d < dim; ++d) {
3175:             PetscPrintf(PETSC_COMM_SELF, "    f1[%d]_%c: %g\n", c, 'x'+d, PetscRealPart(f1[(q*Ncomp + c)*dim+d]));
3176:           }
3177:         }
3178:       }
3179:       if (q == Nq-1) {cOffset = dOffset; cOffsetAux = dOffsetAux;}
3180:     }
3181:     for (f = 0; f < Nf; ++f) {
3182:       PetscInt   Nb, Ncomp, b, comp;

3184:       PetscFEGetDimension(fe[f], &Nb);
3185:       PetscFEGetNumComponents(fe[f], &Ncomp);
3186:       if (f == field) {
3187:         PetscReal *basis;
3188:         PetscReal *basisDer;

3190:         PetscFEGetDefaultTabulation(fe[f], &basis, &basisDer, NULL);
3191:         for (b = 0; b < Nb; ++b) {
3192:           for (comp = 0; comp < Ncomp; ++comp) {
3193:             const PetscInt cidx = b*Ncomp+comp;
3194:             PetscInt       q, d;

3196:             elemVec[eOffset+cidx] = 0.0;
3197:             for (q = 0; q < Nq; ++q) {
3198:               elemVec[eOffset+cidx] += basis[q*Nb*Ncomp+cidx]*f0[q*Ncomp+comp];
3199:               for (d = 0; d < dim; ++d) elemVec[eOffset+cidx] += basisDer[(q*Nb*Ncomp+cidx)*dim+d]*f1[(q*Ncomp+comp)*dim+d];
3200:             }
3201:           }
3202:         }
3203:         if (debug > 1) {
3204:           PetscInt b, comp;

3206:           for (b = 0; b < Nb; ++b) {
3207:             for (comp = 0; comp < Ncomp; ++comp) {
3208:               PetscPrintf(PETSC_COMM_SELF, "    elemVec[%d,%d]: %g\n", b, comp, PetscRealPart(elemVec[eOffset+b*Ncomp+comp]));
3209:             }
3210:           }
3211:         }
3212:       }
3213:       eOffset += Nb*Ncomp;
3214:     }
3215:   }
3216:   PetscFree6(f0,f1,u,gradU,x,refSpaceDer);
3217:   if (NfAux) {PetscFree2(a,gradA);}
3218:   return(0);
3219: }

3223: PetscErrorCode PetscFEIntegrateBdIFunction_Basic(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt field, PetscCellGeometry geom, const PetscScalar coefficients[], const PetscScalar coefficients_t[],
3224:                                                  PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
3225:                                                  void (*f0_func)(const PetscScalar u[], const PetscScalar u_t[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar f0[]),
3226:                                                  void (*f1_func)(const PetscScalar u[], const PetscScalar u_t[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar f1[]),
3227:                                                  PetscScalar elemVec[])
3228: {
3229:   const PetscInt  debug = 0;
3230:   PetscQuadrature quad;
3231:   PetscScalar    *f0, *f1, *u, *u_t, *gradU, *a, *gradA = NULL, *refSpaceDer;
3232:   PetscReal      *x;
3233:   PetscInt        dim, numComponents = 0, numComponentsAux = 0, cOffset = 0, cOffsetAux = 0, eOffset = 0, e, f;
3234:   PetscErrorCode  ierr;

3237:   PetscFEGetSpatialDimension(fe[0], &dim);
3238:   dim += 1; /* Spatial dimension is one higher than topological dimension */
3239:   for (f = 0; f < Nf; ++f) {
3240:     PetscInt Nc;
3241:     PetscFEGetNumComponents(fe[f], &Nc);
3242:     numComponents += Nc;
3243:   }
3244:   PetscFEGetQuadrature(fe[field], &quad);
3245:   PetscMalloc7(quad->numPoints*dim,&f0,quad->numPoints*dim*dim,&f1,numComponents,&u,numComponents,&u_t,numComponents*dim,&gradU,dim,&x,numComponents*dim,&refSpaceDer);
3246:   for (f = 0; f < NfAux; ++f) {
3247:     PetscInt Nc;
3248:     PetscFEGetNumComponents(feAux[f], &Nc);
3249:     numComponentsAux += Nc;
3250:   }
3251:   if (NfAux) {PetscMalloc2(numComponentsAux,&a,numComponentsAux*dim,&gradA);}
3252:   for (e = 0; e < Ne; ++e) {
3253:     const PetscReal  detJ        = geom.detJ[e];
3254:     const PetscReal *v0          = &geom.v0[e*dim];
3255:     const PetscReal *n           = &geom.n[e*dim];
3256:     const PetscReal *J           = &geom.J[e*dim*dim];
3257:     const PetscReal *invJ        = &geom.invJ[e*dim*dim];
3258:     const PetscInt   Nq          = quad->numPoints;
3259:     const PetscReal *quadPoints  = quad->points;
3260:     const PetscReal *quadWeights = quad->weights;
3261:     PetscInt         q, f;

3263:     if (debug > 1) {
3264:       PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
3265: #ifndef PETSC_USE_COMPLEX
3266:       DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
3267: #endif
3268:     }
3269:     for (q = 0; q < Nq; ++q) {
3270:       PetscInt         fOffset = 0,       fOffsetAux = 0;
3271:       PetscInt         dOffset = cOffset, dOffsetAux = cOffsetAux;
3272:       PetscInt         Ncomp, d, d2, f, i;
3273:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}

3275:       PetscFEGetNumComponents(fe[field], &Ncomp);
3276:       for (d = 0; d < numComponents; ++d)       {u[d]     = 0.0;}
3277:       for (d = 0; d < numComponents; ++d)       {u_t[d]   = 0.0;}
3278:       for (d = 0; d < dim*(numComponents); ++d) {gradU[d] = 0.0; refSpaceDer[d] = 0.0;}
3279:       for (d = 0; d < dim; ++d) {
3280:         x[d] = v0[d];
3281:         for (d2 = 0; d2 < dim-1; ++d2) {
3282:           x[d] += J[d*dim+d2]*(quadPoints[q*(dim-1)+d2] + 1.0);
3283:         }
3284:       }
3285:       for (f = 0; f < Nf; ++f) {
3286:         PetscReal *basis, *basisDer;
3287:         PetscInt   Nb, Ncomp, b, comp, d, g;

3289:         PetscFEGetDimension(fe[f], &Nb);
3290:         PetscFEGetNumComponents(fe[f], &Ncomp);
3291:         PetscFEGetDefaultTabulation(fe[f], &basis, &basisDer, NULL);
3292:         for (b = 0; b < Nb; ++b) {
3293:           for (comp = 0; comp < Ncomp; ++comp) {
3294:             const PetscInt cidx = b*Ncomp+comp;

3296:             u[fOffset+comp] += coefficients[dOffset+cidx]*basis[q*Nb*Ncomp+cidx];
3297:             u_t[fOffset+comp] += coefficients_t[dOffset+cidx]*basis[q*Nb*Ncomp+cidx];
3298:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficients[dOffset+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
3299:           }
3300:         }
3301:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (g = 0; g < dim; ++g) gradU[(fOffset+comp)*dim+d] += invJ[g*dim+d]*refSpaceDer[comp*dim+g];
3302:         if (debug > 1) {
3303:           for (comp = 0; comp < Ncomp; ++comp) {
3304:             PetscPrintf(PETSC_COMM_SELF, "    u[%d,%d]: %g\n", f, comp, PetscRealPart(u[fOffset+comp]));
3305:             for (d = 0; d < dim; ++d) {
3306:               PetscPrintf(PETSC_COMM_SELF, "    gradU[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradU[(fOffset+comp)*dim+d]));
3307:             }
3308:           }
3309:         }
3310:         fOffset += Ncomp;
3311:         dOffset += Nb*Ncomp;
3312:       }
3313:       for (d = 0; d < numComponentsAux; ++d)       {a[d]     = 0.0;}
3314:       for (d = 0; d < dim*(numComponentsAux); ++d) {gradA[d] = 0.0; refSpaceDer[d] = 0.0;}
3315:       for (f = 0; f < NfAux; ++f) {
3316:         PetscReal *basis, *basisDer;
3317:         PetscInt   Nb, Ncomp, b, comp, d, g;

3319:         PetscFEGetDimension(feAux[f], &Nb);
3320:         PetscFEGetNumComponents(feAux[f], &Ncomp);
3321:         PetscFEGetDefaultTabulation(feAux[f], &basis, &basisDer, NULL);
3322:         for (b = 0; b < Nb; ++b) {
3323:           for (comp = 0; comp < Ncomp; ++comp) {
3324:             const PetscInt cidx = b*Ncomp+comp;

3326:             a[fOffsetAux+comp] += coefficientsAux[dOffsetAux+cidx]*basis[q*Nb*Ncomp+cidx];
3327:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficientsAux[dOffsetAux+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
3328:           }
3329:         }
3330:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (g = 0; g < dim; ++g) gradA[(fOffsetAux+comp)*dim+d] += invJ[g*dim+d]*refSpaceDer[comp*dim+g];
3331:         if (debug > 1) {
3332:           for (comp = 0; comp < Ncomp; ++comp) {
3333:             PetscPrintf(PETSC_COMM_SELF, "    a[%d,%d]: %g\n", f, comp, PetscRealPart(a[fOffsetAux+comp]));
3334:             for (d = 0; d < dim; ++d) {
3335:               PetscPrintf(PETSC_COMM_SELF, "    gradA[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradA[(fOffsetAux+comp)*dim+d]));
3336:             }
3337:           }
3338:         }
3339:         fOffsetAux += Ncomp;
3340:         dOffsetAux += Nb*Ncomp;
3341:       }

3343:       f0_func(u, u_t, gradU, a, gradA, x, n, &f0[q*Ncomp]);
3344:       for (i = 0; i < Ncomp; ++i) {
3345:         f0[q*Ncomp+i] *= detJ*quadWeights[q];
3346:       }
3347:       f1_func(u, u_t, gradU, a, gradA, x, n, refSpaceDer);
3348:       for (i = 0; i < Ncomp; ++i) {
3349:         for (d = 0; d < dim; ++d) {
3350:           PetscInt g;
3351:           f1[(q*Ncomp + i)*dim+d] = 0.0;
3352:           for (g = 0; g < dim; ++g) f1[(q*Ncomp + i)*dim+d] += invJ[d*dim+g]*refSpaceDer[i*dim+g];
3353:           f1[(q*Ncomp + i)*dim+d] *= detJ*quadWeights[q];
3354:         }
3355:       }
3356:       if (debug > 1) {
3357:         PetscInt c,d;
3358:         for (c = 0; c < Ncomp; ++c) {
3359:           PetscPrintf(PETSC_COMM_SELF, "    f0[%d]: %g\n", c, PetscRealPart(f0[q*Ncomp+c]));
3360:           for (d = 0; d < dim; ++d) {
3361:             PetscPrintf(PETSC_COMM_SELF, "    f1[%d]_%c: %g\n", c, 'x'+d, PetscRealPart(f1[(q*Ncomp + c)*dim+d]));
3362:           }
3363:         }
3364:       }
3365:       if (q == Nq-1) {cOffset = dOffset; cOffsetAux = dOffsetAux;}
3366:     }
3367:     for (f = 0; f < Nf; ++f) {
3368:       PetscInt   Nb, Ncomp, b, comp;

3370:       PetscFEGetDimension(fe[f], &Nb);
3371:       PetscFEGetNumComponents(fe[f], &Ncomp);
3372:       if (f == field) {
3373:         PetscReal *basis;
3374:         PetscReal *basisDer;

3376:         PetscFEGetDefaultTabulation(fe[f], &basis, &basisDer, NULL);
3377:         for (b = 0; b < Nb; ++b) {
3378:           for (comp = 0; comp < Ncomp; ++comp) {
3379:             const PetscInt cidx = b*Ncomp+comp;
3380:             PetscInt       q, d;

3382:             elemVec[eOffset+cidx] = 0.0;
3383:             for (q = 0; q < Nq; ++q) {
3384:               elemVec[eOffset+cidx] += basis[q*Nb*Ncomp+cidx]*f0[q*Ncomp+comp];
3385:               for (d = 0; d < dim; ++d) elemVec[eOffset+cidx] += basisDer[(q*Nb*Ncomp+cidx)*dim+d]*f1[(q*Ncomp+comp)*dim+d];
3386:             }
3387:           }
3388:         }
3389:         if (debug > 1) {
3390:           PetscInt b, comp;

3392:           for (b = 0; b < Nb; ++b) {
3393:             for (comp = 0; comp < Ncomp; ++comp) {
3394:               PetscPrintf(PETSC_COMM_SELF, "    elemVec[%d,%d]: %g\n", b, comp, PetscRealPart(elemVec[eOffset+b*Ncomp+comp]));
3395:             }
3396:           }
3397:         }
3398:       }
3399:       eOffset += Nb*Ncomp;
3400:     }
3401:   }
3402:   PetscFree7(f0,f1,u,u_t,gradU,x,refSpaceDer);
3403:   if (NfAux) {PetscFree2(a,gradA);}
3404:   return(0);
3405: }

3409: PetscErrorCode PetscFEIntegrateJacobian_Basic(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt fieldI, PetscInt fieldJ, PetscCellGeometry geom, const PetscScalar coefficients[],
3410:                                               PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
3411:                                               void (*g0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g0[]),
3412:                                               void (*g1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g1[]),
3413:                                               void (*g2_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g2[]),
3414:                                               void (*g3_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g3[]),
3415:                                               PetscScalar elemMat[])
3416: {
3417:   const PetscInt  debug      = 0;
3418:   PetscInt        cellDof    = 0; /* Total number of dof on a cell */
3419:   PetscInt        cellDofAux = 0; /* Total number of auxiliary dof on a cell */
3420:   PetscInt        cOffset    = 0; /* Offset into coefficients[] for element e */
3421:   PetscInt        cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
3422:   PetscInt        eOffset    = 0; /* Offset into elemMat[] for element e */
3423:   PetscInt        offsetI    = 0; /* Offset into an element vector for fieldI */
3424:   PetscInt        offsetJ    = 0; /* Offset into an element vector for fieldJ */
3425:   PetscQuadrature quad;
3426:   PetscScalar    *g0, *g1, *g2, *g3, *u, *gradU, *a, *gradA = NULL, *refSpaceDer;
3427:   PetscReal      *x;
3428:   PetscReal      *basisI, *basisDerI, *basisJ, *basisDerJ;
3429:   PetscInt        NbI = 0, NcI = 0, NbJ = 0, NcJ = 0, numComponents = 0, numComponentsAux = 0;
3430:   PetscInt        dim, f, e;
3431:   PetscErrorCode  ierr;

3434:   PetscFEGetSpatialDimension(fe[fieldI], &dim);
3435:   PetscFEGetDefaultTabulation(fe[fieldI], &basisI, &basisDerI, NULL);
3436:   PetscFEGetDefaultTabulation(fe[fieldJ], &basisJ, &basisDerJ, NULL);
3437:   for (f = 0; f < Nf; ++f) {
3438:     PetscInt Nb, Nc;

3440:     PetscFEGetDimension(fe[f], &Nb);
3441:     PetscFEGetNumComponents(fe[f], &Nc);
3442:     if (f == fieldI) {offsetI = cellDof; NbI = Nb; NcI = Nc;}
3443:     if (f == fieldJ) {offsetJ = cellDof; NbJ = Nb; NcJ = Nc;}
3444:     numComponents += Nc;
3445:     cellDof += Nb*Nc;
3446:   }
3447:   PetscFEGetQuadrature(fe[fieldI], &quad);
3448:   PetscMalloc4(NcI*NcJ,&g0,NcI*NcJ*dim,&g1,NcI*NcJ*dim,&g2,NcI*NcJ*dim*dim,&g3);
3449:   PetscMemzero(g0, NcI*NcJ         * sizeof(PetscScalar));
3450:   PetscMemzero(g1, NcI*NcJ*dim     * sizeof(PetscScalar));
3451:   PetscMemzero(g2, NcI*NcJ*dim     * sizeof(PetscScalar));
3452:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
3453:   PetscMalloc4(numComponents,&u,numComponents*dim,&gradU,dim,&x,PetscMax(numComponents*dim, NcI*NcJ*dim*dim),&refSpaceDer);
3454:   for (f = 0; f < NfAux; ++f) {
3455:     PetscInt Nb, Nc;
3456:     PetscFEGetDimension(feAux[f], &Nb);
3457:     PetscFEGetNumComponents(feAux[f], &Nc);
3458:     numComponentsAux += Nc;
3459:     cellDofAux       += Nb*Nc;
3460:   }
3461:   if (NfAux) {PetscMalloc2(numComponentsAux,&a,numComponentsAux*dim,&gradA);}
3462:   else a = gradA = NULL;
3463:   for (e = 0; e < Ne; ++e) {
3464:     const PetscReal  detJ        = geom.detJ[e];
3465:     const PetscReal *v0          = &geom.v0[e*dim];
3466:     const PetscReal *J           = &geom.J[e*dim*dim];
3467:     const PetscReal *invJ        = &geom.invJ[e*dim*dim];
3468:     const PetscInt   Nq          = quad->numPoints;
3469:     const PetscReal *quadPoints  = quad->points;
3470:     const PetscReal *quadWeights = quad->weights;
3471:     PetscInt         q;

3473:     for (q = 0; q < Nq; ++q) {
3474:       PetscInt    fOffset    = 0;          /* Offset into u[] for field_q (like offsetI) */
3475:       PetscInt    dOffset    = cOffset;    /* Offset into coefficients[] for field_q */
3476:       PetscInt    fOffsetAux = 0;          /* Offset into a[] for field_q (like offsetI) */
3477:       PetscInt    dOffsetAux = cOffsetAux; /* Offset into coefficientsAux[] for field_q */
3478:       PetscInt    field_q, d, d2;
3479:       PetscInt    f, g, fc, gc, c;

3481:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
3482:       for (d = 0; d < numComponents; ++d)     {u[d]     = 0.0;}
3483:       for (d = 0; d < dim*numComponents; ++d) {gradU[d] = 0.0; refSpaceDer[d] = 0.0;}
3484:       for (d = 0; d < dim; ++d) {
3485:         x[d] = v0[d];
3486:         for (d2 = 0; d2 < dim; ++d2) {
3487:           x[d] += J[d*dim+d2]*(quadPoints[q*dim+d2] + 1.0);
3488:         }
3489:       }
3490:       for (field_q = 0; field_q < Nf; ++field_q) {
3491:         PetscReal *basis, *basisDer;
3492:         PetscInt   Nb, Ncomp, b, comp, d2;

3494:         PetscFEGetDimension(fe[field_q], &Nb);
3495:         PetscFEGetNumComponents(fe[field_q], &Ncomp);
3496:         PetscFEGetDefaultTabulation(fe[field_q], &basis, &basisDer, NULL);
3497:         for (b = 0; b < Nb; ++b) {
3498:           for (comp = 0; comp < Ncomp; ++comp) {
3499:             const PetscInt cidx = b*Ncomp+comp;

3501:             u[fOffset+comp] += coefficients[dOffset+cidx]*basis[q*Nb*Ncomp+cidx];
3502:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficients[dOffset+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
3503:           }
3504:         }
3505:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (d2 = 0; d2 < dim; ++d2) gradU[(fOffset+comp)*dim+d] += invJ[d2*dim+d]*refSpaceDer[comp*dim+d2];
3506:         if (debug > 1) {
3507:           for (comp = 0; comp < Ncomp; ++comp) {
3508:             PetscPrintf(PETSC_COMM_SELF, "    u[%d,%d]: %g\n", f, comp, PetscRealPart(u[fOffset+comp]));
3509:             for (d = 0; d < dim; ++d) {
3510:               PetscPrintf(PETSC_COMM_SELF, "    gradU[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradU[(fOffset+comp)*dim+d]));
3511:             }
3512:           }
3513:         }
3514:         fOffset += Ncomp;
3515:         dOffset += Nb*Ncomp;
3516:       }
3517:       for (d = 0; d < numComponentsAux; ++d)       {a[d]     = 0.0;}
3518:       for (d = 0; d < dim*(numComponentsAux); ++d) {gradA[d] = 0.0; refSpaceDer[d] = 0.0;}
3519:       for (field_q = 0; field_q < NfAux; ++field_q) {
3520:         PetscReal *basis, *basisDer;
3521:         PetscInt   Nb, Ncomp, b, comp, d2;

3523:         PetscFEGetDimension(feAux[field_q], &Nb);
3524:         PetscFEGetNumComponents(feAux[field_q], &Ncomp);
3525:         PetscFEGetDefaultTabulation(feAux[field_q], &basis, &basisDer, NULL);
3526:         for (b = 0; b < Nb; ++b) {
3527:           for (comp = 0; comp < Ncomp; ++comp) {
3528:             const PetscInt cidx = b*Ncomp+comp;

3530:             a[fOffsetAux+comp] += coefficientsAux[dOffsetAux+cidx]*basis[q*Nb*Ncomp+cidx];
3531:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficientsAux[dOffsetAux+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
3532:           }
3533:         }
3534:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (d2 = 0; d2 < dim; ++d2) gradA[(fOffsetAux+comp)*dim+d] += invJ[d2*dim+d]*refSpaceDer[comp*dim+d2];
3535:         if (debug > 1) {
3536:           for (comp = 0; comp < Ncomp; ++comp) {
3537:             PetscPrintf(PETSC_COMM_SELF, "    a[%d,%d]: %g\n", f, comp, PetscRealPart(a[fOffsetAux+comp]));
3538:             for (d = 0; d < dim; ++d) {
3539:               PetscPrintf(PETSC_COMM_SELF, "    gradA[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradA[(fOffsetAux+comp)*dim+d]));
3540:             }
3541:           }
3542:         }
3543:         fOffsetAux += Ncomp;
3544:         dOffsetAux += Nb*Ncomp;
3545:       }

3547:       if (g0_func) {
3548:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
3549:         g0_func(u, gradU, a, gradA, x, g0);
3550:         for (c = 0; c < NcI*NcJ; ++c) {g0[c] *= detJ*quadWeights[q];}
3551:       }
3552:       if (g1_func) {
3553:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
3554:         g1_func(u, gradU, a, gradA, x, refSpaceDer);
3555:         for (fc = 0; fc < NcI; ++fc) {
3556:           for (gc = 0; gc < NcJ; ++gc) {
3557:             for (d = 0; d < dim; ++d) {
3558:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
3559:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
3560:               g1[(fc*NcJ+gc)*dim+d] *= detJ*quadWeights[q];
3561:             }
3562:           }
3563:         }
3564:       }
3565:       if (g2_func) {
3566:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
3567:         g2_func(u, gradU, a, gradA, x, refSpaceDer);
3568:         for (fc = 0; fc < NcI; ++fc) {
3569:           for (gc = 0; gc < NcJ; ++gc) {
3570:             for (d = 0; d < dim; ++d) {
3571:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
3572:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
3573:               g2[(fc*NcJ+gc)*dim+d] *= detJ*quadWeights[q];
3574:             }
3575:           }
3576:         }
3577:       }
3578:       if (g3_func) {
3579:         PetscInt dp, d3;
3580:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
3581:         g3_func(u, gradU, a, gradA, x, refSpaceDer);
3582:         for (fc = 0; fc < NcI; ++fc) {
3583:           for (gc = 0; gc < NcJ; ++gc) {
3584:             for (d = 0; d < dim; ++d) {
3585:               for (dp = 0; dp < dim; ++dp) {
3586:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
3587:                 for (d2 = 0; d2 < dim; ++d2) {
3588:                   for (d3 = 0; d3 < dim; ++d3) {
3589:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
3590:                   }
3591:                 }
3592:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= detJ*quadWeights[q];
3593:               }
3594:             }
3595:           }
3596:         }
3597:       }

3599:       for (f = 0; f < NbI; ++f) {
3600:         for (fc = 0; fc < NcI; ++fc) {
3601:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
3602:           const PetscInt i    = offsetI+fidx; /* Element matrix row */
3603:           for (g = 0; g < NbJ; ++g) {
3604:             for (gc = 0; gc < NcJ; ++gc) {
3605:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
3606:               const PetscInt j    = offsetJ+gidx; /* Element matrix column */
3607:               PetscInt       d, d2;

3609:               elemMat[eOffset+i*cellDof+j] += basisI[q*NbI*NcI+fidx]*g0[fc*NcJ+gc]*basisJ[q*NbJ*NcJ+gidx];
3610:               for (d = 0; d < dim; ++d) {
3611:                 elemMat[eOffset+i*cellDof+j] += basisI[q*NbI*NcI+fidx]*g1[(fc*NcJ+gc)*dim+d]*basisDerJ[(q*NbJ*NcJ+gidx)*dim+d];
3612:                 elemMat[eOffset+i*cellDof+j] += basisDerI[(q*NbI*NcI+fidx)*dim+d]*g2[(fc*NcJ+gc)*dim+d]*basisJ[q*NbJ*NcJ+gidx];
3613:                 for (d2 = 0; d2 < dim; ++d2) {
3614:                   elemMat[eOffset+i*cellDof+j] += basisDerI[(q*NbI*NcI+fidx)*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*basisDerJ[(q*NbJ*NcJ+gidx)*dim+d2];
3615:                 }
3616:               }
3617:             }
3618:           }
3619:         }
3620:       }
3621:     }
3622:     if (debug > 1) {
3623:       PetscInt fc, f, gc, g;

3625:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
3626:       for (fc = 0; fc < NcI; ++fc) {
3627:         for (f = 0; f < NbI; ++f) {
3628:           const PetscInt i = offsetI + f*NcI+fc;
3629:           for (gc = 0; gc < NcJ; ++gc) {
3630:             for (g = 0; g < NbJ; ++g) {
3631:               const PetscInt j = offsetJ + g*NcJ+gc;
3632:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*cellDof+j]));
3633:             }
3634:           }
3635:           PetscPrintf(PETSC_COMM_SELF, "\n");
3636:         }
3637:       }
3638:     }
3639:     cOffset    += cellDof;
3640:     cOffsetAux += cellDofAux;
3641:     eOffset    += cellDof*cellDof;
3642:   }
3643:   PetscFree4(g0,g1,g2,g3);
3644:   PetscFree4(u,gradU,x,refSpaceDer);
3645:   if (NfAux) {PetscFree2(a,gradA);}
3646:   return(0);
3647: }

3651: PetscErrorCode PetscFEIntegrateBdJacobian_Basic(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt fieldI, PetscInt fieldJ, PetscCellGeometry geom, const PetscScalar coefficients[],
3652:                                                 PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
3653:                                                 void (*g0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar g0[]),
3654:                                                 void (*g1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar g1[]),
3655:                                                 void (*g2_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar g2[]),
3656:                                                 void (*g3_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar g3[]),
3657:                                                 PetscScalar elemMat[])
3658: {
3659:   const PetscInt  debug      = 0;
3660:   PetscInt        cellDof    = 0; /* Total number of dof on a cell */
3661:   PetscInt        cellDofAux = 0; /* Total number of auxiliary dof on a cell */
3662:   PetscInt        cOffset    = 0; /* Offset into coefficients[] for element e */
3663:   PetscInt        cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
3664:   PetscInt        eOffset    = 0; /* Offset into elemMat[] for element e */
3665:   PetscInt        offsetI    = 0; /* Offset into an element vector for fieldI */
3666:   PetscInt        offsetJ    = 0; /* Offset into an element vector for fieldJ */
3667:   PetscQuadrature quad;
3668:   PetscScalar    *g0, *g1, *g2, *g3, *u, *gradU, *a, *gradA = NULL;
3669:   PetscReal      *x, *realSpaceDerI, *realSpaceDerJ;
3670:   PetscReal      *basisI, *basisDerI, *basisJ, *basisDerJ;
3671:   PetscInt        NbI = 0, NcI = 0, NbJ = 0, NcJ = 0, numComponents = 0, numComponentsAux = 0;
3672:   PetscInt        dim, f, e;
3673:   PetscErrorCode  ierr;

3676:   PetscFEGetSpatialDimension(fe[fieldI], &dim);
3677:   PetscFEGetDefaultTabulation(fe[fieldI], &basisI, &basisDerI, NULL);
3678:   PetscFEGetDefaultTabulation(fe[fieldJ], &basisJ, &basisDerJ, NULL);
3679:   for (f = 0; f < Nf; ++f) {
3680:     PetscInt Nb, Nc;

3682:     PetscFEGetDimension(fe[f], &Nb);
3683:     PetscFEGetNumComponents(fe[f], &Nc);
3684:     if (f == fieldI) {offsetI = cellDof; NbI = Nb; NcI = Nc;}
3685:     if (f == fieldJ) {offsetJ = cellDof; NbJ = Nb; NcJ = Nc;}
3686:     numComponents += Nc;
3687:     cellDof += Nb*Nc;
3688:   }
3689:   PetscFEGetQuadrature(fe[fieldI], &quad);
3690:   PetscMalloc4(NcI*NcJ,&g0,NcI*NcJ*dim,&g1,NcI*NcJ*dim,&g2,NcI*NcJ*dim*dim,&g3);
3691:   PetscMalloc5(numComponents,&u,numComponents*dim,&gradU,dim,&x,dim,&realSpaceDerI,dim,&realSpaceDerJ);
3692:   for (f = 0; f < NfAux; ++f) {
3693:     PetscInt Nb, Nc;
3694:     PetscFEGetDimension(feAux[f], &Nb);
3695:     PetscFEGetNumComponents(feAux[f], &Nc);
3696:     numComponentsAux += Nc;
3697:     cellDofAux       += Nb*Nc;
3698:   }
3699:   if (NfAux) {PetscMalloc2(numComponentsAux,&a,numComponentsAux*dim,&gradA);}
3700:   for (e = 0; e < Ne; ++e) {
3701:     const PetscReal  detJ        = geom.detJ[e];
3702:     const PetscReal *v0          = &geom.v0[e*dim];
3703:     const PetscReal *n           = &geom.n[e*dim];
3704:     const PetscReal *J           = &geom.J[e*dim*dim];
3705:     const PetscReal *invJ        = &geom.invJ[e*dim*dim];
3706:     const PetscInt   Nq          = quad->numPoints;
3707:     const PetscReal *quadPoints  = quad->points;
3708:     const PetscReal *quadWeights = quad->weights;
3709:     PetscInt         q;

3711:     for (q = 0; q < Nq; ++q) {
3712:       PetscInt    fOffset    = 0;          /* Offset into u[] for field_q (like offsetI) */
3713:       PetscInt    dOffset    = cOffset;    /* Offset into coefficients[] for field_q */
3714:       PetscInt    fOffsetAux = 0;          /* Offset into a[] for field_q (like offsetI) */
3715:       PetscInt    dOffsetAux = cOffsetAux; /* Offset into coefficientsAux[] for field_q */
3716:       PetscInt    field_q, d, d2;
3717:       PetscInt    f, g, fc, gc, c;

3719:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
3720:       for (d = 0; d < numComponents; ++d)     {u[d]     = 0.0;}
3721:       for (d = 0; d < dim*numComponents; ++d) {gradU[d] = 0.0;}
3722:       for (d = 0; d < dim; ++d) {
3723:         x[d] = v0[d];
3724:         for (d2 = 0; d2 < dim; ++d2) {
3725:           x[d] += J[d*dim+d2]*(quadPoints[q*dim+d2] + 1.0);
3726:         }
3727:       }
3728:       for (field_q = 0; field_q < Nf; ++field_q) {
3729:         PetscReal *basis, *basisDer;
3730:         PetscInt   Nb, Ncomp, b, comp;

3732:         PetscFEGetDimension(fe[field_q], &Nb);
3733:         PetscFEGetNumComponents(fe[field_q], &Ncomp);
3734:         PetscFEGetDefaultTabulation(fe[field_q], &basis, &basisDer, NULL);
3735:         for (b = 0; b < Nb; ++b) {
3736:           for (comp = 0; comp < Ncomp; ++comp) {
3737:             const PetscInt cidx = b*Ncomp+comp;
3738:             PetscInt       d1, d2;

3740:             u[fOffset+comp] += coefficients[dOffset+cidx]*basis[q*Nb*Ncomp+cidx];
3741:             for (d1 = 0; d1 < dim; ++d1) {
3742:               realSpaceDerI[d1] = 0.0;
3743:               for (d2 = 0; d2 < dim; ++d2) {
3744:                 realSpaceDerI[d1] += invJ[d2*dim+d1]*basisDer[(q*Nb*Ncomp+cidx)*dim+d2];
3745:               }
3746:               gradU[(fOffset+comp)*dim+d1] += coefficients[dOffset+cidx]*realSpaceDerI[d1];
3747:             }
3748:           }
3749:         }
3750:         if (debug > 1) {
3751:           for (comp = 0; comp < Ncomp; ++comp) {
3752:             PetscPrintf(PETSC_COMM_SELF, "    u[%d,%d]: %g\n", f, comp, PetscRealPart(u[fOffset+comp]));
3753:             for (d = 0; d < dim; ++d) {
3754:               PetscPrintf(PETSC_COMM_SELF, "    gradU[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradU[(fOffset+comp)*dim+d]));
3755:             }
3756:           }
3757:         }
3758:         fOffset += Ncomp;
3759:         dOffset += Nb*Ncomp;
3760:       }
3761:       for (d = 0; d < numComponentsAux; ++d)       {a[d]     = 0.0;}
3762:       for (d = 0; d < dim*(numComponentsAux); ++d) {gradA[d] = 0.0;}
3763:       for (field_q = 0; field_q < NfAux; ++field_q) {
3764:         PetscReal *basis, *basisDer;
3765:         PetscInt   Nb, Ncomp, b, comp;

3767:         PetscFEGetDimension(feAux[field_q], &Nb);
3768:         PetscFEGetNumComponents(feAux[field_q], &Ncomp);
3769:         PetscFEGetDefaultTabulation(feAux[field_q], &basis, &basisDer, NULL);
3770:         for (b = 0; b < Nb; ++b) {
3771:           for (comp = 0; comp < Ncomp; ++comp) {
3772:             const PetscInt cidx = b*Ncomp+comp;
3773:             PetscInt       d1, d2;

3775:             a[fOffsetAux+comp] += coefficientsAux[dOffsetAux+cidx]*basis[q*Nb*Ncomp+cidx];
3776:             for (d1 = 0; d1 < dim; ++d1) {
3777:               realSpaceDerI[d1] = 0.0;
3778:               for (d2 = 0; d2 < dim; ++d2) {
3779:                 realSpaceDerI[d1] += invJ[d2*dim+d1]*basisDer[(q*Nb*Ncomp+cidx)*dim+d2];
3780:               }
3781:               gradA[(fOffsetAux+comp)*dim+d1] += coefficientsAux[dOffsetAux+cidx]*realSpaceDerI[d1];
3782:             }
3783:           }
3784:         }
3785:         if (debug > 1) {
3786:           for (comp = 0; comp < Ncomp; ++comp) {
3787:             PetscPrintf(PETSC_COMM_SELF, "    a[%d,%d]: %g\n", f, comp, PetscRealPart(a[fOffsetAux+comp]));
3788:             for (d = 0; d < dim; ++d) {
3789:               PetscPrintf(PETSC_COMM_SELF, "    gradA[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradA[(fOffsetAux+comp)*dim+d]));
3790:             }
3791:           }
3792:         }
3793:         fOffsetAux += Ncomp;
3794:         dOffsetAux += Nb*Ncomp;
3795:       }

3797:       PetscMemzero(g0, NcI*NcJ         * sizeof(PetscScalar));
3798:       PetscMemzero(g1, NcI*NcJ*dim     * sizeof(PetscScalar));
3799:       PetscMemzero(g2, NcI*NcJ*dim     * sizeof(PetscScalar));
3800:       PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
3801:       if (g0_func) {
3802:         g0_func(u, gradU, a, gradA, x, n, g0);
3803:         for (c = 0; c < NcI*NcJ; ++c) {g0[c] *= detJ*quadWeights[q];}
3804:       }
3805:       if (g1_func) {
3806:         g1_func(u, gradU, a, gradA, x, n, g1);
3807:         for (c = 0; c < NcI*NcJ*dim; ++c) {g1[c] *= detJ*quadWeights[q];}
3808:       }
3809:       if (g2_func) {
3810:         g2_func(u, gradU, a, gradA, x, n, g2);
3811:         for (c = 0; c < NcI*NcJ*dim; ++c) {g2[c] *= detJ*quadWeights[q];}
3812:       }
3813:       if (g3_func) {
3814:         g3_func(u, gradU, a, gradA, x, n, g3);
3815:         for (c = 0; c < NcI*NcJ*dim*dim; ++c) {g3[c] *= detJ*quadWeights[q];}
3816:       }

3818:       for (f = 0; f < NbI; ++f) {
3819:         for (fc = 0; fc < NcI; ++fc) {
3820:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
3821:           const PetscInt i    = offsetI+fidx; /* Element matrix row */
3822:           for (g = 0; g < NbJ; ++g) {
3823:             for (gc = 0; gc < NcJ; ++gc) {
3824:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
3825:               const PetscInt j    = offsetJ+gidx; /* Element matrix column */
3826:               PetscInt       d, d2;

3828:               for (d = 0; d < dim; ++d) {
3829:                 realSpaceDerI[d] = 0.0;
3830:                 realSpaceDerJ[d] = 0.0;
3831:                 for (d2 = 0; d2 < dim; ++d2) {
3832:                   realSpaceDerI[d] += invJ[d2*dim+d]*basisDerI[(q*NbI*NcI+fidx)*dim+d2];
3833:                   realSpaceDerJ[d] += invJ[d2*dim+d]*basisDerJ[(q*NbJ*NcJ+gidx)*dim+d2];
3834:                 }
3835:               }
3836:               elemMat[eOffset+i*cellDof+j] += basisI[q*NbI*NcI+fidx]*g0[fc*NcJ+gc]*basisJ[q*NbJ*NcJ+gidx];
3837:               for (d = 0; d < dim; ++d) {
3838:                 elemMat[eOffset+i*cellDof+j] += basisI[q*NbI*NcI+fidx]*g1[(fc*NcJ+gc)*dim+d]*realSpaceDerJ[d];
3839:                 elemMat[eOffset+i*cellDof+j] += realSpaceDerI[d]*g2[(fc*NcJ+gc)*dim+d]*basisJ[q*NbJ*NcJ+gidx];
3840:                 for (d2 = 0; d2 < dim; ++d2) {
3841:                   elemMat[eOffset+i*cellDof+j] += realSpaceDerI[d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*realSpaceDerJ[d2];
3842:                 }
3843:               }
3844:             }
3845:           }
3846:         }
3847:       }
3848:     }
3849:     if (debug > 1) {
3850:       PetscInt fc, f, gc, g;

3852:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
3853:       for (fc = 0; fc < NcI; ++fc) {
3854:         for (f = 0; f < NbI; ++f) {
3855:           const PetscInt i = offsetI + f*NcI+fc;
3856:           for (gc = 0; gc < NcJ; ++gc) {
3857:             for (g = 0; g < NbJ; ++g) {
3858:               const PetscInt j = offsetJ + g*NcJ+gc;
3859:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*cellDof+j]));
3860:             }
3861:           }
3862:           PetscPrintf(PETSC_COMM_SELF, "\n");
3863:         }
3864:       }
3865:     }
3866:     cOffset    += cellDof;
3867:     cOffsetAux += cellDofAux;
3868:     eOffset    += cellDof*cellDof;
3869:   }
3870:   PetscFree4(g0,g1,g2,g3);
3871:   PetscFree5(u,gradU,x,realSpaceDerI,realSpaceDerJ);
3872:   if (NfAux) {PetscFree2(a,gradA);}
3873:   return(0);
3874: }

3878: PetscErrorCode PetscFEIntegrateInterpolator_Basic(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE feRef[], PetscInt fieldI, PetscFE fe[], PetscInt fieldJ, PetscCellGeometry geom,
3879:                                                   void (*g0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g0[]),
3880:                                                   PetscScalar elemMat[])
3881: {
3882:   const PetscInt  debug      = 2;
3883:   PetscInt        rCellDof   = 0; /* Total number of dof on a fine cell */
3884:   PetscInt        cCellDof   = 0; /* Total number of dof on a coarse cell */
3885:   PetscInt        eOffset    = 0; /* Offset into elemMat[] for element e */
3886:   PetscInt        offsetI    = 0; /* Offset into an element vector for fieldI */
3887:   PetscInt        offsetJ    = 0; /* Offset into an element vector for fieldJ */
3888:   PetscQuadrature quad;
3889:   PetscScalar    *g0;
3890:   PetscReal      *x;
3891:   PetscReal      *basisI, *basisJ;
3892:   PetscInt        NbI = 0, NcI = 0, NbJ = 0, NcJ = 0, numComponents = 0;
3893:   PetscInt        dim, f, e;
3894:   PetscErrorCode  ierr;

3897:   PetscFEGetSpatialDimension(fe[fieldI], &dim);
3898:   PetscFEGetDefaultTabulation(feRef[fieldI], &basisI, NULL, NULL);
3899:   PetscFEGetDefaultTabulation(fe[fieldJ], &basisJ, NULL, NULL);
3900:   for (f = 0; f < Nf; ++f) {
3901:     PetscInt rNb, cNb, Nc;

3903:     PetscFEGetDimension(feRef[f], &rNb);
3904:     PetscFEGetDimension(fe[f], &cNb);
3905:     PetscFEGetNumComponents(fe[f], &Nc);
3906:     if (f == fieldI) {offsetI = rCellDof; NbI = rNb; NcI = Nc;}
3907:     if (f == fieldJ) {offsetJ = cCellDof; NbJ = cNb; NcJ = Nc;}
3908:     numComponents += Nc;
3909:     rCellDof += rNb*Nc;
3910:     cCellDof += cNb*Nc;
3911:   }
3912:   PetscFEGetQuadrature(feRef[fieldI], &quad);
3913:   PetscMalloc2(NcI*NcJ,&g0,dim,&x);
3914:   for (e = 0; e < Ne; ++e) {
3915:     const PetscReal  detJ        = geom.detJ[e];
3916:     const PetscReal *v0          = &geom.v0[e*dim];
3917:     const PetscReal *J           = &geom.J[e*dim*dim];
3918:     const PetscInt   Nq          = quad->numPoints;
3919:     const PetscReal *quadPoints  = quad->points;
3920:     const PetscReal *quadWeights = quad->weights;
3921:     PetscInt         q;

3923:     for (q = 0; q < Nq; ++q) {
3924:       PetscInt    d, d2;
3925:       PetscInt    f, g, fc, gc, c;

3927:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
3928:       for (d = 0; d < dim; ++d) {
3929:         x[d] = v0[d];
3930:         for (d2 = 0; d2 < dim; ++d2) {
3931:           x[d] += J[d*dim+d2]*(quadPoints[q*dim+d2] + 1.0);
3932:         }
3933:       }

3935:       PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
3936:       if (g0_func) {
3937:         g0_func(NULL, NULL, NULL, NULL, x, g0);
3938:         for (c = 0; c < NcI*NcJ; ++c) {g0[c] *= detJ*quadWeights[q];}
3939:       }

3941:       for (f = 0; f < NbI; ++f) {
3942:         for (fc = 0; fc < NcI; ++fc) {
3943:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
3944:           const PetscInt i    = offsetI+fidx; /* Element matrix row */
3945:           for (g = 0; g < NbJ; ++g) {
3946:             for (gc = 0; gc < NcJ; ++gc) {
3947:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
3948:               const PetscInt j    = offsetJ+gidx; /* Element matrix column */

3950:               elemMat[eOffset+i*cCellDof+j] += basisI[q*NbI*NcI+fidx]*g0[fc*NcJ+gc]*basisJ[q*NbJ*NcJ+gidx];
3951:             }
3952:           }
3953:         }
3954:       }
3955:     }
3956:     if (debug > 1) {
3957:       PetscInt fc, f, gc, g;

3959:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
3960:       for (fc = 0; fc < NcI; ++fc) {
3961:         for (f = 0; f < NbI; ++f) {
3962:           const PetscInt i = offsetI + f*NcI+fc;
3963:           for (gc = 0; gc < NcJ; ++gc) {
3964:             for (g = 0; g < NbJ; ++g) {
3965:               const PetscInt j = offsetJ + g*NcJ+gc;
3966:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*cCellDof+j]));
3967:             }
3968:           }
3969:           PetscPrintf(PETSC_COMM_SELF, "\n");
3970:         }
3971:       }
3972:     }
3973:     eOffset += rCellDof*cCellDof;
3974:   }
3975:   PetscFree2(g0,x);
3976:   return(0);
3977: }

3981: PetscErrorCode PetscFEInitialize_Basic(PetscFE fem)
3982: {
3984:   fem->ops->setfromoptions          = NULL;
3985:   fem->ops->setup                   = PetscFESetUp_Basic;
3986:   fem->ops->view                    = PetscFEView_Basic;
3987:   fem->ops->destroy                 = PetscFEDestroy_Basic;
3988:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
3989:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
3990:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Basic;
3991:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Basic;
3992:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Basic */;
3993:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
3994:   fem->ops->integratebdjacobian     = PetscFEIntegrateBdJacobian_Basic;
3995:   fem->ops->integrateifunction      = PetscFEIntegrateIFunction_Basic;
3996:   fem->ops->integratebdifunction    = PetscFEIntegrateBdIFunction_Basic;
3997:   return(0);
3998: }

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

4003:   Level: intermediate

4005: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
4006: M*/

4010: PETSC_EXTERN PetscErrorCode PetscFECreate_Basic(PetscFE fem)
4011: {
4012:   PetscFE_Basic *b;

4017:   PetscNewLog(fem,&b);
4018:   fem->data = b;

4020:   PetscFEInitialize_Basic(fem);
4021:   return(0);
4022: }

4026: PetscErrorCode PetscFEDestroy_Nonaffine(PetscFE fem)
4027: {
4028:   PetscFE_Nonaffine *na = (PetscFE_Nonaffine *) fem->data;

4032:   PetscFree(na);
4033:   return(0);
4034: }

4038: PetscErrorCode PetscFEIntegrateResidual_Nonaffine(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt field, PetscCellGeometry geom, const PetscScalar coefficients[],
4039:                                                   PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
4040:                                                   void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f0[]),
4041:                                                   void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f1[]),
4042:                                                   PetscScalar elemVec[])
4043: {
4044:   const PetscInt  debug = 0;
4045:   PetscQuadrature quad;
4046:   PetscScalar    *f0, *f1, *u, *gradU, *a, *gradA, *refSpaceDer;
4047:   PetscReal      *x;
4048:   PetscInt        dim, numComponents = 0, numComponentsAux = 0, cOffset = 0, cOffsetAux = 0, eOffset = 0, e, f;
4049:   PetscErrorCode  ierr;

4052:   PetscFEGetSpatialDimension(fe[0], &dim);
4053:   for (f = 0; f < Nf; ++f) {
4054:     PetscInt Nc;
4055:     PetscFEGetNumComponents(fe[f], &Nc);
4056:     numComponents += Nc;
4057:   }
4058:   PetscFEGetQuadrature(fe[field], &quad);
4059:   PetscMalloc6(quad->numPoints*dim,&f0,quad->numPoints*dim*dim,&f1,numComponents,&u,numComponents*dim,&gradU,dim,&x,numComponents*dim,&refSpaceDer);
4060:   for (f = 0; f < NfAux; ++f) {
4061:     PetscInt Nc;
4062:     PetscFEGetNumComponents(feAux[f], &Nc);
4063:     numComponentsAux += Nc;
4064:   }
4065:   if (NfAux) {PetscMalloc2(numComponentsAux,&a,numComponentsAux*dim,&gradA);}
4066:   else a = gradA = NULL;
4067:   for (e = 0; e < Ne; ++e) {
4068:     const PetscInt   Nq          = quad->numPoints;
4069:     const PetscReal *quadPoints  = quad->points;
4070:     const PetscReal *quadWeights = quad->weights;
4071:     PetscInt         q, f;

4073:     for (q = 0; q < Nq; ++q) {
4074:       const PetscReal  detJ    = geom.detJ[e*Nq+q];
4075:       const PetscReal *v0      = &geom.v0[(e*Nq+q)*dim];
4076:       const PetscReal *J       = &geom.J[(e*Nq+q)*dim*dim];
4077:       const PetscReal *invJ    = &geom.invJ[(e*Nq+q)*dim*dim];
4078:       PetscInt         fOffset = 0,       fOffsetAux = 0;
4079:       PetscInt         dOffset = cOffset, dOffsetAux = cOffsetAux;
4080:       PetscInt         Ncomp, d, d2, f, i;

4082:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4083:       if (debug > 1) {
4084:         PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
4085: #ifndef PETSC_USE_COMPLEX
4086:         DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
4087: #endif
4088:       }
4089:       PetscFEGetNumComponents(fe[field], &Ncomp);
4090:       for (d = 0; d < numComponents; ++d)       {u[d]     = 0.0;}
4091:       for (d = 0; d < dim*(numComponents); ++d) {gradU[d] = 0.0; refSpaceDer[d] = 0.0;}
4092:       for (d = 0; d < dim; ++d) {
4093:         x[d] = v0[d];
4094:         for (d2 = 0; d2 < dim; ++d2) {
4095:           x[d] += J[d*dim+d2]*(quadPoints[q*dim+d2] + 1.0);
4096:         }
4097:       }
4098:       for (f = 0; f < Nf; ++f) {
4099:         PetscReal *basis, *basisDer;
4100:         PetscInt   Nb, Ncomp, b, comp, g;

4102:         PetscFEGetDimension(fe[f], &Nb);
4103:         PetscFEGetNumComponents(fe[f], &Ncomp);
4104:         PetscFEGetDefaultTabulation(fe[f], &basis, &basisDer, NULL);
4105:         for (b = 0; b < Nb; ++b) {
4106:           for (comp = 0; comp < Ncomp; ++comp) {
4107:             const PetscInt cidx = b*Ncomp+comp;

4109:             u[fOffset+comp] += coefficients[dOffset+cidx]*basis[q*Nb*Ncomp+cidx];
4110:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficients[dOffset+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
4111:           }
4112:         }
4113:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (g = 0; g < dim; ++g) gradU[(fOffset+comp)*dim+d] += invJ[g*dim+d]*refSpaceDer[comp*dim+g];
4114:         if (debug > 1) {
4115:           PetscInt d;
4116:           for (comp = 0; comp < Ncomp; ++comp) {
4117:             PetscPrintf(PETSC_COMM_SELF, "    u[%d,%d]: %g\n", f, comp, PetscRealPart(u[fOffset+comp]));
4118:             for (d = 0; d < dim; ++d) {
4119:               PetscPrintf(PETSC_COMM_SELF, "    gradU[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradU[(fOffset+comp)*dim+d]));
4120:             }
4121:           }
4122:         }
4123:         fOffset += Ncomp;
4124:         dOffset += Nb*Ncomp;
4125:       }
4126:       for (d = 0; d < numComponentsAux; ++d)       {a[d]     = 0.0;}
4127:       for (d = 0; d < dim*(numComponentsAux); ++d) {gradA[d] = 0.0; refSpaceDer[d] = 0.0;}
4128:       for (f = 0; f < NfAux; ++f) {
4129:         PetscReal *basis, *basisDer;
4130:         PetscInt   Nb, Ncomp, b, comp, g;

4132:         PetscFEGetDimension(feAux[f], &Nb);
4133:         PetscFEGetNumComponents(feAux[f], &Ncomp);
4134:         PetscFEGetDefaultTabulation(feAux[f], &basis, &basisDer, NULL);
4135:         for (b = 0; b < Nb; ++b) {
4136:           for (comp = 0; comp < Ncomp; ++comp) {
4137:             const PetscInt cidx = b*Ncomp+comp;

4139:             a[fOffsetAux+comp] += coefficientsAux[dOffsetAux+cidx]*basis[q*Nb*Ncomp+cidx];
4140:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficientsAux[dOffsetAux+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
4141:           }
4142:         }
4143:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (g = 0; g < dim; ++g) gradA[(fOffsetAux+comp)*dim+d] += invJ[g*dim+d]*refSpaceDer[comp*dim+g];
4144:         if (debug > 1) {
4145:           PetscInt d;
4146:           for (comp = 0; comp < Ncomp; ++comp) {
4147:             PetscPrintf(PETSC_COMM_SELF, "    a[%d,%d]: %g\n", f, comp, PetscRealPart(a[fOffsetAux+comp]));
4148:             for (d = 0; d < dim; ++d) {
4149:               PetscPrintf(PETSC_COMM_SELF, "    gradA[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradA[(fOffsetAux+comp)*dim+d]));
4150:             }
4151:           }
4152:         }
4153:         fOffsetAux += Ncomp;
4154:         dOffsetAux += Nb*Ncomp;
4155:       }

4157:       f0_func(u, gradU, a, gradA, x, &f0[q*Ncomp]);
4158:       for (i = 0; i < Ncomp; ++i) {
4159:         f0[q*Ncomp+i] *= detJ*quadWeights[q];
4160:       }
4161:       f1_func(u, gradU, a, gradA, x, refSpaceDer);
4162:       for (i = 0; i < Ncomp*dim; ++i) {
4163:         for (d = 0; d < dim; ++d) {
4164:           PetscInt g;
4165:           f1[(q*Ncomp + i)*dim+d] = 0.0;
4166:           for (g = 0; g < dim; ++g) f1[(q*Ncomp + i)*dim+d] += invJ[d*dim+g]*refSpaceDer[i*dim+g];
4167:           f1[(q*Ncomp + i)*dim+d] *= detJ*quadWeights[q];
4168:         }
4169:       }
4170:       if (debug > 1) {
4171:         PetscInt c,d;
4172:         for (c = 0; c < Ncomp; ++c) {
4173:           PetscPrintf(PETSC_COMM_SELF, "    f0[%d]: %g\n", c, PetscRealPart(f0[q*Ncomp+c]));
4174:           for (d = 0; d < dim; ++d) {
4175:             PetscPrintf(PETSC_COMM_SELF, "    f1[%d]_%c: %g\n", c, 'x'+d, PetscRealPart(f1[(q*Ncomp + c)*dim+d]));
4176:           }
4177:         }
4178:       }
4179:       if (q == Nq-1) {cOffset = dOffset; cOffsetAux = dOffsetAux;}
4180:     }
4181:     for (f = 0; f < Nf; ++f) {
4182:       PetscInt   Nb, Ncomp, b, comp;

4184:       PetscFEGetDimension(fe[f], &Nb);
4185:       PetscFEGetNumComponents(fe[f], &Ncomp);
4186:       if (f == field) {
4187:         PetscReal *basis;
4188:         PetscReal *basisDer;

4190:         PetscFEGetDefaultTabulation(fe[f], &basis, &basisDer, NULL);
4191:         for (b = 0; b < Nb; ++b) {
4192:           for (comp = 0; comp < Ncomp; ++comp) {
4193:             const PetscInt cidx = b*Ncomp+comp;
4194:             PetscInt       q, d;

4196:             elemVec[eOffset+cidx] = 0.0;
4197:             for (q = 0; q < Nq; ++q) {
4198:               elemVec[eOffset+cidx] += basis[q*Nb*Ncomp+cidx]*f0[q*Ncomp+comp];
4199:               for (d = 0; d < dim; ++d) elemVec[eOffset+cidx] += basisDer[(q*Nb*Ncomp+cidx)*dim+d]*f1[(q*Ncomp+comp)*dim+d];
4200:             }
4201:           }
4202:         }
4203:         if (debug > 1) {
4204:           PetscInt b, comp;

4206:           for (b = 0; b < Nb; ++b) {
4207:             for (comp = 0; comp < Ncomp; ++comp) {
4208:               PetscPrintf(PETSC_COMM_SELF, "    elemVec[%d,%d]: %g\n", b, comp, PetscRealPart(elemVec[eOffset+b*Ncomp+comp]));
4209:             }
4210:           }
4211:         }
4212:       }
4213:       eOffset += Nb*Ncomp;
4214:     }
4215:   }
4216:   PetscFree6(f0,f1,u,gradU,x,refSpaceDer);
4217:   PetscFree2(a,gradA);
4218:   return(0);
4219: }

4223: PetscErrorCode PetscFEIntegrateBdResidual_Nonaffine(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt field, PetscCellGeometry geom, const PetscScalar coefficients[],
4224:                                                 PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
4225:                                                 void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar f0[]),
4226:                                                 void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar f1[]),
4227:                                                 PetscScalar elemVec[])
4228: {
4229:   const PetscInt  debug = 0;
4230:   PetscQuadrature quad;
4231:   PetscScalar    *f0, *f1, *u, *gradU, *a, *gradA, *refSpaceDer;
4232:   PetscReal      *x;
4233:   PetscInt        dim, numComponents = 0, numComponentsAux = 0, cOffset = 0, cOffsetAux = 0, eOffset = 0, e, f;
4234:   PetscErrorCode  ierr;

4237:   PetscFEGetSpatialDimension(fe[0], &dim);
4238:   dim += 1; /* Spatial dimension is one higher than topological dimension */
4239:   for (f = 0; f < Nf; ++f) {
4240:     PetscInt Nc;
4241:     PetscFEGetNumComponents(fe[f], &Nc);
4242:     numComponents += Nc;
4243:   }
4244:   PetscFEGetQuadrature(fe[field], &quad);
4245:   PetscMalloc6(quad->numPoints*dim,&f0,quad->numPoints*dim*dim,&f1,numComponents,&u,numComponents*dim,&gradU,dim,&x,numComponents*dim,&refSpaceDer);
4246:   for (f = 0; f < NfAux; ++f) {
4247:     PetscInt Nc;
4248:     PetscFEGetNumComponents(feAux[f], &Nc);
4249:     numComponentsAux += Nc;
4250:   }
4251:   if (NfAux) {PetscMalloc2(numComponentsAux,&a,numComponentsAux*dim,&gradA);}
4252:   else a = gradA = NULL;
4253:   for (e = 0; e < Ne; ++e) {
4254:     const PetscInt   Nq          = quad->numPoints;
4255:     const PetscReal *quadPoints  = quad->points;
4256:     const PetscReal *quadWeights = quad->weights;
4257:     PetscInt         q, f;

4259:     for (q = 0; q < Nq; ++q) {
4260:       const PetscReal  detJ    = geom.detJ[e*Nq+q];
4261:       const PetscReal *v0      = &geom.v0[(e*Nq+q)*dim];
4262:       const PetscReal *n       = &geom.n[(e*Nq+q)*dim];
4263:       const PetscReal *J       = &geom.J[(e*Nq+q)*dim*dim];
4264:       const PetscReal *invJ    = &geom.invJ[(e*Nq+q)*dim*dim];
4265:       PetscInt         fOffset = 0,       fOffsetAux = 0;
4266:       PetscInt         dOffset = cOffset, dOffsetAux = cOffsetAux;
4267:       PetscInt         Ncomp, d, d2, f, i;
4268:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4269:       if (debug > 1) {
4270:         PetscPrintf(PETSC_COMM_SELF, "  detJ: %g\n", detJ);
4271: #ifndef PETSC_USE_COMPLEX
4272:         DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
4273: #endif
4274:       }

4276:       PetscFEGetNumComponents(fe[field], &Ncomp);
4277:       for (d = 0; d < numComponents; ++d)       {u[d]     = 0.0;}
4278:       for (d = 0; d < dim*(numComponents); ++d) {gradU[d] = 0.0; refSpaceDer[d] = 0.0;}
4279:       for (d = 0; d < dim; ++d) {
4280:         x[d] = v0[d];
4281:         for (d2 = 0; d2 < dim-1; ++d2) {
4282:           x[d] += J[d*dim+d2]*(quadPoints[q*(dim-1)+d2] + 1.0);
4283:         }
4284:       }
4285:       for (f = 0; f < Nf; ++f) {
4286:         PetscReal *basis, *basisDer;
4287:         PetscInt   Nb, Ncomp, b, comp, g;

4289:         PetscFEGetDimension(fe[f], &Nb);
4290:         PetscFEGetNumComponents(fe[f], &Ncomp);
4291:         PetscFEGetDefaultTabulation(fe[f], &basis, &basisDer, NULL);
4292:         for (b = 0; b < Nb; ++b) {
4293:           for (comp = 0; comp < Ncomp; ++comp) {
4294:             const PetscInt cidx = b*Ncomp+comp;
4295:             PetscInt       d;

4297:             u[fOffset+comp] += coefficients[dOffset+cidx]*basis[q*Nb*Ncomp+cidx];
4298:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficients[dOffset+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
4299:           }
4300:         }
4301:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (g = 0; g < dim; ++g) gradU[(fOffset+comp)*dim+d] += invJ[g*dim+d]*refSpaceDer[comp*dim+g];
4302:         if (debug > 1) {
4303:           PetscInt d;
4304:           for (comp = 0; comp < Ncomp; ++comp) {
4305:             PetscPrintf(PETSC_COMM_SELF, "    u[%d,%d]: %g\n", f, comp, PetscRealPart(u[fOffset+comp]));
4306:             for (d = 0; d < dim; ++d) {
4307:               PetscPrintf(PETSC_COMM_SELF, "    gradU[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradU[(fOffset+comp)*dim+d]));
4308:             }
4309:           }
4310:         }
4311:         fOffset += Ncomp;
4312:         dOffset += Nb*Ncomp;
4313:       }
4314:       for (d = 0; d < numComponentsAux; ++d)       {a[d]     = 0.0;}
4315:       for (d = 0; d < dim*(numComponentsAux); ++d) {gradA[d] = 0.0; refSpaceDer[d] = 0.0;}
4316:       for (f = 0; f < NfAux; ++f) {
4317:         PetscReal *basis, *basisDer;
4318:         PetscInt   Nb, Ncomp, b, comp, g;

4320:         PetscFEGetDimension(feAux[f], &Nb);
4321:         PetscFEGetNumComponents(feAux[f], &Ncomp);
4322:         PetscFEGetDefaultTabulation(feAux[f], &basis, &basisDer, NULL);
4323:         for (b = 0; b < Nb; ++b) {
4324:           for (comp = 0; comp < Ncomp; ++comp) {
4325:             const PetscInt cidx = b*Ncomp+comp;

4327:             a[fOffsetAux+comp] += coefficientsAux[dOffsetAux+cidx]*basis[q*Nb*Ncomp+cidx];
4328:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficientsAux[dOffsetAux+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
4329:           }
4330:         }
4331:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (g = 0; g < dim; ++g) gradA[(fOffsetAux+comp)*dim+d] += invJ[g*dim+d]*refSpaceDer[comp*dim+g];
4332:         if (debug > 1) {
4333:           PetscInt d;
4334:           for (comp = 0; comp < Ncomp; ++comp) {
4335:             PetscPrintf(PETSC_COMM_SELF, "    a[%d,%d]: %g\n", f, comp, PetscRealPart(a[fOffsetAux+comp]));
4336:             for (d = 0; d < dim; ++d) {
4337:               PetscPrintf(PETSC_COMM_SELF, "    gradA[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradA[(fOffsetAux+comp)*dim+d]));
4338:             }
4339:           }
4340:         }
4341:         fOffsetAux += Ncomp;
4342:         dOffsetAux += Nb*Ncomp;
4343:       }

4345:       f0_func(u, gradU, a, gradA, x, n, &f0[q*Ncomp]);
4346:       for (i = 0; i < Ncomp; ++i) {
4347:         f0[q*Ncomp+i] *= detJ*quadWeights[q];
4348:       }
4349:       f1_func(u, gradU, a, gradA, x, n, refSpaceDer);
4350:       for (i = 0; i < Ncomp*dim; ++i) {
4351:         for (d = 0; d < dim; ++d) {
4352:           PetscInt g;
4353:           f1[(q*Ncomp + i)*dim+d] = 0.0;
4354:           for (g = 0; g < dim; ++g) f1[(q*Ncomp + i)*dim+d] += invJ[d*dim+g]*refSpaceDer[i*dim+g];
4355:           f1[(q*Ncomp + i)*dim+d] *= detJ*quadWeights[q];
4356:         }
4357:       }
4358:       if (debug > 1) {
4359:         PetscInt c,d;
4360:         for (c = 0; c < Ncomp; ++c) {
4361:           PetscPrintf(PETSC_COMM_SELF, "    f0[%d]: %g\n", c, PetscRealPart(f0[q*Ncomp+c]));
4362:           for (d = 0; d < dim; ++d) {
4363:             PetscPrintf(PETSC_COMM_SELF, "    f1[%d]_%c: %g\n", c, 'x'+d, PetscRealPart(f1[(q*Ncomp + c)*dim+d]));
4364:           }
4365:         }
4366:       }
4367:       if (q == Nq-1) {cOffset = dOffset; cOffsetAux = dOffsetAux;}
4368:     }
4369:     for (f = 0; f < Nf; ++f) {
4370:       PetscInt   Nb, Ncomp, b, comp;

4372:       PetscFEGetDimension(fe[f], &Nb);
4373:       PetscFEGetNumComponents(fe[f], &Ncomp);
4374:       if (f == field) {
4375:         PetscReal *basis;
4376:         PetscReal *basisDer;

4378:         PetscFEGetDefaultTabulation(fe[f], &basis, &basisDer, NULL);
4379:         for (b = 0; b < Nb; ++b) {
4380:           for (comp = 0; comp < Ncomp; ++comp) {
4381:             const PetscInt cidx = b*Ncomp+comp;
4382:             PetscInt       q, d;

4384:             elemVec[eOffset+cidx] = 0.0;
4385:             for (q = 0; q < Nq; ++q) {
4386:               elemVec[eOffset+cidx] += basis[q*Nb*Ncomp+cidx]*f0[q*Ncomp+comp];
4387:               for (d = 0; d < dim; ++d) elemVec[eOffset+cidx] += basisDer[(q*Nb*Ncomp+cidx)*dim+d]*f1[(q*Ncomp+comp)*dim+d];
4388:             }
4389:           }
4390:         }
4391:         if (debug > 1) {
4392:           PetscInt b, comp;

4394:           for (b = 0; b < Nb; ++b) {
4395:             for (comp = 0; comp < Ncomp; ++comp) {
4396:               PetscPrintf(PETSC_COMM_SELF, "    elemVec[%d,%d]: %g\n", b, comp, PetscRealPart(elemVec[eOffset+b*Ncomp+comp]));
4397:             }
4398:           }
4399:         }
4400:       }
4401:       eOffset += Nb*Ncomp;
4402:     }
4403:   }
4404:   PetscFree6(f0,f1,u,gradU,x,refSpaceDer);
4405:   PetscFree2(a,gradA);
4406:   return(0);
4407: }

4411: PetscErrorCode PetscFEIntegrateJacobian_Nonaffine(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt fieldI, PetscInt fieldJ, PetscCellGeometry geom, const PetscScalar coefficients[],
4412:                                               PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
4413:                                               void (*g0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g0[]),
4414:                                               void (*g1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g1[]),
4415:                                               void (*g2_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g2[]),
4416:                                               void (*g3_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g3[]),
4417:                                               PetscScalar elemMat[])
4418: {
4419:   const PetscInt  debug      = 0;
4420:   PetscInt        cellDof    = 0; /* Total number of dof on a cell */
4421:   PetscInt        cellDofAux = 0; /* Total number of auxiliary dof on a cell */
4422:   PetscInt        cOffset    = 0; /* Offset into coefficients[] for element e */
4423:   PetscInt        cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
4424:   PetscInt        eOffset    = 0; /* Offset into elemMat[] for element e */
4425:   PetscInt        offsetI    = 0; /* Offset into an element vector for fieldI */
4426:   PetscInt        offsetJ    = 0; /* Offset into an element vector for fieldJ */
4427:   PetscQuadrature quad;
4428:   PetscScalar    *g0, *g1, *g2, *g3, *u, *gradU, *a, *gradA, *refSpaceDer;
4429:   PetscReal      *x;
4430:   PetscReal      *basisI, *basisDerI, *basisJ, *basisDerJ;
4431:   PetscInt        NbI = 0, NcI = 0, NbJ = 0, NcJ = 0, numComponents = 0, numComponentsAux = 0;
4432:   PetscInt        dim, f, e;
4433:   PetscErrorCode  ierr;

4436:   PetscFEGetSpatialDimension(fe[fieldI], &dim);
4437:   PetscFEGetDefaultTabulation(fe[fieldI], &basisI, &basisDerI, NULL);
4438:   PetscFEGetDefaultTabulation(fe[fieldJ], &basisJ, &basisDerJ, NULL);
4439:   for (f = 0; f < Nf; ++f) {
4440:     PetscInt Nb, Nc;

4442:     PetscFEGetDimension(fe[f], &Nb);
4443:     PetscFEGetNumComponents(fe[f], &Nc);
4444:     if (f == fieldI) {offsetI = cellDof; NbI = Nb; NcI = Nc;}
4445:     if (f == fieldJ) {offsetJ = cellDof; NbJ = Nb; NcJ = Nc;}
4446:     numComponents += Nc;
4447:     cellDof += Nb*Nc;
4448:   }
4449:   PetscFEGetQuadrature(fe[fieldI], &quad);
4450:   PetscMalloc4(NcI*NcJ,&g0,NcI*NcJ*dim,&g1,NcI*NcJ*dim,&g2,NcI*NcJ*dim*dim,&g3);
4451:   PetscMemzero(g0, NcI*NcJ         * sizeof(PetscScalar));
4452:   PetscMemzero(g1, NcI*NcJ*dim     * sizeof(PetscScalar));
4453:   PetscMemzero(g2, NcI*NcJ*dim     * sizeof(PetscScalar));
4454:   PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4455:   PetscMalloc4(numComponents,&u,numComponents*dim,&gradU,dim,&x,PetscMax(numComponents*dim, NcI*NcJ*dim*dim),&refSpaceDer);
4456:   for (f = 0; f < NfAux; ++f) {
4457:     PetscInt Nb, Nc;
4458:     PetscFEGetDimension(feAux[f], &Nb);
4459:     PetscFEGetNumComponents(feAux[f], &Nc);
4460:     numComponentsAux += Nc;
4461:     cellDofAux       += Nb*Nc;
4462:   }
4463:   if (NfAux) {PetscMalloc2(numComponentsAux,&a,numComponentsAux*dim,&gradA);}
4464:   else a = gradA = NULL;
4465:   for (e = 0; e < Ne; ++e) {
4466:     const PetscInt   Nq          = quad->numPoints;
4467:     const PetscReal *quadPoints  = quad->points;
4468:     const PetscReal *quadWeights = quad->weights;
4469:     PetscInt         q;

4471:     for (q = 0; q < Nq; ++q) {
4472:       const PetscReal  detJ    = geom.detJ[e*Nq+q];
4473:       const PetscReal *v0      = &geom.v0[(e*Nq+q)*dim];
4474:       const PetscReal *J       = &geom.J[(e*Nq+q)*dim*dim];
4475:       const PetscReal *invJ    = &geom.invJ[(e*Nq+q)*dim*dim];
4476:       PetscInt    fOffset    = 0;          /* Offset into u[] for field_q (like offsetI) */
4477:       PetscInt    dOffset    = cOffset;    /* Offset into coefficients[] for field_q */
4478:       PetscInt    fOffsetAux = 0;          /* Offset into a[] for field_q (like offsetI) */
4479:       PetscInt    dOffsetAux = cOffsetAux; /* Offset into coefficientsAux[] for field_q */
4480:       PetscInt    field_q, d, d2;
4481:       PetscInt    f, g, fc, gc, c;

4483:       if (debug) {PetscPrintf(PETSC_COMM_SELF, "  quad point %d\n", q);}
4484:       for (d = 0; d < numComponents; ++d)     {u[d]     = 0.0;}
4485:       for (d = 0; d < dim*numComponents; ++d) {gradU[d] = 0.0; refSpaceDer[d] = 0.0;}
4486:       for (d = 0; d < dim; ++d) {
4487:         x[d] = v0[d];
4488:         for (d2 = 0; d2 < dim; ++d2) {
4489:           x[d] += J[d*dim+d2]*(quadPoints[q*dim+d2] + 1.0);
4490:         }
4491:       }
4492:       for (field_q = 0; field_q < Nf; ++field_q) {
4493:         PetscReal *basis, *basisDer;
4494:         PetscInt   Nb, Ncomp, b, comp;

4496:         PetscFEGetDimension(fe[field_q], &Nb);
4497:         PetscFEGetNumComponents(fe[field_q], &Ncomp);
4498:         PetscFEGetDefaultTabulation(fe[field_q], &basis, &basisDer, NULL);
4499:         for (b = 0; b < Nb; ++b) {
4500:           for (comp = 0; comp < Ncomp; ++comp) {
4501:             const PetscInt cidx = b*Ncomp+comp;

4503:             u[fOffset+comp] += coefficients[dOffset+cidx]*basis[q*Nb*Ncomp+cidx];
4504:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficients[dOffset+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
4505:           }
4506:         }
4507:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (d2 = 0; d2 < dim; ++d2) gradU[(fOffset+comp)*dim+d] += invJ[d2*dim+d]*refSpaceDer[comp*dim+d2];
4508:         if (debug > 1) {
4509:           for (comp = 0; comp < Ncomp; ++comp) {
4510:             PetscPrintf(PETSC_COMM_SELF, "    u[%d,%d]: %g\n", f, comp, PetscRealPart(u[fOffset+comp]));
4511:             for (d = 0; d < dim; ++d) {
4512:               PetscPrintf(PETSC_COMM_SELF, "    gradU[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradU[(fOffset+comp)*dim+d]));
4513:             }
4514:           }
4515:         }
4516:         fOffset += Ncomp;
4517:         dOffset += Nb*Ncomp;
4518:       }
4519:       for (d = 0; d < numComponentsAux; ++d)       {a[d]     = 0.0;}
4520:       for (d = 0; d < dim*(numComponentsAux); ++d) {gradA[d] = 0.0; refSpaceDer[d] = 0.0;}
4521:       for (field_q = 0; field_q < NfAux; ++field_q) {
4522:         PetscReal *basis, *basisDer;
4523:         PetscInt   Nb, Ncomp, b, comp, d2;

4525:         PetscFEGetDimension(feAux[field_q], &Nb);
4526:         PetscFEGetNumComponents(feAux[field_q], &Ncomp);
4527:         PetscFEGetDefaultTabulation(feAux[field_q], &basis, &basisDer, NULL);
4528:         for (b = 0; b < Nb; ++b) {
4529:           for (comp = 0; comp < Ncomp; ++comp) {
4530:             const PetscInt cidx = b*Ncomp+comp;

4532:             a[fOffsetAux+comp] += coefficientsAux[dOffsetAux+cidx]*basis[q*Nb*Ncomp+cidx];
4533:             for (d = 0; d < dim; ++d) refSpaceDer[comp*dim+d] += coefficientsAux[dOffsetAux+cidx]*basisDer[(q*Nb*Ncomp+cidx)*dim+d];
4534:           }
4535:         }
4536:         for (comp = 0; comp < Ncomp; ++comp) for (d = 0; d < dim; ++d) for (d2 = 0; d2 < dim; ++d2) gradA[(fOffsetAux+comp)*dim+d] += invJ[d2*dim+d]*refSpaceDer[comp*dim+d2];
4537:         if (debug > 1) {
4538:           for (comp = 0; comp < Ncomp; ++comp) {
4539:             PetscPrintf(PETSC_COMM_SELF, "    a[%d,%d]: %g\n", f, comp, PetscRealPart(a[fOffsetAux+comp]));
4540:             for (d = 0; d < dim; ++d) {
4541:               PetscPrintf(PETSC_COMM_SELF, "    gradA[%d,%d]_%c: %g\n", f, comp, 'x'+d, PetscRealPart(gradA[(fOffsetAux+comp)*dim+d]));
4542:             }
4543:           }
4544:         }
4545:         fOffsetAux += Ncomp;
4546:         dOffsetAux += Nb*Ncomp;
4547:       }

4549:       if (g0_func) {
4550:         PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4551:         g0_func(u, gradU, a, gradA, x, g0);
4552:         for (c = 0; c < NcI*NcJ; ++c) {g0[c] *= detJ*quadWeights[q];}
4553:       }
4554:       if (g1_func) {
4555:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4556:         g1_func(u, gradU, a, gradA, x, refSpaceDer);
4557:         for (fc = 0; fc < NcI; ++fc) {
4558:           for (gc = 0; gc < NcJ; ++gc) {
4559:             for (d = 0; d < dim; ++d) {
4560:               g1[(fc*NcJ+gc)*dim+d] = 0.0;
4561:               for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4562:               g1[(fc*NcJ+gc)*dim+d] *= detJ*quadWeights[q];
4563:             }
4564:           }
4565:         }
4566:       }
4567:       if (g2_func) {
4568:         PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4569:         g2_func(u, gradU, a, gradA, x, refSpaceDer);
4570:         for (fc = 0; fc < NcI; ++fc) {
4571:           for (gc = 0; gc < NcJ; ++gc) {
4572:             for (d = 0; d < dim; ++d) {
4573:               g2[(fc*NcJ+gc)*dim+d] = 0.0;
4574:               for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4575:               g2[(fc*NcJ+gc)*dim+d] *= detJ*quadWeights[q];
4576:             }
4577:           }
4578:         }
4579:       }
4580:       if (g3_func) {
4581:         PetscInt dp, d3;
4582:         PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4583:         g3_func(u, gradU, a, gradA, x, refSpaceDer);
4584:         for (fc = 0; fc < NcI; ++fc) {
4585:           for (gc = 0; gc < NcJ; ++gc) {
4586:             for (d = 0; d < dim; ++d) {
4587:               for (dp = 0; dp < dim; ++dp) {
4588:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
4589:                 for (d2 = 0; d2 < dim; ++d2) {
4590:                   for (d3 = 0; d3 < dim; ++d3) {
4591:                     g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
4592:                   }
4593:                 }
4594:                 g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= detJ*quadWeights[q];
4595:               }
4596:             }
4597:           }
4598:         }
4599:       }

4601:       for (f = 0; f < NbI; ++f) {
4602:         for (fc = 0; fc < NcI; ++fc) {
4603:           const PetscInt fidx = f*NcI+fc; /* Test function basis index */
4604:           const PetscInt i    = offsetI+fidx; /* Element matrix row */
4605:           for (g = 0; g < NbJ; ++g) {
4606:             for (gc = 0; gc < NcJ; ++gc) {
4607:               const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
4608:               const PetscInt j    = offsetJ+gidx; /* Element matrix column */
4609:               PetscInt       d, d2;

4611:               elemMat[eOffset+i*cellDof+j] += basisI[q*NbI*NcI+fidx]*g0[fc*NcJ+gc]*basisJ[q*NbJ*NcJ+gidx];
4612:               for (d = 0; d < dim; ++d) {
4613:                 elemMat[eOffset+i*cellDof+j] += basisI[q*NbI*NcI+fidx]*g1[(fc*NcJ+gc)*dim+d]*basisDerJ[(q*NbJ*NcJ+gidx)*dim+d];
4614:                 elemMat[eOffset+i*cellDof+j] += basisDerI[(q*NbI*NcI+fidx)*dim+d]*g2[(fc*NcJ+gc)*dim+d]*basisJ[q*NbJ*NcJ+gidx];
4615:                 for (d2 = 0; d2 < dim; ++d2) {
4616:                   elemMat[eOffset+i*cellDof+j] += basisDerI[(q*NbI*NcI+fidx)*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*basisDerJ[(q*NbJ*NcJ+gidx)*dim+d2];
4617:                 }
4618:               }
4619:             }
4620:           }
4621:         }
4622:       }
4623:     }
4624:     if (debug > 1) {
4625:       PetscInt fc, f, gc, g;

4627:       PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
4628:       for (fc = 0; fc < NcI; ++fc) {
4629:         for (f = 0; f < NbI; ++f) {
4630:           const PetscInt i = offsetI + f*NcI+fc;
4631:           for (gc = 0; gc < NcJ; ++gc) {
4632:             for (g = 0; g < NbJ; ++g) {
4633:               const PetscInt j = offsetJ + g*NcJ+gc;
4634:               PetscPrintf(PETSC_COMM_SELF, "    elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*cellDof+j]));
4635:             }
4636:           }
4637:           PetscPrintf(PETSC_COMM_SELF, "\n");
4638:         }
4639:       }
4640:     }
4641:     cOffset    += cellDof;
4642:     cOffsetAux += cellDofAux;
4643:     eOffset    += cellDof*cellDof;
4644:   }
4645:   PetscFree4(g0,g1,g2,g3);
4646:   PetscFree4(u,gradU,x,refSpaceDer);
4647:   PetscFree2(a,gradA);
4648:   return(0);
4649: }

4653: PetscErrorCode PetscFEInitialize_Nonaffine(PetscFE fem)
4654: {
4656:   fem->ops->setfromoptions          = NULL;
4657:   fem->ops->setup                   = PetscFESetUp_Basic;
4658:   fem->ops->view                    = NULL;
4659:   fem->ops->destroy                 = PetscFEDestroy_Nonaffine;
4660:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
4661:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
4662:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Nonaffine;
4663:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Nonaffine;
4664:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Nonaffine */;
4665:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Nonaffine;
4666:   return(0);
4667: }

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

4672:   Level: intermediate

4674: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
4675: M*/

4679: PETSC_EXTERN PetscErrorCode PetscFECreate_Nonaffine(PetscFE fem)
4680: {
4681:   PetscFE_Nonaffine *na;
4682:   PetscErrorCode     ierr;

4686:   PetscNewLog(fem, &na);
4687:   fem->data = na;

4689:   PetscFEInitialize_Nonaffine(fem);
4690:   return(0);
4691: }

4693: #ifdef PETSC_HAVE_OPENCL

4697: PetscErrorCode PetscFEDestroy_OpenCL(PetscFE fem)
4698: {
4699:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
4700:   PetscErrorCode  ierr;

4703:   clReleaseCommandQueue(ocl->queue_id);
4704:   ocl->queue_id = 0;
4705:   clReleaseContext(ocl->ctx_id);
4706:   ocl->ctx_id = 0;
4707:   PetscFree(ocl);
4708:   return(0);
4709: }

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

4716: /* dim     Number of spatial dimensions:          2                   */
4717: /* N_b     Number of basis functions:             generated           */
4718: /* N_{bt}  Number of total basis functions:       N_b * N_{comp}      */
4719: /* N_q     Number of quadrature points:           generated           */
4720: /* N_{bs}  Number of block cells                  LCM(N_b, N_q)       */
4721: /* N_{bst} Number of block cell components        LCM(N_{bt}, N_q)    */
4722: /* N_{bl}  Number of concurrent blocks            generated           */
4723: /* N_t     Number of threads:                     N_{bl} * N_{bs}     */
4724: /* N_{cbc} Number of concurrent basis      cells: N_{bl} * N_q        */
4725: /* N_{cqc} Number of concurrent quadrature cells: N_{bl} * N_b        */
4726: /* N_{sbc} Number of serial     basis      cells: N_{bs} / N_q        */
4727: /* N_{sqc} Number of serial     quadrature cells: N_{bs} / N_b        */
4728: /* N_{cb}  Number of serial cell batches:         input               */
4729: /* N_c     Number of total cells:                 N_{cb}*N_{t}/N_{comp} */
4730: PetscErrorCode PetscFEOpenCLGenerateIntegrationCode(PetscFE fem, char **string_buffer, PetscInt buffer_length, PetscBool useAux, PetscInt N_bl)
4731: {
4732:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
4733:   PetscQuadrature q;
4734:   char           *string_tail   = *string_buffer;
4735:   char           *end_of_buffer = *string_buffer + buffer_length;
4736:   char            float_str[]   = "float", double_str[]  = "double";
4737:   char           *numeric_str   = &(float_str[0]);
4738:   PetscInt        op            = ocl->op;
4739:   PetscBool       useField      = PETSC_FALSE;
4740:   PetscBool       useFieldDer   = PETSC_TRUE;
4741:   PetscBool       useFieldAux   = useAux;
4742:   PetscBool       useFieldDerAux= PETSC_FALSE;
4743:   PetscBool       useF0         = PETSC_TRUE;
4744:   PetscBool       useF1         = PETSC_TRUE;
4745:   PetscReal      *basis, *basisDer;
4746:   PetscInt        dim, N_b, N_c, N_q, N_t, p, d, b, c;
4747:   size_t          count;
4748:   PetscErrorCode  ierr;

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

5106:   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");}
5107:   if (useF1) {
5108:     switch (dim) {
5109:     case 2:
5110:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5111: "        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"
5112: "        e_i           += realSpaceDer.x*f_1[fidx].x;\n"
5113: "        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"
5114: "        e_i           += realSpaceDer.y*f_1[fidx].y;\n",
5115:                            &count);STRING_ERROR_CHECK("Message to short");break;
5116:     case 3:
5117:       PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5118: "        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"
5119: "        e_i           += realSpaceDer.x*f_1[fidx].x;\n"
5120: "        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"
5121: "        e_i           += realSpaceDer.y*f_1[fidx].y;\n"
5122: "        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"
5123: "        e_i           += realSpaceDer.z*f_1[fidx].z;\n",
5124:                            &count);STRING_ERROR_CHECK("Message to short");break;
5125:     }
5126:   }
5127:   PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5128: "      }\n"
5129: "      /* Write element vector for N_{cbc} cells at a time */\n"
5130: "      elemVec[(gidx*N_cb*N_bc*N_bt)+(batch*N_sbc+c)*N_t+tidx] = e_i;\n"
5131: "    }\n"
5132: "    /* ==== Could do one write per batch ==== */\n"
5133: "  }\n"
5134: "  return;\n"
5135: "}\n",
5136:                        &count);STRING_ERROR_CHECK("Message to short");
5137:   return(0);
5138: }

5142: PetscErrorCode PetscFEOpenCLGetIntegrationKernel(PetscFE fem, PetscBool useAux, cl_program *ocl_prog, cl_kernel *ocl_kernel)
5143: {
5144:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5145:   PetscInt        dim, N_bl;
5146:   char           *buffer;
5147:   size_t          len;
5148:   char            errMsg[8192];
5149:   cl_int          ierr2;
5150:   PetscErrorCode  ierr;

5153:   PetscFEGetSpatialDimension(fem, &dim);
5154:   PetscMalloc1(8192, &buffer);
5155:   PetscFEGetTileSizes(fem, NULL, &N_bl, NULL, NULL);
5156:   PetscFEOpenCLGenerateIntegrationCode(fem, &buffer, 8192, useAux, N_bl);
5157:   len  = strlen(buffer);
5158:   *ocl_prog = clCreateProgramWithSource(ocl->ctx_id, 1, (const char **) &buffer, &len, &ierr2);CHKERRQ(ierr2);
5159:   clBuildProgram(*ocl_prog, 0, NULL, NULL, NULL, NULL);
5160:   if (ierr != CL_SUCCESS) {
5161:     clGetProgramBuildInfo(*ocl_prog, ocl->dev_id, CL_PROGRAM_BUILD_LOG, 8192*sizeof(char), &errMsg, NULL);
5162:     SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Build failed! Log:\n %s", errMsg);
5163:   }
5164:   PetscFree(buffer);
5165:   *ocl_kernel = clCreateKernel(*ocl_prog, "integrateElementQuadrature", &ierr);
5166:   return(0);
5167: }

5171: PetscErrorCode PetscFEOpenCLCalculateGrid(PetscFE fem, PetscInt N, PetscInt blockSize, size_t *x, size_t *y, size_t *z)
5172: {
5173:   const PetscInt Nblocks = N/blockSize;

5176:   if (N % blockSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Invalid block size %d for %d elements", blockSize, N);
5177:   *z = 1;
5178:   for (*x = (size_t) (PetscSqrtReal(Nblocks) + 0.5); *x > 0; --*x) {
5179:     *y = Nblocks / *x;
5180:     if (*x * *y == Nblocks) break;
5181:   }
5182:   if (*x * *y != Nblocks) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Could not find partition for %d with block size %d", N, blockSize);
5183:   return(0);
5184: }

5188: PetscErrorCode PetscFEOpenCLLogResidual(PetscFE fem, PetscLogDouble time, PetscLogDouble flops)
5189: {
5190:   PetscFE_OpenCL   *ocl = (PetscFE_OpenCL *) fem->data;
5191:   PetscStageLog     stageLog;
5192:   PetscEventPerfLog eventLog = NULL;
5193:   PetscInt          stage;
5194:   PetscErrorCode    ierr;

5197:   PetscLogGetStageLog(&stageLog);
5198:   PetscStageLogGetCurrent(stageLog, &stage);
5199:   PetscStageLogGetEventPerfLog(stageLog, stage, &eventLog);
5200:     /* Log performance info */
5201:   eventLog->eventInfo[ocl->residualEvent].count++;
5202:   eventLog->eventInfo[ocl->residualEvent].time  += time;
5203:   eventLog->eventInfo[ocl->residualEvent].flops += flops;
5204:   return(0);
5205: }

5209: PetscErrorCode PetscFEIntegrateResidual_OpenCL(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt field, PetscCellGeometry geom, const PetscScalar coefficients[],
5210:                                                PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
5211:                                                void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f0[]),
5212:                                                void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f1[]),
5213:                                                PetscScalar elemVec[])
5214: {
5215:   /* Nbc = batchSize */
5216:   PetscFE_OpenCL   *ocl = (PetscFE_OpenCL *) fem->data;
5217:   PetscQuadrature   q;
5218:   PetscInt          dim;
5219:   PetscInt          N_b;    /* The number of basis functions */
5220:   PetscInt          N_comp; /* The number of basis function components */
5221:   PetscInt          N_bt;   /* The total number of scalar basis functions */
5222:   PetscInt          N_q;    /* The number of quadrature points */
5223:   PetscInt          N_bst;  /* The block size, LCM(N_bt, N_q), Notice that a block is not process simultaneously */
5224:   PetscInt          N_t;    /* The number of threads, N_bst * N_bl */
5225:   PetscInt          N_bl;   /* The number of blocks */
5226:   PetscInt          N_bc;   /* The batch size, N_bl*N_q*N_b */
5227:   PetscInt          N_cb;   /* The number of batches */
5228:   PetscInt          numFlops, f0Flops, f1Flops;
5229:   PetscBool         useAux      = coefficientsAux ? PETSC_TRUE : PETSC_FALSE;
5230:   PetscBool         useField    = PETSC_FALSE;
5231:   PetscBool         useFieldDer = PETSC_TRUE;
5232:   PetscBool         useF0       = PETSC_TRUE;
5233:   PetscBool         useF1       = PETSC_TRUE;
5234:   /* OpenCL variables */
5235:   cl_program        ocl_prog;
5236:   cl_kernel         ocl_kernel;
5237:   cl_event          ocl_ev;         /* The event for tracking kernel execution */
5238:   cl_ulong          ns_start;       /* Nanoseconds counter on GPU at kernel start */
5239:   cl_ulong          ns_end;         /* Nanoseconds counter on GPU at kernel stop */
5240:   cl_mem            o_jacobianInverses, o_jacobianDeterminants;
5241:   cl_mem            o_coefficients, o_coefficientsAux, o_elemVec;
5242:   float            *f_coeff, *f_coeffAux, *f_invJ, *f_detJ;
5243:   double           *d_coeff, *d_coeffAux, *d_invJ, *d_detJ;
5244:   void             *oclCoeff, *oclCoeffAux, *oclInvJ, *oclDetJ;
5245:   size_t            local_work_size[3], global_work_size[3];
5246:   size_t            realSize, x, y, z;
5247:   PetscErrorCode    ierr;

5250:   if (!Ne) {PetscFEOpenCLLogResidual(fem, 0.0, 0.0); return(0);}
5251:   PetscFEGetSpatialDimension(fem, &dim);
5252:   PetscFEGetDimension(fem, &N_b);
5253:   PetscFEGetNumComponents(fem, &N_comp);
5254:   PetscFEGetQuadrature(fem, &q);
5255:   PetscFEGetTileSizes(fem, NULL, &N_bl, &N_bc, &N_cb);
5256:   N_bt  = N_b*N_comp;
5257:   N_q   = q->numPoints;
5258:   N_bst = N_bt*N_q;
5259:   N_t   = N_bst*N_bl;
5260:   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);
5261:   /* Calculate layout */
5262:   if (Ne % (N_cb*N_bc)) { /* Remainder cells */
5263:     PetscFEIntegrateResidual_Basic(fem, Ne, Nf, fe, field, geom, coefficients, NfAux, feAux, coefficientsAux, f0_func, f1_func, elemVec);
5264:     return(0);
5265:   }
5266:   PetscFEOpenCLCalculateGrid(fem, Ne, N_cb*N_bc, &x, &y, &z);
5267:   local_work_size[0]  = N_bc*N_comp;
5268:   local_work_size[1]  = 1;
5269:   local_work_size[2]  = 1;
5270:   global_work_size[0] = x * local_work_size[0];
5271:   global_work_size[1] = y * local_work_size[1];
5272:   global_work_size[2] = z * local_work_size[2];
5273:   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);
5274:   PetscInfo2(fem, " N_t: %d, N_cb: %d\n", N_t, N_cb);
5275:   /* Generate code */
5276:   if (NfAux) {
5277:     PetscSpace P;
5278:     PetscInt   order, f;

5280:     for (f = 0; f < NfAux; ++f) {
5281:       PetscFEGetBasisSpace(feAux[f], &P);
5282:       PetscSpaceGetOrder(P, &order);
5283:       if (order > 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Can only handle P0 coefficient fields");
5284:     }
5285:   }
5286:   PetscFEOpenCLGetIntegrationKernel(fem, useAux, &ocl_prog, &ocl_kernel);
5287:   /* Create buffers on the device and send data over */
5288:   PetscDataTypeGetSize(ocl->realType, &realSize);
5289:   if (sizeof(PetscReal) != realSize) {
5290:     switch (ocl->realType) {
5291:     case PETSC_FLOAT:
5292:     {
5293:       PetscInt c, b, d;

5295:       PetscMalloc4(Ne*N_bt,&f_coeff,Ne,&f_coeffAux,Ne*dim*dim,&f_invJ,Ne,&f_detJ);
5296:       for (c = 0; c < Ne; ++c) {
5297:         f_detJ[c] = (float) geom.detJ[c];
5298:         for (d = 0; d < dim*dim; ++d) {
5299:           f_invJ[c*dim*dim+d] = (float) geom.invJ[c*dim*dim+d];
5300:         }
5301:         for (b = 0; b < N_bt; ++b) {
5302:           f_coeff[c*N_bt+b] = (float) coefficients[c*N_bt+b];
5303:         }
5304:       }
5305:       if (coefficientsAux) { /* Assume P0 */
5306:         for (c = 0; c < Ne; ++c) {
5307:           f_coeffAux[c] = (float) coefficientsAux[c];
5308:         }
5309:       }
5310:       oclCoeff      = (void *) f_coeff;
5311:       if (coefficientsAux) {
5312:         oclCoeffAux = (void *) f_coeffAux;
5313:       } else {
5314:         oclCoeffAux = NULL;
5315:       }
5316:       oclInvJ       = (void *) f_invJ;
5317:       oclDetJ       = (void *) f_detJ;
5318:     }
5319:     break;
5320:     case PETSC_DOUBLE:
5321:     {
5322:       PetscInt c, b, d;

5324:       PetscMalloc4(Ne*N_bt,&d_coeff,Ne,&d_coeffAux,Ne*dim*dim,&d_invJ,Ne,&d_detJ);
5325:       for (c = 0; c < Ne; ++c) {
5326:         d_detJ[c] = (double) geom.detJ[c];
5327:         for (d = 0; d < dim*dim; ++d) {
5328:           d_invJ[c*dim*dim+d] = (double) geom.invJ[c*dim*dim+d];
5329:         }
5330:         for (b = 0; b < N_bt; ++b) {
5331:           d_coeff[c*N_bt+b] = (double) coefficients[c*N_bt+b];
5332:         }
5333:       }
5334:       if (coefficientsAux) { /* Assume P0 */
5335:         for (c = 0; c < Ne; ++c) {
5336:           d_coeffAux[c] = (double) coefficientsAux[c];
5337:         }
5338:       }
5339:       oclCoeff      = (void *) d_coeff;
5340:       if (coefficientsAux) {
5341:         oclCoeffAux = (void *) d_coeffAux;
5342:       } else {
5343:         oclCoeffAux = NULL;
5344:       }
5345:       oclInvJ       = (void *) d_invJ;
5346:       oclDetJ       = (void *) d_detJ;
5347:     }
5348:     break;
5349:     default:
5350:       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported PETSc type %d", ocl->realType);
5351:     }
5352:   } else {
5353:     oclCoeff    = (void *) coefficients;
5354:     oclCoeffAux = (void *) coefficientsAux;
5355:     oclInvJ     = (void *) geom.invJ;
5356:     oclDetJ     = (void *) geom.detJ;
5357:   }
5358:   o_coefficients         = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne*N_bt    * realSize, oclCoeff,    &ierr);
5359:   if (coefficientsAux) {
5360:     o_coefficientsAux    = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne         * realSize, oclCoeffAux, &ierr);
5361:   } else {
5362:     o_coefficientsAux    = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY,                        Ne         * realSize, oclCoeffAux, &ierr);
5363:   }
5364:   o_jacobianInverses     = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne*dim*dim * realSize, oclInvJ,     &ierr);
5365:   o_jacobianDeterminants = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne         * realSize, oclDetJ,     &ierr);
5366:   o_elemVec              = clCreateBuffer(ocl->ctx_id, CL_MEM_WRITE_ONLY,                       Ne*N_bt    * realSize, NULL,        &ierr);
5367:   /* Kernel launch */
5368:   clSetKernelArg(ocl_kernel, 0, sizeof(cl_int), (void*) &N_cb);
5369:   clSetKernelArg(ocl_kernel, 1, sizeof(cl_mem), (void*) &o_coefficients);
5370:   clSetKernelArg(ocl_kernel, 2, sizeof(cl_mem), (void*) &o_coefficientsAux);
5371:   clSetKernelArg(ocl_kernel, 3, sizeof(cl_mem), (void*) &o_jacobianInverses);
5372:   clSetKernelArg(ocl_kernel, 4, sizeof(cl_mem), (void*) &o_jacobianDeterminants);
5373:   clSetKernelArg(ocl_kernel, 5, sizeof(cl_mem), (void*) &o_elemVec);
5374:   clEnqueueNDRangeKernel(ocl->queue_id, ocl_kernel, 3, NULL, global_work_size, local_work_size, 0, NULL, &ocl_ev);
5375:   /* Read data back from device */
5376:   if (sizeof(PetscReal) != realSize) {
5377:     switch (ocl->realType) {
5378:     case PETSC_FLOAT:
5379:     {
5380:       float   *elem;
5381:       PetscInt c, b;

5383:       PetscFree4(f_coeff,f_coeffAux,f_invJ,f_detJ);
5384:       PetscMalloc1(Ne*N_bt, &elem);
5385:       clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elem, 0, NULL, NULL);
5386:       for (c = 0; c < Ne; ++c) {
5387:         for (b = 0; b < N_bt; ++b) {
5388:           elemVec[c*N_bt+b] = (PetscScalar) elem[c*N_bt+b];
5389:         }
5390:       }
5391:       PetscFree(elem);
5392:     }
5393:     break;
5394:     case PETSC_DOUBLE:
5395:     {
5396:       double  *elem;
5397:       PetscInt c, b;

5399:       PetscFree4(d_coeff,d_coeffAux,d_invJ,d_detJ);
5400:       PetscMalloc1(Ne*N_bt, &elem);
5401:       clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elem, 0, NULL, NULL);
5402:       for (c = 0; c < Ne; ++c) {
5403:         for (b = 0; b < N_bt; ++b) {
5404:           elemVec[c*N_bt+b] = (PetscScalar) elem[c*N_bt+b];
5405:         }
5406:       }
5407:       PetscFree(elem);
5408:     }
5409:     break;
5410:     default:
5411:       SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported PETSc type %d", ocl->realType);
5412:     }
5413:   } else {
5414:     clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elemVec, 0, NULL, NULL);
5415:   }
5416:   /* Log performance */
5417:   clGetEventProfilingInfo(ocl_ev, CL_PROFILING_COMMAND_START, sizeof(cl_ulong), &ns_start, NULL);
5418:   clGetEventProfilingInfo(ocl_ev, CL_PROFILING_COMMAND_END,   sizeof(cl_ulong), &ns_end,   NULL);
5419:   f0Flops = 0;
5420:   switch (ocl->op) {
5421:   case LAPLACIAN:
5422:     f1Flops = useAux ? dim : 0;break;
5423:   case ELASTICITY:
5424:     f1Flops = 2*dim*dim;break;
5425:   }
5426:   numFlops = Ne*(
5427:     N_q*(
5428:       N_b*N_comp*((useField ? 2 : 0) + (useFieldDer ? 2*dim*(dim + 1) : 0))
5429:       /*+
5430:        N_ba*N_compa*((useFieldAux ? 2 : 0) + (useFieldDerAux ? 2*dim*(dim + 1) : 0))*/
5431:       +
5432:       N_comp*((useF0 ? f0Flops + 2 : 0) + (useF1 ? f1Flops + 2*dim : 0)))
5433:     +
5434:     N_b*((useF0 ? 2 : 0) + (useF1 ? 2*dim*(dim + 1) : 0)));
5435:   PetscFEOpenCLLogResidual(fem, (ns_end - ns_start)*1.0e-9, numFlops);
5436:   /* Cleanup */
5437:   clReleaseMemObject(o_coefficients);
5438:   clReleaseMemObject(o_coefficientsAux);
5439:   clReleaseMemObject(o_jacobianInverses);
5440:   clReleaseMemObject(o_jacobianDeterminants);
5441:   clReleaseMemObject(o_elemVec);
5442:   clReleaseKernel(ocl_kernel);
5443:   clReleaseProgram(ocl_prog);
5444:   return(0);
5445: }

5449: PetscErrorCode PetscFEInitialize_OpenCL(PetscFE fem)
5450: {
5452:   fem->ops->setfromoptions          = NULL;
5453:   fem->ops->setup                   = PetscFESetUp_Basic;
5454:   fem->ops->view                    = NULL;
5455:   fem->ops->destroy                 = PetscFEDestroy_OpenCL;
5456:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
5457:   fem->ops->gettabulation           = PetscFEGetTabulation_Basic;
5458:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_OpenCL;
5459:   fem->ops->integratebdresidual     = NULL/* PetscFEIntegrateBdResidual_OpenCL */;
5460:   fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_OpenCL */;
5461:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
5462:   return(0);
5463: }

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

5468:   Level: intermediate

5470: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
5471: M*/

5475: PETSC_EXTERN PetscErrorCode PetscFECreate_OpenCL(PetscFE fem)
5476: {
5477:   PetscFE_OpenCL *ocl;
5478:   cl_uint         num_platforms;
5479:   cl_platform_id  platform_ids[42];
5480:   cl_uint         num_devices;
5481:   cl_device_id    device_ids[42];
5482:   cl_int          ierr2;
5483:   PetscErrorCode  ierr;

5487:   PetscNewLog(fem,&ocl);
5488:   fem->data = ocl;

5490:   /* Init Platform */
5491:   clGetPlatformIDs(42, platform_ids, &num_platforms);
5492:   if (!num_platforms) SETERRQ(PetscObjectComm((PetscObject) fem), PETSC_ERR_SUP, "No OpenCL platform found.");
5493:   ocl->pf_id = platform_ids[0];
5494:   /* Init Device */
5495:   clGetDeviceIDs(ocl->pf_id, CL_DEVICE_TYPE_ALL, 42, device_ids, &num_devices);
5496:   if (!num_devices) SETERRQ(PetscObjectComm((PetscObject) fem), PETSC_ERR_SUP, "No OpenCL device found.");
5497:   ocl->dev_id = device_ids[0];
5498:   /* Create context with one command queue */
5499:   ocl->ctx_id   = clCreateContext(0, 1, &(ocl->dev_id), NULL, NULL, &ierr2);CHKERRQ(ierr2);
5500:   ocl->queue_id = clCreateCommandQueue(ocl->ctx_id, ocl->dev_id, CL_QUEUE_PROFILING_ENABLE, &ierr2);CHKERRQ(ierr2);
5501:   /* Types */
5502:   ocl->realType = PETSC_FLOAT;
5503:   /* Register events */
5504:   PetscLogEventRegister("OpenCL FEResidual", PETSCFE_CLASSID, &ocl->residualEvent);
5505:   /* Equation handling */
5506:   ocl->op = LAPLACIAN;

5508:   PetscFEInitialize_OpenCL(fem);
5509:   return(0);
5510: }

5514: PetscErrorCode PetscFEOpenCLSetRealType(PetscFE fem, PetscDataType realType)
5515: {
5516:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;

5520:   ocl->realType = realType;
5521:   return(0);
5522: }

5526: PetscErrorCode PetscFEOpenCLGetRealType(PetscFE fem, PetscDataType *realType)
5527: {
5528:   PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;

5533:   *realType = ocl->realType;
5534:   return(0);
5535: }

5537: #endif /* PETSC_HAVE_OPENCL */

5541: PetscErrorCode PetscFEDestroy_Composite(PetscFE fem)
5542: {
5543:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
5544:   PetscErrorCode     ierr;

5547:   CellRefinerRestoreAffineTransforms_Internal(cmp->cellRefiner, &cmp->numSubelements, &cmp->v0, &cmp->jac, &cmp->invjac);
5548:   PetscFree(cmp->embedding);
5549:   PetscFree(cmp);
5550:   return(0);
5551: }

5555: PetscErrorCode PetscFESetUp_Composite(PetscFE fem)
5556: {
5557:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
5558:   DM                 K;
5559:   PetscReal         *work, *subpoint;
5560:   PetscBLASInt      *pivots;
5561: #ifndef PETSC_USE_COMPLEX
5562:   PetscBLASInt       n, info;
5563: #endif
5564:   PetscInt           dim, pdim, spdim, j, s;
5565:   PetscErrorCode     ierr;

5568:   /* Get affine mapping from reference cell to each subcell */
5569:   PetscDualSpaceGetDM(fem->dualSpace, &K);
5570:   DMPlexGetDimension(K, &dim);
5571:   DMPlexGetCellRefiner_Internal(K, &cmp->cellRefiner);
5572:   CellRefinerGetAffineTransforms_Internal(cmp->cellRefiner, &cmp->numSubelements, &cmp->v0, &cmp->jac, &cmp->invjac);
5573:   /* Determine dof embedding into subelements */
5574:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
5575:   PetscSpaceGetDimension(fem->basisSpace, &spdim);
5576:   PetscMalloc1(cmp->numSubelements*spdim,&cmp->embedding);
5577:   DMGetWorkArray(K, dim, PETSC_REAL, &subpoint);
5578:   for (s = 0; s < cmp->numSubelements; ++s) {
5579:     PetscInt sd = 0;

5581:     for (j = 0; j < pdim; ++j) {
5582:       PetscBool       inside = PETSC_TRUE;
5583:       PetscReal       sum    = 0.0;
5584:       PetscQuadrature f;
5585:       PetscInt        d, e;

5587:       PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);
5588:       /* Apply transform to first point, and check that point is inside subcell */
5589:       for (d = 0; d < dim; ++d) {
5590:         subpoint[d] = -1.0;
5591:         for (e = 0; e < dim; ++e) {
5592:           subpoint[d] += cmp->invjac[(s*dim + d)*dim+e]*(f->points[e] - cmp->v0[s*dim+e]);
5593:         }
5594:         if (subpoint[d] < -1.0) {inside = PETSC_FALSE; break;}
5595:         sum += subpoint[d];
5596:       }
5597:       if (inside && (sum <= 0.0)) {cmp->embedding[s*spdim+sd++] = j;}
5598:     }
5599:     if (sd != spdim) SETERRQ3(PetscObjectComm((PetscObject) fem), PETSC_ERR_PLIB, "Subelement %d has %d dual basis vectors != %d", s, sd, spdim);
5600:   }
5601:   DMRestoreWorkArray(K, dim, PETSC_REAL, &subpoint);
5602:   /* Construct the change of basis from prime basis to nodal basis for each subelement */
5603:   PetscMalloc1(cmp->numSubelements*spdim*spdim,&fem->invV);
5604:   PetscMalloc2(spdim,&pivots,spdim,&work);
5605:   for (s = 0; s < cmp->numSubelements; ++s) {
5606:     for (j = 0; j < spdim; ++j) {
5607:       PetscReal      *Bf;
5608:       PetscQuadrature f;
5609:       PetscInt        q, k;

5611:       PetscDualSpaceGetFunctional(fem->dualSpace, cmp->embedding[s*spdim+j], &f);
5612:       PetscMalloc1(f->numPoints*spdim,&Bf);
5613:       PetscSpaceEvaluate(fem->basisSpace, f->numPoints, f->points, Bf, NULL, NULL);
5614:       for (k = 0; k < spdim; ++k) {
5615:         /* n_j \cdot \phi_k */
5616:         fem->invV[(s*spdim + j)*spdim+k] = 0.0;
5617:         for (q = 0; q < f->numPoints; ++q) {
5618:           fem->invV[(s*spdim + j)*spdim+k] += Bf[q*spdim+k]*f->weights[q];
5619:         }
5620:       }
5621:       PetscFree(Bf);
5622:     }
5623: #ifndef PETSC_USE_COMPLEX
5624:     n = spdim;
5625:     PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, &fem->invV[s*spdim*spdim], &n, pivots, &info));
5626:     PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, &fem->invV[s*spdim*spdim], &n, pivots, work, &n, &info));
5627: #endif
5628:   }
5629:   PetscFree2(pivots,work);
5630:   return(0);
5631: }

5635: PetscErrorCode PetscFEGetTabulation_Composite(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H)
5636: {
5637:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
5638:   DM                 dm;
5639:   PetscInt           pdim;  /* Dimension of FE space P */
5640:   PetscInt           spdim; /* Dimension of subelement FE space P */
5641:   PetscInt           dim;   /* Spatial dimension */
5642:   PetscInt           comp;  /* Field components */
5643:   PetscInt          *subpoints;
5644:   PetscReal         *tmpB, *tmpD, *tmpH, *subpoint;
5645:   PetscInt           p, s, d, e, j, k;
5646:   PetscErrorCode     ierr;

5649:   PetscDualSpaceGetDM(fem->dualSpace, &dm);
5650:   DMPlexGetDimension(dm, &dim);
5651:   PetscSpaceGetDimension(fem->basisSpace, &spdim);
5652:   PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
5653:   PetscFEGetNumComponents(fem, &comp);
5654:   /* Divide points into subelements */
5655:   DMGetWorkArray(dm, npoints, PETSC_INT, &subpoints);
5656:   DMGetWorkArray(dm, dim, PETSC_REAL, &subpoint);
5657:   for (p = 0; p < npoints; ++p) {
5658:     for (s = 0; s < cmp->numSubelements; ++s) {
5659:       PetscBool inside = PETSC_TRUE;
5660:       PetscReal sum    = 0.0;

5662:       /* Apply transform, and check that point is inside cell */
5663:       for (d = 0; d < dim; ++d) {
5664:         subpoint[d] = -1.0;
5665:         for (e = 0; e < dim; ++e) {
5666:           subpoint[d] += cmp->invjac[(s*dim + d)*dim+e]*(points[p*dim+e] - cmp->v0[s*dim+e]);
5667:         }
5668:         if (subpoint[d] < -1.0) {inside = PETSC_FALSE; break;}
5669:         sum += subpoint[d];
5670:       }
5671:       if (inside && (sum <= 0.0)) {subpoints[p] = s; break;}
5672:     }
5673:     if (s >= cmp->numSubelements) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %d was not found in any subelement", p);
5674:   }
5675:   DMRestoreWorkArray(dm, dim, PETSC_REAL, &subpoint);
5676:   /* Evaluate the prime basis functions at all points */
5677:   if (B) {DMGetWorkArray(dm, npoints*spdim, PETSC_REAL, &tmpB);}
5678:   if (D) {DMGetWorkArray(dm, npoints*spdim*dim, PETSC_REAL, &tmpD);}
5679:   if (H) {DMGetWorkArray(dm, npoints*spdim*dim*dim, PETSC_REAL, &tmpH);}
5680:   PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);
5681:   /* Translate to the nodal basis */
5682:   if (B) {PetscMemzero(B, npoints*pdim*comp * sizeof(PetscReal));}
5683:   if (D) {PetscMemzero(D, npoints*pdim*comp*dim * sizeof(PetscReal));}
5684:   if (H) {PetscMemzero(H, npoints*pdim*comp*dim*dim * sizeof(PetscReal));}
5685:   for (p = 0; p < npoints; ++p) {
5686:     const PetscInt s = subpoints[p];

5688:     if (B) {
5689:       /* Multiply by V^{-1} (spdim x spdim) */
5690:       for (j = 0; j < spdim; ++j) {
5691:         const PetscInt i = (p*pdim + cmp->embedding[s*spdim+j])*comp;
5692:         PetscInt       c;

5694:         B[i] = 0.0;
5695:         for (k = 0; k < spdim; ++k) {
5696:           B[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpB[p*spdim + k];
5697:         }
5698:         for (c = 1; c < comp; ++c) {
5699:           B[i+c] = B[i];
5700:         }
5701:       }
5702:     }
5703:     if (D) {
5704:       /* Multiply by V^{-1} (spdim x spdim) */
5705:       for (j = 0; j < spdim; ++j) {
5706:         for (d = 0; d < dim; ++d) {
5707:           const PetscInt i = ((p*pdim + cmp->embedding[s*spdim+j])*comp + 0)*dim + d;
5708:           PetscInt       c;

5710:           D[i] = 0.0;
5711:           for (k = 0; k < spdim; ++k) {
5712:             D[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpD[(p*spdim + k)*dim + d];
5713:           }
5714:           for (c = 1; c < comp; ++c) {
5715:             D[((p*pdim + cmp->embedding[s*spdim+j])*comp + c)*dim + d] = D[i];
5716:           }
5717:         }
5718:       }
5719:     }
5720:     if (H) {
5721:       /* Multiply by V^{-1} (pdim x pdim) */
5722:       for (j = 0; j < spdim; ++j) {
5723:         for (d = 0; d < dim*dim; ++d) {
5724:           const PetscInt i = ((p*pdim + cmp->embedding[s*spdim+j])*comp + 0)*dim*dim + d;
5725:           PetscInt       c;

5727:           H[i] = 0.0;
5728:           for (k = 0; k < spdim; ++k) {
5729:             H[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpH[(p*spdim + k)*dim*dim + d];
5730:           }
5731:           for (c = 1; c < comp; ++c) {
5732:             H[((p*pdim + cmp->embedding[s*spdim+j])*comp + c)*dim*dim + d] = H[i];
5733:           }
5734:         }
5735:       }
5736:     }
5737:   }
5738:   DMRestoreWorkArray(dm, npoints, PETSC_INT, &subpoints);
5739:   if (B) {DMRestoreWorkArray(dm, npoints*spdim, PETSC_REAL, &tmpB);}
5740:   if (D) {DMRestoreWorkArray(dm, npoints*spdim*dim, PETSC_REAL, &tmpD);}
5741:   if (H) {DMRestoreWorkArray(dm, npoints*spdim*dim*dim, PETSC_REAL, &tmpH);}
5742:   return(0);
5743: }

5747: PetscErrorCode PetscFEInitialize_Composite(PetscFE fem)
5748: {
5750:   fem->ops->setfromoptions          = NULL;
5751:   fem->ops->setup                   = PetscFESetUp_Composite;
5752:   fem->ops->view                    = NULL;
5753:   fem->ops->destroy                 = PetscFEDestroy_Composite;
5754:   fem->ops->getdimension            = PetscFEGetDimension_Basic;
5755:   fem->ops->gettabulation           = PetscFEGetTabulation_Composite;
5756:   fem->ops->integrateresidual       = PetscFEIntegrateResidual_Basic;
5757:   fem->ops->integratebdresidual     = PetscFEIntegrateBdResidual_Basic;
5758:   fem->ops->integratejacobianaction = NULL/*PetscFEIntegrateJacobianAction_Basic*/;
5759:   fem->ops->integratejacobian       = PetscFEIntegrateJacobian_Basic;
5760:   return(0);
5761: }

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

5766:   Level: intermediate

5768: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
5769: M*/

5773: PETSC_EXTERN PetscErrorCode PetscFECreate_Composite(PetscFE fem)
5774: {
5775:   PetscFE_Composite *cmp;
5776:   PetscErrorCode     ierr;

5780:   PetscNewLog(fem, &cmp);
5781:   fem->data = cmp;

5783:   cmp->cellRefiner    = 0;
5784:   cmp->numSubelements = -1;
5785:   cmp->v0             = NULL;
5786:   cmp->jac            = NULL;

5788:   PetscFEInitialize_Composite(fem);
5789:   return(0);
5790: }

5794: PetscErrorCode PetscFECompositeExpandQuadrature(PetscFE fem, PetscQuadrature q, PetscQuadrature *qref)
5795: {
5796:   PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
5797:   const PetscReal   *points,    *weights;
5798:   PetscReal         *pointsRef, *weightsRef;
5799:   PetscInt           dim, npoints, npointsRef, c, p, d, e;
5800:   PetscErrorCode     ierr;

5806:   PetscQuadratureCreate(PETSC_COMM_SELF, qref);
5807:   PetscQuadratureGetData(q, &dim, &npoints, &points, &weights);
5808:   npointsRef = npoints*cmp->numSubelements;
5809:   PetscMalloc1(npointsRef*dim,&pointsRef);
5810:   PetscMalloc1(npointsRef,&weightsRef);
5811:   for (c = 0; c < cmp->numSubelements; ++c) {
5812:     for (p = 0; p < npoints; ++p) {
5813:       for (d = 0; d < dim; ++d) {
5814:         pointsRef[(c*npoints + p)*dim+d] = cmp->v0[c*dim+d];
5815:         for (e = 0; e < dim; ++e) {
5816:           pointsRef[(c*npoints + p)*dim+d] += cmp->jac[(c*dim + d)*dim+e]*(points[p*dim+e] + 1.0);
5817:         }
5818:       }
5819:       /* Could also use detJ here */
5820:       weightsRef[c*npoints+p] = weights[p]/cmp->numSubelements;
5821:     }
5822:   }
5823:   PetscQuadratureSetData(*qref, dim, npointsRef, pointsRef, weightsRef);
5824:   return(0);
5825: }

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

5832:   Not collective

5834:   Input Parameter:
5835: . fe - The PetscFE

5837:   Output Parameter:
5838: . dim - The dimension

5840:   Level: intermediate

5842: .seealso: PetscFECreate(), PetscSpaceGetDimension(), PetscDualSpaceGetDimension()
5843: @*/
5844: PetscErrorCode PetscFEGetDimension(PetscFE fem, PetscInt *dim)
5845: {

5851:   if (fem->ops->getdimension) {(*fem->ops->getdimension)(fem, dim);}
5852:   return(0);
5853: }

5855: /*
5856: Purpose: Compute element vector for chunk of elements

5858: Input:
5859:   Sizes:
5860:      Ne:  number of elements
5861:      Nf:  number of fields
5862:      PetscFE
5863:        dim: spatial dimension
5864:        Nb:  number of basis functions
5865:        Nc:  number of field components
5866:        PetscQuadrature
5867:          Nq:  number of quadrature points

5869:   Geometry:
5870:      PetscCellGeometry
5871:        PetscReal v0s[Ne*dim]
5872:        PetscReal jacobians[Ne*dim*dim]        possibly *Nq
5873:        PetscReal jacobianInverses[Ne*dim*dim] possibly *Nq
5874:        PetscReal jacobianDeterminants[Ne]     possibly *Nq
5875:   FEM:
5876:      PetscFE
5877:        PetscQuadrature
5878:          PetscReal   quadPoints[Nq*dim]
5879:          PetscReal   quadWeights[Nq]
5880:        PetscReal   basis[Nq*Nb*Nc]
5881:        PetscReal   basisDer[Nq*Nb*Nc*dim]
5882:      PetscScalar coefficients[Ne*Nb*Nc]
5883:      PetscScalar elemVec[Ne*Nb*Nc]

5885:   Problem:
5886:      PetscInt f: the active field
5887:      f0, f1

5889:   Work Space:
5890:      PetscFE
5891:        PetscScalar f0[Nq*dim];
5892:        PetscScalar f1[Nq*dim*dim];
5893:        PetscScalar u[Nc];
5894:        PetscScalar gradU[Nc*dim];
5895:        PetscReal   x[dim];
5896:        PetscScalar realSpaceDer[dim];

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

5900: Input:
5901:   Sizes:
5902:      N_cb: Number of serial cell batches

5904:   Geometry:
5905:      PetscReal v0s[Ne*dim]
5906:      PetscReal jacobians[Ne*dim*dim]        possibly *Nq
5907:      PetscReal jacobianInverses[Ne*dim*dim] possibly *Nq
5908:      PetscReal jacobianDeterminants[Ne]     possibly *Nq
5909:   FEM:
5910:      static PetscReal   quadPoints[Nq*dim]
5911:      static PetscReal   quadWeights[Nq]
5912:      static PetscReal   basis[Nq*Nb*Nc]
5913:      static PetscReal   basisDer[Nq*Nb*Nc*dim]
5914:      PetscScalar coefficients[Ne*Nb*Nc]
5915:      PetscScalar elemVec[Ne*Nb*Nc]

5917: ex62.c:
5918:   PetscErrorCode PetscFEIntegrateResidualBatch(PetscInt Ne, PetscInt numFields, PetscInt field, PetscQuadrature quad[], const PetscScalar coefficients[],
5919:                                                const PetscReal v0s[], const PetscReal jacobians[], const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[],
5920:                                                void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f0[]),
5921:                                                void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f1[]), PetscScalar elemVec[])

5923: ex52.c:
5924:   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)
5925:   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)

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

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

5934: ex52_integrateElementOpenCL.c:
5935: PETSC_EXTERN PetscErrorCode IntegrateElementBatchGPU(PetscInt spatial_dim, PetscInt Ne, PetscInt Ncb, PetscInt Nbc, PetscInt N_bl, const PetscScalar coefficients[],
5936:                                                      const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscScalar elemVec[],
5937:                                                      PetscLogEvent event, PetscInt debug, PetscInt pde_op)

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

5944: /*C
5945:   PetscFEIntegrateResidual - Produce the element residual vector for a chunk of elements by quadrature integration

5947:   Not collective

5949:   Input Parameters:
5950: + fem          - The PetscFE object for the field being integrated
5951: . Ne           - The number of elements in the chunk
5952: . Nf           - The number of physical fields
5953: . fe           - The PetscFE objects for each field
5954: . field        - The field being integrated
5955: . geom         - The cell geometry for each cell in the chunk
5956: . coefficients - The array of FEM basis coefficients for the elements
5957: . NfAux        - The number of auxiliary physical fields
5958: . feAux        - The PetscFE objects for each auxiliary field
5959: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
5960: . f0_func      - f_0 function from the first order FEM model
5961: - f1_func      - f_1 function from the first order FEM model

5963:   Output Parameter
5964: . elemVec      - the element residual vectors from each element

5966:    Calling sequence of f0_func and f1_func:
5967: $    void f0(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f0[])

5969:   Note:
5970: $ Loop over batch of elements (e):
5971: $   Loop over quadrature points (q):
5972: $     Make u_q and gradU_q (loops over fields,Nb,Ncomp) and x_q
5973: $     Call f_0 and f_1
5974: $   Loop over element vector entries (f,fc --> i):
5975: $     elemVec[i] += \psi^{fc}_f(q) f0_{fc}(u, \nabla u) + \nabla\psi^{fc}_f(q) \cdot f1_{fc,df}(u, \nabla u)
5976: */
5977: PetscErrorCode PetscFEIntegrateResidual(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt field, PetscCellGeometry geom, const PetscScalar coefficients[],
5978:                                         PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
5979:                                         void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f0[]),
5980:                                         void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f1[]),
5981:                                         PetscScalar elemVec[])
5982: {

5987:   if (fem->ops->integrateresidual) {(*fem->ops->integrateresidual)(fem, Ne, Nf, fe, field, geom, coefficients, NfAux, feAux, coefficientsAux, f0_func, f1_func, elemVec);}
5988:   return(0);
5989: }

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

5996:   Not collective

5998:   Input Parameters:
5999: + fem          - The PetscFE object for the field being integrated
6000: . Ne           - The number of elements in the chunk
6001: . Nf           - The number of physical fields
6002: . fe           - The PetscFE objects for each field
6003: . field        - The field being integrated
6004: . geom         - The cell geometry for each cell in the chunk
6005: . coefficients - The array of FEM basis coefficients for the elements
6006: . NfAux        - The number of auxiliary physical fields
6007: . feAux        - The PetscFE objects for each auxiliary field
6008: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6009: . f0_func      - f_0 function from the first order FEM model
6010: - f1_func      - f_1 function from the first order FEM model

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

6015:    Calling sequence of f0_func and f1_func:
6016: $    void f0(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar f0[])

6018:   Note:
6019: $ Loop over batch of elements (e):
6020: $   Loop over quadrature points (q):
6021: $     Make u_q and gradU_q (loops over fields,Nb,Ncomp) and x_q
6022: $     Call f_0 and f_1
6023: $   Loop over element vector entries (f,fc --> i):
6024: $     elemVec[i] += \psi^{fc}_f(q) f0_{fc}(u, \nabla u) + \nabla\psi^{fc}_f(q) \cdot f1_{fc,df}(u, \nabla u)
6025: */
6026: PetscErrorCode PetscFEIntegrateBdResidual(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt field, PetscCellGeometry geom, const PetscScalar coefficients[],
6027:                                           PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
6028:                                           void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar f0[]),
6029:                                           void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar f1[]),
6030:                                           PetscScalar elemVec[])
6031: {

6036:   if (fem->ops->integratebdresidual) {(*fem->ops->integratebdresidual)(fem, Ne, Nf, fe, field, geom, coefficients, NfAux, feAux, coefficientsAux, f0_func, f1_func, elemVec);}
6037:   return(0);
6038: }

6042: /*C
6043:   PetscFEIntegrateJacobianAction - Produce the action of the element Jacobian on an element vector for a chunk of elements by quadrature integration

6045:   Not collective

6047:   Input Parameters:
6048: + fem          = The PetscFE object for the field being integrated
6049: . Ne           - The number of elements in the chunk
6050: . Nf           - The number of physical fields
6051: . fe           - The PetscFE objects for each field
6052: . field        - The test field being integrated
6053: . geom         - The cell geometry for each cell in the chunk
6054: . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
6055: . input        - The array of FEM basis coefficients for the elements for the input vector
6056: . g0_func      - g_0 function from the first order FEM model
6057: . g1_func      - g_1 function from the first order FEM model
6058: . g2_func      - g_2 function from the first order FEM model
6059: - g3_func      - g_3 function from the first order FEM model

6061:   Output Parameter
6062: . elemVec      - the element vector for the action from each element

6064:    Calling sequence of g0_func, g1_func, g2_func and g3_func:
6065: $    void g0(PetscScalar u[], const PetscScalar gradU[], PetscScalar a[], const PetscScalar gradA[], PetscScalar x[], PetscScalar g0[])

6067:   Note:
6068: $ Loop over batch of elements (e):
6069: $   Loop over element matrix entries (f,fc,g,gc --> i,j):
6070: $     Loop over quadrature points (q):
6071: $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
6072: $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
6073: $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6074: $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
6075: $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6076: */
6077: PetscErrorCode PetscFEIntegrateJacobianAction(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt field, PetscCellGeometry geom, const PetscScalar coefficients[], const PetscScalar input[],
6078:                                               void (**g0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g0[]),
6079:                                               void (**g1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g1[]),
6080:                                               void (**g2_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g2[]),
6081:                                               void (**g3_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g3[]),
6082:                                               PetscScalar elemVec[])
6083: {

6088:   if (fem->ops->integratejacobianaction) {(*fem->ops->integratejacobianaction)(fem, Ne, Nf, fe, field, geom, coefficients, input, g0_func, g1_func, g2_func, g3_func, elemVec);}
6089:   return(0);
6090: }

6094: /*C
6095:   PetscFEIntegrateJacobian - Produce the element Jacobian for a chunk of elements by quadrature integration

6097:   Not collective

6099:   Input Parameters:
6100: + fem          = The PetscFE object for the field being integrated
6101: . Ne           - The number of elements in the chunk
6102: . Nf           - The number of physical fields
6103: . fe           - The PetscFE objects for each field
6104: . fieldI       - The test field being integrated
6105: . fieldJ       - The basis field being integrated
6106: . geom         - The cell geometry for each cell in the chunk
6107: . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
6108: . NfAux        - The number of auxiliary physical fields
6109: . feAux        - The PetscFE objects for each auxiliary field
6110: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6111: . g0_func      - g_0 function from the first order FEM model
6112: . g1_func      - g_1 function from the first order FEM model
6113: . g2_func      - g_2 function from the first order FEM model
6114: - g3_func      - g_3 function from the first order FEM model

6116:   Output Parameter
6117: . elemMat              - the element matrices for the Jacobian from each element

6119:    Calling sequence of g0_func, g1_func, g2_func and g3_func:
6120: $    void g0(PetscScalar u[], const PetscScalar gradU[], PetscScalar a[], const PetscScalar gradA[], PetscScalar x[], PetscScalar g0[])

6122:   Note:
6123: $ Loop over batch of elements (e):
6124: $   Loop over element matrix entries (f,fc,g,gc --> i,j):
6125: $     Loop over quadrature points (q):
6126: $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
6127: $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
6128: $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6129: $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
6130: $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6131: */
6132: PetscErrorCode PetscFEIntegrateJacobian(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt fieldI, PetscInt fieldJ, PetscCellGeometry geom, const PetscScalar coefficients[],
6133:                                         PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
6134:                                         void (*g0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g0[]),
6135:                                         void (*g1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g1[]),
6136:                                         void (*g2_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g2[]),
6137:                                         void (*g3_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar g3[]),
6138:                                         PetscScalar elemMat[])
6139: {

6144:   if (fem->ops->integratejacobian) {(*fem->ops->integratejacobian)(fem, Ne, Nf, fe, fieldI, fieldJ, geom, coefficients, NfAux, feAux, coefficientsAux, g0_func, g1_func, g2_func, g3_func, elemMat);}
6145:   return(0);
6146: }

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

6153:   Not collective

6155:   Input Parameters:
6156: + fem          = The PetscFE object for the field being integrated
6157: . Ne           - The number of elements in the chunk
6158: . Nf           - The number of physical fields
6159: . fe           - The PetscFE objects for each field
6160: . fieldI       - The test field being integrated
6161: . fieldJ       - The basis field being integrated
6162: . geom         - The cell geometry for each cell in the chunk
6163: . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
6164: . NfAux        - The number of auxiliary physical fields
6165: . feAux        - The PetscFE objects for each auxiliary field
6166: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6167: . g0_func      - g_0 function from the first order FEM model
6168: . g1_func      - g_1 function from the first order FEM model
6169: . g2_func      - g_2 function from the first order FEM model
6170: - g3_func      - g_3 function from the first order FEM model

6172:   Output Parameter
6173: . elemMat              - the element matrices for the Jacobian from each element

6175:    Calling sequence of g0_func, g1_func, g2_func and g3_func:
6176: $    void g0(PetscScalar u[], const PetscScalar gradU[], PetscScalar a[], const PetscScalar gradA[], PetscScalar x[], PetscScalar g0[])

6178:   Note:
6179: $ Loop over batch of elements (e):
6180: $   Loop over element matrix entries (f,fc,g,gc --> i,j):
6181: $     Loop over quadrature points (q):
6182: $       Make u_q and gradU_q (loops over fields,Nb,Ncomp)
6183: $         elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
6184: $                      + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6185: $                      + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
6186: $                      + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6187: */
6188: PetscErrorCode PetscFEIntegrateBdJacobian(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt fieldI, PetscInt fieldJ, PetscCellGeometry geom, const PetscScalar coefficients[],
6189:                                           PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
6190:                                           void (*g0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar g0[]),
6191:                                           void (*g1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar g1[]),
6192:                                           void (*g2_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar g2[]),
6193:                                           void (*g3_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar g3[]),
6194:                                         PetscScalar elemMat[])
6195: {

6200:   if (fem->ops->integratebdjacobian) {(*fem->ops->integratebdjacobian)(fem, Ne, Nf, fe, fieldI, fieldJ, geom, coefficients, NfAux, feAux, coefficientsAux, g0_func, g1_func, g2_func, g3_func, elemMat);}
6201:   return(0);
6202: }

6206: /*C
6207:   PetscFEIntegrateIFunction - Produce the element residual vector for a chunk of elements by quadrature integration

6209:   Not collective

6211:   Input Parameters:
6212: + fem          - The PetscFE object for the field being integrated
6213: . Ne           - The number of elements in the chunk
6214: . Nf           - The number of physical fields
6215: . fe           - The PetscFE objects for each field
6216: . field        - The field being integrated
6217: . geom         - The cell geometry for each cell in the chunk
6218: . coefficients - The array of FEM basis coefficients for the elements
6219: . coefficients_t - The array of FEM time derivative basis coefficients for the elements
6220: . NfAux        - The number of auxiliary physical fields
6221: . feAux        - The PetscFE objects for each auxiliary field
6222: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6223: . f0_func      - f_0 function from the first order FEM model
6224: - f1_func      - f_1 function from the first order FEM model

6226:   Output Parameter
6227: . elemVec      - the element residual vectors from each element

6229:    Calling sequence of f0_func and f1_func:
6230: $    void f0(const PetscScalar u[], const PetscScalar u_t[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f0[])

6232:   Note:
6233: $ Loop over batch of elements (e):
6234: $   Loop over quadrature points (q):
6235: $     Make u_q and gradU_q (loops over fields,Nb,Ncomp) and x_q
6236: $     Call f_0 and f_1
6237: $   Loop over element vector entries (f,fc --> i):
6238: $     elemVec[i] += \psi^{fc}_f(q) f0_{fc}(u, \nabla u) + \nabla\psi^{fc}_f(q) \cdot f1_{fc,df}(u, \nabla u)
6239: */
6240: PetscErrorCode PetscFEIntegrateIFunction(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt field, PetscCellGeometry geom, const PetscScalar coefficients[], const PetscScalar coefficients_t[],
6241:                                         PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
6242:                                         void (*f0_func)(const PetscScalar u[], const PetscScalar u_t[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f0[]),
6243:                                         void (*f1_func)(const PetscScalar u[], const PetscScalar u_t[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], PetscScalar f1[]),
6244:                                         PetscScalar elemVec[])
6245: {

6250:   if (fem->ops->integrateifunction) {(*fem->ops->integrateifunction)(fem, Ne, Nf, fe, field, geom, coefficients, coefficients_t, NfAux, feAux, coefficientsAux, f0_func, f1_func, elemVec);}
6251:   return(0);
6252: }

6256: /*C
6257:   PetscFEIntegrateBdIFunction - Produce the element residual vector for a chunk of elements by quadrature integration over a boundary

6259:   Not collective

6261:   Input Parameters:
6262: + fem          - The PetscFE object for the field being integrated
6263: . Ne           - The number of elements in the chunk
6264: . Nf           - The number of physical fields
6265: . fe           - The PetscFE objects for each field
6266: . field        - The field being integrated
6267: . geom         - The cell geometry for each cell in the chunk
6268: . coefficients - The array of FEM basis coefficients for the elements
6269: . coefficients_t - The array of FEM time derivative basis coefficients for the elements
6270: . NfAux        - The number of auxiliary physical fields
6271: . feAux        - The PetscFE objects for each auxiliary field
6272: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6273: . f0_func      - f_0 function from the first order FEM model
6274: - f1_func      - f_1 function from the first order FEM model

6276:   Output Parameter
6277: . elemVec      - the element residual vectors from each element

6279:    Calling sequence of f0_func and f1_func:
6280: $    void f0(const PetscScalar u[], const PetscScalar u_t[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar f0[])

6282:   Note:
6283: $ Loop over batch of elements (e):
6284: $   Loop over quadrature points (q):
6285: $     Make u_q and gradU_q (loops over fields,Nb,Ncomp) and x_q
6286: $     Call f_0 and f_1
6287: $   Loop over element vector entries (f,fc --> i):
6288: $     elemVec[i] += \psi^{fc}_f(q) f0_{fc}(u, \nabla u) + \nabla\psi^{fc}_f(q) \cdot f1_{fc,df}(u, \nabla u)
6289: */
6290: PetscErrorCode PetscFEIntegrateBdIFunction(PetscFE fem, PetscInt Ne, PetscInt Nf, PetscFE fe[], PetscInt field, PetscCellGeometry geom, const PetscScalar coefficients[], const PetscScalar coefficients_t[],
6291:                                           PetscInt NfAux, PetscFE feAux[], const PetscScalar coefficientsAux[],
6292:                                           void (*f0_func)(const PetscScalar u[], const PetscScalar u_t[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar f0[]),
6293:                                           void (*f1_func)(const PetscScalar u[], const PetscScalar u_t[], const PetscScalar gradU[], const PetscScalar a[], const PetscScalar gradA[], const PetscReal x[], const PetscReal n[], PetscScalar f1[]),
6294:                                            PetscScalar elemVec[])
6295: {

6300:   if (fem->ops->integratebdifunction) {(*fem->ops->integratebdifunction)(fem, Ne, Nf, fe, field, geom, coefficients, coefficients_t, NfAux, feAux, coefficientsAux, f0_func, f1_func, elemVec);}
6301:   return(0);
6302: }

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

6311:   Input Parameter:
6312: . fe - The initial PetscFE

6314:   Output Parameter:
6315: . feRef - The refined PetscFE

6317:   Level: developer

6319: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
6320: @*/
6321: PetscErrorCode PetscFERefine(PetscFE fe, PetscFE *feRef)
6322: {
6323:   PetscSpaceType   tname;
6324:   PetscSpace       P, Pref;
6325:   PetscDualSpace   Q, Qref;
6326:   DM               K, Kref;
6327:   PetscQuadrature  q, qref;
6328:   PetscInt         dim, order, numComp;
6329:   PetscErrorCode   ierr;

6332:   PetscFEGetBasisSpace(fe, &P);
6333:   PetscFEGetDualSpace(fe, &Q);
6334:   PetscFEGetQuadrature(fe, &q);
6335:   PetscDualSpaceGetDM(Q, &K);
6336:   /* Create space */
6337:   PetscSpaceCreate(PetscObjectComm((PetscObject) fe), &Pref);
6338:   PetscObjectGetType((PetscObject) P, &tname);
6339:   PetscSpaceSetType(Pref, tname);
6340:   PetscSpacePolynomialGetNumVariables(P, &dim);
6341:   PetscSpacePolynomialSetNumVariables(Pref, dim);
6342:   PetscSpaceGetOrder(P,   &order);
6343:   PetscSpaceSetOrder(Pref, order);
6344:   PetscSpaceSetUp(Pref);
6345:   /* Create dual space */
6346:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) fe), &Qref);
6347:   PetscObjectGetType((PetscObject) Q, &tname);
6348:   PetscDualSpaceSetType(Qref, tname);
6349:   DMRefine(K, PetscObjectComm((PetscObject) fe), &Kref);
6350:   PetscDualSpaceSetDM(Qref, Kref);
6351:   DMDestroy(&Kref);
6352:   PetscDualSpaceGetOrder(Q,   &order);
6353:   PetscDualSpaceSetOrder(Qref, order);
6354:   PetscDualSpaceSetUp(Qref);
6355:   /* Create element */
6356:   PetscFECreate(PetscObjectComm((PetscObject) fe), feRef);
6357:   PetscFESetType(*feRef, PETSCFECOMPOSITE);
6358:   PetscFESetBasisSpace(*feRef, Pref);
6359:   PetscFESetDualSpace(*feRef, Qref);
6360:   PetscFEGetNumComponents(fe,    &numComp);
6361:   PetscFESetNumComponents(*feRef, numComp);
6362:   PetscFESetUp(*feRef);
6363:   PetscSpaceDestroy(&Pref);
6364:   PetscDualSpaceDestroy(&Qref);
6365:   /* Create quadrature */
6366:   PetscFECompositeExpandQuadrature(*feRef, q, &qref);
6367:   PetscFESetQuadrature(*feRef, qref);
6368:   PetscQuadratureDestroy(&qref);
6369:   return(0);
6370: }

6374: /*@
6375:   PetscFECreateDefault - Create a PetscFE for basic FEM computation

6377:   Collective on DM

6379:   Input Parameters:
6380: + dm        - The underlying DM for the domain
6381: . dim       - The spatial dimension
6382: . numComp   - The number of components
6383: . isSimplex - Flag for simplex reference cell, otherwise its a tensor product
6384: . prefix    - The options prefix, or NULL
6385: - qorder    - The quadrature order

6387:   Output Parameter:
6388: . fem - The PetscFE object

6390:   Level: beginner

6392: .keywords: PetscFE, finite element
6393: .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate()
6394: @*/
6395: PetscErrorCode PetscFECreateDefault(DM dm, PetscInt dim, PetscInt numComp, PetscBool isSimplex, const char prefix[], PetscInt qorder, PetscFE *fem)
6396: {
6397:   PetscQuadrature q;
6398:   DM              K;
6399:   PetscSpace      P;
6400:   PetscDualSpace  Q;
6401:   PetscInt        order;
6402:   PetscErrorCode  ierr;

6405:   /* Create space */
6406:   PetscSpaceCreate(PetscObjectComm((PetscObject) dm), &P);
6407:   PetscObjectSetOptionsPrefix((PetscObject) P, prefix);
6408:   PetscSpaceSetFromOptions(P);
6409:   PetscSpacePolynomialSetNumVariables(P, dim);
6410:   PetscSpacePolynomialSetTensor(P, !isSimplex ? PETSC_TRUE : PETSC_FALSE);
6411:   PetscSpaceSetUp(P);
6412:   PetscSpaceGetOrder(P, &order);
6413:   /* Create dual space */
6414:   PetscDualSpaceCreate(PetscObjectComm((PetscObject) dm), &Q);
6415:   PetscObjectSetOptionsPrefix((PetscObject) Q, prefix);
6416:   PetscDualSpaceCreateReferenceCell(Q, dim, isSimplex, &K);
6417:   PetscDualSpaceSetDM(Q, K);
6418:   DMDestroy(&K);
6419:   PetscDualSpaceSetOrder(Q, order);
6420:   PetscDualSpaceSetFromOptions(Q);
6421:   PetscDualSpaceSetUp(Q);
6422:   /* Create element */
6423:   PetscFECreate(PetscObjectComm((PetscObject) dm), fem);
6424:   PetscObjectSetOptionsPrefix((PetscObject) *fem, prefix);
6425:   PetscFESetFromOptions(*fem);
6426:   PetscFESetBasisSpace(*fem, P);
6427:   PetscFESetDualSpace(*fem, Q);
6428:   PetscFESetNumComponents(*fem, numComp);
6429:   PetscFESetUp(*fem);
6430:   PetscSpaceDestroy(&P);
6431:   PetscDualSpaceDestroy(&Q);
6432:   /* Create quadrature (with specified order if given) */
6433:   if (isSimplex) {PetscDTGaussJacobiQuadrature(dim, PetscMax(qorder > 0 ? qorder : order, 1), -1.0, 1.0, &q);}
6434:   else           {PetscDTGaussTensorQuadrature(dim, PetscMax(qorder > 0 ? qorder : order, 1), -1.0, 1.0, &q);}
6435:   PetscFESetQuadrature(*fem, q);
6436:   PetscQuadratureDestroy(&q);
6437:   return(0);
6438: }