Actual source code: dtfe.c
petsc-3.8.4 2018-03-24
1: /* Basis Jet Tabulation
3: We would like to tabulate the nodal basis functions and derivatives at a set of points, usually quadrature points. We
4: follow here the derviation in http://www.math.ttu.edu/~kirby/papers/fiat-toms-2004.pdf. The nodal basis $\psi_i$ can
5: be expressed in terms of a prime basis $\phi_i$ which can be stably evaluated. In PETSc, we will use the Legendre basis
6: as a prime basis.
8: \psi_i = \sum_k \alpha_{ki} \phi_k
10: Our nodal basis is defined in terms of the dual basis $n_j$
12: n_j \cdot \psi_i = \delta_{ji}
14: and we may act on the first equation to obtain
16: n_j \cdot \psi_i = \sum_k \alpha_{ki} n_j \cdot \phi_k
17: \delta_{ji} = \sum_k \alpha_{ki} V_{jk}
18: I = V \alpha
20: so the coefficients of the nodal basis in the prime basis are
22: \alpha = V^{-1}
24: We will define the dual basis vectors $n_j$ using a quadrature rule.
26: Right now, we will just use the polynomial spaces P^k. I know some elements use the space of symmetric polynomials
27: (I think Nedelec), but we will neglect this for now. Constraints in the space, e.g. Arnold-Winther elements, can
28: be implemented exactly as in FIAT using functionals $L_j$.
30: I will have to count the degrees correctly for the Legendre product when we are on simplices.
32: We will have three objects:
33: - Space, P: this just need point evaluation I think
34: - Dual Space, P'+K: This looks like a set of functionals that can act on members of P, each n is defined by a Q
35: - FEM: This keeps {P, P', Q}
36: */
37: #include <petsc/private/petscfeimpl.h>
38: #include <petsc/private/dtimpl.h>
39: #include <petsc/private/dmpleximpl.h>
40: #include <petscdmshell.h>
41: #include <petscdmplex.h>
42: #include <petscblaslapack.h>
44: PetscBool FEcite = PETSC_FALSE;
45: const char FECitation[] = "@article{kirby2004,\n"
46: " title = {Algorithm 839: FIAT, a New Paradigm for Computing Finite Element Basis Functions},\n"
47: " journal = {ACM Transactions on Mathematical Software},\n"
48: " author = {Robert C. Kirby},\n"
49: " volume = {30},\n"
50: " number = {4},\n"
51: " pages = {502--516},\n"
52: " doi = {10.1145/1039813.1039820},\n"
53: " year = {2004}\n}\n";
55: PetscClassId PETSCSPACE_CLASSID = 0;
57: PetscFunctionList PetscSpaceList = NULL;
58: PetscBool PetscSpaceRegisterAllCalled = PETSC_FALSE;
60: /*@C
61: PetscSpaceRegister - Adds a new PetscSpace implementation
63: Not Collective
65: Input Parameters:
66: + name - The name of a new user-defined creation routine
67: - create_func - The creation routine itself
69: Notes:
70: PetscSpaceRegister() may be called multiple times to add several user-defined PetscSpaces
72: Sample usage:
73: .vb
74: PetscSpaceRegister("my_space", MyPetscSpaceCreate);
75: .ve
77: Then, your PetscSpace type can be chosen with the procedural interface via
78: .vb
79: PetscSpaceCreate(MPI_Comm, PetscSpace *);
80: PetscSpaceSetType(PetscSpace, "my_space");
81: .ve
82: or at runtime via the option
83: .vb
84: -petscspace_type my_space
85: .ve
87: Level: advanced
89: .keywords: PetscSpace, register
90: .seealso: PetscSpaceRegisterAll(), PetscSpaceRegisterDestroy()
92: @*/
93: PetscErrorCode PetscSpaceRegister(const char sname[], PetscErrorCode (*function)(PetscSpace))
94: {
98: PetscFunctionListAdd(&PetscSpaceList, sname, function);
99: return(0);
100: }
102: /*@C
103: PetscSpaceSetType - Builds a particular PetscSpace
105: Collective on PetscSpace
107: Input Parameters:
108: + sp - The PetscSpace object
109: - name - The kind of space
111: Options Database Key:
112: . -petscspace_type <type> - Sets the PetscSpace type; use -help for a list of available types
114: Level: intermediate
116: .keywords: PetscSpace, set, type
117: .seealso: PetscSpaceGetType(), PetscSpaceCreate()
118: @*/
119: PetscErrorCode PetscSpaceSetType(PetscSpace sp, PetscSpaceType name)
120: {
121: PetscErrorCode (*r)(PetscSpace);
122: PetscBool match;
127: PetscObjectTypeCompare((PetscObject) sp, name, &match);
128: if (match) return(0);
130: PetscSpaceRegisterAll();
131: PetscFunctionListFind(PetscSpaceList, name, &r);
132: if (!r) SETERRQ1(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown PetscSpace type: %s", name);
134: if (sp->ops->destroy) {
135: (*sp->ops->destroy)(sp);
136: sp->ops->destroy = NULL;
137: }
138: (*r)(sp);
139: PetscObjectChangeTypeName((PetscObject) sp, name);
140: return(0);
141: }
143: /*@C
144: PetscSpaceGetType - Gets the PetscSpace type name (as a string) from the object.
146: Not Collective
148: Input Parameter:
149: . sp - The PetscSpace
151: Output Parameter:
152: . name - The PetscSpace type name
154: Level: intermediate
156: .keywords: PetscSpace, get, type, name
157: .seealso: PetscSpaceSetType(), PetscSpaceCreate()
158: @*/
159: PetscErrorCode PetscSpaceGetType(PetscSpace sp, PetscSpaceType *name)
160: {
166: if (!PetscSpaceRegisterAllCalled) {
167: PetscSpaceRegisterAll();
168: }
169: *name = ((PetscObject) sp)->type_name;
170: return(0);
171: }
173: /*@C
174: PetscSpaceView - Views a PetscSpace
176: Collective on PetscSpace
178: Input Parameter:
179: + sp - the PetscSpace object to view
180: - v - the viewer
182: Level: developer
184: .seealso PetscSpaceDestroy()
185: @*/
186: PetscErrorCode PetscSpaceView(PetscSpace sp, PetscViewer v)
187: {
192: if (!v) {PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) sp), &v);}
193: if (sp->ops->view) {(*sp->ops->view)(sp, v);}
194: return(0);
195: }
197: /*@
198: PetscSpaceSetFromOptions - sets parameters in a PetscSpace from the options database
200: Collective on PetscSpace
202: Input Parameter:
203: . sp - the PetscSpace object to set options for
205: Options Database:
206: . -petscspace_order the approximation order of the space
208: Level: developer
210: .seealso PetscSpaceView()
211: @*/
212: PetscErrorCode PetscSpaceSetFromOptions(PetscSpace sp)
213: {
214: const char *defaultType;
215: char name[256];
216: PetscBool flg;
221: if (!((PetscObject) sp)->type_name) {
222: defaultType = PETSCSPACEPOLYNOMIAL;
223: } else {
224: defaultType = ((PetscObject) sp)->type_name;
225: }
226: if (!PetscSpaceRegisterAllCalled) {PetscSpaceRegisterAll();}
228: PetscObjectOptionsBegin((PetscObject) sp);
229: PetscOptionsFList("-petscspace_type", "Linear space", "PetscSpaceSetType", PetscSpaceList, defaultType, name, 256, &flg);
230: if (flg) {
231: PetscSpaceSetType(sp, name);
232: } else if (!((PetscObject) sp)->type_name) {
233: PetscSpaceSetType(sp, defaultType);
234: }
235: PetscOptionsInt("-petscspace_order", "The approximation order", "PetscSpaceSetOrder", sp->order, &sp->order, NULL);
236: PetscOptionsInt("-petscspace_components", "The number of components", "PetscSpaceSetNumComponents", sp->Nc, &sp->Nc, NULL);
237: if (sp->ops->setfromoptions) {
238: (*sp->ops->setfromoptions)(PetscOptionsObject,sp);
239: }
240: /* process any options handlers added with PetscObjectAddOptionsHandler() */
241: PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) sp);
242: PetscOptionsEnd();
243: PetscSpaceViewFromOptions(sp, NULL, "-petscspace_view");
244: return(0);
245: }
247: /*@C
248: PetscSpaceSetUp - Construct data structures for the PetscSpace
250: Collective on PetscSpace
252: Input Parameter:
253: . sp - the PetscSpace object to setup
255: Level: developer
257: .seealso PetscSpaceView(), PetscSpaceDestroy()
258: @*/
259: PetscErrorCode PetscSpaceSetUp(PetscSpace sp)
260: {
265: if (sp->ops->setup) {(*sp->ops->setup)(sp);}
266: return(0);
267: }
269: /*@
270: PetscSpaceDestroy - Destroys a PetscSpace object
272: Collective on PetscSpace
274: Input Parameter:
275: . sp - the PetscSpace object to destroy
277: Level: developer
279: .seealso PetscSpaceView()
280: @*/
281: PetscErrorCode PetscSpaceDestroy(PetscSpace *sp)
282: {
286: if (!*sp) return(0);
289: if (--((PetscObject)(*sp))->refct > 0) {*sp = 0; return(0);}
290: ((PetscObject) (*sp))->refct = 0;
291: DMDestroy(&(*sp)->dm);
293: (*(*sp)->ops->destroy)(*sp);
294: PetscHeaderDestroy(sp);
295: return(0);
296: }
298: /*@
299: PetscSpaceCreate - Creates an empty PetscSpace object. The type can then be set with PetscSpaceSetType().
301: Collective on MPI_Comm
303: Input Parameter:
304: . comm - The communicator for the PetscSpace object
306: Output Parameter:
307: . sp - The PetscSpace object
309: Level: beginner
311: .seealso: PetscSpaceSetType(), PETSCSPACEPOLYNOMIAL
312: @*/
313: PetscErrorCode PetscSpaceCreate(MPI_Comm comm, PetscSpace *sp)
314: {
315: PetscSpace s;
320: PetscCitationsRegister(FECitation,&FEcite);
321: *sp = NULL;
322: PetscFEInitializePackage();
324: PetscHeaderCreate(s, PETSCSPACE_CLASSID, "PetscSpace", "Linear Space", "PetscSpace", comm, PetscSpaceDestroy, PetscSpaceView);
326: s->order = 0;
327: s->Nc = 1;
328: DMShellCreate(comm, &s->dm);
329: PetscSpaceSetType(s, PETSCSPACEPOLYNOMIAL);
331: *sp = s;
332: return(0);
333: }
335: /*@
336: PetscSpaceGetDimension - Return the dimension of this space, i.e. the number of basis vectors
338: Input Parameter:
339: . sp - The PetscSpace
341: Output Parameter:
342: . dim - The dimension
344: Level: intermediate
346: .seealso: PetscSpaceGetOrder(), PetscSpaceCreate(), PetscSpace
347: @*/
348: PetscErrorCode PetscSpaceGetDimension(PetscSpace sp, PetscInt *dim)
349: {
355: *dim = 0;
356: if (sp->ops->getdimension) {(*sp->ops->getdimension)(sp, dim);}
357: return(0);
358: }
360: /*@
361: PetscSpaceGetOrder - Return the order of approximation for this space
363: Input Parameter:
364: . sp - The PetscSpace
366: Output Parameter:
367: . order - The approximation order
369: Level: intermediate
371: .seealso: PetscSpaceSetOrder(), PetscSpaceGetDimension(), PetscSpaceCreate(), PetscSpace
372: @*/
373: PetscErrorCode PetscSpaceGetOrder(PetscSpace sp, PetscInt *order)
374: {
378: *order = sp->order;
379: return(0);
380: }
382: /*@
383: PetscSpaceSetOrder - Set the order of approximation for this space
385: Input Parameters:
386: + sp - The PetscSpace
387: - order - The approximation order
389: Level: intermediate
391: .seealso: PetscSpaceGetOrder(), PetscSpaceCreate(), PetscSpace
392: @*/
393: PetscErrorCode PetscSpaceSetOrder(PetscSpace sp, PetscInt order)
394: {
397: sp->order = order;
398: return(0);
399: }
401: /*@
402: PetscSpaceGetNumComponents - Return the number of components for this space
404: Input Parameter:
405: . sp - The PetscSpace
407: Output Parameter:
408: . Nc - The number of components
410: Note: A vector space, for example, will have d components, where d is the spatial dimension
412: Level: intermediate
414: .seealso: PetscSpaceSetNumComponents(), PetscSpaceGetDimension(), PetscSpaceCreate(), PetscSpace
415: @*/
416: PetscErrorCode PetscSpaceGetNumComponents(PetscSpace sp, PetscInt *Nc)
417: {
421: *Nc = sp->Nc;
422: return(0);
423: }
425: /*@
426: PetscSpaceSetNumComponents - Set the number of components for this space
428: Input Parameters:
429: + sp - The PetscSpace
430: - order - The number of components
432: Level: intermediate
434: .seealso: PetscSpaceGetNumComponents(), PetscSpaceCreate(), PetscSpace
435: @*/
436: PetscErrorCode PetscSpaceSetNumComponents(PetscSpace sp, PetscInt Nc)
437: {
440: sp->Nc = Nc;
441: return(0);
442: }
444: /*@C
445: PetscSpaceEvaluate - Evaluate the basis functions and their derivatives (jet) at each point
447: Input Parameters:
448: + sp - The PetscSpace
449: . npoints - The number of evaluation points, in reference coordinates
450: - points - The point coordinates
452: Output Parameters:
453: + B - The function evaluations in a npoints x nfuncs array
454: . D - The derivative evaluations in a npoints x nfuncs x dim array
455: - H - The second derivative evaluations in a npoints x nfuncs x dim x dim array
457: Note: Above nfuncs is the dimension of the space, and dim is the spatial dimension. The coordinates are given
458: on the reference cell, not in real space.
460: Level: advanced
462: .seealso: PetscFEGetTabulation(), PetscFEGetDefaultTabulation(), PetscSpaceCreate()
463: @*/
464: PetscErrorCode PetscSpaceEvaluate(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
465: {
469: if (!npoints) return(0);
475: if (sp->ops->evaluate) {(*sp->ops->evaluate)(sp, npoints, points, B, D, H);}
476: return(0);
477: }
479: /*@
480: PetscSpaceGetHeightSubspace - Get the subset of the primal space basis that is supported on a mesh point of a given height.
482: If the space is not defined on mesh points of the given height (e.g. if the space is discontinuous and
483: pointwise values are not defined on the element boundaries), or if the implementation of PetscSpace does not
484: support extracting subspaces, then NULL is returned.
486: This does not increment the reference count on the returned space, and the user should not destroy it.
488: Not collective
490: Input Parameters:
491: + sp - the PetscSpace object
492: - height - the height of the mesh point for which the subspace is desired
494: Output Parameter:
495: . subsp - the subspace
497: Level: advanced
499: .seealso: PetscDualSpaceGetHeightSubspace(), PetscSpace
500: @*/
501: PetscErrorCode PetscSpaceGetHeightSubspace(PetscSpace sp, PetscInt height, PetscSpace *subsp)
502: {
508: *subsp = NULL;
509: if (sp->ops->getheightsubspace) {
510: (*sp->ops->getheightsubspace)(sp, height, subsp);
511: }
512: return(0);
513: }
515: PetscErrorCode PetscSpaceSetFromOptions_Polynomial(PetscOptionItems *PetscOptionsObject,PetscSpace sp)
516: {
517: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
518: PetscErrorCode ierr;
521: PetscOptionsHead(PetscOptionsObject,"PetscSpace polynomial options");
522: PetscOptionsInt("-petscspace_poly_num_variables", "The number of different variables, e.g. x and y", "PetscSpacePolynomialSetNumVariables", poly->numVariables, &poly->numVariables, NULL);
523: PetscOptionsBool("-petscspace_poly_sym", "Use only symmetric polynomials", "PetscSpacePolynomialSetSymmetric", poly->symmetric, &poly->symmetric, NULL);
524: PetscOptionsBool("-petscspace_poly_tensor", "Use the tensor product polynomials", "PetscSpacePolynomialSetTensor", poly->tensor, &poly->tensor, NULL);
525: PetscOptionsTail();
526: return(0);
527: }
529: static PetscErrorCode PetscSpacePolynomialView_Ascii(PetscSpace sp, PetscViewer viewer)
530: {
531: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
532: PetscErrorCode ierr;
535: if (sp->Nc > 1) {
536: if (poly->tensor) {PetscViewerASCIIPrintf(viewer, "Tensor polynomial space in %D variables of degree %D with %D components\n", poly->numVariables, sp->order, sp->Nc);}
537: else {PetscViewerASCIIPrintf(viewer, "Polynomial space in %D variables of degree %D with %D components\n", poly->numVariables, sp->order, sp->Nc);}
538: } else {
539: if (poly->tensor) {PetscViewerASCIIPrintf(viewer, "Tensor polynomial space in %d variables of degree %d\n", poly->numVariables, sp->order);}
540: else {PetscViewerASCIIPrintf(viewer, "Polynomial space in %d variables of degree %d\n", poly->numVariables, sp->order);}
541: }
542: return(0);
543: }
545: PetscErrorCode PetscSpaceView_Polynomial(PetscSpace sp, PetscViewer viewer)
546: {
547: PetscBool iascii;
553: PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
554: if (iascii) {PetscSpacePolynomialView_Ascii(sp, viewer);}
555: return(0);
556: }
558: PetscErrorCode PetscSpaceSetUp_Polynomial(PetscSpace sp)
559: {
560: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
561: PetscInt ndegree = sp->order+1;
562: PetscInt deg;
563: PetscErrorCode ierr;
566: PetscMalloc1(ndegree, &poly->degrees);
567: for (deg = 0; deg < ndegree; ++deg) poly->degrees[deg] = deg;
568: return(0);
569: }
571: PetscErrorCode PetscSpaceDestroy_Polynomial(PetscSpace sp)
572: {
573: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
574: PetscErrorCode ierr;
577: PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", NULL);
578: PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialSetTensor_C", NULL);
579: PetscFree(poly->degrees);
580: if (poly->subspaces) {
581: PetscInt d;
583: for (d = 0; d < poly->numVariables; ++d) {
584: PetscSpaceDestroy(&poly->subspaces[d]);
585: }
586: }
587: PetscFree(poly->subspaces);
588: PetscFree(poly);
589: return(0);
590: }
592: /* We treat the space as a tensor product of scalar polynomial spaces, so the dimension is multiplied by Nc */
593: PetscErrorCode PetscSpaceGetDimension_Polynomial(PetscSpace sp, PetscInt *dim)
594: {
595: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
596: PetscInt deg = sp->order;
597: PetscInt n = poly->numVariables, i;
598: PetscReal D = 1.0;
601: if (poly->tensor) {
602: *dim = 1;
603: for (i = 0; i < n; ++i) *dim *= (deg+1);
604: } else {
605: for (i = 1; i <= n; ++i) {
606: D *= ((PetscReal) (deg+i))/i;
607: }
608: *dim = (PetscInt) (D + 0.5);
609: }
610: *dim *= sp->Nc;
611: return(0);
612: }
614: /*
615: LatticePoint_Internal - Returns all tuples of size 'len' with nonnegative integers that sum up to 'sum'.
617: Input Parameters:
618: + len - The length of the tuple
619: . sum - The sum of all entries in the tuple
620: - ind - The current multi-index of the tuple, initialized to the 0 tuple
622: Output Parameter:
623: + ind - The multi-index of the tuple, -1 indicates the iteration has terminated
624: . tup - A tuple of len integers addig to sum
626: Level: developer
628: .seealso:
629: */
630: static PetscErrorCode LatticePoint_Internal(PetscInt len, PetscInt sum, PetscInt ind[], PetscInt tup[])
631: {
632: PetscInt i;
636: if (len == 1) {
637: ind[0] = -1;
638: tup[0] = sum;
639: } else if (sum == 0) {
640: for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
641: } else {
642: tup[0] = sum - ind[0];
643: LatticePoint_Internal(len-1, ind[0], &ind[1], &tup[1]);
644: if (ind[1] < 0) {
645: if (ind[0] == sum) {ind[0] = -1;}
646: else {ind[1] = 0; ++ind[0];}
647: }
648: }
649: return(0);
650: }
652: /*
653: LatticePointLexicographic_Internal - Returns all tuples of size 'len' with nonnegative integers that sum up to at most 'max'.
654: Ordering is lexicographic with lowest index as least significant in ordering.
655: e.g. for len == 2 and max == 2, this will return, in order, {0,0}, {1,0}, {2,0}, {0,1}, {1,1}, {2,0}.
657: Input Parameters:
658: + len - The length of the tuple
659: . max - The maximum sum
660: - tup - A tuple of length len+1: tup[len] > 0 indicates a stopping condition
662: Output Parameter:
663: . tup - A tuple of len integers whos sum is at most 'max'
664: */
665: static PetscErrorCode LatticePointLexicographic_Internal(PetscInt len, PetscInt max, PetscInt tup[])
666: {
668: while (len--) {
669: max -= tup[len];
670: if (!max) {
671: tup[len] = 0;
672: break;
673: }
674: }
675: tup[++len]++;
676: return(0);
677: }
679: /*
680: TensorPoint_Internal - Returns all tuples of size 'len' with nonnegative integers that are less than 'max'.
682: Input Parameters:
683: + len - The length of the tuple
684: . max - The max for all entries in the tuple
685: - ind - The current multi-index of the tuple, initialized to the 0 tuple
687: Output Parameter:
688: + ind - The multi-index of the tuple, -1 indicates the iteration has terminated
689: . tup - A tuple of len integers less than max
691: Level: developer
693: .seealso:
694: */
695: static PetscErrorCode TensorPoint_Internal(PetscInt len, PetscInt max, PetscInt ind[], PetscInt tup[])
696: {
697: PetscInt i;
701: if (len == 1) {
702: tup[0] = ind[0]++;
703: ind[0] = ind[0] >= max ? -1 : ind[0];
704: } else if (max == 0) {
705: for (i = 0; i < len; ++i) {ind[0] = -1; tup[i] = 0;}
706: } else {
707: tup[0] = ind[0];
708: TensorPoint_Internal(len-1, max, &ind[1], &tup[1]);
709: if (ind[1] < 0) {
710: ind[1] = 0;
711: if (ind[0] == max-1) {ind[0] = -1;}
712: else {++ind[0];}
713: }
714: }
715: return(0);
716: }
718: /*
719: TensorPointLexicographic_Internal - Returns all tuples of size 'len' with nonnegative integers that are all less than or equal to 'max'.
720: Ordering is lexicographic with lowest index as least significant in ordering.
721: e.g. for len == 2 and max == 2, this will return, in order, {0,0}, {1,0}, {2,0}, {0,1}, {1,1}, {2,1}, {0,2}, {1,2}, {2,2}.
723: Input Parameters:
724: + len - The length of the tuple
725: . max - The maximum value
726: - tup - A tuple of length len+1: tup[len] > 0 indicates a stopping condition
728: Output Parameter:
729: . tup - A tuple of len integers whos sum is at most 'max'
730: */
731: static PetscErrorCode TensorPointLexicographic_Internal(PetscInt len, PetscInt max, PetscInt tup[])
732: {
733: PetscInt i;
736: for (i = 0; i < len; i++) {
737: if (tup[i] < max) {
738: break;
739: } else {
740: tup[i] = 0;
741: }
742: }
743: tup[i]++;
744: return(0);
745: }
747: /*
748: p in [0, npoints), i in [0, pdim), c in [0, Nc)
750: B[p][i][c] = B[p][i_scalar][c][c]
751: */
752: PetscErrorCode PetscSpaceEvaluate_Polynomial(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
753: {
754: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
755: DM dm = sp->dm;
756: PetscInt Nc = sp->Nc;
757: PetscInt ndegree = sp->order+1;
758: PetscInt *degrees = poly->degrees;
759: PetscInt dim = poly->numVariables;
760: PetscReal *lpoints, *tmp, *LB, *LD, *LH;
761: PetscInt *ind, *tup;
762: PetscInt c, pdim, d, der, i, p, deg, o;
763: PetscErrorCode ierr;
766: PetscSpaceGetDimension(sp, &pdim);
767: pdim /= Nc;
768: DMGetWorkArray(dm, npoints, PETSC_REAL, &lpoints);
769: DMGetWorkArray(dm, npoints*ndegree*3, PETSC_REAL, &tmp);
770: if (B) {DMGetWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LB);}
771: if (D) {DMGetWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LD);}
772: if (H) {DMGetWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LH);}
773: for (d = 0; d < dim; ++d) {
774: for (p = 0; p < npoints; ++p) {
775: lpoints[p] = points[p*dim+d];
776: }
777: PetscDTLegendreEval(npoints, lpoints, ndegree, degrees, tmp, &tmp[1*npoints*ndegree], &tmp[2*npoints*ndegree]);
778: /* LB, LD, LH (ndegree * dim x npoints) */
779: for (deg = 0; deg < ndegree; ++deg) {
780: for (p = 0; p < npoints; ++p) {
781: if (B) LB[(deg*dim + d)*npoints + p] = tmp[(0*npoints + p)*ndegree+deg];
782: if (D) LD[(deg*dim + d)*npoints + p] = tmp[(1*npoints + p)*ndegree+deg];
783: if (H) LH[(deg*dim + d)*npoints + p] = tmp[(2*npoints + p)*ndegree+deg];
784: }
785: }
786: }
787: /* Multiply by A (pdim x ndegree * dim) */
788: PetscMalloc2(dim,&ind,dim,&tup);
789: if (B) {
790: /* B (npoints x pdim x Nc) */
791: PetscMemzero(B, npoints*pdim*Nc*Nc * sizeof(PetscReal));
792: if (poly->tensor) {
793: i = 0;
794: PetscMemzero(ind, dim * sizeof(PetscInt));
795: while (ind[0] >= 0) {
796: TensorPoint_Internal(dim, sp->order+1, ind, tup);
797: for (p = 0; p < npoints; ++p) {
798: B[(p*pdim + i)*Nc*Nc] = 1.0;
799: for (d = 0; d < dim; ++d) {
800: B[(p*pdim + i)*Nc*Nc] *= LB[(tup[d]*dim + d)*npoints + p];
801: }
802: }
803: ++i;
804: }
805: } else {
806: i = 0;
807: for (o = 0; o <= sp->order; ++o) {
808: PetscMemzero(ind, dim * sizeof(PetscInt));
809: while (ind[0] >= 0) {
810: LatticePoint_Internal(dim, o, ind, tup);
811: for (p = 0; p < npoints; ++p) {
812: B[(p*pdim + i)*Nc*Nc] = 1.0;
813: for (d = 0; d < dim; ++d) {
814: B[(p*pdim + i)*Nc*Nc] *= LB[(tup[d]*dim + d)*npoints + p];
815: }
816: }
817: ++i;
818: }
819: }
820: }
821: /* Make direct sum basis for multicomponent space */
822: for (p = 0; p < npoints; ++p) {
823: for (i = 0; i < pdim; ++i) {
824: for (c = 1; c < Nc; ++c) {
825: B[(p*pdim*Nc + i*Nc + c)*Nc + c] = B[(p*pdim + i)*Nc*Nc];
826: }
827: }
828: }
829: }
830: if (D) {
831: /* D (npoints x pdim x Nc x dim) */
832: PetscMemzero(D, npoints*pdim*Nc*Nc*dim * sizeof(PetscReal));
833: if (poly->tensor) {
834: i = 0;
835: PetscMemzero(ind, dim * sizeof(PetscInt));
836: while (ind[0] >= 0) {
837: TensorPoint_Internal(dim, sp->order+1, ind, tup);
838: for (p = 0; p < npoints; ++p) {
839: for (der = 0; der < dim; ++der) {
840: D[(p*pdim + i)*Nc*Nc*dim + der] = 1.0;
841: for (d = 0; d < dim; ++d) {
842: if (d == der) {
843: D[(p*pdim + i)*Nc*Nc*dim + der] *= LD[(tup[d]*dim + d)*npoints + p];
844: } else {
845: D[(p*pdim + i)*Nc*Nc*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
846: }
847: }
848: }
849: }
850: ++i;
851: }
852: } else {
853: i = 0;
854: for (o = 0; o <= sp->order; ++o) {
855: PetscMemzero(ind, dim * sizeof(PetscInt));
856: while (ind[0] >= 0) {
857: LatticePoint_Internal(dim, o, ind, tup);
858: for (p = 0; p < npoints; ++p) {
859: for (der = 0; der < dim; ++der) {
860: D[(p*pdim + i)*Nc*Nc*dim + der] = 1.0;
861: for (d = 0; d < dim; ++d) {
862: if (d == der) {
863: D[(p*pdim + i)*Nc*Nc*dim + der] *= LD[(tup[d]*dim + d)*npoints + p];
864: } else {
865: D[(p*pdim + i)*Nc*Nc*dim + der] *= LB[(tup[d]*dim + d)*npoints + p];
866: }
867: }
868: }
869: }
870: ++i;
871: }
872: }
873: }
874: /* Make direct sum basis for multicomponent space */
875: for (p = 0; p < npoints; ++p) {
876: for (i = 0; i < pdim; ++i) {
877: for (c = 1; c < Nc; ++c) {
878: for (d = 0; d < dim; ++d) {
879: D[((p*pdim*Nc + i*Nc + c)*Nc + c)*dim + d] = D[(p*pdim + i)*Nc*Nc*dim + d];
880: }
881: }
882: }
883: }
884: }
885: if (H) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Too lazy to code second derivatives");
886: PetscFree2(ind,tup);
887: if (B) {DMRestoreWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LB);}
888: if (D) {DMRestoreWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LD);}
889: if (H) {DMRestoreWorkArray(dm, npoints*dim*ndegree, PETSC_REAL, &LH);}
890: DMRestoreWorkArray(dm, npoints*ndegree*3, PETSC_REAL, &tmp);
891: DMRestoreWorkArray(dm, npoints, PETSC_REAL, &lpoints);
892: return(0);
893: }
895: /*@
896: PetscSpacePolynomialSetTensor - Set whether a function space is a space of tensor polynomials (the space is spanned
897: by polynomials whose degree in each variabl is bounded by the given order), as opposed to polynomials (the space is
898: spanned by polynomials whose total degree---summing over all variables---is bounded by the given order).
900: Input Parameters:
901: + sp - the function space object
902: - tensor - PETSC_TRUE for a tensor polynomial space, PETSC_FALSE for a polynomial space
904: Level: beginner
906: .seealso: PetscSpacePolynomialGetTensor(), PetscSpaceSetOrder(), PetscSpacePolynomialSetNumVariables()
907: @*/
908: PetscErrorCode PetscSpacePolynomialSetTensor(PetscSpace sp, PetscBool tensor)
909: {
914: PetscTryMethod(sp,"PetscSpacePolynomialSetTensor_C",(PetscSpace,PetscBool),(sp,tensor));
915: return(0);
916: }
918: /*@
919: PetscSpacePolynomialGetTensor - Get whether a function space is a space of tensor polynomials (the space is spanned
920: by polynomials whose degree in each variabl is bounded by the given order), as opposed to polynomials (the space is
921: spanned by polynomials whose total degree---summing over all variables---is bounded by the given order).
923: Input Parameters:
924: . sp - the function space object
926: Output Parameters:
927: . tensor - PETSC_TRUE for a tensor polynomial space, PETSC_FALSE for a polynomial space
929: Level: beginner
931: .seealso: PetscSpacePolynomialSetTensor(), PetscSpaceSetOrder(), PetscSpacePolynomialSetNumVariables()
932: @*/
933: PetscErrorCode PetscSpacePolynomialGetTensor(PetscSpace sp, PetscBool *tensor)
934: {
940: PetscTryMethod(sp,"PetscSpacePolynomialGetTensor_C",(PetscSpace,PetscBool*),(sp,tensor));
941: return(0);
942: }
944: static PetscErrorCode PetscSpacePolynomialSetTensor_Polynomial(PetscSpace sp, PetscBool tensor)
945: {
946: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
949: poly->tensor = tensor;
950: return(0);
951: }
953: static PetscErrorCode PetscSpacePolynomialGetTensor_Polynomial(PetscSpace sp, PetscBool *tensor)
954: {
955: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
960: *tensor = poly->tensor;
961: return(0);
962: }
964: static PetscErrorCode PetscSpaceGetHeightSubspace_Polynomial(PetscSpace sp, PetscInt height, PetscSpace *subsp)
965: {
966: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
967: PetscInt Nc, dim, order;
968: PetscBool tensor;
969: PetscErrorCode ierr;
972: PetscSpaceGetNumComponents(sp, &Nc);
973: PetscSpacePolynomialGetNumVariables(sp, &dim);
974: PetscSpaceGetOrder(sp, &order);
975: PetscSpacePolynomialGetTensor(sp, &tensor);
976: if (height > dim || height < 0) {SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Asked for space at height %D for dimension %D space", height, dim);}
977: if (!poly->subspaces) {PetscCalloc1(dim, &poly->subspaces);}
978: if (height <= dim) {
979: if (!poly->subspaces[height-1]) {
980: PetscSpace sub;
982: PetscSpaceCreate(PetscObjectComm((PetscObject) sp), &sub);
983: PetscSpaceSetNumComponents(sub, Nc);
984: PetscSpaceSetOrder(sub, order);
985: PetscSpaceSetType(sub, PETSCSPACEPOLYNOMIAL);
986: PetscSpacePolynomialSetNumVariables(sub, dim-height);
987: PetscSpacePolynomialSetTensor(sub, tensor);
988: PetscSpaceSetUp(sub);
989: poly->subspaces[height-1] = sub;
990: }
991: *subsp = poly->subspaces[height-1];
992: } else {
993: *subsp = NULL;
994: }
995: return(0);
996: }
998: PetscErrorCode PetscSpaceInitialize_Polynomial(PetscSpace sp)
999: {
1003: sp->ops->setfromoptions = PetscSpaceSetFromOptions_Polynomial;
1004: sp->ops->setup = PetscSpaceSetUp_Polynomial;
1005: sp->ops->view = PetscSpaceView_Polynomial;
1006: sp->ops->destroy = PetscSpaceDestroy_Polynomial;
1007: sp->ops->getdimension = PetscSpaceGetDimension_Polynomial;
1008: sp->ops->evaluate = PetscSpaceEvaluate_Polynomial;
1009: sp->ops->getheightsubspace = PetscSpaceGetHeightSubspace_Polynomial;
1010: PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialGetTensor_C", PetscSpacePolynomialGetTensor_Polynomial);
1011: PetscObjectComposeFunction((PetscObject) sp, "PetscSpacePolynomialSetTensor_C", PetscSpacePolynomialSetTensor_Polynomial);
1012: return(0);
1013: }
1015: /*MC
1016: PETSCSPACEPOLYNOMIAL = "poly" - A PetscSpace object that encapsulates a polynomial space, e.g. P1 is the space of
1017: linear polynomials. The space is replicated for each component.
1019: Level: intermediate
1021: .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
1022: M*/
1024: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_Polynomial(PetscSpace sp)
1025: {
1026: PetscSpace_Poly *poly;
1027: PetscErrorCode ierr;
1031: PetscNewLog(sp,&poly);
1032: sp->data = poly;
1034: poly->numVariables = 0;
1035: poly->symmetric = PETSC_FALSE;
1036: poly->tensor = PETSC_FALSE;
1037: poly->degrees = NULL;
1038: poly->subspaces = NULL;
1040: PetscSpaceInitialize_Polynomial(sp);
1041: return(0);
1042: }
1044: PetscErrorCode PetscSpacePolynomialSetSymmetric(PetscSpace sp, PetscBool sym)
1045: {
1046: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
1050: poly->symmetric = sym;
1051: return(0);
1052: }
1054: PetscErrorCode PetscSpacePolynomialGetSymmetric(PetscSpace sp, PetscBool *sym)
1055: {
1056: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
1061: *sym = poly->symmetric;
1062: return(0);
1063: }
1065: PetscErrorCode PetscSpacePolynomialSetNumVariables(PetscSpace sp, PetscInt n)
1066: {
1067: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
1071: poly->numVariables = n;
1072: return(0);
1073: }
1075: PetscErrorCode PetscSpacePolynomialGetNumVariables(PetscSpace sp, PetscInt *n)
1076: {
1077: PetscSpace_Poly *poly = (PetscSpace_Poly *) sp->data;
1082: *n = poly->numVariables;
1083: return(0);
1084: }
1086: PetscErrorCode PetscSpaceSetFromOptions_Point(PetscOptionItems *PetscOptionsObject,PetscSpace sp)
1087: {
1088: PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1089: PetscErrorCode ierr;
1092: PetscOptionsHead(PetscOptionsObject,"PetscSpace Point options");
1093: PetscOptionsInt("-petscspace_point_num_variables", "The number of different variables, e.g. x and y", "PetscSpacePointSetNumVariables", pt->numVariables, &pt->numVariables, NULL);
1094: PetscOptionsTail();
1095: return(0);
1096: }
1098: PetscErrorCode PetscSpacePointView_Ascii(PetscSpace sp, PetscViewer viewer)
1099: {
1100: PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1101: PetscViewerFormat format;
1102: PetscErrorCode ierr;
1105: PetscViewerGetFormat(viewer, &format);
1106: if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
1107: PetscViewerASCIIPrintf(viewer, "Point space in dimension %d:\n", pt->numVariables);
1108: PetscViewerASCIIPushTab(viewer);
1109: PetscQuadratureView(pt->quad, viewer);
1110: PetscViewerASCIIPopTab(viewer);
1111: } else {
1112: PetscViewerASCIIPrintf(viewer, "Point space in dimension %d on %d points\n", pt->numVariables, pt->quad->numPoints);
1113: }
1114: return(0);
1115: }
1117: PetscErrorCode PetscSpaceView_Point(PetscSpace sp, PetscViewer viewer)
1118: {
1119: PetscBool iascii;
1125: PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
1126: if (iascii) {PetscSpacePointView_Ascii(sp, viewer);}
1127: return(0);
1128: }
1130: PetscErrorCode PetscSpaceSetUp_Point(PetscSpace sp)
1131: {
1132: PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1133: PetscErrorCode ierr;
1136: if (!pt->quad->points && sp->order >= 0) {
1137: PetscQuadratureDestroy(&pt->quad);
1138: PetscDTGaussJacobiQuadrature(pt->numVariables, sp->Nc, PetscMax(sp->order + 1, 1), -1.0, 1.0, &pt->quad);
1139: }
1140: return(0);
1141: }
1143: PetscErrorCode PetscSpaceDestroy_Point(PetscSpace sp)
1144: {
1145: PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1146: PetscErrorCode ierr;
1149: PetscQuadratureDestroy(&pt->quad);
1150: PetscFree(pt);
1151: return(0);
1152: }
1154: PetscErrorCode PetscSpaceGetDimension_Point(PetscSpace sp, PetscInt *dim)
1155: {
1156: PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1159: *dim = pt->quad->numPoints;
1160: return(0);
1161: }
1163: PetscErrorCode PetscSpaceEvaluate_Point(PetscSpace sp, PetscInt npoints, const PetscReal points[], PetscReal B[], PetscReal D[], PetscReal H[])
1164: {
1165: PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1166: PetscInt dim = pt->numVariables, pdim = pt->quad->numPoints, d, p, i, c;
1167: PetscErrorCode ierr;
1170: if (npoints != pt->quad->numPoints) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_SUP, "Cannot evaluate Point space on %d points != %d size", npoints, pt->quad->numPoints);
1171: PetscMemzero(B, npoints*pdim * sizeof(PetscReal));
1172: for (p = 0; p < npoints; ++p) {
1173: for (i = 0; i < pdim; ++i) {
1174: for (d = 0; d < dim; ++d) {
1175: if (PetscAbsReal(points[p*dim+d] - pt->quad->points[p*dim+d]) > 1.0e-10) break;
1176: }
1177: if (d >= dim) {B[p*pdim+i] = 1.0; break;}
1178: }
1179: }
1180: /* Replicate for other components */
1181: for (c = 1; c < sp->Nc; ++c) {
1182: for (p = 0; p < npoints; ++p) {
1183: for (i = 0; i < pdim; ++i) {
1184: B[(c*npoints + p)*pdim + i] = B[p*pdim + i];
1185: }
1186: }
1187: }
1188: if (D) {PetscMemzero(D, npoints*pdim*dim * sizeof(PetscReal));}
1189: if (H) {PetscMemzero(H, npoints*pdim*dim*dim * sizeof(PetscReal));}
1190: return(0);
1191: }
1193: PetscErrorCode PetscSpaceInitialize_Point(PetscSpace sp)
1194: {
1196: sp->ops->setfromoptions = PetscSpaceSetFromOptions_Point;
1197: sp->ops->setup = PetscSpaceSetUp_Point;
1198: sp->ops->view = PetscSpaceView_Point;
1199: sp->ops->destroy = PetscSpaceDestroy_Point;
1200: sp->ops->getdimension = PetscSpaceGetDimension_Point;
1201: sp->ops->evaluate = PetscSpaceEvaluate_Point;
1202: return(0);
1203: }
1205: /*MC
1206: PETSCSPACEPOINT = "point" - A PetscSpace object that encapsulates functions defined on a set of quadrature points.
1208: Level: intermediate
1210: .seealso: PetscSpaceType, PetscSpaceCreate(), PetscSpaceSetType()
1211: M*/
1213: PETSC_EXTERN PetscErrorCode PetscSpaceCreate_Point(PetscSpace sp)
1214: {
1215: PetscSpace_Point *pt;
1216: PetscErrorCode ierr;
1220: PetscNewLog(sp,&pt);
1221: sp->data = pt;
1223: pt->numVariables = 0;
1224: PetscQuadratureCreate(PETSC_COMM_SELF, &pt->quad);
1225: PetscQuadratureSetData(pt->quad, 0, 1, 0, NULL, NULL);
1227: PetscSpaceInitialize_Point(sp);
1228: return(0);
1229: }
1231: /*@
1232: PetscSpacePointSetPoints - Sets the evaluation points for the space to coincide with the points of a quadrature rule
1234: Logically collective
1236: Input Parameters:
1237: + sp - The PetscSpace
1238: - q - The PetscQuadrature defining the points
1240: Level: intermediate
1242: .keywords: PetscSpacePoint
1243: .seealso: PetscSpaceCreate(), PetscSpaceSetType()
1244: @*/
1245: PetscErrorCode PetscSpacePointSetPoints(PetscSpace sp, PetscQuadrature q)
1246: {
1247: PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1248: PetscErrorCode ierr;
1253: PetscQuadratureDestroy(&pt->quad);
1254: PetscQuadratureDuplicate(q, &pt->quad);
1255: return(0);
1256: }
1258: /*@
1259: PetscSpacePointGetPoints - Gets the evaluation points for the space as the points of a quadrature rule
1261: Logically collective
1263: Input Parameter:
1264: . sp - The PetscSpace
1266: Output Parameter:
1267: . q - The PetscQuadrature defining the points
1269: Level: intermediate
1271: .keywords: PetscSpacePoint
1272: .seealso: PetscSpaceCreate(), PetscSpaceSetType()
1273: @*/
1274: PetscErrorCode PetscSpacePointGetPoints(PetscSpace sp, PetscQuadrature *q)
1275: {
1276: PetscSpace_Point *pt = (PetscSpace_Point *) sp->data;
1281: *q = pt->quad;
1282: return(0);
1283: }
1286: PetscClassId PETSCDUALSPACE_CLASSID = 0;
1288: PetscFunctionList PetscDualSpaceList = NULL;
1289: PetscBool PetscDualSpaceRegisterAllCalled = PETSC_FALSE;
1291: /*@C
1292: PetscDualSpaceRegister - Adds a new PetscDualSpace implementation
1294: Not Collective
1296: Input Parameters:
1297: + name - The name of a new user-defined creation routine
1298: - create_func - The creation routine itself
1300: Notes:
1301: PetscDualSpaceRegister() may be called multiple times to add several user-defined PetscDualSpaces
1303: Sample usage:
1304: .vb
1305: PetscDualSpaceRegister("my_space", MyPetscDualSpaceCreate);
1306: .ve
1308: Then, your PetscDualSpace type can be chosen with the procedural interface via
1309: .vb
1310: PetscDualSpaceCreate(MPI_Comm, PetscDualSpace *);
1311: PetscDualSpaceSetType(PetscDualSpace, "my_dual_space");
1312: .ve
1313: or at runtime via the option
1314: .vb
1315: -petscdualspace_type my_dual_space
1316: .ve
1318: Level: advanced
1320: .keywords: PetscDualSpace, register
1321: .seealso: PetscDualSpaceRegisterAll(), PetscDualSpaceRegisterDestroy()
1323: @*/
1324: PetscErrorCode PetscDualSpaceRegister(const char sname[], PetscErrorCode (*function)(PetscDualSpace))
1325: {
1329: PetscFunctionListAdd(&PetscDualSpaceList, sname, function);
1330: return(0);
1331: }
1333: /*@C
1334: PetscDualSpaceSetType - Builds a particular PetscDualSpace
1336: Collective on PetscDualSpace
1338: Input Parameters:
1339: + sp - The PetscDualSpace object
1340: - name - The kind of space
1342: Options Database Key:
1343: . -petscdualspace_type <type> - Sets the PetscDualSpace type; use -help for a list of available types
1345: Level: intermediate
1347: .keywords: PetscDualSpace, set, type
1348: .seealso: PetscDualSpaceGetType(), PetscDualSpaceCreate()
1349: @*/
1350: PetscErrorCode PetscDualSpaceSetType(PetscDualSpace sp, PetscDualSpaceType name)
1351: {
1352: PetscErrorCode (*r)(PetscDualSpace);
1353: PetscBool match;
1358: PetscObjectTypeCompare((PetscObject) sp, name, &match);
1359: if (match) return(0);
1361: if (!PetscDualSpaceRegisterAllCalled) {PetscDualSpaceRegisterAll();}
1362: PetscFunctionListFind(PetscDualSpaceList, name, &r);
1363: if (!r) SETERRQ1(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown PetscDualSpace type: %s", name);
1365: if (sp->ops->destroy) {
1366: (*sp->ops->destroy)(sp);
1367: sp->ops->destroy = NULL;
1368: }
1369: (*r)(sp);
1370: PetscObjectChangeTypeName((PetscObject) sp, name);
1371: return(0);
1372: }
1374: /*@C
1375: PetscDualSpaceGetType - Gets the PetscDualSpace type name (as a string) from the object.
1377: Not Collective
1379: Input Parameter:
1380: . sp - The PetscDualSpace
1382: Output Parameter:
1383: . name - The PetscDualSpace type name
1385: Level: intermediate
1387: .keywords: PetscDualSpace, get, type, name
1388: .seealso: PetscDualSpaceSetType(), PetscDualSpaceCreate()
1389: @*/
1390: PetscErrorCode PetscDualSpaceGetType(PetscDualSpace sp, PetscDualSpaceType *name)
1391: {
1397: if (!PetscDualSpaceRegisterAllCalled) {
1398: PetscDualSpaceRegisterAll();
1399: }
1400: *name = ((PetscObject) sp)->type_name;
1401: return(0);
1402: }
1404: /*@
1405: PetscDualSpaceView - Views a PetscDualSpace
1407: Collective on PetscDualSpace
1409: Input Parameter:
1410: + sp - the PetscDualSpace object to view
1411: - v - the viewer
1413: Level: developer
1415: .seealso PetscDualSpaceDestroy()
1416: @*/
1417: PetscErrorCode PetscDualSpaceView(PetscDualSpace sp, PetscViewer v)
1418: {
1423: if (!v) {
1424: PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) sp), &v);
1425: }
1426: if (sp->ops->view) {
1427: (*sp->ops->view)(sp, v);
1428: }
1429: return(0);
1430: }
1432: /*@
1433: PetscDualSpaceSetFromOptions - sets parameters in a PetscDualSpace from the options database
1435: Collective on PetscDualSpace
1437: Input Parameter:
1438: . sp - the PetscDualSpace object to set options for
1440: Options Database:
1441: . -petscspace_order the approximation order of the space
1443: Level: developer
1445: .seealso PetscDualSpaceView()
1446: @*/
1447: PetscErrorCode PetscDualSpaceSetFromOptions(PetscDualSpace sp)
1448: {
1449: const char *defaultType;
1450: char name[256];
1451: PetscBool flg;
1456: if (!((PetscObject) sp)->type_name) {
1457: defaultType = PETSCDUALSPACELAGRANGE;
1458: } else {
1459: defaultType = ((PetscObject) sp)->type_name;
1460: }
1461: if (!PetscSpaceRegisterAllCalled) {PetscSpaceRegisterAll();}
1463: PetscObjectOptionsBegin((PetscObject) sp);
1464: PetscOptionsFList("-petscdualspace_type", "Dual space", "PetscDualSpaceSetType", PetscDualSpaceList, defaultType, name, 256, &flg);
1465: if (flg) {
1466: PetscDualSpaceSetType(sp, name);
1467: } else if (!((PetscObject) sp)->type_name) {
1468: PetscDualSpaceSetType(sp, defaultType);
1469: }
1470: PetscOptionsInt("-petscdualspace_order", "The approximation order", "PetscDualSpaceSetOrder", sp->order, &sp->order, NULL);
1471: PetscOptionsInt("-petscdualspace_components", "The number of components", "PetscDualSpaceSetNumComponents", sp->Nc, &sp->Nc, NULL);
1472: if (sp->ops->setfromoptions) {
1473: (*sp->ops->setfromoptions)(PetscOptionsObject,sp);
1474: }
1475: /* process any options handlers added with PetscObjectAddOptionsHandler() */
1476: PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) sp);
1477: PetscOptionsEnd();
1478: PetscDualSpaceViewFromOptions(sp, NULL, "-petscdualspace_view");
1479: return(0);
1480: }
1482: /*@
1483: PetscDualSpaceSetUp - Construct a basis for the PetscDualSpace
1485: Collective on PetscDualSpace
1487: Input Parameter:
1488: . sp - the PetscDualSpace object to setup
1490: Level: developer
1492: .seealso PetscDualSpaceView(), PetscDualSpaceDestroy()
1493: @*/
1494: PetscErrorCode PetscDualSpaceSetUp(PetscDualSpace sp)
1495: {
1500: if (sp->setupcalled) return(0);
1501: sp->setupcalled = PETSC_TRUE;
1502: if (sp->ops->setup) {(*sp->ops->setup)(sp);}
1503: return(0);
1504: }
1506: /*@
1507: PetscDualSpaceDestroy - Destroys a PetscDualSpace object
1509: Collective on PetscDualSpace
1511: Input Parameter:
1512: . sp - the PetscDualSpace object to destroy
1514: Level: developer
1516: .seealso PetscDualSpaceView()
1517: @*/
1518: PetscErrorCode PetscDualSpaceDestroy(PetscDualSpace *sp)
1519: {
1520: PetscInt dim, f;
1524: if (!*sp) return(0);
1527: if (--((PetscObject)(*sp))->refct > 0) {*sp = 0; return(0);}
1528: ((PetscObject) (*sp))->refct = 0;
1530: PetscDualSpaceGetDimension(*sp, &dim);
1531: for (f = 0; f < dim; ++f) {
1532: PetscQuadratureDestroy(&(*sp)->functional[f]);
1533: }
1534: PetscFree((*sp)->functional);
1535: DMDestroy(&(*sp)->dm);
1537: if ((*sp)->ops->destroy) {(*(*sp)->ops->destroy)(*sp);}
1538: PetscHeaderDestroy(sp);
1539: return(0);
1540: }
1542: /*@
1543: PetscDualSpaceCreate - Creates an empty PetscDualSpace object. The type can then be set with PetscDualSpaceSetType().
1545: Collective on MPI_Comm
1547: Input Parameter:
1548: . comm - The communicator for the PetscDualSpace object
1550: Output Parameter:
1551: . sp - The PetscDualSpace object
1553: Level: beginner
1555: .seealso: PetscDualSpaceSetType(), PETSCDUALSPACELAGRANGE
1556: @*/
1557: PetscErrorCode PetscDualSpaceCreate(MPI_Comm comm, PetscDualSpace *sp)
1558: {
1559: PetscDualSpace s;
1564: PetscCitationsRegister(FECitation,&FEcite);
1565: *sp = NULL;
1566: PetscFEInitializePackage();
1568: PetscHeaderCreate(s, PETSCDUALSPACE_CLASSID, "PetscDualSpace", "Dual Space", "PetscDualSpace", comm, PetscDualSpaceDestroy, PetscDualSpaceView);
1570: s->order = 0;
1571: s->Nc = 1;
1572: s->setupcalled = PETSC_FALSE;
1574: *sp = s;
1575: return(0);
1576: }
1578: /*@
1579: PetscDualSpaceDuplicate - Creates a duplicate PetscDualSpace object, however it is not setup.
1581: Collective on PetscDualSpace
1583: Input Parameter:
1584: . sp - The original PetscDualSpace
1586: Output Parameter:
1587: . spNew - The duplicate PetscDualSpace
1589: Level: beginner
1591: .seealso: PetscDualSpaceCreate(), PetscDualSpaceSetType()
1592: @*/
1593: PetscErrorCode PetscDualSpaceDuplicate(PetscDualSpace sp, PetscDualSpace *spNew)
1594: {
1600: (*sp->ops->duplicate)(sp, spNew);
1601: return(0);
1602: }
1604: /*@
1605: PetscDualSpaceGetDM - Get the DM representing the reference cell
1607: Not collective
1609: Input Parameter:
1610: . sp - The PetscDualSpace
1612: Output Parameter:
1613: . dm - The reference cell
1615: Level: intermediate
1617: .seealso: PetscDualSpaceSetDM(), PetscDualSpaceCreate()
1618: @*/
1619: PetscErrorCode PetscDualSpaceGetDM(PetscDualSpace sp, DM *dm)
1620: {
1624: *dm = sp->dm;
1625: return(0);
1626: }
1628: /*@
1629: PetscDualSpaceSetDM - Get the DM representing the reference cell
1631: Not collective
1633: Input Parameters:
1634: + sp - The PetscDualSpace
1635: - dm - The reference cell
1637: Level: intermediate
1639: .seealso: PetscDualSpaceGetDM(), PetscDualSpaceCreate()
1640: @*/
1641: PetscErrorCode PetscDualSpaceSetDM(PetscDualSpace sp, DM dm)
1642: {
1648: DMDestroy(&sp->dm);
1649: PetscObjectReference((PetscObject) dm);
1650: sp->dm = dm;
1651: return(0);
1652: }
1654: /*@
1655: PetscDualSpaceGetOrder - Get the order of the dual space
1657: Not collective
1659: Input Parameter:
1660: . sp - The PetscDualSpace
1662: Output Parameter:
1663: . order - The order
1665: Level: intermediate
1667: .seealso: PetscDualSpaceSetOrder(), PetscDualSpaceCreate()
1668: @*/
1669: PetscErrorCode PetscDualSpaceGetOrder(PetscDualSpace sp, PetscInt *order)
1670: {
1674: *order = sp->order;
1675: return(0);
1676: }
1678: /*@
1679: PetscDualSpaceSetOrder - Set the order of the dual space
1681: Not collective
1683: Input Parameters:
1684: + sp - The PetscDualSpace
1685: - order - The order
1687: Level: intermediate
1689: .seealso: PetscDualSpaceGetOrder(), PetscDualSpaceCreate()
1690: @*/
1691: PetscErrorCode PetscDualSpaceSetOrder(PetscDualSpace sp, PetscInt order)
1692: {
1695: sp->order = order;
1696: return(0);
1697: }
1699: /*@
1700: PetscDualSpaceGetNumComponents - Return the number of components for this space
1702: Input Parameter:
1703: . sp - The PetscDualSpace
1705: Output Parameter:
1706: . Nc - The number of components
1708: Note: A vector space, for example, will have d components, where d is the spatial dimension
1710: Level: intermediate
1712: .seealso: PetscDualSpaceSetNumComponents(), PetscDualSpaceGetDimension(), PetscDualSpaceCreate(), PetscDualSpace
1713: @*/
1714: PetscErrorCode PetscDualSpaceGetNumComponents(PetscDualSpace sp, PetscInt *Nc)
1715: {
1719: *Nc = sp->Nc;
1720: return(0);
1721: }
1723: /*@
1724: PetscDualSpaceSetNumComponents - Set the number of components for this space
1726: Input Parameters:
1727: + sp - The PetscDualSpace
1728: - order - The number of components
1730: Level: intermediate
1732: .seealso: PetscDualSpaceGetNumComponents(), PetscDualSpaceCreate(), PetscDualSpace
1733: @*/
1734: PetscErrorCode PetscDualSpaceSetNumComponents(PetscDualSpace sp, PetscInt Nc)
1735: {
1738: sp->Nc = Nc;
1739: return(0);
1740: }
1742: /*@
1743: PetscDualSpaceLagrangeGetTensor - Get the tensor nature of the dual space
1745: Not collective
1747: Input Parameter:
1748: . sp - The PetscDualSpace
1750: Output Parameter:
1751: . tensor - Whether the dual space has tensor layout (vs. simplicial)
1753: Level: intermediate
1755: .seealso: PetscDualSpaceLagrangeSetTensor(), PetscDualSpaceCreate()
1756: @*/
1757: PetscErrorCode PetscDualSpaceLagrangeGetTensor(PetscDualSpace sp, PetscBool *tensor)
1758: {
1764: PetscTryMethod(sp,"PetscDualSpaceLagrangeGetTensor_C",(PetscDualSpace,PetscBool *),(sp,tensor));
1765: return(0);
1766: }
1768: /*@
1769: PetscDualSpaceLagrangeSetTensor - Set the tensor nature of the dual space
1771: Not collective
1773: Input Parameters:
1774: + sp - The PetscDualSpace
1775: - tensor - Whether the dual space has tensor layout (vs. simplicial)
1777: Level: intermediate
1779: .seealso: PetscDualSpaceLagrangeGetTensor(), PetscDualSpaceCreate()
1780: @*/
1781: PetscErrorCode PetscDualSpaceLagrangeSetTensor(PetscDualSpace sp, PetscBool tensor)
1782: {
1787: PetscTryMethod(sp,"PetscDualSpaceLagrangeSetTensor_C",(PetscDualSpace,PetscBool),(sp,tensor));
1788: return(0);
1789: }
1791: /*@
1792: PetscDualSpaceGetFunctional - Get the i-th basis functional in the dual space
1794: Not collective
1796: Input Parameters:
1797: + sp - The PetscDualSpace
1798: - i - The basis number
1800: Output Parameter:
1801: . functional - The basis functional
1803: Level: intermediate
1805: .seealso: PetscDualSpaceGetDimension(), PetscDualSpaceCreate()
1806: @*/
1807: PetscErrorCode PetscDualSpaceGetFunctional(PetscDualSpace sp, PetscInt i, PetscQuadrature *functional)
1808: {
1809: PetscInt dim;
1815: PetscDualSpaceGetDimension(sp, &dim);
1816: if ((i < 0) || (i >= dim)) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Functional index %d must be in [0, %d)", i, dim);
1817: *functional = sp->functional[i];
1818: return(0);
1819: }
1821: /*@
1822: PetscDualSpaceGetDimension - Get the dimension of the dual space, i.e. the number of basis functionals
1824: Not collective
1826: Input Parameter:
1827: . sp - The PetscDualSpace
1829: Output Parameter:
1830: . dim - The dimension
1832: Level: intermediate
1834: .seealso: PetscDualSpaceGetFunctional(), PetscDualSpaceCreate()
1835: @*/
1836: PetscErrorCode PetscDualSpaceGetDimension(PetscDualSpace sp, PetscInt *dim)
1837: {
1843: *dim = 0;
1844: if (sp->ops->getdimension) {(*sp->ops->getdimension)(sp, dim);}
1845: return(0);
1846: }
1848: /*@C
1849: PetscDualSpaceGetNumDof - Get the number of degrees of freedom for each spatial (topological) dimension
1851: Not collective
1853: Input Parameter:
1854: . sp - The PetscDualSpace
1856: Output Parameter:
1857: . numDof - An array of length dim+1 which holds the number of dofs for each dimension
1859: Level: intermediate
1861: .seealso: PetscDualSpaceGetFunctional(), PetscDualSpaceCreate()
1862: @*/
1863: PetscErrorCode PetscDualSpaceGetNumDof(PetscDualSpace sp, const PetscInt **numDof)
1864: {
1870: (*sp->ops->getnumdof)(sp, numDof);
1871: if (!*numDof) SETERRQ(PetscObjectComm((PetscObject) sp), PETSC_ERR_LIB, "Empty numDof[] returned from dual space implementation");
1872: return(0);
1873: }
1875: /*@
1876: PetscDualSpaceCreateReferenceCell - Create a DMPLEX with the appropriate FEM reference cell
1878: Collective on PetscDualSpace
1880: Input Parameters:
1881: + sp - The PetscDualSpace
1882: . dim - The spatial dimension
1883: - simplex - Flag for simplex, otherwise use a tensor-product cell
1885: Output Parameter:
1886: . refdm - The reference cell
1888: Level: advanced
1890: .keywords: PetscDualSpace, reference cell
1891: .seealso: PetscDualSpaceCreate(), DMPLEX
1892: @*/
1893: PetscErrorCode PetscDualSpaceCreateReferenceCell(PetscDualSpace sp, PetscInt dim, PetscBool simplex, DM *refdm)
1894: {
1898: DMPlexCreateReferenceCell(PetscObjectComm((PetscObject) sp), dim, simplex, refdm);
1899: return(0);
1900: }
1902: /*@C
1903: PetscDualSpaceApply - Apply a functional from the dual space basis to an input function
1905: Input Parameters:
1906: + sp - The PetscDualSpace object
1907: . f - The basis functional index
1908: . time - The time
1909: . cgeom - A context with geometric information for this cell, we use v0 (the initial vertex) and J (the Jacobian)
1910: . numComp - The number of components for the function
1911: . func - The input function
1912: - ctx - A context for the function
1914: Output Parameter:
1915: . value - numComp output values
1917: Note: The calling sequence for the callback func is given by:
1919: $ func(PetscInt dim, PetscReal time, const PetscReal x[],
1920: $ PetscInt numComponents, PetscScalar values[], void *ctx)
1922: Level: developer
1924: .seealso: PetscDualSpaceCreate()
1925: @*/
1926: PetscErrorCode PetscDualSpaceApply(PetscDualSpace sp, PetscInt f, PetscReal time, PetscFECellGeom *cgeom, PetscInt numComp, PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void *ctx, PetscScalar *value)
1927: {
1934: (*sp->ops->apply)(sp, f, time, cgeom, numComp, func, ctx, value);
1935: return(0);
1936: }
1938: /*@C
1939: PetscDualSpaceApplyDefault - Apply a functional from the dual space basis to an input function by assuming a point evaluation functional.
1941: Input Parameters:
1942: + sp - The PetscDualSpace object
1943: . f - The basis functional index
1944: . time - The time
1945: . cgeom - A context with geometric information for this cell, we use v0 (the initial vertex) and J (the Jacobian)
1946: . Nc - The number of components for the function
1947: . func - The input function
1948: - ctx - A context for the function
1950: Output Parameter:
1951: . value - The output value
1953: Note: The calling sequence for the callback func is given by:
1955: $ func(PetscInt dim, PetscReal time, const PetscReal x[],
1956: $ PetscInt numComponents, PetscScalar values[], void *ctx)
1958: and the idea is to evaluate the functional as an integral
1960: $ n(f) = int dx n(x) . f(x)
1962: where both n and f have Nc components.
1964: Level: developer
1966: .seealso: PetscDualSpaceCreate()
1967: @*/
1968: PetscErrorCode PetscDualSpaceApplyDefault(PetscDualSpace sp, PetscInt f, PetscReal time, PetscFECellGeom *cgeom, PetscInt Nc, PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void *ctx, PetscScalar *value)
1969: {
1970: DM dm;
1971: PetscQuadrature n;
1972: const PetscReal *points, *weights;
1973: PetscReal x[3];
1974: PetscScalar *val;
1975: PetscInt dim, qNc, c, Nq, q;
1976: PetscErrorCode ierr;
1981: PetscDualSpaceGetDM(sp, &dm);
1982: PetscDualSpaceGetFunctional(sp, f, &n);
1983: PetscQuadratureGetData(n, &dim, &qNc, &Nq, &points, &weights);
1984: if (dim != cgeom->dim) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_SIZ, "The quadrature spatial dimension %D != cell geometry dimension %D", dim, cgeom->dim);
1985: if (qNc != Nc) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_SIZ, "The quadrature components %D != function components %D", qNc, Nc);
1986: DMGetWorkArray(dm, Nc, PETSC_SCALAR, &val);
1987: *value = 0.0;
1988: for (q = 0; q < Nq; ++q) {
1989: CoordinatesRefToReal(cgeom->dimEmbed, dim, cgeom->v0, cgeom->J, &points[q*dim], x);
1990: (*func)(cgeom->dimEmbed, time, x, Nc, val, ctx);
1991: for (c = 0; c < Nc; ++c) {
1992: *value += val[c]*weights[q*Nc+c];
1993: }
1994: }
1995: DMRestoreWorkArray(dm, Nc, PETSC_SCALAR, &val);
1996: return(0);
1997: }
1999: /*@C
2000: PetscDualSpaceApplyFVM - Apply a functional from the dual space basis to an input function by assuming a point evaluation functional at the cell centroid.
2002: Input Parameters:
2003: + sp - The PetscDualSpace object
2004: . f - The basis functional index
2005: . time - The time
2006: . cgeom - A context with geometric information for this cell, we currently just use the centroid
2007: . Nc - The number of components for the function
2008: . func - The input function
2009: - ctx - A context for the function
2011: Output Parameter:
2012: . value - The output value
2014: Note: The calling sequence for the callback func is given by:
2016: $ func(PetscInt dim, PetscReal time, const PetscReal x[],
2017: $ PetscInt numComponents, PetscScalar values[], void *ctx)
2019: and the idea is to evaluate the functional as an integral
2021: $ n(f) = int dx n(x) . f(x)
2023: where both n and f have Nc components.
2025: Level: developer
2027: .seealso: PetscDualSpaceCreate()
2028: @*/
2029: PetscErrorCode PetscDualSpaceApplyFVM(PetscDualSpace sp, PetscInt f, PetscReal time, PetscFVCellGeom *cgeom, PetscInt Nc, PetscErrorCode (*func)(PetscInt, PetscReal, const PetscReal [], PetscInt, PetscScalar *, void *), void *ctx, PetscScalar *value)
2030: {
2031: DM dm;
2032: PetscQuadrature n;
2033: const PetscReal *points, *weights;
2034: PetscScalar *val;
2035: PetscInt dimEmbed, qNc, c, Nq, q;
2036: PetscErrorCode ierr;
2041: PetscDualSpaceGetDM(sp, &dm);
2042: DMGetCoordinateDim(dm, &dimEmbed);
2043: PetscDualSpaceGetFunctional(sp, f, &n);
2044: PetscQuadratureGetData(n, NULL, &qNc, &Nq, &points, &weights);
2045: if (qNc != Nc) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_SIZ, "The quadrature components %D != function components %D", qNc, Nc);
2046: DMGetWorkArray(dm, Nc, PETSC_SCALAR, &val);
2047: for (c = 0; c < Nc; ++c) value[c] = 0.0;
2048: for (q = 0; q < Nq; ++q) {
2049: (*func)(dimEmbed, time, cgeom->centroid, Nc, val, ctx);
2050: for (c = 0; c < Nc; ++c) {
2051: value[c] += val[c]*weights[q*Nc+c];
2052: }
2053: }
2054: DMRestoreWorkArray(dm, Nc, PETSC_SCALAR, &val);
2055: return(0);
2056: }
2058: /*@
2059: PetscDualSpaceGetHeightSubspace - Get the subset of the dual space basis that is supported on a mesh point of a given height.
2061: If the dual space is not defined on mesh points of the given height (e.g. if the space is discontinuous and
2062: pointwise values are not defined on the element boundaries), or if the implementation of PetscDualSpace does not
2063: support extracting subspaces, then NULL is returned.
2065: This does not increment the reference count on the returned dual space, and the user should not destroy it.
2067: Not collective
2069: Input Parameters:
2070: + sp - the PetscDualSpace object
2071: - height - the height of the mesh point for which the subspace is desired
2073: Output Parameter:
2074: . subsp - the subspace
2076: Level: advanced
2078: .seealso: PetscSpaceGetHeightSubspace(), PetscDualSpace
2079: @*/
2080: PetscErrorCode PetscDualSpaceGetHeightSubspace(PetscDualSpace sp, PetscInt height, PetscDualSpace *subsp)
2081: {
2087: *subsp = NULL;
2088: if (sp->ops->getheightsubspace) {
2089: (*sp->ops->getheightsubspace)(sp, height, subsp);
2090: }
2091: return(0);
2092: }
2094: static PetscErrorCode PetscDualSpaceLagrangeGetTensor_Lagrange(PetscDualSpace sp, PetscBool *tensor)
2095: {
2096: PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2099: *tensor = lag->tensorSpace;
2100: return(0);
2101: }
2103: static PetscErrorCode PetscDualSpaceLagrangeSetTensor_Lagrange(PetscDualSpace sp, PetscBool tensor)
2104: {
2105: PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *)sp->data;
2108: lag->tensorSpace = tensor;
2109: return(0);
2110: }
2112: #define BaryIndex(perEdge,a,b,c) (((b)*(2*perEdge+1-(b)))/2)+(c)
2114: #define CartIndex(perEdge,a,b) (perEdge*(a)+b)
2116: static PetscErrorCode PetscDualSpaceGetSymmetries_Lagrange(PetscDualSpace sp, const PetscInt ****perms, const PetscScalar ****flips)
2117: {
2119: PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2120: PetscInt dim, order, p, Nc;
2121: PetscErrorCode ierr;
2124: PetscDualSpaceGetOrder(sp,&order);
2125: PetscDualSpaceGetNumComponents(sp,&Nc);
2126: DMGetDimension(sp->dm,&dim);
2127: if (!dim || !lag->continuous || order < 3) return(0);
2128: if (dim > 3) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Lagrange symmetries not implemented for dim = %D > 3",dim);
2129: if (!lag->symmetries) { /* store symmetries */
2130: PetscDualSpace hsp;
2131: DM K;
2132: PetscInt numPoints = 1, d;
2133: PetscInt numFaces;
2134: PetscInt ***symmetries;
2135: const PetscInt ***hsymmetries;
2137: if (lag->simplexCell) {
2138: numFaces = 1 + dim;
2139: for (d = 0; d < dim; d++) numPoints = numPoints * 2 + 1;
2140: }
2141: else {
2142: numPoints = PetscPowInt(3,dim);
2143: numFaces = 2 * dim;
2144: }
2145: PetscCalloc1(numPoints,&symmetries);
2146: if (0 < dim && dim < 3) { /* compute self symmetries */
2147: PetscInt **cellSymmetries;
2149: lag->numSelfSym = 2 * numFaces;
2150: lag->selfSymOff = numFaces;
2151: PetscCalloc1(2*numFaces,&cellSymmetries);
2152: /* we want to be able to index symmetries directly with the orientations, which range from [-numFaces,numFaces) */
2153: symmetries[0] = &cellSymmetries[numFaces];
2154: if (dim == 1) {
2155: PetscInt dofPerEdge = order - 1;
2157: if (dofPerEdge > 1) {
2158: PetscInt i, j, *reverse;
2160: PetscMalloc1(dofPerEdge*Nc,&reverse);
2161: for (i = 0; i < dofPerEdge; i++) {
2162: for (j = 0; j < Nc; j++) {
2163: reverse[i*Nc + j] = Nc * (dofPerEdge - 1 - i) + j;
2164: }
2165: }
2166: symmetries[0][-2] = reverse;
2168: /* yes, this is redundant, but it makes it easier to cleanup if I don't have to worry about what not to free */
2169: PetscMalloc1(dofPerEdge*Nc,&reverse);
2170: for (i = 0; i < dofPerEdge; i++) {
2171: for (j = 0; j < Nc; j++) {
2172: reverse[i*Nc + j] = Nc * (dofPerEdge - 1 - i) + j;
2173: }
2174: }
2175: symmetries[0][1] = reverse;
2176: }
2177: } else {
2178: PetscInt dofPerEdge = lag->simplexCell ? (order - 2) : (order - 1), s;
2179: PetscInt dofPerFace;
2181: if (dofPerEdge > 1) {
2182: for (s = -numFaces; s < numFaces; s++) {
2183: PetscInt *sym, i, j, k, l;
2185: if (!s) continue;
2186: if (lag->simplexCell) {
2187: dofPerFace = (dofPerEdge * (dofPerEdge + 1))/2;
2188: PetscMalloc1(Nc*dofPerFace,&sym);
2189: for (j = 0, l = 0; j < dofPerEdge; j++) {
2190: for (k = 0; k < dofPerEdge - j; k++, l++) {
2191: i = dofPerEdge - 1 - j - k;
2192: switch (s) {
2193: case -3:
2194: sym[Nc*l] = BaryIndex(dofPerEdge,i,k,j);
2195: break;
2196: case -2:
2197: sym[Nc*l] = BaryIndex(dofPerEdge,j,i,k);
2198: break;
2199: case -1:
2200: sym[Nc*l] = BaryIndex(dofPerEdge,k,j,i);
2201: break;
2202: case 1:
2203: sym[Nc*l] = BaryIndex(dofPerEdge,k,i,j);
2204: break;
2205: case 2:
2206: sym[Nc*l] = BaryIndex(dofPerEdge,j,k,i);
2207: break;
2208: }
2209: }
2210: }
2211: } else {
2212: dofPerFace = dofPerEdge * dofPerEdge;
2213: PetscMalloc1(Nc*dofPerFace,&sym);
2214: for (j = 0, l = 0; j < dofPerEdge; j++) {
2215: for (k = 0; k < dofPerEdge; k++, l++) {
2216: switch (s) {
2217: case -4:
2218: sym[Nc*l] = CartIndex(dofPerEdge,k,j);
2219: break;
2220: case -3:
2221: sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - j),k);
2222: break;
2223: case -2:
2224: sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - k),(dofPerEdge - 1 - j));
2225: break;
2226: case -1:
2227: sym[Nc*l] = CartIndex(dofPerEdge,j,(dofPerEdge - 1 - k));
2228: break;
2229: case 1:
2230: sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - k),j);
2231: break;
2232: case 2:
2233: sym[Nc*l] = CartIndex(dofPerEdge,(dofPerEdge - 1 - j),(dofPerEdge - 1 - k));
2234: break;
2235: case 3:
2236: sym[Nc*l] = CartIndex(dofPerEdge,k,(dofPerEdge - 1 - j));
2237: break;
2238: }
2239: }
2240: }
2241: }
2242: for (i = 0; i < dofPerFace; i++) {
2243: sym[Nc*i] *= Nc;
2244: for (j = 1; j < Nc; j++) {
2245: sym[Nc*i+j] = sym[Nc*i] + j;
2246: }
2247: }
2248: symmetries[0][s] = sym;
2249: }
2250: }
2251: }
2252: }
2253: PetscDualSpaceGetHeightSubspace(sp,1,&hsp);
2254: PetscDualSpaceGetSymmetries(hsp,&hsymmetries,NULL);
2255: if (hsymmetries) {
2256: PetscBool *seen;
2257: const PetscInt *cone;
2258: PetscInt KclosureSize, *Kclosure = NULL;
2260: PetscDualSpaceGetDM(sp,&K);
2261: PetscCalloc1(numPoints,&seen);
2262: DMPlexGetCone(K,0,&cone);
2263: DMPlexGetTransitiveClosure(K,0,PETSC_TRUE,&KclosureSize,&Kclosure);
2264: for (p = 0; p < numFaces; p++) {
2265: PetscInt closureSize, *closure = NULL, q;
2267: DMPlexGetTransitiveClosure(K,cone[p],PETSC_TRUE,&closureSize,&closure);
2268: for (q = 0; q < closureSize; q++) {
2269: PetscInt point = closure[2*q], r;
2271: if(!seen[point]) {
2272: for (r = 0; r < KclosureSize; r++) {
2273: if (Kclosure[2 * r] == point) break;
2274: }
2275: seen[point] = PETSC_TRUE;
2276: symmetries[r] = (PetscInt **) hsymmetries[q];
2277: }
2278: }
2279: DMPlexRestoreTransitiveClosure(K,cone[p],PETSC_TRUE,&closureSize,&closure);
2280: }
2281: DMPlexRestoreTransitiveClosure(K,0,PETSC_TRUE,&KclosureSize,&Kclosure);
2282: PetscFree(seen);
2283: }
2284: lag->symmetries = symmetries;
2285: }
2286: if (perms) *perms = (const PetscInt ***) lag->symmetries;
2287: return(0);
2288: }
2290: /*@C
2291: PetscDualSpaceGetSymmetries - Returns a description of the symmetries of this basis
2293: Not collective
2295: Input Parameter:
2296: . sp - the PetscDualSpace object
2298: Output Parameters:
2299: + perms - Permutations of the local degrees of freedom, parameterized by the point orientation
2300: - flips - Sign reversal of the local degrees of freedom, parameterized by the point orientation
2302: Note: The permutation and flip arrays are organized in the following way
2303: $ perms[p][ornt][dof # on point] = new local dof #
2304: $ flips[p][ornt][dof # on point] = reversal or not
2306: Level: developer
2308: .seealso: PetscDualSpaceSetSymmetries()
2309: @*/
2310: PetscErrorCode PetscDualSpaceGetSymmetries(PetscDualSpace sp, const PetscInt ****perms, const PetscScalar ****flips)
2311: {
2316: if (perms) {
2318: *perms = NULL;
2319: }
2320: if (flips) {
2322: *flips = NULL;
2323: }
2324: if (sp->ops->getsymmetries) {
2325: (sp->ops->getsymmetries)(sp,perms,flips);
2326: }
2327: return(0);
2328: }
2330: static PetscErrorCode PetscDualSpaceGetDimension_SingleCell_Lagrange(PetscDualSpace sp, PetscInt order, PetscInt *dim)
2331: {
2332: PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2333: PetscReal D = 1.0;
2334: PetscInt n, i;
2335: PetscErrorCode ierr;
2338: *dim = -1; /* Ensure that the compiler knows *dim is set. */
2339: DMGetDimension(sp->dm, &n);
2340: if (!lag->tensorSpace) {
2341: for (i = 1; i <= n; ++i) {
2342: D *= ((PetscReal) (order+i))/i;
2343: }
2344: *dim = (PetscInt) (D + 0.5);
2345: } else {
2346: *dim = 1;
2347: for (i = 0; i < n; ++i) *dim *= (order+1);
2348: }
2349: *dim *= sp->Nc;
2350: return(0);
2351: }
2353: static PetscErrorCode PetscDualSpaceCreateHeightSubspace_Lagrange(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
2354: {
2355: PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2356: PetscBool continuous, tensor;
2357: PetscInt order;
2358: PetscErrorCode ierr;
2363: PetscDualSpaceLagrangeGetContinuity(sp,&continuous);
2364: PetscDualSpaceGetOrder(sp,&order);
2365: if (height == 0) {
2366: PetscObjectReference((PetscObject)sp);
2367: *bdsp = sp;
2368: } else if (continuous == PETSC_FALSE || !order) {
2369: *bdsp = NULL;
2370: } else {
2371: DM dm, K;
2372: PetscInt dim;
2374: PetscDualSpaceGetDM(sp,&dm);
2375: DMGetDimension(dm,&dim);
2376: if (height > dim || height < 0) {SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Asked for dual space at height %d for dimension %d reference element\n",height,dim);}
2377: PetscDualSpaceDuplicate(sp,bdsp);
2378: PetscDualSpaceCreateReferenceCell(*bdsp, dim-height, lag->simplexCell, &K);
2379: PetscDualSpaceSetDM(*bdsp, K);
2380: DMDestroy(&K);
2381: PetscDualSpaceLagrangeGetTensor(sp,&tensor);
2382: PetscDualSpaceLagrangeSetTensor(*bdsp,tensor);
2383: PetscDualSpaceSetUp(*bdsp);
2384: }
2385: return(0);
2386: }
2388: PetscErrorCode PetscDualSpaceSetUp_Lagrange(PetscDualSpace sp)
2389: {
2390: PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2391: DM dm = sp->dm;
2392: PetscInt order = sp->order;
2393: PetscInt Nc = sp->Nc;
2394: PetscBool continuous;
2395: PetscSection csection;
2396: Vec coordinates;
2397: PetscReal *qpoints, *qweights;
2398: PetscInt depth, dim, pdimMax, pStart, pEnd, p, *pStratStart, *pStratEnd, coneSize, d, f = 0, c;
2399: PetscBool simplex, tensorSpace;
2400: PetscErrorCode ierr;
2403: /* Classify element type */
2404: if (!order) lag->continuous = PETSC_FALSE;
2405: continuous = lag->continuous;
2406: DMGetDimension(dm, &dim);
2407: DMPlexGetDepth(dm, &depth);
2408: DMPlexGetChart(dm, &pStart, &pEnd);
2409: PetscCalloc1(dim+1, &lag->numDof);
2410: PetscMalloc2(depth+1,&pStratStart,depth+1,&pStratEnd);
2411: for (d = 0; d <= depth; ++d) {DMPlexGetDepthStratum(dm, d, &pStratStart[d], &pStratEnd[d]);}
2412: DMPlexGetConeSize(dm, pStratStart[depth], &coneSize);
2413: DMGetCoordinateSection(dm, &csection);
2414: DMGetCoordinatesLocal(dm, &coordinates);
2415: if (depth == 1) {
2416: if (coneSize == dim+1) simplex = PETSC_TRUE;
2417: else if (coneSize == 1 << dim) simplex = PETSC_FALSE;
2418: else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
2419: } else if (depth == dim) {
2420: if (coneSize == dim+1) simplex = PETSC_TRUE;
2421: else if (coneSize == 2 * dim) simplex = PETSC_FALSE;
2422: else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support simplices and tensor product cells");
2423: } else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only support cell-vertex meshes or interpolated meshes");
2424: lag->simplexCell = simplex;
2425: if (dim > 1 && continuous && lag->simplexCell == lag->tensorSpace) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP, "Mismatching simplex/tensor cells and spaces only allowed for discontinuous elements");
2426: tensorSpace = lag->tensorSpace;
2427: lag->height = 0;
2428: lag->subspaces = NULL;
2429: if (continuous && sp->order > 0 && dim > 0) {
2430: PetscInt i;
2432: lag->height = dim;
2433: PetscMalloc1(dim,&lag->subspaces);
2434: PetscDualSpaceCreateHeightSubspace_Lagrange(sp,1,&lag->subspaces[0]);
2435: PetscDualSpaceSetUp(lag->subspaces[0]);
2436: for (i = 1; i < dim; i++) {
2437: PetscDualSpaceGetHeightSubspace(lag->subspaces[i-1],1,&lag->subspaces[i]);
2438: PetscObjectReference((PetscObject)(lag->subspaces[i]));
2439: }
2440: }
2441: PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, sp->order, &pdimMax);
2442: pdimMax *= (pStratEnd[depth] - pStratStart[depth]);
2443: PetscMalloc1(pdimMax, &sp->functional);
2444: if (!dim) {
2445: for (c = 0; c < Nc; ++c) {
2446: PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2447: PetscCalloc1(Nc, &qweights);
2448: PetscQuadratureSetOrder(sp->functional[f], 0);
2449: PetscQuadratureSetData(sp->functional[f], 0, Nc, 1, NULL, qweights);
2450: qweights[c] = 1.0;
2451: ++f;
2452: lag->numDof[0]++;
2453: }
2454: } else {
2455: PetscInt *tup;
2456: PetscReal *v0, *hv0, *J, *invJ, detJ, hdetJ;
2457: PetscSection section;
2459: PetscSectionCreate(PETSC_COMM_SELF,§ion);
2460: PetscSectionSetChart(section,pStart,pEnd);
2461: PetscCalloc5(dim+1,&tup,dim,&v0,dim,&hv0,dim*dim,&J,dim*dim,&invJ);
2462: for (p = pStart; p < pEnd; p++) {
2463: PetscInt pointDim, d, nFunc = 0;
2464: PetscDualSpace hsp;
2466: DMPlexComputeCellGeometryFEM(dm, p, NULL, v0, J, invJ, &detJ);
2467: for (d = 0; d < depth; d++) {if (p >= pStratStart[d] && p < pStratEnd[d]) break;}
2468: pointDim = (depth == 1 && d == 1) ? dim : d;
2469: hsp = ((pointDim < dim) && lag->subspaces) ? lag->subspaces[dim - pointDim - 1] : NULL;
2470: if (hsp) {
2471: PetscDualSpace_Lag *hlag = (PetscDualSpace_Lag *) hsp->data;
2472: DM hdm;
2474: PetscDualSpaceGetDM(hsp,&hdm);
2475: DMPlexComputeCellGeometryFEM(hdm, 0, NULL, hv0, NULL, NULL, &hdetJ);
2476: nFunc = lag->numDof[pointDim] = hlag->numDof[pointDim];
2477: }
2478: if (pointDim == dim) {
2479: /* Cells, create for self */
2480: PetscInt orderEff = continuous ? (!tensorSpace ? order-1-dim : order-2) : order;
2481: PetscReal denom = continuous ? order : (!tensorSpace ? order+1+dim : order+2);
2482: PetscReal numer = (!simplex || !tensorSpace) ? 2. : (2./dim);
2483: PetscReal dx = numer/denom;
2484: PetscInt cdim, d, d2;
2486: if (orderEff < 0) continue;
2487: PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, orderEff, &cdim);
2488: PetscMemzero(tup,(dim+1)*sizeof(PetscInt));
2489: if (!tensorSpace) {
2490: while (!tup[dim]) {
2491: for (c = 0; c < Nc; ++c) {
2492: PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2493: PetscMalloc1(dim, &qpoints);
2494: PetscCalloc1(Nc, &qweights);
2495: PetscQuadratureSetOrder(sp->functional[f], 0);
2496: PetscQuadratureSetData(sp->functional[f], dim, Nc, 1, qpoints, qweights);
2497: for (d = 0; d < dim; ++d) {
2498: qpoints[d] = v0[d];
2499: for (d2 = 0; d2 < dim; ++d2) qpoints[d] += J[d*dim+d2]*((tup[d2]+1)*dx);
2500: }
2501: qweights[c] = 1.0;
2502: ++f;
2503: }
2504: LatticePointLexicographic_Internal(dim, orderEff, tup);
2505: }
2506: } else {
2507: while (!tup[dim]) {
2508: for (c = 0; c < Nc; ++c) {
2509: PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2510: PetscMalloc1(dim, &qpoints);
2511: PetscCalloc1(Nc, &qweights);
2512: PetscQuadratureSetOrder(sp->functional[f], 0);
2513: PetscQuadratureSetData(sp->functional[f], dim, Nc, 1, qpoints, qweights);
2514: for (d = 0; d < dim; ++d) {
2515: qpoints[d] = v0[d];
2516: for (d2 = 0; d2 < dim; ++d2) qpoints[d] += J[d*dim+d2]*((tup[d2]+1)*dx);
2517: }
2518: qweights[c] = 1.0;
2519: ++f;
2520: }
2521: TensorPointLexicographic_Internal(dim, orderEff, tup);
2522: }
2523: }
2524: lag->numDof[dim] = cdim;
2525: } else { /* transform functionals from subspaces */
2526: PetscInt q;
2528: for (q = 0; q < nFunc; q++, f++) {
2529: PetscQuadrature fn;
2530: PetscInt fdim, Nc, c, nPoints, i;
2531: const PetscReal *points;
2532: const PetscReal *weights;
2533: PetscReal *qpoints;
2534: PetscReal *qweights;
2536: PetscDualSpaceGetFunctional(hsp, q, &fn);
2537: PetscQuadratureGetData(fn,&fdim,&Nc,&nPoints,&points,&weights);
2538: if (fdim != pointDim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Expected height dual space dim %D, got %D",pointDim,fdim);
2539: PetscMalloc1(nPoints * dim, &qpoints);
2540: PetscCalloc1(nPoints * Nc, &qweights);
2541: for (i = 0; i < nPoints; i++) {
2542: PetscInt j, k;
2543: PetscReal *qp = &qpoints[i * dim];
2545: for (c = 0; c < Nc; ++c) qweights[i*Nc+c] = weights[i*Nc+c];
2546: for (j = 0; j < dim; ++j) qp[j] = v0[j];
2547: for (j = 0; j < dim; ++j) {
2548: for (k = 0; k < pointDim; k++) qp[j] += J[dim * j + k] * (points[pointDim * i + k] - hv0[k]);
2549: }
2550: }
2551: PetscQuadratureCreate(PETSC_COMM_SELF, &sp->functional[f]);
2552: PetscQuadratureSetOrder(sp->functional[f],0);
2553: PetscQuadratureSetData(sp->functional[f],dim,Nc,nPoints,qpoints,qweights);
2554: }
2555: }
2556: PetscSectionSetDof(section,p,lag->numDof[pointDim]);
2557: }
2558: PetscFree5(tup,v0,hv0,J,invJ);
2559: PetscSectionSetUp(section);
2560: { /* reorder to closure order */
2561: PetscInt *key, count;
2562: PetscQuadrature *reorder = NULL;
2564: PetscCalloc1(f,&key);
2565: PetscMalloc1(f*sp->Nc,&reorder);
2567: for (p = pStratStart[depth], count = 0; p < pStratEnd[depth]; p++) {
2568: PetscInt *closure = NULL, closureSize, c;
2570: DMPlexGetTransitiveClosure(dm,p,PETSC_TRUE,&closureSize,&closure);
2571: for (c = 0; c < closureSize; c++) {
2572: PetscInt point = closure[2 * c], dof, off, i;
2574: PetscSectionGetDof(section,point,&dof);
2575: PetscSectionGetOffset(section,point,&off);
2576: for (i = 0; i < dof; i++) {
2577: PetscInt fi = i + off;
2578: if (!key[fi]) {
2579: key[fi] = 1;
2580: reorder[count++] = sp->functional[fi];
2581: }
2582: }
2583: }
2584: DMPlexRestoreTransitiveClosure(dm,p,PETSC_TRUE,&closureSize,&closure);
2585: }
2586: PetscFree(sp->functional);
2587: sp->functional = reorder;
2588: PetscFree(key);
2589: }
2590: PetscSectionDestroy(§ion);
2591: }
2592: if (pStratEnd[depth] == 1 && f != pdimMax) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of dual basis vectors %d not equal to dimension %d", f, pdimMax);
2593: PetscFree2(pStratStart, pStratEnd);
2594: if (f > pdimMax) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of dual basis vectors %d is greater than dimension %d", f, pdimMax);
2595: return(0);
2596: }
2598: PetscErrorCode PetscDualSpaceDestroy_Lagrange(PetscDualSpace sp)
2599: {
2600: PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2601: PetscInt i;
2602: PetscErrorCode ierr;
2605: if (lag->symmetries) {
2606: PetscInt **selfSyms = lag->symmetries[0];
2608: if (selfSyms) {
2609: PetscInt i, **allocated = &selfSyms[-lag->selfSymOff];
2611: for (i = 0; i < lag->numSelfSym; i++) {
2612: PetscFree(allocated[i]);
2613: }
2614: PetscFree(allocated);
2615: }
2616: PetscFree(lag->symmetries);
2617: }
2618: for (i = 0; i < lag->height; i++) {
2619: PetscDualSpaceDestroy(&lag->subspaces[i]);
2620: }
2621: PetscFree(lag->subspaces);
2622: PetscFree(lag->numDof);
2623: PetscFree(lag);
2624: PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", NULL);
2625: PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", NULL);
2626: PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", NULL);
2627: PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", NULL);
2628: return(0);
2629: }
2631: PetscErrorCode PetscDualSpaceDuplicate_Lagrange(PetscDualSpace sp, PetscDualSpace *spNew)
2632: {
2633: PetscInt order, Nc;
2634: PetscBool cont, tensor;
2638: PetscDualSpaceCreate(PetscObjectComm((PetscObject) sp), spNew);
2639: PetscDualSpaceSetType(*spNew, PETSCDUALSPACELAGRANGE);
2640: PetscDualSpaceGetOrder(sp, &order);
2641: PetscDualSpaceSetOrder(*spNew, order);
2642: PetscDualSpaceGetNumComponents(sp, &Nc);
2643: PetscDualSpaceSetNumComponents(*spNew, Nc);
2644: PetscDualSpaceLagrangeGetContinuity(sp, &cont);
2645: PetscDualSpaceLagrangeSetContinuity(*spNew, cont);
2646: PetscDualSpaceLagrangeGetTensor(sp, &tensor);
2647: PetscDualSpaceLagrangeSetTensor(*spNew, tensor);
2648: return(0);
2649: }
2651: PetscErrorCode PetscDualSpaceSetFromOptions_Lagrange(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp)
2652: {
2653: PetscBool continuous, tensor, flg;
2657: PetscDualSpaceLagrangeGetContinuity(sp, &continuous);
2658: PetscDualSpaceLagrangeGetTensor(sp, &tensor);
2659: PetscOptionsHead(PetscOptionsObject,"PetscDualSpace Lagrange Options");
2660: PetscOptionsBool("-petscdualspace_lagrange_continuity", "Flag for continuous element", "PetscDualSpaceLagrangeSetContinuity", continuous, &continuous, &flg);
2661: if (flg) {PetscDualSpaceLagrangeSetContinuity(sp, continuous);}
2662: PetscOptionsBool("-petscdualspace_lagrange_tensor", "Flag for tensor dual space", "PetscDualSpaceLagrangeSetContinuity", tensor, &tensor, &flg);
2663: if (flg) {PetscDualSpaceLagrangeSetTensor(sp, tensor);}
2664: PetscOptionsTail();
2665: return(0);
2666: }
2668: PetscErrorCode PetscDualSpaceGetDimension_Lagrange(PetscDualSpace sp, PetscInt *dim)
2669: {
2670: DM K;
2671: const PetscInt *numDof;
2672: PetscInt spatialDim, Nc, size = 0, d;
2673: PetscErrorCode ierr;
2676: PetscDualSpaceGetDM(sp, &K);
2677: PetscDualSpaceGetNumDof(sp, &numDof);
2678: DMGetDimension(K, &spatialDim);
2679: DMPlexGetHeightStratum(K, 0, NULL, &Nc);
2680: if (Nc == 1) {PetscDualSpaceGetDimension_SingleCell_Lagrange(sp, sp->order, dim); return(0);}
2681: for (d = 0; d <= spatialDim; ++d) {
2682: PetscInt pStart, pEnd;
2684: DMPlexGetDepthStratum(K, d, &pStart, &pEnd);
2685: size += (pEnd-pStart)*numDof[d];
2686: }
2687: *dim = size;
2688: return(0);
2689: }
2691: PetscErrorCode PetscDualSpaceGetNumDof_Lagrange(PetscDualSpace sp, const PetscInt **numDof)
2692: {
2693: PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2696: *numDof = lag->numDof;
2697: return(0);
2698: }
2700: static PetscErrorCode PetscDualSpaceLagrangeGetContinuity_Lagrange(PetscDualSpace sp, PetscBool *continuous)
2701: {
2702: PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2707: *continuous = lag->continuous;
2708: return(0);
2709: }
2711: static PetscErrorCode PetscDualSpaceLagrangeSetContinuity_Lagrange(PetscDualSpace sp, PetscBool continuous)
2712: {
2713: PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2717: lag->continuous = continuous;
2718: return(0);
2719: }
2721: /*@
2722: PetscDualSpaceLagrangeGetContinuity - Retrieves the flag for element continuity
2724: Not Collective
2726: Input Parameter:
2727: . sp - the PetscDualSpace
2729: Output Parameter:
2730: . continuous - flag for element continuity
2732: Level: intermediate
2734: .keywords: PetscDualSpace, Lagrange, continuous, discontinuous
2735: .seealso: PetscDualSpaceLagrangeSetContinuity()
2736: @*/
2737: PetscErrorCode PetscDualSpaceLagrangeGetContinuity(PetscDualSpace sp, PetscBool *continuous)
2738: {
2744: PetscTryMethod(sp, "PetscDualSpaceLagrangeGetContinuity_C", (PetscDualSpace,PetscBool*),(sp,continuous));
2745: return(0);
2746: }
2748: /*@
2749: PetscDualSpaceLagrangeSetContinuity - Indicate whether the element is continuous
2751: Logically Collective on PetscDualSpace
2753: Input Parameters:
2754: + sp - the PetscDualSpace
2755: - continuous - flag for element continuity
2757: Options Database:
2758: . -petscdualspace_lagrange_continuity <bool>
2760: Level: intermediate
2762: .keywords: PetscDualSpace, Lagrange, continuous, discontinuous
2763: .seealso: PetscDualSpaceLagrangeGetContinuity()
2764: @*/
2765: PetscErrorCode PetscDualSpaceLagrangeSetContinuity(PetscDualSpace sp, PetscBool continuous)
2766: {
2772: PetscTryMethod(sp, "PetscDualSpaceLagrangeSetContinuity_C", (PetscDualSpace,PetscBool),(sp,continuous));
2773: return(0);
2774: }
2776: PetscErrorCode PetscDualSpaceGetHeightSubspace_Lagrange(PetscDualSpace sp, PetscInt height, PetscDualSpace *bdsp)
2777: {
2778: PetscDualSpace_Lag *lag = (PetscDualSpace_Lag *) sp->data;
2779: PetscErrorCode ierr;
2784: if (height == 0) {
2785: *bdsp = sp;
2786: }
2787: else {
2788: DM dm;
2789: PetscInt dim;
2791: PetscDualSpaceGetDM(sp,&dm);
2792: DMGetDimension(dm,&dim);
2793: if (height > dim || height < 0) {SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Asked for dual space at height %d for dimension %d reference element\n",height,dim);}
2794: if (height <= lag->height) {
2795: *bdsp = lag->subspaces[height-1];
2796: }
2797: else {
2798: *bdsp = NULL;
2799: }
2800: }
2801: return(0);
2802: }
2804: PetscErrorCode PetscDualSpaceInitialize_Lagrange(PetscDualSpace sp)
2805: {
2807: sp->ops->setfromoptions = PetscDualSpaceSetFromOptions_Lagrange;
2808: sp->ops->setup = PetscDualSpaceSetUp_Lagrange;
2809: sp->ops->view = NULL;
2810: sp->ops->destroy = PetscDualSpaceDestroy_Lagrange;
2811: sp->ops->duplicate = PetscDualSpaceDuplicate_Lagrange;
2812: sp->ops->getdimension = PetscDualSpaceGetDimension_Lagrange;
2813: sp->ops->getnumdof = PetscDualSpaceGetNumDof_Lagrange;
2814: sp->ops->getheightsubspace = PetscDualSpaceGetHeightSubspace_Lagrange;
2815: sp->ops->getsymmetries = PetscDualSpaceGetSymmetries_Lagrange;
2816: sp->ops->apply = PetscDualSpaceApplyDefault;
2817: return(0);
2818: }
2820: /*MC
2821: PETSCDUALSPACELAGRANGE = "lagrange" - A PetscDualSpace object that encapsulates a dual space of pointwise evaluation functionals
2823: Level: intermediate
2825: .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
2826: M*/
2828: PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Lagrange(PetscDualSpace sp)
2829: {
2830: PetscDualSpace_Lag *lag;
2831: PetscErrorCode ierr;
2835: PetscNewLog(sp,&lag);
2836: sp->data = lag;
2838: lag->numDof = NULL;
2839: lag->simplexCell = PETSC_TRUE;
2840: lag->tensorSpace = PETSC_FALSE;
2841: lag->continuous = PETSC_TRUE;
2843: PetscDualSpaceInitialize_Lagrange(sp);
2844: PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetContinuity_C", PetscDualSpaceLagrangeGetContinuity_Lagrange);
2845: PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetContinuity_C", PetscDualSpaceLagrangeSetContinuity_Lagrange);
2846: PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeGetTensor_C", PetscDualSpaceLagrangeGetTensor_Lagrange);
2847: PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceLagrangeSetTensor_C", PetscDualSpaceLagrangeSetTensor_Lagrange);
2848: return(0);
2849: }
2851: PetscErrorCode PetscDualSpaceSetUp_Simple(PetscDualSpace sp)
2852: {
2853: PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2854: DM dm = sp->dm;
2855: PetscInt dim;
2856: PetscErrorCode ierr;
2859: DMGetDimension(dm, &dim);
2860: PetscCalloc1(dim+1, &s->numDof);
2861: return(0);
2862: }
2864: PetscErrorCode PetscDualSpaceDestroy_Simple(PetscDualSpace sp)
2865: {
2866: PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2867: PetscErrorCode ierr;
2870: PetscFree(s->numDof);
2871: PetscFree(s);
2872: PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetDimension_C", NULL);
2873: PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetFunctional_C", NULL);
2874: return(0);
2875: }
2877: PetscErrorCode PetscDualSpaceDuplicate_Simple(PetscDualSpace sp, PetscDualSpace *spNew)
2878: {
2879: PetscInt dim, d, Nc;
2883: PetscDualSpaceCreate(PetscObjectComm((PetscObject) sp), spNew);
2884: PetscDualSpaceSetType(*spNew, PETSCDUALSPACESIMPLE);
2885: PetscDualSpaceGetNumComponents(sp, &Nc);
2886: PetscDualSpaceSetNumComponents(sp, Nc);
2887: PetscDualSpaceGetDimension(sp, &dim);
2888: PetscDualSpaceSimpleSetDimension(*spNew, dim);
2889: for (d = 0; d < dim; ++d) {
2890: PetscQuadrature q;
2892: PetscDualSpaceGetFunctional(sp, d, &q);
2893: PetscDualSpaceSimpleSetFunctional(*spNew, d, q);
2894: }
2895: return(0);
2896: }
2898: PetscErrorCode PetscDualSpaceSetFromOptions_Simple(PetscOptionItems *PetscOptionsObject,PetscDualSpace sp)
2899: {
2901: return(0);
2902: }
2904: PetscErrorCode PetscDualSpaceGetDimension_Simple(PetscDualSpace sp, PetscInt *dim)
2905: {
2906: PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2909: *dim = s->dim;
2910: return(0);
2911: }
2913: PetscErrorCode PetscDualSpaceSimpleSetDimension_Simple(PetscDualSpace sp, const PetscInt dim)
2914: {
2915: PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2916: DM dm;
2917: PetscInt spatialDim, f;
2918: PetscErrorCode ierr;
2921: for (f = 0; f < s->dim; ++f) {PetscQuadratureDestroy(&sp->functional[f]);}
2922: PetscFree(sp->functional);
2923: s->dim = dim;
2924: PetscCalloc1(s->dim, &sp->functional);
2925: PetscFree(s->numDof);
2926: PetscDualSpaceGetDM(sp, &dm);
2927: DMGetCoordinateDim(dm, &spatialDim);
2928: PetscCalloc1(spatialDim+1, &s->numDof);
2929: s->numDof[spatialDim] = dim;
2930: return(0);
2931: }
2933: PetscErrorCode PetscDualSpaceGetNumDof_Simple(PetscDualSpace sp, const PetscInt **numDof)
2934: {
2935: PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2938: *numDof = s->numDof;
2939: return(0);
2940: }
2942: PetscErrorCode PetscDualSpaceSimpleSetFunctional_Simple(PetscDualSpace sp, PetscInt f, PetscQuadrature q)
2943: {
2944: PetscDualSpace_Simple *s = (PetscDualSpace_Simple *) sp->data;
2945: PetscReal *weights;
2946: PetscInt Nc, c, Nq, p;
2947: PetscErrorCode ierr;
2950: if ((f < 0) || (f >= s->dim)) SETERRQ2(PetscObjectComm((PetscObject) sp), PETSC_ERR_ARG_OUTOFRANGE, "Basis index %d not in [0, %d)", f, s->dim);
2951: PetscQuadratureDuplicate(q, &sp->functional[f]);
2952: /* Reweight so that it has unit volume: Do we want to do this for Nc > 1? */
2953: PetscQuadratureGetData(sp->functional[f], NULL, &Nc, &Nq, NULL, (const PetscReal **) &weights);
2954: for (c = 0; c < Nc; ++c) {
2955: PetscReal vol = 0.0;
2957: for (p = 0; p < Nq; ++p) vol += weights[p*Nc+c];
2958: for (p = 0; p < Nq; ++p) weights[p*Nc+c] /= (vol == 0.0 ? 1.0 : vol);
2959: }
2960: return(0);
2961: }
2963: /*@
2964: PetscDualSpaceSimpleSetDimension - Set the number of functionals in the dual space basis
2966: Logically Collective on PetscDualSpace
2968: Input Parameters:
2969: + sp - the PetscDualSpace
2970: - dim - the basis dimension
2972: Level: intermediate
2974: .keywords: PetscDualSpace, dimension
2975: .seealso: PetscDualSpaceSimpleSetFunctional()
2976: @*/
2977: PetscErrorCode PetscDualSpaceSimpleSetDimension(PetscDualSpace sp, PetscInt dim)
2978: {
2984: PetscTryMethod(sp, "PetscDualSpaceSimpleSetDimension_C", (PetscDualSpace,PetscInt),(sp,dim));
2985: return(0);
2986: }
2988: /*@
2989: PetscDualSpaceSimpleSetFunctional - Set the given basis element for this dual space
2991: Not Collective
2993: Input Parameters:
2994: + sp - the PetscDualSpace
2995: . f - the basis index
2996: - q - the basis functional
2998: Level: intermediate
3000: Note: The quadrature will be reweighted so that it has unit volume.
3002: .keywords: PetscDualSpace, functional
3003: .seealso: PetscDualSpaceSimpleSetDimension()
3004: @*/
3005: PetscErrorCode PetscDualSpaceSimpleSetFunctional(PetscDualSpace sp, PetscInt func, PetscQuadrature q)
3006: {
3011: PetscTryMethod(sp, "PetscDualSpaceSimpleSetFunctional_C", (PetscDualSpace,PetscInt,PetscQuadrature),(sp,func,q));
3012: return(0);
3013: }
3015: PetscErrorCode PetscDualSpaceInitialize_Simple(PetscDualSpace sp)
3016: {
3018: sp->ops->setfromoptions = PetscDualSpaceSetFromOptions_Simple;
3019: sp->ops->setup = PetscDualSpaceSetUp_Simple;
3020: sp->ops->view = NULL;
3021: sp->ops->destroy = PetscDualSpaceDestroy_Simple;
3022: sp->ops->duplicate = PetscDualSpaceDuplicate_Simple;
3023: sp->ops->getdimension = PetscDualSpaceGetDimension_Simple;
3024: sp->ops->getnumdof = PetscDualSpaceGetNumDof_Simple;
3025: sp->ops->getheightsubspace = NULL;
3026: sp->ops->getsymmetries = NULL;
3027: sp->ops->apply = PetscDualSpaceApplyDefault;
3028: return(0);
3029: }
3031: /*MC
3032: PETSCDUALSPACESIMPLE = "simple" - A PetscDualSpace object that encapsulates a dual space of arbitrary functionals
3034: Level: intermediate
3036: .seealso: PetscDualSpaceType, PetscDualSpaceCreate(), PetscDualSpaceSetType()
3037: M*/
3039: PETSC_EXTERN PetscErrorCode PetscDualSpaceCreate_Simple(PetscDualSpace sp)
3040: {
3041: PetscDualSpace_Simple *s;
3042: PetscErrorCode ierr;
3046: PetscNewLog(sp,&s);
3047: sp->data = s;
3049: s->dim = 0;
3050: s->numDof = NULL;
3052: PetscDualSpaceInitialize_Simple(sp);
3053: PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetDimension_C", PetscDualSpaceSimpleSetDimension_Simple);
3054: PetscObjectComposeFunction((PetscObject) sp, "PetscDualSpaceSimpleSetFunctional_C", PetscDualSpaceSimpleSetFunctional_Simple);
3055: return(0);
3056: }
3059: PetscClassId PETSCFE_CLASSID = 0;
3061: PetscFunctionList PetscFEList = NULL;
3062: PetscBool PetscFERegisterAllCalled = PETSC_FALSE;
3064: /*@C
3065: PetscFERegister - Adds a new PetscFE implementation
3067: Not Collective
3069: Input Parameters:
3070: + name - The name of a new user-defined creation routine
3071: - create_func - The creation routine itself
3073: Notes:
3074: PetscFERegister() may be called multiple times to add several user-defined PetscFEs
3076: Sample usage:
3077: .vb
3078: PetscFERegister("my_fe", MyPetscFECreate);
3079: .ve
3081: Then, your PetscFE type can be chosen with the procedural interface via
3082: .vb
3083: PetscFECreate(MPI_Comm, PetscFE *);
3084: PetscFESetType(PetscFE, "my_fe");
3085: .ve
3086: or at runtime via the option
3087: .vb
3088: -petscfe_type my_fe
3089: .ve
3091: Level: advanced
3093: .keywords: PetscFE, register
3094: .seealso: PetscFERegisterAll(), PetscFERegisterDestroy()
3096: @*/
3097: PetscErrorCode PetscFERegister(const char sname[], PetscErrorCode (*function)(PetscFE))
3098: {
3102: PetscFunctionListAdd(&PetscFEList, sname, function);
3103: return(0);
3104: }
3106: /*@C
3107: PetscFESetType - Builds a particular PetscFE
3109: Collective on PetscFE
3111: Input Parameters:
3112: + fem - The PetscFE object
3113: - name - The kind of FEM space
3115: Options Database Key:
3116: . -petscfe_type <type> - Sets the PetscFE type; use -help for a list of available types
3118: Level: intermediate
3120: .keywords: PetscFE, set, type
3121: .seealso: PetscFEGetType(), PetscFECreate()
3122: @*/
3123: PetscErrorCode PetscFESetType(PetscFE fem, PetscFEType name)
3124: {
3125: PetscErrorCode (*r)(PetscFE);
3126: PetscBool match;
3131: PetscObjectTypeCompare((PetscObject) fem, name, &match);
3132: if (match) return(0);
3134: if (!PetscFERegisterAllCalled) {PetscFERegisterAll();}
3135: PetscFunctionListFind(PetscFEList, name, &r);
3136: if (!r) SETERRQ1(PetscObjectComm((PetscObject) fem), PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown PetscFE type: %s", name);
3138: if (fem->ops->destroy) {
3139: (*fem->ops->destroy)(fem);
3140: fem->ops->destroy = NULL;
3141: }
3142: (*r)(fem);
3143: PetscObjectChangeTypeName((PetscObject) fem, name);
3144: return(0);
3145: }
3147: /*@C
3148: PetscFEGetType - Gets the PetscFE type name (as a string) from the object.
3150: Not Collective
3152: Input Parameter:
3153: . fem - The PetscFE
3155: Output Parameter:
3156: . name - The PetscFE type name
3158: Level: intermediate
3160: .keywords: PetscFE, get, type, name
3161: .seealso: PetscFESetType(), PetscFECreate()
3162: @*/
3163: PetscErrorCode PetscFEGetType(PetscFE fem, PetscFEType *name)
3164: {
3170: if (!PetscFERegisterAllCalled) {
3171: PetscFERegisterAll();
3172: }
3173: *name = ((PetscObject) fem)->type_name;
3174: return(0);
3175: }
3177: /*@C
3178: PetscFEView - Views a PetscFE
3180: Collective on PetscFE
3182: Input Parameter:
3183: + fem - the PetscFE object to view
3184: - v - the viewer
3186: Level: developer
3188: .seealso PetscFEDestroy()
3189: @*/
3190: PetscErrorCode PetscFEView(PetscFE fem, PetscViewer v)
3191: {
3196: if (!v) {
3197: PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject) fem), &v);
3198: }
3199: if (fem->ops->view) {
3200: (*fem->ops->view)(fem, v);
3201: }
3202: return(0);
3203: }
3205: /*@
3206: PetscFESetFromOptions - sets parameters in a PetscFE from the options database
3208: Collective on PetscFE
3210: Input Parameter:
3211: . fem - the PetscFE object to set options for
3213: Options Database:
3214: . -petscfe_num_blocks the number of cell blocks to integrate concurrently
3215: . -petscfe_num_batches the number of cell batches to integrate serially
3217: Level: developer
3219: .seealso PetscFEView()
3220: @*/
3221: PetscErrorCode PetscFESetFromOptions(PetscFE fem)
3222: {
3223: const char *defaultType;
3224: char name[256];
3225: PetscBool flg;
3230: if (!((PetscObject) fem)->type_name) {
3231: defaultType = PETSCFEBASIC;
3232: } else {
3233: defaultType = ((PetscObject) fem)->type_name;
3234: }
3235: if (!PetscFERegisterAllCalled) {PetscFERegisterAll();}
3237: PetscObjectOptionsBegin((PetscObject) fem);
3238: PetscOptionsFList("-petscfe_type", "Finite element space", "PetscFESetType", PetscFEList, defaultType, name, 256, &flg);
3239: if (flg) {
3240: PetscFESetType(fem, name);
3241: } else if (!((PetscObject) fem)->type_name) {
3242: PetscFESetType(fem, defaultType);
3243: }
3244: PetscOptionsInt("-petscfe_num_blocks", "The number of cell blocks to integrate concurrently", "PetscSpaceSetTileSizes", fem->numBlocks, &fem->numBlocks, NULL);
3245: PetscOptionsInt("-petscfe_num_batches", "The number of cell batches to integrate serially", "PetscSpaceSetTileSizes", fem->numBatches, &fem->numBatches, NULL);
3246: if (fem->ops->setfromoptions) {
3247: (*fem->ops->setfromoptions)(PetscOptionsObject,fem);
3248: }
3249: /* process any options handlers added with PetscObjectAddOptionsHandler() */
3250: PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject) fem);
3251: PetscOptionsEnd();
3252: PetscFEViewFromOptions(fem, NULL, "-petscfe_view");
3253: return(0);
3254: }
3256: /*@C
3257: PetscFESetUp - Construct data structures for the PetscFE
3259: Collective on PetscFE
3261: Input Parameter:
3262: . fem - the PetscFE object to setup
3264: Level: developer
3266: .seealso PetscFEView(), PetscFEDestroy()
3267: @*/
3268: PetscErrorCode PetscFESetUp(PetscFE fem)
3269: {
3274: if (fem->ops->setup) {(*fem->ops->setup)(fem);}
3275: return(0);
3276: }
3278: /*@
3279: PetscFEDestroy - Destroys a PetscFE object
3281: Collective on PetscFE
3283: Input Parameter:
3284: . fem - the PetscFE object to destroy
3286: Level: developer
3288: .seealso PetscFEView()
3289: @*/
3290: PetscErrorCode PetscFEDestroy(PetscFE *fem)
3291: {
3295: if (!*fem) return(0);
3298: if (--((PetscObject)(*fem))->refct > 0) {*fem = 0; return(0);}
3299: ((PetscObject) (*fem))->refct = 0;
3301: if ((*fem)->subspaces) {
3302: PetscInt dim, d;
3304: PetscDualSpaceGetDimension((*fem)->dualSpace, &dim);
3305: for (d = 0; d < dim; ++d) {PetscFEDestroy(&(*fem)->subspaces[d]);}
3306: }
3307: PetscFree((*fem)->subspaces);
3308: PetscFree((*fem)->invV);
3309: PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->B, &(*fem)->D, NULL /*&(*fem)->H*/);
3310: PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->Bf, &(*fem)->Df, NULL /*&(*fem)->Hf*/);
3311: PetscFERestoreTabulation((*fem), 0, NULL, &(*fem)->F, NULL, NULL);
3312: PetscSpaceDestroy(&(*fem)->basisSpace);
3313: PetscDualSpaceDestroy(&(*fem)->dualSpace);
3314: PetscQuadratureDestroy(&(*fem)->quadrature);
3315: PetscQuadratureDestroy(&(*fem)->faceQuadrature);
3317: if ((*fem)->ops->destroy) {(*(*fem)->ops->destroy)(*fem);}
3318: PetscHeaderDestroy(fem);
3319: return(0);
3320: }
3322: /*@
3323: PetscFECreate - Creates an empty PetscFE object. The type can then be set with PetscFESetType().
3325: Collective on MPI_Comm
3327: Input Parameter:
3328: . comm - The communicator for the PetscFE object
3330: Output Parameter:
3331: . fem - The PetscFE object
3333: Level: beginner
3335: .seealso: PetscFESetType(), PETSCFEGALERKIN
3336: @*/
3337: PetscErrorCode PetscFECreate(MPI_Comm comm, PetscFE *fem)
3338: {
3339: PetscFE f;
3344: PetscCitationsRegister(FECitation,&FEcite);
3345: *fem = NULL;
3346: PetscFEInitializePackage();
3348: PetscHeaderCreate(f, PETSCFE_CLASSID, "PetscFE", "Finite Element", "PetscFE", comm, PetscFEDestroy, PetscFEView);
3350: f->basisSpace = NULL;
3351: f->dualSpace = NULL;
3352: f->numComponents = 1;
3353: f->subspaces = NULL;
3354: f->invV = NULL;
3355: f->B = NULL;
3356: f->D = NULL;
3357: f->H = NULL;
3358: f->Bf = NULL;
3359: f->Df = NULL;
3360: f->Hf = NULL;
3361: PetscMemzero(&f->quadrature, sizeof(PetscQuadrature));
3362: PetscMemzero(&f->faceQuadrature, sizeof(PetscQuadrature));
3363: f->blockSize = 0;
3364: f->numBlocks = 1;
3365: f->batchSize = 0;
3366: f->numBatches = 1;
3368: *fem = f;
3369: return(0);
3370: }
3372: /*@
3373: PetscFEGetSpatialDimension - Returns the spatial dimension of the element
3375: Not collective
3377: Input Parameter:
3378: . fem - The PetscFE object
3380: Output Parameter:
3381: . dim - The spatial dimension
3383: Level: intermediate
3385: .seealso: PetscFECreate()
3386: @*/
3387: PetscErrorCode PetscFEGetSpatialDimension(PetscFE fem, PetscInt *dim)
3388: {
3389: DM dm;
3395: PetscDualSpaceGetDM(fem->dualSpace, &dm);
3396: DMGetDimension(dm, dim);
3397: return(0);
3398: }
3400: /*@
3401: PetscFESetNumComponents - Sets the number of components in the element
3403: Not collective
3405: Input Parameters:
3406: + fem - The PetscFE object
3407: - comp - The number of field components
3409: Level: intermediate
3411: .seealso: PetscFECreate()
3412: @*/
3413: PetscErrorCode PetscFESetNumComponents(PetscFE fem, PetscInt comp)
3414: {
3417: fem->numComponents = comp;
3418: return(0);
3419: }
3421: /*@
3422: PetscFEGetNumComponents - Returns the number of components in the element
3424: Not collective
3426: Input Parameter:
3427: . fem - The PetscFE object
3429: Output Parameter:
3430: . comp - The number of field components
3432: Level: intermediate
3434: .seealso: PetscFECreate()
3435: @*/
3436: PetscErrorCode PetscFEGetNumComponents(PetscFE fem, PetscInt *comp)
3437: {
3441: *comp = fem->numComponents;
3442: return(0);
3443: }
3445: /*@
3446: PetscFESetTileSizes - Sets the tile sizes for evaluation
3448: Not collective
3450: Input Parameters:
3451: + fem - The PetscFE object
3452: . blockSize - The number of elements in a block
3453: . numBlocks - The number of blocks in a batch
3454: . batchSize - The number of elements in a batch
3455: - numBatches - The number of batches in a chunk
3457: Level: intermediate
3459: .seealso: PetscFECreate()
3460: @*/
3461: PetscErrorCode PetscFESetTileSizes(PetscFE fem, PetscInt blockSize, PetscInt numBlocks, PetscInt batchSize, PetscInt numBatches)
3462: {
3465: fem->blockSize = blockSize;
3466: fem->numBlocks = numBlocks;
3467: fem->batchSize = batchSize;
3468: fem->numBatches = numBatches;
3469: return(0);
3470: }
3472: /*@
3473: PetscFEGetTileSizes - Returns the tile sizes for evaluation
3475: Not collective
3477: Input Parameter:
3478: . fem - The PetscFE object
3480: Output Parameters:
3481: + blockSize - The number of elements in a block
3482: . numBlocks - The number of blocks in a batch
3483: . batchSize - The number of elements in a batch
3484: - numBatches - The number of batches in a chunk
3486: Level: intermediate
3488: .seealso: PetscFECreate()
3489: @*/
3490: PetscErrorCode PetscFEGetTileSizes(PetscFE fem, PetscInt *blockSize, PetscInt *numBlocks, PetscInt *batchSize, PetscInt *numBatches)
3491: {
3498: if (blockSize) *blockSize = fem->blockSize;
3499: if (numBlocks) *numBlocks = fem->numBlocks;
3500: if (batchSize) *batchSize = fem->batchSize;
3501: if (numBatches) *numBatches = fem->numBatches;
3502: return(0);
3503: }
3505: /*@
3506: PetscFEGetBasisSpace - Returns the PetscSpace used for approximation of the solution
3508: Not collective
3510: Input Parameter:
3511: . fem - The PetscFE object
3513: Output Parameter:
3514: . sp - The PetscSpace object
3516: Level: intermediate
3518: .seealso: PetscFECreate()
3519: @*/
3520: PetscErrorCode PetscFEGetBasisSpace(PetscFE fem, PetscSpace *sp)
3521: {
3525: *sp = fem->basisSpace;
3526: return(0);
3527: }
3529: /*@
3530: PetscFESetBasisSpace - Sets the PetscSpace used for approximation of the solution
3532: Not collective
3534: Input Parameters:
3535: + fem - The PetscFE object
3536: - sp - The PetscSpace object
3538: Level: intermediate
3540: .seealso: PetscFECreate()
3541: @*/
3542: PetscErrorCode PetscFESetBasisSpace(PetscFE fem, PetscSpace sp)
3543: {
3549: PetscSpaceDestroy(&fem->basisSpace);
3550: fem->basisSpace = sp;
3551: PetscObjectReference((PetscObject) fem->basisSpace);
3552: return(0);
3553: }
3555: /*@
3556: PetscFEGetDualSpace - Returns the PetscDualSpace used to define the inner product
3558: Not collective
3560: Input Parameter:
3561: . fem - The PetscFE object
3563: Output Parameter:
3564: . sp - The PetscDualSpace object
3566: Level: intermediate
3568: .seealso: PetscFECreate()
3569: @*/
3570: PetscErrorCode PetscFEGetDualSpace(PetscFE fem, PetscDualSpace *sp)
3571: {
3575: *sp = fem->dualSpace;
3576: return(0);
3577: }
3579: /*@
3580: PetscFESetDualSpace - Sets the PetscDualSpace used to define the inner product
3582: Not collective
3584: Input Parameters:
3585: + fem - The PetscFE object
3586: - sp - The PetscDualSpace object
3588: Level: intermediate
3590: .seealso: PetscFECreate()
3591: @*/
3592: PetscErrorCode PetscFESetDualSpace(PetscFE fem, PetscDualSpace sp)
3593: {
3599: PetscDualSpaceDestroy(&fem->dualSpace);
3600: fem->dualSpace = sp;
3601: PetscObjectReference((PetscObject) fem->dualSpace);
3602: return(0);
3603: }
3605: /*@
3606: PetscFEGetQuadrature - Returns the PetscQuadrature used to calculate inner products
3608: Not collective
3610: Input Parameter:
3611: . fem - The PetscFE object
3613: Output Parameter:
3614: . q - The PetscQuadrature object
3616: Level: intermediate
3618: .seealso: PetscFECreate()
3619: @*/
3620: PetscErrorCode PetscFEGetQuadrature(PetscFE fem, PetscQuadrature *q)
3621: {
3625: *q = fem->quadrature;
3626: return(0);
3627: }
3629: /*@
3630: PetscFESetQuadrature - Sets the PetscQuadrature used to calculate inner products
3632: Not collective
3634: Input Parameters:
3635: + fem - The PetscFE object
3636: - q - The PetscQuadrature object
3638: Level: intermediate
3640: .seealso: PetscFECreate()
3641: @*/
3642: PetscErrorCode PetscFESetQuadrature(PetscFE fem, PetscQuadrature q)
3643: {
3644: PetscInt Nc, qNc;
3649: PetscFEGetNumComponents(fem, &Nc);
3650: PetscQuadratureGetNumComponents(q, &qNc);
3651: if ((qNc != 1) && (Nc != qNc)) SETERRQ2(PetscObjectComm((PetscObject) fem), PETSC_ERR_ARG_SIZ, "FE components %D != Quadrature components %D and non-scalar quadrature", Nc, qNc);
3652: PetscFERestoreTabulation(fem, 0, NULL, &fem->B, &fem->D, NULL /*&(*fem)->H*/);
3653: PetscQuadratureDestroy(&fem->quadrature);
3654: fem->quadrature = q;
3655: PetscObjectReference((PetscObject) q);
3656: return(0);
3657: }
3659: /*@
3660: PetscFEGetFaceQuadrature - Returns the PetscQuadrature used to calculate inner products on faces
3662: Not collective
3664: Input Parameter:
3665: . fem - The PetscFE object
3667: Output Parameter:
3668: . q - The PetscQuadrature object
3670: Level: intermediate
3672: .seealso: PetscFECreate()
3673: @*/
3674: PetscErrorCode PetscFEGetFaceQuadrature(PetscFE fem, PetscQuadrature *q)
3675: {
3679: *q = fem->faceQuadrature;
3680: return(0);
3681: }
3683: /*@
3684: PetscFESetFaceQuadrature - Sets the PetscQuadrature used to calculate inner products on faces
3686: Not collective
3688: Input Parameters:
3689: + fem - The PetscFE object
3690: - q - The PetscQuadrature object
3692: Level: intermediate
3694: .seealso: PetscFECreate()
3695: @*/
3696: PetscErrorCode PetscFESetFaceQuadrature(PetscFE fem, PetscQuadrature q)
3697: {
3702: PetscFERestoreTabulation(fem, 0, NULL, &fem->Bf, &fem->Df, NULL /*&(*fem)->Hf*/);
3703: PetscQuadratureDestroy(&fem->faceQuadrature);
3704: fem->faceQuadrature = q;
3705: PetscObjectReference((PetscObject) q);
3706: return(0);
3707: }
3709: /*@C
3710: PetscFEGetNumDof - Returns the number of dofs (dual basis vectors) associated to mesh points on the reference cell of a given dimension
3712: Not collective
3714: Input Parameter:
3715: . fem - The PetscFE object
3717: Output Parameter:
3718: . numDof - Array with the number of dofs per dimension
3720: Level: intermediate
3722: .seealso: PetscFECreate()
3723: @*/
3724: PetscErrorCode PetscFEGetNumDof(PetscFE fem, const PetscInt **numDof)
3725: {
3731: PetscDualSpaceGetNumDof(fem->dualSpace, numDof);
3732: return(0);
3733: }
3735: /*@C
3736: PetscFEGetDefaultTabulation - Returns the tabulation of the basis functions at the quadrature points
3738: Not collective
3740: Input Parameter:
3741: . fem - The PetscFE object
3743: Output Parameters:
3744: + B - The basis function values at quadrature points
3745: . D - The basis function derivatives at quadrature points
3746: - H - The basis function second derivatives at quadrature points
3748: Note:
3749: $ B[(p*pdim + i)*Nc + c] is the value at point p for basis function i and component c
3750: $ D[((p*pdim + i)*Nc + c)*dim + d] is the derivative value at point p for basis function i, component c, in direction d
3751: $ H[(((p*pdim + i)*Nc + c)*dim + d)*dim + e] is the value at point p for basis function i, component c, in directions d and e
3753: Level: intermediate
3755: .seealso: PetscFEGetTabulation(), PetscFERestoreTabulation()
3756: @*/
3757: PetscErrorCode PetscFEGetDefaultTabulation(PetscFE fem, PetscReal **B, PetscReal **D, PetscReal **H)
3758: {
3759: PetscInt npoints;
3760: const PetscReal *points;
3761: PetscErrorCode ierr;
3768: PetscQuadratureGetData(fem->quadrature, NULL, NULL, &npoints, &points, NULL);
3769: if (!fem->B) {PetscFEGetTabulation(fem, npoints, points, &fem->B, &fem->D, NULL/*&fem->H*/);}
3770: if (B) *B = fem->B;
3771: if (D) *D = fem->D;
3772: if (H) *H = fem->H;
3773: return(0);
3774: }
3776: PetscErrorCode PetscFEGetFaceTabulation(PetscFE fem, PetscReal **Bf, PetscReal **Df, PetscReal **Hf)
3777: {
3778: PetscErrorCode ierr;
3785: if (!fem->Bf) {
3786: PetscFECellGeom cgeom;
3787: PetscQuadrature fq;
3788: PetscDualSpace sp;
3789: DM dm;
3790: const PetscInt *faces;
3791: PetscInt dim, numFaces, f, npoints, q;
3792: const PetscReal *points;
3793: PetscReal *facePoints;
3795: PetscFEGetDualSpace(fem, &sp);
3796: PetscDualSpaceGetDM(sp, &dm);
3797: DMGetDimension(dm, &dim);
3798: DMPlexGetConeSize(dm, 0, &numFaces);
3799: DMPlexGetCone(dm, 0, &faces);
3800: PetscFEGetFaceQuadrature(fem, &fq);
3801: PetscQuadratureGetData(fq, NULL, NULL, &npoints, &points, NULL);
3802: PetscMalloc1(numFaces*npoints*dim, &facePoints);
3803: for (f = 0; f < numFaces; ++f) {
3804: DMPlexComputeCellGeometryFEM(dm, faces[f], NULL, cgeom.v0, cgeom.J, NULL, &cgeom.detJ);
3805: for (q = 0; q < npoints; ++q) CoordinatesRefToReal(dim, dim-1, cgeom.v0, cgeom.J, &points[q*(dim-1)], &facePoints[(f*npoints+q)*dim]);
3806: }
3807: PetscFEGetTabulation(fem, numFaces*npoints, facePoints, &fem->Bf, &fem->Df, NULL/*&fem->Hf*/);
3808: PetscFree(facePoints);
3809: }
3810: if (Bf) *Bf = fem->Bf;
3811: if (Df) *Df = fem->Df;
3812: if (Hf) *Hf = fem->Hf;
3813: return(0);
3814: }
3816: PetscErrorCode PetscFEGetFaceCentroidTabulation(PetscFE fem, PetscReal **F)
3817: {
3818: PetscErrorCode ierr;
3823: if (!fem->F) {
3824: PetscDualSpace sp;
3825: DM dm;
3826: const PetscInt *cone;
3827: PetscReal *centroids;
3828: PetscInt dim, numFaces, f;
3830: PetscFEGetDualSpace(fem, &sp);
3831: PetscDualSpaceGetDM(sp, &dm);
3832: DMGetDimension(dm, &dim);
3833: DMPlexGetConeSize(dm, 0, &numFaces);
3834: DMPlexGetCone(dm, 0, &cone);
3835: PetscMalloc1(numFaces*dim, ¢roids);
3836: for (f = 0; f < numFaces; ++f) {DMPlexComputeCellGeometryFVM(dm, cone[f], NULL, ¢roids[f*dim], NULL);}
3837: PetscFEGetTabulation(fem, numFaces, centroids, &fem->F, NULL, NULL);
3838: PetscFree(centroids);
3839: }
3840: *F = fem->F;
3841: return(0);
3842: }
3844: /*@C
3845: PetscFEGetTabulation - Tabulates the basis functions, and perhaps derivatives, at the points provided.
3847: Not collective
3849: Input Parameters:
3850: + fem - The PetscFE object
3851: . npoints - The number of tabulation points
3852: - points - The tabulation point coordinates
3854: Output Parameters:
3855: + B - The basis function values at tabulation points
3856: . D - The basis function derivatives at tabulation points
3857: - H - The basis function second derivatives at tabulation points
3859: Note:
3860: $ B[(p*pdim + i)*Nc + c] is the value at point p for basis function i and component c
3861: $ D[((p*pdim + i)*Nc + c)*dim + d] is the derivative value at point p for basis function i, component c, in direction d
3862: $ H[(((p*pdim + i)*Nc + c)*dim + d)*dim + e] is the value at point p for basis function i, component c, in directions d and e
3864: Level: intermediate
3866: .seealso: PetscFERestoreTabulation(), PetscFEGetDefaultTabulation()
3867: @*/
3868: PetscErrorCode PetscFEGetTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal **B, PetscReal **D, PetscReal **H)
3869: {
3870: DM dm;
3871: PetscInt pdim; /* Dimension of FE space P */
3872: PetscInt dim; /* Spatial dimension */
3873: PetscInt comp; /* Field components */
3874: PetscErrorCode ierr;
3877: if (!npoints) {
3878: if (B) *B = NULL;
3879: if (D) *D = NULL;
3880: if (H) *H = NULL;
3881: return(0);
3882: }
3888: PetscDualSpaceGetDM(fem->dualSpace, &dm);
3889: DMGetDimension(dm, &dim);
3890: PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
3891: PetscFEGetNumComponents(fem, &comp);
3892: if (B) {DMGetWorkArray(dm, npoints*pdim*comp, PETSC_REAL, B);}
3893: if (D) {DMGetWorkArray(dm, npoints*pdim*comp*dim, PETSC_REAL, D);}
3894: if (H) {DMGetWorkArray(dm, npoints*pdim*comp*dim*dim, PETSC_REAL, H);}
3895: (*fem->ops->gettabulation)(fem, npoints, points, B ? *B : NULL, D ? *D : NULL, H ? *H : NULL);
3896: return(0);
3897: }
3899: PetscErrorCode PetscFERestoreTabulation(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal **B, PetscReal **D, PetscReal **H)
3900: {
3901: DM dm;
3906: PetscDualSpaceGetDM(fem->dualSpace, &dm);
3907: if (B && *B) {DMRestoreWorkArray(dm, 0, PETSC_REAL, B);}
3908: if (D && *D) {DMRestoreWorkArray(dm, 0, PETSC_REAL, D);}
3909: if (H && *H) {DMRestoreWorkArray(dm, 0, PETSC_REAL, H);}
3910: return(0);
3911: }
3913: PetscErrorCode PetscFEDestroy_Basic(PetscFE fem)
3914: {
3915: PetscFE_Basic *b = (PetscFE_Basic *) fem->data;
3919: PetscFree(b);
3920: return(0);
3921: }
3923: PetscErrorCode PetscFEView_Basic_Ascii(PetscFE fe, PetscViewer viewer)
3924: {
3925: PetscSpace basis;
3926: PetscDualSpace dual;
3927: PetscQuadrature q = NULL;
3928: PetscInt dim, Nc, Nq;
3929: PetscViewerFormat format;
3930: PetscErrorCode ierr;
3933: PetscFEGetBasisSpace(fe, &basis);
3934: PetscFEGetDualSpace(fe, &dual);
3935: PetscFEGetQuadrature(fe, &q);
3936: PetscFEGetNumComponents(fe, &Nc);
3937: PetscQuadratureGetData(q, &dim, NULL, &Nq, NULL, NULL);
3938: PetscViewerGetFormat(viewer, &format);
3939: PetscViewerASCIIPrintf(viewer, "Basic Finite Element:\n");
3940: if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
3941: PetscViewerASCIIPrintf(viewer, " dimension: %d\n", dim);
3942: PetscViewerASCIIPrintf(viewer, " components: %d\n", Nc);
3943: PetscViewerASCIIPrintf(viewer, " num quad points: %d\n", Nq);
3944: PetscViewerASCIIPushTab(viewer);
3945: PetscQuadratureView(q, viewer);
3946: PetscViewerASCIIPopTab(viewer);
3947: } else {
3948: PetscViewerASCIIPrintf(viewer, " dimension: %d\n", dim);
3949: PetscViewerASCIIPrintf(viewer, " components: %d\n", Nc);
3950: PetscViewerASCIIPrintf(viewer, " num quad points: %d\n", Nq);
3951: }
3952: PetscViewerASCIIPushTab(viewer);
3953: PetscSpaceView(basis, viewer);
3954: PetscDualSpaceView(dual, viewer);
3955: PetscViewerASCIIPopTab(viewer);
3956: return(0);
3957: }
3959: PetscErrorCode PetscFEView_Basic(PetscFE fe, PetscViewer viewer)
3960: {
3961: PetscBool iascii;
3967: PetscObjectTypeCompare((PetscObject) viewer, PETSCVIEWERASCII, &iascii);
3968: if (iascii) {PetscFEView_Basic_Ascii(fe, viewer);}
3969: return(0);
3970: }
3972: /* Construct the change of basis from prime basis to nodal basis */
3973: PetscErrorCode PetscFESetUp_Basic(PetscFE fem)
3974: {
3975: PetscScalar *work, *invVscalar;
3976: PetscBLASInt *pivots;
3977: PetscBLASInt n, info;
3978: PetscInt pdim, j;
3982: PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
3983: PetscMalloc1(pdim*pdim,&fem->invV);
3984: #if defined(PETSC_USE_COMPLEX)
3985: PetscMalloc1(pdim*pdim,&invVscalar);
3986: #else
3987: invVscalar = fem->invV;
3988: #endif
3989: for (j = 0; j < pdim; ++j) {
3990: PetscReal *Bf;
3991: PetscQuadrature f;
3992: const PetscReal *points, *weights;
3993: PetscInt Nc, Nq, q, k, c;
3995: PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);
3996: PetscQuadratureGetData(f, NULL, &Nc, &Nq, &points, &weights);
3997: PetscMalloc1(Nc*Nq*pdim,&Bf);
3998: PetscSpaceEvaluate(fem->basisSpace, Nq, points, Bf, NULL, NULL);
3999: for (k = 0; k < pdim; ++k) {
4000: /* V_{jk} = n_j(\phi_k) = \int \phi_k(x) n_j(x) dx */
4001: invVscalar[j*pdim+k] = 0.0;
4003: for (q = 0; q < Nq; ++q) {
4004: for (c = 0; c < Nc; ++c) invVscalar[j*pdim+k] += Bf[(q*pdim + k)*Nc + c]*weights[q*Nc + c];
4005: }
4006: }
4007: PetscFree(Bf);
4008: }
4009: PetscMalloc2(pdim,&pivots,pdim,&work);
4010: n = pdim;
4011: PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, invVscalar, &n, pivots, &info));
4012: PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, invVscalar, &n, pivots, work, &n, &info));
4013: #if defined(PETSC_USE_COMPLEX)
4014: for (j = 0; j < pdim*pdim; j++) fem->invV[j] = PetscRealPart(invVscalar[j]);
4015: PetscFree(invVscalar);
4016: #endif
4017: PetscFree2(pivots,work);
4018: return(0);
4019: }
4021: PetscErrorCode PetscFEGetDimension_Basic(PetscFE fem, PetscInt *dim)
4022: {
4026: PetscDualSpaceGetDimension(fem->dualSpace, dim);
4027: return(0);
4028: }
4030: PetscErrorCode PetscFEGetTabulation_Basic(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H)
4031: {
4032: DM dm;
4033: PetscInt pdim; /* Dimension of FE space P */
4034: PetscInt dim; /* Spatial dimension */
4035: PetscInt Nc; /* Field components */
4036: PetscReal *tmpB, *tmpD, *tmpH;
4037: PetscInt p, d, j, k, c;
4038: PetscErrorCode ierr;
4041: PetscDualSpaceGetDM(fem->dualSpace, &dm);
4042: DMGetDimension(dm, &dim);
4043: PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
4044: PetscFEGetNumComponents(fem, &Nc);
4045: /* Evaluate the prime basis functions at all points */
4046: if (B) {DMGetWorkArray(dm, npoints*pdim*Nc, PETSC_REAL, &tmpB);}
4047: if (D) {DMGetWorkArray(dm, npoints*pdim*Nc*dim, PETSC_REAL, &tmpD);}
4048: if (H) {DMGetWorkArray(dm, npoints*pdim*Nc*dim*dim, PETSC_REAL, &tmpH);}
4049: PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);
4050: /* Translate to the nodal basis */
4051: for (p = 0; p < npoints; ++p) {
4052: if (B) {
4053: /* Multiply by V^{-1} (pdim x pdim) */
4054: for (j = 0; j < pdim; ++j) {
4055: const PetscInt i = (p*pdim + j)*Nc;
4057: for (c = 0; c < Nc; ++c) {
4058: B[i+c] = 0.0;
4059: for (k = 0; k < pdim; ++k) {
4060: B[i+c] += fem->invV[k*pdim+j] * tmpB[(p*pdim + k)*Nc+c];
4061: }
4062: }
4063: }
4064: }
4065: if (D) {
4066: /* Multiply by V^{-1} (pdim x pdim) */
4067: for (j = 0; j < pdim; ++j) {
4068: for (c = 0; c < Nc; ++c) {
4069: for (d = 0; d < dim; ++d) {
4070: const PetscInt i = ((p*pdim + j)*Nc + c)*dim + d;
4072: D[i] = 0.0;
4073: for (k = 0; k < pdim; ++k) {
4074: D[i] += fem->invV[k*pdim+j] * tmpD[((p*pdim + k)*Nc + c)*dim + d];
4075: }
4076: }
4077: }
4078: }
4079: }
4080: if (H) {
4081: /* Multiply by V^{-1} (pdim x pdim) */
4082: for (j = 0; j < pdim; ++j) {
4083: for (c = 0; c < Nc; ++c) {
4084: for (d = 0; d < dim*dim; ++d) {
4085: const PetscInt i = ((p*pdim + j)*Nc + c)*dim*dim + d;
4087: H[i] = 0.0;
4088: for (k = 0; k < pdim; ++k) {
4089: H[i] += fem->invV[k*pdim+j] * tmpH[((p*pdim + k)*Nc + c)*dim*dim + d];
4090: }
4091: }
4092: }
4093: }
4094: }
4095: }
4096: if (B) {DMRestoreWorkArray(dm, npoints*pdim*Nc, PETSC_REAL, &tmpB);}
4097: if (D) {DMRestoreWorkArray(dm, npoints*pdim*Nc*dim, PETSC_REAL, &tmpD);}
4098: if (H) {DMRestoreWorkArray(dm, npoints*pdim*Nc*dim*dim, PETSC_REAL, &tmpH);}
4099: return(0);
4100: }
4102: PetscErrorCode PetscFEIntegrate_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
4103: const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal integral[])
4104: {
4105: const PetscInt debug = 0;
4106: PetscPointFunc obj_func;
4107: PetscQuadrature quad;
4108: PetscScalar *u, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4109: const PetscScalar *constants;
4110: PetscReal *x;
4111: PetscReal **B, **D, **BAux = NULL, **DAux = NULL;
4112: PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4113: PetscInt dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, e;
4114: PetscErrorCode ierr;
4117: PetscDSGetObjective(prob, field, &obj_func);
4118: if (!obj_func) return(0);
4119: PetscFEGetSpatialDimension(fem, &dim);
4120: PetscFEGetQuadrature(fem, &quad);
4121: PetscDSGetNumFields(prob, &Nf);
4122: PetscDSGetTotalDimension(prob, &totDim);
4123: PetscDSGetDimensions(prob, &Nb);
4124: PetscDSGetComponents(prob, &Nc);
4125: PetscDSGetComponentOffsets(prob, &uOff);
4126: PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4127: PetscDSGetEvaluationArrays(prob, &u, NULL, &u_x);
4128: PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4129: PetscDSGetTabulation(prob, &B, &D);
4130: PetscDSGetConstants(prob, &numConstants, &constants);
4131: if (probAux) {
4132: PetscDSGetNumFields(probAux, &NfAux);
4133: PetscDSGetTotalDimension(probAux, &totDimAux);
4134: PetscDSGetDimensions(probAux, &NbAux);
4135: PetscDSGetComponents(probAux, &NcAux);
4136: PetscDSGetComponentOffsets(probAux, &aOff);
4137: PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4138: PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4139: PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4140: PetscDSGetTabulation(probAux, &BAux, &DAux);
4141: }
4142: for (e = 0; e < Ne; ++e) {
4143: const PetscReal *v0 = cgeom[e].v0;
4144: const PetscReal *J = cgeom[e].J;
4145: const PetscReal *invJ = cgeom[e].invJ;
4146: const PetscReal detJ = cgeom[e].detJ;
4147: const PetscReal *quadPoints, *quadWeights;
4148: PetscInt qNc, Nq, q;
4150: PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4151: if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4152: if (debug > 1) {
4153: PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", detJ);
4154: #ifndef PETSC_USE_COMPLEX
4155: DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
4156: #endif
4157: }
4158: for (q = 0; q < Nq; ++q) {
4159: PetscScalar integrand;
4161: if (debug) {PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);}
4162: CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4163: EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], NULL, u, u_x, NULL);
4164: if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4165: obj_func(dim, Nf, NfAux, uOff, uOff_x, u, NULL, u_x, aOff, aOff_x, a, NULL, a_x, 0.0, x, numConstants, constants, &integrand);
4166: integrand *= detJ*quadWeights[q];
4167: integral[field] += PetscRealPart(integrand);
4168: if (debug > 1) {PetscPrintf(PETSC_COMM_SELF, " int: %g %g\n", PetscRealPart(integrand), integral[field]);}
4169: }
4170: cOffset += totDim;
4171: cOffsetAux += totDimAux;
4172: }
4173: return(0);
4174: }
4176: PetscErrorCode PetscFEIntegrateResidual_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
4177: const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4178: {
4179: const PetscInt debug = 0;
4180: PetscPointFunc f0_func;
4181: PetscPointFunc f1_func;
4182: PetscQuadrature quad;
4183: PetscScalar *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4184: const PetscScalar *constants;
4185: PetscReal *x;
4186: PetscReal **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4187: PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4188: PetscInt dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
4189: PetscErrorCode ierr;
4192: PetscFEGetSpatialDimension(fem, &dim);
4193: PetscFEGetQuadrature(fem, &quad);
4194: PetscDSGetNumFields(prob, &Nf);
4195: PetscDSGetTotalDimension(prob, &totDim);
4196: PetscDSGetDimensions(prob, &Nb);
4197: PetscDSGetComponents(prob, &Nc);
4198: PetscDSGetComponentOffsets(prob, &uOff);
4199: PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4200: PetscDSGetFieldOffset(prob, field, &fOffset);
4201: PetscDSGetResidual(prob, field, &f0_func, &f1_func);
4202: PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4203: PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4204: PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4205: PetscDSGetTabulation(prob, &B, &D);
4206: PetscDSGetConstants(prob, &numConstants, &constants);
4207: if (probAux) {
4208: PetscDSGetNumFields(probAux, &NfAux);
4209: PetscDSGetTotalDimension(probAux, &totDimAux);
4210: PetscDSGetDimensions(probAux, &NbAux);
4211: PetscDSGetComponents(probAux, &NcAux);
4212: PetscDSGetComponentOffsets(probAux, &aOff);
4213: PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4214: PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4215: PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4216: PetscDSGetTabulation(probAux, &BAux, &DAux);
4217: }
4218: NbI = Nb[field];
4219: NcI = Nc[field];
4220: BI = B[field];
4221: DI = D[field];
4222: for (e = 0; e < Ne; ++e) {
4223: const PetscReal *v0 = cgeom[e].v0;
4224: const PetscReal *J = cgeom[e].J;
4225: const PetscReal *invJ = cgeom[e].invJ;
4226: const PetscReal detJ = cgeom[e].detJ;
4227: const PetscReal *quadPoints, *quadWeights;
4228: PetscInt qNc, Nq, q;
4230: PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4231: if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4232: PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
4233: PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
4234: if (debug > 1) {
4235: PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", detJ);
4236: #ifndef PETSC_USE_COMPLEX
4237: DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
4238: #endif
4239: }
4240: for (q = 0; q < Nq; ++q) {
4241: if (debug) {PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);}
4242: CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4243: EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4244: if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4245: if (f0_func) f0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, numConstants, constants, &f0[q*NcI]);
4246: if (f1_func) {
4247: PetscMemzero(refSpaceDer, NcI*dim * sizeof(PetscScalar));
4248: f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, numConstants, constants, refSpaceDer);
4249: }
4250: TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
4251: }
4252: UpdateElementVec(dim, Nq, NbI, NcI, BI, DI, f0, f1, &elemVec[cOffset+fOffset]);
4253: cOffset += totDim;
4254: cOffsetAux += totDimAux;
4255: }
4256: return(0);
4257: }
4259: PetscErrorCode PetscFEIntegrateBdResidual_Basic(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEFaceGeom *fgeom,
4260: const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4261: {
4262: const PetscInt debug = 0;
4263: PetscBdPointFunc f0_func;
4264: PetscBdPointFunc f1_func;
4265: PetscQuadrature quad;
4266: PetscScalar *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4267: const PetscScalar *constants;
4268: PetscReal *x;
4269: PetscReal **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4270: PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4271: PetscInt dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
4272: PetscErrorCode ierr;
4275: PetscFEGetSpatialDimension(fem, &dim);
4276: PetscFEGetFaceQuadrature(fem, &quad);
4277: PetscDSGetNumFields(prob, &Nf);
4278: PetscDSGetTotalDimension(prob, &totDim);
4279: PetscDSGetDimensions(prob, &Nb);
4280: PetscDSGetComponents(prob, &Nc);
4281: PetscDSGetComponentOffsets(prob, &uOff);
4282: PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4283: PetscDSGetFieldOffset(prob, field, &fOffset);
4284: PetscDSGetBdResidual(prob, field, &f0_func, &f1_func);
4285: if (!f0_func && !f1_func) return(0);
4286: PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4287: PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4288: PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4289: PetscDSGetFaceTabulation(prob, &B, &D);
4290: PetscDSGetConstants(prob, &numConstants, &constants);
4291: if (probAux) {
4292: PetscDSGetNumFields(probAux, &NfAux);
4293: PetscDSGetTotalDimension(probAux, &totDimAux);
4294: PetscDSGetDimensions(probAux, &NbAux);
4295: PetscDSGetComponents(probAux, &NcAux);
4296: PetscDSGetComponentOffsets(probAux, &aOff);
4297: PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4298: PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4299: PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4300: PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
4301: }
4302: NbI = Nb[field];
4303: NcI = Nc[field];
4304: BI = B[field];
4305: DI = D[field];
4306: for (e = 0; e < Ne; ++e) {
4307: const PetscReal *quadPoints, *quadWeights;
4308: const PetscReal *v0 = fgeom[e].v0;
4309: const PetscReal *J = fgeom[e].J;
4310: const PetscReal *invJ = fgeom[e].invJ[0];
4311: const PetscReal detJ = fgeom[e].detJ;
4312: const PetscReal *n = fgeom[e].n;
4313: const PetscInt face = fgeom[e].face[0];
4314: PetscInt qNc, Nq, q;
4316: PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4317: if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4318: PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
4319: PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
4320: if (debug > 1) {
4321: PetscPrintf(PETSC_COMM_SELF, " detJ: %g\n", detJ);
4322: #ifndef PETSC_USE_COMPLEX
4323: DMPrintCellMatrix(e, "invJ", dim, dim, invJ);
4324: #endif
4325: }
4326: for (q = 0; q < Nq; ++q) {
4327: if (debug) {PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);}
4328: CoordinatesRefToReal(dim, dim-1, v0, J, &quadPoints[q*(dim-1)], x);
4329: EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4330: if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4331: if (f0_func) f0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, n, numConstants, constants, &f0[q*NcI]);
4332: if (f1_func) {
4333: PetscMemzero(refSpaceDer, NcI*dim * sizeof(PetscScalar));
4334: f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, n, numConstants, constants, refSpaceDer);
4335: }
4336: TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
4337: }
4338: UpdateElementVec(dim, Nq, NbI, NcI, &BI[face*Nq*NbI*NcI], &DI[face*Nq*NbI*NcI*dim], f0, f1, &elemVec[cOffset+fOffset]);
4339: cOffset += totDim;
4340: cOffsetAux += totDimAux;
4341: }
4342: return(0);
4343: }
4345: PetscErrorCode PetscFEIntegrateJacobian_Basic(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFECellGeom *geom,
4346: const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
4347: {
4348: const PetscInt debug = 0;
4349: PetscPointJac g0_func;
4350: PetscPointJac g1_func;
4351: PetscPointJac g2_func;
4352: PetscPointJac g3_func;
4353: PetscInt cOffset = 0; /* Offset into coefficients[] for element e */
4354: PetscInt cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
4355: PetscInt eOffset = 0; /* Offset into elemMat[] for element e */
4356: PetscInt offsetI = 0; /* Offset into an element vector for fieldI */
4357: PetscInt offsetJ = 0; /* Offset into an element vector for fieldJ */
4358: PetscQuadrature quad;
4359: PetscScalar *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4360: const PetscScalar *constants;
4361: PetscReal *x;
4362: PetscReal **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
4363: PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4364: PetscInt NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
4365: PetscInt dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, e;
4366: PetscErrorCode ierr;
4369: PetscFEGetSpatialDimension(fem, &dim);
4370: PetscFEGetQuadrature(fem, &quad);
4371: PetscDSGetNumFields(prob, &Nf);
4372: PetscDSGetTotalDimension(prob, &totDim);
4373: PetscDSGetDimensions(prob, &Nb);
4374: PetscDSGetComponents(prob, &Nc);
4375: PetscDSGetComponentOffsets(prob, &uOff);
4376: PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4377: switch(jtype) {
4378: case PETSCFE_JACOBIAN_DYN: PetscDSGetDynamicJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4379: case PETSCFE_JACOBIAN_PRE: PetscDSGetJacobianPreconditioner(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4380: case PETSCFE_JACOBIAN: PetscDSGetJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4381: }
4382: if (!g0_func && !g1_func && !g2_func && !g3_func) return(0);
4383: PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4384: PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4385: PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
4386: PetscDSGetTabulation(prob, &B, &D);
4387: PetscDSGetFieldOffset(prob, fieldI, &offsetI);
4388: PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
4389: PetscDSGetConstants(prob, &numConstants, &constants);
4390: if (probAux) {
4391: PetscDSGetNumFields(probAux, &NfAux);
4392: PetscDSGetTotalDimension(probAux, &totDimAux);
4393: PetscDSGetDimensions(probAux, &NbAux);
4394: PetscDSGetComponents(probAux, &NcAux);
4395: PetscDSGetComponentOffsets(probAux, &aOff);
4396: PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4397: PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4398: PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4399: PetscDSGetTabulation(probAux, &BAux, &DAux);
4400: }
4401: NbI = Nb[fieldI], NbJ = Nb[fieldJ];
4402: NcI = Nc[fieldI], NcJ = Nc[fieldJ];
4403: BI = B[fieldI], BJ = B[fieldJ];
4404: DI = D[fieldI], DJ = D[fieldJ];
4405: /* Initialize here in case the function is not defined */
4406: PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4407: PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
4408: PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
4409: PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4410: for (e = 0; e < Ne; ++e) {
4411: const PetscReal *v0 = geom[e].v0;
4412: const PetscReal *J = geom[e].J;
4413: const PetscReal *invJ = geom[e].invJ;
4414: const PetscReal detJ = geom[e].detJ;
4415: const PetscReal *quadPoints, *quadWeights;
4416: PetscInt qNc, Nq, q;
4418: PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4419: if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4420: for (q = 0; q < Nq; ++q) {
4421: const PetscReal *BIq = &BI[q*NbI*NcI], *BJq = &BJ[q*NbJ*NcJ];
4422: const PetscReal *DIq = &DI[q*NbI*NcI*dim], *DJq = &DJ[q*NbJ*NcJ*dim];
4423: const PetscReal w = detJ*quadWeights[q];
4424: PetscInt f, g, fc, gc, c;
4426: if (debug) {PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);}
4427: CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4428: EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4429: if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4430: if (g0_func) {
4431: PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4432: g0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, g0);
4433: for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
4434: }
4435: if (g1_func) {
4436: PetscInt d, d2;
4437: PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4438: g1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, refSpaceDer);
4439: for (fc = 0; fc < NcI; ++fc) {
4440: for (gc = 0; gc < NcJ; ++gc) {
4441: for (d = 0; d < dim; ++d) {
4442: g1[(fc*NcJ+gc)*dim+d] = 0.0;
4443: for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4444: g1[(fc*NcJ+gc)*dim+d] *= w;
4445: }
4446: }
4447: }
4448: }
4449: if (g2_func) {
4450: PetscInt d, d2;
4451: PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4452: g2_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, refSpaceDer);
4453: for (fc = 0; fc < NcI; ++fc) {
4454: for (gc = 0; gc < NcJ; ++gc) {
4455: for (d = 0; d < dim; ++d) {
4456: g2[(fc*NcJ+gc)*dim+d] = 0.0;
4457: for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4458: g2[(fc*NcJ+gc)*dim+d] *= w;
4459: }
4460: }
4461: }
4462: }
4463: if (g3_func) {
4464: PetscInt d, d2, dp, d3;
4465: PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4466: g3_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, refSpaceDer);
4467: for (fc = 0; fc < NcI; ++fc) {
4468: for (gc = 0; gc < NcJ; ++gc) {
4469: for (d = 0; d < dim; ++d) {
4470: for (dp = 0; dp < dim; ++dp) {
4471: g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
4472: for (d2 = 0; d2 < dim; ++d2) {
4473: for (d3 = 0; d3 < dim; ++d3) {
4474: g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
4475: }
4476: }
4477: g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
4478: }
4479: }
4480: }
4481: }
4482: }
4484: for (f = 0; f < NbI; ++f) {
4485: for (fc = 0; fc < NcI; ++fc) {
4486: const PetscInt fidx = f*NcI+fc; /* Test function basis index */
4487: const PetscInt i = offsetI+f; /* Element matrix row */
4488: for (g = 0; g < NbJ; ++g) {
4489: for (gc = 0; gc < NcJ; ++gc) {
4490: const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
4491: const PetscInt j = offsetJ+g; /* Element matrix column */
4492: const PetscInt fOff = eOffset+i*totDim+j;
4493: PetscInt d, d2;
4495: elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
4496: for (d = 0; d < dim; ++d) {
4497: elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
4498: elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
4499: for (d2 = 0; d2 < dim; ++d2) {
4500: elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
4501: }
4502: }
4503: }
4504: }
4505: }
4506: }
4507: }
4508: if (debug > 1) {
4509: PetscInt fc, f, gc, g;
4511: PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
4512: for (fc = 0; fc < NcI; ++fc) {
4513: for (f = 0; f < NbI; ++f) {
4514: const PetscInt i = offsetI + f*NcI+fc;
4515: for (gc = 0; gc < NcJ; ++gc) {
4516: for (g = 0; g < NbJ; ++g) {
4517: const PetscInt j = offsetJ + g*NcJ+gc;
4518: PetscPrintf(PETSC_COMM_SELF, " elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
4519: }
4520: }
4521: PetscPrintf(PETSC_COMM_SELF, "\n");
4522: }
4523: }
4524: }
4525: cOffset += totDim;
4526: cOffsetAux += totDimAux;
4527: eOffset += PetscSqr(totDim);
4528: }
4529: return(0);
4530: }
4532: PetscErrorCode PetscFEIntegrateBdJacobian_Basic(PetscFE fem, PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEFaceGeom *fgeom,
4533: const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
4534: {
4535: const PetscInt debug = 0;
4536: PetscBdPointJac g0_func;
4537: PetscBdPointJac g1_func;
4538: PetscBdPointJac g2_func;
4539: PetscBdPointJac g3_func;
4540: PetscInt cOffset = 0; /* Offset into coefficients[] for element e */
4541: PetscInt cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
4542: PetscInt eOffset = 0; /* Offset into elemMat[] for element e */
4543: PetscInt offsetI = 0; /* Offset into an element vector for fieldI */
4544: PetscInt offsetJ = 0; /* Offset into an element vector for fieldJ */
4545: PetscQuadrature quad;
4546: PetscScalar *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4547: const PetscScalar *constants;
4548: PetscReal *x;
4549: PetscReal **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
4550: PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4551: PetscInt NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
4552: PetscInt dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, e;
4553: PetscErrorCode ierr;
4556: PetscFEGetSpatialDimension(fem, &dim);
4557: PetscFEGetFaceQuadrature(fem, &quad);
4558: PetscDSGetNumFields(prob, &Nf);
4559: PetscDSGetTotalDimension(prob, &totDim);
4560: PetscDSGetDimensions(prob, &Nb);
4561: PetscDSGetComponents(prob, &Nc);
4562: PetscDSGetComponentOffsets(prob, &uOff);
4563: PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4564: PetscDSGetFieldOffset(prob, fieldI, &offsetI);
4565: PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
4566: PetscDSGetBdJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);
4567: PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4568: PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4569: PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
4570: PetscDSGetFaceTabulation(prob, &B, &D);
4571: PetscDSGetConstants(prob, &numConstants, &constants);
4572: if (probAux) {
4573: PetscDSGetNumFields(probAux, &NfAux);
4574: PetscDSGetTotalDimension(probAux, &totDimAux);
4575: PetscDSGetDimensions(probAux, &NbAux);
4576: PetscDSGetComponents(probAux, &NcAux);
4577: PetscDSGetComponentOffsets(probAux, &aOff);
4578: PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4579: PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4580: PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4581: PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
4582: }
4583: NbI = Nb[fieldI], NbJ = Nb[fieldJ];
4584: NcI = Nc[fieldI], NcJ = Nc[fieldJ];
4585: BI = B[fieldI], BJ = B[fieldJ];
4586: DI = D[fieldI], DJ = D[fieldJ];
4587: /* Initialize here in case the function is not defined */
4588: PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4589: PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
4590: PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
4591: PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4592: for (e = 0; e < Ne; ++e) {
4593: const PetscReal *quadPoints, *quadWeights;
4594: const PetscReal *v0 = fgeom[e].v0;
4595: const PetscReal *J = fgeom[e].J;
4596: const PetscReal *invJ = fgeom[e].invJ[0];
4597: const PetscReal detJ = fgeom[e].detJ;
4598: const PetscReal *n = fgeom[e].n;
4599: const PetscInt face = fgeom[e].face[0];
4600: PetscInt qNc, Nq, q;
4602: PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4603: if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4604: for (q = 0; q < Nq; ++q) {
4605: const PetscReal *BIq = &BI[(face*Nq+q)*NbI*NcI], *BJq = &BJ[(face*Nq+q)*NbJ*NcJ];
4606: const PetscReal *DIq = &DI[(face*Nq+q)*NbI*NcI*dim], *DJq = &DJ[(face*Nq+q)*NbJ*NcJ*dim];
4607: const PetscReal w = detJ*quadWeights[q];
4608: PetscInt f, g, fc, gc, c;
4610: if (debug) {PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);}
4611: CoordinatesRefToReal(dim, dim-1, v0, J, &quadPoints[q*(dim-1)], x);
4612: EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4613: if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4614: if (g0_func) {
4615: PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4616: g0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, n, numConstants, constants, g0);
4617: for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
4618: }
4619: if (g1_func) {
4620: PetscInt d, d2;
4621: PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4622: g1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, n, numConstants, constants, refSpaceDer);
4623: for (fc = 0; fc < NcI; ++fc) {
4624: for (gc = 0; gc < NcJ; ++gc) {
4625: for (d = 0; d < dim; ++d) {
4626: g1[(fc*NcJ+gc)*dim+d] = 0.0;
4627: for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4628: g1[(fc*NcJ+gc)*dim+d] *= w;
4629: }
4630: }
4631: }
4632: }
4633: if (g2_func) {
4634: PetscInt d, d2;
4635: PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
4636: g2_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, n, numConstants, constants, refSpaceDer);
4637: for (fc = 0; fc < NcI; ++fc) {
4638: for (gc = 0; gc < NcJ; ++gc) {
4639: for (d = 0; d < dim; ++d) {
4640: g2[(fc*NcJ+gc)*dim+d] = 0.0;
4641: for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
4642: g2[(fc*NcJ+gc)*dim+d] *= w;
4643: }
4644: }
4645: }
4646: }
4647: if (g3_func) {
4648: PetscInt d, d2, dp, d3;
4649: PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4650: g3_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, n, numConstants, constants, refSpaceDer);
4651: for (fc = 0; fc < NcI; ++fc) {
4652: for (gc = 0; gc < NcJ; ++gc) {
4653: for (d = 0; d < dim; ++d) {
4654: for (dp = 0; dp < dim; ++dp) {
4655: g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
4656: for (d2 = 0; d2 < dim; ++d2) {
4657: for (d3 = 0; d3 < dim; ++d3) {
4658: g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
4659: }
4660: }
4661: g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
4662: }
4663: }
4664: }
4665: }
4666: }
4668: for (f = 0; f < NbI; ++f) {
4669: for (fc = 0; fc < NcI; ++fc) {
4670: const PetscInt fidx = f*NcI+fc; /* Test function basis index */
4671: const PetscInt i = offsetI+f; /* Element matrix row */
4672: for (g = 0; g < NbJ; ++g) {
4673: for (gc = 0; gc < NcJ; ++gc) {
4674: const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
4675: const PetscInt j = offsetJ+g; /* Element matrix column */
4676: const PetscInt fOff = eOffset+i*totDim+j;
4677: PetscInt d, d2;
4679: elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
4680: for (d = 0; d < dim; ++d) {
4681: elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
4682: elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
4683: for (d2 = 0; d2 < dim; ++d2) {
4684: elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
4685: }
4686: }
4687: }
4688: }
4689: }
4690: }
4691: }
4692: if (debug > 1) {
4693: PetscInt fc, f, gc, g;
4695: PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
4696: for (fc = 0; fc < NcI; ++fc) {
4697: for (f = 0; f < NbI; ++f) {
4698: const PetscInt i = offsetI + f*NcI+fc;
4699: for (gc = 0; gc < NcJ; ++gc) {
4700: for (g = 0; g < NbJ; ++g) {
4701: const PetscInt j = offsetJ + g*NcJ+gc;
4702: PetscPrintf(PETSC_COMM_SELF, " elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
4703: }
4704: }
4705: PetscPrintf(PETSC_COMM_SELF, "\n");
4706: }
4707: }
4708: }
4709: cOffset += totDim;
4710: cOffsetAux += totDimAux;
4711: eOffset += PetscSqr(totDim);
4712: }
4713: return(0);
4714: }
4716: PetscErrorCode PetscFEInitialize_Basic(PetscFE fem)
4717: {
4719: fem->ops->setfromoptions = NULL;
4720: fem->ops->setup = PetscFESetUp_Basic;
4721: fem->ops->view = PetscFEView_Basic;
4722: fem->ops->destroy = PetscFEDestroy_Basic;
4723: fem->ops->getdimension = PetscFEGetDimension_Basic;
4724: fem->ops->gettabulation = PetscFEGetTabulation_Basic;
4725: fem->ops->integrate = PetscFEIntegrate_Basic;
4726: fem->ops->integrateresidual = PetscFEIntegrateResidual_Basic;
4727: fem->ops->integratebdresidual = PetscFEIntegrateBdResidual_Basic;
4728: fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Basic */;
4729: fem->ops->integratejacobian = PetscFEIntegrateJacobian_Basic;
4730: fem->ops->integratebdjacobian = PetscFEIntegrateBdJacobian_Basic;
4731: return(0);
4732: }
4734: /*MC
4735: PETSCFEBASIC = "basic" - A PetscFE object that integrates with basic tiling and no vectorization
4737: Level: intermediate
4739: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
4740: M*/
4742: PETSC_EXTERN PetscErrorCode PetscFECreate_Basic(PetscFE fem)
4743: {
4744: PetscFE_Basic *b;
4749: PetscNewLog(fem,&b);
4750: fem->data = b;
4752: PetscFEInitialize_Basic(fem);
4753: return(0);
4754: }
4756: PetscErrorCode PetscFEDestroy_Nonaffine(PetscFE fem)
4757: {
4758: PetscFE_Nonaffine *na = (PetscFE_Nonaffine *) fem->data;
4762: PetscFree(na);
4763: return(0);
4764: }
4766: PetscErrorCode PetscFEIntegrateResidual_Nonaffine(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
4767: const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4768: {
4769: const PetscInt debug = 0;
4770: PetscPointFunc f0_func;
4771: PetscPointFunc f1_func;
4772: PetscQuadrature quad;
4773: PetscScalar *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4774: const PetscScalar *constants;
4775: PetscReal *x;
4776: PetscReal **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4777: PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4778: PetscInt dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
4779: PetscErrorCode ierr;
4782: PetscFEGetSpatialDimension(fem, &dim);
4783: PetscFEGetQuadrature(fem, &quad);
4784: PetscDSGetNumFields(prob, &Nf);
4785: PetscDSGetTotalDimension(prob, &totDim);
4786: PetscDSGetDimensions(prob, &Nb);
4787: PetscDSGetComponents(prob, &Nc);
4788: PetscDSGetComponentOffsets(prob, &uOff);
4789: PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4790: PetscDSGetFieldOffset(prob, field, &fOffset);
4791: PetscDSGetResidual(prob, field, &f0_func, &f1_func);
4792: PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4793: PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4794: PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4795: PetscDSGetTabulation(prob, &B, &D);
4796: PetscDSGetConstants(prob, &numConstants, &constants);
4797: if (probAux) {
4798: PetscDSGetNumFields(probAux, &NfAux);
4799: PetscDSGetTotalDimension(probAux, &totDimAux);
4800: PetscDSGetDimensions(probAux, &NbAux);
4801: PetscDSGetComponents(probAux, &NcAux);
4802: PetscDSGetComponentOffsets(probAux, &aOff);
4803: PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4804: PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4805: PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4806: PetscDSGetTabulation(probAux, &BAux, &DAux);
4807: }
4808: NbI = Nb[field];
4809: NcI = Nc[field];
4810: BI = B[field];
4811: DI = D[field];
4812: for (e = 0; e < Ne; ++e) {
4813: const PetscReal *quadPoints, *quadWeights;
4814: PetscInt qNc, Nq, q;
4816: PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4817: if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4818: PetscMemzero(f0, Nq*Nc[field]* sizeof(PetscScalar));
4819: PetscMemzero(f1, Nq*Nc[field]*dim * sizeof(PetscScalar));
4820: for (q = 0; q < Nq; ++q) {
4821: const PetscReal *v0 = cgeom[e*Nq+q].v0;
4822: const PetscReal *J = cgeom[e*Nq+q].J;
4823: const PetscReal *invJ = cgeom[e*Nq+q].invJ;
4824: const PetscReal detJ = cgeom[e*Nq+q].detJ;
4826: if (debug) {PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);}
4827: CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
4828: EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4829: if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4830: if (f0_func) f0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, numConstants, constants, &f0[q*NcI]);
4831: if (f1_func) {
4832: PetscMemzero(refSpaceDer, NcI*dim * sizeof(PetscScalar));
4833: f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, numConstants, constants, refSpaceDer);
4834: }
4835: TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0, f1);
4836: }
4837: UpdateElementVec(dim, Nq, NbI, NcI, BI, DI, f0, f1, &elemVec[cOffset+fOffset]);
4838: cOffset += totDim;
4839: cOffsetAux += totDimAux;
4840: }
4841: return(0);
4842: }
4844: PetscErrorCode PetscFEIntegrateBdResidual_Nonaffine(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEFaceGeom *fgeom,
4845: const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
4846: {
4847: const PetscInt debug = 0;
4848: PetscBdPointFunc f0_func;
4849: PetscBdPointFunc f1_func;
4850: PetscQuadrature quad;
4851: PetscScalar *f0, *f1, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4852: const PetscScalar *constants;
4853: PetscReal *x;
4854: PetscReal **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI;
4855: PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4856: PetscInt dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, cOffset = 0, cOffsetAux = 0, fOffset, e, NbI, NcI;
4857: PetscErrorCode ierr;
4860: PetscFEGetSpatialDimension(fem, &dim);
4861: PetscFEGetFaceQuadrature(fem, &quad);
4862: PetscDSGetNumFields(prob, &Nf);
4863: PetscDSGetTotalDimension(prob, &totDim);
4864: PetscDSGetDimensions(prob, &Nb);
4865: PetscDSGetComponents(prob, &Nc);
4866: PetscDSGetComponentOffsets(prob, &uOff);
4867: PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4868: PetscDSGetFieldOffset(prob, field, &fOffset);
4869: PetscDSGetBdResidual(prob, field, &f0_func, &f1_func);
4870: if (!f0_func && !f1_func) return(0);
4871: PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4872: PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4873: PetscDSGetWeakFormArrays(prob, &f0, &f1, NULL, NULL, NULL, NULL);
4874: PetscDSGetFaceTabulation(prob, &B, &D);
4875: PetscDSGetConstants(prob, &numConstants, &constants);
4876: if (probAux) {
4877: PetscDSGetNumFields(probAux, &NfAux);
4878: PetscDSGetTotalDimension(probAux, &totDimAux);
4879: PetscDSGetDimensions(probAux, &NbAux);
4880: PetscDSGetComponents(probAux, &NcAux);
4881: PetscDSGetComponentOffsets(probAux, &aOff);
4882: PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4883: PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4884: PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4885: PetscDSGetFaceTabulation(probAux, &BAux, &DAux);
4886: }
4887: NbI = Nb[field];
4888: NcI = Nc[field];
4889: BI = B[field];
4890: DI = D[field];
4891: for (e = 0; e < Ne; ++e) {
4892: const PetscReal *quadPoints, *quadWeights;
4893: PetscInt qNc, Nq, q, face;
4895: PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4896: if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4897: face = fgeom[e*Nq].face[0];
4898: PetscMemzero(f0, Nq*NcI* sizeof(PetscScalar));
4899: PetscMemzero(f1, Nq*NcI*dim * sizeof(PetscScalar));
4900: for (q = 0; q < Nq; ++q) {
4901: const PetscReal *v0 = fgeom[e*Nq+q].v0;
4902: const PetscReal *J = fgeom[e*Nq+q].J;
4903: const PetscReal *invJ = fgeom[e*Nq+q].invJ[0];
4904: const PetscReal detJ = fgeom[e*Nq+q].detJ;
4905: const PetscReal *n = fgeom[e*Nq+q].n;
4907: if (debug) {PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);}
4908: CoordinatesRefToReal(dim, dim-1, v0, J, &quadPoints[q*(dim-1)], x);
4909: EvaluateFieldJets(dim, Nf, Nb, Nc, face*Nq+q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
4910: if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, face*Nq+q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
4911: if (f0_func) f0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, n, numConstants, constants, &f0[q*NcI]);
4912: if (f1_func) {
4913: PetscMemzero(refSpaceDer, NcI*dim * sizeof(PetscScalar));
4914: f1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, x, n, numConstants, constants, refSpaceDer);
4915: }
4916: TransformF(dim, NcI, q, invJ, detJ, quadWeights, refSpaceDer, f0_func ? f0 : NULL, f1_func ? f1 : NULL);
4917: }
4918: UpdateElementVec(dim, Nq, NbI, NcI, &BI[face*Nq*NbI*NcI], &DI[face*Nq*NbI*NcI*dim], f0, f1, &elemVec[cOffset+fOffset]);
4919: cOffset += totDim;
4920: cOffsetAux += totDimAux;
4921: }
4922: return(0);
4923: }
4925: PetscErrorCode PetscFEIntegrateJacobian_Nonaffine(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFECellGeom *cgeom,
4926: const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
4927: {
4928: const PetscInt debug = 0;
4929: PetscPointJac g0_func;
4930: PetscPointJac g1_func;
4931: PetscPointJac g2_func;
4932: PetscPointJac g3_func;
4933: PetscInt cOffset = 0; /* Offset into coefficients[] for element e */
4934: PetscInt cOffsetAux = 0; /* Offset into coefficientsAux[] for element e */
4935: PetscInt eOffset = 0; /* Offset into elemMat[] for element e */
4936: PetscInt offsetI = 0; /* Offset into an element vector for fieldI */
4937: PetscInt offsetJ = 0; /* Offset into an element vector for fieldJ */
4938: PetscQuadrature quad;
4939: PetscScalar *g0, *g1, *g2, *g3, *u, *u_t = NULL, *u_x, *a, *a_x, *refSpaceDer, *refSpaceDerAux;
4940: const PetscScalar *constants;
4941: PetscReal *x;
4942: PetscReal **B, **D, **BAux = NULL, **DAux = NULL, *BI, *DI, *BJ, *DJ;
4943: PetscInt NbI = 0, NcI = 0, NbJ = 0, NcJ = 0;
4944: PetscInt *uOff, *uOff_x, *aOff = NULL, *aOff_x = NULL, *Nb, *Nc, *NbAux = NULL, *NcAux = NULL;
4945: PetscInt dim, numConstants, Nf, NfAux = 0, totDim, totDimAux = 0, e;
4946: PetscErrorCode ierr;
4949: PetscFEGetSpatialDimension(fem, &dim);
4950: PetscFEGetQuadrature(fem, &quad);
4951: PetscDSGetNumFields(prob, &Nf);
4952: PetscDSGetTotalDimension(prob, &totDim);
4953: PetscDSGetDimensions(prob, &Nb);
4954: PetscDSGetComponents(prob, &Nc);
4955: PetscDSGetComponentOffsets(prob, &uOff);
4956: PetscDSGetComponentDerivativeOffsets(prob, &uOff_x);
4957: switch(jtype) {
4958: case PETSCFE_JACOBIAN_DYN: PetscDSGetDynamicJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4959: case PETSCFE_JACOBIAN_PRE: PetscDSGetJacobianPreconditioner(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4960: case PETSCFE_JACOBIAN: PetscDSGetJacobian(prob, fieldI, fieldJ, &g0_func, &g1_func, &g2_func, &g3_func);break;
4961: }
4962: PetscDSGetEvaluationArrays(prob, &u, coefficients_t ? &u_t : NULL, &u_x);
4963: PetscDSGetRefCoordArrays(prob, &x, &refSpaceDer);
4964: PetscDSGetWeakFormArrays(prob, NULL, NULL, &g0, &g1, &g2, &g3);
4965: PetscDSGetTabulation(prob, &B, &D);
4966: PetscDSGetFieldOffset(prob, fieldI, &offsetI);
4967: PetscDSGetFieldOffset(prob, fieldJ, &offsetJ);
4968: PetscDSGetConstants(prob, &numConstants, &constants);
4969: if (probAux) {
4970: PetscDSGetNumFields(probAux, &NfAux);
4971: PetscDSGetTotalDimension(probAux, &totDimAux);
4972: PetscDSGetDimensions(probAux, &NbAux);
4973: PetscDSGetComponents(probAux, &NcAux);
4974: PetscDSGetComponentOffsets(probAux, &aOff);
4975: PetscDSGetComponentDerivativeOffsets(probAux, &aOff_x);
4976: PetscDSGetEvaluationArrays(probAux, &a, NULL, &a_x);
4977: PetscDSGetRefCoordArrays(probAux, NULL, &refSpaceDerAux);
4978: PetscDSGetTabulation(probAux, &BAux, &DAux);
4979: }
4980: NbI = Nb[fieldI], NbJ = Nb[fieldJ];
4981: NcI = Nc[fieldI], NcJ = Nc[fieldJ];
4982: BI = B[fieldI], BJ = B[fieldJ];
4983: DI = D[fieldI], DJ = D[fieldJ];
4984: /* Initialize here in case the function is not defined */
4985: PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
4986: PetscMemzero(g1, NcI*NcJ*dim * sizeof(PetscScalar));
4987: PetscMemzero(g2, NcI*NcJ*dim * sizeof(PetscScalar));
4988: PetscMemzero(g3, NcI*NcJ*dim*dim * sizeof(PetscScalar));
4989: for (e = 0; e < Ne; ++e) {
4990: const PetscReal *quadPoints, *quadWeights;
4991: PetscInt qNc, Nq, q;
4993: PetscQuadratureGetData(quad, NULL, &qNc, &Nq, &quadPoints, &quadWeights);
4994: if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
4995: for (q = 0; q < Nq; ++q) {
4996: const PetscReal *v0 = cgeom[e*Nq+q].v0;
4997: const PetscReal *J = cgeom[e*Nq+q].J;
4998: const PetscReal *invJ = cgeom[e*Nq+q].invJ;
4999: const PetscReal detJ = cgeom[e*Nq+q].detJ;
5000: const PetscReal *BIq = &BI[q*NbI*NcI], *BJq = &BJ[q*NbJ*NcJ];
5001: const PetscReal *DIq = &DI[q*NbI*NcI*dim], *DJq = &DJ[q*NbJ*NcJ*dim];
5002: const PetscReal w = detJ*quadWeights[q];
5003: PetscInt f, g, fc, gc, c;
5005: if (debug) {PetscPrintf(PETSC_COMM_SELF, " quad point %d\n", q);}
5006: CoordinatesRefToReal(dim, dim, v0, J, &quadPoints[q*dim], x);
5007: EvaluateFieldJets(dim, Nf, Nb, Nc, q, B, D, refSpaceDer, invJ, &coefficients[cOffset], &coefficients_t[cOffset], u, u_x, u_t);
5008: if (probAux) EvaluateFieldJets(dim, NfAux, NbAux, NcAux, q, BAux, DAux, refSpaceDerAux, invJ, &coefficientsAux[cOffsetAux], NULL, a, a_x, NULL);
5009: if (g0_func) {
5010: PetscMemzero(g0, NcI*NcJ * sizeof(PetscScalar));
5011: g0_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, g0);
5012: for (c = 0; c < NcI*NcJ; ++c) g0[c] *= w;
5013: }
5014: if (g1_func) {
5015: PetscInt d, d2;
5016: PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
5017: g1_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, refSpaceDer);
5018: for (fc = 0; fc < NcI; ++fc) {
5019: for (gc = 0; gc < NcJ; ++gc) {
5020: for (d = 0; d < dim; ++d) {
5021: g1[(fc*NcJ+gc)*dim+d] = 0.0;
5022: for (d2 = 0; d2 < dim; ++d2) g1[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
5023: g1[(fc*NcJ+gc)*dim+d] *= w;
5024: }
5025: }
5026: }
5027: }
5028: if (g2_func) {
5029: PetscInt d, d2;
5030: PetscMemzero(refSpaceDer, NcI*NcJ*dim * sizeof(PetscScalar));
5031: g2_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, refSpaceDer);
5032: for (fc = 0; fc < NcI; ++fc) {
5033: for (gc = 0; gc < NcJ; ++gc) {
5034: for (d = 0; d < dim; ++d) {
5035: g2[(fc*NcJ+gc)*dim+d] = 0.0;
5036: for (d2 = 0; d2 < dim; ++d2) g2[(fc*NcJ+gc)*dim+d] += invJ[d*dim+d2]*refSpaceDer[(fc*NcJ+gc)*dim+d2];
5037: g2[(fc*NcJ+gc)*dim+d] *= w;
5038: }
5039: }
5040: }
5041: }
5042: if (g3_func) {
5043: PetscInt d, d2, dp, d3;
5044: PetscMemzero(refSpaceDer, NcI*NcJ*dim*dim * sizeof(PetscScalar));
5045: g3_func(dim, Nf, NfAux, uOff, uOff_x, u, u_t, u_x, aOff, aOff_x, a, NULL, a_x, t, u_tshift, x, numConstants, constants, refSpaceDer);
5046: for (fc = 0; fc < NcI; ++fc) {
5047: for (gc = 0; gc < NcJ; ++gc) {
5048: for (d = 0; d < dim; ++d) {
5049: for (dp = 0; dp < dim; ++dp) {
5050: g3[((fc*NcJ+gc)*dim+d)*dim+dp] = 0.0;
5051: for (d2 = 0; d2 < dim; ++d2) {
5052: for (d3 = 0; d3 < dim; ++d3) {
5053: g3[((fc*NcJ+gc)*dim+d)*dim+dp] += invJ[d*dim+d2]*refSpaceDer[((fc*NcJ+gc)*dim+d2)*dim+d3]*invJ[dp*dim+d3];
5054: }
5055: }
5056: g3[((fc*NcJ+gc)*dim+d)*dim+dp] *= w;
5057: }
5058: }
5059: }
5060: }
5061: }
5063: for (f = 0; f < NbI; ++f) {
5064: for (fc = 0; fc < NcI; ++fc) {
5065: const PetscInt fidx = f*NcI+fc; /* Test function basis index */
5066: const PetscInt i = offsetI+f; /* Element matrix row */
5067: for (g = 0; g < NbJ; ++g) {
5068: for (gc = 0; gc < NcJ; ++gc) {
5069: const PetscInt gidx = g*NcJ+gc; /* Trial function basis index */
5070: const PetscInt j = offsetJ+g; /* Element matrix column */
5071: const PetscInt fOff = eOffset+i*totDim+j;
5072: PetscInt d, d2;
5074: elemMat[fOff] += BIq[fidx]*g0[fc*NcJ+gc]*BJq[gidx];
5075: for (d = 0; d < dim; ++d) {
5076: elemMat[fOff] += BIq[fidx]*g1[(fc*NcJ+gc)*dim+d]*DJq[gidx*dim+d];
5077: elemMat[fOff] += DIq[fidx*dim+d]*g2[(fc*NcJ+gc)*dim+d]*BJq[gidx];
5078: for (d2 = 0; d2 < dim; ++d2) {
5079: elemMat[fOff] += DIq[fidx*dim+d]*g3[((fc*NcJ+gc)*dim+d)*dim+d2]*DJq[gidx*dim+d2];
5080: }
5081: }
5082: }
5083: }
5084: }
5085: }
5086: }
5087: if (debug > 1) {
5088: PetscInt fc, f, gc, g;
5090: PetscPrintf(PETSC_COMM_SELF, "Element matrix for fields %d and %d\n", fieldI, fieldJ);
5091: for (fc = 0; fc < NcI; ++fc) {
5092: for (f = 0; f < NbI; ++f) {
5093: const PetscInt i = offsetI + f*NcI+fc;
5094: for (gc = 0; gc < NcJ; ++gc) {
5095: for (g = 0; g < NbJ; ++g) {
5096: const PetscInt j = offsetJ + g*NcJ+gc;
5097: PetscPrintf(PETSC_COMM_SELF, " elemMat[%d,%d,%d,%d]: %g\n", f, fc, g, gc, PetscRealPart(elemMat[eOffset+i*totDim+j]));
5098: }
5099: }
5100: PetscPrintf(PETSC_COMM_SELF, "\n");
5101: }
5102: }
5103: }
5104: cOffset += totDim;
5105: cOffsetAux += totDimAux;
5106: eOffset += PetscSqr(totDim);
5107: }
5108: return(0);
5109: }
5111: PetscErrorCode PetscFEInitialize_Nonaffine(PetscFE fem)
5112: {
5114: fem->ops->setfromoptions = NULL;
5115: fem->ops->setup = PetscFESetUp_Basic;
5116: fem->ops->view = NULL;
5117: fem->ops->destroy = PetscFEDestroy_Nonaffine;
5118: fem->ops->getdimension = PetscFEGetDimension_Basic;
5119: fem->ops->gettabulation = PetscFEGetTabulation_Basic;
5120: fem->ops->integrateresidual = PetscFEIntegrateResidual_Nonaffine;
5121: fem->ops->integratebdresidual = PetscFEIntegrateBdResidual_Nonaffine;
5122: fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Nonaffine */;
5123: fem->ops->integratejacobian = PetscFEIntegrateJacobian_Nonaffine;
5124: return(0);
5125: }
5127: /*MC
5128: PETSCFENONAFFINE = "nonaffine" - A PetscFE object that integrates with basic tiling and no vectorization for non-affine mappings
5130: Level: intermediate
5132: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
5133: M*/
5135: PETSC_EXTERN PetscErrorCode PetscFECreate_Nonaffine(PetscFE fem)
5136: {
5137: PetscFE_Nonaffine *na;
5138: PetscErrorCode ierr;
5142: PetscNewLog(fem, &na);
5143: fem->data = na;
5145: PetscFEInitialize_Nonaffine(fem);
5146: return(0);
5147: }
5149: #ifdef PETSC_HAVE_OPENCL
5151: PetscErrorCode PetscFEDestroy_OpenCL(PetscFE fem)
5152: {
5153: PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5154: PetscErrorCode ierr;
5157: clReleaseCommandQueue(ocl->queue_id);
5158: ocl->queue_id = 0;
5159: clReleaseContext(ocl->ctx_id);
5160: ocl->ctx_id = 0;
5161: PetscFree(ocl);
5162: return(0);
5163: }
5165: #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)
5166: enum {LAPLACIAN = 0, ELASTICITY = 1};
5168: /* NOTE: This is now broken for vector problems. Must redo loops to respect vector basis elements */
5169: /* dim Number of spatial dimensions: 2 */
5170: /* N_b Number of basis functions: generated */
5171: /* N_{bt} Number of total basis functions: N_b * N_{comp} */
5172: /* N_q Number of quadrature points: generated */
5173: /* N_{bs} Number of block cells LCM(N_b, N_q) */
5174: /* N_{bst} Number of block cell components LCM(N_{bt}, N_q) */
5175: /* N_{bl} Number of concurrent blocks generated */
5176: /* N_t Number of threads: N_{bl} * N_{bs} */
5177: /* N_{cbc} Number of concurrent basis cells: N_{bl} * N_q */
5178: /* N_{cqc} Number of concurrent quadrature cells: N_{bl} * N_b */
5179: /* N_{sbc} Number of serial basis cells: N_{bs} / N_q */
5180: /* N_{sqc} Number of serial quadrature cells: N_{bs} / N_b */
5181: /* N_{cb} Number of serial cell batches: input */
5182: /* N_c Number of total cells: N_{cb}*N_{t}/N_{comp} */
5183: PetscErrorCode PetscFEOpenCLGenerateIntegrationCode(PetscFE fem, char **string_buffer, PetscInt buffer_length, PetscBool useAux, PetscInt N_bl)
5184: {
5185: PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5186: PetscQuadrature q;
5187: char *string_tail = *string_buffer;
5188: char *end_of_buffer = *string_buffer + buffer_length;
5189: char float_str[] = "float", double_str[] = "double";
5190: char *numeric_str = &(float_str[0]);
5191: PetscInt op = ocl->op;
5192: PetscBool useField = PETSC_FALSE;
5193: PetscBool useFieldDer = PETSC_TRUE;
5194: PetscBool useFieldAux = useAux;
5195: PetscBool useFieldDerAux= PETSC_FALSE;
5196: PetscBool useF0 = PETSC_TRUE;
5197: PetscBool useF1 = PETSC_TRUE;
5198: const PetscReal *points, *weights;
5199: PetscReal *basis, *basisDer;
5200: PetscInt dim, qNc, N_b, N_c, N_q, N_t, p, d, b, c;
5201: size_t count;
5202: PetscErrorCode ierr;
5205: PetscFEGetSpatialDimension(fem, &dim);
5206: PetscFEGetDimension(fem, &N_b);
5207: PetscFEGetNumComponents(fem, &N_c);
5208: PetscFEGetQuadrature(fem, &q);
5209: PetscQuadratureGetData(q, NULL, &qNc, &N_q, &points, &weights);
5210: if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
5211: N_t = N_b * N_c * N_q * N_bl;
5212: /* Enable device extension for double precision */
5213: if (ocl->realType == PETSC_DOUBLE) {
5214: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5215: "#if defined(cl_khr_fp64)\n"
5216: "# pragma OPENCL EXTENSION cl_khr_fp64: enable\n"
5217: "#elif defined(cl_amd_fp64)\n"
5218: "# pragma OPENCL EXTENSION cl_amd_fp64: enable\n"
5219: "#endif\n",
5220: &count);STRING_ERROR_CHECK("Message to short");
5221: numeric_str = &(double_str[0]);
5222: }
5223: /* Kernel API */
5224: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5225: "\n"
5226: "__kernel void integrateElementQuadrature(int N_cb, __global %s *coefficients, __global %s *coefficientsAux, __global %s *jacobianInverses, __global %s *jacobianDeterminants, __global %s *elemVec)\n"
5227: "{\n",
5228: &count, numeric_str, numeric_str, numeric_str, numeric_str, numeric_str);STRING_ERROR_CHECK("Message to short");
5229: /* Quadrature */
5230: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5231: " /* Quadrature points\n"
5232: " - (x1,y1,x2,y2,...) */\n"
5233: " const %s points[%d] = {\n",
5234: &count, numeric_str, N_q*dim);STRING_ERROR_CHECK("Message to short");
5235: for (p = 0; p < N_q; ++p) {
5236: for (d = 0; d < dim; ++d) {
5237: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "%g,\n", &count, points[p*dim+d]);STRING_ERROR_CHECK("Message to short");
5238: }
5239: }
5240: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
5241: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5242: " /* Quadrature weights\n"
5243: " - (v1,v2,...) */\n"
5244: " const %s weights[%d] = {\n",
5245: &count, numeric_str, N_q);STRING_ERROR_CHECK("Message to short");
5246: for (p = 0; p < N_q; ++p) {
5247: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "%g,\n", &count, weights[p]);STRING_ERROR_CHECK("Message to short");
5248: }
5249: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
5250: /* Basis Functions */
5251: PetscFEGetDefaultTabulation(fem, &basis, &basisDer, NULL);
5252: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5253: " /* Nodal basis function evaluations\n"
5254: " - basis component is fastest varying, the basis function, then point */\n"
5255: " const %s Basis[%d] = {\n",
5256: &count, numeric_str, N_q*N_b*N_c);STRING_ERROR_CHECK("Message to short");
5257: for (p = 0; p < N_q; ++p) {
5258: for (b = 0; b < N_b; ++b) {
5259: for (c = 0; c < N_c; ++c) {
5260: 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");
5261: }
5262: }
5263: }
5264: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
5265: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5266: "\n"
5267: " /* Nodal basis function derivative evaluations,\n"
5268: " - derivative direction is fastest varying, then basis component, then basis function, then point */\n"
5269: " const %s%d BasisDerivatives[%d] = {\n",
5270: &count, numeric_str, dim, N_q*N_b*N_c);STRING_ERROR_CHECK("Message to short");
5271: for (p = 0; p < N_q; ++p) {
5272: for (b = 0; b < N_b; ++b) {
5273: for (c = 0; c < N_c; ++c) {
5274: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "(%s%d)(", &count, numeric_str, dim);STRING_ERROR_CHECK("Message to short");
5275: for (d = 0; d < dim; ++d) {
5276: if (d > 0) {
5277: 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");
5278: } else {
5279: 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");
5280: }
5281: }
5282: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "),\n", &count);STRING_ERROR_CHECK("Message to short");
5283: }
5284: }
5285: }
5286: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, "};\n", &count);STRING_ERROR_CHECK("Message to short");
5287: /* Sizes */
5288: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5289: " const int dim = %d; // The spatial dimension\n"
5290: " const int N_bl = %d; // The number of concurrent blocks\n"
5291: " const int N_b = %d; // The number of basis functions\n"
5292: " const int N_comp = %d; // The number of basis function components\n"
5293: " const int N_bt = N_b*N_comp; // The total number of scalar basis functions\n"
5294: " const int N_q = %d; // The number of quadrature points\n"
5295: " 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"
5296: " const int N_t = N_bst*N_bl; // The number of threads, N_bst * N_bl\n"
5297: " const int N_bc = N_t/N_comp; // The number of cells per batch (N_b*N_q*N_bl)\n"
5298: " const int N_sbc = N_bst / (N_q * N_comp);\n"
5299: " const int N_sqc = N_bst / N_bt;\n"
5300: " /*const int N_c = N_cb * N_bc;*/\n"
5301: "\n"
5302: " /* Calculated indices */\n"
5303: " /*const int tidx = get_local_id(0) + get_local_size(0)*get_local_id(1);*/\n"
5304: " const int tidx = get_local_id(0);\n"
5305: " const int blidx = tidx / N_bst; // Block number for this thread\n"
5306: " const int bidx = tidx %% N_bt; // Basis function mapped to this thread\n"
5307: " const int cidx = tidx %% N_comp; // Basis component mapped to this thread\n"
5308: " const int qidx = tidx %% N_q; // Quadrature point mapped to this thread\n"
5309: " const int blbidx = tidx %% N_q + blidx*N_q; // Cell mapped to this thread in the basis phase\n"
5310: " const int blqidx = tidx %% N_b + blidx*N_b; // Cell mapped to this thread in the quadrature phase\n"
5311: " const int gidx = get_group_id(1)*get_num_groups(0) + get_group_id(0);\n"
5312: " const int Goffset = gidx*N_cb*N_bc;\n",
5313: &count, dim, N_bl, N_b, N_c, N_q);STRING_ERROR_CHECK("Message to short");
5314: /* Local memory */
5315: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5316: "\n"
5317: " /* Quadrature data */\n"
5318: " %s w; // $w_q$, Quadrature weight at $x_q$\n"
5319: " __local %s phi_i[%d]; //[N_bt*N_q]; // $\\phi_i(x_q)$, Value of the basis function $i$ at $x_q$\n"
5320: " __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"
5321: " /* Geometric data */\n"
5322: " __local %s detJ[%d]; //[N_t]; // $|J(x_q)|$, Jacobian determinant at $x_q$\n"
5323: " __local %s invJ[%d];//[N_t*dim*dim]; // $J^{-1}(x_q)$, Jacobian inverse at $x_q$\n",
5324: &count, numeric_str, numeric_str, N_b*N_c*N_q, numeric_str, dim, N_b*N_c*N_q, numeric_str, N_t,
5325: numeric_str, N_t*dim*dim, numeric_str, N_t*N_b*N_c);STRING_ERROR_CHECK("Message to short");
5326: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5327: " /* FEM data */\n"
5328: " __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",
5329: &count, numeric_str, N_t*N_b*N_c);STRING_ERROR_CHECK("Message to short");
5330: if (useAux) {
5331: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5332: " __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",
5333: &count, numeric_str, N_t);STRING_ERROR_CHECK("Message to short");
5334: }
5335: if (useF0) {
5336: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5337: " /* Intermediate calculations */\n"
5338: " __local %s f_0[%d]; //[N_t*N_sqc]; // $f_0(u(x_q), \\nabla u(x_q)) |J(x_q)| w_q$\n",
5339: &count, numeric_str, N_t*N_q);STRING_ERROR_CHECK("Message to short");
5340: }
5341: if (useF1) {
5342: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5343: " __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",
5344: &count, numeric_str, dim, N_t*N_q);STRING_ERROR_CHECK("Message to short");
5345: }
5346: /* TODO: If using elasticity, put in mu/lambda coefficients */
5347: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5348: " /* Output data */\n"
5349: " %s e_i; // Coefficient $e_i$ of the residual\n\n",
5350: &count, numeric_str);STRING_ERROR_CHECK("Message to short");
5351: /* One-time loads */
5352: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5353: " /* These should be generated inline */\n"
5354: " /* Load quadrature weights */\n"
5355: " w = weights[qidx];\n"
5356: " /* Load basis tabulation \\phi_i for this cell */\n"
5357: " if (tidx < N_bt*N_q) {\n"
5358: " phi_i[tidx] = Basis[tidx];\n"
5359: " phiDer_i[tidx] = BasisDerivatives[tidx];\n"
5360: " }\n\n",
5361: &count);STRING_ERROR_CHECK("Message to short");
5362: /* Batch loads */
5363: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5364: " for (int batch = 0; batch < N_cb; ++batch) {\n"
5365: " /* Load geometry */\n"
5366: " detJ[tidx] = jacobianDeterminants[Goffset+batch*N_bc+tidx];\n"
5367: " for (int n = 0; n < dim*dim; ++n) {\n"
5368: " const int offset = n*N_t;\n"
5369: " invJ[offset+tidx] = jacobianInverses[(Goffset+batch*N_bc)*dim*dim+offset+tidx];\n"
5370: " }\n"
5371: " /* Load coefficients u_i for this cell */\n"
5372: " for (int n = 0; n < N_bt; ++n) {\n"
5373: " const int offset = n*N_t;\n"
5374: " u_i[offset+tidx] = coefficients[(Goffset*N_bt)+batch*N_t*N_b+offset+tidx];\n"
5375: " }\n",
5376: &count);STRING_ERROR_CHECK("Message to short");
5377: if (useAux) {
5378: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5379: " /* Load coefficients a_i for this cell */\n"
5380: " /* TODO: This should not be N_t here, it should be N_bc*N_comp_aux */\n"
5381: " a_i[tidx] = coefficientsAux[Goffset+batch*N_t+tidx];\n",
5382: &count);STRING_ERROR_CHECK("Message to short");
5383: }
5384: /* Quadrature phase */
5385: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5386: " barrier(CLK_LOCAL_MEM_FENCE);\n"
5387: "\n"
5388: " /* Map coefficients to values at quadrature points */\n"
5389: " for (int c = 0; c < N_sqc; ++c) {\n"
5390: " const int cell = c*N_bl*N_b + blqidx;\n"
5391: " const int fidx = (cell*N_q + qidx)*N_comp + cidx;\n",
5392: &count);STRING_ERROR_CHECK("Message to short");
5393: if (useField) {
5394: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5395: " %s u[%d]; //[N_comp]; // $u(x_q)$, Value of the field at $x_q$\n",
5396: &count, numeric_str, N_c);STRING_ERROR_CHECK("Message to short");
5397: }
5398: if (useFieldDer) {
5399: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5400: " %s%d gradU[%d]; //[N_comp]; // $\\nabla u(x_q)$, Value of the field gradient at $x_q$\n",
5401: &count, numeric_str, dim, N_c);STRING_ERROR_CHECK("Message to short");
5402: }
5403: if (useFieldAux) {
5404: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5405: " %s a[%d]; //[1]; // $a(x_q)$, Value of the auxiliary fields at $x_q$\n",
5406: &count, numeric_str, 1);STRING_ERROR_CHECK("Message to short");
5407: }
5408: if (useFieldDerAux) {
5409: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5410: " %s%d gradA[%d]; //[1]; // $\\nabla a(x_q)$, Value of the auxiliary field gradient at $x_q$\n",
5411: &count, numeric_str, dim, 1);STRING_ERROR_CHECK("Message to short");
5412: }
5413: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5414: "\n"
5415: " for (int comp = 0; comp < N_comp; ++comp) {\n",
5416: &count);STRING_ERROR_CHECK("Message to short");
5417: if (useField) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, " u[comp] = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");}
5418: if (useFieldDer) {
5419: switch (dim) {
5420: case 1:
5421: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, " gradU[comp].x = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");break;
5422: case 2:
5423: 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;
5424: case 3:
5425: 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;
5426: }
5427: }
5428: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5429: " }\n",
5430: &count);STRING_ERROR_CHECK("Message to short");
5431: if (useFieldAux) {
5432: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, " a[0] = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");
5433: }
5434: if (useFieldDerAux) {
5435: switch (dim) {
5436: case 1:
5437: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, " gradA[0].x = 0.0;\n", &count);STRING_ERROR_CHECK("Message to short");break;
5438: case 2:
5439: 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;
5440: case 3:
5441: 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;
5442: }
5443: }
5444: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5445: " /* Get field and derivatives at this quadrature point */\n"
5446: " for (int i = 0; i < N_b; ++i) {\n"
5447: " for (int comp = 0; comp < N_comp; ++comp) {\n"
5448: " const int b = i*N_comp+comp;\n"
5449: " const int pidx = qidx*N_bt + b;\n"
5450: " const int uidx = cell*N_bt + b;\n"
5451: " %s%d realSpaceDer;\n\n",
5452: &count, numeric_str, dim);STRING_ERROR_CHECK("Message to short");
5453: 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");}
5454: if (useFieldDer) {
5455: switch (dim) {
5456: case 2:
5457: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5458: " 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"
5459: " gradU[comp].x += u_i[uidx]*realSpaceDer.x;\n"
5460: " 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"
5461: " gradU[comp].y += u_i[uidx]*realSpaceDer.y;\n",
5462: &count);STRING_ERROR_CHECK("Message to short");break;
5463: case 3:
5464: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5465: " 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"
5466: " gradU[comp].x += u_i[uidx]*realSpaceDer.x;\n"
5467: " 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"
5468: " gradU[comp].y += u_i[uidx]*realSpaceDer.y;\n"
5469: " 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"
5470: " gradU[comp].z += u_i[uidx]*realSpaceDer.z;\n",
5471: &count);STRING_ERROR_CHECK("Message to short");break;
5472: }
5473: }
5474: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5475: " }\n"
5476: " }\n",
5477: &count);STRING_ERROR_CHECK("Message to short");
5478: if (useFieldAux) {
5479: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail," a[0] += a_i[cell];\n", &count);STRING_ERROR_CHECK("Message to short");
5480: }
5481: /* Calculate residual at quadrature points: Should be generated by an weak form egine */
5482: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5483: " /* Process values at quadrature points */\n",
5484: &count);STRING_ERROR_CHECK("Message to short");
5485: switch (op) {
5486: case LAPLACIAN:
5487: if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, " f_0[fidx] = 4.0;\n", &count);STRING_ERROR_CHECK("Message to short");}
5488: if (useF1) {
5489: if (useAux) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, " f_1[fidx] = a[0]*gradU[cidx];\n", &count);STRING_ERROR_CHECK("Message to short");}
5490: else {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, " f_1[fidx] = gradU[cidx];\n", &count);STRING_ERROR_CHECK("Message to short");}
5491: }
5492: break;
5493: case ELASTICITY:
5494: if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail, " f_0[fidx] = 4.0;\n", &count);STRING_ERROR_CHECK("Message to short");}
5495: if (useF1) {
5496: switch (dim) {
5497: case 2:
5498: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5499: " switch (cidx) {\n"
5500: " case 0:\n"
5501: " f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[0].x + gradU[0].x);\n"
5502: " f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[0].y + gradU[1].x);\n"
5503: " break;\n"
5504: " case 1:\n"
5505: " f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[1].x + gradU[0].y);\n"
5506: " f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y) + mu*(gradU[1].y + gradU[1].y);\n"
5507: " }\n",
5508: &count);STRING_ERROR_CHECK("Message to short");break;
5509: case 3:
5510: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5511: " switch (cidx) {\n"
5512: " case 0:\n"
5513: " f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[0].x + gradU[0].x);\n"
5514: " f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[0].y + gradU[1].x);\n"
5515: " f_1[fidx].z = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[0].z + gradU[2].x);\n"
5516: " break;\n"
5517: " case 1:\n"
5518: " f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[1].x + gradU[0].y);\n"
5519: " f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[1].y + gradU[1].y);\n"
5520: " f_1[fidx].z = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[1].y + gradU[2].y);\n"
5521: " break;\n"
5522: " case 2:\n"
5523: " f_1[fidx].x = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[2].x + gradU[0].z);\n"
5524: " f_1[fidx].y = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[2].y + gradU[1].z);\n"
5525: " f_1[fidx].z = lambda*(gradU[0].x + gradU[1].y + gradU[2].z) + mu*(gradU[2].y + gradU[2].z);\n"
5526: " }\n",
5527: &count);STRING_ERROR_CHECK("Message to short");break;
5528: }}
5529: break;
5530: default:
5531: SETERRQ1(PETSC_COMM_WORLD, PETSC_ERR_SUP, "PDE operator %d is not supported", op);
5532: }
5533: if (useF0) {PetscSNPrintfCount(string_tail, end_of_buffer - string_tail," f_0[fidx] *= detJ[cell]*w;\n", &count);STRING_ERROR_CHECK("Message to short");}
5534: if (useF1) {
5535: switch (dim) {
5536: case 1:
5537: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail," f_1[fidx].x *= detJ[cell]*w;\n", &count);STRING_ERROR_CHECK("Message to short");break;
5538: case 2:
5539: 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;
5540: case 3:
5541: 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;
5542: }
5543: }
5544: /* Thread transpose */
5545: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5546: " }\n\n"
5547: " /* ==== TRANSPOSE THREADS ==== */\n"
5548: " barrier(CLK_LOCAL_MEM_FENCE);\n\n",
5549: &count);STRING_ERROR_CHECK("Message to short");
5550: /* Basis phase */
5551: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5552: " /* Map values at quadrature points to coefficients */\n"
5553: " for (int c = 0; c < N_sbc; ++c) {\n"
5554: " const int cell = c*N_bl*N_q + blbidx; /* Cell number in batch */\n"
5555: "\n"
5556: " e_i = 0.0;\n"
5557: " for (int q = 0; q < N_q; ++q) {\n"
5558: " const int pidx = q*N_bt + bidx;\n"
5559: " const int fidx = (cell*N_q + q)*N_comp + cidx;\n"
5560: " %s%d realSpaceDer;\n\n",
5561: &count, numeric_str, dim);STRING_ERROR_CHECK("Message to short");
5563: 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");}
5564: if (useF1) {
5565: switch (dim) {
5566: case 2:
5567: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5568: " 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"
5569: " e_i += realSpaceDer.x*f_1[fidx].x;\n"
5570: " 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"
5571: " e_i += realSpaceDer.y*f_1[fidx].y;\n",
5572: &count);STRING_ERROR_CHECK("Message to short");break;
5573: case 3:
5574: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5575: " 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"
5576: " e_i += realSpaceDer.x*f_1[fidx].x;\n"
5577: " 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"
5578: " e_i += realSpaceDer.y*f_1[fidx].y;\n"
5579: " 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"
5580: " e_i += realSpaceDer.z*f_1[fidx].z;\n",
5581: &count);STRING_ERROR_CHECK("Message to short");break;
5582: }
5583: }
5584: PetscSNPrintfCount(string_tail, end_of_buffer - string_tail,
5585: " }\n"
5586: " /* Write element vector for N_{cbc} cells at a time */\n"
5587: " elemVec[(Goffset + batch*N_bc + c*N_bl*N_q)*N_bt + tidx] = e_i;\n"
5588: " }\n"
5589: " /* ==== Could do one write per batch ==== */\n"
5590: " }\n"
5591: " return;\n"
5592: "}\n",
5593: &count);STRING_ERROR_CHECK("Message to short");
5594: return(0);
5595: }
5597: PetscErrorCode PetscFEOpenCLGetIntegrationKernel(PetscFE fem, PetscBool useAux, cl_program *ocl_prog, cl_kernel *ocl_kernel)
5598: {
5599: PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5600: PetscInt dim, N_bl;
5601: PetscBool flg;
5602: char *buffer;
5603: size_t len;
5604: char errMsg[8192];
5605: cl_int ierr2;
5606: PetscErrorCode ierr;
5609: PetscFEGetSpatialDimension(fem, &dim);
5610: PetscMalloc1(8192, &buffer);
5611: PetscFEGetTileSizes(fem, NULL, &N_bl, NULL, NULL);
5612: PetscFEOpenCLGenerateIntegrationCode(fem, &buffer, 8192, useAux, N_bl);
5613: PetscOptionsHasName(((PetscObject)fem)->options,((PetscObject)fem)->prefix, "-petscfe_opencl_kernel_print", &flg);
5614: if (flg) {PetscPrintf(PetscObjectComm((PetscObject) fem), "OpenCL FE Integration Kernel:\n%s\n", buffer);}
5615: len = strlen(buffer);
5616: *ocl_prog = clCreateProgramWithSource(ocl->ctx_id, 1, (const char **) &buffer, &len, &ierr2);CHKERRQ(ierr2);
5617: clBuildProgram(*ocl_prog, 0, NULL, NULL, NULL, NULL);
5618: if (ierr != CL_SUCCESS) {
5619: clGetProgramBuildInfo(*ocl_prog, ocl->dev_id, CL_PROGRAM_BUILD_LOG, 8192*sizeof(char), &errMsg, NULL);
5620: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Build failed! Log:\n %s", errMsg);
5621: }
5622: PetscFree(buffer);
5623: *ocl_kernel = clCreateKernel(*ocl_prog, "integrateElementQuadrature", &ierr);
5624: return(0);
5625: }
5627: PetscErrorCode PetscFEOpenCLCalculateGrid(PetscFE fem, PetscInt N, PetscInt blockSize, size_t *x, size_t *y, size_t *z)
5628: {
5629: const PetscInt Nblocks = N/blockSize;
5632: if (N % blockSize) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Invalid block size %d for %d elements", blockSize, N);
5633: *z = 1;
5634: for (*x = (size_t) (PetscSqrtReal(Nblocks) + 0.5); *x > 0; --*x) {
5635: *y = Nblocks / *x;
5636: if (*x * *y == Nblocks) break;
5637: }
5638: if (*x * *y != Nblocks) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Could not find partition for %d with block size %d", N, blockSize);
5639: return(0);
5640: }
5642: PetscErrorCode PetscFEOpenCLLogResidual(PetscFE fem, PetscLogDouble time, PetscLogDouble flops)
5643: {
5644: PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5645: PetscStageLog stageLog;
5646: PetscEventPerfLog eventLog = NULL;
5647: PetscInt stage;
5648: PetscErrorCode ierr;
5651: PetscLogGetStageLog(&stageLog);
5652: PetscStageLogGetCurrent(stageLog, &stage);
5653: PetscStageLogGetEventPerfLog(stageLog, stage, &eventLog);
5654: /* Log performance info */
5655: eventLog->eventInfo[ocl->residualEvent].count++;
5656: eventLog->eventInfo[ocl->residualEvent].time += time;
5657: eventLog->eventInfo[ocl->residualEvent].flops += flops;
5658: return(0);
5659: }
5661: PetscErrorCode PetscFEIntegrateResidual_OpenCL(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
5662: const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
5663: {
5664: /* Nbc = batchSize */
5665: PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5666: PetscPointFunc f0_func;
5667: PetscPointFunc f1_func;
5668: PetscQuadrature q;
5669: PetscInt dim, qNc;
5670: PetscInt N_b; /* The number of basis functions */
5671: PetscInt N_comp; /* The number of basis function components */
5672: PetscInt N_bt; /* The total number of scalar basis functions */
5673: PetscInt N_q; /* The number of quadrature points */
5674: PetscInt N_bst; /* The block size, LCM(N_bt, N_q), Notice that a block is not process simultaneously */
5675: PetscInt N_t; /* The number of threads, N_bst * N_bl */
5676: PetscInt N_bl; /* The number of blocks */
5677: PetscInt N_bc; /* The batch size, N_bl*N_q*N_b */
5678: PetscInt N_cb; /* The number of batches */
5679: PetscInt numFlops, f0Flops = 0, f1Flops = 0;
5680: PetscBool useAux = probAux ? PETSC_TRUE : PETSC_FALSE;
5681: PetscBool useField = PETSC_FALSE;
5682: PetscBool useFieldDer = PETSC_TRUE;
5683: PetscBool useF0 = PETSC_TRUE;
5684: PetscBool useF1 = PETSC_TRUE;
5685: /* OpenCL variables */
5686: cl_program ocl_prog;
5687: cl_kernel ocl_kernel;
5688: cl_event ocl_ev; /* The event for tracking kernel execution */
5689: cl_ulong ns_start; /* Nanoseconds counter on GPU at kernel start */
5690: cl_ulong ns_end; /* Nanoseconds counter on GPU at kernel stop */
5691: cl_mem o_jacobianInverses, o_jacobianDeterminants;
5692: cl_mem o_coefficients, o_coefficientsAux, o_elemVec;
5693: float *f_coeff = NULL, *f_coeffAux = NULL, *f_invJ = NULL, *f_detJ = NULL;
5694: double *d_coeff = NULL, *d_coeffAux = NULL, *d_invJ = NULL, *d_detJ = NULL;
5695: PetscReal *r_invJ = NULL, *r_detJ = NULL;
5696: void *oclCoeff, *oclCoeffAux, *oclInvJ, *oclDetJ;
5697: size_t local_work_size[3], global_work_size[3];
5698: size_t realSize, x, y, z;
5699: const PetscReal *points, *weights;
5700: PetscErrorCode ierr;
5703: if (!Ne) {PetscFEOpenCLLogResidual(fem, 0.0, 0.0); return(0);}
5704: PetscFEGetSpatialDimension(fem, &dim);
5705: PetscFEGetQuadrature(fem, &q);
5706: PetscQuadratureGetData(q, NULL, &qNc, &N_q, &points, &weights);
5707: if (qNc != 1) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_SUP, "Only supports scalar quadrature, not %D components\n", qNc);
5708: PetscFEGetDimension(fem, &N_b);
5709: PetscFEGetNumComponents(fem, &N_comp);
5710: PetscDSGetResidual(prob, field, &f0_func, &f1_func);
5711: PetscFEGetTileSizes(fem, NULL, &N_bl, &N_bc, &N_cb);
5712: N_bt = N_b*N_comp;
5713: N_bst = N_bt*N_q;
5714: N_t = N_bst*N_bl;
5715: 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);
5716: /* Calculate layout */
5717: if (Ne % (N_cb*N_bc)) { /* Remainder cells */
5718: PetscFEIntegrateResidual_Basic(fem, prob, field, Ne, cgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);
5719: return(0);
5720: }
5721: PetscFEOpenCLCalculateGrid(fem, Ne, N_cb*N_bc, &x, &y, &z);
5722: local_work_size[0] = N_bc*N_comp;
5723: local_work_size[1] = 1;
5724: local_work_size[2] = 1;
5725: global_work_size[0] = x * local_work_size[0];
5726: global_work_size[1] = y * local_work_size[1];
5727: global_work_size[2] = z * local_work_size[2];
5728: 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);
5729: PetscInfo2(fem, " N_t: %d, N_cb: %d\n", N_t, N_cb);
5730: /* Generate code */
5731: if (probAux) {
5732: PetscSpace P;
5733: PetscInt NfAux, order, f;
5735: PetscDSGetNumFields(probAux, &NfAux);
5736: for (f = 0; f < NfAux; ++f) {
5737: PetscFE feAux;
5739: PetscDSGetDiscretization(probAux, f, (PetscObject *) &feAux);
5740: PetscFEGetBasisSpace(feAux, &P);
5741: PetscSpaceGetOrder(P, &order);
5742: if (order > 0) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Can only handle P0 coefficient fields");
5743: }
5744: }
5745: PetscFEOpenCLGetIntegrationKernel(fem, useAux, &ocl_prog, &ocl_kernel);
5746: /* Create buffers on the device and send data over */
5747: PetscDataTypeGetSize(ocl->realType, &realSize);
5748: if (sizeof(PetscReal) != realSize) {
5749: switch (ocl->realType) {
5750: case PETSC_FLOAT:
5751: {
5752: PetscInt c, b, d;
5754: PetscMalloc4(Ne*N_bt,&f_coeff,Ne,&f_coeffAux,Ne*dim*dim,&f_invJ,Ne,&f_detJ);
5755: for (c = 0; c < Ne; ++c) {
5756: f_detJ[c] = (float) cgeom[c].detJ;
5757: for (d = 0; d < dim*dim; ++d) {
5758: f_invJ[c*dim*dim+d] = (float) cgeom[c].invJ[d];
5759: }
5760: for (b = 0; b < N_bt; ++b) {
5761: f_coeff[c*N_bt+b] = (float) coefficients[c*N_bt+b];
5762: }
5763: }
5764: if (coefficientsAux) { /* Assume P0 */
5765: for (c = 0; c < Ne; ++c) {
5766: f_coeffAux[c] = (float) coefficientsAux[c];
5767: }
5768: }
5769: oclCoeff = (void *) f_coeff;
5770: if (coefficientsAux) {
5771: oclCoeffAux = (void *) f_coeffAux;
5772: } else {
5773: oclCoeffAux = NULL;
5774: }
5775: oclInvJ = (void *) f_invJ;
5776: oclDetJ = (void *) f_detJ;
5777: }
5778: break;
5779: case PETSC_DOUBLE:
5780: {
5781: PetscInt c, b, d;
5783: PetscMalloc4(Ne*N_bt,&d_coeff,Ne,&d_coeffAux,Ne*dim*dim,&d_invJ,Ne,&d_detJ);
5784: for (c = 0; c < Ne; ++c) {
5785: d_detJ[c] = (double) cgeom[c].detJ;
5786: for (d = 0; d < dim*dim; ++d) {
5787: d_invJ[c*dim*dim+d] = (double) cgeom[c].invJ[d];
5788: }
5789: for (b = 0; b < N_bt; ++b) {
5790: d_coeff[c*N_bt+b] = (double) coefficients[c*N_bt+b];
5791: }
5792: }
5793: if (coefficientsAux) { /* Assume P0 */
5794: for (c = 0; c < Ne; ++c) {
5795: d_coeffAux[c] = (double) coefficientsAux[c];
5796: }
5797: }
5798: oclCoeff = (void *) d_coeff;
5799: if (coefficientsAux) {
5800: oclCoeffAux = (void *) d_coeffAux;
5801: } else {
5802: oclCoeffAux = NULL;
5803: }
5804: oclInvJ = (void *) d_invJ;
5805: oclDetJ = (void *) d_detJ;
5806: }
5807: break;
5808: default:
5809: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported PETSc type %d", ocl->realType);
5810: }
5811: } else {
5812: PetscInt c, d;
5814: PetscMalloc2(Ne*dim*dim,&r_invJ,Ne,&r_detJ);
5815: for (c = 0; c < Ne; ++c) {
5816: r_detJ[c] = cgeom[c].detJ;
5817: for (d = 0; d < dim*dim; ++d) {
5818: r_invJ[c*dim*dim+d] = cgeom[c].invJ[d];
5819: }
5820: }
5821: oclCoeff = (void *) coefficients;
5822: oclCoeffAux = (void *) coefficientsAux;
5823: oclInvJ = (void *) r_invJ;
5824: oclDetJ = (void *) r_detJ;
5825: }
5826: o_coefficients = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne*N_bt * realSize, oclCoeff, &ierr);
5827: if (coefficientsAux) {
5828: o_coefficientsAux = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne * realSize, oclCoeffAux, &ierr);
5829: } else {
5830: o_coefficientsAux = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY, Ne * realSize, oclCoeffAux, &ierr);
5831: }
5832: o_jacobianInverses = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne*dim*dim * realSize, oclInvJ, &ierr);
5833: o_jacobianDeterminants = clCreateBuffer(ocl->ctx_id, CL_MEM_READ_ONLY | CL_MEM_COPY_HOST_PTR, Ne * realSize, oclDetJ, &ierr);
5834: o_elemVec = clCreateBuffer(ocl->ctx_id, CL_MEM_WRITE_ONLY, Ne*N_bt * realSize, NULL, &ierr);
5835: /* Kernel launch */
5836: clSetKernelArg(ocl_kernel, 0, sizeof(cl_int), (void*) &N_cb);
5837: clSetKernelArg(ocl_kernel, 1, sizeof(cl_mem), (void*) &o_coefficients);
5838: clSetKernelArg(ocl_kernel, 2, sizeof(cl_mem), (void*) &o_coefficientsAux);
5839: clSetKernelArg(ocl_kernel, 3, sizeof(cl_mem), (void*) &o_jacobianInverses);
5840: clSetKernelArg(ocl_kernel, 4, sizeof(cl_mem), (void*) &o_jacobianDeterminants);
5841: clSetKernelArg(ocl_kernel, 5, sizeof(cl_mem), (void*) &o_elemVec);
5842: clEnqueueNDRangeKernel(ocl->queue_id, ocl_kernel, 3, NULL, global_work_size, local_work_size, 0, NULL, &ocl_ev);
5843: /* Read data back from device */
5844: if (sizeof(PetscReal) != realSize) {
5845: switch (ocl->realType) {
5846: case PETSC_FLOAT:
5847: {
5848: float *elem;
5849: PetscInt c, b;
5851: PetscFree4(f_coeff,f_coeffAux,f_invJ,f_detJ);
5852: PetscMalloc1(Ne*N_bt, &elem);
5853: clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elem, 0, NULL, NULL);
5854: for (c = 0; c < Ne; ++c) {
5855: for (b = 0; b < N_bt; ++b) {
5856: elemVec[c*N_bt+b] = (PetscScalar) elem[c*N_bt+b];
5857: }
5858: }
5859: PetscFree(elem);
5860: }
5861: break;
5862: case PETSC_DOUBLE:
5863: {
5864: double *elem;
5865: PetscInt c, b;
5867: PetscFree4(d_coeff,d_coeffAux,d_invJ,d_detJ);
5868: PetscMalloc1(Ne*N_bt, &elem);
5869: clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elem, 0, NULL, NULL);
5870: for (c = 0; c < Ne; ++c) {
5871: for (b = 0; b < N_bt; ++b) {
5872: elemVec[c*N_bt+b] = (PetscScalar) elem[c*N_bt+b];
5873: }
5874: }
5875: PetscFree(elem);
5876: }
5877: break;
5878: default:
5879: SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Unsupported PETSc type %d", ocl->realType);
5880: }
5881: } else {
5882: PetscFree2(r_invJ,r_detJ);
5883: clEnqueueReadBuffer(ocl->queue_id, o_elemVec, CL_TRUE, 0, Ne*N_bt * realSize, elemVec, 0, NULL, NULL);
5884: }
5885: /* Log performance */
5886: clGetEventProfilingInfo(ocl_ev, CL_PROFILING_COMMAND_START, sizeof(cl_ulong), &ns_start, NULL);
5887: clGetEventProfilingInfo(ocl_ev, CL_PROFILING_COMMAND_END, sizeof(cl_ulong), &ns_end, NULL);
5888: f0Flops = 0;
5889: switch (ocl->op) {
5890: case LAPLACIAN:
5891: f1Flops = useAux ? dim : 0;break;
5892: case ELASTICITY:
5893: f1Flops = 2*dim*dim;break;
5894: }
5895: numFlops = Ne*(
5896: N_q*(
5897: N_b*N_comp*((useField ? 2 : 0) + (useFieldDer ? 2*dim*(dim + 1) : 0))
5898: /*+
5899: N_ba*N_compa*((useFieldAux ? 2 : 0) + (useFieldDerAux ? 2*dim*(dim + 1) : 0))*/
5900: +
5901: N_comp*((useF0 ? f0Flops + 2 : 0) + (useF1 ? f1Flops + 2*dim : 0)))
5902: +
5903: N_b*((useF0 ? 2 : 0) + (useF1 ? 2*dim*(dim + 1) : 0)));
5904: PetscFEOpenCLLogResidual(fem, (ns_end - ns_start)*1.0e-9, numFlops);
5905: /* Cleanup */
5906: clReleaseMemObject(o_coefficients);
5907: clReleaseMemObject(o_coefficientsAux);
5908: clReleaseMemObject(o_jacobianInverses);
5909: clReleaseMemObject(o_jacobianDeterminants);
5910: clReleaseMemObject(o_elemVec);
5911: clReleaseKernel(ocl_kernel);
5912: clReleaseProgram(ocl_prog);
5913: return(0);
5914: }
5916: PetscErrorCode PetscFEInitialize_OpenCL(PetscFE fem)
5917: {
5919: fem->ops->setfromoptions = NULL;
5920: fem->ops->setup = PetscFESetUp_Basic;
5921: fem->ops->view = NULL;
5922: fem->ops->destroy = PetscFEDestroy_OpenCL;
5923: fem->ops->getdimension = PetscFEGetDimension_Basic;
5924: fem->ops->gettabulation = PetscFEGetTabulation_Basic;
5925: fem->ops->integrateresidual = PetscFEIntegrateResidual_OpenCL;
5926: fem->ops->integratebdresidual = NULL/* PetscFEIntegrateBdResidual_OpenCL */;
5927: fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_OpenCL */;
5928: fem->ops->integratejacobian = PetscFEIntegrateJacobian_Basic;
5929: return(0);
5930: }
5932: /*MC
5933: PETSCFEOPENCL = "opencl" - A PetscFE object that integrates using a vectorized OpenCL implementation
5935: Level: intermediate
5937: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
5938: M*/
5940: PETSC_EXTERN PetscErrorCode PetscFECreate_OpenCL(PetscFE fem)
5941: {
5942: PetscFE_OpenCL *ocl;
5943: cl_uint num_platforms;
5944: cl_platform_id platform_ids[42];
5945: cl_uint num_devices;
5946: cl_device_id device_ids[42];
5947: cl_int ierr2;
5948: PetscErrorCode ierr;
5952: PetscNewLog(fem,&ocl);
5953: fem->data = ocl;
5955: /* Init Platform */
5956: clGetPlatformIDs(42, platform_ids, &num_platforms);
5957: if (!num_platforms) SETERRQ(PetscObjectComm((PetscObject) fem), PETSC_ERR_SUP, "No OpenCL platform found.");
5958: ocl->pf_id = platform_ids[0];
5959: /* Init Device */
5960: clGetDeviceIDs(ocl->pf_id, CL_DEVICE_TYPE_ALL, 42, device_ids, &num_devices);
5961: if (!num_devices) SETERRQ(PetscObjectComm((PetscObject) fem), PETSC_ERR_SUP, "No OpenCL device found.");
5962: ocl->dev_id = device_ids[0];
5963: /* Create context with one command queue */
5964: ocl->ctx_id = clCreateContext(0, 1, &(ocl->dev_id), NULL, NULL, &ierr2);CHKERRQ(ierr2);
5965: ocl->queue_id = clCreateCommandQueue(ocl->ctx_id, ocl->dev_id, CL_QUEUE_PROFILING_ENABLE, &ierr2);CHKERRQ(ierr2);
5966: /* Types */
5967: ocl->realType = PETSC_FLOAT;
5968: /* Register events */
5969: PetscLogEventRegister("OpenCL FEResidual", PETSCFE_CLASSID, &ocl->residualEvent);
5970: /* Equation handling */
5971: ocl->op = LAPLACIAN;
5973: PetscFEInitialize_OpenCL(fem);
5974: return(0);
5975: }
5977: PetscErrorCode PetscFEOpenCLSetRealType(PetscFE fem, PetscDataType realType)
5978: {
5979: PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5983: ocl->realType = realType;
5984: return(0);
5985: }
5987: PetscErrorCode PetscFEOpenCLGetRealType(PetscFE fem, PetscDataType *realType)
5988: {
5989: PetscFE_OpenCL *ocl = (PetscFE_OpenCL *) fem->data;
5994: *realType = ocl->realType;
5995: return(0);
5996: }
5998: #endif /* PETSC_HAVE_OPENCL */
6000: PetscErrorCode PetscFEDestroy_Composite(PetscFE fem)
6001: {
6002: PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
6003: PetscErrorCode ierr;
6006: CellRefinerRestoreAffineTransforms_Internal(cmp->cellRefiner, &cmp->numSubelements, &cmp->v0, &cmp->jac, &cmp->invjac);
6007: PetscFree(cmp->embedding);
6008: PetscFree(cmp);
6009: return(0);
6010: }
6012: PetscErrorCode PetscFESetUp_Composite(PetscFE fem)
6013: {
6014: PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
6015: DM K;
6016: PetscReal *subpoint;
6017: PetscBLASInt *pivots;
6018: PetscBLASInt n, info;
6019: PetscScalar *work, *invVscalar;
6020: PetscInt dim, pdim, spdim, j, s;
6021: PetscErrorCode ierr;
6024: /* Get affine mapping from reference cell to each subcell */
6025: PetscDualSpaceGetDM(fem->dualSpace, &K);
6026: DMGetDimension(K, &dim);
6027: DMPlexGetCellRefiner_Internal(K, &cmp->cellRefiner);
6028: CellRefinerGetAffineTransforms_Internal(cmp->cellRefiner, &cmp->numSubelements, &cmp->v0, &cmp->jac, &cmp->invjac);
6029: /* Determine dof embedding into subelements */
6030: PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
6031: PetscSpaceGetDimension(fem->basisSpace, &spdim);
6032: PetscMalloc1(cmp->numSubelements*spdim,&cmp->embedding);
6033: DMGetWorkArray(K, dim, PETSC_REAL, &subpoint);
6034: for (s = 0; s < cmp->numSubelements; ++s) {
6035: PetscInt sd = 0;
6037: for (j = 0; j < pdim; ++j) {
6038: PetscBool inside;
6039: PetscQuadrature f;
6040: PetscInt d, e;
6042: PetscDualSpaceGetFunctional(fem->dualSpace, j, &f);
6043: /* Apply transform to first point, and check that point is inside subcell */
6044: for (d = 0; d < dim; ++d) {
6045: subpoint[d] = -1.0;
6046: for (e = 0; e < dim; ++e) subpoint[d] += cmp->invjac[(s*dim + d)*dim+e]*(f->points[e] - cmp->v0[s*dim+e]);
6047: }
6048: CellRefinerInCellTest_Internal(cmp->cellRefiner, subpoint, &inside);
6049: if (inside) {cmp->embedding[s*spdim+sd++] = j;}
6050: }
6051: if (sd != spdim) SETERRQ3(PetscObjectComm((PetscObject) fem), PETSC_ERR_PLIB, "Subelement %d has %d dual basis vectors != %d", s, sd, spdim);
6052: }
6053: DMRestoreWorkArray(K, dim, PETSC_REAL, &subpoint);
6054: /* Construct the change of basis from prime basis to nodal basis for each subelement */
6055: PetscMalloc1(cmp->numSubelements*spdim*spdim,&fem->invV);
6056: PetscMalloc2(spdim,&pivots,spdim,&work);
6057: #if defined(PETSC_USE_COMPLEX)
6058: PetscMalloc1(cmp->numSubelements*spdim*spdim,&invVscalar);
6059: #else
6060: invVscalar = fem->invV;
6061: #endif
6062: for (s = 0; s < cmp->numSubelements; ++s) {
6063: for (j = 0; j < spdim; ++j) {
6064: PetscReal *Bf;
6065: PetscQuadrature f;
6066: const PetscReal *points, *weights;
6067: PetscInt Nc, Nq, q, k;
6069: PetscDualSpaceGetFunctional(fem->dualSpace, cmp->embedding[s*spdim+j], &f);
6070: PetscQuadratureGetData(f, NULL, &Nc, &Nq, &points, &weights);
6071: PetscMalloc1(f->numPoints*spdim*Nc,&Bf);
6072: PetscSpaceEvaluate(fem->basisSpace, Nq, points, Bf, NULL, NULL);
6073: for (k = 0; k < spdim; ++k) {
6074: /* n_j \cdot \phi_k */
6075: invVscalar[(s*spdim + j)*spdim+k] = 0.0;
6076: for (q = 0; q < Nq; ++q) {
6077: invVscalar[(s*spdim + j)*spdim+k] += Bf[q*spdim+k]*weights[q];
6078: }
6079: }
6080: PetscFree(Bf);
6081: }
6082: n = spdim;
6083: PetscStackCallBLAS("LAPACKgetrf", LAPACKgetrf_(&n, &n, &invVscalar[s*spdim*spdim], &n, pivots, &info));
6084: PetscStackCallBLAS("LAPACKgetri", LAPACKgetri_(&n, &invVscalar[s*spdim*spdim], &n, pivots, work, &n, &info));
6085: }
6086: #if defined(PETSC_USE_COMPLEX)
6087: for (s = 0; s <cmp->numSubelements*spdim*spdim; s++) fem->invV[s] = PetscRealPart(invVscalar[s]);
6088: PetscFree(invVscalar);
6089: #endif
6090: PetscFree2(pivots,work);
6091: return(0);
6092: }
6094: PetscErrorCode PetscFEGetTabulation_Composite(PetscFE fem, PetscInt npoints, const PetscReal points[], PetscReal *B, PetscReal *D, PetscReal *H)
6095: {
6096: PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
6097: DM dm;
6098: PetscInt pdim; /* Dimension of FE space P */
6099: PetscInt spdim; /* Dimension of subelement FE space P */
6100: PetscInt dim; /* Spatial dimension */
6101: PetscInt comp; /* Field components */
6102: PetscInt *subpoints;
6103: PetscReal *tmpB, *tmpD, *tmpH, *subpoint;
6104: PetscInt p, s, d, e, j, k;
6105: PetscErrorCode ierr;
6108: PetscDualSpaceGetDM(fem->dualSpace, &dm);
6109: DMGetDimension(dm, &dim);
6110: PetscSpaceGetDimension(fem->basisSpace, &spdim);
6111: PetscDualSpaceGetDimension(fem->dualSpace, &pdim);
6112: PetscFEGetNumComponents(fem, &comp);
6113: /* Divide points into subelements */
6114: DMGetWorkArray(dm, npoints, PETSC_INT, &subpoints);
6115: DMGetWorkArray(dm, dim, PETSC_REAL, &subpoint);
6116: for (p = 0; p < npoints; ++p) {
6117: for (s = 0; s < cmp->numSubelements; ++s) {
6118: PetscBool inside;
6120: /* Apply transform, and check that point is inside cell */
6121: for (d = 0; d < dim; ++d) {
6122: subpoint[d] = -1.0;
6123: for (e = 0; e < dim; ++e) subpoint[d] += cmp->invjac[(s*dim + d)*dim+e]*(points[p*dim+e] - cmp->v0[s*dim+e]);
6124: }
6125: CellRefinerInCellTest_Internal(cmp->cellRefiner, subpoint, &inside);
6126: if (inside) {subpoints[p] = s; break;}
6127: }
6128: if (s >= cmp->numSubelements) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Point %d was not found in any subelement", p);
6129: }
6130: DMRestoreWorkArray(dm, dim, PETSC_REAL, &subpoint);
6131: /* Evaluate the prime basis functions at all points */
6132: if (B) {DMGetWorkArray(dm, npoints*spdim, PETSC_REAL, &tmpB);}
6133: if (D) {DMGetWorkArray(dm, npoints*spdim*dim, PETSC_REAL, &tmpD);}
6134: if (H) {DMGetWorkArray(dm, npoints*spdim*dim*dim, PETSC_REAL, &tmpH);}
6135: PetscSpaceEvaluate(fem->basisSpace, npoints, points, B ? tmpB : NULL, D ? tmpD : NULL, H ? tmpH : NULL);
6136: /* Translate to the nodal basis */
6137: if (B) {PetscMemzero(B, npoints*pdim*comp * sizeof(PetscReal));}
6138: if (D) {PetscMemzero(D, npoints*pdim*comp*dim * sizeof(PetscReal));}
6139: if (H) {PetscMemzero(H, npoints*pdim*comp*dim*dim * sizeof(PetscReal));}
6140: for (p = 0; p < npoints; ++p) {
6141: const PetscInt s = subpoints[p];
6143: if (B) {
6144: /* Multiply by V^{-1} (spdim x spdim) */
6145: for (j = 0; j < spdim; ++j) {
6146: const PetscInt i = (p*pdim + cmp->embedding[s*spdim+j])*comp;
6148: B[i] = 0.0;
6149: for (k = 0; k < spdim; ++k) {
6150: B[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpB[p*spdim + k];
6151: }
6152: }
6153: }
6154: if (D) {
6155: /* Multiply by V^{-1} (spdim x spdim) */
6156: for (j = 0; j < spdim; ++j) {
6157: for (d = 0; d < dim; ++d) {
6158: const PetscInt i = ((p*pdim + cmp->embedding[s*spdim+j])*comp + 0)*dim + d;
6160: D[i] = 0.0;
6161: for (k = 0; k < spdim; ++k) {
6162: D[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpD[(p*spdim + k)*dim + d];
6163: }
6164: }
6165: }
6166: }
6167: if (H) {
6168: /* Multiply by V^{-1} (pdim x pdim) */
6169: for (j = 0; j < spdim; ++j) {
6170: for (d = 0; d < dim*dim; ++d) {
6171: const PetscInt i = ((p*pdim + cmp->embedding[s*spdim+j])*comp + 0)*dim*dim + d;
6173: H[i] = 0.0;
6174: for (k = 0; k < spdim; ++k) {
6175: H[i] += fem->invV[(s*spdim + k)*spdim+j] * tmpH[(p*spdim + k)*dim*dim + d];
6176: }
6177: }
6178: }
6179: }
6180: }
6181: DMRestoreWorkArray(dm, npoints, PETSC_INT, &subpoints);
6182: if (B) {DMRestoreWorkArray(dm, npoints*spdim, PETSC_REAL, &tmpB);}
6183: if (D) {DMRestoreWorkArray(dm, npoints*spdim*dim, PETSC_REAL, &tmpD);}
6184: if (H) {DMRestoreWorkArray(dm, npoints*spdim*dim*dim, PETSC_REAL, &tmpH);}
6185: return(0);
6186: }
6188: PetscErrorCode PetscFEInitialize_Composite(PetscFE fem)
6189: {
6191: fem->ops->setfromoptions = NULL;
6192: fem->ops->setup = PetscFESetUp_Composite;
6193: fem->ops->view = NULL;
6194: fem->ops->destroy = PetscFEDestroy_Composite;
6195: fem->ops->getdimension = PetscFEGetDimension_Basic;
6196: fem->ops->gettabulation = PetscFEGetTabulation_Composite;
6197: fem->ops->integrateresidual = PetscFEIntegrateResidual_Basic;
6198: fem->ops->integratebdresidual = PetscFEIntegrateBdResidual_Basic;
6199: fem->ops->integratejacobianaction = NULL/* PetscFEIntegrateJacobianAction_Basic */;
6200: fem->ops->integratejacobian = PetscFEIntegrateJacobian_Basic;
6201: return(0);
6202: }
6204: /*MC
6205: PETSCFECOMPOSITE = "composite" - A PetscFE object that represents a composite element
6207: Level: intermediate
6209: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
6210: M*/
6212: PETSC_EXTERN PetscErrorCode PetscFECreate_Composite(PetscFE fem)
6213: {
6214: PetscFE_Composite *cmp;
6215: PetscErrorCode ierr;
6219: PetscNewLog(fem, &cmp);
6220: fem->data = cmp;
6222: cmp->cellRefiner = REFINER_NOOP;
6223: cmp->numSubelements = -1;
6224: cmp->v0 = NULL;
6225: cmp->jac = NULL;
6227: PetscFEInitialize_Composite(fem);
6228: return(0);
6229: }
6231: /*@C
6232: PetscFECompositeGetMapping - Returns the mappings from the reference element to each subelement
6234: Not collective
6236: Input Parameter:
6237: . fem - The PetscFE object
6239: Output Parameters:
6240: + blockSize - The number of elements in a block
6241: . numBlocks - The number of blocks in a batch
6242: . batchSize - The number of elements in a batch
6243: - numBatches - The number of batches in a chunk
6245: Level: intermediate
6247: .seealso: PetscFECreate()
6248: @*/
6249: PetscErrorCode PetscFECompositeGetMapping(PetscFE fem, PetscInt *numSubelements, const PetscReal *v0[], const PetscReal *jac[], const PetscReal *invjac[])
6250: {
6251: PetscFE_Composite *cmp = (PetscFE_Composite *) fem->data;
6259: return(0);
6260: }
6262: /*@
6263: PetscFEGetDimension - Get the dimension of the finite element space on a cell
6265: Not collective
6267: Input Parameter:
6268: . fe - The PetscFE
6270: Output Parameter:
6271: . dim - The dimension
6273: Level: intermediate
6275: .seealso: PetscFECreate(), PetscSpaceGetDimension(), PetscDualSpaceGetDimension()
6276: @*/
6277: PetscErrorCode PetscFEGetDimension(PetscFE fem, PetscInt *dim)
6278: {
6284: if (fem->ops->getdimension) {(*fem->ops->getdimension)(fem, dim);}
6285: return(0);
6286: }
6288: /*
6289: Purpose: Compute element vector for chunk of elements
6291: Input:
6292: Sizes:
6293: Ne: number of elements
6294: Nf: number of fields
6295: PetscFE
6296: dim: spatial dimension
6297: Nb: number of basis functions
6298: Nc: number of field components
6299: PetscQuadrature
6300: Nq: number of quadrature points
6302: Geometry:
6303: PetscFECellGeom[Ne] possibly *Nq
6304: PetscReal v0s[dim]
6305: PetscReal n[dim]
6306: PetscReal jacobians[dim*dim]
6307: PetscReal jacobianInverses[dim*dim]
6308: PetscReal jacobianDeterminants
6309: FEM:
6310: PetscFE
6311: PetscQuadrature
6312: PetscReal quadPoints[Nq*dim]
6313: PetscReal quadWeights[Nq]
6314: PetscReal basis[Nq*Nb*Nc]
6315: PetscReal basisDer[Nq*Nb*Nc*dim]
6316: PetscScalar coefficients[Ne*Nb*Nc]
6317: PetscScalar elemVec[Ne*Nb*Nc]
6319: Problem:
6320: PetscInt f: the active field
6321: f0, f1
6323: Work Space:
6324: PetscFE
6325: PetscScalar f0[Nq*dim];
6326: PetscScalar f1[Nq*dim*dim];
6327: PetscScalar u[Nc];
6328: PetscScalar gradU[Nc*dim];
6329: PetscReal x[dim];
6330: PetscScalar realSpaceDer[dim];
6332: Purpose: Compute element vector for N_cb batches of elements
6334: Input:
6335: Sizes:
6336: N_cb: Number of serial cell batches
6338: Geometry:
6339: PetscReal v0s[Ne*dim]
6340: PetscReal jacobians[Ne*dim*dim] possibly *Nq
6341: PetscReal jacobianInverses[Ne*dim*dim] possibly *Nq
6342: PetscReal jacobianDeterminants[Ne] possibly *Nq
6343: FEM:
6344: static PetscReal quadPoints[Nq*dim]
6345: static PetscReal quadWeights[Nq]
6346: static PetscReal basis[Nq*Nb*Nc]
6347: static PetscReal basisDer[Nq*Nb*Nc*dim]
6348: PetscScalar coefficients[Ne*Nb*Nc]
6349: PetscScalar elemVec[Ne*Nb*Nc]
6351: ex62.c:
6352: PetscErrorCode PetscFEIntegrateResidualBatch(PetscInt Ne, PetscInt numFields, PetscInt field, PetscQuadrature quad[], const PetscScalar coefficients[],
6353: const PetscReal v0s[], const PetscReal jacobians[], const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[],
6354: void (*f0_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f0[]),
6355: void (*f1_func)(const PetscScalar u[], const PetscScalar gradU[], const PetscReal x[], PetscScalar f1[]), PetscScalar elemVec[])
6357: ex52.c:
6358: 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)
6359: 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)
6361: ex52_integrateElement.cu
6362: __global__ void integrateElementQuadrature(int N_cb, realType *coefficients, realType *jacobianInverses, realType *jacobianDeterminants, realType *elemVec)
6364: PETSC_EXTERN PetscErrorCode IntegrateElementBatchGPU(PetscInt spatial_dim, PetscInt Ne, PetscInt Ncb, PetscInt Nbc, PetscInt Nbl, const PetscScalar coefficients[],
6365: const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscScalar elemVec[],
6366: PetscLogEvent event, PetscInt debug, PetscInt pde_op)
6368: ex52_integrateElementOpenCL.c:
6369: PETSC_EXTERN PetscErrorCode IntegrateElementBatchGPU(PetscInt spatial_dim, PetscInt Ne, PetscInt Ncb, PetscInt Nbc, PetscInt N_bl, const PetscScalar coefficients[],
6370: const PetscReal jacobianInverses[], const PetscReal jacobianDeterminants[], PetscScalar elemVec[],
6371: PetscLogEvent event, PetscInt debug, PetscInt pde_op)
6373: __kernel void integrateElementQuadrature(int N_cb, __global float *coefficients, __global float *jacobianInverses, __global float *jacobianDeterminants, __global float *elemVec)
6374: */
6376: /*@C
6377: PetscFEIntegrate - Produce the integral for the given field for a chunk of elements by quadrature integration
6379: Not collective
6381: Input Parameters:
6382: + fem - The PetscFE object for the field being integrated
6383: . prob - The PetscDS specifying the discretizations and continuum functions
6384: . field - The field being integrated
6385: . Ne - The number of elements in the chunk
6386: . cgeom - The cell geometry for each cell in the chunk
6387: . coefficients - The array of FEM basis coefficients for the elements
6388: . probAux - The PetscDS specifying the auxiliary discretizations
6389: - coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6391: Output Parameter
6392: . integral - the integral for this field
6394: Level: developer
6396: .seealso: PetscFEIntegrateResidual()
6397: @*/
6398: PetscErrorCode PetscFEIntegrate(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
6399: const PetscScalar coefficients[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal integral[])
6400: {
6406: if (fem->ops->integrate) {(*fem->ops->integrate)(fem, prob, field, Ne, cgeom, coefficients, probAux, coefficientsAux, integral);}
6407: return(0);
6408: }
6410: /*@C
6411: PetscFEIntegrateResidual - Produce the element residual vector for a chunk of elements by quadrature integration
6413: Not collective
6415: Input Parameters:
6416: + fem - The PetscFE object for the field being integrated
6417: . prob - The PetscDS specifying the discretizations and continuum functions
6418: . field - The field being integrated
6419: . Ne - The number of elements in the chunk
6420: . cgeom - The cell geometry for each cell in the chunk
6421: . coefficients - The array of FEM basis coefficients for the elements
6422: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
6423: . probAux - The PetscDS specifying the auxiliary discretizations
6424: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6425: - t - The time
6427: Output Parameter
6428: . elemVec - the element residual vectors from each element
6430: Note:
6431: $ Loop over batch of elements (e):
6432: $ Loop over quadrature points (q):
6433: $ Make u_q and gradU_q (loops over fields,Nb,Ncomp) and x_q
6434: $ Call f_0 and f_1
6435: $ Loop over element vector entries (f,fc --> i):
6436: $ elemVec[i] += \psi^{fc}_f(q) f0_{fc}(u, \nabla u) + \nabla\psi^{fc}_f(q) \cdot f1_{fc,df}(u, \nabla u)
6438: Level: developer
6440: .seealso: PetscFEIntegrateResidual()
6441: @*/
6442: PetscErrorCode PetscFEIntegrateResidual(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFECellGeom *cgeom,
6443: const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
6444: {
6450: if (fem->ops->integrateresidual) {(*fem->ops->integrateresidual)(fem, prob, field, Ne, cgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);}
6451: return(0);
6452: }
6454: /*@C
6455: PetscFEIntegrateBdResidual - Produce the element residual vector for a chunk of elements by quadrature integration over a boundary
6457: Not collective
6459: Input Parameters:
6460: + fem - The PetscFE object for the field being integrated
6461: . prob - The PetscDS specifying the discretizations and continuum functions
6462: . field - The field being integrated
6463: . Ne - The number of elements in the chunk
6464: . fgeom - The face geometry for each cell in the chunk
6465: . coefficients - The array of FEM basis coefficients for the elements
6466: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
6467: . probAux - The PetscDS specifying the auxiliary discretizations
6468: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6469: - t - The time
6471: Output Parameter
6472: . elemVec - the element residual vectors from each element
6474: Level: developer
6476: .seealso: PetscFEIntegrateResidual()
6477: @*/
6478: PetscErrorCode PetscFEIntegrateBdResidual(PetscFE fem, PetscDS prob, PetscInt field, PetscInt Ne, PetscFEFaceGeom *fgeom,
6479: const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscScalar elemVec[])
6480: {
6485: if (fem->ops->integratebdresidual) {(*fem->ops->integratebdresidual)(fem, prob, field, Ne, fgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, elemVec);}
6486: return(0);
6487: }
6489: /*@C
6490: PetscFEIntegrateJacobian - Produce the element Jacobian for a chunk of elements by quadrature integration
6492: Not collective
6494: Input Parameters:
6495: + fem - The PetscFE object for the field being integrated
6496: . prob - The PetscDS specifying the discretizations and continuum functions
6497: . jtype - The type of matrix pointwise functions that should be used
6498: . fieldI - The test field being integrated
6499: . fieldJ - The basis field being integrated
6500: . Ne - The number of elements in the chunk
6501: . cgeom - The cell geometry for each cell in the chunk
6502: . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
6503: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
6504: . probAux - The PetscDS specifying the auxiliary discretizations
6505: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6506: . t - The time
6507: - u_tShift - A multiplier for the dF/du_t term (as opposed to the dF/du term)
6509: Output Parameter
6510: . elemMat - the element matrices for the Jacobian from each element
6512: Note:
6513: $ Loop over batch of elements (e):
6514: $ Loop over element matrix entries (f,fc,g,gc --> i,j):
6515: $ Loop over quadrature points (q):
6516: $ Make u_q and gradU_q (loops over fields,Nb,Ncomp)
6517: $ elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
6518: $ + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6519: $ + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
6520: $ + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6521: Level: developer
6523: .seealso: PetscFEIntegrateResidual()
6524: @*/
6525: PetscErrorCode PetscFEIntegrateJacobian(PetscFE fem, PetscDS prob, PetscFEJacobianType jtype, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFECellGeom *cgeom,
6526: const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
6527: {
6532: if (fem->ops->integratejacobian) {(*fem->ops->integratejacobian)(fem, prob, jtype, fieldI, fieldJ, Ne, cgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, u_tshift, elemMat);}
6533: return(0);
6534: }
6536: /*@C
6537: PetscFEIntegrateBdJacobian - Produce the boundary element Jacobian for a chunk of elements by quadrature integration
6539: Not collective
6541: Input Parameters:
6542: + fem = The PetscFE object for the field being integrated
6543: . prob - The PetscDS specifying the discretizations and continuum functions
6544: . fieldI - The test field being integrated
6545: . fieldJ - The basis field being integrated
6546: . Ne - The number of elements in the chunk
6547: . fgeom - The face geometry for each cell in the chunk
6548: . coefficients - The array of FEM basis coefficients for the elements for the Jacobian evaluation point
6549: . coefficients_t - The array of FEM basis time derivative coefficients for the elements
6550: . probAux - The PetscDS specifying the auxiliary discretizations
6551: . coefficientsAux - The array of FEM auxiliary basis coefficients for the elements
6552: . t - The time
6553: - u_tShift - A multiplier for the dF/du_t term (as opposed to the dF/du term)
6555: Output Parameter
6556: . elemMat - the element matrices for the Jacobian from each element
6558: Note:
6559: $ Loop over batch of elements (e):
6560: $ Loop over element matrix entries (f,fc,g,gc --> i,j):
6561: $ Loop over quadrature points (q):
6562: $ Make u_q and gradU_q (loops over fields,Nb,Ncomp)
6563: $ elemMat[i,j] += \psi^{fc}_f(q) g0_{fc,gc}(u, \nabla u) \phi^{gc}_g(q)
6564: $ + \psi^{fc}_f(q) \cdot g1_{fc,gc,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6565: $ + \nabla\psi^{fc}_f(q) \cdot g2_{fc,gc,df}(u, \nabla u) \phi^{gc}_g(q)
6566: $ + \nabla\psi^{fc}_f(q) \cdot g3_{fc,gc,df,dg}(u, \nabla u) \nabla\phi^{gc}_g(q)
6567: Level: developer
6569: .seealso: PetscFEIntegrateJacobian(), PetscFEIntegrateResidual()
6570: @*/
6571: PetscErrorCode PetscFEIntegrateBdJacobian(PetscFE fem, PetscDS prob, PetscInt fieldI, PetscInt fieldJ, PetscInt Ne, PetscFEFaceGeom *fgeom,
6572: const PetscScalar coefficients[], const PetscScalar coefficients_t[], PetscDS probAux, const PetscScalar coefficientsAux[], PetscReal t, PetscReal u_tshift, PetscScalar elemMat[])
6573: {
6578: if (fem->ops->integratebdjacobian) {(*fem->ops->integratebdjacobian)(fem, prob, fieldI, fieldJ, Ne, fgeom, coefficients, coefficients_t, probAux, coefficientsAux, t, u_tshift, elemMat);}
6579: return(0);
6580: }
6582: PetscErrorCode PetscFEGetHeightSubspace(PetscFE fe, PetscInt height, PetscFE *subfe)
6583: {
6584: PetscSpace P, subP;
6585: PetscDualSpace Q, subQ;
6586: PetscQuadrature subq;
6587: PetscFEType fetype;
6588: PetscInt dim, Nc;
6589: PetscErrorCode ierr;
6594: if (height == 0) {
6595: *subfe = fe;
6596: return(0);
6597: }
6598: PetscFEGetBasisSpace(fe, &P);
6599: PetscFEGetDualSpace(fe, &Q);
6600: PetscFEGetNumComponents(fe, &Nc);
6601: PetscFEGetFaceQuadrature(fe, &subq);
6602: PetscDualSpaceGetDimension(Q, &dim);
6603: if (height > dim || height < 0) {SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Asked for space at height %D for dimension %D space", height, dim);}
6604: if (height != 1) SETERRQ1(PetscObjectComm((PetscObject) fe), PETSC_ERR_SUP, "Height %D not currently supported", height);
6605: if (!fe->subspaces) {PetscCalloc1(dim, &fe->subspaces);}
6606: if (height <= dim) {
6607: if (!fe->subspaces[height-1]) {
6608: PetscFE sub;
6610: PetscSpaceGetHeightSubspace(P, height, &subP);
6611: PetscDualSpaceGetHeightSubspace(Q, height, &subQ);
6612: PetscFECreate(PetscObjectComm((PetscObject) fe), &sub);
6613: PetscFEGetType(fe, &fetype);
6614: PetscFESetType(sub, fetype);
6615: PetscFESetBasisSpace(sub, subP);
6616: PetscFESetDualSpace(sub, subQ);
6617: PetscFESetNumComponents(sub, Nc);
6618: PetscFESetUp(sub);
6619: PetscFESetQuadrature(sub, subq);
6620: fe->subspaces[height-1] = sub;
6621: }
6622: *subfe = fe->subspaces[height-1];
6623: } else {
6624: *subfe = NULL;
6625: }
6626: return(0);
6627: }
6629: /*@
6630: PetscFERefine - Create a "refined" PetscFE object that refines the reference cell into smaller copies. This is typically used
6631: to precondition a higher order method with a lower order method on a refined mesh having the same number of dofs (but more
6632: sparsity). It is also used to create an interpolation between regularly refined meshes.
6634: Collective on PetscFE
6636: Input Parameter:
6637: . fe - The initial PetscFE
6639: Output Parameter:
6640: . feRef - The refined PetscFE
6642: Level: developer
6644: .seealso: PetscFEType, PetscFECreate(), PetscFESetType()
6645: @*/
6646: PetscErrorCode PetscFERefine(PetscFE fe, PetscFE *feRef)
6647: {
6648: PetscSpace P, Pref;
6649: PetscDualSpace Q, Qref;
6650: DM K, Kref;
6651: PetscQuadrature q, qref;
6652: const PetscReal *v0, *jac;
6653: PetscInt numComp, numSubelements;
6654: PetscErrorCode ierr;
6657: PetscFEGetBasisSpace(fe, &P);
6658: PetscFEGetDualSpace(fe, &Q);
6659: PetscFEGetQuadrature(fe, &q);
6660: PetscDualSpaceGetDM(Q, &K);
6661: /* Create space */
6662: PetscObjectReference((PetscObject) P);
6663: Pref = P;
6664: /* Create dual space */
6665: PetscDualSpaceDuplicate(Q, &Qref);
6666: DMRefine(K, PetscObjectComm((PetscObject) fe), &Kref);
6667: PetscDualSpaceSetDM(Qref, Kref);
6668: DMDestroy(&Kref);
6669: PetscDualSpaceSetUp(Qref);
6670: /* Create element */
6671: PetscFECreate(PetscObjectComm((PetscObject) fe), feRef);
6672: PetscFESetType(*feRef, PETSCFECOMPOSITE);
6673: PetscFESetBasisSpace(*feRef, Pref);
6674: PetscFESetDualSpace(*feRef, Qref);
6675: PetscFEGetNumComponents(fe, &numComp);
6676: PetscFESetNumComponents(*feRef, numComp);
6677: PetscFESetUp(*feRef);
6678: PetscSpaceDestroy(&Pref);
6679: PetscDualSpaceDestroy(&Qref);
6680: /* Create quadrature */
6681: PetscFECompositeGetMapping(*feRef, &numSubelements, &v0, &jac, NULL);
6682: PetscQuadratureExpandComposite(q, numSubelements, v0, jac, &qref);
6683: PetscFESetQuadrature(*feRef, qref);
6684: PetscQuadratureDestroy(&qref);
6685: return(0);
6686: }
6688: /*@C
6689: PetscFECreateDefault - Create a PetscFE for basic FEM computation
6691: Collective on DM
6693: Input Parameters:
6694: + dm - The underlying DM for the domain
6695: . dim - The spatial dimension
6696: . Nc - The number of components
6697: . isSimplex - Flag for simplex reference cell, otherwise its a tensor product
6698: . prefix - The options prefix, or NULL
6699: - qorder - The quadrature order
6701: Output Parameter:
6702: . fem - The PetscFE object
6704: Level: beginner
6706: .keywords: PetscFE, finite element
6707: .seealso: PetscFECreate(), PetscSpaceCreate(), PetscDualSpaceCreate()
6708: @*/
6709: PetscErrorCode PetscFECreateDefault(DM dm, PetscInt dim, PetscInt Nc, PetscBool isSimplex, const char prefix[], PetscInt qorder, PetscFE *fem)
6710: {
6711: PetscQuadrature q, fq;
6712: DM K;
6713: PetscSpace P;
6714: PetscDualSpace Q;
6715: PetscInt order, quadPointsPerEdge;
6716: PetscBool tensor = isSimplex ? PETSC_FALSE : PETSC_TRUE;
6717: PetscErrorCode ierr;
6720: /* Create space */
6721: PetscSpaceCreate(PetscObjectComm((PetscObject) dm), &P);
6722: PetscObjectSetOptionsPrefix((PetscObject) P, prefix);
6723: PetscSpacePolynomialSetTensor(P, tensor);
6724: PetscSpaceSetFromOptions(P);
6725: PetscSpaceSetNumComponents(P, Nc);
6726: PetscSpacePolynomialSetNumVariables(P, dim);
6727: PetscSpaceSetUp(P);
6728: PetscSpaceGetOrder(P, &order);
6729: PetscSpacePolynomialGetTensor(P, &tensor);
6730: /* Create dual space */
6731: PetscDualSpaceCreate(PetscObjectComm((PetscObject) dm), &Q);
6732: PetscDualSpaceSetType(Q,PETSCDUALSPACELAGRANGE);
6733: PetscObjectSetOptionsPrefix((PetscObject) Q, prefix);
6734: PetscDualSpaceCreateReferenceCell(Q, dim, isSimplex, &K);
6735: PetscDualSpaceSetDM(Q, K);
6736: DMDestroy(&K);
6737: PetscDualSpaceSetNumComponents(Q, Nc);
6738: PetscDualSpaceSetOrder(Q, order);
6739: PetscDualSpaceLagrangeSetTensor(Q, tensor);
6740: PetscDualSpaceSetFromOptions(Q);
6741: PetscDualSpaceSetUp(Q);
6742: /* Create element */
6743: PetscFECreate(PetscObjectComm((PetscObject) dm), fem);
6744: PetscObjectSetOptionsPrefix((PetscObject) *fem, prefix);
6745: PetscFESetFromOptions(*fem);
6746: PetscFESetBasisSpace(*fem, P);
6747: PetscFESetDualSpace(*fem, Q);
6748: PetscFESetNumComponents(*fem, Nc);
6749: PetscFESetUp(*fem);
6750: PetscSpaceDestroy(&P);
6751: PetscDualSpaceDestroy(&Q);
6752: /* Create quadrature (with specified order if given) */
6753: qorder = qorder >= 0 ? qorder : order;
6754: PetscObjectOptionsBegin((PetscObject)*fem);
6755: PetscOptionsInt("-petscfe_default_quadrature_order","Quadrature order is one less than quadture points per edge","PetscFECreateDefault",qorder,&qorder,NULL);
6756: PetscOptionsEnd();
6757: quadPointsPerEdge = PetscMax(qorder + 1,1);
6758: if (isSimplex) {
6759: PetscDTGaussJacobiQuadrature(dim, 1, quadPointsPerEdge, -1.0, 1.0, &q);
6760: PetscDTGaussJacobiQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);
6761: }
6762: else {
6763: PetscDTGaussTensorQuadrature(dim, 1, quadPointsPerEdge, -1.0, 1.0, &q);
6764: PetscDTGaussTensorQuadrature(dim-1, 1, quadPointsPerEdge, -1.0, 1.0, &fq);
6765: }
6766: PetscFESetQuadrature(*fem, q);
6767: PetscFESetFaceQuadrature(*fem, fq);
6768: PetscQuadratureDestroy(&q);
6769: PetscQuadratureDestroy(&fq);
6770: return(0);
6771: }