xref: /petsc/src/dm/impls/moab/dmmbfem.cxx (revision d0e6bf2ad94dcc89b258ce16c7987200a4714786)
1 #include <petscconf.h>
2 #include <petscdt.h>                /*I "petscdt.h" I*/
3 #include <petsc/private/dmmbimpl.h> /*I  "petscdmmoab.h"   I*/
4 
5 /* Utility functions */
DMatrix_Determinant_2x2_Internal(const PetscReal inmat[2* 2])6 static inline PetscReal DMatrix_Determinant_2x2_Internal(const PetscReal inmat[2 * 2])
7 {
8   return inmat[0] * inmat[3] - inmat[1] * inmat[2];
9 }
10 
DMatrix_Invert_2x2_Internal(const PetscReal * inmat,PetscReal * outmat,PetscReal * determinant)11 static inline PetscErrorCode DMatrix_Invert_2x2_Internal(const PetscReal *inmat, PetscReal *outmat, PetscReal *determinant)
12 {
13   PetscReal det = DMatrix_Determinant_2x2_Internal(inmat);
14   if (outmat) {
15     outmat[0] = inmat[3] / det;
16     outmat[1] = -inmat[1] / det;
17     outmat[2] = -inmat[2] / det;
18     outmat[3] = inmat[0] / det;
19   }
20   if (determinant) *determinant = det;
21   return PETSC_SUCCESS;
22 }
23 
DMatrix_Determinant_3x3_Internal(const PetscReal inmat[3* 3])24 static inline PetscReal DMatrix_Determinant_3x3_Internal(const PetscReal inmat[3 * 3])
25 {
26   return inmat[0] * (inmat[8] * inmat[4] - inmat[7] * inmat[5]) - inmat[3] * (inmat[8] * inmat[1] - inmat[7] * inmat[2]) + inmat[6] * (inmat[5] * inmat[1] - inmat[4] * inmat[2]);
27 }
28 
DMatrix_Invert_3x3_Internal(const PetscReal * inmat,PetscReal * outmat,PetscReal * determinant)29 static inline PetscErrorCode DMatrix_Invert_3x3_Internal(const PetscReal *inmat, PetscReal *outmat, PetscReal *determinant)
30 {
31   PetscReal det = DMatrix_Determinant_3x3_Internal(inmat);
32   if (outmat) {
33     outmat[0] = (inmat[8] * inmat[4] - inmat[7] * inmat[5]) / det;
34     outmat[1] = -(inmat[8] * inmat[1] - inmat[7] * inmat[2]) / det;
35     outmat[2] = (inmat[5] * inmat[1] - inmat[4] * inmat[2]) / det;
36     outmat[3] = -(inmat[8] * inmat[3] - inmat[6] * inmat[5]) / det;
37     outmat[4] = (inmat[8] * inmat[0] - inmat[6] * inmat[2]) / det;
38     outmat[5] = -(inmat[5] * inmat[0] - inmat[3] * inmat[2]) / det;
39     outmat[6] = (inmat[7] * inmat[3] - inmat[6] * inmat[4]) / det;
40     outmat[7] = -(inmat[7] * inmat[0] - inmat[6] * inmat[1]) / det;
41     outmat[8] = (inmat[4] * inmat[0] - inmat[3] * inmat[1]) / det;
42   }
43   if (determinant) *determinant = det;
44   return PETSC_SUCCESS;
45 }
46 
DMatrix_Determinant_4x4_Internal(PetscReal inmat[4* 4])47 static inline PetscReal DMatrix_Determinant_4x4_Internal(PetscReal inmat[4 * 4])
48 {
49   return inmat[0 + 0 * 4] * (inmat[1 + 1 * 4] * (inmat[2 + 2 * 4] * inmat[3 + 3 * 4] - inmat[2 + 3 * 4] * inmat[3 + 2 * 4]) - inmat[1 + 2 * 4] * (inmat[2 + 1 * 4] * inmat[3 + 3 * 4] - inmat[2 + 3 * 4] * inmat[3 + 1 * 4]) + inmat[1 + 3 * 4] * (inmat[2 + 1 * 4] * inmat[3 + 2 * 4] - inmat[2 + 2 * 4] * inmat[3 + 1 * 4])) - inmat[0 + 1 * 4] * (inmat[1 + 0 * 4] * (inmat[2 + 2 * 4] * inmat[3 + 3 * 4] - inmat[2 + 3 * 4] * inmat[3 + 2 * 4]) - inmat[1 + 2 * 4] * (inmat[2 + 0 * 4] * inmat[3 + 3 * 4] - inmat[2 + 3 * 4] * inmat[3 + 0 * 4]) + inmat[1 + 3 * 4] * (inmat[2 + 0 * 4] * inmat[3 + 2 * 4] - inmat[2 + 2 * 4] * inmat[3 + 0 * 4])) + inmat[0 + 2 * 4] * (inmat[1 + 0 * 4] * (inmat[2 + 1 * 4] * inmat[3 + 3 * 4] - inmat[2 + 3 * 4] * inmat[3 + 1 * 4]) - inmat[1 + 1 * 4] * (inmat[2 + 0 * 4] * inmat[3 + 3 * 4] - inmat[2 + 3 * 4] * inmat[3 + 0 * 4]) + inmat[1 + 3 * 4] * (inmat[2 + 0 * 4] * inmat[3 + 1 * 4] - inmat[2 + 1 * 4] * inmat[3 + 0 * 4])) - inmat[0 + 3 * 4] * (inmat[1 + 0 * 4] * (inmat[2 + 1 * 4] * inmat[3 + 2 * 4] - inmat[2 + 2 * 4] * inmat[3 + 1 * 4]) - inmat[1 + 1 * 4] * (inmat[2 + 0 * 4] * inmat[3 + 2 * 4] - inmat[2 + 2 * 4] * inmat[3 + 0 * 4]) + inmat[1 + 2 * 4] * (inmat[2 + 0 * 4] * inmat[3 + 1 * 4] - inmat[2 + 1 * 4] * inmat[3 + 0 * 4]));
50 }
51 
DMatrix_Invert_4x4_Internal(PetscReal * inmat,PetscReal * outmat,PetscScalar * determinant)52 static inline PETSC_UNUSED PetscErrorCode DMatrix_Invert_4x4_Internal(PetscReal *inmat, PetscReal *outmat, PetscScalar *determinant)
53 {
54   PetscReal det = DMatrix_Determinant_4x4_Internal(inmat);
55   if (outmat) {
56     outmat[0]  = (inmat[5] * inmat[10] * inmat[15] + inmat[6] * inmat[11] * inmat[13] + inmat[7] * inmat[9] * inmat[14] - inmat[5] * inmat[11] * inmat[14] - inmat[6] * inmat[9] * inmat[15] - inmat[7] * inmat[10] * inmat[13]) / det;
57     outmat[1]  = (inmat[1] * inmat[11] * inmat[14] + inmat[2] * inmat[9] * inmat[15] + inmat[3] * inmat[10] * inmat[13] - inmat[1] * inmat[10] * inmat[15] - inmat[2] * inmat[11] * inmat[13] - inmat[3] * inmat[9] * inmat[14]) / det;
58     outmat[2]  = (inmat[1] * inmat[6] * inmat[15] + inmat[2] * inmat[7] * inmat[13] + inmat[3] * inmat[5] * inmat[14] - inmat[1] * inmat[7] * inmat[14] - inmat[2] * inmat[5] * inmat[15] - inmat[3] * inmat[6] * inmat[13]) / det;
59     outmat[3]  = (inmat[1] * inmat[7] * inmat[10] + inmat[2] * inmat[5] * inmat[11] + inmat[3] * inmat[6] * inmat[9] - inmat[1] * inmat[6] * inmat[11] - inmat[2] * inmat[7] * inmat[9] - inmat[3] * inmat[5] * inmat[10]) / det;
60     outmat[4]  = (inmat[4] * inmat[11] * inmat[14] + inmat[6] * inmat[8] * inmat[15] + inmat[7] * inmat[10] * inmat[12] - inmat[4] * inmat[10] * inmat[15] - inmat[6] * inmat[11] * inmat[12] - inmat[7] * inmat[8] * inmat[14]) / det;
61     outmat[5]  = (inmat[0] * inmat[10] * inmat[15] + inmat[2] * inmat[11] * inmat[12] + inmat[3] * inmat[8] * inmat[14] - inmat[0] * inmat[11] * inmat[14] - inmat[2] * inmat[8] * inmat[15] - inmat[3] * inmat[10] * inmat[12]) / det;
62     outmat[6]  = (inmat[0] * inmat[7] * inmat[14] + inmat[2] * inmat[4] * inmat[15] + inmat[3] * inmat[6] * inmat[12] - inmat[0] * inmat[6] * inmat[15] - inmat[2] * inmat[7] * inmat[12] - inmat[3] * inmat[4] * inmat[14]) / det;
63     outmat[7]  = (inmat[0] * inmat[6] * inmat[11] + inmat[2] * inmat[7] * inmat[8] + inmat[3] * inmat[4] * inmat[10] - inmat[0] * inmat[7] * inmat[10] - inmat[2] * inmat[4] * inmat[11] - inmat[3] * inmat[6] * inmat[8]) / det;
64     outmat[8]  = (inmat[4] * inmat[9] * inmat[15] + inmat[5] * inmat[11] * inmat[12] + inmat[7] * inmat[8] * inmat[13] - inmat[4] * inmat[11] * inmat[13] - inmat[5] * inmat[8] * inmat[15] - inmat[7] * inmat[9] * inmat[12]) / det;
65     outmat[9]  = (inmat[0] * inmat[11] * inmat[13] + inmat[1] * inmat[8] * inmat[15] + inmat[3] * inmat[9] * inmat[12] - inmat[0] * inmat[9] * inmat[15] - inmat[1] * inmat[11] * inmat[12] - inmat[3] * inmat[8] * inmat[13]) / det;
66     outmat[10] = (inmat[0] * inmat[5] * inmat[15] + inmat[1] * inmat[7] * inmat[12] + inmat[3] * inmat[4] * inmat[13] - inmat[0] * inmat[7] * inmat[13] - inmat[1] * inmat[4] * inmat[15] - inmat[3] * inmat[5] * inmat[12]) / det;
67     outmat[11] = (inmat[0] * inmat[7] * inmat[9] + inmat[1] * inmat[4] * inmat[11] + inmat[3] * inmat[5] * inmat[8] - inmat[0] * inmat[5] * inmat[11] - inmat[1] * inmat[7] * inmat[8] - inmat[3] * inmat[4] * inmat[9]) / det;
68     outmat[12] = (inmat[4] * inmat[10] * inmat[13] + inmat[5] * inmat[8] * inmat[14] + inmat[6] * inmat[9] * inmat[12] - inmat[4] * inmat[9] * inmat[14] - inmat[5] * inmat[10] * inmat[12] - inmat[6] * inmat[8] * inmat[13]) / det;
69     outmat[13] = (inmat[0] * inmat[9] * inmat[14] + inmat[1] * inmat[10] * inmat[12] + inmat[2] * inmat[8] * inmat[13] - inmat[0] * inmat[10] * inmat[13] - inmat[1] * inmat[8] * inmat[14] - inmat[2] * inmat[9] * inmat[12]) / det;
70     outmat[14] = (inmat[0] * inmat[6] * inmat[13] + inmat[1] * inmat[4] * inmat[14] + inmat[2] * inmat[5] * inmat[12] - inmat[0] * inmat[5] * inmat[14] - inmat[1] * inmat[6] * inmat[12] - inmat[2] * inmat[4] * inmat[13]) / det;
71     outmat[15] = (inmat[0] * inmat[5] * inmat[10] + inmat[1] * inmat[6] * inmat[8] + inmat[2] * inmat[4] * inmat[9] - inmat[0] * inmat[6] * inmat[9] - inmat[1] * inmat[4] * inmat[10] - inmat[2] * inmat[5] * inmat[8]) / det;
72   }
73   if (determinant) *determinant = det;
74   return PETSC_SUCCESS;
75 }
76 
77 /*
78   Compute_Lagrange_Basis_1D_Internal - Evaluate bases and derivatives at quadrature points for a EDGE2 or EDGE3 element.
79 
80   The routine is given the coordinates of the vertices of a linear or quadratic edge element.
81 
82   The routine evaluates the basis functions associated with each quadrature point provided,
83   and their derivatives with respect to X.
84 
85   Notes:
86 
87   Example Physical Element
88 .vb
89     1-------2        1----3----2
90       EDGE2             EDGE3
91 .ve
92 
93   Input Parameters:
94 +  PetscInt  nverts -          the number of element vertices
95 .  PetscReal coords[3*nverts] - the physical coordinates of the vertices (in canonical numbering)
96 .  PetscInt  npts -            the number of evaluation points (quadrature points)
97 -  PetscReal quad[3*npts] -    the evaluation points (quadrature points) in the reference space
98 
99   Output Parameters:
100 +  PetscReal phypts[3*npts] -  the evaluation points (quadrature points) transformed to the physical space
101 .  PetscReal jxw[npts] -       the jacobian determinant * quadrature weight necessary for assembling discrete contributions
102 .  PetscReal phi[npts] -       the bases evaluated at the specified quadrature points
103 .  PetscReal dphidx[npts] -    the derivative of the bases wrt X-direction evaluated at the specified quadrature points
104 . jacobian  - jacobian
105 . ijacobian - ijacobian
106 - volume    - volume
107 
108   Level: advanced
109 */
Compute_Lagrange_Basis_1D_Internal(const PetscInt nverts,const PetscReal * coords,const PetscInt npts,const PetscReal * quad,PetscReal * phypts,PetscReal * jxw,PetscReal * phi,PetscReal * dphidx,PetscReal * jacobian,PetscReal * ijacobian,PetscReal * volume)110 static PetscErrorCode Compute_Lagrange_Basis_1D_Internal(const PetscInt nverts, const PetscReal *coords, const PetscInt npts, const PetscReal *quad, PetscReal *phypts, PetscReal *jxw, PetscReal *phi, PetscReal *dphidx, PetscReal *jacobian, PetscReal *ijacobian, PetscReal *volume)
111 {
112   int i, j;
113 
114   PetscFunctionBegin;
115   PetscAssertPointer(jacobian, 9);
116   PetscAssertPointer(ijacobian, 10);
117   PetscAssertPointer(volume, 11);
118   if (phypts) PetscCall(PetscArrayzero(phypts, npts * 3));
119   if (dphidx) { /* Reset arrays. */
120     PetscCall(PetscArrayzero(dphidx, npts * nverts));
121   }
122   if (nverts == 2) { /* Linear Edge */
123 
124     for (j = 0; j < npts; j++) {
125       const PetscInt  offset = j * nverts;
126       const PetscReal r      = quad[j];
127 
128       phi[0 + offset] = (1.0 - r);
129       phi[1 + offset] = (r);
130 
131       const PetscReal dNi_dxi[2] = {-1.0, 1.0};
132 
133       jacobian[0] = ijacobian[0] = volume[0] = 0.0;
134       for (i = 0; i < nverts; ++i) {
135         const PetscReal *vertices = coords + i * 3;
136         jacobian[0] += dNi_dxi[i] * vertices[0];
137         if (phypts) phypts[3 * j + 0] += phi[i + offset] * vertices[0];
138       }
139 
140       /* invert the jacobian */
141       *volume      = jacobian[0];
142       ijacobian[0] = 1.0 / jacobian[0];
143       jxw[j] *= *volume;
144 
145       /*  Divide by element jacobian. */
146       for (i = 0; i < nverts; i++) {
147         if (dphidx) dphidx[i + offset] += dNi_dxi[i] * ijacobian[0];
148       }
149     }
150   } else if (nverts == 3) { /* Quadratic Edge */
151 
152     for (j = 0; j < npts; j++) {
153       const PetscInt  offset = j * nverts;
154       const PetscReal r      = quad[j];
155 
156       phi[0 + offset] = 1.0 + r * (2.0 * r - 3.0);
157       phi[1 + offset] = 4.0 * r * (1.0 - r);
158       phi[2 + offset] = r * (2.0 * r - 1.0);
159 
160       const PetscReal dNi_dxi[3] = {4 * r - 3.0, 4 * (1.0 - 2.0 * r), 4.0 * r - 1.0};
161 
162       jacobian[0] = ijacobian[0] = volume[0] = 0.0;
163       for (i = 0; i < nverts; ++i) {
164         const PetscReal *vertices = coords + i * 3;
165         jacobian[0] += dNi_dxi[i] * vertices[0];
166         if (phypts) phypts[3 * j + 0] += phi[i + offset] * vertices[0];
167       }
168 
169       /* invert the jacobian */
170       *volume      = jacobian[0];
171       ijacobian[0] = 1.0 / jacobian[0];
172       if (jxw) jxw[j] *= *volume;
173 
174       /*  Divide by element jacobian. */
175       for (i = 0; i < nverts; i++) {
176         if (dphidx) dphidx[i + offset] += dNi_dxi[i] * ijacobian[0];
177       }
178     }
179   } else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "The number of entity vertices are invalid. Currently only support EDGE2 and EDGE3 basis evaluations in 1-D : %" PetscInt_FMT, nverts);
180   PetscFunctionReturn(PETSC_SUCCESS);
181 }
182 
183 /*
184   Compute_Lagrange_Basis_2D_Internal - Evaluate bases and derivatives at quadrature points for a QUAD4 or TRI3 element.
185 
186   The routine is given the coordinates of the vertices of a quadrangle or triangle.
187 
188   The routine evaluates the basis functions associated with each quadrature point provided,
189   and their derivatives with respect to X and Y.
190 
191   Notes:
192 
193   Example Physical Element (QUAD4)
194 .vb
195     4------3        s
196     |      |        |
197     |      |        |
198     |      |        |
199     1------2        0-------r
200 .ve
201 
202   Input Parameters:
203 +  PetscInt  nverts -          the number of element vertices
204 .  PetscReal coords[3*nverts] - the physical coordinates of the vertices (in canonical numbering)
205 .  PetscInt  npts -            the number of evaluation points (quadrature points)
206 -  PetscReal quad[3*npts] -    the evaluation points (quadrature points) in the reference space
207 
208   Output Parameters:
209 +  PetscReal phypts[3*npts] -  the evaluation points (quadrature points) transformed to the physical space
210 .  PetscReal jxw[npts] -       the jacobian determinant * quadrature weight necessary for assembling discrete contributions
211 .  PetscReal phi[npts] -       the bases evaluated at the specified quadrature points
212 .  PetscReal dphidx[npts] -    the derivative of the bases wrt X-direction evaluated at the specified quadrature points
213 .  PetscReal dphidy[npts] -    the derivative of the bases wrt Y-direction evaluated at the specified quadrature points
214 . jacobian  - jacobian
215 . ijacobian - ijacobian
216 - volume    - volume
217 
218   Level: advanced
219 */
Compute_Lagrange_Basis_2D_Internal(const PetscInt nverts,const PetscReal * coords,const PetscInt npts,const PetscReal * quad,PetscReal * phypts,PetscReal * jxw,PetscReal * phi,PetscReal * dphidx,PetscReal * dphidy,PetscReal * jacobian,PetscReal * ijacobian,PetscReal * volume)220 static PetscErrorCode Compute_Lagrange_Basis_2D_Internal(const PetscInt nverts, const PetscReal *coords, const PetscInt npts, const PetscReal *quad, PetscReal *phypts, PetscReal *jxw, PetscReal *phi, PetscReal *dphidx, PetscReal *dphidy, PetscReal *jacobian, PetscReal *ijacobian, PetscReal *volume)
221 {
222   PetscInt i, j, k;
223 
224   PetscFunctionBegin;
225   PetscAssertPointer(jacobian, 10);
226   PetscAssertPointer(ijacobian, 11);
227   PetscAssertPointer(volume, 12);
228   PetscCall(PetscArrayzero(phi, npts));
229   if (phypts) PetscCall(PetscArrayzero(phypts, npts * 3));
230   if (dphidx) { /* Reset arrays. */
231     PetscCall(PetscArrayzero(dphidx, npts * nverts));
232     PetscCall(PetscArrayzero(dphidy, npts * nverts));
233   }
234   if (nverts == 4) { /* Linear Quadrangle */
235 
236     for (j = 0; j < npts; j++) {
237       const PetscInt  offset = j * nverts;
238       const PetscReal r      = quad[0 + j * 2];
239       const PetscReal s      = quad[1 + j * 2];
240 
241       phi[0 + offset] = (1.0 - r) * (1.0 - s);
242       phi[1 + offset] = r * (1.0 - s);
243       phi[2 + offset] = r * s;
244       phi[3 + offset] = (1.0 - r) * s;
245 
246       const PetscReal dNi_dxi[4]  = {-1.0 + s, 1.0 - s, s, -s};
247       const PetscReal dNi_deta[4] = {-1.0 + r, -r, r, 1.0 - r};
248 
249       PetscCall(PetscArrayzero(jacobian, 4));
250       PetscCall(PetscArrayzero(ijacobian, 4));
251       for (i = 0; i < nverts; ++i) {
252         const PetscReal *vertices = coords + i * 3;
253         jacobian[0] += dNi_dxi[i] * vertices[0];
254         jacobian[2] += dNi_dxi[i] * vertices[1];
255         jacobian[1] += dNi_deta[i] * vertices[0];
256         jacobian[3] += dNi_deta[i] * vertices[1];
257         if (phypts) {
258           phypts[3 * j + 0] += phi[i + offset] * vertices[0];
259           phypts[3 * j + 1] += phi[i + offset] * vertices[1];
260           phypts[3 * j + 2] += phi[i + offset] * vertices[2];
261         }
262       }
263 
264       /* invert the jacobian */
265       PetscCall(DMatrix_Invert_2x2_Internal(jacobian, ijacobian, volume));
266       PetscCheck(*volume >= 1e-12, PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "Quadrangular element has zero volume: %g. Degenerate element or invalid connectivity", *volume);
267 
268       if (jxw) jxw[j] *= *volume;
269 
270       /*  Let us compute the bases derivatives by scaling with inverse jacobian. */
271       if (dphidx) {
272         for (i = 0; i < nverts; i++) {
273           for (k = 0; k < 2; ++k) {
274             if (dphidx) dphidx[i + offset] += dNi_dxi[i] * ijacobian[k * 2 + 0];
275             if (dphidy) dphidy[i + offset] += dNi_deta[i] * ijacobian[k * 2 + 1];
276           } /* for k=[0..2) */
277         } /* for i=[0..nverts) */
278       } /* if (dphidx) */
279     }
280   } else if (nverts == 3) { /* Linear triangle */
281     const PetscReal x2 = coords[2 * 3 + 0], y2 = coords[2 * 3 + 1];
282 
283     PetscCall(PetscArrayzero(jacobian, 4));
284     PetscCall(PetscArrayzero(ijacobian, 4));
285 
286     /* Jacobian is constant */
287     jacobian[0] = (coords[0 * 3 + 0] - x2);
288     jacobian[1] = (coords[1 * 3 + 0] - x2);
289     jacobian[2] = (coords[0 * 3 + 1] - y2);
290     jacobian[3] = (coords[1 * 3 + 1] - y2);
291 
292     /* invert the jacobian */
293     PetscCall(DMatrix_Invert_2x2_Internal(jacobian, ijacobian, volume));
294     PetscCheck(*volume >= 1e-12, PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "Triangular element has zero volume: %g. Degenerate element or invalid connectivity", (double)*volume);
295 
296     const PetscReal Dx[3] = {ijacobian[0], ijacobian[2], -ijacobian[0] - ijacobian[2]};
297     const PetscReal Dy[3] = {ijacobian[1], ijacobian[3], -ijacobian[1] - ijacobian[3]};
298 
299     for (j = 0; j < npts; j++) {
300       const PetscInt  offset = j * nverts;
301       const PetscReal r      = quad[0 + j * 2];
302       const PetscReal s      = quad[1 + j * 2];
303 
304       if (jxw) jxw[j] *= 0.5;
305 
306       /* const PetscReal Ni[3]  = { r, s, 1.0 - r - s }; */
307       const PetscReal phipts_x = coords[2 * 3 + 0] + jacobian[0] * r + jacobian[1] * s;
308       const PetscReal phipts_y = coords[2 * 3 + 1] + jacobian[2] * r + jacobian[3] * s;
309       if (phypts) {
310         phypts[offset + 0] = phipts_x;
311         phypts[offset + 1] = phipts_y;
312       }
313 
314       /* \phi_0 = (b.y - c.y) x + (b.x - c.x) y + c.x b.y - b.x c.y */
315       phi[0 + offset] = (ijacobian[0] * (phipts_x - x2) + ijacobian[1] * (phipts_y - y2));
316       /* \phi_1 = (c.y - a.y) x + (a.x - c.x) y + c.x a.y - a.x c.y */
317       phi[1 + offset] = (ijacobian[2] * (phipts_x - x2) + ijacobian[3] * (phipts_y - y2));
318       phi[2 + offset] = 1.0 - phi[0 + offset] - phi[1 + offset];
319 
320       if (dphidx) {
321         dphidx[0 + offset] = Dx[0];
322         dphidx[1 + offset] = Dx[1];
323         dphidx[2 + offset] = Dx[2];
324       }
325 
326       if (dphidy) {
327         dphidy[0 + offset] = Dy[0];
328         dphidy[1 + offset] = Dy[1];
329         dphidy[2 + offset] = Dy[2];
330       }
331     }
332   } else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "The number of entity vertices are invalid. Currently only support QUAD4 and TRI3 basis evaluations in 2-D : %" PetscInt_FMT, nverts);
333   PetscFunctionReturn(PETSC_SUCCESS);
334 }
335 
336 /*
337   Compute_Lagrange_Basis_3D_Internal - Evaluate bases and derivatives at quadrature points for a HEX8 or TET4 element.
338 
339   The routine is given the coordinates of the vertices of a hexahedra or tetrahedra.
340 
341   The routine evaluates the basis functions associated with each quadrature point provided,
342   and their derivatives with respect to X, Y and Z.
343 
344   Notes:
345 
346   Example Physical Element (HEX8)
347 .vb
348       8------7
349      /|     /|        t  s
350     5------6 |        | /
351     | |    | |        |/
352     | 4----|-3        0-------r
353     |/     |/
354     1------2
355 .ve
356 
357   Input Parameters:
358 +  PetscInt  nverts -          the number of element vertices
359 .  PetscReal coords[3*nverts] - the physical coordinates of the vertices (in canonical numbering)
360 .  PetscInt  npts -            the number of evaluation points (quadrature points)
361 -  PetscReal quad[3*npts] -    the evaluation points (quadrature points) in the reference space
362 
363   Output Parameters:
364 +  PetscReal phypts[3*npts] -  the evaluation points (quadrature points) transformed to the physical space
365 .  PetscReal jxw[npts] -       the jacobian determinant * quadrature weight necessary for assembling discrete contributions
366 .  PetscReal phi[npts] -       the bases evaluated at the specified quadrature points
367 .  PetscReal dphidx[npts] -    the derivative of the bases wrt X-direction evaluated at the specified quadrature points
368 .  PetscReal dphidy[npts] -    the derivative of the bases wrt Y-direction evaluated at the specified quadrature points
369 .  PetscReal dphidz[npts] -    the derivative of the bases wrt Z-direction evaluated at the specified quadrature points
370 . jacobian  - jacobian
371 . ijacobian - ijacobian
372 - volume    - volume
373 
374   Level: advanced
375 */
Compute_Lagrange_Basis_3D_Internal(const PetscInt nverts,const PetscReal * coords,const PetscInt npts,const PetscReal * quad,PetscReal * phypts,PetscReal * jxw,PetscReal * phi,PetscReal * dphidx,PetscReal * dphidy,PetscReal * dphidz,PetscReal * jacobian,PetscReal * ijacobian,PetscReal * volume)376 static PetscErrorCode Compute_Lagrange_Basis_3D_Internal(const PetscInt nverts, const PetscReal *coords, const PetscInt npts, const PetscReal *quad, PetscReal *phypts, PetscReal *jxw, PetscReal *phi, PetscReal *dphidx, PetscReal *dphidy, PetscReal *dphidz, PetscReal *jacobian, PetscReal *ijacobian, PetscReal *volume)
377 {
378   PetscInt i, j, k;
379 
380   PetscFunctionBegin;
381   PetscAssertPointer(jacobian, 11);
382   PetscAssertPointer(ijacobian, 12);
383   PetscAssertPointer(volume, 13);
384 
385   PetscCall(PetscArrayzero(phi, npts));
386   if (phypts) PetscCall(PetscArrayzero(phypts, npts * 3));
387   if (dphidx) {
388     PetscCall(PetscArrayzero(dphidx, npts * nverts));
389     PetscCall(PetscArrayzero(dphidy, npts * nverts));
390     PetscCall(PetscArrayzero(dphidz, npts * nverts));
391   }
392 
393   if (nverts == 8) { /* Linear Hexahedra */
394 
395     for (j = 0; j < npts; j++) {
396       const PetscInt   offset = j * nverts;
397       const PetscReal &r      = quad[j * 3 + 0];
398       const PetscReal &s      = quad[j * 3 + 1];
399       const PetscReal &t      = quad[j * 3 + 2];
400 
401       phi[offset + 0] = (1.0 - r) * (1.0 - s) * (1.0 - t); /* 0,0,0 */
402       phi[offset + 1] = (r) * (1.0 - s) * (1.0 - t);       /* 1,0,0 */
403       phi[offset + 2] = (r) * (s) * (1.0 - t);             /* 1,1,0 */
404       phi[offset + 3] = (1.0 - r) * (s) * (1.0 - t);       /* 0,1,0 */
405       phi[offset + 4] = (1.0 - r) * (1.0 - s) * (t);       /* 0,0,1 */
406       phi[offset + 5] = (r) * (1.0 - s) * (t);             /* 1,0,1 */
407       phi[offset + 6] = (r) * (s) * (t);                   /* 1,1,1 */
408       phi[offset + 7] = (1.0 - r) * (s) * (t);             /* 0,1,1 */
409 
410       const PetscReal dNi_dxi[8] = {-(1.0 - s) * (1.0 - t), (1.0 - s) * (1.0 - t), (s) * (1.0 - t), -(s) * (1.0 - t), -(1.0 - s) * (t), (1.0 - s) * (t), (s) * (t), -(s) * (t)};
411 
412       const PetscReal dNi_deta[8] = {-(1.0 - r) * (1.0 - t), -(r) * (1.0 - t), (r) * (1.0 - t), (1.0 - r) * (1.0 - t), -(1.0 - r) * (t), -(r) * (t), (r) * (t), (1.0 - r) * (t)};
413 
414       const PetscReal dNi_dzeta[8] = {-(1.0 - r) * (1.0 - s), -(r) * (1.0 - s), -(r) * (s), -(1.0 - r) * (s), (1.0 - r) * (1.0 - s), (r) * (1.0 - s), (r) * (s), (1.0 - r) * (s)};
415 
416       PetscCall(PetscArrayzero(jacobian, 9));
417       PetscCall(PetscArrayzero(ijacobian, 9));
418       for (i = 0; i < nverts; ++i) {
419         const PetscReal *vertex = coords + i * 3;
420         jacobian[0] += dNi_dxi[i] * vertex[0];
421         jacobian[3] += dNi_dxi[i] * vertex[1];
422         jacobian[6] += dNi_dxi[i] * vertex[2];
423         jacobian[1] += dNi_deta[i] * vertex[0];
424         jacobian[4] += dNi_deta[i] * vertex[1];
425         jacobian[7] += dNi_deta[i] * vertex[2];
426         jacobian[2] += dNi_dzeta[i] * vertex[0];
427         jacobian[5] += dNi_dzeta[i] * vertex[1];
428         jacobian[8] += dNi_dzeta[i] * vertex[2];
429         if (phypts) {
430           phypts[3 * j + 0] += phi[i + offset] * vertex[0];
431           phypts[3 * j + 1] += phi[i + offset] * vertex[1];
432           phypts[3 * j + 2] += phi[i + offset] * vertex[2];
433         }
434       }
435 
436       /* invert the jacobian */
437       PetscCall(DMatrix_Invert_3x3_Internal(jacobian, ijacobian, volume));
438       PetscCheck(*volume >= 1e-8, PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "Hexahedral element has zero volume: %g. Degenerate element or invalid connectivity", *volume);
439 
440       if (jxw) jxw[j] *= (*volume);
441 
442       /*  Divide by element jacobian. */
443       for (i = 0; i < nverts; ++i) {
444         for (k = 0; k < 3; ++k) {
445           if (dphidx) dphidx[i + offset] += dNi_dxi[i] * ijacobian[0 * 3 + k];
446           if (dphidy) dphidy[i + offset] += dNi_deta[i] * ijacobian[1 * 3 + k];
447           if (dphidz) dphidz[i + offset] += dNi_dzeta[i] * ijacobian[2 * 3 + k];
448         }
449       }
450     }
451   } else if (nverts == 4) { /* Linear Tetrahedra */
452     PetscReal       Dx[4] = {0, 0, 0, 0}, Dy[4] = {0, 0, 0, 0}, Dz[4] = {0, 0, 0, 0};
453     const PetscReal x0 = coords[/*0 * 3 +*/ 0], y0 = coords[/*0 * 3 +*/ 1], z0 = coords[/*0 * 3 +*/ 2];
454 
455     PetscCall(PetscArrayzero(jacobian, 9));
456     PetscCall(PetscArrayzero(ijacobian, 9));
457 
458     /* compute the jacobian */
459     jacobian[0] = coords[1 * 3 + 0] - x0;
460     jacobian[1] = coords[2 * 3 + 0] - x0;
461     jacobian[2] = coords[3 * 3 + 0] - x0;
462     jacobian[3] = coords[1 * 3 + 1] - y0;
463     jacobian[4] = coords[2 * 3 + 1] - y0;
464     jacobian[5] = coords[3 * 3 + 1] - y0;
465     jacobian[6] = coords[1 * 3 + 2] - z0;
466     jacobian[7] = coords[2 * 3 + 2] - z0;
467     jacobian[8] = coords[3 * 3 + 2] - z0;
468 
469     /* invert the jacobian */
470     PetscCall(DMatrix_Invert_3x3_Internal(jacobian, ijacobian, volume));
471     PetscCheck(*volume >= 1e-8, PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "Tetrahedral element has zero volume: %g. Degenerate element or invalid connectivity", (double)*volume);
472 
473     if (dphidx) {
474       Dx[0] = (coords[1 + 2 * 3] * (coords[2 + 1 * 3] - coords[2 + 3 * 3]) - coords[1 + 1 * 3] * (coords[2 + 2 * 3] - coords[2 + 3 * 3]) - coords[1 + 3 * 3] * (coords[2 + 1 * 3] - coords[2 + 2 * 3])) / *volume;
475       Dx[1] = -(coords[1 + 2 * 3] * (coords[2 + 0 * 3] - coords[2 + 3 * 3]) - coords[1 + 0 * 3] * (coords[2 + 2 * 3] - coords[2 + 3 * 3]) - coords[1 + 3 * 3] * (coords[2 + 0 * 3] - coords[2 + 2 * 3])) / *volume;
476       Dx[2] = (coords[1 + 1 * 3] * (coords[2 + 0 * 3] - coords[2 + 3 * 3]) - coords[1 + 0 * 3] * (coords[2 + 1 * 3] - coords[2 + 3 * 3]) - coords[1 + 3 * 3] * (coords[2 + 0 * 3] - coords[2 + 1 * 3])) / *volume;
477       Dx[3] = -(Dx[0] + Dx[1] + Dx[2]);
478       Dy[0] = (coords[0 + 1 * 3] * (coords[2 + 2 * 3] - coords[2 + 3 * 3]) - coords[0 + 2 * 3] * (coords[2 + 1 * 3] - coords[2 + 3 * 3]) + coords[0 + 3 * 3] * (coords[2 + 1 * 3] - coords[2 + 2 * 3])) / *volume;
479       Dy[1] = -(coords[0 + 0 * 3] * (coords[2 + 2 * 3] - coords[2 + 3 * 3]) - coords[0 + 2 * 3] * (coords[2 + 0 * 3] - coords[2 + 3 * 3]) + coords[0 + 3 * 3] * (coords[2 + 0 * 3] - coords[2 + 2 * 3])) / *volume;
480       Dy[2] = (coords[0 + 0 * 3] * (coords[2 + 1 * 3] - coords[2 + 3 * 3]) - coords[0 + 1 * 3] * (coords[2 + 0 * 3] - coords[2 + 3 * 3]) + coords[0 + 3 * 3] * (coords[2 + 0 * 3] - coords[2 + 1 * 3])) / *volume;
481       Dy[3] = -(Dy[0] + Dy[1] + Dy[2]);
482       Dz[0] = (coords[0 + 1 * 3] * (coords[1 + 3 * 3] - coords[1 + 2 * 3]) - coords[0 + 2 * 3] * (coords[1 + 3 * 3] - coords[1 + 1 * 3]) + coords[0 + 3 * 3] * (coords[1 + 2 * 3] - coords[1 + 1 * 3])) / *volume;
483       Dz[1] = -(coords[0 + 0 * 3] * (coords[1 + 3 * 3] - coords[1 + 2 * 3]) + coords[0 + 2 * 3] * (coords[1 + 0 * 3] - coords[1 + 3 * 3]) - coords[0 + 3 * 3] * (coords[1 + 0 * 3] - coords[1 + 2 * 3])) / *volume;
484       Dz[2] = (coords[0 + 0 * 3] * (coords[1 + 3 * 3] - coords[1 + 1 * 3]) + coords[0 + 1 * 3] * (coords[1 + 0 * 3] - coords[1 + 3 * 3]) - coords[0 + 3 * 3] * (coords[1 + 0 * 3] - coords[1 + 1 * 3])) / *volume;
485       Dz[3] = -(Dz[0] + Dz[1] + Dz[2]);
486     }
487 
488     for (j = 0; j < npts; j++) {
489       const PetscInt   offset = j * nverts;
490       const PetscReal &r      = quad[j * 3 + 0];
491       const PetscReal &s      = quad[j * 3 + 1];
492       const PetscReal &t      = quad[j * 3 + 2];
493 
494       if (jxw) jxw[j] *= *volume;
495 
496       phi[offset + 0] = 1.0 - r - s - t;
497       phi[offset + 1] = r;
498       phi[offset + 2] = s;
499       phi[offset + 3] = t;
500 
501       if (phypts) {
502         for (i = 0; i < nverts; ++i) {
503           const PetscReal *vertices = coords + i * 3;
504           phypts[3 * j + 0] += phi[i + offset] * vertices[0];
505           phypts[3 * j + 1] += phi[i + offset] * vertices[1];
506           phypts[3 * j + 2] += phi[i + offset] * vertices[2];
507         }
508       }
509 
510       /* Now set the derivatives */
511       if (dphidx) {
512         dphidx[0 + offset] = Dx[0];
513         dphidx[1 + offset] = Dx[1];
514         dphidx[2 + offset] = Dx[2];
515         dphidx[3 + offset] = Dx[3];
516 
517         dphidy[0 + offset] = Dy[0];
518         dphidy[1 + offset] = Dy[1];
519         dphidy[2 + offset] = Dy[2];
520         dphidy[3 + offset] = Dy[3];
521 
522         dphidz[0 + offset] = Dz[0];
523         dphidz[1 + offset] = Dz[1];
524         dphidz[2 + offset] = Dz[2];
525         dphidz[3 + offset] = Dz[3];
526       }
527 
528     } /* Tetrahedra -- ends */
529   } else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "The number of entity vertices are invalid. Currently only support HEX8 and TET4 basis evaluations in 3-D : %" PetscInt_FMT, nverts);
530   PetscFunctionReturn(PETSC_SUCCESS);
531 }
532 
533 /*@C
534   DMMoabFEMComputeBasis - Evaluate bases and derivatives at quadrature points for a linear EDGE/QUAD/TRI/HEX/TET element.
535 
536   The routine takes the coordinates of the vertices of an element and computes basis functions associated with
537   each quadrature point provided, and their derivatives with respect to X, Y and Z as appropriate.
538 
539   Input Parameters:
540 + dim         - the dimension
541 . nverts      - the number of element vertices
542 . coordinates - the physical coordinates of the vertices (in canonical numbering)
543 - quadrature  - the evaluation points (quadrature points) in the reference space
544 
545   Output Parameters:
546 + phypts                             - the evaluation points (quadrature points) transformed to the physical space
547 . jacobian_quadrature_weight_product - the jacobian determinant * quadrature weight necessary for assembling discrete contributions
548 . fe_basis                           - the bases values evaluated at the specified quadrature points
549 - fe_basis_derivatives               - the derivative of the bases wrt (X,Y,Z)-directions (depending on the dimension) evaluated at the specified quadrature points
550 
551   Level: advanced
552 
553 .seealso: `DMMoabCreate()`
554 @*/
DMMoabFEMComputeBasis(const PetscInt dim,const PetscInt nverts,const PetscReal * coordinates,const PetscQuadrature quadrature,PetscReal * phypts,PetscReal * jacobian_quadrature_weight_product,PetscReal * fe_basis,PetscReal ** fe_basis_derivatives)555 PetscErrorCode DMMoabFEMComputeBasis(const PetscInt dim, const PetscInt nverts, const PetscReal *coordinates, const PetscQuadrature quadrature, PetscReal *phypts, PetscReal *jacobian_quadrature_weight_product, PetscReal *fe_basis, PetscReal **fe_basis_derivatives)
556 {
557   PetscInt         npoints, idim;
558   bool             compute_der;
559   const PetscReal *quadpts, *quadwts;
560   PetscReal        jacobian[9], ijacobian[9], volume;
561 
562   PetscFunctionBegin;
563   PetscAssertPointer(coordinates, 3);
564   PetscValidHeaderSpecific(quadrature, PETSCQUADRATURE_CLASSID, 4);
565   PetscAssertPointer(fe_basis, 7);
566   compute_der = (fe_basis_derivatives != NULL);
567 
568   /* Get the quadrature points and weights for the given quadrature rule */
569   PetscCall(PetscQuadratureGetData(quadrature, &idim, NULL, &npoints, &quadpts, &quadwts));
570   PetscCheck(idim == dim, PETSC_COMM_WORLD, PETSC_ERR_ARG_WRONG, "Dimension mismatch: provided (%" PetscInt_FMT ") vs quadrature (%" PetscInt_FMT ")", idim, dim);
571   if (jacobian_quadrature_weight_product) PetscCall(PetscArraycpy(jacobian_quadrature_weight_product, quadwts, npoints));
572 
573   switch (dim) {
574   case 1:
575     PetscCall(Compute_Lagrange_Basis_1D_Internal(nverts, coordinates, npoints, quadpts, phypts, jacobian_quadrature_weight_product, fe_basis, compute_der ? fe_basis_derivatives[0] : NULL, jacobian, ijacobian, &volume));
576     break;
577   case 2:
578     PetscCall(Compute_Lagrange_Basis_2D_Internal(nverts, coordinates, npoints, quadpts, phypts, jacobian_quadrature_weight_product, fe_basis, compute_der ? fe_basis_derivatives[0] : NULL, compute_der ? fe_basis_derivatives[1] : NULL, jacobian, ijacobian, &volume));
579     break;
580   case 3:
581     PetscCall(Compute_Lagrange_Basis_3D_Internal(nverts, coordinates, npoints, quadpts, phypts, jacobian_quadrature_weight_product, fe_basis, compute_der ? fe_basis_derivatives[0] : NULL, compute_der ? fe_basis_derivatives[1] : NULL, compute_der ? fe_basis_derivatives[2] : NULL, jacobian, ijacobian, &volume));
582     break;
583   default:
584     SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "Invalid dimension; should be in [1,3] : %" PetscInt_FMT, dim);
585   }
586   PetscFunctionReturn(PETSC_SUCCESS);
587 }
588 
589 /*@C
590   DMMoabFEMCreateQuadratureDefault - Create default quadrature rules for integration over an element with a given
591   dimension and polynomial order (deciphered from number of element vertices).
592 
593   Input Parameters:
594 + dim    - the element dimension (1=EDGE, 2=QUAD/TRI, 3=HEX/TET)
595 - nverts - the number of vertices in the physical element
596 
597   Output Parameter:
598 . quadrature - the quadrature object with default settings to integrate polynomials defined over the element
599 
600   Level: advanced
601 
602 .seealso: `DMMoabCreate()`
603 @*/
DMMoabFEMCreateQuadratureDefault(const PetscInt dim,const PetscInt nverts,PetscQuadrature * quadrature)604 PetscErrorCode DMMoabFEMCreateQuadratureDefault(const PetscInt dim, const PetscInt nverts, PetscQuadrature *quadrature)
605 {
606   PetscReal *w, *x;
607   PetscInt   nc = 1;
608 
609   PetscFunctionBegin;
610   /* Create an appropriate quadrature rule to sample basis */
611   switch (dim) {
612   case 1:
613     /* Create Gauss quadrature rules with <order = nverts> in the span [-1, 1] */
614     PetscCall(PetscDTStroudConicalQuadrature(1, nc, nverts, 0, 1.0, quadrature));
615     break;
616   case 2:
617     /* Create Gauss quadrature rules with <order = nverts> in the span [-1, 1] */
618     if (nverts == 3) {
619       const PetscInt order   = 2;
620       const PetscInt npoints = (order == 2 ? 3 : 6);
621       PetscCall(PetscMalloc2(npoints * 2, &x, npoints, &w));
622       if (npoints == 3) {
623         x[0] = x[1] = x[2] = x[5] = 1.0 / 6.0;
624         x[3] = x[4] = 2.0 / 3.0;
625         w[0] = w[1] = w[2] = 1.0 / 3.0;
626       } else if (npoints == 6) {
627         x[0] = x[1] = x[2] = 0.44594849091597;
628         x[3] = x[4] = 0.10810301816807;
629         x[5]        = 0.44594849091597;
630         x[6] = x[7] = x[8] = 0.09157621350977;
631         x[9] = x[10] = 0.81684757298046;
632         x[11]        = 0.09157621350977;
633         w[0] = w[1] = w[2] = 0.22338158967801;
634         w[3] = w[4] = w[5] = 0.10995174365532;
635       } else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "Triangle quadrature rules for points 3 and 6 supported; npoints : %" PetscInt_FMT, npoints);
636       PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, quadrature));
637       PetscCall(PetscQuadratureSetOrder(*quadrature, order));
638       PetscCall(PetscQuadratureSetData(*quadrature, dim, nc, npoints, x, w));
639       /* PetscCall(PetscDTStroudConicalQuadrature(dim, nc, nverts, 0.0, 1.0, quadrature)); */
640     } else PetscCall(PetscDTGaussTensorQuadrature(dim, nc, nverts, 0.0, 1.0, quadrature));
641     break;
642   case 3:
643     /* Create Gauss quadrature rules with <order = nverts> in the span [-1, 1] */
644     if (nverts == 4) {
645       PetscInt       order;
646       const PetscInt npoints = 4; // Choose between 4 and 10
647       PetscCall(PetscMalloc2(npoints * 3, &x, npoints, &w));
648       if (npoints == 4) { /*  KEAST1, K1,  N=4, O=4 */
649         const PetscReal x_4[12] = {0.5854101966249685, 0.1381966011250105, 0.1381966011250105, 0.1381966011250105, 0.1381966011250105, 0.1381966011250105,
650                                    0.1381966011250105, 0.1381966011250105, 0.5854101966249685, 0.1381966011250105, 0.5854101966249685, 0.1381966011250105};
651         PetscCall(PetscArraycpy(x, x_4, 12));
652 
653         w[0] = w[1] = w[2] = w[3] = 1.0 / 24.0;
654         order                     = 4;
655       } else if (npoints == 10) { /*  KEAST3, K3  N=10, O=10 */
656         const PetscReal x_10[30] = {0.5684305841968444, 0.1438564719343852, 0.1438564719343852, 0.1438564719343852, 0.1438564719343852, 0.1438564719343852, 0.1438564719343852, 0.1438564719343852, 0.5684305841968444, 0.1438564719343852,
657                                     0.5684305841968444, 0.1438564719343852, 0.0000000000000000, 0.5000000000000000, 0.5000000000000000, 0.5000000000000000, 0.0000000000000000, 0.5000000000000000, 0.5000000000000000, 0.5000000000000000,
658                                     0.0000000000000000, 0.5000000000000000, 0.0000000000000000, 0.0000000000000000, 0.0000000000000000, 0.5000000000000000, 0.0000000000000000, 0.0000000000000000, 0.0000000000000000, 0.5000000000000000};
659         PetscCall(PetscArraycpy(x, x_10, 30));
660 
661         w[0] = w[1] = w[2] = w[3] = 0.2177650698804054;
662         w[4] = w[5] = w[6] = w[7] = w[8] = w[9] = 0.0214899534130631;
663         order                                   = 10;
664       } else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "Tetrahedral quadrature rules for points 4 and 10 supported; npoints : %" PetscInt_FMT, npoints);
665       PetscCall(PetscQuadratureCreate(PETSC_COMM_SELF, quadrature));
666       PetscCall(PetscQuadratureSetOrder(*quadrature, order));
667       PetscCall(PetscQuadratureSetData(*quadrature, dim, nc, npoints, x, w));
668       /* PetscCall(PetscDTStroudConicalQuadrature(dim, nc, nverts, 0.0, 1.0, quadrature)); */
669     } else PetscCall(PetscDTGaussTensorQuadrature(dim, nc, nverts, 0.0, 1.0, quadrature));
670     break;
671   default:
672     SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "Invalid dimension; should be in [1,3] : %" PetscInt_FMT, dim);
673   }
674   PetscFunctionReturn(PETSC_SUCCESS);
675 }
676 
677 /* Compute Jacobians */
FEMComputeBasis_JandF(const PetscInt dim,const PetscInt nverts,const PetscReal * coordinates,const PetscReal * quadrature,PetscReal * phypts,PetscReal * phibasis,PetscReal * jacobian,PetscReal * ijacobian,PetscReal * volume)678 static PetscErrorCode FEMComputeBasis_JandF(const PetscInt dim, const PetscInt nverts, const PetscReal *coordinates, const PetscReal *quadrature, PetscReal *phypts, PetscReal *phibasis, PetscReal *jacobian, PetscReal *ijacobian, PetscReal *volume)
679 {
680   PetscFunctionBegin;
681   switch (dim) {
682   case 1:
683     PetscCall(Compute_Lagrange_Basis_1D_Internal(nverts, coordinates, 1, quadrature, phypts, NULL, phibasis, NULL, jacobian, ijacobian, volume));
684     break;
685   case 2:
686     PetscCall(Compute_Lagrange_Basis_2D_Internal(nverts, coordinates, 1, quadrature, phypts, NULL, phibasis, NULL, NULL, jacobian, ijacobian, volume));
687     break;
688   case 3:
689     PetscCall(Compute_Lagrange_Basis_3D_Internal(nverts, coordinates, 1, quadrature, phypts, NULL, phibasis, NULL, NULL, NULL, jacobian, ijacobian, volume));
690     break;
691   default:
692     SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "Invalid dimension; should be in [1,3] : %" PetscInt_FMT, dim);
693   }
694   PetscFunctionReturn(PETSC_SUCCESS);
695 }
696 
697 /*@C
698   DMMoabPToRMapping - Compute the mapping from the physical coordinate system for a given element to the
699   canonical reference element.
700 
701   Input Parameters:
702 + dim         - the element dimension (1=EDGE, 2=QUAD/TRI, 3=HEX/TET)
703 . nverts      - the number of vertices in the physical element
704 . coordinates - the coordinates of vertices in the physical element
705 - xphy        - the coordinates of physical point for which natural coordinates (in reference frame) are sought
706 
707   Output Parameters:
708 + natparam - the natural coordinates (in reference frame) corresponding to xphy
709 - phi      - the basis functions evaluated at the natural coordinates (natparam)
710 
711   Level: advanced
712 
713   Notes:
714   In addition to finding the inverse mapping evaluation through Newton iteration, the basis
715   function at the parametric point is also evaluated optionally.
716 
717 .seealso: `DMMoabCreate()`
718 @*/
DMMoabPToRMapping(const PetscInt dim,const PetscInt nverts,const PetscReal * coordinates,const PetscReal * xphy,PetscReal * natparam,PetscReal * phi)719 PetscErrorCode DMMoabPToRMapping(const PetscInt dim, const PetscInt nverts, const PetscReal *coordinates, const PetscReal *xphy, PetscReal *natparam, PetscReal *phi)
720 {
721   /* Perform inverse evaluation for the mapping with use of Newton Raphson iteration */
722   const PetscReal tol            = 1.0e-10;
723   const PetscInt  max_iterations = 10;
724   const PetscReal error_tol_sqr  = tol * tol;
725   PetscReal       phibasis[8], jacobian[9], ijacobian[9], volume;
726   PetscReal       phypts[3] = {0.0, 0.0, 0.0};
727   PetscReal       delta[3]  = {0.0, 0.0, 0.0};
728   PetscInt        iters     = 0;
729   PetscReal       error     = 1.0;
730 
731   PetscFunctionBegin;
732   PetscAssertPointer(coordinates, 3);
733   PetscAssertPointer(xphy, 4);
734   PetscAssertPointer(natparam, 5);
735 
736   PetscCall(PetscArrayzero(jacobian, dim * dim));
737   PetscCall(PetscArrayzero(ijacobian, dim * dim));
738   PetscCall(PetscArrayzero(phibasis, nverts));
739 
740   /* zero initial guess */
741   natparam[0] = natparam[1] = natparam[2] = 0.0;
742 
743   /* Compute delta = evaluate( xi) - x */
744   PetscCall(FEMComputeBasis_JandF(dim, nverts, coordinates, natparam, phypts, phibasis, jacobian, ijacobian, &volume));
745 
746   error = 0.0;
747   switch (dim) {
748   case 3:
749     delta[2] = phypts[2] - xphy[2];
750     error += (delta[2] * delta[2]);
751   case 2:
752     delta[1] = phypts[1] - xphy[1];
753     error += (delta[1] * delta[1]);
754   case 1:
755     delta[0] = phypts[0] - xphy[0];
756     error += (delta[0] * delta[0]);
757     break;
758   }
759 
760   while (error > error_tol_sqr) {
761     PetscCheck(++iters <= max_iterations, PETSC_COMM_WORLD, PETSC_ERR_ARG_OUTOFRANGE, "Maximum Newton iterations (10) reached. Current point in reference space : (%g, %g, %g)", natparam[0], natparam[1], natparam[2]);
762 
763     /* Compute natparam -= J.inverse() * delta */
764     switch (dim) {
765     case 1:
766       natparam[0] -= ijacobian[0] * delta[0];
767       break;
768     case 2:
769       natparam[0] -= ijacobian[0] * delta[0] + ijacobian[1] * delta[1];
770       natparam[1] -= ijacobian[2] * delta[0] + ijacobian[3] * delta[1];
771       break;
772     case 3:
773       natparam[0] -= ijacobian[0] * delta[0] + ijacobian[1] * delta[1] + ijacobian[2] * delta[2];
774       natparam[1] -= ijacobian[3] * delta[0] + ijacobian[4] * delta[1] + ijacobian[5] * delta[2];
775       natparam[2] -= ijacobian[6] * delta[0] + ijacobian[7] * delta[1] + ijacobian[8] * delta[2];
776       break;
777     }
778 
779     /* Compute delta = evaluate( xi) - x */
780     PetscCall(FEMComputeBasis_JandF(dim, nverts, coordinates, natparam, phypts, phibasis, jacobian, ijacobian, &volume));
781 
782     error = 0.0;
783     switch (dim) {
784     case 3:
785       delta[2] = phypts[2] - xphy[2];
786       error += (delta[2] * delta[2]);
787     case 2:
788       delta[1] = phypts[1] - xphy[1];
789       error += (delta[1] * delta[1]);
790     case 1:
791       delta[0] = phypts[0] - xphy[0];
792       error += (delta[0] * delta[0]);
793       break;
794     }
795   }
796   if (phi) PetscCall(PetscArraycpy(phi, phibasis, nverts));
797   PetscFunctionReturn(PETSC_SUCCESS);
798 }
799