xref: /libCEED/interface/ceed-basis.c (revision a8d322087fa8f150327cdc2bf14a171452b711ec)
1 // Copyright (c) 2017, Lawrence Livermore National Security, LLC. Produced at
2 // the Lawrence Livermore National Laboratory. LLNL-CODE-734707. All Rights
3 // reserved. See files LICENSE and NOTICE for details.
4 //
5 // This file is part of CEED, a collection of benchmarks, miniapps, software
6 // libraries and APIs for efficient high-order finite element and spectral
7 // element discretizations for exascale applications. For more information and
8 // source code availability see http://github.com/ceed.
9 //
10 // The CEED research is supported by the Exascale Computing Project 17-SC-20-SC,
11 // a collaborative effort of two U.S. Department of Energy organizations (Office
12 // of Science and the National Nuclear Security Administration) responsible for
13 // the planning and preparation of a capable exascale ecosystem, including
14 // software, applications, hardware, advanced system engineering and early
15 // testbed platforms, in support of the nation's exascale computing imperative.
16 
17 #include <ceed-impl.h>
18 #include <ceed-backend.h>
19 #include <math.h>
20 #include <stdio.h>
21 #include <stdlib.h>
22 #include <string.h>
23 
24 /// @cond DOXYGEN_SKIP
25 static struct CeedBasis_private ceed_basis_collocated;
26 /// @endcond
27 
28 /// @file
29 /// Implementation of public CeedBasis interfaces
30 ///
31 /// @addtogroup CeedBasis
32 /// @{
33 
34 /**
35   @brief Create a tensor-product basis for H^1 discretizations
36 
37   @param ceed        A Ceed object where the CeedBasis will be created
38   @param dim         Topological dimension
39   @param ncomp       Number of field components (1 for scalar fields)
40   @param P1d         Number of nodes in one dimension
41   @param Q1d         Number of quadrature points in one dimension
42   @param interp1d    Row-major (Q1d * P1d) matrix expressing the values of nodal
43                        basis functions at quadrature points
44   @param grad1d      Row-major (Q1d * P1d) matrix expressing derivatives of nodal
45                        basis functions at quadrature points
46   @param qref1d      Array of length Q1d holding the locations of quadrature points
47                        on the 1D reference element [-1, 1]
48   @param qweight1d   Array of length Q1d holding the quadrature weights on the
49                        reference element
50   @param[out] basis  Address of the variable where the newly created
51                        CeedBasis will be stored.
52 
53   @return An error code: 0 - success, otherwise - failure
54 
55   @ref Basic
56 **/
57 int CeedBasisCreateTensorH1(Ceed ceed, CeedInt dim, CeedInt ncomp, CeedInt P1d,
58                             CeedInt Q1d, const CeedScalar *interp1d,
59                             const CeedScalar *grad1d, const CeedScalar *qref1d,
60                             const CeedScalar *qweight1d, CeedBasis *basis) {
61   int ierr;
62 
63   if (dim<1)
64     // LCOV_EXCL_START
65     return CeedError(ceed, 1, "Basis dimension must be a positive value");
66   // LCOV_EXCL_STOP
67 
68   if (!ceed->BasisCreateTensorH1) {
69     Ceed delegate;
70     ierr = CeedGetObjectDelegate(ceed, &delegate, "Basis"); CeedChk(ierr);
71 
72     if (!delegate)
73       // LCOV_EXCL_START
74       return CeedError(ceed, 1, "Backend does not support BasisCreateTensorH1");
75     // LCOV_EXCL_STOP
76 
77     ierr = CeedBasisCreateTensorH1(delegate, dim, ncomp, P1d,
78                                    Q1d, interp1d, grad1d, qref1d,
79                                    qweight1d, basis); CeedChk(ierr);
80     return 0;
81   }
82   ierr = CeedCalloc(1,basis); CeedChk(ierr);
83   (*basis)->ceed = ceed;
84   ceed->refcount++;
85   (*basis)->refcount = 1;
86   (*basis)->tensorbasis = 1;
87   (*basis)->dim = dim;
88   (*basis)->ncomp = ncomp;
89   (*basis)->P1d = P1d;
90   (*basis)->Q1d = Q1d;
91   (*basis)->P = CeedIntPow(P1d, dim);
92   (*basis)->Q = CeedIntPow(Q1d, dim);
93   ierr = CeedMalloc(Q1d,&(*basis)->qref1d); CeedChk(ierr);
94   ierr = CeedMalloc(Q1d,&(*basis)->qweight1d); CeedChk(ierr);
95   memcpy((*basis)->qref1d, qref1d, Q1d*sizeof(qref1d[0]));
96   memcpy((*basis)->qweight1d, qweight1d, Q1d*sizeof(qweight1d[0]));
97   ierr = CeedMalloc(Q1d*P1d,&(*basis)->interp1d); CeedChk(ierr);
98   ierr = CeedMalloc(Q1d*P1d,&(*basis)->grad1d); CeedChk(ierr);
99   memcpy((*basis)->interp1d, interp1d, Q1d*P1d*sizeof(interp1d[0]));
100   memcpy((*basis)->grad1d, grad1d, Q1d*P1d*sizeof(grad1d[0]));
101   ierr = ceed->BasisCreateTensorH1(dim, P1d, Q1d, interp1d, grad1d, qref1d,
102                                    qweight1d, *basis); CeedChk(ierr);
103   return 0;
104 }
105 
106 /**
107   @brief Create a tensor-product Lagrange basis
108 
109   @param ceed        A Ceed object where the CeedBasis will be created
110   @param dim         Topological dimension of element
111   @param ncomp       Number of field components (1 for scalar fields)
112   @param P           Number of Gauss-Lobatto nodes in one dimension.  The
113                        polynomial degree of the resulting Q_k element is k=P-1.
114   @param Q           Number of quadrature points in one dimension.
115   @param qmode       Distribution of the Q quadrature points (affects order of
116                        accuracy for the quadrature)
117   @param[out] basis  Address of the variable where the newly created
118                        CeedBasis will be stored.
119 
120   @return An error code: 0 - success, otherwise - failure
121 
122   @ref Basic
123 **/
124 int CeedBasisCreateTensorH1Lagrange(Ceed ceed, CeedInt dim, CeedInt ncomp,
125                                     CeedInt P, CeedInt Q, CeedQuadMode qmode,
126                                     CeedBasis *basis) {
127   // Allocate
128   int ierr, i, j, k;
129   CeedScalar c1, c2, c3, c4, dx, *nodes, *interp1d, *grad1d, *qref1d, *qweight1d;
130 
131   if (dim<1)
132     // LCOV_EXCL_START
133     return CeedError(ceed, 1, "Basis dimension must be a positive value");
134   // LCOV_EXCL_STOP
135 
136   ierr = CeedCalloc(P*Q, &interp1d); CeedChk(ierr);
137   ierr = CeedCalloc(P*Q, &grad1d); CeedChk(ierr);
138   ierr = CeedCalloc(P, &nodes); CeedChk(ierr);
139   ierr = CeedCalloc(Q, &qref1d); CeedChk(ierr);
140   ierr = CeedCalloc(Q, &qweight1d); CeedChk(ierr);
141   // Get Nodes and Weights
142   ierr = CeedLobattoQuadrature(P, nodes, NULL); CeedChk(ierr);
143   switch (qmode) {
144   case CEED_GAUSS:
145     ierr = CeedGaussQuadrature(Q, qref1d, qweight1d); CeedChk(ierr);
146     break;
147   case CEED_GAUSS_LOBATTO:
148     ierr = CeedLobattoQuadrature(Q, qref1d, qweight1d); CeedChk(ierr);
149     break;
150   }
151   // Build B, D matrix
152   // Fornberg, 1998
153   for (i = 0; i  < Q; i++) {
154     c1 = 1.0;
155     c3 = nodes[0] - qref1d[i];
156     interp1d[i*P+0] = 1.0;
157     for (j = 1; j < P; j++) {
158       c2 = 1.0;
159       c4 = c3;
160       c3 = nodes[j] - qref1d[i];
161       for (k = 0; k < j; k++) {
162         dx = nodes[j] - nodes[k];
163         c2 *= dx;
164         if (k == j - 1) {
165           grad1d[i*P + j] = c1*(interp1d[i*P + k] - c4*grad1d[i*P + k]) / c2;
166           interp1d[i*P + j] = - c1*c4*interp1d[i*P + k] / c2;
167         }
168         grad1d[i*P + k] = (c3*grad1d[i*P + k] - interp1d[i*P + k]) / dx;
169         interp1d[i*P + k] = c3*interp1d[i*P + k] / dx;
170       }
171       c1 = c2;
172     }
173   }
174   //  // Pass to CeedBasisCreateTensorH1
175   ierr = CeedBasisCreateTensorH1(ceed, dim, ncomp, P, Q, interp1d, grad1d, qref1d,
176                                  qweight1d, basis); CeedChk(ierr);
177   ierr = CeedFree(&interp1d); CeedChk(ierr);
178   ierr = CeedFree(&grad1d); CeedChk(ierr);
179   ierr = CeedFree(&nodes); CeedChk(ierr);
180   ierr = CeedFree(&qref1d); CeedChk(ierr);
181   ierr = CeedFree(&qweight1d); CeedChk(ierr);
182   return 0;
183 }
184 
185 /**
186   @brief Create a non tensor-product basis for H^1 discretizations
187 
188   @param ceed        A Ceed object where the CeedBasis will be created
189   @param topo        Topology of element, e.g. hypercube, simplex, ect
190   @param ncomp       Number of field components (1 for scalar fields)
191   @param nnodes      Total number of nodes
192   @param nqpts       Total number of quadrature points
193   @param interp      Row-major (nqpts * nnodes) matrix expressing the values of
194                        nodal basis functions at quadrature points
195   @param grad        Row-major (nqpts * dim * nnodes) matrix expressing
196                        derivatives of nodal basis functions at quadrature points
197   @param qref        Array of length nqpts holding the locations of quadrature
198                        points on the reference element [-1, 1]
199   @param qweight     Array of length nqpts holding the quadrature weights on the
200                        reference element
201   @param[out] basis  Address of the variable where the newly created
202                        CeedBasis will be stored.
203 
204   @return An error code: 0 - success, otherwise - failure
205 
206   @ref Basic
207 **/
208 int CeedBasisCreateH1(Ceed ceed, CeedElemTopology topo, CeedInt ncomp,
209                       CeedInt nnodes, CeedInt nqpts, const CeedScalar *interp,
210                       const CeedScalar *grad, const CeedScalar *qref,
211                       const CeedScalar *qweight, CeedBasis *basis) {
212   int ierr;
213   CeedInt P = nnodes, Q = nqpts, dim = 0;
214 
215   if (!ceed->BasisCreateH1) {
216     Ceed delegate;
217     ierr = CeedGetObjectDelegate(ceed, &delegate, "Basis"); CeedChk(ierr);
218 
219     if (!delegate)
220       // LCOV_EXCL_START
221       return CeedError(ceed, 1, "Backend does not support BasisCreateH1");
222     // LCOV_EXCL_STOP
223 
224     ierr = CeedBasisCreateH1(delegate, topo, ncomp, nnodes,
225                              nqpts, interp, grad, qref,
226                              qweight, basis); CeedChk(ierr);
227     return 0;
228   }
229 
230   ierr = CeedCalloc(1,basis); CeedChk(ierr);
231 
232   ierr = CeedBasisGetTopologyDimension(topo, &dim); CeedChk(ierr);
233 
234   (*basis)->ceed = ceed;
235   ceed->refcount++;
236   (*basis)->refcount = 1;
237   (*basis)->tensorbasis = 0;
238   (*basis)->dim = dim;
239   (*basis)->ncomp = ncomp;
240   (*basis)->P = P;
241   (*basis)->Q = Q;
242   ierr = CeedMalloc(Q*dim,&(*basis)->qref1d); CeedChk(ierr);
243   ierr = CeedMalloc(Q,&(*basis)->qweight1d); CeedChk(ierr);
244   memcpy((*basis)->qref1d, qref, Q*dim*sizeof(qref[0]));
245   memcpy((*basis)->qweight1d, qweight, Q*sizeof(qweight[0]));
246   ierr = CeedMalloc(Q*P, &(*basis)->interp); CeedChk(ierr);
247   ierr = CeedMalloc(dim*Q*P, &(*basis)->grad); CeedChk(ierr);
248   memcpy((*basis)->interp, interp, Q*P*sizeof(interp[0]));
249   memcpy((*basis)->grad, grad, dim*Q*P*sizeof(grad[0]));
250   ierr = ceed->BasisCreateH1(topo, dim, P, Q, interp, grad, qref,
251                              qweight, *basis); CeedChk(ierr);
252   return 0;
253 }
254 
255 /**
256   @brief Construct a Gauss-Legendre quadrature
257 
258   @param Q               Number of quadrature points (integrates polynomials of
259                            degree 2*Q-1 exactly)
260   @param[out] qref1d     Array of length Q to hold the abscissa on [-1, 1]
261   @param[out] qweight1d  Array of length Q to hold the weights
262 
263   @return An error code: 0 - success, otherwise - failure
264 
265   @ref Utility
266 **/
267 int CeedGaussQuadrature(CeedInt Q, CeedScalar *qref1d, CeedScalar *qweight1d) {
268   // Allocate
269   CeedScalar P0, P1, P2, dP2, xi, wi, PI = 4.0*atan(1.0);
270   // Build qref1d, qweight1d
271   for (int i = 0; i <= Q/2; i++) {
272     // Guess
273     xi = cos(PI*(CeedScalar)(2*i+1)/((CeedScalar)(2*Q)));
274     // Pn(xi)
275     P0 = 1.0;
276     P1 = xi;
277     P2 = 0.0;
278     for (int j = 2; j <= Q; j++) {
279       P2 = (((CeedScalar)(2*j-1))*xi*P1-((CeedScalar)(j-1))*P0)/((CeedScalar)(j));
280       P0 = P1;
281       P1 = P2;
282     }
283     // First Newton Step
284     dP2 = (xi*P2 - P0)*(CeedScalar)Q/(xi*xi-1.0);
285     xi = xi-P2/dP2;
286     // Newton to convergence
287     for (int k=0; k<100 && fabs(P2)>10*CEED_EPSILON; k++) {
288       P0 = 1.0;
289       P1 = xi;
290       for (int j = 2; j <= Q; j++) {
291         P2 = (((CeedScalar)(2*j-1))*xi*P1-((CeedScalar)(j-1))*P0)/((CeedScalar)(j));
292         P0 = P1;
293         P1 = P2;
294       }
295       dP2 = (xi*P2 - P0)*(CeedScalar)Q/(xi*xi-1.0);
296       xi = xi-P2/dP2;
297     }
298     // Save xi, wi
299     wi = 2.0/((1.0-xi*xi)*dP2*dP2);
300     qweight1d[i] = wi;
301     qweight1d[Q-1-i] = wi;
302     qref1d[i] = -xi;
303     qref1d[Q-1-i]= xi;
304   }
305   return 0;
306 }
307 
308 /**
309   @brief Construct a Gauss-Legendre-Lobatto quadrature
310 
311   @param Q               Number of quadrature points (integrates polynomials of
312                            degree 2*Q-3 exactly)
313   @param[out] qref1d     Array of length Q to hold the abscissa on [-1, 1]
314   @param[out] qweight1d  Array of length Q to hold the weights
315 
316   @return An error code: 0 - success, otherwise - failure
317 
318   @ref Utility
319 **/
320 int CeedLobattoQuadrature(CeedInt Q, CeedScalar *qref1d,
321                           CeedScalar *qweight1d) {
322   // Allocate
323   CeedScalar P0, P1, P2, dP2, d2P2, xi, wi, PI = 4.0*atan(1.0);
324   // Build qref1d, qweight1d
325   // Set endpoints
326   wi = 2.0/((CeedScalar)(Q*(Q-1)));
327   if (qweight1d) {
328     qweight1d[0] = wi;
329     qweight1d[Q-1] = wi;
330   }
331   qref1d[0] = -1.0;
332   qref1d[Q-1] = 1.0;
333   // Interior
334   for (int i = 1; i <= (Q-1)/2; i++) {
335     // Guess
336     xi = cos(PI*(CeedScalar)(i)/(CeedScalar)(Q-1));
337     // Pn(xi)
338     P0 = 1.0;
339     P1 = xi;
340     P2 = 0.0;
341     for (int j = 2; j < Q; j++) {
342       P2 = (((CeedScalar)(2*j-1))*xi*P1-((CeedScalar)(j-1))*P0)/((CeedScalar)(j));
343       P0 = P1;
344       P1 = P2;
345     }
346     // First Newton step
347     dP2 = (xi*P2 - P0)*(CeedScalar)Q/(xi*xi-1.0);
348     d2P2 = (2*xi*dP2 - (CeedScalar)(Q*(Q-1))*P2)/(1.0-xi*xi);
349     xi = xi-dP2/d2P2;
350     // Newton to convergence
351     for (int k=0; k<100 && fabs(dP2)>10*CEED_EPSILON; k++) {
352       P0 = 1.0;
353       P1 = xi;
354       for (int j = 2; j < Q; j++) {
355         P2 = (((CeedScalar)(2*j-1))*xi*P1-((CeedScalar)(j-1))*P0)/((CeedScalar)(j));
356         P0 = P1;
357         P1 = P2;
358       }
359       dP2 = (xi*P2 - P0)*(CeedScalar)Q/(xi*xi-1.0);
360       d2P2 = (2*xi*dP2 - (CeedScalar)(Q*(Q-1))*P2)/(1.0-xi*xi);
361       xi = xi-dP2/d2P2;
362     }
363     // Save xi, wi
364     wi = 2.0/(((CeedScalar)(Q*(Q-1)))*P2*P2);
365     if (qweight1d) {
366       qweight1d[i] = wi;
367       qweight1d[Q-1-i] = wi;
368     }
369     qref1d[i] = -xi;
370     qref1d[Q-1-i]= xi;
371   }
372   return 0;
373 }
374 
375 /**
376   @brief View an array stored in a CeedBasis
377 
378   @param name      Name of array
379   @param fpformat  Printing format
380   @param m         Number of rows in array
381   @param n         Number of columns in array
382   @param a         Array to be viewed
383   @param stream    Stream to view to, e.g., stdout
384 
385   @return An error code: 0 - success, otherwise - failure
386 
387   @ref Utility
388 **/
389 static int CeedScalarView(const char *name, const char *fpformat, CeedInt m,
390                           CeedInt n, const CeedScalar *a, FILE *stream) {
391   for (int i=0; i<m; i++) {
392     if (m > 1)
393       fprintf(stream, "%12s[%d]:", name, i);
394     else
395       fprintf(stream, "%12s:", name);
396     for (int j=0; j<n; j++)
397       fprintf(stream, fpformat, fabs(a[i*n+j]) > 1E-14 ? a[i*n+j] : 0);
398     fputs("\n", stream);
399   }
400   return 0;
401 }
402 
403 /**
404   @brief View a CeedBasis
405 
406   @param basis   CeedBasis to view
407   @param stream  Stream to view to, e.g., stdout
408 
409   @return An error code: 0 - success, otherwise - failure
410 
411   @ref Utility
412 **/
413 int CeedBasisView(CeedBasis basis, FILE *stream) {
414   int ierr;
415 
416   if (basis->tensorbasis) {
417     fprintf(stream, "CeedBasis: dim=%d P=%d Q=%d\n", basis->dim, basis->P1d,
418             basis->Q1d);
419     ierr = CeedScalarView("qref1d", "\t% 12.8f", 1, basis->Q1d, basis->qref1d,
420                           stream); CeedChk(ierr);
421     ierr = CeedScalarView("qweight1d", "\t% 12.8f", 1, basis->Q1d,
422                           basis->qweight1d, stream); CeedChk(ierr);
423     ierr = CeedScalarView("interp1d", "\t% 12.8f", basis->Q1d, basis->P1d,
424                           basis->interp1d, stream); CeedChk(ierr);
425     ierr = CeedScalarView("grad1d", "\t% 12.8f", basis->Q1d, basis->P1d,
426                           basis->grad1d, stream); CeedChk(ierr);
427   } else {
428     fprintf(stream, "CeedBasis: dim=%d P=%d Q=%d\n", basis->dim, basis->P,
429             basis->Q);
430     ierr = CeedScalarView("qref", "\t% 12.8f", 1, basis->Q*basis->dim,
431                           basis->qref1d,
432                           stream); CeedChk(ierr);
433     ierr = CeedScalarView("qweight", "\t% 12.8f", 1, basis->Q, basis->qweight1d,
434                           stream); CeedChk(ierr);
435     ierr = CeedScalarView("interp", "\t% 12.8f", basis->Q, basis->P,
436                           basis->interp, stream); CeedChk(ierr);
437     ierr = CeedScalarView("grad", "\t% 12.8f", basis->dim*basis->Q, basis->P,
438                           basis->grad, stream); CeedChk(ierr);
439   }
440   return 0;
441 }
442 
443 /**
444   @brief Compute Householder reflection
445 
446     Computes A = (I - b v v^T) A
447     where A is an mxn matrix indexed as A[i*row + j*col]
448 
449   @param[in,out] A  Matrix to apply Householder reflection to, in place
450   @param v          Householder vector
451   @param b          Scaling factor
452   @param m          Number of rows in A
453   @param n          Number of columns in A
454   @param row        Row stride
455   @param col        Col stride
456 
457   @return An error code: 0 - success, otherwise - failure
458 
459   @ref Developer
460 **/
461 static int CeedHouseholderReflect(CeedScalar *A, const CeedScalar *v,
462                                   CeedScalar b, CeedInt m, CeedInt n,
463                                   CeedInt row, CeedInt col) {
464   for (CeedInt j=0; j<n; j++) {
465     CeedScalar w = A[0*row + j*col];
466     for (CeedInt i=1; i<m; i++)
467       w += v[i] * A[i*row + j*col];
468     A[0*row + j*col] -= b * w;
469     for (CeedInt i=1; i<m; i++)
470       A[i*row + j*col] -= b * w * v[i];
471   }
472   return 0;
473 }
474 
475 /**
476   @brief Apply Householder Q matrix
477 
478     Compute A = Q A where Q is mxm and A is mxn.
479 
480   @param[in,out] A  Matrix to apply Householder Q to, in place
481   @param Q          Householder Q matrix
482   @param tau        Householder scaling factors
483   @param tmode      Transpose mode for application
484   @param m          Number of rows in A
485   @param n          Number of columns in A
486   @param k          Number of elementary reflectors in Q, k<m
487   @param row        Row stride in A
488   @param col        Col stride in A
489 
490   @return An error code: 0 - success, otherwise - failure
491 
492   @ref Developer
493 **/
494 static int CeedHouseholderApplyQ(CeedScalar *A, const CeedScalar *Q,
495                                  const CeedScalar *tau, CeedTransposeMode tmode,
496                                  CeedInt m, CeedInt n, CeedInt k,
497                                  CeedInt row, CeedInt col) {
498   CeedScalar v[m];
499   for (CeedInt ii=0; ii<k; ii++) {
500     CeedInt i = tmode == CEED_TRANSPOSE ? ii : k-1-ii;
501     for (CeedInt j=i+1; j<m; j++)
502       v[j] = Q[j*k+i];
503     // Apply Householder reflector (I - tau v v^T) collograd1d^T
504     CeedHouseholderReflect(&A[i*row], &v[i], tau[i], m-i, n, row, col);
505   }
506   return 0;
507 }
508 
509 /**
510   @brief Compute Givens rotation
511 
512     Computes A = G A (or G^T A in transpose mode)
513     where A is an mxn matrix indexed as A[i*n + j*m]
514 
515   @param[in,out] A  Row major matrix to apply Givens rotation to, in place
516   @param c          Cosine factor
517   @param s          Sine factor
518   @param i          First row/column to apply rotation
519   @param k          Second row/column to apply rotation
520   @param m          Number of rows in A
521   @param n          Number of columns in A
522 
523   @return An error code: 0 - success, otherwise - failure
524 
525   @ref Developer
526 **/
527 static int CeedGivensRotation(CeedScalar *A, CeedScalar c, CeedScalar s,
528                               CeedTransposeMode tmode, CeedInt i, CeedInt k,
529                               CeedInt m, CeedInt n) {
530   CeedInt stridej = 1, strideik = m, numits = n;
531   if (tmode == CEED_NOTRANSPOSE) {
532     stridej = n; strideik = 1; numits = m;
533   }
534 
535   // Apply rotation
536   for (CeedInt j=0; j<numits; j++) {
537     CeedScalar tau1 = A[i*strideik+j*stridej], tau2 = A[k*strideik+j*stridej];
538     A[i*strideik+j*stridej] = c*tau1 - s*tau2;
539     A[k*strideik+j*stridej] = s*tau1 + c*tau2;
540   }
541 
542   return 0;
543 }
544 
545 /**
546   @brief Return QR Factorization of a matrix
547 
548   @param ceed         A Ceed context for error handling
549   @param[in,out] mat  Row-major matrix to be factorized in place
550   @param[in,out] tau  Vector of length m of scaling factors
551   @param m            Number of rows
552   @param n            Number of columns
553 
554   @return An error code: 0 - success, otherwise - failure
555 
556   @ref Utility
557 **/
558 int CeedQRFactorization(Ceed ceed, CeedScalar *mat, CeedScalar *tau,
559                         CeedInt m, CeedInt n) {
560   CeedScalar v[m];
561 
562   // Check m >= n
563   if (n > m)
564     // LCOV_EXCL_START
565     return CeedError(ceed, 1, "Cannot compute QR factorization with n > m");
566   // LCOV_EXCL_STOP
567 
568   for (CeedInt i=0; i<n; i++) {
569     // Calculate Householder vector, magnitude
570     CeedScalar sigma = 0.0;
571     v[i] = mat[i+n*i];
572     for (CeedInt j=i+1; j<m; j++) {
573       v[j] = mat[i+n*j];
574       sigma += v[j] * v[j];
575     }
576     CeedScalar norm = sqrt(v[i]*v[i] + sigma); // norm of v[i:m]
577     CeedScalar Rii = -copysign(norm, v[i]);
578     v[i] -= Rii;
579     // norm of v[i:m] after modification above and scaling below
580     //   norm = sqrt(v[i]*v[i] + sigma) / v[i];
581     //   tau = 2 / (norm*norm)
582     tau[i] = 2 * v[i]*v[i] / (v[i]*v[i] + sigma);
583 
584     for (CeedInt j=i+1; j<m; j++)
585       v[j] /= v[i];
586 
587     // Apply Householder reflector to lower right panel
588     CeedHouseholderReflect(&mat[i*n+i+1], &v[i], tau[i], m-i, n-i-1, n, 1);
589     // Save v
590     mat[i+n*i] = Rii;
591     for (CeedInt j=i+1; j<m; j++)
592       mat[i+n*j] = v[j];
593   }
594 
595   return 0;
596 }
597 
598 /**
599   @brief Return symmetric Schur decomposition of the symmetric matrix mat via
600            symmetric QR factorization
601 
602   @param ceed         A Ceed context for error handling
603   @param[in,out] mat  Row-major matrix to be factorized in place
604   @param[out] lambda  Vector of length n of eigenvalues
605   @param n            Number of rows/columns
606 
607   @return An error code: 0 - success, otherwise - failure
608 
609   @ref Utility
610 **/
611 int CeedSymmetricSchurDecomposition(Ceed ceed, CeedScalar *mat,
612                                     CeedScalar *lambda, CeedInt n) {
613   // Check bounds for clang-tidy
614   if (n<2)
615     // LCOV_EXCL_START
616     return CeedError(ceed, 1,
617                      "Cannot compute symmetric Schur decomposition of scalars");
618   // LCOV_EXCL_STOP
619 
620   CeedScalar v[n-1], tau[n-1], matT[n*n];
621 
622   // Copy mat to matT and set mat to I
623   memcpy(matT, mat, n*n*sizeof(mat[0]));
624   for (CeedInt i=0; i<n; i++)
625     for (CeedInt j=0; j<n; j++)
626       mat[j+n*i] = (i==j) ? 1 : 0;
627 
628   // Reduce to tridiagonal
629   for (CeedInt i=0; i<n-1; i++) {
630     // Calculate Householder vector, magnitude
631     CeedScalar sigma = 0.0;
632     v[i] = matT[i+n*(i+1)];
633     for (CeedInt j=i+1; j<n-1; j++) {
634       v[j] = matT[i+n*(j+1)];
635       sigma += v[j] * v[j];
636     }
637     CeedScalar norm = sqrt(v[i]*v[i] + sigma); // norm of v[i:n-1]
638     CeedScalar Rii = -copysign(norm, v[i]);
639     v[i] -= Rii;
640     // norm of v[i:m] after modification above and scaling below
641     //   norm = sqrt(v[i]*v[i] + sigma) / v[i];
642     //   tau = 2 / (norm*norm)
643     if (sigma > 10*CEED_EPSILON)
644       tau[i] = 2 * v[i]*v[i] / (v[i]*v[i] + sigma);
645     else
646       tau[i] = 0;
647 
648     for (CeedInt j=i+1; j<n-1; j++)
649       v[j] /= v[i];
650 
651     // Update sub and super diagonal
652     matT[i+n*(i+1)] = Rii;
653     matT[(i+1)+n*i] = Rii;
654     for (CeedInt j=i+2; j<n; j++) {
655       matT[i+n*j] = 0; matT[j+n*i] = 0;
656     }
657     // Apply symmetric Householder reflector to lower right panel
658     CeedHouseholderReflect(&matT[(i+1)+n*(i+1)], &v[i], tau[i],
659                            n-(i+1), n-(i+1), n, 1);
660     CeedHouseholderReflect(&matT[(i+1)+n*(i+1)], &v[i], tau[i],
661                            n-(i+1), n-(i+1), 1, n);
662     // Save v
663     for (CeedInt j=i+1; j<n-1; j++) {
664       matT[i+n*(j+1)] = v[j];
665     }
666   }
667   // Backwards accumulation of Q
668   for (CeedInt i=n-2; i>=0; i--) {
669     v[i] = 1;
670     for (CeedInt j=i+1; j<n-1; j++) {
671       v[j] = matT[i+n*(j+1)];
672       matT[i+n*(j+1)] = 0;
673     }
674     CeedHouseholderReflect(&mat[(i+1)+n*(i+1)], &v[i], tau[i],
675                            n-(i+1), n-(i+1), n, 1);
676   }
677 
678   // Reduce sub and super diagonal
679   CeedInt p = 0, q = 0, itr = 0, maxitr = n*n*n;
680   CeedScalar tol = 10*CEED_EPSILON;
681 
682   while (q < n && itr < maxitr) {
683     // Update p, q, size of reduced portions of diagonal
684     p = 0; q = 0;
685     for (CeedInt i=n-2; i>=0; i--) {
686       if (fabs(matT[i+n*(i+1)]) < tol)
687         q += 1;
688       else
689         break;
690     }
691     for (CeedInt i=0; i<n-1-q; i++) {
692       if (fabs(matT[i+n*(i+1)]) < tol)
693         p += 1;
694       else
695         break;
696     }
697     if (q == n-1) break; // Finished reducing
698 
699     // Reduce tridiagonal portion
700     CeedScalar tnn = matT[(n-1-q)+n*(n-1-q)],
701                tnnm1 = matT[(n-2-q)+n*(n-1-q)];
702     CeedScalar d = (matT[(n-2-q)+n*(n-2-q)] - tnn)/2;
703     CeedScalar mu = tnn - tnnm1*tnnm1 /
704                     (d + copysign(sqrt(d*d + tnnm1*tnnm1), d));
705     CeedScalar x = matT[p+n*p] - mu;
706     CeedScalar z = matT[p+n*(p+1)];
707     for (CeedInt k=p; k<n-1-q; k++) {
708       // Compute Givens rotation
709       CeedScalar c = 1, s = 0;
710       if (fabs(z) > tol) {
711         if (fabs(z) > fabs(x)) {
712           CeedScalar tau = -x/z;
713           s = 1/sqrt(1+tau*tau), c = s*tau;
714         } else {
715           CeedScalar tau = -z/x;
716           c = 1/sqrt(1+tau*tau), s = c*tau;
717         }
718       }
719 
720       // Apply Givens rotation to T
721       CeedGivensRotation(matT, c, s, CEED_NOTRANSPOSE, k, k+1, n, n);
722       CeedGivensRotation(matT, c, s, CEED_TRANSPOSE, k, k+1, n, n);
723 
724       // Apply Givens rotation to Q
725       CeedGivensRotation(mat, c, s, CEED_NOTRANSPOSE, k, k+1, n, n);
726 
727       // Update x, z
728       if (k < n-q-2) {
729         x = matT[k+n*(k+1)];
730         z = matT[k+n*(k+2)];
731       }
732     }
733     itr++;
734   }
735   // Save eigenvalues
736   for (CeedInt i=0; i<n; i++)
737     lambda[i] = matT[i+n*i];
738 
739   // Check convergence
740   if (itr == maxitr && q < n-1)
741     // LCOV_EXCL_START
742     return CeedError(ceed, 1, "Symmetric QR failed to converge");
743   // LCOV_EXCL_STOP
744 
745   return 0;
746 }
747 
748 /**
749   @brief Return a reference implementation of matrix multiplication C = A B.
750            Note, this is a reference implementation for CPU CeedScalar pointers
751            that is not intended for high performance.
752 
753   @param ceed         A Ceed context for error handling
754   @param[in] matA     Row-major matrix A
755   @param[in] matB     Row-major matrix B
756   @param[out] matC    Row-major output matrix C
757   @param m            Number of rows of C
758   @param n            Number of columns of C
759   @param kk           Number of columns of A/rows of B
760 
761   @return An error code: 0 - success, otherwise - failure
762 
763   @ref Utility
764 **/
765 int CeedMatrixMultiply(Ceed ceed, const CeedScalar *matA,
766                        const CeedScalar *matB, CeedScalar *matC, CeedInt m,
767                        CeedInt n, CeedInt kk) {
768   for (CeedInt i=0; i<m; i++)
769     for (CeedInt j=0; j<n; j++) {
770       CeedScalar sum = 0;
771       for (CeedInt k=0; k<kk; k++)
772         sum += matA[k+i*kk]*matB[j+k*n];
773       matC[j+i*n] = sum;
774     }
775   return 0;
776 }
777 
778 /**
779   @brief Return Simultaneous Diagonalization of two matrices. This solves the
780            generalized eigenvalue problem A x = lambda B x, where A and B
781            are symmetric and B is positive definite. We generate the matrix X
782            and vector Lambda such that X^T A X = Lambda and X^T B X = I. This
783            is equivalent to the LAPACK routine 'sygv' with TYPE = 1.
784 
785   @param ceed         A Ceed context for error handling
786   @param[in] matA     Row-major matrix to be factorized with eigenvalues
787   @param[in] matB     Row-major matrix to be factorized to identity
788   @param[out] x       Row-major orthogonal matrix
789   @param[out] lambda  Vector of length n of generalized eigenvalues
790   @param n            Number of rows/columns
791 
792   @return An error code: 0 - success, otherwise - failure
793 
794   @ref Utility
795 **/
796 int CeedSimultaneousDiagonalization(Ceed ceed, CeedScalar *matA,
797                                     CeedScalar *matB, CeedScalar *x,
798                                     CeedScalar *lambda, CeedInt n) {
799   int ierr;
800   CeedScalar matC[n*n], matG[n*n], vecD[n];
801 
802   // Compute B = G D G^T
803   memcpy(matG, matB, n*n*sizeof(matB[0]));
804   ierr = CeedSymmetricSchurDecomposition(ceed, matG, vecD, n); CeedChk(ierr);
805   for (CeedInt i=0; i<n; i++)
806     vecD[i] = sqrt(vecD[i]);
807 
808   // Compute C = (G D^1/2)^-1 A (G D^1/2)^-T
809   //           = D^-1/2 G^T A G D^-1/2
810   for (CeedInt i=0; i<n; i++)
811     for (CeedInt j=0; j<n; j++)
812       matC[j+i*n] = matG[i+j*n] / vecD[i];
813   ierr = CeedMatrixMultiply(ceed, (const CeedScalar *)matC,
814                             (const CeedScalar *)matA, x, n, n, n);
815   CeedChk(ierr);
816   for (CeedInt i=0; i<n; i++)
817     for (CeedInt j=0; j<n; j++)
818       matG[j+i*n] = matG[j+i*n] / vecD[j];
819   ierr = CeedMatrixMultiply(ceed, (const CeedScalar *)x,
820                             (const CeedScalar *)matG, matC, n, n, n);
821   CeedChk(ierr);
822 
823   // Compute Q^T C Q = lambda
824   ierr = CeedSymmetricSchurDecomposition(ceed, matC, lambda, n); CeedChk(ierr);
825 
826   // Set x = (G D^1/2)^-T Q
827   //       = G D^-1/2 Q
828   ierr = CeedMatrixMultiply(ceed, (const CeedScalar *)matG,
829                             (const CeedScalar *)matC, x, n, n, n);
830   CeedChk(ierr);
831 
832   return 0;
833 }
834 
835 /**
836   @brief Return collocated grad matrix
837 
838   @param basis             CeedBasis
839   @param[out] collograd1d  Row-major (Q1d * Q1d) matrix expressing derivatives of
840                             basis functions at quadrature points
841 
842   @return An error code: 0 - success, otherwise - failure
843 
844   @ref Advanced
845 **/
846 int CeedBasisGetCollocatedGrad(CeedBasis basis, CeedScalar *collograd1d) {
847   int i, j, k;
848   Ceed ceed;
849   CeedInt ierr, P1d=(basis)->P1d, Q1d=(basis)->Q1d;
850   CeedScalar *interp1d, *grad1d, tau[Q1d];
851 
852   ierr = CeedMalloc(Q1d*P1d, &interp1d); CeedChk(ierr);
853   ierr = CeedMalloc(Q1d*P1d, &grad1d); CeedChk(ierr);
854   memcpy(interp1d, (basis)->interp1d, Q1d*P1d*sizeof(basis)->interp1d[0]);
855   memcpy(grad1d, (basis)->grad1d, Q1d*P1d*sizeof(basis)->interp1d[0]);
856 
857   // QR Factorization, interp1d = Q R
858   ierr = CeedBasisGetCeed(basis, &ceed); CeedChk(ierr);
859   ierr = CeedQRFactorization(ceed, interp1d, tau, Q1d, P1d); CeedChk(ierr);
860 
861   // Apply Rinv, collograd1d = grad1d Rinv
862   for (i=0; i<Q1d; i++) { // Row i
863     collograd1d[Q1d*i] = grad1d[P1d*i]/interp1d[0];
864     for (j=1; j<P1d; j++) { // Column j
865       collograd1d[j+Q1d*i] = grad1d[j+P1d*i];
866       for (k=0; k<j; k++)
867         collograd1d[j+Q1d*i] -= interp1d[j+P1d*k]*collograd1d[k+Q1d*i];
868       collograd1d[j+Q1d*i] /= interp1d[j+P1d*j];
869     }
870     for (j=P1d; j<Q1d; j++)
871       collograd1d[j+Q1d*i] = 0;
872   }
873 
874   // Apply Qtranspose, collograd = collograd Qtranspose
875   CeedHouseholderApplyQ(collograd1d, interp1d, tau, CEED_NOTRANSPOSE,
876                         Q1d, Q1d, P1d, 1, Q1d);
877 
878   ierr = CeedFree(&interp1d); CeedChk(ierr);
879   ierr = CeedFree(&grad1d); CeedChk(ierr);
880 
881   return 0;
882 }
883 
884 /**
885   @brief Apply basis evaluation from nodes to quadrature points or vice versa
886 
887   @param basis   CeedBasis to evaluate
888   @param nelem   The number of elements to apply the basis evaluation to;
889                    the backend will specify the ordering in
890                    ElemRestrictionCreateBlocked
891   @param tmode   \ref CEED_NOTRANSPOSE to evaluate from nodes to quadrature
892                    points, \ref CEED_TRANSPOSE to apply the transpose, mapping
893                    from quadrature points to nodes
894   @param emode   \ref CEED_EVAL_NONE to use values directly,
895                    \ref CEED_EVAL_INTERP to use interpolated values,
896                    \ref CEED_EVAL_GRAD to use gradients,
897                    \ref CEED_EVAL_WEIGHT to use quadrature weights.
898   @param[in] u   Input CeedVector
899   @param[out] v  Output CeedVector
900 
901   @return An error code: 0 - success, otherwise - failure
902 
903   @ref Advanced
904 **/
905 int CeedBasisApply(CeedBasis basis, CeedInt nelem, CeedTransposeMode tmode,
906                    CeedEvalMode emode, CeedVector u, CeedVector v) {
907   int ierr;
908   CeedInt ulength = 0, vlength, nnodes, nqpt;
909   if (!basis->Apply)
910     // LCOV_EXCL_START
911     return CeedError(basis->ceed, 1, "Backend does not support BasisApply");
912   // LCOV_EXCL_STOP
913 
914   // Check compatibility of topological and geometrical dimensions
915   ierr = CeedBasisGetNumNodes(basis, &nnodes); CeedChk(ierr);
916   ierr = CeedBasisGetNumQuadraturePoints(basis, &nqpt); CeedChk(ierr);
917   ierr = CeedVectorGetLength(v, &vlength); CeedChk(ierr);
918 
919   if (u) {
920     ierr = CeedVectorGetLength(u, &ulength); CeedChk(ierr);
921   }
922 
923   if ((tmode == CEED_TRANSPOSE && (vlength%nnodes != 0 || ulength%nqpt != 0)) ||
924       (tmode == CEED_NOTRANSPOSE && (ulength%nnodes != 0 || vlength%nqpt != 0)))
925     return CeedError(basis->ceed, 1, "Length of input/output vectors "
926                      "incompatible with basis dimensions");
927 
928   ierr = basis->Apply(basis, nelem, tmode, emode, u, v); CeedChk(ierr);
929   return 0;
930 }
931 
932 /**
933   @brief Get Ceed associated with a CeedBasis
934 
935   @param basis      CeedBasis
936   @param[out] ceed  Variable to store Ceed
937 
938   @return An error code: 0 - success, otherwise - failure
939 
940   @ref Advanced
941 **/
942 int CeedBasisGetCeed(CeedBasis basis, Ceed *ceed) {
943   *ceed = basis->ceed;
944   return 0;
945 };
946 
947 /**
948   @brief Get dimension for given CeedBasis
949 
950   @param basis     CeedBasis
951   @param[out] dim  Variable to store dimension of basis
952 
953   @return An error code: 0 - success, otherwise - failure
954 
955   @ref Advanced
956 **/
957 int CeedBasisGetDimension(CeedBasis basis, CeedInt *dim) {
958   *dim = basis->dim;
959   return 0;
960 };
961 
962 /**
963   @brief Get tensor status for given CeedBasis
964 
965   @param basis        CeedBasis
966   @param[out] tensor  Variable to store tensor status
967 
968   @return An error code: 0 - success, otherwise - failure
969 
970   @ref Advanced
971 **/
972 int CeedBasisGetTensorStatus(CeedBasis basis, bool *tensor) {
973   *tensor = basis->tensorbasis;
974   return 0;
975 };
976 
977 /**
978   @brief Get number of components for given CeedBasis
979 
980   @param basis         CeedBasis
981   @param[out] numcomp  Variable to store number of components of basis
982 
983   @return An error code: 0 - success, otherwise - failure
984 
985   @ref Advanced
986 **/
987 int CeedBasisGetNumComponents(CeedBasis basis, CeedInt *numcomp) {
988   *numcomp = basis->ncomp;
989   return 0;
990 };
991 
992 /**
993   @brief Get total number of nodes (in 1 dimension) of a CeedBasis
994 
995   @param basis     CeedBasis
996   @param[out] P1d  Variable to store number of nodes
997 
998   @return An error code: 0 - success, otherwise - failure
999 
1000   @ref Advanced
1001 **/
1002 int CeedBasisGetNumNodes1D(CeedBasis basis, CeedInt *P1d) {
1003   if (!basis->tensorbasis)
1004     // LCOV_EXCL_START
1005     return CeedError(basis->ceed, 1, "Cannot supply P1d for non-tensor basis");
1006   // LCOV_EXCL_STOP
1007 
1008   *P1d = basis->P1d;
1009   return 0;
1010 }
1011 
1012 /**
1013   @brief Get total number of quadrature points (in 1 dimension) of a CeedBasis
1014 
1015   @param basis     CeedBasis
1016   @param[out] Q1d  Variable to store number of quadrature points
1017 
1018   @return An error code: 0 - success, otherwise - failure
1019 
1020   @ref Advanced
1021 **/
1022 int CeedBasisGetNumQuadraturePoints1D(CeedBasis basis, CeedInt *Q1d) {
1023   if (!basis->tensorbasis)
1024     // LCOV_EXCL_START
1025     return CeedError(basis->ceed, 1, "Cannot supply Q1d for non-tensor basis");
1026   // LCOV_EXCL_STOP
1027 
1028   *Q1d = basis->Q1d;
1029   return 0;
1030 }
1031 
1032 /**
1033   @brief Get total number of nodes (in dim dimensions) of a CeedBasis
1034 
1035   @param basis   CeedBasis
1036   @param[out] P  Variable to store number of nodes
1037 
1038   @return An error code: 0 - success, otherwise - failure
1039 
1040   @ref Utility
1041 **/
1042 int CeedBasisGetNumNodes(CeedBasis basis, CeedInt *P) {
1043   *P = basis->P;
1044   return 0;
1045 }
1046 
1047 /**
1048   @brief Get total number of quadrature points (in dim dimensions) of a CeedBasis
1049 
1050   @param basis   CeedBasis
1051   @param[out] Q  Variable to store number of quadrature points
1052 
1053   @return An error code: 0 - success, otherwise - failure
1054 
1055   @ref Utility
1056 **/
1057 int CeedBasisGetNumQuadraturePoints(CeedBasis basis, CeedInt *Q) {
1058   *Q = basis->Q;
1059   return 0;
1060 }
1061 
1062 /**
1063   @brief Get reference coordinates of quadrature points (in dim dimensions)
1064          of a CeedBasis
1065 
1066   @param basis      CeedBasis
1067   @param[out] qref  Variable to store reference coordinates of quadrature points
1068 
1069   @return An error code: 0 - success, otherwise - failure
1070 
1071   @ref Advanced
1072 **/
1073 int CeedBasisGetQRef(CeedBasis basis, CeedScalar **qref) {
1074   *qref = basis->qref1d;
1075   return 0;
1076 }
1077 
1078 /**
1079   @brief Get quadrature weights of quadrature points (in dim dimensions)
1080          of a CeedBasis
1081 
1082   @param basis         CeedBasis
1083   @param[out] qweight  Variable to store quadrature weights
1084 
1085   @return An error code: 0 - success, otherwise - failure
1086 
1087   @ref Advanced
1088 **/
1089 int CeedBasisGetQWeights(CeedBasis basis, CeedScalar **qweight) {
1090   *qweight = basis->qweight1d;
1091   return 0;
1092 }
1093 
1094 /**
1095   @brief Get interpolation matrix of a CeedBasis
1096 
1097   @param basis        CeedBasis
1098   @param[out] interp  Variable to store interpolation matrix
1099 
1100   @return An error code: 0 - success, otherwise - failure
1101 
1102   @ref Advanced
1103 **/
1104 int CeedBasisGetInterp(CeedBasis basis, CeedScalar **interp) {
1105   if (!basis->interp && basis->tensorbasis) {
1106     // Allocate
1107     int ierr;
1108     ierr = CeedMalloc(basis->Q*basis->P, &basis->interp); CeedChk(ierr);
1109 
1110     // Initialize
1111     for (CeedInt i=0; i<basis->Q*basis->P; i++)
1112       basis->interp[i] = 1.0;
1113 
1114     // Calculate
1115     for (CeedInt d=0; d<basis->dim; d++)
1116       for (CeedInt qpt=0; qpt<basis->Q; qpt++)
1117         for (CeedInt node=0; node<basis->P; node++) {
1118           CeedInt p = (node / CeedIntPow(basis->P1d, d)) % basis->P1d;
1119           CeedInt q = (qpt / CeedIntPow(basis->Q1d, d)) % basis->Q1d;
1120           basis->interp[qpt*(basis->P)+node] *= basis->interp1d[q*basis->P1d+p];
1121         }
1122   }
1123 
1124   *interp = basis->interp;
1125 
1126   return 0;
1127 }
1128 
1129 /**
1130   @brief Get 1D interpolation matrix of a tensor product CeedBasis
1131 
1132   @param basis          CeedBasis
1133   @param[out] interp1d  Variable to store interpolation matrix
1134 
1135   @return An error code: 0 - success, otherwise - failure
1136 
1137   @ref Advanced
1138 **/
1139 int CeedBasisGetInterp1D(CeedBasis basis, CeedScalar **interp1d) {
1140   if (!basis->tensorbasis)
1141     // LCOV_EXCL_START
1142     return CeedError(basis->ceed, 1, "CeedBasis is not a tensor product basis.");
1143   // LCOV_EXCL_STOP
1144 
1145   *interp1d = basis->interp1d;
1146 
1147   return 0;
1148 }
1149 
1150 /**
1151   @brief Get gradient matrix of a CeedBasis
1152 
1153   @param basis      CeedBasis
1154   @param[out] grad  Variable to store gradient matrix
1155 
1156   @return An error code: 0 - success, otherwise - failure
1157 
1158   @ref Advanced
1159 **/
1160 int CeedBasisGetGrad(CeedBasis basis, CeedScalar **grad) {
1161   if (!basis->grad && basis->tensorbasis) {
1162     // Allocate
1163     int ierr;
1164     ierr = CeedMalloc(basis->dim*basis->Q*basis->P, &basis->grad);
1165     CeedChk(ierr);
1166 
1167     // Initialize
1168     for (CeedInt i=0; i<basis->dim*basis->Q*basis->P; i++)
1169       basis->grad[i] = 1.0;
1170 
1171     // Calculate
1172     for (CeedInt d=0; d<basis->dim; d++)
1173       for (CeedInt i=0; i<basis->dim; i++)
1174         for (CeedInt qpt=0; qpt<basis->Q; qpt++)
1175           for (CeedInt node=0; node<basis->P; node++) {
1176             CeedInt p = (node / CeedIntPow(basis->P1d, d)) % basis->P1d;
1177             CeedInt q = (qpt / CeedIntPow(basis->Q1d, d)) % basis->Q1d;
1178             if (i == d)
1179               basis->grad[(i*basis->Q+qpt)*(basis->P)+node] *=
1180                 basis->grad1d[q*basis->P1d+p];
1181             else
1182               basis->grad[(i*basis->Q+qpt)*(basis->P)+node] *=
1183                 basis->interp1d[q*basis->P1d+p];
1184           }
1185   }
1186 
1187   *grad = basis->grad;
1188 
1189   return 0;
1190 }
1191 
1192 /**
1193   @brief Get 1D gradient matrix of a tensor product CeedBasis
1194 
1195   @param basis        CeedBasis
1196   @param[out] grad1d  Variable to store gradient matrix
1197 
1198   @return An error code: 0 - success, otherwise - failure
1199 
1200   @ref Advanced
1201 **/
1202 int CeedBasisGetGrad1D(CeedBasis basis, CeedScalar **grad1d) {
1203   if (!basis->tensorbasis)
1204     // LCOV_EXCL_START
1205     return CeedError(basis->ceed, 1, "CeedBasis is not a tensor product basis.");
1206   // LCOV_EXCL_STOP
1207 
1208   *grad1d = basis->grad1d;
1209 
1210   return 0;
1211 }
1212 
1213 /**
1214   @brief Get backend data of a CeedBasis
1215 
1216   @param basis      CeedBasis
1217   @param[out] data  Variable to store data
1218 
1219   @return An error code: 0 - success, otherwise - failure
1220 
1221   @ref Advanced
1222 **/
1223 int CeedBasisGetData(CeedBasis basis, void **data) {
1224   *data = basis->data;
1225   return 0;
1226 }
1227 
1228 /**
1229   @brief Set backend data of a CeedBasis
1230 
1231   @param[out] basis  CeedBasis
1232   @param data        Data to set
1233 
1234   @return An error code: 0 - success, otherwise - failure
1235 
1236   @ref Advanced
1237 **/
1238 int CeedBasisSetData(CeedBasis basis, void **data) {
1239   basis->data = *data;
1240   return 0;
1241 }
1242 
1243 /**
1244   @brief Get CeedTensorContract of a CeedBasis
1245 
1246   @param basis          CeedBasis
1247   @param[out] contract  Variable to store CeedTensorContract
1248 
1249   @return An error code: 0 - success, otherwise - failure
1250 
1251   @ref Advanced
1252 **/
1253 int CeedBasisGetTensorContract(CeedBasis basis, CeedTensorContract *contract) {
1254   *contract = basis->contract;
1255   return 0;
1256 }
1257 
1258 /**
1259   @brief Set CeedTensorContract of a CeedBasis
1260 
1261   @param[out] basis     CeedBasis
1262   @param contract       CeedTensorContract to set
1263 
1264   @return An error code: 0 - success, otherwise - failure
1265 
1266   @ref Advanced
1267 **/
1268 int CeedBasisSetTensorContract(CeedBasis basis, CeedTensorContract *contract) {
1269   basis->contract = *contract;
1270   return 0;
1271 }
1272 
1273 /**
1274   @brief Get dimension for given CeedElemTopology
1275 
1276   @param topo      CeedElemTopology
1277   @param[out] dim  Variable to store dimension of topology
1278 
1279   @return An error code: 0 - success, otherwise - failure
1280 
1281   @ref Advanced
1282 **/
1283 int CeedBasisGetTopologyDimension(CeedElemTopology topo, CeedInt *dim) {
1284   *dim = (CeedInt) topo >> 16;
1285   return 0;
1286 };
1287 
1288 /**
1289   @brief Destroy a CeedBasis
1290 
1291   @param basis CeedBasis to destroy
1292 
1293   @return An error code: 0 - success, otherwise - failure
1294 
1295   @ref Basic
1296 **/
1297 int CeedBasisDestroy(CeedBasis *basis) {
1298   int ierr;
1299 
1300   if (!*basis || --(*basis)->refcount > 0)
1301     return 0;
1302   if ((*basis)->Destroy) {
1303     ierr = (*basis)->Destroy(*basis); CeedChk(ierr);
1304   }
1305   ierr = CeedFree(&(*basis)->interp); CeedChk(ierr);
1306   ierr = CeedFree(&(*basis)->interp1d); CeedChk(ierr);
1307   ierr = CeedFree(&(*basis)->grad); CeedChk(ierr);
1308   ierr = CeedFree(&(*basis)->grad1d); CeedChk(ierr);
1309   ierr = CeedFree(&(*basis)->qref1d); CeedChk(ierr);
1310   ierr = CeedFree(&(*basis)->qweight1d); CeedChk(ierr);
1311   ierr = CeedDestroy(&(*basis)->ceed); CeedChk(ierr);
1312   ierr = CeedFree(basis); CeedChk(ierr);
1313   return 0;
1314 }
1315 
1316 /// @cond DOXYGEN_SKIP
1317 // Indicate that the quadrature points are collocated with the nodes
1318 CeedBasis CEED_BASIS_COLLOCATED = &ceed_basis_collocated;
1319 /// @endcond
1320 /// @}
1321