xref: /libCEED/interface/ceed-basis.c (revision 953190f450113a41d1c5f7c88cc0572afc0b7241)
1 // Copyright (c) 2017-2022, Lawrence Livermore National Security, LLC and other CEED contributors.
2 // All Rights Reserved. See the top-level LICENSE and NOTICE files for details.
3 //
4 // SPDX-License-Identifier: BSD-2-Clause
5 //
6 // This file is part of CEED:  http://github.com/ceed
7 
8 #include <ceed-impl.h>
9 #include <ceed.h>
10 #include <ceed/backend.h>
11 #include <math.h>
12 #include <stdbool.h>
13 #include <stdio.h>
14 #include <string.h>
15 
16 /// @file
17 /// Implementation of CeedBasis interfaces
18 
19 /// @cond DOXYGEN_SKIP
20 static struct CeedBasis_private ceed_basis_none;
21 /// @endcond
22 
23 /// @addtogroup CeedBasisUser
24 /// @{
25 
26 /// Argument for CeedOperatorSetField indicating that the field does not require a CeedBasis
27 const CeedBasis CEED_BASIS_NONE = &ceed_basis_none;
28 
29 /// This feature will be removed. Use CEED_BASIS_NONE.
30 const CeedBasis CEED_BASIS_COLLOCATED = &ceed_basis_none;
31 
32 /// @}
33 
34 /// ----------------------------------------------------------------------------
35 /// CeedBasis Library Internal Functions
36 /// ----------------------------------------------------------------------------
37 /// @addtogroup CeedBasisDeveloper
38 /// @{
39 
40 /**
41   @brief Compute Chebyshev polynomial values at a point
42 
43   @param[in]  x           Coordinate to evaluate Chebyshev polynomials at
44   @param[in]  n           Number of Chebyshev polynomials to evaluate, n >= 2
45   @param[out] chebyshev_x Array of Chebyshev polynomial values
46 
47   @return An error code: 0 - success, otherwise - failure
48 
49   @ref Developer
50 **/
51 static int CeedChebyshevPolynomialsAtPoint(CeedScalar x, CeedInt n, CeedScalar *chebyshev_x) {
52   chebyshev_x[0] = 1.0;
53   chebyshev_x[1] = 2 * x;
54   for (CeedInt i = 2; i < n; i++) chebyshev_x[i] = 2 * x * chebyshev_x[i - 1] - chebyshev_x[i - 2];
55   return CEED_ERROR_SUCCESS;
56 }
57 
58 /**
59   @brief Compute values of the derivative of Chebyshev polynomials at a point
60 
61   @param[in]  x            Coordinate to evaluate derivative of Chebyshev polynomials at
62   @param[in]  n            Number of Chebyshev polynomials to evaluate, n >= 2
63   @param[out] chebyshev_dx Array of Chebyshev polynomial derivative values
64 
65   @return An error code: 0 - success, otherwise - failure
66 
67   @ref Developer
68 **/
69 static int CeedChebyshevDerivativeAtPoint(CeedScalar x, CeedInt n, CeedScalar *chebyshev_dx) {
70   CeedScalar chebyshev_x[3];
71 
72   chebyshev_x[1]  = 1.0;
73   chebyshev_x[2]  = 2 * x;
74   chebyshev_dx[0] = 0.0;
75   chebyshev_dx[1] = 2.0;
76   for (CeedInt i = 2; i < n; i++) {
77     chebyshev_x[0]  = chebyshev_x[1];
78     chebyshev_x[1]  = chebyshev_x[2];
79     chebyshev_x[2]  = 2 * x * chebyshev_x[1] - chebyshev_x[0];
80     chebyshev_dx[i] = 2 * x * chebyshev_dx[i - 1] + 2 * chebyshev_x[1] - chebyshev_dx[i - 2];
81   }
82   return CEED_ERROR_SUCCESS;
83 }
84 
85 /**
86   @brief Compute Householder reflection
87 
88   Computes A = (I - b v v^T) A, where A is an mxn matrix indexed as A[i*row + j*col]
89 
90   @param[in,out] A   Matrix to apply Householder reflection to, in place
91   @param[in]     v   Householder vector
92   @param[in]     b   Scaling factor
93   @param[in]     m   Number of rows in A
94   @param[in]     n   Number of columns in A
95   @param[in]     row Row stride
96   @param[in]     col Col stride
97 
98   @return An error code: 0 - success, otherwise - failure
99 
100   @ref Developer
101 **/
102 static int CeedHouseholderReflect(CeedScalar *A, const CeedScalar *v, CeedScalar b, CeedInt m, CeedInt n, CeedInt row, CeedInt col) {
103   for (CeedInt j = 0; j < n; j++) {
104     CeedScalar w = A[0 * row + j * col];
105 
106     for (CeedInt i = 1; i < m; i++) w += v[i] * A[i * row + j * col];
107     A[0 * row + j * col] -= b * w;
108     for (CeedInt i = 1; i < m; i++) A[i * row + j * col] -= b * w * v[i];
109   }
110   return CEED_ERROR_SUCCESS;
111 }
112 
113 /**
114   @brief Compute Givens rotation
115 
116   Computes A = G A (or G^T A in transpose mode), where A is an mxn matrix indexed as A[i*n + j*m]
117 
118   @param[in,out] A      Row major matrix to apply Givens rotation to, in place
119   @param[in]     c      Cosine factor
120   @param[in]     s      Sine factor
121   @param[in]     t_mode @ref CEED_NOTRANSPOSE to rotate the basis counter-clockwise, which has the effect of rotating columns of A clockwise;
122                           @ref CEED_TRANSPOSE for the opposite rotation
123   @param[in]     i      First row/column to apply rotation
124   @param[in]     k      Second row/column to apply rotation
125   @param[in]     m      Number of rows in A
126   @param[in]     n      Number of columns in A
127 
128   @return An error code: 0 - success, otherwise - failure
129 
130   @ref Developer
131 **/
132 static int CeedGivensRotation(CeedScalar *A, CeedScalar c, CeedScalar s, CeedTransposeMode t_mode, CeedInt i, CeedInt k, CeedInt m, CeedInt n) {
133   CeedInt stride_j = 1, stride_ik = m, num_its = n;
134 
135   if (t_mode == CEED_NOTRANSPOSE) {
136     stride_j  = n;
137     stride_ik = 1;
138     num_its   = m;
139   }
140 
141   // Apply rotation
142   for (CeedInt j = 0; j < num_its; j++) {
143     CeedScalar tau1 = A[i * stride_ik + j * stride_j], tau2 = A[k * stride_ik + j * stride_j];
144 
145     A[i * stride_ik + j * stride_j] = c * tau1 - s * tau2;
146     A[k * stride_ik + j * stride_j] = s * tau1 + c * tau2;
147   }
148   return CEED_ERROR_SUCCESS;
149 }
150 
151 /**
152   @brief View an array stored in a CeedBasis
153 
154   @param[in] name   Name of array
155   @param[in] fp_fmt Printing format
156   @param[in] m      Number of rows in array
157   @param[in] n      Number of columns in array
158   @param[in] a      Array to be viewed
159   @param[in] stream Stream to view to, e.g., stdout
160 
161   @return An error code: 0 - success, otherwise - failure
162 
163   @ref Developer
164 **/
165 static int CeedScalarView(const char *name, const char *fp_fmt, CeedInt m, CeedInt n, const CeedScalar *a, FILE *stream) {
166   if (m > 1) {
167     fprintf(stream, "  %s:\n", name);
168   } else {
169     char padded_name[12];
170 
171     snprintf(padded_name, 11, "%s:", name);
172     fprintf(stream, "  %-10s", padded_name);
173   }
174   for (CeedInt i = 0; i < m; i++) {
175     if (m > 1) fprintf(stream, "    [%" CeedInt_FMT "]", i);
176     for (CeedInt j = 0; j < n; j++) fprintf(stream, fp_fmt, fabs(a[i * n + j]) > 1E-14 ? a[i * n + j] : 0);
177     fputs("\n", stream);
178   }
179   return CEED_ERROR_SUCCESS;
180 }
181 
182 /**
183   @brief Create the interpolation and gradient matrices for projection from the nodes of `basis_from` to the nodes of `basis_to`.
184 
185   The interpolation is given by `interp_project = interp_to^+ * interp_from`, where the pseudoinverse `interp_to^+` is given by QR factorization.
186   The gradient is given by `grad_project = interp_to^+ * grad_from`, and is only computed for H^1 spaces otherwise it should not be used.
187 
188   Note: `basis_from` and `basis_to` must have compatible quadrature spaces.
189 
190   @param[in]  basis_from     CeedBasis to project from
191   @param[in]  basis_to       CeedBasis to project to
192   @param[out] interp_project Address of the variable where the newly created interpolation matrix will be stored.
193   @param[out] grad_project   Address of the variable where the newly created gradient matrix will be stored.
194 
195   @return An error code: 0 - success, otherwise - failure
196 
197   @ref Developer
198 **/
199 static int CeedBasisCreateProjectionMatrices(CeedBasis basis_from, CeedBasis basis_to, CeedScalar **interp_project, CeedScalar **grad_project) {
200   Ceed    ceed;
201   bool    is_tensor_to, is_tensor_from;
202   CeedInt Q, Q_to, Q_from, P_to, P_from;
203 
204   CeedCall(CeedBasisGetCeed(basis_to, &ceed));
205 
206   // Check for compatible quadrature spaces
207   CeedCall(CeedBasisGetNumQuadraturePoints(basis_to, &Q_to));
208   CeedCall(CeedBasisGetNumQuadraturePoints(basis_from, &Q_from));
209   CeedCheck(Q_to == Q_from, ceed, CEED_ERROR_DIMENSION, "Bases must have compatible quadrature spaces");
210   Q = Q_to;
211 
212   // Check for matching tensor or non-tensor
213   CeedCall(CeedBasisIsTensor(basis_to, &is_tensor_to));
214   CeedCall(CeedBasisIsTensor(basis_from, &is_tensor_from));
215   CeedCheck(is_tensor_to == is_tensor_from, ceed, CEED_ERROR_MINOR, "Bases must both be tensor or non-tensor");
216   if (is_tensor_to) {
217     CeedCall(CeedBasisGetNumNodes1D(basis_to, &P_to));
218     CeedCall(CeedBasisGetNumNodes1D(basis_from, &P_from));
219     CeedCall(CeedBasisGetNumQuadraturePoints1D(basis_from, &Q));
220   } else {
221     CeedCall(CeedBasisGetNumNodes(basis_to, &P_to));
222     CeedCall(CeedBasisGetNumNodes(basis_from, &P_from));
223   }
224 
225   // Check for matching FE space
226   CeedFESpace fe_space_to, fe_space_from;
227   CeedCall(CeedBasisGetFESpace(basis_to, &fe_space_to));
228   CeedCall(CeedBasisGetFESpace(basis_from, &fe_space_from));
229   CeedCheck(fe_space_to == fe_space_from, ceed, CEED_ERROR_MINOR, "Bases must both be the same FE space type");
230 
231   // Get source matrices
232   CeedInt           dim, q_comp = 1;
233   CeedScalar       *interp_to, *interp_from, *tau;
234   const CeedScalar *interp_to_source = NULL, *interp_from_source = NULL, *grad_from_source = NULL;
235 
236   CeedCall(CeedBasisGetDimension(basis_to, &dim));
237   if (is_tensor_to) {
238     CeedCall(CeedBasisGetInterp1D(basis_to, &interp_to_source));
239     CeedCall(CeedBasisGetInterp1D(basis_from, &interp_from_source));
240   } else {
241     CeedCall(CeedBasisGetNumQuadratureComponents(basis_from, CEED_EVAL_INTERP, &q_comp));
242     CeedCall(CeedBasisGetInterp(basis_to, &interp_to_source));
243     CeedCall(CeedBasisGetInterp(basis_from, &interp_from_source));
244   }
245   CeedCall(CeedMalloc(Q * P_from * q_comp, &interp_from));
246   CeedCall(CeedMalloc(Q * P_to * q_comp, &interp_to));
247   CeedCall(CeedCalloc(P_to * P_from, interp_project));
248   CeedCall(CeedMalloc(Q * q_comp, &tau));
249 
250   // `grad_project = interp_to^+ * grad_from` is computed for the H^1 space case so the
251   // projection basis will have a gradient operation (allocated even if not H^1 for the
252   // basis construction later on)
253   if (fe_space_to == CEED_FE_SPACE_H1) {
254     if (is_tensor_to) {
255       CeedCall(CeedBasisGetGrad1D(basis_from, &grad_from_source));
256     } else {
257       CeedCall(CeedBasisGetGrad(basis_from, &grad_from_source));
258     }
259   }
260   CeedCall(CeedCalloc(P_to * P_from * (is_tensor_to ? 1 : dim), grad_project));
261 
262   // QR Factorization, interp_to = Q R
263   memcpy(interp_to, interp_to_source, Q * P_to * q_comp * sizeof(interp_to_source[0]));
264   CeedCall(CeedQRFactorization(ceed, interp_to, tau, Q * q_comp, P_to));
265 
266   // Build matrices
267   CeedInt     num_matrices = 1 + (fe_space_to == CEED_FE_SPACE_H1) * (is_tensor_to ? 1 : dim);
268   CeedScalar *input_from[num_matrices], *output_project[num_matrices];
269 
270   input_from[0]     = (CeedScalar *)interp_from_source;
271   output_project[0] = *interp_project;
272   for (CeedInt m = 1; m < num_matrices; m++) {
273     input_from[m]     = (CeedScalar *)&grad_from_source[(m - 1) * Q * P_from];
274     output_project[m] = &((*grad_project)[(m - 1) * P_to * P_from]);
275   }
276   for (CeedInt m = 0; m < num_matrices; m++) {
277     // Apply Q^T, interp_from = Q^T interp_from
278     memcpy(interp_from, input_from[m], Q * P_from * q_comp * sizeof(input_from[m][0]));
279     CeedCall(CeedHouseholderApplyQ(interp_from, interp_to, tau, CEED_TRANSPOSE, Q * q_comp, P_from, P_to, P_from, 1));
280 
281     // Apply Rinv, output_project = Rinv interp_from
282     for (CeedInt j = 0; j < P_from; j++) {  // Column j
283       output_project[m][j + P_from * (P_to - 1)] = interp_from[j + P_from * (P_to - 1)] / interp_to[P_to * P_to - 1];
284       for (CeedInt i = P_to - 2; i >= 0; i--) {  // Row i
285         output_project[m][j + P_from * i] = interp_from[j + P_from * i];
286         for (CeedInt k = i + 1; k < P_to; k++) {
287           output_project[m][j + P_from * i] -= interp_to[k + P_to * i] * output_project[m][j + P_from * k];
288         }
289         output_project[m][j + P_from * i] /= interp_to[i + P_to * i];
290       }
291     }
292   }
293 
294   // Cleanup
295   CeedCall(CeedFree(&tau));
296   CeedCall(CeedFree(&interp_to));
297   CeedCall(CeedFree(&interp_from));
298   return CEED_ERROR_SUCCESS;
299 }
300 
301 /// @}
302 
303 /// ----------------------------------------------------------------------------
304 /// Ceed Backend API
305 /// ----------------------------------------------------------------------------
306 /// @addtogroup CeedBasisBackend
307 /// @{
308 
309 /**
310   @brief Return collocated grad matrix
311 
312   @param[in]  basis         CeedBasis
313   @param[out] collo_grad_1d Row-major (Q_1d * Q_1d) matrix expressing derivatives of basis functions at quadrature points
314 
315   @return An error code: 0 - success, otherwise - failure
316 
317   @ref Backend
318 **/
319 int CeedBasisGetCollocatedGrad(CeedBasis basis, CeedScalar *collo_grad_1d) {
320   Ceed        ceed;
321   CeedInt     P_1d = (basis)->P_1d, Q_1d = (basis)->Q_1d;
322   CeedScalar *interp_1d, *grad_1d, *tau;
323 
324   CeedCall(CeedMalloc(Q_1d * P_1d, &interp_1d));
325   CeedCall(CeedMalloc(Q_1d * P_1d, &grad_1d));
326   CeedCall(CeedMalloc(Q_1d, &tau));
327   memcpy(interp_1d, (basis)->interp_1d, Q_1d * P_1d * sizeof(basis)->interp_1d[0]);
328   memcpy(grad_1d, (basis)->grad_1d, Q_1d * P_1d * sizeof(basis)->interp_1d[0]);
329 
330   // QR Factorization, interp_1d = Q R
331   CeedCall(CeedBasisGetCeed(basis, &ceed));
332   CeedCall(CeedQRFactorization(ceed, interp_1d, tau, Q_1d, P_1d));
333   // Note: This function is for backend use, so all errors are terminal and we do not need to clean up memory on failure.
334 
335   // Apply R_inv, collo_grad_1d = grad_1d R_inv
336   for (CeedInt i = 0; i < Q_1d; i++) {  // Row i
337     collo_grad_1d[Q_1d * i] = grad_1d[P_1d * i] / interp_1d[0];
338     for (CeedInt j = 1; j < P_1d; j++) {  // Column j
339       collo_grad_1d[j + Q_1d * i] = grad_1d[j + P_1d * i];
340       for (CeedInt k = 0; k < j; k++) collo_grad_1d[j + Q_1d * i] -= interp_1d[j + P_1d * k] * collo_grad_1d[k + Q_1d * i];
341       collo_grad_1d[j + Q_1d * i] /= interp_1d[j + P_1d * j];
342     }
343     for (CeedInt j = P_1d; j < Q_1d; j++) collo_grad_1d[j + Q_1d * i] = 0;
344   }
345 
346   // Apply Q^T, collo_grad_1d = collo_grad_1d Q^T
347   CeedCall(CeedHouseholderApplyQ(collo_grad_1d, interp_1d, tau, CEED_NOTRANSPOSE, Q_1d, Q_1d, P_1d, 1, Q_1d));
348 
349   CeedCall(CeedFree(&interp_1d));
350   CeedCall(CeedFree(&grad_1d));
351   CeedCall(CeedFree(&tau));
352   return CEED_ERROR_SUCCESS;
353 }
354 
355 /**
356   @brief Get tensor status for given CeedBasis
357 
358   @param[in]  basis     CeedBasis
359   @param[out] is_tensor Variable to store tensor status
360 
361   @return An error code: 0 - success, otherwise - failure
362 
363   @ref Backend
364 **/
365 int CeedBasisIsTensor(CeedBasis basis, bool *is_tensor) {
366   *is_tensor = basis->is_tensor_basis;
367   return CEED_ERROR_SUCCESS;
368 }
369 
370 /**
371   @brief Get backend data of a CeedBasis
372 
373   @param[in]  basis CeedBasis
374   @param[out] data  Variable to store data
375 
376   @return An error code: 0 - success, otherwise - failure
377 
378   @ref Backend
379 **/
380 int CeedBasisGetData(CeedBasis basis, void *data) {
381   *(void **)data = basis->data;
382   return CEED_ERROR_SUCCESS;
383 }
384 
385 /**
386   @brief Set backend data of a CeedBasis
387 
388   @param[in,out] basis  CeedBasis
389   @param[in]     data   Data to set
390 
391   @return An error code: 0 - success, otherwise - failure
392 
393   @ref Backend
394 **/
395 int CeedBasisSetData(CeedBasis basis, void *data) {
396   basis->data = data;
397   return CEED_ERROR_SUCCESS;
398 }
399 
400 /**
401   @brief Increment the reference counter for a CeedBasis
402 
403   @param[in,out] basis Basis to increment the reference counter
404 
405   @return An error code: 0 - success, otherwise - failure
406 
407   @ref Backend
408 **/
409 int CeedBasisReference(CeedBasis basis) {
410   basis->ref_count++;
411   return CEED_ERROR_SUCCESS;
412 }
413 
414 /**
415   @brief Get number of Q-vector components for given CeedBasis
416 
417   @param[in]  basis  CeedBasis
418   @param[in]  eval_mode \ref CEED_EVAL_INTERP to use interpolated values,
419                           \ref CEED_EVAL_GRAD to use gradients,
420                           \ref CEED_EVAL_DIV to use divergence,
421                           \ref CEED_EVAL_CURL to use curl.
422   @param[out] q_comp Variable to store number of Q-vector components of basis
423 
424   @return An error code: 0 - success, otherwise - failure
425 
426   @ref Backend
427 **/
428 int CeedBasisGetNumQuadratureComponents(CeedBasis basis, CeedEvalMode eval_mode, CeedInt *q_comp) {
429   switch (eval_mode) {
430     case CEED_EVAL_INTERP:
431       *q_comp = (basis->fe_space == CEED_FE_SPACE_H1) ? 1 : basis->dim;
432       break;
433     case CEED_EVAL_GRAD:
434       *q_comp = basis->dim;
435       break;
436     case CEED_EVAL_DIV:
437       *q_comp = 1;
438       break;
439     case CEED_EVAL_CURL:
440       *q_comp = (basis->dim < 3) ? 1 : basis->dim;
441       break;
442     case CEED_EVAL_NONE:
443     case CEED_EVAL_WEIGHT:
444       *q_comp = 1;
445       break;
446   }
447   return CEED_ERROR_SUCCESS;
448 }
449 
450 /**
451   @brief Estimate number of FLOPs required to apply CeedBasis in t_mode and eval_mode
452 
453   @param[in]  basis     Basis to estimate FLOPs for
454   @param[in]  t_mode    Apply basis or transpose
455   @param[in]  eval_mode Basis evaluation mode
456   @param[out] flops     Address of variable to hold FLOPs estimate
457 
458   @ref Backend
459 **/
460 int CeedBasisGetFlopsEstimate(CeedBasis basis, CeedTransposeMode t_mode, CeedEvalMode eval_mode, CeedSize *flops) {
461   bool is_tensor;
462 
463   CeedCall(CeedBasisIsTensor(basis, &is_tensor));
464   if (is_tensor) {
465     CeedInt dim, num_comp, P_1d, Q_1d;
466 
467     CeedCall(CeedBasisGetDimension(basis, &dim));
468     CeedCall(CeedBasisGetNumComponents(basis, &num_comp));
469     CeedCall(CeedBasisGetNumNodes1D(basis, &P_1d));
470     CeedCall(CeedBasisGetNumQuadraturePoints1D(basis, &Q_1d));
471     if (t_mode == CEED_TRANSPOSE) {
472       P_1d = Q_1d;
473       Q_1d = P_1d;
474     }
475     CeedInt tensor_flops = 0, pre = num_comp * CeedIntPow(P_1d, dim - 1), post = 1;
476     for (CeedInt d = 0; d < dim; d++) {
477       tensor_flops += 2 * pre * P_1d * post * Q_1d;
478       pre /= P_1d;
479       post *= Q_1d;
480     }
481     switch (eval_mode) {
482       case CEED_EVAL_NONE:
483         *flops = 0;
484         break;
485       case CEED_EVAL_INTERP:
486         *flops = tensor_flops;
487         break;
488       case CEED_EVAL_GRAD:
489         *flops = tensor_flops * 2;
490         break;
491       case CEED_EVAL_DIV:
492       case CEED_EVAL_CURL:
493         // LCOV_EXCL_START
494         return CeedError(basis->ceed, CEED_ERROR_INCOMPATIBLE, "Tensor basis evaluation for %s not supported", CeedEvalModes[eval_mode]);
495         break;
496       // LCOV_EXCL_STOP
497       case CEED_EVAL_WEIGHT:
498         *flops = dim * CeedIntPow(Q_1d, dim);
499         break;
500     }
501   } else {
502     CeedInt dim, num_comp, q_comp, num_nodes, num_qpts;
503 
504     CeedCall(CeedBasisGetDimension(basis, &dim));
505     CeedCall(CeedBasisGetNumComponents(basis, &num_comp));
506     CeedCall(CeedBasisGetNumQuadratureComponents(basis, eval_mode, &q_comp));
507     CeedCall(CeedBasisGetNumNodes(basis, &num_nodes));
508     CeedCall(CeedBasisGetNumQuadraturePoints(basis, &num_qpts));
509     switch (eval_mode) {
510       case CEED_EVAL_NONE:
511         *flops = 0;
512         break;
513       case CEED_EVAL_INTERP:
514       case CEED_EVAL_GRAD:
515       case CEED_EVAL_DIV:
516       case CEED_EVAL_CURL:
517         *flops = num_nodes * num_qpts * num_comp * q_comp;
518         break;
519       case CEED_EVAL_WEIGHT:
520         *flops = 0;
521         break;
522     }
523   }
524   return CEED_ERROR_SUCCESS;
525 }
526 
527 /**
528   @brief Get CeedFESpace for a CeedBasis
529 
530   @param[in]  basis     CeedBasis
531   @param[out] fe_space  Variable to store CeedFESpace
532 
533   @return An error code: 0 - success, otherwise - failure
534 
535   @ref Backend
536 **/
537 int CeedBasisGetFESpace(CeedBasis basis, CeedFESpace *fe_space) {
538   *fe_space = basis->fe_space;
539   return CEED_ERROR_SUCCESS;
540 }
541 
542 /**
543   @brief Get dimension for given CeedElemTopology
544 
545   @param[in]  topo CeedElemTopology
546   @param[out] dim  Variable to store dimension of topology
547 
548   @return An error code: 0 - success, otherwise - failure
549 
550   @ref Backend
551 **/
552 int CeedBasisGetTopologyDimension(CeedElemTopology topo, CeedInt *dim) {
553   *dim = (CeedInt)topo >> 16;
554   return CEED_ERROR_SUCCESS;
555 }
556 
557 /**
558   @brief Get CeedTensorContract of a CeedBasis
559 
560   @param[in]  basis     CeedBasis
561   @param[out] contract  Variable to store CeedTensorContract
562 
563   @return An error code: 0 - success, otherwise - failure
564 
565   @ref Backend
566 **/
567 int CeedBasisGetTensorContract(CeedBasis basis, CeedTensorContract *contract) {
568   *contract = basis->contract;
569   return CEED_ERROR_SUCCESS;
570 }
571 
572 /**
573   @brief Set CeedTensorContract of a CeedBasis
574 
575   @param[in,out] basis    CeedBasis
576   @param[in]     contract CeedTensorContract to set
577 
578   @return An error code: 0 - success, otherwise - failure
579 
580   @ref Backend
581 **/
582 int CeedBasisSetTensorContract(CeedBasis basis, CeedTensorContract contract) {
583   basis->contract = contract;
584   CeedCall(CeedTensorContractReference(contract));
585   return CEED_ERROR_SUCCESS;
586 }
587 
588 /**
589   @brief Return a reference implementation of matrix multiplication C = A B.
590 
591   Note: This is a reference implementation for CPU CeedScalar pointers that is not intended for high performance.
592 
593   @param[in]  ceed  Ceed context for error handling
594   @param[in]  mat_A Row-major matrix A
595   @param[in]  mat_B Row-major matrix B
596   @param[out] mat_C Row-major output matrix C
597   @param[in]  m     Number of rows of C
598   @param[in]  n     Number of columns of C
599   @param[in]  kk    Number of columns of A/rows of B
600 
601   @return An error code: 0 - success, otherwise - failure
602 
603   @ref Utility
604 **/
605 int CeedMatrixMatrixMultiply(Ceed ceed, const CeedScalar *mat_A, const CeedScalar *mat_B, CeedScalar *mat_C, CeedInt m, CeedInt n, CeedInt kk) {
606   for (CeedInt i = 0; i < m; i++) {
607     for (CeedInt j = 0; j < n; j++) {
608       CeedScalar sum = 0;
609 
610       for (CeedInt k = 0; k < kk; k++) sum += mat_A[k + i * kk] * mat_B[j + k * n];
611       mat_C[j + i * n] = sum;
612     }
613   }
614   return CEED_ERROR_SUCCESS;
615 }
616 
617 /**
618   @brief Return QR Factorization of a matrix
619 
620   @param[in]     ceed Ceed context for error handling
621   @param[in,out] mat  Row-major matrix to be factorized in place
622   @param[in,out] tau  Vector of length m of scaling factors
623   @param[in]     m    Number of rows
624   @param[in]     n    Number of columns
625 
626   @return An error code: 0 - success, otherwise - failure
627 
628   @ref Utility
629 **/
630 int CeedQRFactorization(Ceed ceed, CeedScalar *mat, CeedScalar *tau, CeedInt m, CeedInt n) {
631   CeedScalar v[m];
632 
633   // Check matrix shape
634   CeedCheck(n <= m, ceed, CEED_ERROR_UNSUPPORTED, "Cannot compute QR factorization with n > m");
635 
636   for (CeedInt i = 0; i < n; i++) {
637     CeedScalar sigma = 0.0;
638 
639     if (i >= m - 1) {  // last row of matrix, no reflection needed
640       tau[i] = 0.;
641       break;
642     }
643     // Calculate Householder vector, magnitude
644     v[i] = mat[i + n * i];
645     for (CeedInt j = i + 1; j < m; j++) {
646       v[j] = mat[i + n * j];
647       sigma += v[j] * v[j];
648     }
649     const CeedScalar norm = sqrt(v[i] * v[i] + sigma);  // norm of v[i:m]
650     const CeedScalar R_ii = -copysign(norm, v[i]);
651 
652     v[i] -= R_ii;
653     // norm of v[i:m] after modification above and scaling below
654     //   norm = sqrt(v[i]*v[i] + sigma) / v[i];
655     //   tau = 2 / (norm*norm)
656     tau[i] = 2 * v[i] * v[i] / (v[i] * v[i] + sigma);
657     for (CeedInt j = i + 1; j < m; j++) v[j] /= v[i];
658 
659     // Apply Householder reflector to lower right panel
660     CeedHouseholderReflect(&mat[i * n + i + 1], &v[i], tau[i], m - i, n - i - 1, n, 1);
661     // Save v
662     mat[i + n * i] = R_ii;
663     for (CeedInt j = i + 1; j < m; j++) mat[i + n * j] = v[j];
664   }
665   return CEED_ERROR_SUCCESS;
666 }
667 
668 /**
669   @brief Apply Householder Q matrix
670 
671   Compute mat_A = mat_Q mat_A, where mat_Q is mxm and mat_A is mxn.
672 
673   @param[in,out] mat_A  Matrix to apply Householder Q to, in place
674   @param[in]     mat_Q  Householder Q matrix
675   @param[in]     tau    Householder scaling factors
676   @param[in]     t_mode Transpose mode for application
677   @param[in]     m      Number of rows in A
678   @param[in]     n      Number of columns in A
679   @param[in]     k      Number of elementary reflectors in Q, k<m
680   @param[in]     row    Row stride in A
681   @param[in]     col    Col stride in A
682 
683   @return An error code: 0 - success, otherwise - failure
684 
685   @ref Utility
686 **/
687 int CeedHouseholderApplyQ(CeedScalar *mat_A, const CeedScalar *mat_Q, const CeedScalar *tau, CeedTransposeMode t_mode, CeedInt m, CeedInt n,
688                           CeedInt k, CeedInt row, CeedInt col) {
689   CeedScalar *v;
690 
691   CeedCall(CeedMalloc(m, &v));
692   for (CeedInt ii = 0; ii < k; ii++) {
693     CeedInt i = t_mode == CEED_TRANSPOSE ? ii : k - 1 - ii;
694     for (CeedInt j = i + 1; j < m; j++) v[j] = mat_Q[j * k + i];
695     // Apply Householder reflector (I - tau v v^T) collo_grad_1d^T
696     CeedCall(CeedHouseholderReflect(&mat_A[i * row], &v[i], tau[i], m - i, n, row, col));
697   }
698   CeedCall(CeedFree(&v));
699   return CEED_ERROR_SUCCESS;
700 }
701 
702 /**
703   @brief Return symmetric Schur decomposition of the symmetric matrix mat via symmetric QR factorization
704 
705   @param[in]     ceed   Ceed context for error handling
706   @param[in,out] mat    Row-major matrix to be factorized in place
707   @param[out]    lambda Vector of length n of eigenvalues
708   @param[in]     n      Number of rows/columns
709 
710   @return An error code: 0 - success, otherwise - failure
711 
712   @ref Utility
713 **/
714 CeedPragmaOptimizeOff
715 int CeedSymmetricSchurDecomposition(Ceed ceed, CeedScalar *mat, CeedScalar *lambda, CeedInt n) {
716   // Check bounds for clang-tidy
717   CeedCheck(n > 1, ceed, CEED_ERROR_UNSUPPORTED, "Cannot compute symmetric Schur decomposition of scalars");
718 
719   CeedScalar v[n - 1], tau[n - 1], mat_T[n * n];
720 
721   // Copy mat to mat_T and set mat to I
722   memcpy(mat_T, mat, n * n * sizeof(mat[0]));
723   for (CeedInt i = 0; i < n; i++) {
724     for (CeedInt j = 0; j < n; j++) mat[j + n * i] = (i == j) ? 1 : 0;
725   }
726 
727   // Reduce to tridiagonal
728   for (CeedInt i = 0; i < n - 1; i++) {
729     // Calculate Householder vector, magnitude
730     CeedScalar sigma = 0.0;
731 
732     v[i] = mat_T[i + n * (i + 1)];
733     for (CeedInt j = i + 1; j < n - 1; j++) {
734       v[j] = mat_T[i + n * (j + 1)];
735       sigma += v[j] * v[j];
736     }
737     const CeedScalar norm = sqrt(v[i] * v[i] + sigma);  // norm of v[i:n-1]
738     const CeedScalar R_ii = -copysign(norm, v[i]);
739 
740     v[i] -= R_ii;
741     // norm of v[i:m] after modification above and scaling below
742     //   norm = sqrt(v[i]*v[i] + sigma) / v[i];
743     //   tau = 2 / (norm*norm)
744     tau[i] = i == n - 2 ? 2 : 2 * v[i] * v[i] / (v[i] * v[i] + sigma);
745     for (CeedInt j = i + 1; j < n - 1; j++) v[j] /= v[i];
746 
747     // Update sub and super diagonal
748     for (CeedInt j = i + 2; j < n; j++) {
749       mat_T[i + n * j] = 0;
750       mat_T[j + n * i] = 0;
751     }
752     // Apply symmetric Householder reflector to lower right panel
753     CeedHouseholderReflect(&mat_T[(i + 1) + n * (i + 1)], &v[i], tau[i], n - (i + 1), n - (i + 1), n, 1);
754     CeedHouseholderReflect(&mat_T[(i + 1) + n * (i + 1)], &v[i], tau[i], n - (i + 1), n - (i + 1), 1, n);
755 
756     // Save v
757     mat_T[i + n * (i + 1)] = R_ii;
758     mat_T[(i + 1) + n * i] = R_ii;
759     for (CeedInt j = i + 1; j < n - 1; j++) {
760       mat_T[i + n * (j + 1)] = v[j];
761     }
762   }
763   // Backwards accumulation of Q
764   for (CeedInt i = n - 2; i >= 0; i--) {
765     if (tau[i] > 0.0) {
766       v[i] = 1;
767       for (CeedInt j = i + 1; j < n - 1; j++) {
768         v[j]                   = mat_T[i + n * (j + 1)];
769         mat_T[i + n * (j + 1)] = 0;
770       }
771       CeedHouseholderReflect(&mat[(i + 1) + n * (i + 1)], &v[i], tau[i], n - (i + 1), n - (i + 1), n, 1);
772     }
773   }
774 
775   // Reduce sub and super diagonal
776   CeedInt    p = 0, q = 0, itr = 0, max_itr = n * n * n * n;
777   CeedScalar tol = CEED_EPSILON;
778 
779   while (itr < max_itr) {
780     // Update p, q, size of reduced portions of diagonal
781     p = 0;
782     q = 0;
783     for (CeedInt i = n - 2; i >= 0; i--) {
784       if (fabs(mat_T[i + n * (i + 1)]) < tol) q += 1;
785       else break;
786     }
787     for (CeedInt i = 0; i < n - q - 1; i++) {
788       if (fabs(mat_T[i + n * (i + 1)]) < tol) p += 1;
789       else break;
790     }
791     if (q == n - 1) break;  // Finished reducing
792 
793     // Reduce tridiagonal portion
794     CeedScalar t_nn = mat_T[(n - 1 - q) + n * (n - 1 - q)], t_nnm1 = mat_T[(n - 2 - q) + n * (n - 1 - q)];
795     CeedScalar d  = (mat_T[(n - 2 - q) + n * (n - 2 - q)] - t_nn) / 2;
796     CeedScalar mu = t_nn - t_nnm1 * t_nnm1 / (d + copysign(sqrt(d * d + t_nnm1 * t_nnm1), d));
797     CeedScalar x  = mat_T[p + n * p] - mu;
798     CeedScalar z  = mat_T[p + n * (p + 1)];
799 
800     for (CeedInt k = p; k < n - q - 1; k++) {
801       // Compute Givens rotation
802       CeedScalar c = 1, s = 0;
803 
804       if (fabs(z) > tol) {
805         if (fabs(z) > fabs(x)) {
806           const CeedScalar tau = -x / z;
807 
808           s = 1 / sqrt(1 + tau * tau);
809           c = s * tau;
810         } else {
811           const CeedScalar tau = -z / x;
812 
813           c = 1 / sqrt(1 + tau * tau);
814           s = c * tau;
815         }
816       }
817 
818       // Apply Givens rotation to T
819       CeedGivensRotation(mat_T, c, s, CEED_NOTRANSPOSE, k, k + 1, n, n);
820       CeedGivensRotation(mat_T, c, s, CEED_TRANSPOSE, k, k + 1, n, n);
821 
822       // Apply Givens rotation to Q
823       CeedGivensRotation(mat, c, s, CEED_NOTRANSPOSE, k, k + 1, n, n);
824 
825       // Update x, z
826       if (k < n - q - 2) {
827         x = mat_T[k + n * (k + 1)];
828         z = mat_T[k + n * (k + 2)];
829       }
830     }
831     itr++;
832   }
833 
834   // Save eigenvalues
835   for (CeedInt i = 0; i < n; i++) lambda[i] = mat_T[i + n * i];
836 
837   // Check convergence
838   CeedCheck(itr < max_itr || q > n, ceed, CEED_ERROR_MINOR, "Symmetric QR failed to converge");
839   return CEED_ERROR_SUCCESS;
840 }
841 CeedPragmaOptimizeOn
842 
843 /**
844   @brief Return Simultaneous Diagonalization of two matrices.
845 
846   This solves the generalized eigenvalue problem A x = lambda B x, where A and B are symmetric and B is positive definite.
847   We generate the matrix X and vector Lambda such that X^T A X = Lambda and X^T B X = I.
848   This is equivalent to the LAPACK routine 'sygv' with TYPE = 1.
849 
850   @param[in]  ceed   Ceed context for error handling
851   @param[in]  mat_A  Row-major matrix to be factorized with eigenvalues
852   @param[in]  mat_B  Row-major matrix to be factorized to identity
853   @param[out] mat_X  Row-major orthogonal matrix
854   @param[out] lambda Vector of length n of generalized eigenvalues
855   @param[in]  n      Number of rows/columns
856 
857   @return An error code: 0 - success, otherwise - failure
858 
859   @ref Utility
860 **/
861 CeedPragmaOptimizeOff
862 int CeedSimultaneousDiagonalization(Ceed ceed, CeedScalar *mat_A, CeedScalar *mat_B, CeedScalar *mat_X, CeedScalar *lambda, CeedInt n) {
863   CeedScalar *mat_C, *mat_G, *vec_D;
864 
865   CeedCall(CeedCalloc(n * n, &mat_C));
866   CeedCall(CeedCalloc(n * n, &mat_G));
867   CeedCall(CeedCalloc(n, &vec_D));
868 
869   // Compute B = G D G^T
870   memcpy(mat_G, mat_B, n * n * sizeof(mat_B[0]));
871   CeedCall(CeedSymmetricSchurDecomposition(ceed, mat_G, vec_D, n));
872 
873   // Sort eigenvalues
874   for (CeedInt i = n - 1; i >= 0; i--) {
875     for (CeedInt j = 0; j < i; j++) {
876       if (fabs(vec_D[j]) > fabs(vec_D[j + 1])) {
877         CeedScalarSwap(vec_D[j], vec_D[j + 1]);
878         for (CeedInt k = 0; k < n; k++) CeedScalarSwap(mat_G[k * n + j], mat_G[k * n + j + 1]);
879       }
880     }
881   }
882 
883   // Compute C = (G D^1/2)^-1 A (G D^1/2)^-T
884   //           = D^-1/2 G^T A G D^-1/2
885   // -- D = D^-1/2
886   for (CeedInt i = 0; i < n; i++) vec_D[i] = 1. / sqrt(vec_D[i]);
887   // -- G = G D^-1/2
888   // -- C = D^-1/2 G^T
889   for (CeedInt i = 0; i < n; i++) {
890     for (CeedInt j = 0; j < n; j++) {
891       mat_G[i * n + j] *= vec_D[j];
892       mat_C[j * n + i] = mat_G[i * n + j];
893     }
894   }
895   // -- X = (D^-1/2 G^T) A
896   CeedCall(CeedMatrixMatrixMultiply(ceed, (const CeedScalar *)mat_C, (const CeedScalar *)mat_A, mat_X, n, n, n));
897   // -- C = (D^-1/2 G^T A) (G D^-1/2)
898   CeedCall(CeedMatrixMatrixMultiply(ceed, (const CeedScalar *)mat_X, (const CeedScalar *)mat_G, mat_C, n, n, n));
899 
900   // Compute Q^T C Q = lambda
901   CeedCall(CeedSymmetricSchurDecomposition(ceed, mat_C, lambda, n));
902 
903   // Sort eigenvalues
904   for (CeedInt i = n - 1; i >= 0; i--) {
905     for (CeedInt j = 0; j < i; j++) {
906       if (fabs(lambda[j]) > fabs(lambda[j + 1])) {
907         CeedScalarSwap(lambda[j], lambda[j + 1]);
908         for (CeedInt k = 0; k < n; k++) CeedScalarSwap(mat_C[k * n + j], mat_C[k * n + j + 1]);
909       }
910     }
911   }
912 
913   // Set X = (G D^1/2)^-T Q
914   //       = G D^-1/2 Q
915   CeedCall(CeedMatrixMatrixMultiply(ceed, (const CeedScalar *)mat_G, (const CeedScalar *)mat_C, mat_X, n, n, n));
916 
917   // Cleanup
918   CeedCall(CeedFree(&mat_C));
919   CeedCall(CeedFree(&mat_G));
920   CeedCall(CeedFree(&vec_D));
921   return CEED_ERROR_SUCCESS;
922 }
923 CeedPragmaOptimizeOn
924 
925 /// @}
926 
927 /// ----------------------------------------------------------------------------
928 /// CeedBasis Public API
929 /// ----------------------------------------------------------------------------
930 /// @addtogroup CeedBasisUser
931 /// @{
932 
933 /**
934   @brief Create a tensor-product basis for H^1 discretizations
935 
936   @param[in]  ceed        Ceed object where the CeedBasis will be created
937   @param[in]  dim         Topological dimension
938   @param[in]  num_comp    Number of field components (1 for scalar fields)
939   @param[in]  P_1d        Number of nodes in one dimension
940   @param[in]  Q_1d        Number of quadrature points in one dimension
941   @param[in]  interp_1d   Row-major (Q_1d * P_1d) matrix expressing the values of nodal basis functions at quadrature points
942   @param[in]  grad_1d     Row-major (Q_1d * P_1d) matrix expressing derivatives of nodal basis functions at quadrature points
943   @param[in]  q_ref_1d    Array of length Q_1d holding the locations of quadrature points on the 1D reference element [-1, 1]
944   @param[in]  q_weight_1d Array of length Q_1d holding the quadrature weights on the reference element
945   @param[out] basis       Address of the variable where the newly created CeedBasis will be stored.
946 
947   @return An error code: 0 - success, otherwise - failure
948 
949   @ref User
950 **/
951 int CeedBasisCreateTensorH1(Ceed ceed, CeedInt dim, CeedInt num_comp, CeedInt P_1d, CeedInt Q_1d, const CeedScalar *interp_1d,
952                             const CeedScalar *grad_1d, const CeedScalar *q_ref_1d, const CeedScalar *q_weight_1d, CeedBasis *basis) {
953   if (!ceed->BasisCreateTensorH1) {
954     Ceed delegate;
955 
956     CeedCall(CeedGetObjectDelegate(ceed, &delegate, "Basis"));
957     CeedCheck(delegate, ceed, CEED_ERROR_UNSUPPORTED, "Backend does not support BasisCreateTensorH1");
958     CeedCall(CeedBasisCreateTensorH1(delegate, dim, num_comp, P_1d, Q_1d, interp_1d, grad_1d, q_ref_1d, q_weight_1d, basis));
959     return CEED_ERROR_SUCCESS;
960   }
961 
962   CeedCheck(dim > 0, ceed, CEED_ERROR_DIMENSION, "Basis dimension must be a positive value");
963   CeedCheck(num_comp > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 component");
964   CeedCheck(P_1d > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 node");
965   CeedCheck(Q_1d > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 quadrature point");
966 
967   CeedElemTopology topo = dim == 1 ? CEED_TOPOLOGY_LINE : dim == 2 ? CEED_TOPOLOGY_QUAD : CEED_TOPOLOGY_HEX;
968 
969   CeedCall(CeedCalloc(1, basis));
970   CeedCall(CeedReferenceCopy(ceed, &(*basis)->ceed));
971   (*basis)->ref_count       = 1;
972   (*basis)->is_tensor_basis = true;
973   (*basis)->dim             = dim;
974   (*basis)->topo            = topo;
975   (*basis)->num_comp        = num_comp;
976   (*basis)->P_1d            = P_1d;
977   (*basis)->Q_1d            = Q_1d;
978   (*basis)->P               = CeedIntPow(P_1d, dim);
979   (*basis)->Q               = CeedIntPow(Q_1d, dim);
980   (*basis)->fe_space        = CEED_FE_SPACE_H1;
981   CeedCall(CeedCalloc(Q_1d, &(*basis)->q_ref_1d));
982   CeedCall(CeedCalloc(Q_1d, &(*basis)->q_weight_1d));
983   if (q_ref_1d) memcpy((*basis)->q_ref_1d, q_ref_1d, Q_1d * sizeof(q_ref_1d[0]));
984   if (q_weight_1d) memcpy((*basis)->q_weight_1d, q_weight_1d, Q_1d * sizeof(q_weight_1d[0]));
985   CeedCall(CeedCalloc(Q_1d * P_1d, &(*basis)->interp_1d));
986   CeedCall(CeedCalloc(Q_1d * P_1d, &(*basis)->grad_1d));
987   if (interp_1d) memcpy((*basis)->interp_1d, interp_1d, Q_1d * P_1d * sizeof(interp_1d[0]));
988   if (grad_1d) memcpy((*basis)->grad_1d, grad_1d, Q_1d * P_1d * sizeof(grad_1d[0]));
989   CeedCall(ceed->BasisCreateTensorH1(dim, P_1d, Q_1d, interp_1d, grad_1d, q_ref_1d, q_weight_1d, *basis));
990   return CEED_ERROR_SUCCESS;
991 }
992 
993 /**
994   @brief Create a tensor-product Lagrange basis
995 
996   @param[in]  ceed      Ceed object where the CeedBasis will be created
997   @param[in]  dim       Topological dimension of element
998   @param[in]  num_comp  Number of field components (1 for scalar fields)
999   @param[in]  P         Number of Gauss-Lobatto nodes in one dimension.
1000                           The polynomial degree of the resulting Q_k element is k=P-1.
1001   @param[in]  Q         Number of quadrature points in one dimension.
1002   @param[in]  quad_mode Distribution of the Q quadrature points (affects order of accuracy for the quadrature)
1003   @param[out] basis     Address of the variable where the newly created CeedBasis will be stored.
1004 
1005   @return An error code: 0 - success, otherwise - failure
1006 
1007   @ref User
1008 **/
1009 int CeedBasisCreateTensorH1Lagrange(Ceed ceed, CeedInt dim, CeedInt num_comp, CeedInt P, CeedInt Q, CeedQuadMode quad_mode, CeedBasis *basis) {
1010   // Allocate
1011   int        ierr = CEED_ERROR_SUCCESS;
1012   CeedScalar c1, c2, c3, c4, dx, *nodes, *interp_1d, *grad_1d, *q_ref_1d, *q_weight_1d;
1013 
1014   CeedCheck(dim > 0, ceed, CEED_ERROR_DIMENSION, "Basis dimension must be a positive value");
1015   CeedCheck(num_comp > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 component");
1016   CeedCheck(P > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 node");
1017   CeedCheck(Q > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 quadrature point");
1018 
1019   // Get Nodes and Weights
1020   CeedCall(CeedCalloc(P * Q, &interp_1d));
1021   CeedCall(CeedCalloc(P * Q, &grad_1d));
1022   CeedCall(CeedCalloc(P, &nodes));
1023   CeedCall(CeedCalloc(Q, &q_ref_1d));
1024   CeedCall(CeedCalloc(Q, &q_weight_1d));
1025   if (CeedLobattoQuadrature(P, nodes, NULL) != CEED_ERROR_SUCCESS) goto cleanup;
1026   switch (quad_mode) {
1027     case CEED_GAUSS:
1028       ierr = CeedGaussQuadrature(Q, q_ref_1d, q_weight_1d);
1029       break;
1030     case CEED_GAUSS_LOBATTO:
1031       ierr = CeedLobattoQuadrature(Q, q_ref_1d, q_weight_1d);
1032       break;
1033   }
1034   if (ierr != CEED_ERROR_SUCCESS) goto cleanup;
1035 
1036   // Build B, D matrix
1037   // Fornberg, 1998
1038   for (CeedInt i = 0; i < Q; i++) {
1039     c1                   = 1.0;
1040     c3                   = nodes[0] - q_ref_1d[i];
1041     interp_1d[i * P + 0] = 1.0;
1042     for (CeedInt j = 1; j < P; j++) {
1043       c2 = 1.0;
1044       c4 = c3;
1045       c3 = nodes[j] - q_ref_1d[i];
1046       for (CeedInt k = 0; k < j; k++) {
1047         dx = nodes[j] - nodes[k];
1048         c2 *= dx;
1049         if (k == j - 1) {
1050           grad_1d[i * P + j]   = c1 * (interp_1d[i * P + k] - c4 * grad_1d[i * P + k]) / c2;
1051           interp_1d[i * P + j] = -c1 * c4 * interp_1d[i * P + k] / c2;
1052         }
1053         grad_1d[i * P + k]   = (c3 * grad_1d[i * P + k] - interp_1d[i * P + k]) / dx;
1054         interp_1d[i * P + k] = c3 * interp_1d[i * P + k] / dx;
1055       }
1056       c1 = c2;
1057     }
1058   }
1059   // Pass to CeedBasisCreateTensorH1
1060   CeedCall(CeedBasisCreateTensorH1(ceed, dim, num_comp, P, Q, interp_1d, grad_1d, q_ref_1d, q_weight_1d, basis));
1061 cleanup:
1062   CeedCall(CeedFree(&interp_1d));
1063   CeedCall(CeedFree(&grad_1d));
1064   CeedCall(CeedFree(&nodes));
1065   CeedCall(CeedFree(&q_ref_1d));
1066   CeedCall(CeedFree(&q_weight_1d));
1067   return CEED_ERROR_SUCCESS;
1068 }
1069 
1070 /**
1071   @brief Create a non tensor-product basis for H^1 discretizations
1072 
1073   @param[in]  ceed      Ceed object where the CeedBasis will be created
1074   @param[in]  topo      Topology of element, e.g. hypercube, simplex, ect
1075   @param[in]  num_comp  Number of field components (1 for scalar fields)
1076   @param[in]  num_nodes Total number of nodes
1077   @param[in]  num_qpts  Total number of quadrature points
1078   @param[in]  interp    Row-major (num_qpts * num_nodes) matrix expressing the values of nodal basis functions at quadrature points
1079   @param[in]  grad      Row-major (dim * num_qpts * num_nodes) matrix expressing derivatives of nodal basis functions at quadrature points
1080   @param[in]  q_ref     Array of length num_qpts * dim holding the locations of quadrature points on the reference element
1081   @param[in]  q_weight  Array of length num_qpts holding the quadrature weights on the reference element
1082   @param[out] basis     Address of the variable where the newly created CeedBasis will be stored.
1083 
1084   @return An error code: 0 - success, otherwise - failure
1085 
1086   @ref User
1087 **/
1088 int CeedBasisCreateH1(Ceed ceed, CeedElemTopology topo, CeedInt num_comp, CeedInt num_nodes, CeedInt num_qpts, const CeedScalar *interp,
1089                       const CeedScalar *grad, const CeedScalar *q_ref, const CeedScalar *q_weight, CeedBasis *basis) {
1090   CeedInt P = num_nodes, Q = num_qpts, dim = 0;
1091 
1092   if (!ceed->BasisCreateH1) {
1093     Ceed delegate;
1094 
1095     CeedCall(CeedGetObjectDelegate(ceed, &delegate, "Basis"));
1096     CeedCheck(delegate, ceed, CEED_ERROR_UNSUPPORTED, "Backend does not support BasisCreateH1");
1097     CeedCall(CeedBasisCreateH1(delegate, topo, num_comp, num_nodes, num_qpts, interp, grad, q_ref, q_weight, basis));
1098     return CEED_ERROR_SUCCESS;
1099   }
1100 
1101   CeedCheck(num_comp > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 component");
1102   CeedCheck(num_nodes > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 node");
1103   CeedCheck(num_qpts > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 quadrature point");
1104 
1105   CeedCall(CeedBasisGetTopologyDimension(topo, &dim));
1106 
1107   CeedCall(CeedCalloc(1, basis));
1108   CeedCall(CeedReferenceCopy(ceed, &(*basis)->ceed));
1109   (*basis)->ref_count       = 1;
1110   (*basis)->is_tensor_basis = false;
1111   (*basis)->dim             = dim;
1112   (*basis)->topo            = topo;
1113   (*basis)->num_comp        = num_comp;
1114   (*basis)->P               = P;
1115   (*basis)->Q               = Q;
1116   (*basis)->fe_space        = CEED_FE_SPACE_H1;
1117   CeedCall(CeedCalloc(Q * dim, &(*basis)->q_ref_1d));
1118   CeedCall(CeedCalloc(Q, &(*basis)->q_weight_1d));
1119   if (q_ref) memcpy((*basis)->q_ref_1d, q_ref, Q * dim * sizeof(q_ref[0]));
1120   if (q_weight) memcpy((*basis)->q_weight_1d, q_weight, Q * sizeof(q_weight[0]));
1121   CeedCall(CeedCalloc(Q * P, &(*basis)->interp));
1122   CeedCall(CeedCalloc(dim * Q * P, &(*basis)->grad));
1123   if (interp) memcpy((*basis)->interp, interp, Q * P * sizeof(interp[0]));
1124   if (grad) memcpy((*basis)->grad, grad, dim * Q * P * sizeof(grad[0]));
1125   CeedCall(ceed->BasisCreateH1(topo, dim, P, Q, interp, grad, q_ref, q_weight, *basis));
1126   return CEED_ERROR_SUCCESS;
1127 }
1128 
1129 /**
1130   @brief Create a non tensor-product basis for \f$H(\mathrm{div})\f$ discretizations
1131 
1132   @param[in]  ceed      Ceed object where the CeedBasis will be created
1133   @param[in]  topo      Topology of element (`CEED_TOPOLOGY_QUAD`, `CEED_TOPOLOGY_PRISM`, etc.), dimension of which is used in some array sizes below
1134   @param[in]  num_comp  Number of components (usually 1 for vectors in H(div) bases)
1135   @param[in]  num_nodes Total number of nodes (dofs per element)
1136   @param[in]  num_qpts  Total number of quadrature points
1137   @param[in]  interp    Row-major (dim * num_qpts * num_nodes) matrix expressing the values of basis functions at quadrature points
1138   @param[in]  div       Row-major (num_qpts * num_nodes) matrix expressing divergence of basis functions at quadrature points
1139   @param[in]  q_ref     Array of length num_qpts * dim holding the locations of quadrature points on the reference element
1140   @param[in]  q_weight  Array of length num_qpts holding the quadrature weights on the reference element
1141   @param[out] basis     Address of the variable where the newly created CeedBasis will be stored.
1142 
1143   @return An error code: 0 - success, otherwise - failure
1144 
1145   @ref User
1146 **/
1147 int CeedBasisCreateHdiv(Ceed ceed, CeedElemTopology topo, CeedInt num_comp, CeedInt num_nodes, CeedInt num_qpts, const CeedScalar *interp,
1148                         const CeedScalar *div, const CeedScalar *q_ref, const CeedScalar *q_weight, CeedBasis *basis) {
1149   CeedInt Q = num_qpts, P = num_nodes, dim = 0;
1150 
1151   if (!ceed->BasisCreateHdiv) {
1152     Ceed delegate;
1153 
1154     CeedCall(CeedGetObjectDelegate(ceed, &delegate, "Basis"));
1155     CeedCheck(delegate, ceed, CEED_ERROR_UNSUPPORTED, "Backend does not implement BasisCreateHdiv");
1156     CeedCall(CeedBasisCreateHdiv(delegate, topo, num_comp, num_nodes, num_qpts, interp, div, q_ref, q_weight, basis));
1157     return CEED_ERROR_SUCCESS;
1158   }
1159 
1160   CeedCheck(num_comp > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 component");
1161   CeedCheck(num_nodes > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 node");
1162   CeedCheck(num_qpts > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 quadrature point");
1163 
1164   CeedCall(CeedBasisGetTopologyDimension(topo, &dim));
1165 
1166   CeedCall(CeedCalloc(1, basis));
1167   CeedCall(CeedReferenceCopy(ceed, &(*basis)->ceed));
1168   (*basis)->ref_count       = 1;
1169   (*basis)->is_tensor_basis = false;
1170   (*basis)->dim             = dim;
1171   (*basis)->topo            = topo;
1172   (*basis)->num_comp        = num_comp;
1173   (*basis)->P               = P;
1174   (*basis)->Q               = Q;
1175   (*basis)->fe_space        = CEED_FE_SPACE_HDIV;
1176   CeedCall(CeedMalloc(Q * dim, &(*basis)->q_ref_1d));
1177   CeedCall(CeedMalloc(Q, &(*basis)->q_weight_1d));
1178   if (q_ref) memcpy((*basis)->q_ref_1d, q_ref, Q * dim * sizeof(q_ref[0]));
1179   if (q_weight) memcpy((*basis)->q_weight_1d, q_weight, Q * sizeof(q_weight[0]));
1180   CeedCall(CeedMalloc(dim * Q * P, &(*basis)->interp));
1181   CeedCall(CeedMalloc(Q * P, &(*basis)->div));
1182   if (interp) memcpy((*basis)->interp, interp, dim * Q * P * sizeof(interp[0]));
1183   if (div) memcpy((*basis)->div, div, Q * P * sizeof(div[0]));
1184   CeedCall(ceed->BasisCreateHdiv(topo, dim, P, Q, interp, div, q_ref, q_weight, *basis));
1185   return CEED_ERROR_SUCCESS;
1186 }
1187 
1188 /**
1189   @brief Create a non tensor-product basis for \f$H(\mathrm{curl})\f$ discretizations
1190 
1191   @param[in]  ceed      Ceed object where the CeedBasis will be created
1192   @param[in]  topo      Topology of element (`CEED_TOPOLOGY_QUAD`, `CEED_TOPOLOGY_PRISM`, etc.), dimension of which is used in some array sizes below
1193   @param[in]  num_comp  Number of components (usually 1 for vectors in H(curl) bases)
1194   @param[in]  num_nodes Total number of nodes (dofs per element)
1195   @param[in]  num_qpts  Total number of quadrature points
1196   @param[in]  interp    Row-major (dim * num_qpts * num_nodes) matrix expressing the values of basis functions at quadrature points
1197   @param[in]  curl      Row-major (curl_comp * num_qpts * num_nodes, curl_comp = 1 if dim < 3 else dim) matrix expressing curl of basis functions at
1198 quadrature points
1199   @param[in]  q_ref     Array of length num_qpts * dim holding the locations of quadrature points on the reference element
1200   @param[in]  q_weight  Array of length num_qpts holding the quadrature weights on the reference element
1201   @param[out] basis     Address of the variable where the newly created CeedBasis will be stored.
1202 
1203   @return An error code: 0 - success, otherwise - failure
1204 
1205   @ref User
1206 **/
1207 int CeedBasisCreateHcurl(Ceed ceed, CeedElemTopology topo, CeedInt num_comp, CeedInt num_nodes, CeedInt num_qpts, const CeedScalar *interp,
1208                          const CeedScalar *curl, const CeedScalar *q_ref, const CeedScalar *q_weight, CeedBasis *basis) {
1209   CeedInt Q = num_qpts, P = num_nodes, dim = 0, curl_comp = 0;
1210 
1211   if (!ceed->BasisCreateHdiv) {
1212     Ceed delegate;
1213 
1214     CeedCall(CeedGetObjectDelegate(ceed, &delegate, "Basis"));
1215     CeedCheck(delegate, ceed, CEED_ERROR_UNSUPPORTED, "Backend does not implement BasisCreateHcurl");
1216     CeedCall(CeedBasisCreateHcurl(delegate, topo, num_comp, num_nodes, num_qpts, interp, curl, q_ref, q_weight, basis));
1217     return CEED_ERROR_SUCCESS;
1218   }
1219 
1220   CeedCheck(num_comp > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 component");
1221   CeedCheck(num_nodes > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 node");
1222   CeedCheck(num_qpts > 0, ceed, CEED_ERROR_DIMENSION, "Basis must have at least 1 quadrature point");
1223 
1224   CeedCall(CeedBasisGetTopologyDimension(topo, &dim));
1225   curl_comp = (dim < 3) ? 1 : dim;
1226 
1227   CeedCall(CeedCalloc(1, basis));
1228   CeedCall(CeedReferenceCopy(ceed, &(*basis)->ceed));
1229   (*basis)->ref_count       = 1;
1230   (*basis)->is_tensor_basis = false;
1231   (*basis)->dim             = dim;
1232   (*basis)->topo            = topo;
1233   (*basis)->num_comp        = num_comp;
1234   (*basis)->P               = P;
1235   (*basis)->Q               = Q;
1236   (*basis)->fe_space        = CEED_FE_SPACE_HCURL;
1237   CeedCall(CeedMalloc(Q * dim, &(*basis)->q_ref_1d));
1238   CeedCall(CeedMalloc(Q, &(*basis)->q_weight_1d));
1239   if (q_ref) memcpy((*basis)->q_ref_1d, q_ref, Q * dim * sizeof(q_ref[0]));
1240   if (q_weight) memcpy((*basis)->q_weight_1d, q_weight, Q * sizeof(q_weight[0]));
1241   CeedCall(CeedMalloc(dim * Q * P, &(*basis)->interp));
1242   CeedCall(CeedMalloc(curl_comp * Q * P, &(*basis)->curl));
1243   if (interp) memcpy((*basis)->interp, interp, dim * Q * P * sizeof(interp[0]));
1244   if (curl) memcpy((*basis)->curl, curl, curl_comp * Q * P * sizeof(curl[0]));
1245   CeedCall(ceed->BasisCreateHcurl(topo, dim, P, Q, interp, curl, q_ref, q_weight, *basis));
1246   return CEED_ERROR_SUCCESS;
1247 }
1248 
1249 /**
1250   @brief Create a CeedBasis for projection from the nodes of `basis_from` to the nodes of `basis_to`.
1251 
1252   Only `CEED_EVAL_INTERP` will be valid for the new basis, `basis_project`.
1253   For H^1 spaces, `CEED_EVAL_GRAD` will also be valid.
1254   The interpolation is given by `interp_project = interp_to^+ * interp_from`, where the pseudoinverse `interp_to^+` is given by QR
1255 factorization.
1256   The gradient (for the H^1 case) is given by `grad_project = interp_to^+ * grad_from`.
1257 
1258   Note: `basis_from` and `basis_to` must have compatible quadrature spaces.
1259 
1260   Note: `basis_project` will have the same number of components as `basis_from`, regardless of the number of components that `basis_to` has.
1261         If `basis_from` has 3 components and `basis_to` has 5 components, then `basis_project` will have 3 components.
1262 
1263   @param[in]  basis_from    CeedBasis to prolong from
1264   @param[in]  basis_to      CeedBasis to prolong to
1265   @param[out] basis_project Address of the variable where the newly created CeedBasis will be stored.
1266 
1267   @return An error code: 0 - success, otherwise - failure
1268 
1269   @ref User
1270 **/
1271 int CeedBasisCreateProjection(CeedBasis basis_from, CeedBasis basis_to, CeedBasis *basis_project) {
1272   Ceed        ceed;
1273   bool        is_tensor;
1274   CeedInt     dim, num_comp;
1275   CeedScalar *q_ref, *q_weight, *interp_project, *grad_project;
1276 
1277   CeedCall(CeedBasisGetCeed(basis_to, &ceed));
1278 
1279   // Create projection matrix
1280   CeedCall(CeedBasisCreateProjectionMatrices(basis_from, basis_to, &interp_project, &grad_project));
1281 
1282   // Build basis
1283   CeedCall(CeedBasisIsTensor(basis_to, &is_tensor));
1284   CeedCall(CeedBasisGetDimension(basis_to, &dim));
1285   CeedCall(CeedBasisGetNumComponents(basis_from, &num_comp));
1286   if (is_tensor) {
1287     CeedInt P_1d_to, P_1d_from;
1288 
1289     CeedCall(CeedBasisGetNumNodes1D(basis_from, &P_1d_from));
1290     CeedCall(CeedBasisGetNumNodes1D(basis_to, &P_1d_to));
1291     CeedCall(CeedCalloc(P_1d_to, &q_ref));
1292     CeedCall(CeedCalloc(P_1d_to, &q_weight));
1293     CeedCall(CeedBasisCreateTensorH1(ceed, dim, num_comp, P_1d_from, P_1d_to, interp_project, grad_project, q_ref, q_weight, basis_project));
1294   } else {
1295     // Even if basis_to and basis_from are not H1, the resulting basis is H1 for interpolation to work
1296     CeedInt          num_nodes_to, num_nodes_from;
1297     CeedElemTopology topo;
1298 
1299     CeedCall(CeedBasisGetTopology(basis_to, &topo));
1300     CeedCall(CeedBasisGetNumNodes(basis_from, &num_nodes_from));
1301     CeedCall(CeedBasisGetNumNodes(basis_to, &num_nodes_to));
1302     CeedCall(CeedCalloc(num_nodes_to * dim, &q_ref));
1303     CeedCall(CeedCalloc(num_nodes_to, &q_weight));
1304     CeedCall(CeedBasisCreateH1(ceed, topo, num_comp, num_nodes_from, num_nodes_to, interp_project, grad_project, q_ref, q_weight, basis_project));
1305   }
1306 
1307   // Cleanup
1308   CeedCall(CeedFree(&interp_project));
1309   CeedCall(CeedFree(&grad_project));
1310   CeedCall(CeedFree(&q_ref));
1311   CeedCall(CeedFree(&q_weight));
1312   return CEED_ERROR_SUCCESS;
1313 }
1314 
1315 /**
1316   @brief Copy the pointer to a CeedBasis.
1317 
1318   Note: If the value of `basis_copy` passed into this function is non-NULL, then it is assumed that `basis_copy` is a pointer to a CeedBasis.
1319         This CeedBasis will be destroyed if `basis_copy` is the only reference to this CeedBasis.
1320 
1321   @param[in]     basis      CeedBasis to copy reference to
1322   @param[in,out] basis_copy Variable to store copied reference
1323 
1324   @return An error code: 0 - success, otherwise - failure
1325 
1326   @ref User
1327 **/
1328 int CeedBasisReferenceCopy(CeedBasis basis, CeedBasis *basis_copy) {
1329   if (basis != CEED_BASIS_NONE) CeedCall(CeedBasisReference(basis));
1330   CeedCall(CeedBasisDestroy(basis_copy));
1331   *basis_copy = basis;
1332   return CEED_ERROR_SUCCESS;
1333 }
1334 
1335 /**
1336   @brief View a CeedBasis
1337 
1338   @param[in] basis  CeedBasis to view
1339   @param[in] stream Stream to view to, e.g., stdout
1340 
1341   @return An error code: 0 - success, otherwise - failure
1342 
1343   @ref User
1344 **/
1345 int CeedBasisView(CeedBasis basis, FILE *stream) {
1346   CeedInt          q_comp   = 0;
1347   CeedElemTopology topo     = basis->topo;
1348   CeedFESpace      fe_space = basis->fe_space;
1349 
1350   // Print FE space and element topology of the basis
1351   fprintf(stream, "CeedBasis in a %s on a %s element\n", CeedFESpaces[fe_space], CeedElemTopologies[topo]);
1352   if (basis->is_tensor_basis) {
1353     fprintf(stream, "  P: %" CeedInt_FMT "\n  Q: %" CeedInt_FMT "\n", basis->P_1d, basis->Q_1d);
1354   } else {
1355     fprintf(stream, "  P: %" CeedInt_FMT "\n  Q: %" CeedInt_FMT "\n", basis->P, basis->Q);
1356   }
1357   fprintf(stream, "  dimension: %" CeedInt_FMT "\n  field components: %" CeedInt_FMT "\n", basis->dim, basis->num_comp);
1358   // Print quadrature data, interpolation/gradient/divergence/curl of the basis
1359   if (basis->is_tensor_basis) {  // tensor basis
1360     CeedCall(CeedScalarView("qref1d", "\t% 12.8f", 1, basis->Q_1d, basis->q_ref_1d, stream));
1361     CeedCall(CeedScalarView("qweight1d", "\t% 12.8f", 1, basis->Q_1d, basis->q_weight_1d, stream));
1362     CeedCall(CeedScalarView("interp1d", "\t% 12.8f", basis->Q_1d, basis->P_1d, basis->interp_1d, stream));
1363     CeedCall(CeedScalarView("grad1d", "\t% 12.8f", basis->Q_1d, basis->P_1d, basis->grad_1d, stream));
1364   } else {  // non-tensor basis
1365     CeedCall(CeedScalarView("qref", "\t% 12.8f", 1, basis->Q * basis->dim, basis->q_ref_1d, stream));
1366     CeedCall(CeedScalarView("qweight", "\t% 12.8f", 1, basis->Q, basis->q_weight_1d, stream));
1367     CeedCall(CeedBasisGetNumQuadratureComponents(basis, CEED_EVAL_INTERP, &q_comp));
1368     CeedCall(CeedScalarView("interp", "\t% 12.8f", q_comp * basis->Q, basis->P, basis->interp, stream));
1369     if (basis->grad) {
1370       CeedCall(CeedBasisGetNumQuadratureComponents(basis, CEED_EVAL_GRAD, &q_comp));
1371       CeedCall(CeedScalarView("grad", "\t% 12.8f", q_comp * basis->Q, basis->P, basis->grad, stream));
1372     }
1373     if (basis->div) {
1374       CeedCall(CeedBasisGetNumQuadratureComponents(basis, CEED_EVAL_DIV, &q_comp));
1375       CeedCall(CeedScalarView("div", "\t% 12.8f", q_comp * basis->Q, basis->P, basis->div, stream));
1376     }
1377     if (basis->curl) {
1378       CeedCall(CeedBasisGetNumQuadratureComponents(basis, CEED_EVAL_CURL, &q_comp));
1379       CeedCall(CeedScalarView("curl", "\t% 12.8f", q_comp * basis->Q, basis->P, basis->curl, stream));
1380     }
1381   }
1382   return CEED_ERROR_SUCCESS;
1383 }
1384 
1385 /**
1386   @brief Apply basis evaluation from nodes to quadrature points or vice versa
1387 
1388   @param[in]  basis      CeedBasis to evaluate
1389   @param[in]  num_elem   The number of elements to apply the basis evaluation to;
1390                            the backend will specify the ordering in CeedElemRestrictionCreateBlocked()
1391   @param[in]  t_mode    \ref CEED_NOTRANSPOSE to evaluate from nodes to quadrature points;
1392                           \ref CEED_TRANSPOSE to apply the transpose, mapping from quadrature points to nodes
1393   @param[in]  eval_mode \ref CEED_EVAL_NONE to use values directly,
1394                           \ref CEED_EVAL_INTERP to use interpolated values,
1395                           \ref CEED_EVAL_GRAD to use gradients,
1396                           \ref CEED_EVAL_DIV to use divergence,
1397                           \ref CEED_EVAL_CURL to use curl,
1398                           \ref CEED_EVAL_WEIGHT to use quadrature weights.
1399   @param[in]  u        Input CeedVector
1400   @param[out] v        Output CeedVector
1401 
1402   @return An error code: 0 - success, otherwise - failure
1403 
1404   @ref User
1405 **/
1406 int CeedBasisApply(CeedBasis basis, CeedInt num_elem, CeedTransposeMode t_mode, CeedEvalMode eval_mode, CeedVector u, CeedVector v) {
1407   CeedInt  dim, num_comp, q_comp, num_nodes, num_qpts;
1408   CeedSize u_length = 0, v_length;
1409 
1410   CeedCall(CeedBasisGetDimension(basis, &dim));
1411   CeedCall(CeedBasisGetNumComponents(basis, &num_comp));
1412   CeedCall(CeedBasisGetNumQuadratureComponents(basis, eval_mode, &q_comp));
1413   CeedCall(CeedBasisGetNumNodes(basis, &num_nodes));
1414   CeedCall(CeedBasisGetNumQuadraturePoints(basis, &num_qpts));
1415   CeedCall(CeedVectorGetLength(v, &v_length));
1416   if (u) CeedCall(CeedVectorGetLength(u, &u_length));
1417 
1418   CeedCheck(basis->Apply, basis->ceed, CEED_ERROR_UNSUPPORTED, "Backend does not support BasisApply");
1419 
1420   // Check compatibility of topological and geometrical dimensions
1421   CeedCheck((t_mode == CEED_TRANSPOSE && v_length % num_nodes == 0 && u_length % num_qpts == 0) ||
1422                 (t_mode == CEED_NOTRANSPOSE && u_length % num_nodes == 0 && v_length % num_qpts == 0),
1423             basis->ceed, CEED_ERROR_DIMENSION, "Length of input/output vectors incompatible with basis dimensions");
1424 
1425   // Check vector lengths to prevent out of bounds issues
1426   bool good_dims = true;
1427   switch (eval_mode) {
1428     case CEED_EVAL_NONE:
1429     case CEED_EVAL_INTERP:
1430     case CEED_EVAL_GRAD:
1431     case CEED_EVAL_DIV:
1432     case CEED_EVAL_CURL:
1433       good_dims =
1434           ((t_mode == CEED_TRANSPOSE && u_length >= num_elem * num_comp * num_qpts * q_comp && v_length >= num_elem * num_comp * num_nodes) ||
1435            (t_mode == CEED_NOTRANSPOSE && v_length >= num_elem * num_qpts * num_comp * q_comp && u_length >= num_elem * num_comp * num_nodes));
1436       break;
1437     case CEED_EVAL_WEIGHT:
1438       good_dims = v_length >= num_elem * num_qpts;
1439       break;
1440   }
1441   CeedCheck(good_dims, basis->ceed, CEED_ERROR_DIMENSION, "Input/output vectors too short for basis and evaluation mode");
1442 
1443   CeedCall(basis->Apply(basis, num_elem, t_mode, eval_mode, u, v));
1444   return CEED_ERROR_SUCCESS;
1445 }
1446 
1447 /**
1448   @brief Apply basis evaluation from nodes to arbitrary points
1449 
1450   @param[in]  basis      CeedBasis to evaluate
1451   @param[in]  num_points The number of points to apply the basis evaluation to
1452   @param[in]  t_mode    \ref CEED_NOTRANSPOSE to evaluate from nodes to points;
1453                           \ref CEED_TRANSPOSE to apply the transpose, mapping from points to nodes
1454   @param[in]  eval_mode \ref CEED_EVAL_INTERP to use interpolated values,
1455                           \ref CEED_EVAL_GRAD to use gradients
1456   @param[in]  x_ref    CeedVector holding reference coordinates of each point
1457   @param[in]  u        Input CeedVector, of length `num_nodes * num_comp` for `CEED_NOTRANSPOSE`
1458   @param[out] v        Output CeedVector, of length `num_points * num_q_comp` for `CEED_NOTRANSPOSE` with `CEED_EVAL_INTERP`
1459 
1460   @return An error code: 0 - success, otherwise - failure
1461 
1462   @ref User
1463 **/
1464 int CeedBasisApplyAtPoints(CeedBasis basis, CeedInt num_points, CeedTransposeMode t_mode, CeedEvalMode eval_mode, CeedVector x_ref, CeedVector u,
1465                            CeedVector v) {
1466   CeedInt  dim, num_comp, num_q_comp, num_nodes, P_1d = 1, Q_1d = 1;
1467   CeedSize x_length = 0, u_length = 0, v_length;
1468 
1469   CeedCall(CeedBasisGetDimension(basis, &dim));
1470   CeedCall(CeedBasisGetNumNodes1D(basis, &P_1d));
1471   CeedCall(CeedBasisGetNumQuadraturePoints1D(basis, &Q_1d));
1472   CeedCall(CeedBasisGetNumComponents(basis, &num_comp));
1473   CeedCall(CeedBasisGetNumQuadratureComponents(basis, eval_mode, &num_q_comp));
1474   CeedCall(CeedBasisGetNumNodes(basis, &num_nodes));
1475   CeedCall(CeedVectorGetLength(v, &v_length));
1476   if (x_ref != CEED_VECTOR_NONE) CeedCall(CeedVectorGetLength(x_ref, &x_length));
1477   if (u != CEED_VECTOR_NONE) CeedCall(CeedVectorGetLength(u, &u_length));
1478 
1479   // Check compatibility of topological and geometrical dimensions
1480   CeedCheck((t_mode == CEED_TRANSPOSE && v_length % num_nodes == 0) || (t_mode == CEED_NOTRANSPOSE && u_length % num_nodes == 0) ||
1481                 (eval_mode == CEED_EVAL_WEIGHT),
1482             basis->ceed, CEED_ERROR_DIMENSION, "Length of input/output vectors incompatible with basis dimensions and number of points");
1483 
1484   // Check compatibility coordinates vector
1485   CeedCheck((x_length >= num_points * dim) || (eval_mode == CEED_EVAL_WEIGHT), basis->ceed, CEED_ERROR_DIMENSION,
1486             "Length of reference coordinate vector incompatible with basis dimension and number of points");
1487 
1488   // Check CEED_EVAL_WEIGHT only on CEED_NOTRANSPOSE
1489   CeedCheck(eval_mode != CEED_EVAL_WEIGHT || t_mode == CEED_NOTRANSPOSE, basis->ceed, CEED_ERROR_UNSUPPORTED,
1490             "CEED_EVAL_WEIGHT only supported with CEED_NOTRANSPOSE");
1491 
1492   // Check vector lengths to prevent out of bounds issues
1493   bool good_dims = false;
1494   switch (eval_mode) {
1495     case CEED_EVAL_INTERP:
1496       good_dims = ((t_mode == CEED_TRANSPOSE && (u_length >= num_points * num_q_comp || v_length >= num_nodes * num_comp)) ||
1497                    (t_mode == CEED_NOTRANSPOSE && (v_length >= num_points * num_q_comp || u_length >= num_nodes * num_comp)));
1498       break;
1499     case CEED_EVAL_GRAD:
1500       good_dims = ((t_mode == CEED_TRANSPOSE && (u_length >= num_points * num_q_comp * dim || v_length >= num_nodes * num_comp)) ||
1501                    (t_mode == CEED_NOTRANSPOSE && (v_length >= num_points * num_q_comp * dim || u_length >= num_nodes * num_comp)));
1502       break;
1503     case CEED_EVAL_WEIGHT:
1504       good_dims = t_mode == CEED_NOTRANSPOSE && (v_length >= num_points);
1505       break;
1506     case CEED_EVAL_NONE:
1507     case CEED_EVAL_DIV:
1508     case CEED_EVAL_CURL:
1509       // LCOV_EXCL_START
1510       return CeedError(basis->ceed, CEED_ERROR_UNSUPPORTED, "Evaluation at arbitrary points not supported for %s", CeedEvalModes[eval_mode]);
1511       // LCOV_EXCL_STOP
1512   }
1513   CeedCheck(good_dims, basis->ceed, CEED_ERROR_DIMENSION, "Input/output vectors too short for basis and evaluation mode");
1514 
1515   // Backend method
1516   if (basis->ApplyAtPoints) {
1517     CeedCall(basis->ApplyAtPoints(basis, num_points, t_mode, eval_mode, x_ref, u, v));
1518     return CEED_ERROR_SUCCESS;
1519   }
1520 
1521   // Default implementation
1522   CeedCheck(basis->is_tensor_basis, basis->ceed, CEED_ERROR_UNSUPPORTED, "Evaluation at arbitrary points only supported for tensor product bases");
1523   if (eval_mode == CEED_EVAL_WEIGHT) {
1524     CeedCall(CeedVectorSetValue(v, 1.0));
1525     return CEED_ERROR_SUCCESS;
1526   }
1527   if (!basis->basis_chebyshev) {
1528     // Build matrix mapping from quadrature point values to Chebyshev coefficients
1529     CeedScalar       *tau, *C, *I, *chebyshev_coeffs_1d;
1530     const CeedScalar *q_ref_1d;
1531 
1532     // Build coefficient matrix
1533     // -- Note: Clang-tidy needs this check because it does not understand the is_tensor_basis check above
1534     CeedCheck(P_1d > 0 && Q_1d > 0, basis->ceed, CEED_ERROR_INCOMPATIBLE, "Basis dimensions are malformed");
1535     CeedCall(CeedCalloc(Q_1d * Q_1d, &C));
1536     CeedCall(CeedBasisGetQRef(basis, &q_ref_1d));
1537     for (CeedInt i = 0; i < Q_1d; i++) CeedCall(CeedChebyshevPolynomialsAtPoint(q_ref_1d[i], Q_1d, &C[i * Q_1d]));
1538 
1539     // Inverse of coefficient matrix
1540     CeedCall(CeedCalloc(Q_1d * Q_1d, &chebyshev_coeffs_1d));
1541     CeedCall(CeedCalloc(Q_1d * Q_1d, &I));
1542     CeedCall(CeedCalloc(Q_1d, &tau));
1543     // -- QR Factorization, C = Q R
1544     CeedCall(CeedQRFactorization(basis->ceed, C, tau, Q_1d, Q_1d));
1545     // -- chebyshev_coeffs_1d = R_inv Q^T
1546     for (CeedInt i = 0; i < Q_1d; i++) I[i * Q_1d + i] = 1.0;
1547     // ---- Apply R_inv, chebyshev_coeffs_1d = I R_inv
1548     for (CeedInt i = 0; i < Q_1d; i++) {  // Row i
1549       chebyshev_coeffs_1d[Q_1d * i] = I[Q_1d * i] / C[0];
1550       for (CeedInt j = 1; j < Q_1d; j++) {  // Column j
1551         chebyshev_coeffs_1d[j + Q_1d * i] = I[j + Q_1d * i];
1552         for (CeedInt k = 0; k < j; k++) chebyshev_coeffs_1d[j + Q_1d * i] -= C[j + Q_1d * k] * chebyshev_coeffs_1d[k + Q_1d * i];
1553         chebyshev_coeffs_1d[j + Q_1d * i] /= C[j + Q_1d * j];
1554       }
1555     }
1556     // ---- Apply Q^T, chebyshev_coeffs_1d = R_inv Q^T
1557     CeedCall(CeedHouseholderApplyQ(chebyshev_coeffs_1d, C, tau, CEED_NOTRANSPOSE, Q_1d, Q_1d, Q_1d, 1, Q_1d));
1558 
1559     // Build basis mapping from nodes to Chebyshev coefficients
1560     CeedScalar       *chebyshev_interp_1d, *chebyshev_grad_1d, *chebyshev_q_weight_1d;
1561     const CeedScalar *interp_1d;
1562 
1563     CeedCall(CeedCalloc(P_1d * Q_1d, &chebyshev_interp_1d));
1564     CeedCall(CeedCalloc(P_1d * Q_1d, &chebyshev_grad_1d));
1565     CeedCall(CeedCalloc(Q_1d, &chebyshev_q_weight_1d));
1566     CeedCall(CeedBasisGetInterp1D(basis, &interp_1d));
1567     CeedCall(CeedMatrixMatrixMultiply(basis->ceed, chebyshev_coeffs_1d, interp_1d, chebyshev_interp_1d, Q_1d, P_1d, Q_1d));
1568 
1569     CeedCall(CeedVectorCreate(basis->ceed, num_comp * CeedIntPow(Q_1d, dim), &basis->vec_chebyshev));
1570     CeedCall(CeedBasisCreateTensorH1(basis->ceed, dim, num_comp, P_1d, Q_1d, chebyshev_interp_1d, chebyshev_grad_1d, q_ref_1d, chebyshev_q_weight_1d,
1571                                      &basis->basis_chebyshev));
1572 
1573     // Cleanup
1574     CeedCall(CeedFree(&C));
1575     CeedCall(CeedFree(&chebyshev_coeffs_1d));
1576     CeedCall(CeedFree(&I));
1577     CeedCall(CeedFree(&tau));
1578     CeedCall(CeedFree(&chebyshev_interp_1d));
1579     CeedCall(CeedFree(&chebyshev_grad_1d));
1580     CeedCall(CeedFree(&chebyshev_q_weight_1d));
1581   }
1582 
1583   // Create TensorContract object if needed, such as a basis from the GPU backends
1584   if (!basis->contract) {
1585     Ceed      ceed_ref;
1586     CeedBasis basis_ref = NULL;
1587 
1588     CeedCall(CeedInit("/cpu/self", &ceed_ref));
1589     // Only need matching tensor contraction dimensions, any type of basis will work
1590     CeedCall(CeedBasisCreateTensorH1Lagrange(ceed_ref, dim, num_comp, P_1d, Q_1d, CEED_GAUSS, &basis_ref));
1591     // Note - clang-tidy doesn't know basis_ref->contract must be valid here
1592     CeedCheck(basis_ref && basis_ref->contract, basis->ceed, CEED_ERROR_UNSUPPORTED,
1593               "Reference CPU ceed failed to create a tensor contraction object");
1594     CeedCall(CeedTensorContractReferenceCopy(basis_ref->contract, &basis->contract));
1595     CeedCall(CeedBasisDestroy(&basis_ref));
1596     CeedCall(CeedDestroy(&ceed_ref));
1597   }
1598 
1599   // Basis evaluation
1600   switch (t_mode) {
1601     case CEED_NOTRANSPOSE: {
1602       // Nodes to arbitrary points
1603       CeedScalar       *v_array;
1604       const CeedScalar *chebyshev_coeffs, *x_array_read;
1605 
1606       // -- Interpolate to Chebyshev coefficients
1607       CeedCall(CeedBasisApply(basis->basis_chebyshev, 1, CEED_NOTRANSPOSE, CEED_EVAL_INTERP, u, basis->vec_chebyshev));
1608 
1609       // -- Evaluate Chebyshev polynomials at arbitrary points
1610       CeedCall(CeedVectorGetArrayRead(basis->vec_chebyshev, CEED_MEM_HOST, &chebyshev_coeffs));
1611       CeedCall(CeedVectorGetArrayRead(x_ref, CEED_MEM_HOST, &x_array_read));
1612       CeedCall(CeedVectorGetArrayWrite(v, CEED_MEM_HOST, &v_array));
1613       switch (eval_mode) {
1614         case CEED_EVAL_INTERP: {
1615           CeedScalar tmp[2][num_comp * CeedIntPow(Q_1d, dim)], chebyshev_x[Q_1d];
1616 
1617           // ---- Values at point
1618           for (CeedInt p = 0; p < num_points; p++) {
1619             CeedInt pre = num_comp * CeedIntPow(Q_1d, dim - 1), post = 1;
1620 
1621             for (CeedInt d = 0; d < dim; d++) {
1622               // ------ Tensor contract with current Chebyshev polynomial values
1623               CeedCall(CeedChebyshevPolynomialsAtPoint(x_array_read[p * dim + d], Q_1d, chebyshev_x));
1624               CeedCall(CeedTensorContractApply(basis->contract, pre, Q_1d, post, 1, chebyshev_x, t_mode, false,
1625                                                d == 0 ? chebyshev_coeffs : tmp[d % 2], d == (dim - 1) ? &v_array[p * num_comp] : tmp[(d + 1) % 2]));
1626               pre /= Q_1d;
1627               post *= 1;
1628             }
1629           }
1630           break;
1631         }
1632         case CEED_EVAL_GRAD: {
1633           CeedScalar tmp[2][num_comp * CeedIntPow(Q_1d, dim)], chebyshev_x[Q_1d];
1634 
1635           // ---- Values at point
1636           for (CeedInt p = 0; p < num_points; p++) {
1637             // Dim**2 contractions, apply grad when pass == dim
1638             for (CeedInt pass = 0; pass < dim; pass++) {
1639               CeedInt pre = num_comp * CeedIntPow(Q_1d, dim - 1), post = 1;
1640 
1641               for (CeedInt d = 0; d < dim; d++) {
1642                 // ------ Tensor contract with current Chebyshev polynomial values
1643                 if (pass == d) CeedCall(CeedChebyshevDerivativeAtPoint(x_array_read[p * dim + d], Q_1d, chebyshev_x));
1644                 else CeedCall(CeedChebyshevPolynomialsAtPoint(x_array_read[p * dim + d], Q_1d, chebyshev_x));
1645                 CeedCall(CeedTensorContractApply(basis->contract, pre, Q_1d, post, 1, chebyshev_x, t_mode, false,
1646                                                  d == 0 ? chebyshev_coeffs : tmp[d % 2],
1647                                                  d == (dim - 1) ? &v_array[p * num_comp * dim + pass] : tmp[(d + 1) % 2]));
1648                 pre /= Q_1d;
1649                 post *= 1;
1650               }
1651             }
1652           }
1653           break;
1654         }
1655         default:
1656           // Nothing to do, excluded above
1657           break;
1658       }
1659       CeedCall(CeedVectorRestoreArrayRead(basis->vec_chebyshev, &chebyshev_coeffs));
1660       CeedCall(CeedVectorRestoreArrayRead(x_ref, &x_array_read));
1661       CeedCall(CeedVectorRestoreArray(v, &v_array));
1662       break;
1663     }
1664     case CEED_TRANSPOSE: {
1665       // Note: No switch on e_mode here because only CEED_EVAL_INTERP is supported at this time
1666       // Arbitrary points to nodes
1667       CeedScalar       *chebyshev_coeffs;
1668       const CeedScalar *u_array, *x_array_read;
1669 
1670       // -- Transpose of evaluation of Chebyshev polynomials at arbitrary points
1671       CeedCall(CeedVectorGetArrayWrite(basis->vec_chebyshev, CEED_MEM_HOST, &chebyshev_coeffs));
1672       CeedCall(CeedVectorGetArrayRead(x_ref, CEED_MEM_HOST, &x_array_read));
1673       CeedCall(CeedVectorGetArrayRead(u, CEED_MEM_HOST, &u_array));
1674 
1675       switch (eval_mode) {
1676         case CEED_EVAL_INTERP: {
1677           CeedScalar tmp[2][num_comp * CeedIntPow(Q_1d, dim)], chebyshev_x[Q_1d];
1678 
1679           // ---- Values at point
1680           for (CeedInt p = 0; p < num_points; p++) {
1681             CeedInt pre = num_comp * 1, post = 1;
1682 
1683             for (CeedInt d = 0; d < dim; d++) {
1684               // ------ Tensor contract with current Chebyshev polynomial values
1685               CeedCall(CeedChebyshevPolynomialsAtPoint(x_array_read[p * dim + d], Q_1d, chebyshev_x));
1686               CeedCall(CeedTensorContractApply(basis->contract, pre, 1, post, Q_1d, chebyshev_x, t_mode, p > 0 && d == (dim - 1),
1687                                                d == 0 ? &u_array[p * num_comp] : tmp[d % 2], d == (dim - 1) ? chebyshev_coeffs : tmp[(d + 1) % 2]));
1688               pre /= 1;
1689               post *= Q_1d;
1690             }
1691           }
1692           break;
1693         }
1694         case CEED_EVAL_GRAD: {
1695           CeedScalar tmp[2][num_comp * CeedIntPow(Q_1d, dim)], chebyshev_x[Q_1d];
1696 
1697           // ---- Values at point
1698           for (CeedInt p = 0; p < num_points; p++) {
1699             // Dim**2 contractions, apply grad when pass == dim
1700             for (CeedInt pass = 0; pass < dim; pass++) {
1701               CeedInt pre = num_comp * 1, post = 1;
1702 
1703               for (CeedInt d = 0; d < dim; d++) {
1704                 // ------ Tensor contract with current Chebyshev polynomial values
1705                 if (pass == d) CeedCall(CeedChebyshevDerivativeAtPoint(x_array_read[p * dim + d], Q_1d, chebyshev_x));
1706                 else CeedCall(CeedChebyshevPolynomialsAtPoint(x_array_read[p * dim + d], Q_1d, chebyshev_x));
1707                 CeedCall(CeedTensorContractApply(
1708                     basis->contract, pre, 1, post, Q_1d, chebyshev_x, t_mode, (p > 0 || (p == 0 && pass > 0)) && d == (dim - 1),
1709                     d == 0 ? &u_array[p * num_comp * dim + pass] : tmp[d % 2], d == (dim - 1) ? chebyshev_coeffs : tmp[(d + 1) % 2]));
1710                 pre /= 1;
1711                 post *= Q_1d;
1712               }
1713             }
1714           }
1715           break;
1716         }
1717         default:
1718           // Nothing to do, excluded above
1719           break;
1720       }
1721       CeedCall(CeedVectorRestoreArray(basis->vec_chebyshev, &chebyshev_coeffs));
1722       CeedCall(CeedVectorRestoreArrayRead(x_ref, &x_array_read));
1723       CeedCall(CeedVectorRestoreArrayRead(u, &u_array));
1724 
1725       // -- Interpolate transpose from Chebyshev coefficients
1726       CeedCall(CeedBasisApply(basis->basis_chebyshev, 1, CEED_TRANSPOSE, CEED_EVAL_INTERP, basis->vec_chebyshev, v));
1727       break;
1728     }
1729   }
1730   return CEED_ERROR_SUCCESS;
1731 }
1732 
1733 /**
1734   @brief Get Ceed associated with a CeedBasis
1735 
1736   @param[in]  basis CeedBasis
1737   @param[out] ceed  Variable to store Ceed
1738 
1739   @return An error code: 0 - success, otherwise - failure
1740 
1741   @ref Advanced
1742 **/
1743 int CeedBasisGetCeed(CeedBasis basis, Ceed *ceed) {
1744   *ceed = basis->ceed;
1745   return CEED_ERROR_SUCCESS;
1746 }
1747 
1748 /**
1749   @brief Get dimension for given CeedBasis
1750 
1751   @param[in]  basis CeedBasis
1752   @param[out] dim   Variable to store dimension of basis
1753 
1754   @return An error code: 0 - success, otherwise - failure
1755 
1756   @ref Advanced
1757 **/
1758 int CeedBasisGetDimension(CeedBasis basis, CeedInt *dim) {
1759   *dim = basis->dim;
1760   return CEED_ERROR_SUCCESS;
1761 }
1762 
1763 /**
1764   @brief Get topology for given CeedBasis
1765 
1766   @param[in]  basis CeedBasis
1767   @param[out] topo  Variable to store topology of basis
1768 
1769   @return An error code: 0 - success, otherwise - failure
1770 
1771   @ref Advanced
1772 **/
1773 int CeedBasisGetTopology(CeedBasis basis, CeedElemTopology *topo) {
1774   *topo = basis->topo;
1775   return CEED_ERROR_SUCCESS;
1776 }
1777 
1778 /**
1779   @brief Get number of components for given CeedBasis
1780 
1781   @param[in]  basis    CeedBasis
1782   @param[out] num_comp Variable to store number of components of basis
1783 
1784   @return An error code: 0 - success, otherwise - failure
1785 
1786   @ref Advanced
1787 **/
1788 int CeedBasisGetNumComponents(CeedBasis basis, CeedInt *num_comp) {
1789   *num_comp = basis->num_comp;
1790   return CEED_ERROR_SUCCESS;
1791 }
1792 
1793 /**
1794   @brief Get total number of nodes (in dim dimensions) of a CeedBasis
1795 
1796   @param[in]  basis CeedBasis
1797   @param[out] P     Variable to store number of nodes
1798 
1799   @return An error code: 0 - success, otherwise - failure
1800 
1801   @ref Utility
1802 **/
1803 int CeedBasisGetNumNodes(CeedBasis basis, CeedInt *P) {
1804   *P = basis->P;
1805   return CEED_ERROR_SUCCESS;
1806 }
1807 
1808 /**
1809   @brief Get total number of nodes (in 1 dimension) of a CeedBasis
1810 
1811   @param[in]  basis CeedBasis
1812   @param[out] P_1d  Variable to store number of nodes
1813 
1814   @return An error code: 0 - success, otherwise - failure
1815 
1816   @ref Advanced
1817 **/
1818 int CeedBasisGetNumNodes1D(CeedBasis basis, CeedInt *P_1d) {
1819   CeedCheck(basis->is_tensor_basis, basis->ceed, CEED_ERROR_MINOR, "Cannot supply P_1d for non-tensor basis");
1820   *P_1d = basis->P_1d;
1821   return CEED_ERROR_SUCCESS;
1822 }
1823 
1824 /**
1825   @brief Get total number of quadrature points (in dim dimensions) of a CeedBasis
1826 
1827   @param[in]  basis CeedBasis
1828   @param[out] Q     Variable to store number of quadrature points
1829 
1830   @return An error code: 0 - success, otherwise - failure
1831 
1832   @ref Utility
1833 **/
1834 int CeedBasisGetNumQuadraturePoints(CeedBasis basis, CeedInt *Q) {
1835   *Q = basis->Q;
1836   return CEED_ERROR_SUCCESS;
1837 }
1838 
1839 /**
1840   @brief Get total number of quadrature points (in 1 dimension) of a CeedBasis
1841 
1842   @param[in]  basis CeedBasis
1843   @param[out] Q_1d  Variable to store number of quadrature points
1844 
1845   @return An error code: 0 - success, otherwise - failure
1846 
1847   @ref Advanced
1848 **/
1849 int CeedBasisGetNumQuadraturePoints1D(CeedBasis basis, CeedInt *Q_1d) {
1850   CeedCheck(basis->is_tensor_basis, basis->ceed, CEED_ERROR_MINOR, "Cannot supply Q_1d for non-tensor basis");
1851   *Q_1d = basis->Q_1d;
1852   return CEED_ERROR_SUCCESS;
1853 }
1854 
1855 /**
1856   @brief Get reference coordinates of quadrature points (in dim dimensions) of a CeedBasis
1857 
1858   @param[in]  basis CeedBasis
1859   @param[out] q_ref Variable to store reference coordinates of quadrature points
1860 
1861   @return An error code: 0 - success, otherwise - failure
1862 
1863   @ref Advanced
1864 **/
1865 int CeedBasisGetQRef(CeedBasis basis, const CeedScalar **q_ref) {
1866   *q_ref = basis->q_ref_1d;
1867   return CEED_ERROR_SUCCESS;
1868 }
1869 
1870 /**
1871   @brief Get quadrature weights of quadrature points (in dim dimensions) of a CeedBasis
1872 
1873   @param[in]  basis    CeedBasis
1874   @param[out] q_weight Variable to store quadrature weights
1875 
1876   @return An error code: 0 - success, otherwise - failure
1877 
1878   @ref Advanced
1879 **/
1880 int CeedBasisGetQWeights(CeedBasis basis, const CeedScalar **q_weight) {
1881   *q_weight = basis->q_weight_1d;
1882   return CEED_ERROR_SUCCESS;
1883 }
1884 
1885 /**
1886   @brief Get interpolation matrix of a CeedBasis
1887 
1888   @param[in]  basis  CeedBasis
1889   @param[out] interp Variable to store interpolation matrix
1890 
1891   @return An error code: 0 - success, otherwise - failure
1892 
1893   @ref Advanced
1894 **/
1895 int CeedBasisGetInterp(CeedBasis basis, const CeedScalar **interp) {
1896   if (!basis->interp && basis->is_tensor_basis) {
1897     // Allocate
1898     CeedCall(CeedMalloc(basis->Q * basis->P, &basis->interp));
1899 
1900     // Initialize
1901     for (CeedInt i = 0; i < basis->Q * basis->P; i++) basis->interp[i] = 1.0;
1902 
1903     // Calculate
1904     for (CeedInt d = 0; d < basis->dim; d++) {
1905       for (CeedInt qpt = 0; qpt < basis->Q; qpt++) {
1906         for (CeedInt node = 0; node < basis->P; node++) {
1907           CeedInt p = (node / CeedIntPow(basis->P_1d, d)) % basis->P_1d;
1908           CeedInt q = (qpt / CeedIntPow(basis->Q_1d, d)) % basis->Q_1d;
1909 
1910           basis->interp[qpt * (basis->P) + node] *= basis->interp_1d[q * basis->P_1d + p];
1911         }
1912       }
1913     }
1914   }
1915   *interp = basis->interp;
1916   return CEED_ERROR_SUCCESS;
1917 }
1918 
1919 /**
1920   @brief Get 1D interpolation matrix of a tensor product CeedBasis
1921 
1922   @param[in]  basis     CeedBasis
1923   @param[out] interp_1d Variable to store interpolation matrix
1924 
1925   @return An error code: 0 - success, otherwise - failure
1926 
1927   @ref Backend
1928 **/
1929 int CeedBasisGetInterp1D(CeedBasis basis, const CeedScalar **interp_1d) {
1930   CeedCheck(basis->is_tensor_basis, basis->ceed, CEED_ERROR_MINOR, "CeedBasis is not a tensor product basis.");
1931   *interp_1d = basis->interp_1d;
1932   return CEED_ERROR_SUCCESS;
1933 }
1934 
1935 /**
1936   @brief Get gradient matrix of a CeedBasis
1937 
1938   @param[in]  basis CeedBasis
1939   @param[out] grad  Variable to store gradient matrix
1940 
1941   @return An error code: 0 - success, otherwise - failure
1942 
1943   @ref Advanced
1944 **/
1945 int CeedBasisGetGrad(CeedBasis basis, const CeedScalar **grad) {
1946   if (!basis->grad && basis->is_tensor_basis) {
1947     // Allocate
1948     CeedCall(CeedMalloc(basis->dim * basis->Q * basis->P, &basis->grad));
1949 
1950     // Initialize
1951     for (CeedInt i = 0; i < basis->dim * basis->Q * basis->P; i++) basis->grad[i] = 1.0;
1952 
1953     // Calculate
1954     for (CeedInt d = 0; d < basis->dim; d++) {
1955       for (CeedInt i = 0; i < basis->dim; i++) {
1956         for (CeedInt qpt = 0; qpt < basis->Q; qpt++) {
1957           for (CeedInt node = 0; node < basis->P; node++) {
1958             CeedInt p = (node / CeedIntPow(basis->P_1d, d)) % basis->P_1d;
1959             CeedInt q = (qpt / CeedIntPow(basis->Q_1d, d)) % basis->Q_1d;
1960 
1961             if (i == d) basis->grad[(i * basis->Q + qpt) * (basis->P) + node] *= basis->grad_1d[q * basis->P_1d + p];
1962             else basis->grad[(i * basis->Q + qpt) * (basis->P) + node] *= basis->interp_1d[q * basis->P_1d + p];
1963           }
1964         }
1965       }
1966     }
1967   }
1968   *grad = basis->grad;
1969   return CEED_ERROR_SUCCESS;
1970 }
1971 
1972 /**
1973   @brief Get 1D gradient matrix of a tensor product CeedBasis
1974 
1975   @param[in]  basis   CeedBasis
1976   @param[out] grad_1d Variable to store gradient matrix
1977 
1978   @return An error code: 0 - success, otherwise - failure
1979 
1980   @ref Advanced
1981 **/
1982 int CeedBasisGetGrad1D(CeedBasis basis, const CeedScalar **grad_1d) {
1983   CeedCheck(basis->is_tensor_basis, basis->ceed, CEED_ERROR_MINOR, "CeedBasis is not a tensor product basis.");
1984   *grad_1d = basis->grad_1d;
1985   return CEED_ERROR_SUCCESS;
1986 }
1987 
1988 /**
1989   @brief Get divergence matrix of a CeedBasis
1990 
1991   @param[in]  basis CeedBasis
1992   @param[out] div   Variable to store divergence matrix
1993 
1994   @return An error code: 0 - success, otherwise - failure
1995 
1996   @ref Advanced
1997 **/
1998 int CeedBasisGetDiv(CeedBasis basis, const CeedScalar **div) {
1999   CeedCheck(basis->div, basis->ceed, CEED_ERROR_MINOR, "CeedBasis does not have divergence matrix.");
2000   *div = basis->div;
2001   return CEED_ERROR_SUCCESS;
2002 }
2003 
2004 /**
2005   @brief Get curl matrix of a CeedBasis
2006 
2007   @param[in]  basis CeedBasis
2008   @param[out] curl  Variable to store curl matrix
2009 
2010   @return An error code: 0 - success, otherwise - failure
2011 
2012   @ref Advanced
2013 **/
2014 int CeedBasisGetCurl(CeedBasis basis, const CeedScalar **curl) {
2015   CeedCheck(basis->curl, basis->ceed, CEED_ERROR_MINOR, "CeedBasis does not have curl matrix.");
2016   *curl = basis->curl;
2017   return CEED_ERROR_SUCCESS;
2018 }
2019 
2020 /**
2021   @brief Destroy a CeedBasis
2022 
2023   @param[in,out] basis CeedBasis to destroy
2024 
2025   @return An error code: 0 - success, otherwise - failure
2026 
2027   @ref User
2028 **/
2029 int CeedBasisDestroy(CeedBasis *basis) {
2030   if (!*basis || *basis == CEED_BASIS_NONE || --(*basis)->ref_count > 0) {
2031     *basis = NULL;
2032     return CEED_ERROR_SUCCESS;
2033   }
2034   if ((*basis)->Destroy) CeedCall((*basis)->Destroy(*basis));
2035   CeedCall(CeedTensorContractDestroy(&(*basis)->contract));
2036   CeedCall(CeedFree(&(*basis)->q_ref_1d));
2037   CeedCall(CeedFree(&(*basis)->q_weight_1d));
2038   CeedCall(CeedFree(&(*basis)->interp));
2039   CeedCall(CeedFree(&(*basis)->interp_1d));
2040   CeedCall(CeedFree(&(*basis)->grad));
2041   CeedCall(CeedFree(&(*basis)->grad_1d));
2042   CeedCall(CeedFree(&(*basis)->div));
2043   CeedCall(CeedFree(&(*basis)->curl));
2044   CeedCall(CeedVectorDestroy(&(*basis)->vec_chebyshev));
2045   CeedCall(CeedBasisDestroy(&(*basis)->basis_chebyshev));
2046   CeedCall(CeedDestroy(&(*basis)->ceed));
2047   CeedCall(CeedFree(basis));
2048   return CEED_ERROR_SUCCESS;
2049 }
2050 
2051 /**
2052   @brief Construct a Gauss-Legendre quadrature
2053 
2054   @param[in]  Q           Number of quadrature points (integrates polynomials of degree 2*Q-1 exactly)
2055   @param[out] q_ref_1d    Array of length Q to hold the abscissa on [-1, 1]
2056   @param[out] q_weight_1d Array of length Q to hold the weights
2057 
2058   @return An error code: 0 - success, otherwise - failure
2059 
2060   @ref Utility
2061 **/
2062 int CeedGaussQuadrature(CeedInt Q, CeedScalar *q_ref_1d, CeedScalar *q_weight_1d) {
2063   CeedScalar P0, P1, P2, dP2, xi, wi, PI = 4.0 * atan(1.0);
2064 
2065   // Build q_ref_1d, q_weight_1d
2066   for (CeedInt i = 0; i <= Q / 2; i++) {
2067     // Guess
2068     xi = cos(PI * (CeedScalar)(2 * i + 1) / ((CeedScalar)(2 * Q)));
2069     // Pn(xi)
2070     P0 = 1.0;
2071     P1 = xi;
2072     P2 = 0.0;
2073     for (CeedInt j = 2; j <= Q; j++) {
2074       P2 = (((CeedScalar)(2 * j - 1)) * xi * P1 - ((CeedScalar)(j - 1)) * P0) / ((CeedScalar)(j));
2075       P0 = P1;
2076       P1 = P2;
2077     }
2078     // First Newton Step
2079     dP2 = (xi * P2 - P0) * (CeedScalar)Q / (xi * xi - 1.0);
2080     xi  = xi - P2 / dP2;
2081     // Newton to convergence
2082     for (CeedInt k = 0; k < 100 && fabs(P2) > 10 * CEED_EPSILON; k++) {
2083       P0 = 1.0;
2084       P1 = xi;
2085       for (CeedInt j = 2; j <= Q; j++) {
2086         P2 = (((CeedScalar)(2 * j - 1)) * xi * P1 - ((CeedScalar)(j - 1)) * P0) / ((CeedScalar)(j));
2087         P0 = P1;
2088         P1 = P2;
2089       }
2090       dP2 = (xi * P2 - P0) * (CeedScalar)Q / (xi * xi - 1.0);
2091       xi  = xi - P2 / dP2;
2092     }
2093     // Save xi, wi
2094     wi                     = 2.0 / ((1.0 - xi * xi) * dP2 * dP2);
2095     q_weight_1d[i]         = wi;
2096     q_weight_1d[Q - 1 - i] = wi;
2097     q_ref_1d[i]            = -xi;
2098     q_ref_1d[Q - 1 - i]    = xi;
2099   }
2100   return CEED_ERROR_SUCCESS;
2101 }
2102 
2103 /**
2104   @brief Construct a Gauss-Legendre-Lobatto quadrature
2105 
2106   @param[in]  Q           Number of quadrature points (integrates polynomials of degree 2*Q-3 exactly)
2107   @param[out] q_ref_1d    Array of length Q to hold the abscissa on [-1, 1]
2108   @param[out] q_weight_1d Array of length Q to hold the weights
2109 
2110   @return An error code: 0 - success, otherwise - failure
2111 
2112   @ref Utility
2113 **/
2114 int CeedLobattoQuadrature(CeedInt Q, CeedScalar *q_ref_1d, CeedScalar *q_weight_1d) {
2115   CeedScalar P0, P1, P2, dP2, d2P2, xi, wi, PI = 4.0 * atan(1.0);
2116 
2117   // Build q_ref_1d, q_weight_1d
2118   // Set endpoints
2119   CeedCheck(Q > 1, NULL, CEED_ERROR_DIMENSION, "Cannot create Lobatto quadrature with Q=%" CeedInt_FMT " < 2 points", Q);
2120   wi = 2.0 / ((CeedScalar)(Q * (Q - 1)));
2121   if (q_weight_1d) {
2122     q_weight_1d[0]     = wi;
2123     q_weight_1d[Q - 1] = wi;
2124   }
2125   q_ref_1d[0]     = -1.0;
2126   q_ref_1d[Q - 1] = 1.0;
2127   // Interior
2128   for (CeedInt i = 1; i <= (Q - 1) / 2; i++) {
2129     // Guess
2130     xi = cos(PI * (CeedScalar)(i) / (CeedScalar)(Q - 1));
2131     // Pn(xi)
2132     P0 = 1.0;
2133     P1 = xi;
2134     P2 = 0.0;
2135     for (CeedInt j = 2; j < Q; j++) {
2136       P2 = (((CeedScalar)(2 * j - 1)) * xi * P1 - ((CeedScalar)(j - 1)) * P0) / ((CeedScalar)(j));
2137       P0 = P1;
2138       P1 = P2;
2139     }
2140     // First Newton step
2141     dP2  = (xi * P2 - P0) * (CeedScalar)Q / (xi * xi - 1.0);
2142     d2P2 = (2 * xi * dP2 - (CeedScalar)(Q * (Q - 1)) * P2) / (1.0 - xi * xi);
2143     xi   = xi - dP2 / d2P2;
2144     // Newton to convergence
2145     for (CeedInt k = 0; k < 100 && fabs(dP2) > 10 * CEED_EPSILON; k++) {
2146       P0 = 1.0;
2147       P1 = xi;
2148       for (CeedInt j = 2; j < Q; j++) {
2149         P2 = (((CeedScalar)(2 * j - 1)) * xi * P1 - ((CeedScalar)(j - 1)) * P0) / ((CeedScalar)(j));
2150         P0 = P1;
2151         P1 = P2;
2152       }
2153       dP2  = (xi * P2 - P0) * (CeedScalar)Q / (xi * xi - 1.0);
2154       d2P2 = (2 * xi * dP2 - (CeedScalar)(Q * (Q - 1)) * P2) / (1.0 - xi * xi);
2155       xi   = xi - dP2 / d2P2;
2156     }
2157     // Save xi, wi
2158     wi = 2.0 / (((CeedScalar)(Q * (Q - 1))) * P2 * P2);
2159     if (q_weight_1d) {
2160       q_weight_1d[i]         = wi;
2161       q_weight_1d[Q - 1 - i] = wi;
2162     }
2163     q_ref_1d[i]         = -xi;
2164     q_ref_1d[Q - 1 - i] = xi;
2165   }
2166   return CEED_ERROR_SUCCESS;
2167 }
2168 
2169 /// @}
2170