xref: /libCEED/interface/ceed-basis.c (revision aa4b4a9fcfd0e85f86607a23b052958a8bf51783)
1d275d636SJeremy L Thompson // Copyright (c) 2017-2025, Lawrence Livermore National Security, LLC and other CEED contributors.
23d8e8822SJeremy L Thompson // All Rights Reserved. See the top-level LICENSE and NOTICE files for details.
3d7b241e6Sjeremylt //
43d8e8822SJeremy L Thompson // SPDX-License-Identifier: BSD-2-Clause
5d7b241e6Sjeremylt //
63d8e8822SJeremy L Thompson // This file is part of CEED:  http://github.com/ceed
7d7b241e6Sjeremylt 
83d576824SJeremy L Thompson #include <ceed-impl.h>
949aac155SJeremy L Thompson #include <ceed.h>
102b730f8bSJeremy L Thompson #include <ceed/backend.h>
11d7b241e6Sjeremylt #include <math.h>
123d576824SJeremy L Thompson #include <stdbool.h>
13d7b241e6Sjeremylt #include <stdio.h>
14d7b241e6Sjeremylt #include <string.h>
15d7b241e6Sjeremylt 
167a982d89SJeremy L. Thompson /// @file
177a982d89SJeremy L. Thompson /// Implementation of CeedBasis interfaces
187a982d89SJeremy L. Thompson 
19d7b241e6Sjeremylt /// @cond DOXYGEN_SKIP
20356036faSJeremy L Thompson static struct CeedBasis_private ceed_basis_none;
21d7b241e6Sjeremylt /// @endcond
22d7b241e6Sjeremylt 
237a982d89SJeremy L. Thompson /// @addtogroup CeedBasisUser
247a982d89SJeremy L. Thompson /// @{
257a982d89SJeremy L. Thompson 
26ca94c3ddSJeremy L Thompson /// Argument for @ref CeedOperatorSetField() indicating that the field does not require a `CeedBasis`
27356036faSJeremy L Thompson const CeedBasis CEED_BASIS_NONE = &ceed_basis_none;
28356036faSJeremy L Thompson 
297a982d89SJeremy L. Thompson /// @}
307a982d89SJeremy L. Thompson 
317a982d89SJeremy L. Thompson /// ----------------------------------------------------------------------------
327a982d89SJeremy L. Thompson /// CeedBasis Library Internal Functions
337a982d89SJeremy L. Thompson /// ----------------------------------------------------------------------------
347a982d89SJeremy L. Thompson /// @addtogroup CeedBasisDeveloper
357a982d89SJeremy L. Thompson /// @{
367a982d89SJeremy L. Thompson 
377a982d89SJeremy L. Thompson /**
383778dbaaSJeremy L Thompson   @brief Compute Chebyshev polynomial values at a point
393778dbaaSJeremy L Thompson 
403778dbaaSJeremy L Thompson   @param[in]  x           Coordinate to evaluate Chebyshev polynomials at
41ca94c3ddSJeremy L Thompson   @param[in]  n           Number of Chebyshev polynomials to evaluate, `n >= 2`
423778dbaaSJeremy L Thompson   @param[out] chebyshev_x Array of Chebyshev polynomial values
433778dbaaSJeremy L Thompson 
443778dbaaSJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
453778dbaaSJeremy L Thompson 
463778dbaaSJeremy L Thompson   @ref Developer
473778dbaaSJeremy L Thompson **/
483778dbaaSJeremy L Thompson static int CeedChebyshevPolynomialsAtPoint(CeedScalar x, CeedInt n, CeedScalar *chebyshev_x) {
493778dbaaSJeremy L Thompson   chebyshev_x[0] = 1.0;
503778dbaaSJeremy L Thompson   chebyshev_x[1] = 2 * x;
513778dbaaSJeremy L Thompson   for (CeedInt i = 2; i < n; i++) chebyshev_x[i] = 2 * x * chebyshev_x[i - 1] - chebyshev_x[i - 2];
523778dbaaSJeremy L Thompson   return CEED_ERROR_SUCCESS;
533778dbaaSJeremy L Thompson }
543778dbaaSJeremy L Thompson 
553778dbaaSJeremy L Thompson /**
563778dbaaSJeremy L Thompson   @brief Compute values of the derivative of Chebyshev polynomials at a point
573778dbaaSJeremy L Thompson 
583778dbaaSJeremy L Thompson   @param[in]  x            Coordinate to evaluate derivative of Chebyshev polynomials at
59ca94c3ddSJeremy L Thompson   @param[in]  n            Number of Chebyshev polynomials to evaluate, `n >= 2`
606cec60aaSJed Brown   @param[out] chebyshev_dx Array of Chebyshev polynomial derivative values
613778dbaaSJeremy L Thompson 
623778dbaaSJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
633778dbaaSJeremy L Thompson 
643778dbaaSJeremy L Thompson   @ref Developer
653778dbaaSJeremy L Thompson **/
663778dbaaSJeremy L Thompson static int CeedChebyshevDerivativeAtPoint(CeedScalar x, CeedInt n, CeedScalar *chebyshev_dx) {
673778dbaaSJeremy L Thompson   CeedScalar chebyshev_x[3];
683778dbaaSJeremy L Thompson 
693778dbaaSJeremy L Thompson   chebyshev_x[1]  = 1.0;
703778dbaaSJeremy L Thompson   chebyshev_x[2]  = 2 * x;
713778dbaaSJeremy L Thompson   chebyshev_dx[0] = 0.0;
723778dbaaSJeremy L Thompson   chebyshev_dx[1] = 2.0;
733778dbaaSJeremy L Thompson   for (CeedInt i = 2; i < n; i++) {
743778dbaaSJeremy L Thompson     chebyshev_x[0]  = chebyshev_x[1];
753778dbaaSJeremy L Thompson     chebyshev_x[1]  = chebyshev_x[2];
763778dbaaSJeremy L Thompson     chebyshev_x[2]  = 2 * x * chebyshev_x[1] - chebyshev_x[0];
773778dbaaSJeremy L Thompson     chebyshev_dx[i] = 2 * x * chebyshev_dx[i - 1] + 2 * chebyshev_x[1] - chebyshev_dx[i - 2];
783778dbaaSJeremy L Thompson   }
793778dbaaSJeremy L Thompson   return CEED_ERROR_SUCCESS;
803778dbaaSJeremy L Thompson }
813778dbaaSJeremy L Thompson 
823778dbaaSJeremy L Thompson /**
83ca94c3ddSJeremy L Thompson   @brief Compute Householder reflection.
847a982d89SJeremy L. Thompson 
85ca94c3ddSJeremy L Thompson   Computes \f$A = (I - b v v^T) A\f$, where \f$A\f$ is an \f$m \times n\f$ matrix indexed as `A[i*row + j*col]`.
867a982d89SJeremy L. Thompson 
877a982d89SJeremy L. Thompson   @param[in,out] A   Matrix to apply Householder reflection to, in place
88ea61e9acSJeremy L Thompson   @param[in]     v   Householder vector
89ea61e9acSJeremy L Thompson   @param[in]     b   Scaling factor
90ca94c3ddSJeremy L Thompson   @param[in]     m   Number of rows in `A`
91ca94c3ddSJeremy L Thompson   @param[in]     n   Number of columns in `A`
92ea61e9acSJeremy L Thompson   @param[in]     row Row stride
93ea61e9acSJeremy L Thompson   @param[in]     col Col stride
947a982d89SJeremy L. Thompson 
957a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
967a982d89SJeremy L. Thompson 
977a982d89SJeremy L. Thompson   @ref Developer
987a982d89SJeremy L. Thompson **/
992b730f8bSJeremy L Thompson static int CeedHouseholderReflect(CeedScalar *A, const CeedScalar *v, CeedScalar b, CeedInt m, CeedInt n, CeedInt row, CeedInt col) {
1007a982d89SJeremy L. Thompson   for (CeedInt j = 0; j < n; j++) {
1017a982d89SJeremy L. Thompson     CeedScalar w = A[0 * row + j * col];
1021c66c397SJeremy L Thompson 
1032b730f8bSJeremy L Thompson     for (CeedInt i = 1; i < m; i++) w += v[i] * A[i * row + j * col];
1047a982d89SJeremy L. Thompson     A[0 * row + j * col] -= b * w;
1052b730f8bSJeremy L Thompson     for (CeedInt i = 1; i < m; i++) A[i * row + j * col] -= b * w * v[i];
1067a982d89SJeremy L. Thompson   }
107e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
1087a982d89SJeremy L. Thompson }
1097a982d89SJeremy L. Thompson 
1107a982d89SJeremy L. Thompson /**
1117a982d89SJeremy L. Thompson   @brief Compute Givens rotation
1127a982d89SJeremy L. Thompson 
113ca94c3ddSJeremy L Thompson   Computes \f$A = G A\f$ (or \f$G^T A\f$ in transpose mode), where \f$A\f$ is an \f$m \times n\f$ matrix indexed as `A[i*n + j*m]`.
1147a982d89SJeremy L. Thompson 
1157a982d89SJeremy L. Thompson   @param[in,out] A      Row major matrix to apply Givens rotation to, in place
116ea61e9acSJeremy L Thompson   @param[in]     c      Cosine factor
117ea61e9acSJeremy L Thompson   @param[in]     s      Sine factor
118ca94c3ddSJeremy L Thompson   @param[in]     t_mode @ref CEED_NOTRANSPOSE to rotate the basis counter-clockwise, which has the effect of rotating columns of `A` clockwise;
1194cc79fe7SJed Brown                           @ref CEED_TRANSPOSE for the opposite rotation
120ea61e9acSJeremy L Thompson   @param[in]     i      First row/column to apply rotation
121ea61e9acSJeremy L Thompson   @param[in]     k      Second row/column to apply rotation
122ca94c3ddSJeremy L Thompson   @param[in]     m      Number of rows in `A`
123ca94c3ddSJeremy L Thompson   @param[in]     n      Number of columns in `A`
1247a982d89SJeremy L. Thompson 
1257a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
1267a982d89SJeremy L. Thompson 
1277a982d89SJeremy L. Thompson   @ref Developer
1287a982d89SJeremy L. Thompson **/
1292b730f8bSJeremy L Thompson static int CeedGivensRotation(CeedScalar *A, CeedScalar c, CeedScalar s, CeedTransposeMode t_mode, CeedInt i, CeedInt k, CeedInt m, CeedInt n) {
130d1d35e2fSjeremylt   CeedInt stride_j = 1, stride_ik = m, num_its = n;
1311c66c397SJeremy L Thompson 
132d1d35e2fSjeremylt   if (t_mode == CEED_NOTRANSPOSE) {
1332b730f8bSJeremy L Thompson     stride_j  = n;
1342b730f8bSJeremy L Thompson     stride_ik = 1;
1352b730f8bSJeremy L Thompson     num_its   = m;
1367a982d89SJeremy L. Thompson   }
1377a982d89SJeremy L. Thompson 
1387a982d89SJeremy L. Thompson   // Apply rotation
139d1d35e2fSjeremylt   for (CeedInt j = 0; j < num_its; j++) {
140d1d35e2fSjeremylt     CeedScalar tau1 = A[i * stride_ik + j * stride_j], tau2 = A[k * stride_ik + j * stride_j];
1411c66c397SJeremy L Thompson 
142d1d35e2fSjeremylt     A[i * stride_ik + j * stride_j] = c * tau1 - s * tau2;
143d1d35e2fSjeremylt     A[k * stride_ik + j * stride_j] = s * tau1 + c * tau2;
1447a982d89SJeremy L. Thompson   }
145e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
1467a982d89SJeremy L. Thompson }
1477a982d89SJeremy L. Thompson 
1487a982d89SJeremy L. Thompson /**
149ca94c3ddSJeremy L Thompson   @brief View an array stored in a `CeedBasis`
1507a982d89SJeremy L. Thompson 
1510a0da059Sjeremylt   @param[in] name   Name of array
152d1d35e2fSjeremylt   @param[in] fp_fmt Printing format
1530a0da059Sjeremylt   @param[in] m      Number of rows in array
1540a0da059Sjeremylt   @param[in] n      Number of columns in array
1550a0da059Sjeremylt   @param[in] a      Array to be viewed
156ca94c3ddSJeremy L Thompson   @param[in] stream Stream to view to, e.g., `stdout`
1577a982d89SJeremy L. Thompson 
1587a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
1597a982d89SJeremy L. Thompson 
1607a982d89SJeremy L. Thompson   @ref Developer
1617a982d89SJeremy L. Thompson **/
1622b730f8bSJeremy L Thompson static int CeedScalarView(const char *name, const char *fp_fmt, CeedInt m, CeedInt n, const CeedScalar *a, FILE *stream) {
163edf04919SJeremy L Thompson   if (m > 1) {
164edf04919SJeremy L Thompson     fprintf(stream, "  %s:\n", name);
165edf04919SJeremy L Thompson   } else {
166edf04919SJeremy L Thompson     char padded_name[12];
167edf04919SJeremy L Thompson 
168edf04919SJeremy L Thompson     snprintf(padded_name, 11, "%s:", name);
169edf04919SJeremy L Thompson     fprintf(stream, "  %-10s", padded_name);
170edf04919SJeremy L Thompson   }
17192ae7e47SJeremy L Thompson   for (CeedInt i = 0; i < m; i++) {
172edf04919SJeremy L Thompson     if (m > 1) fprintf(stream, "    [%" CeedInt_FMT "]", i);
1732b730f8bSJeremy L Thompson     for (CeedInt j = 0; j < n; j++) fprintf(stream, fp_fmt, fabs(a[i * n + j]) > 1E-14 ? a[i * n + j] : 0);
1747a982d89SJeremy L. Thompson     fputs("\n", stream);
1757a982d89SJeremy L. Thompson   }
176e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
1777a982d89SJeremy L. Thompson }
1787a982d89SJeremy L. Thompson 
179a76a04e7SJeremy L Thompson /**
180ea61e9acSJeremy L Thompson   @brief Create the interpolation and gradient matrices for projection from the nodes of `basis_from` to the nodes of `basis_to`.
181ba59ac12SSebastian Grimberg 
18215ad3917SSebastian Grimberg   The interpolation is given by `interp_project = interp_to^+ * interp_from`, where the pseudoinverse `interp_to^+` is given by QR factorization.
183ca94c3ddSJeremy L Thompson   The gradient is given by `grad_project = interp_to^+ * grad_from`, and is only computed for \f$H^1\f$ spaces otherwise it should not be used.
18415ad3917SSebastian Grimberg 
185ba59ac12SSebastian Grimberg   Note: `basis_from` and `basis_to` must have compatible quadrature spaces.
186a76a04e7SJeremy L Thompson 
187ca94c3ddSJeremy L Thompson   @param[in]  basis_from     `CeedBasis` to project from
188ca94c3ddSJeremy L Thompson   @param[in]  basis_to       `CeedBasis` to project to
189ca94c3ddSJeremy L Thompson   @param[out] interp_project Address of the variable where the newly created interpolation matrix will be stored
190ca94c3ddSJeremy L Thompson   @param[out] grad_project   Address of the variable where the newly created gradient matrix will be stored
191a76a04e7SJeremy L Thompson 
192a76a04e7SJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
193a76a04e7SJeremy L Thompson 
194a76a04e7SJeremy L Thompson   @ref Developer
195a76a04e7SJeremy L Thompson **/
1962b730f8bSJeremy L Thompson static int CeedBasisCreateProjectionMatrices(CeedBasis basis_from, CeedBasis basis_to, CeedScalar **interp_project, CeedScalar **grad_project) {
197e104ad11SJames Wright   bool    are_both_tensor;
1981c66c397SJeremy L Thompson   CeedInt Q, Q_to, Q_from, P_to, P_from;
1991c66c397SJeremy L Thompson 
200a76a04e7SJeremy L Thompson   // Check for compatible quadrature spaces
2012b730f8bSJeremy L Thompson   CeedCall(CeedBasisGetNumQuadraturePoints(basis_to, &Q_to));
2022b730f8bSJeremy L Thompson   CeedCall(CeedBasisGetNumQuadraturePoints(basis_from, &Q_from));
2039bc66399SJeremy L Thompson   CeedCheck(Q_to == Q_from, CeedBasisReturnCeed(basis_to), CEED_ERROR_DIMENSION,
2043f08121cSJeremy L Thompson             "Bases must have compatible quadrature spaces."
20523622755SJeremy L Thompson             " 'basis_from' has %" CeedInt_FMT " points and 'basis_to' has %" CeedInt_FMT,
2063f08121cSJeremy L Thompson             Q_from, Q_to);
2071c66c397SJeremy L Thompson   Q = Q_to;
208a76a04e7SJeremy L Thompson 
20914556e63SJeremy L Thompson   // Check for matching tensor or non-tensor
210e104ad11SJames Wright   {
211e104ad11SJames Wright     bool is_tensor_to, is_tensor_from;
212e104ad11SJames Wright 
2132b730f8bSJeremy L Thompson     CeedCall(CeedBasisIsTensor(basis_to, &is_tensor_to));
2142b730f8bSJeremy L Thompson     CeedCall(CeedBasisIsTensor(basis_from, &is_tensor_from));
215e104ad11SJames Wright     are_both_tensor = is_tensor_to && is_tensor_from;
216e104ad11SJames Wright   }
217e104ad11SJames Wright   if (are_both_tensor) {
2182b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumNodes1D(basis_to, &P_to));
2192b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumNodes1D(basis_from, &P_from));
2202b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumQuadraturePoints1D(basis_from, &Q));
2216574a04fSJeremy L Thompson   } else {
2222b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumNodes(basis_to, &P_to));
2232b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumNodes(basis_from, &P_from));
224a76a04e7SJeremy L Thompson   }
225a76a04e7SJeremy L Thompson 
22615ad3917SSebastian Grimberg   // Check for matching FE space
22715ad3917SSebastian Grimberg   CeedFESpace fe_space_to, fe_space_from;
2283f08121cSJeremy L Thompson 
22915ad3917SSebastian Grimberg   CeedCall(CeedBasisGetFESpace(basis_to, &fe_space_to));
23015ad3917SSebastian Grimberg   CeedCall(CeedBasisGetFESpace(basis_from, &fe_space_from));
2319bc66399SJeremy L Thompson   CeedCheck(fe_space_to == fe_space_from, CeedBasisReturnCeed(basis_to), CEED_ERROR_MINOR,
2323f08121cSJeremy L Thompson             "Bases must both be the same FE space type."
2333f08121cSJeremy L Thompson             " 'basis_from' is a %s and 'basis_to' is a %s",
2343f08121cSJeremy L Thompson             CeedFESpaces[fe_space_from], CeedFESpaces[fe_space_to]);
23515ad3917SSebastian Grimberg 
23614556e63SJeremy L Thompson   // Get source matrices
23715ad3917SSebastian Grimberg   CeedInt           dim, q_comp = 1;
2382247a93fSRezgar Shakeri   CeedScalar       *interp_to_inv, *interp_from;
2391c66c397SJeremy L Thompson   const CeedScalar *interp_to_source = NULL, *interp_from_source = NULL, *grad_from_source = NULL;
2401c66c397SJeremy L Thompson 
241b3ed00e5SJames Wright   CeedCall(CeedBasisGetDimension(basis_from, &dim));
242e104ad11SJames Wright   if (are_both_tensor) {
2432b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetInterp1D(basis_to, &interp_to_source));
2442b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetInterp1D(basis_from, &interp_from_source));
245a76a04e7SJeremy L Thompson   } else {
24615ad3917SSebastian Grimberg     CeedCall(CeedBasisGetNumQuadratureComponents(basis_from, CEED_EVAL_INTERP, &q_comp));
2472b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetInterp(basis_to, &interp_to_source));
2482b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetInterp(basis_from, &interp_from_source));
24915ad3917SSebastian Grimberg   }
25015ad3917SSebastian Grimberg   CeedCall(CeedMalloc(Q * P_from * q_comp, &interp_from));
25115ad3917SSebastian Grimberg   CeedCall(CeedCalloc(P_to * P_from, interp_project));
25215ad3917SSebastian Grimberg 
25315ad3917SSebastian Grimberg   // `grad_project = interp_to^+ * grad_from` is computed for the H^1 space case so the
254de05fbb2SSebastian Grimberg   // projection basis will have a gradient operation (allocated even if not H^1 for the
255de05fbb2SSebastian Grimberg   // basis construction later on)
25615ad3917SSebastian Grimberg   if (fe_space_to == CEED_FE_SPACE_H1) {
257e104ad11SJames Wright     if (are_both_tensor) {
25815ad3917SSebastian Grimberg       CeedCall(CeedBasisGetGrad1D(basis_from, &grad_from_source));
25915ad3917SSebastian Grimberg     } else {
2602b730f8bSJeremy L Thompson       CeedCall(CeedBasisGetGrad(basis_from, &grad_from_source));
261a76a04e7SJeremy L Thompson     }
262de05fbb2SSebastian Grimberg   }
263e104ad11SJames Wright   CeedCall(CeedCalloc(P_to * P_from * (are_both_tensor ? 1 : dim), grad_project));
26415ad3917SSebastian Grimberg 
2652247a93fSRezgar Shakeri   // Compute interp_to^+, pseudoinverse of interp_to
2662247a93fSRezgar Shakeri   CeedCall(CeedCalloc(Q * q_comp * P_to, &interp_to_inv));
2679bc66399SJeremy L Thompson   CeedCall(CeedMatrixPseudoinverse(CeedBasisReturnCeed(basis_to), interp_to_source, Q * q_comp, P_to, interp_to_inv));
26814556e63SJeremy L Thompson   // Build matrices
269e104ad11SJames Wright   CeedInt     num_matrices = 1 + (fe_space_to == CEED_FE_SPACE_H1) * (are_both_tensor ? 1 : dim);
27014556e63SJeremy L Thompson   CeedScalar *input_from[num_matrices], *output_project[num_matrices];
2711c66c397SJeremy L Thompson 
27214556e63SJeremy L Thompson   input_from[0]     = (CeedScalar *)interp_from_source;
27314556e63SJeremy L Thompson   output_project[0] = *interp_project;
27414556e63SJeremy L Thompson   for (CeedInt m = 1; m < num_matrices; m++) {
27514556e63SJeremy L Thompson     input_from[m]     = (CeedScalar *)&grad_from_source[(m - 1) * Q * P_from];
27602af4036SJeremy L Thompson     output_project[m] = &((*grad_project)[(m - 1) * P_to * P_from]);
27714556e63SJeremy L Thompson   }
27814556e63SJeremy L Thompson   for (CeedInt m = 0; m < num_matrices; m++) {
2792247a93fSRezgar Shakeri     // output_project = interp_to^+ * interp_from
28015ad3917SSebastian Grimberg     memcpy(interp_from, input_from[m], Q * P_from * q_comp * sizeof(input_from[m][0]));
2819bc66399SJeremy L Thompson     CeedCall(CeedMatrixMatrixMultiply(CeedBasisReturnCeed(basis_to), interp_to_inv, input_from[m], output_project[m], P_to, P_from, Q * q_comp));
2822247a93fSRezgar Shakeri     // Round zero to machine precision
2832247a93fSRezgar Shakeri     for (CeedInt i = 0; i < P_to * P_from; i++) {
2842247a93fSRezgar Shakeri       if (fabs(output_project[m][i]) < 10 * CEED_EPSILON) output_project[m][i] = 0.0;
285a76a04e7SJeremy L Thompson     }
28614556e63SJeremy L Thompson   }
28714556e63SJeremy L Thompson 
28814556e63SJeremy L Thompson   // Cleanup
2892247a93fSRezgar Shakeri   CeedCall(CeedFree(&interp_to_inv));
2902b730f8bSJeremy L Thompson   CeedCall(CeedFree(&interp_from));
291a76a04e7SJeremy L Thompson   return CEED_ERROR_SUCCESS;
292a76a04e7SJeremy L Thompson }
293a76a04e7SJeremy L Thompson 
2940b31fde2SJeremy L Thompson /**
2956ab8e59fSJames Wright   @brief Check input vector dimensions for CeedBasisApply[Add]
2966ab8e59fSJames Wright 
2976ab8e59fSJames Wright   @param[in]  basis     `CeedBasis` to evaluate
2986ab8e59fSJames Wright   @param[in]  num_elem  The number of elements to apply the basis evaluation to;
2996ab8e59fSJames Wright                           the backend will specify the ordering in @ref CeedElemRestrictionCreate()
3006ab8e59fSJames Wright   @param[in]  t_mode    @ref CEED_NOTRANSPOSE to evaluate from nodes to quadrature points;
3016ab8e59fSJames Wright                           @ref CEED_TRANSPOSE to apply the transpose, mapping from quadrature points to nodes
3026ab8e59fSJames Wright   @param[in]  eval_mode @ref CEED_EVAL_NONE to use values directly,
3036ab8e59fSJames Wright                           @ref CEED_EVAL_INTERP to use interpolated values,
3046ab8e59fSJames Wright                           @ref CEED_EVAL_GRAD to use gradients,
3056ab8e59fSJames Wright                           @ref CEED_EVAL_DIV to use divergence,
3066ab8e59fSJames Wright                           @ref CEED_EVAL_CURL to use curl,
3076ab8e59fSJames Wright                           @ref CEED_EVAL_WEIGHT to use quadrature weights
3086ab8e59fSJames Wright   @param[in]  u         Input `CeedVector`
3096ab8e59fSJames Wright   @param[out] v         Output `CeedVector`
3106ab8e59fSJames Wright 
3116ab8e59fSJames Wright   @return An error code: 0 - success, otherwise - failure
3126ab8e59fSJames Wright 
3136ab8e59fSJames Wright   @ref Developer
3146ab8e59fSJames Wright **/
3156ab8e59fSJames Wright static int CeedBasisApplyCheckDims(CeedBasis basis, CeedInt num_elem, CeedTransposeMode t_mode, CeedEvalMode eval_mode, CeedVector u, CeedVector v) {
3166ab8e59fSJames Wright   CeedInt  dim, num_comp, q_comp, num_nodes, num_qpts;
3176ab8e59fSJames Wright   CeedSize u_length = 0, v_length;
3186ab8e59fSJames Wright 
3196ab8e59fSJames Wright   CeedCall(CeedBasisGetDimension(basis, &dim));
3206ab8e59fSJames Wright   CeedCall(CeedBasisGetNumComponents(basis, &num_comp));
3216ab8e59fSJames Wright   CeedCall(CeedBasisGetNumQuadratureComponents(basis, eval_mode, &q_comp));
3226ab8e59fSJames Wright   CeedCall(CeedBasisGetNumNodes(basis, &num_nodes));
3236ab8e59fSJames Wright   CeedCall(CeedBasisGetNumQuadraturePoints(basis, &num_qpts));
3246ab8e59fSJames Wright   CeedCall(CeedVectorGetLength(v, &v_length));
3256ab8e59fSJames Wright   if (u) CeedCall(CeedVectorGetLength(u, &u_length));
3266ab8e59fSJames Wright 
3276ab8e59fSJames Wright   // Check vector lengths to prevent out of bounds issues
3286ab8e59fSJames Wright   bool has_good_dims = true;
3296ab8e59fSJames Wright   switch (eval_mode) {
3306ab8e59fSJames Wright     case CEED_EVAL_NONE:
3316ab8e59fSJames Wright     case CEED_EVAL_INTERP:
3326ab8e59fSJames Wright     case CEED_EVAL_GRAD:
3336ab8e59fSJames Wright     case CEED_EVAL_DIV:
3346ab8e59fSJames Wright     case CEED_EVAL_CURL:
3356ab8e59fSJames Wright       has_good_dims = ((t_mode == CEED_TRANSPOSE && u_length >= (CeedSize)num_elem * (CeedSize)num_comp * (CeedSize)num_qpts * (CeedSize)q_comp &&
3366ab8e59fSJames Wright                         v_length >= (CeedSize)num_elem * (CeedSize)num_comp * (CeedSize)num_nodes) ||
3376ab8e59fSJames Wright                        (t_mode == CEED_NOTRANSPOSE && v_length >= (CeedSize)num_elem * (CeedSize)num_qpts * (CeedSize)num_comp * (CeedSize)q_comp &&
3386ab8e59fSJames Wright                         u_length >= (CeedSize)num_elem * (CeedSize)num_comp * (CeedSize)num_nodes));
3396ab8e59fSJames Wright       break;
3406ab8e59fSJames Wright     case CEED_EVAL_WEIGHT:
3416ab8e59fSJames Wright       has_good_dims = v_length >= (CeedSize)num_elem * (CeedSize)num_qpts;
3426ab8e59fSJames Wright       break;
3436ab8e59fSJames Wright   }
3446ab8e59fSJames Wright   CeedCheck(has_good_dims, CeedBasisReturnCeed(basis), CEED_ERROR_DIMENSION, "Input/output vectors too short for basis and evaluation mode");
3456ab8e59fSJames Wright   return CEED_ERROR_SUCCESS;
3466ab8e59fSJames Wright }
3476ab8e59fSJames Wright 
3486ab8e59fSJames Wright /**
3490b31fde2SJeremy L Thompson   @brief Check input vector dimensions for CeedBasisApply[Add]AtPoints
3500b31fde2SJeremy L Thompson 
3510b31fde2SJeremy L Thompson   @param[in]  basis      `CeedBasis` to evaluate
3520b31fde2SJeremy L Thompson   @param[in]  num_elem   The number of elements to apply the basis evaluation to;
3530b31fde2SJeremy L Thompson                           the backend will specify the ordering in @ref CeedElemRestrictionCreate()
3540b31fde2SJeremy L Thompson   @param[in]  num_points Array of the number of points to apply the basis evaluation to in each element, size `num_elem`
3550b31fde2SJeremy L Thompson   @param[in]  t_mode     @ref CEED_NOTRANSPOSE to evaluate from nodes to points;
3560b31fde2SJeremy L Thompson                            @ref CEED_TRANSPOSE to apply the transpose, mapping from points to nodes
3570b31fde2SJeremy L Thompson   @param[in]  eval_mode  @ref CEED_EVAL_INTERP to use interpolated values,
3580b31fde2SJeremy L Thompson                            @ref CEED_EVAL_GRAD to use gradients,
3590b31fde2SJeremy L Thompson                            @ref CEED_EVAL_WEIGHT to use quadrature weights
3600b31fde2SJeremy L Thompson   @param[in]  x_ref      `CeedVector` holding reference coordinates of each point
3610b31fde2SJeremy L Thompson   @param[in]  u          Input `CeedVector`, of length `num_nodes * num_comp` for @ref CEED_NOTRANSPOSE
3620b31fde2SJeremy L Thompson   @param[out] v          Output `CeedVector`, of length `num_points * num_q_comp` for @ref CEED_NOTRANSPOSE with @ref CEED_EVAL_INTERP
3630b31fde2SJeremy L Thompson 
3640b31fde2SJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
3650b31fde2SJeremy L Thompson 
3660b31fde2SJeremy L Thompson   @ref Developer
3670b31fde2SJeremy L Thompson **/
3680b31fde2SJeremy L Thompson static int CeedBasisApplyAtPointsCheckDims(CeedBasis basis, CeedInt num_elem, const CeedInt *num_points, CeedTransposeMode t_mode,
3690b31fde2SJeremy L Thompson                                            CeedEvalMode eval_mode, CeedVector x_ref, CeedVector u, CeedVector v) {
3700b31fde2SJeremy L Thompson   CeedInt  dim, num_comp, num_q_comp, num_nodes, P_1d = 1, Q_1d = 1, total_num_points = 0;
3710b31fde2SJeremy L Thompson   CeedSize x_length = 0, u_length = 0, v_length;
3720b31fde2SJeremy L Thompson 
3730b31fde2SJeremy L Thompson   CeedCall(CeedBasisGetDimension(basis, &dim));
3740b31fde2SJeremy L Thompson   CeedCall(CeedBasisGetNumNodes1D(basis, &P_1d));
3750b31fde2SJeremy L Thompson   CeedCall(CeedBasisGetNumQuadraturePoints1D(basis, &Q_1d));
3760b31fde2SJeremy L Thompson   CeedCall(CeedBasisGetNumComponents(basis, &num_comp));
3770b31fde2SJeremy L Thompson   CeedCall(CeedBasisGetNumQuadratureComponents(basis, eval_mode, &num_q_comp));
3780b31fde2SJeremy L Thompson   CeedCall(CeedBasisGetNumNodes(basis, &num_nodes));
3790b31fde2SJeremy L Thompson   CeedCall(CeedVectorGetLength(v, &v_length));
3800b31fde2SJeremy L Thompson   if (x_ref != CEED_VECTOR_NONE) CeedCall(CeedVectorGetLength(x_ref, &x_length));
3810b31fde2SJeremy L Thompson   if (u != CEED_VECTOR_NONE) CeedCall(CeedVectorGetLength(u, &u_length));
3820b31fde2SJeremy L Thompson 
3830b31fde2SJeremy L Thompson   // Check compatibility coordinates vector
3840b31fde2SJeremy L Thompson   for (CeedInt i = 0; i < num_elem; i++) total_num_points += num_points[i];
3859bc66399SJeremy L Thompson   CeedCheck((x_length >= (CeedSize)total_num_points * (CeedSize)dim) || (eval_mode == CEED_EVAL_WEIGHT), CeedBasisReturnCeed(basis),
3869bc66399SJeremy L Thompson             CEED_ERROR_DIMENSION,
3870b31fde2SJeremy L Thompson             "Length of reference coordinate vector incompatible with basis dimension and number of points."
3880b31fde2SJeremy L Thompson             " Found reference coordinate vector of length %" CeedSize_FMT ", not of length %" CeedSize_FMT ".",
38919a04db8SJeremy L Thompson             x_length, (CeedSize)total_num_points * (CeedSize)dim);
3900b31fde2SJeremy L Thompson 
3910b31fde2SJeremy L Thompson   // Check CEED_EVAL_WEIGHT only on CEED_NOTRANSPOSE
3929bc66399SJeremy L Thompson   CeedCheck(eval_mode != CEED_EVAL_WEIGHT || t_mode == CEED_NOTRANSPOSE, CeedBasisReturnCeed(basis), CEED_ERROR_UNSUPPORTED,
3930b31fde2SJeremy L Thompson             "CEED_EVAL_WEIGHT only supported with CEED_NOTRANSPOSE");
3940b31fde2SJeremy L Thompson 
3950b31fde2SJeremy L Thompson   // Check vector lengths to prevent out of bounds issues
3960b31fde2SJeremy L Thompson   bool has_good_dims = true;
3970b31fde2SJeremy L Thompson   switch (eval_mode) {
3980b31fde2SJeremy L Thompson     case CEED_EVAL_INTERP:
39919a04db8SJeremy L Thompson       has_good_dims = ((t_mode == CEED_TRANSPOSE && (u_length >= (CeedSize)total_num_points * (CeedSize)num_q_comp ||
40019a04db8SJeremy L Thompson                                                      v_length >= (CeedSize)num_elem * (CeedSize)num_nodes * (CeedSize)num_comp)) ||
40119a04db8SJeremy L Thompson                        (t_mode == CEED_NOTRANSPOSE && (v_length >= (CeedSize)total_num_points * (CeedSize)num_q_comp ||
40219a04db8SJeremy L Thompson                                                        u_length >= (CeedSize)num_elem * (CeedSize)num_nodes * (CeedSize)num_comp)));
4030b31fde2SJeremy L Thompson       break;
4040b31fde2SJeremy L Thompson     case CEED_EVAL_GRAD:
40519a04db8SJeremy L Thompson       has_good_dims = ((t_mode == CEED_TRANSPOSE && (u_length >= (CeedSize)total_num_points * (CeedSize)num_q_comp * (CeedSize)dim ||
40619a04db8SJeremy L Thompson                                                      v_length >= (CeedSize)num_elem * (CeedSize)num_nodes * (CeedSize)num_comp)) ||
40719a04db8SJeremy L Thompson                        (t_mode == CEED_NOTRANSPOSE && (v_length >= (CeedSize)total_num_points * (CeedSize)num_q_comp * (CeedSize)dim ||
40819a04db8SJeremy L Thompson                                                        u_length >= (CeedSize)num_elem * (CeedSize)num_nodes * (CeedSize)num_comp)));
4090b31fde2SJeremy L Thompson       break;
4100b31fde2SJeremy L Thompson     case CEED_EVAL_WEIGHT:
4110b31fde2SJeremy L Thompson       has_good_dims = t_mode == CEED_NOTRANSPOSE && (v_length >= total_num_points);
4120b31fde2SJeremy L Thompson       break;
4130b31fde2SJeremy L Thompson       // LCOV_EXCL_START
4140b31fde2SJeremy L Thompson     case CEED_EVAL_NONE:
4150b31fde2SJeremy L Thompson     case CEED_EVAL_DIV:
4160b31fde2SJeremy L Thompson     case CEED_EVAL_CURL:
4179bc66399SJeremy L Thompson       return CeedError(CeedBasisReturnCeed(basis), CEED_ERROR_UNSUPPORTED, "Evaluation at arbitrary points not supported for %s",
4189bc66399SJeremy L Thompson                        CeedEvalModes[eval_mode]);
4190b31fde2SJeremy L Thompson       // LCOV_EXCL_STOP
4200b31fde2SJeremy L Thompson   }
4219bc66399SJeremy L Thompson   CeedCheck(has_good_dims, CeedBasisReturnCeed(basis), CEED_ERROR_DIMENSION, "Input/output vectors too short for basis and evaluation mode");
4220b31fde2SJeremy L Thompson   return CEED_ERROR_SUCCESS;
4230b31fde2SJeremy L Thompson }
4240b31fde2SJeremy L Thompson 
4250b31fde2SJeremy L Thompson /**
4260b31fde2SJeremy L Thompson   @brief Default implimentation to apply basis evaluation from nodes to arbitrary points
4270b31fde2SJeremy L Thompson 
4280b31fde2SJeremy L Thompson   @param[in]  basis      `CeedBasis` to evaluate
4290b31fde2SJeremy L Thompson   @param[in]  apply_add  Sum result into target vector or overwrite
4300b31fde2SJeremy L Thompson   @param[in]  num_elem   The number of elements to apply the basis evaluation to;
4310b31fde2SJeremy L Thompson                           the backend will specify the ordering in @ref CeedElemRestrictionCreate()
4320b31fde2SJeremy L Thompson   @param[in]  num_points Array of the number of points to apply the basis evaluation to in each element, size `num_elem`
4330b31fde2SJeremy L Thompson   @param[in]  t_mode     @ref CEED_NOTRANSPOSE to evaluate from nodes to points;
4340b31fde2SJeremy L Thompson                            @ref CEED_TRANSPOSE to apply the transpose, mapping from points to nodes
4350b31fde2SJeremy L Thompson   @param[in]  eval_mode  @ref CEED_EVAL_INTERP to use interpolated values,
4360b31fde2SJeremy L Thompson                            @ref CEED_EVAL_GRAD to use gradients,
4370b31fde2SJeremy L Thompson                            @ref CEED_EVAL_WEIGHT to use quadrature weights
4380b31fde2SJeremy L Thompson   @param[in]  x_ref      `CeedVector` holding reference coordinates of each point
4390b31fde2SJeremy L Thompson   @param[in]  u          Input `CeedVector`, of length `num_nodes * num_comp` for @ref CEED_NOTRANSPOSE
4400b31fde2SJeremy L Thompson   @param[out] v          Output `CeedVector`, of length `num_points * num_q_comp` for @ref CEED_NOTRANSPOSE with @ref CEED_EVAL_INTERP
4410b31fde2SJeremy L Thompson 
4420b31fde2SJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
4430b31fde2SJeremy L Thompson 
4440b31fde2SJeremy L Thompson   @ref Developer
4450b31fde2SJeremy L Thompson **/
4460b31fde2SJeremy L Thompson static int CeedBasisApplyAtPoints_Core(CeedBasis basis, bool apply_add, CeedInt num_elem, const CeedInt *num_points, CeedTransposeMode t_mode,
4470b31fde2SJeremy L Thompson                                        CeedEvalMode eval_mode, CeedVector x_ref, CeedVector u, CeedVector v) {
4480b31fde2SJeremy L Thompson   CeedInt dim, num_comp, P_1d = 1, Q_1d = 1, total_num_points = num_points[0];
4490b31fde2SJeremy L Thompson 
4500b31fde2SJeremy L Thompson   CeedCall(CeedBasisGetDimension(basis, &dim));
4510b31fde2SJeremy L Thompson   // Inserting check because clang-tidy doesn't understand this cannot occur
4529bc66399SJeremy L Thompson   CeedCheck(dim > 0, CeedBasisReturnCeed(basis), CEED_ERROR_UNSUPPORTED, "Malformed CeedBasis, dim > 0 is required");
4530b31fde2SJeremy L Thompson   CeedCall(CeedBasisGetNumNodes1D(basis, &P_1d));
4540b31fde2SJeremy L Thompson   CeedCall(CeedBasisGetNumQuadraturePoints1D(basis, &Q_1d));
4550b31fde2SJeremy L Thompson   CeedCall(CeedBasisGetNumComponents(basis, &num_comp));
4560b31fde2SJeremy L Thompson 
4570b31fde2SJeremy L Thompson   // Default implementation
4580b31fde2SJeremy L Thompson   {
4590b31fde2SJeremy L Thompson     bool is_tensor_basis;
4600b31fde2SJeremy L Thompson 
4610b31fde2SJeremy L Thompson     CeedCall(CeedBasisIsTensor(basis, &is_tensor_basis));
4629bc66399SJeremy L Thompson     CeedCheck(is_tensor_basis, CeedBasisReturnCeed(basis), CEED_ERROR_UNSUPPORTED,
4639bc66399SJeremy L Thompson               "Evaluation at arbitrary points only supported for tensor product bases");
4640b31fde2SJeremy L Thompson   }
4659bc66399SJeremy L Thompson   CeedCheck(num_elem == 1, CeedBasisReturnCeed(basis), CEED_ERROR_UNSUPPORTED,
4669bc66399SJeremy L Thompson             "Evaluation at arbitrary  points only supported for a single element at a time");
4670b31fde2SJeremy L Thompson   if (eval_mode == CEED_EVAL_WEIGHT) {
4680b31fde2SJeremy L Thompson     CeedCall(CeedVectorSetValue(v, 1.0));
4690b31fde2SJeremy L Thompson     return CEED_ERROR_SUCCESS;
4700b31fde2SJeremy L Thompson   }
4710b31fde2SJeremy L Thompson   if (!basis->basis_chebyshev) {
4720b31fde2SJeremy L Thompson     // Build basis mapping from nodes to Chebyshev coefficients
4730b31fde2SJeremy L Thompson     CeedScalar       *chebyshev_interp_1d, *chebyshev_grad_1d, *chebyshev_q_weight_1d;
4740b31fde2SJeremy L Thompson     const CeedScalar *q_ref_1d;
4759bc66399SJeremy L Thompson     Ceed              ceed;
4760b31fde2SJeremy L Thompson 
4770b31fde2SJeremy L Thompson     CeedCall(CeedCalloc(P_1d * Q_1d, &chebyshev_interp_1d));
4780b31fde2SJeremy L Thompson     CeedCall(CeedCalloc(P_1d * Q_1d, &chebyshev_grad_1d));
4790b31fde2SJeremy L Thompson     CeedCall(CeedCalloc(Q_1d, &chebyshev_q_weight_1d));
4800b31fde2SJeremy L Thompson     CeedCall(CeedBasisGetQRef(basis, &q_ref_1d));
4810b31fde2SJeremy L Thompson     CeedCall(CeedBasisGetChebyshevInterp1D(basis, chebyshev_interp_1d));
4820b31fde2SJeremy L Thompson 
4839bc66399SJeremy L Thompson     CeedCall(CeedBasisGetCeed(basis, &ceed));
4840b31fde2SJeremy L Thompson     CeedCall(CeedVectorCreate(ceed, num_comp * CeedIntPow(Q_1d, dim), &basis->vec_chebyshev));
4850b31fde2SJeremy L Thompson     CeedCall(CeedBasisCreateTensorH1(ceed, dim, num_comp, P_1d, Q_1d, chebyshev_interp_1d, chebyshev_grad_1d, q_ref_1d, chebyshev_q_weight_1d,
4860b31fde2SJeremy L Thompson                                      &basis->basis_chebyshev));
4870b31fde2SJeremy L Thompson 
4880b31fde2SJeremy L Thompson     // Cleanup
4890b31fde2SJeremy L Thompson     CeedCall(CeedFree(&chebyshev_interp_1d));
4900b31fde2SJeremy L Thompson     CeedCall(CeedFree(&chebyshev_grad_1d));
4910b31fde2SJeremy L Thompson     CeedCall(CeedFree(&chebyshev_q_weight_1d));
4929bc66399SJeremy L Thompson     CeedCall(CeedDestroy(&ceed));
4930b31fde2SJeremy L Thompson   }
4940b31fde2SJeremy L Thompson 
4950b31fde2SJeremy L Thompson   // Create TensorContract object if needed, such as a basis from the GPU backends
4960b31fde2SJeremy L Thompson   if (!basis->contract) {
4970b31fde2SJeremy L Thompson     Ceed      ceed_ref;
4980b31fde2SJeremy L Thompson     CeedBasis basis_ref = NULL;
4990b31fde2SJeremy L Thompson 
5000b31fde2SJeremy L Thompson     CeedCall(CeedInit("/cpu/self", &ceed_ref));
5010b31fde2SJeremy L Thompson     // Only need matching tensor contraction dimensions, any type of basis will work
5020b31fde2SJeremy L Thompson     CeedCall(CeedBasisCreateTensorH1Lagrange(ceed_ref, dim, num_comp, P_1d, Q_1d, CEED_GAUSS, &basis_ref));
5030b31fde2SJeremy L Thompson     // Note - clang-tidy doesn't know basis_ref->contract must be valid here
5049bc66399SJeremy L Thompson     CeedCheck(basis_ref && basis_ref->contract, CeedBasisReturnCeed(basis), CEED_ERROR_UNSUPPORTED,
5059bc66399SJeremy L Thompson               "Reference CPU ceed failed to create a tensor contraction object");
5060b31fde2SJeremy L Thompson     CeedCall(CeedTensorContractReferenceCopy(basis_ref->contract, &basis->contract));
5070b31fde2SJeremy L Thompson     CeedCall(CeedBasisDestroy(&basis_ref));
5080b31fde2SJeremy L Thompson     CeedCall(CeedDestroy(&ceed_ref));
5090b31fde2SJeremy L Thompson   }
5100b31fde2SJeremy L Thompson 
5110b31fde2SJeremy L Thompson   // Basis evaluation
5120b31fde2SJeremy L Thompson   switch (t_mode) {
5130b31fde2SJeremy L Thompson     case CEED_NOTRANSPOSE: {
5140b31fde2SJeremy L Thompson       // Nodes to arbitrary points
5150b31fde2SJeremy L Thompson       CeedScalar       *v_array;
5160b31fde2SJeremy L Thompson       const CeedScalar *chebyshev_coeffs, *x_array_read;
5170b31fde2SJeremy L Thompson 
5180b31fde2SJeremy L Thompson       // -- Interpolate to Chebyshev coefficients
5190b31fde2SJeremy L Thompson       CeedCall(CeedBasisApply(basis->basis_chebyshev, 1, CEED_NOTRANSPOSE, CEED_EVAL_INTERP, u, basis->vec_chebyshev));
5200b31fde2SJeremy L Thompson 
5210b31fde2SJeremy L Thompson       // -- Evaluate Chebyshev polynomials at arbitrary points
5220b31fde2SJeremy L Thompson       CeedCall(CeedVectorGetArrayRead(basis->vec_chebyshev, CEED_MEM_HOST, &chebyshev_coeffs));
5230b31fde2SJeremy L Thompson       CeedCall(CeedVectorGetArrayRead(x_ref, CEED_MEM_HOST, &x_array_read));
5240b31fde2SJeremy L Thompson       CeedCall(CeedVectorGetArrayWrite(v, CEED_MEM_HOST, &v_array));
5250b31fde2SJeremy L Thompson       switch (eval_mode) {
5260b31fde2SJeremy L Thompson         case CEED_EVAL_INTERP: {
5270b31fde2SJeremy L Thompson           CeedScalar tmp[2][num_comp * CeedIntPow(Q_1d, dim)], chebyshev_x[Q_1d];
5280b31fde2SJeremy L Thompson 
5290b31fde2SJeremy L Thompson           // ---- Values at point
5300b31fde2SJeremy L Thompson           for (CeedInt p = 0; p < total_num_points; p++) {
5310b31fde2SJeremy L Thompson             CeedInt pre = num_comp * CeedIntPow(Q_1d, dim - 1), post = 1;
5320b31fde2SJeremy L Thompson 
5330b31fde2SJeremy L Thompson             for (CeedInt d = 0; d < dim; d++) {
5340b31fde2SJeremy L Thompson               // ------ Tensor contract with current Chebyshev polynomial values
5350b31fde2SJeremy L Thompson               CeedCall(CeedChebyshevPolynomialsAtPoint(x_array_read[d * total_num_points + p], Q_1d, chebyshev_x));
5360b31fde2SJeremy L Thompson               CeedCall(CeedTensorContractApply(basis->contract, pre, Q_1d, post, 1, chebyshev_x, t_mode, false,
5370b31fde2SJeremy L Thompson                                                d == 0 ? chebyshev_coeffs : tmp[d % 2], tmp[(d + 1) % 2]));
5380b31fde2SJeremy L Thompson               pre /= Q_1d;
5390b31fde2SJeremy L Thompson               post *= 1;
5400b31fde2SJeremy L Thompson             }
5410b31fde2SJeremy L Thompson             for (CeedInt c = 0; c < num_comp; c++) v_array[c * total_num_points + p] = tmp[dim % 2][c];
5420b31fde2SJeremy L Thompson           }
5430b31fde2SJeremy L Thompson           break;
5440b31fde2SJeremy L Thompson         }
5450b31fde2SJeremy L Thompson         case CEED_EVAL_GRAD: {
5460b31fde2SJeremy L Thompson           CeedScalar tmp[2][num_comp * CeedIntPow(Q_1d, dim)], chebyshev_x[Q_1d];
5470b31fde2SJeremy L Thompson 
5480b31fde2SJeremy L Thompson           // ---- Values at point
5490b31fde2SJeremy L Thompson           for (CeedInt p = 0; p < total_num_points; p++) {
5500b31fde2SJeremy L Thompson             // Dim**2 contractions, apply grad when pass == dim
5510b31fde2SJeremy L Thompson             for (CeedInt pass = 0; pass < dim; pass++) {
5520b31fde2SJeremy L Thompson               CeedInt pre = num_comp * CeedIntPow(Q_1d, dim - 1), post = 1;
5530b31fde2SJeremy L Thompson 
5540b31fde2SJeremy L Thompson               for (CeedInt d = 0; d < dim; d++) {
5550b31fde2SJeremy L Thompson                 // ------ Tensor contract with current Chebyshev polynomial values
5560b31fde2SJeremy L Thompson                 if (pass == d) CeedCall(CeedChebyshevDerivativeAtPoint(x_array_read[d * total_num_points + p], Q_1d, chebyshev_x));
5570b31fde2SJeremy L Thompson                 else CeedCall(CeedChebyshevPolynomialsAtPoint(x_array_read[d * total_num_points + p], Q_1d, chebyshev_x));
5580b31fde2SJeremy L Thompson                 CeedCall(CeedTensorContractApply(basis->contract, pre, Q_1d, post, 1, chebyshev_x, t_mode, false,
5590b31fde2SJeremy L Thompson                                                  d == 0 ? chebyshev_coeffs : tmp[d % 2], tmp[(d + 1) % 2]));
5600b31fde2SJeremy L Thompson                 pre /= Q_1d;
5610b31fde2SJeremy L Thompson                 post *= 1;
5620b31fde2SJeremy L Thompson               }
5630b31fde2SJeremy L Thompson               for (CeedInt c = 0; c < num_comp; c++) v_array[(pass * num_comp + c) * total_num_points + p] = tmp[dim % 2][c];
5640b31fde2SJeremy L Thompson             }
5650b31fde2SJeremy L Thompson           }
5660b31fde2SJeremy L Thompson           break;
5670b31fde2SJeremy L Thompson         }
5680b31fde2SJeremy L Thompson         default:
5690b31fde2SJeremy L Thompson           // Nothing to do, excluded above
5700b31fde2SJeremy L Thompson           break;
5710b31fde2SJeremy L Thompson       }
5720b31fde2SJeremy L Thompson       CeedCall(CeedVectorRestoreArrayRead(basis->vec_chebyshev, &chebyshev_coeffs));
5730b31fde2SJeremy L Thompson       CeedCall(CeedVectorRestoreArrayRead(x_ref, &x_array_read));
5740b31fde2SJeremy L Thompson       CeedCall(CeedVectorRestoreArray(v, &v_array));
5750b31fde2SJeremy L Thompson       break;
5760b31fde2SJeremy L Thompson     }
5770b31fde2SJeremy L Thompson     case CEED_TRANSPOSE: {
5780b31fde2SJeremy L Thompson       // Note: No switch on e_mode here because only CEED_EVAL_INTERP is supported at this time
5790b31fde2SJeremy L Thompson       // Arbitrary points to nodes
5800b31fde2SJeremy L Thompson       CeedScalar       *chebyshev_coeffs;
5810b31fde2SJeremy L Thompson       const CeedScalar *u_array, *x_array_read;
5820b31fde2SJeremy L Thompson 
5830b31fde2SJeremy L Thompson       // -- Transpose of evaluation of Chebyshev polynomials at arbitrary points
5840b31fde2SJeremy L Thompson       CeedCall(CeedVectorGetArrayWrite(basis->vec_chebyshev, CEED_MEM_HOST, &chebyshev_coeffs));
5850b31fde2SJeremy L Thompson       CeedCall(CeedVectorGetArrayRead(x_ref, CEED_MEM_HOST, &x_array_read));
5860b31fde2SJeremy L Thompson       CeedCall(CeedVectorGetArrayRead(u, CEED_MEM_HOST, &u_array));
5870b31fde2SJeremy L Thompson 
5880b31fde2SJeremy L Thompson       switch (eval_mode) {
5890b31fde2SJeremy L Thompson         case CEED_EVAL_INTERP: {
5900b31fde2SJeremy L Thompson           CeedScalar tmp[2][num_comp * CeedIntPow(Q_1d, dim)], chebyshev_x[Q_1d];
5910b31fde2SJeremy L Thompson 
5920b31fde2SJeremy L Thompson           // ---- Values at point
5930b31fde2SJeremy L Thompson           for (CeedInt p = 0; p < total_num_points; p++) {
5940b31fde2SJeremy L Thompson             CeedInt pre = num_comp * 1, post = 1;
5950b31fde2SJeremy L Thompson 
5960b31fde2SJeremy L Thompson             for (CeedInt c = 0; c < num_comp; c++) tmp[0][c] = u_array[c * total_num_points + p];
5970b31fde2SJeremy L Thompson             for (CeedInt d = 0; d < dim; d++) {
5980b31fde2SJeremy L Thompson               // ------ Tensor contract with current Chebyshev polynomial values
5990b31fde2SJeremy L Thompson               CeedCall(CeedChebyshevPolynomialsAtPoint(x_array_read[d * total_num_points + p], Q_1d, chebyshev_x));
6000b31fde2SJeremy L Thompson               CeedCall(CeedTensorContractApply(basis->contract, pre, 1, post, Q_1d, chebyshev_x, t_mode, p > 0 && d == (dim - 1), tmp[d % 2],
6010b31fde2SJeremy L Thompson                                                d == (dim - 1) ? chebyshev_coeffs : tmp[(d + 1) % 2]));
6020b31fde2SJeremy L Thompson               pre /= 1;
6030b31fde2SJeremy L Thompson               post *= Q_1d;
6040b31fde2SJeremy L Thompson             }
6050b31fde2SJeremy L Thompson           }
6060b31fde2SJeremy L Thompson           break;
6070b31fde2SJeremy L Thompson         }
6080b31fde2SJeremy L Thompson         case CEED_EVAL_GRAD: {
6090b31fde2SJeremy L Thompson           CeedScalar tmp[2][num_comp * CeedIntPow(Q_1d, dim)], chebyshev_x[Q_1d];
6100b31fde2SJeremy L Thompson 
6110b31fde2SJeremy L Thompson           // ---- Values at point
6120b31fde2SJeremy L Thompson           for (CeedInt p = 0; p < total_num_points; p++) {
6130b31fde2SJeremy L Thompson             // Dim**2 contractions, apply grad when pass == dim
6140b31fde2SJeremy L Thompson             for (CeedInt pass = 0; pass < dim; pass++) {
6150b31fde2SJeremy L Thompson               CeedInt pre = num_comp * 1, post = 1;
6160b31fde2SJeremy L Thompson 
6170b31fde2SJeremy L Thompson               for (CeedInt c = 0; c < num_comp; c++) tmp[0][c] = u_array[(pass * num_comp + c) * total_num_points + p];
6180b31fde2SJeremy L Thompson               for (CeedInt d = 0; d < dim; d++) {
6190b31fde2SJeremy L Thompson                 // ------ Tensor contract with current Chebyshev polynomial values
6200b31fde2SJeremy L Thompson                 if (pass == d) CeedCall(CeedChebyshevDerivativeAtPoint(x_array_read[d * total_num_points + p], Q_1d, chebyshev_x));
6210b31fde2SJeremy L Thompson                 else CeedCall(CeedChebyshevPolynomialsAtPoint(x_array_read[d * total_num_points + p], Q_1d, chebyshev_x));
6220b31fde2SJeremy L Thompson                 CeedCall(CeedTensorContractApply(basis->contract, pre, 1, post, Q_1d, chebyshev_x, t_mode,
6230b31fde2SJeremy L Thompson                                                  (p > 0 || (p == 0 && pass > 0)) && d == (dim - 1), tmp[d % 2],
6240b31fde2SJeremy L Thompson                                                  d == (dim - 1) ? chebyshev_coeffs : tmp[(d + 1) % 2]));
6250b31fde2SJeremy L Thompson                 pre /= 1;
6260b31fde2SJeremy L Thompson                 post *= Q_1d;
6270b31fde2SJeremy L Thompson               }
6280b31fde2SJeremy L Thompson             }
6290b31fde2SJeremy L Thompson           }
6300b31fde2SJeremy L Thompson           break;
6310b31fde2SJeremy L Thompson         }
6320b31fde2SJeremy L Thompson         default:
6330b31fde2SJeremy L Thompson           // Nothing to do, excluded above
6340b31fde2SJeremy L Thompson           break;
6350b31fde2SJeremy L Thompson       }
6360b31fde2SJeremy L Thompson       CeedCall(CeedVectorRestoreArray(basis->vec_chebyshev, &chebyshev_coeffs));
6370b31fde2SJeremy L Thompson       CeedCall(CeedVectorRestoreArrayRead(x_ref, &x_array_read));
6380b31fde2SJeremy L Thompson       CeedCall(CeedVectorRestoreArrayRead(u, &u_array));
6390b31fde2SJeremy L Thompson 
6400b31fde2SJeremy L Thompson       // -- Interpolate transpose from Chebyshev coefficients
6410b31fde2SJeremy L Thompson       if (apply_add) CeedCall(CeedBasisApplyAdd(basis->basis_chebyshev, 1, CEED_TRANSPOSE, CEED_EVAL_INTERP, basis->vec_chebyshev, v));
6420b31fde2SJeremy L Thompson       else CeedCall(CeedBasisApply(basis->basis_chebyshev, 1, CEED_TRANSPOSE, CEED_EVAL_INTERP, basis->vec_chebyshev, v));
6430b31fde2SJeremy L Thompson       break;
6440b31fde2SJeremy L Thompson     }
6450b31fde2SJeremy L Thompson   }
6460b31fde2SJeremy L Thompson   return CEED_ERROR_SUCCESS;
6470b31fde2SJeremy L Thompson }
6480b31fde2SJeremy L Thompson 
6497a982d89SJeremy L. Thompson /// @}
6507a982d89SJeremy L. Thompson 
6517a982d89SJeremy L. Thompson /// ----------------------------------------------------------------------------
6527a982d89SJeremy L. Thompson /// Ceed Backend API
6537a982d89SJeremy L. Thompson /// ----------------------------------------------------------------------------
6547a982d89SJeremy L. Thompson /// @addtogroup CeedBasisBackend
6557a982d89SJeremy L. Thompson /// @{
6567a982d89SJeremy L. Thompson 
6577a982d89SJeremy L. Thompson /**
658fda26546SJeremy L Thompson   @brief Fallback to a reference implementation for a non tensor-product basis for \f$H^1\f$ discretizations.
659fda26546SJeremy L Thompson     This function may only be called inside of a backend `BasisCreateH1` function.
660fda26546SJeremy L Thompson     This is used by a backend when the specific parameters for a `CeedBasis` exceed the backend's support, such as
661fda26546SJeremy L Thompson     when a `interp` and `grad` matrices require too many bytes to fit into shared memory on a GPU.
662fda26546SJeremy L Thompson 
663fda26546SJeremy L Thompson   @param[in]  ceed      `Ceed` object used to create the `CeedBasis`
664fda26546SJeremy L Thompson   @param[in]  topo      Topology of element, e.g. hypercube, simplex, etc
665fda26546SJeremy L Thompson   @param[in]  num_comp  Number of field components (1 for scalar fields)
666fda26546SJeremy L Thompson   @param[in]  num_nodes Total number of nodes
667fda26546SJeremy L Thompson   @param[in]  num_qpts  Total number of quadrature points
668fda26546SJeremy L Thompson   @param[in]  interp    Row-major (`num_qpts * num_nodes`) matrix expressing the values of nodal basis functions at quadrature points
669fda26546SJeremy L Thompson   @param[in]  grad      Row-major (`dim * num_qpts * num_nodes`) matrix expressing derivatives of nodal basis functions at quadrature points
670fda26546SJeremy L Thompson   @param[in]  q_ref     Array of length `num_qpts * dim` holding the locations of quadrature points on the reference element
671fda26546SJeremy L Thompson   @param[in]  q_weight  Array of length `num_qpts` holding the quadrature weights on the reference element
672fda26546SJeremy L Thompson   @param[out] basis     Newly created `CeedBasis`
673fda26546SJeremy L Thompson 
674fda26546SJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
675fda26546SJeremy L Thompson 
676fda26546SJeremy L Thompson   @ref User
677fda26546SJeremy L Thompson **/
678fda26546SJeremy L Thompson int CeedBasisCreateH1Fallback(Ceed ceed, CeedElemTopology topo, CeedInt num_comp, CeedInt num_nodes, CeedInt num_qpts, const CeedScalar *interp,
679fda26546SJeremy L Thompson                               const CeedScalar *grad, const CeedScalar *q_ref, const CeedScalar *q_weight, CeedBasis basis) {
680fda26546SJeremy L Thompson   CeedInt P = num_nodes, Q = num_qpts, dim = 0;
681fda26546SJeremy L Thompson   Ceed    delegate;
682fda26546SJeremy L Thompson 
683fda26546SJeremy L Thompson   CeedCall(CeedGetObjectDelegate(ceed, &delegate, "Basis"));
684fda26546SJeremy L Thompson   CeedCheck(delegate, ceed, CEED_ERROR_UNSUPPORTED, "Backend does not implement BasisCreateH1");
685fda26546SJeremy L Thompson 
686fda26546SJeremy L Thompson   CeedCall(CeedReferenceCopy(delegate, &(basis)->ceed));
687fda26546SJeremy L Thompson   CeedCall(CeedBasisGetTopologyDimension(topo, &dim));
688fda26546SJeremy L Thompson   CeedCall(delegate->BasisCreateH1(topo, dim, P, Q, interp, grad, q_ref, q_weight, basis));
689fda26546SJeremy L Thompson   CeedCall(CeedDestroy(&delegate));
690fda26546SJeremy L Thompson   return CEED_ERROR_SUCCESS;
691fda26546SJeremy L Thompson }
692fda26546SJeremy L Thompson 
693fda26546SJeremy L Thompson /**
694ca94c3ddSJeremy L Thompson   @brief Return collocated gradient matrix
6957a982d89SJeremy L. Thompson 
696ca94c3ddSJeremy L Thompson   @param[in]  basis         `CeedBasis`
697ca94c3ddSJeremy L Thompson   @param[out] collo_grad_1d Row-major (`Q_1d * Q_1d`) matrix expressing derivatives of basis functions at quadrature points
6987a982d89SJeremy L. Thompson 
6997a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
7007a982d89SJeremy L. Thompson 
7017a982d89SJeremy L. Thompson   @ref Backend
7027a982d89SJeremy L. Thompson **/
703d1d35e2fSjeremylt int CeedBasisGetCollocatedGrad(CeedBasis basis, CeedScalar *collo_grad_1d) {
7047a982d89SJeremy L. Thompson   Ceed              ceed;
7052247a93fSRezgar Shakeri   CeedInt           P_1d, Q_1d;
7062247a93fSRezgar Shakeri   CeedScalar       *interp_1d_pinv;
7071203703bSJeremy L Thompson   const CeedScalar *grad_1d, *interp_1d;
7081203703bSJeremy L Thompson 
709ea61e9acSJeremy L Thompson   // Note: This function is for backend use, so all errors are terminal and we do not need to clean up memory on failure.
7102247a93fSRezgar Shakeri   CeedCall(CeedBasisGetCeed(basis, &ceed));
7112247a93fSRezgar Shakeri   CeedCall(CeedBasisGetNumNodes1D(basis, &P_1d));
7122247a93fSRezgar Shakeri   CeedCall(CeedBasisGetNumQuadraturePoints1D(basis, &Q_1d));
7137a982d89SJeremy L. Thompson 
7142247a93fSRezgar Shakeri   // Compute interp_1d^+, pseudoinverse of interp_1d
7152247a93fSRezgar Shakeri   CeedCall(CeedCalloc(P_1d * Q_1d, &interp_1d_pinv));
7161203703bSJeremy L Thompson   CeedCall(CeedBasisGetInterp1D(basis, &interp_1d));
7171203703bSJeremy L Thompson   CeedCall(CeedMatrixPseudoinverse(ceed, interp_1d, Q_1d, P_1d, interp_1d_pinv));
7181203703bSJeremy L Thompson   CeedCall(CeedBasisGetGrad1D(basis, &grad_1d));
7191203703bSJeremy L Thompson   CeedCall(CeedMatrixMatrixMultiply(ceed, grad_1d, (const CeedScalar *)interp_1d_pinv, collo_grad_1d, Q_1d, Q_1d, P_1d));
7207a982d89SJeremy L. Thompson 
7212247a93fSRezgar Shakeri   CeedCall(CeedFree(&interp_1d_pinv));
7229bc66399SJeremy L Thompson   CeedCall(CeedDestroy(&ceed));
723e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
7247a982d89SJeremy L. Thompson }
7257a982d89SJeremy L. Thompson 
7267a982d89SJeremy L. Thompson /**
727b0cc4569SJeremy L Thompson   @brief Return 1D interpolation matrix to Chebyshev polynomial coefficients on quadrature space
728b0cc4569SJeremy L Thompson 
729b0cc4569SJeremy L Thompson   @param[in]  basis               `CeedBasis`
730b0cc4569SJeremy L Thompson   @param[out] chebyshev_interp_1d Row-major (`P_1d * Q_1d`) matrix interpolating from basis nodes to Chebyshev polynomial coefficients
731b0cc4569SJeremy L Thompson 
732b0cc4569SJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
733b0cc4569SJeremy L Thompson 
734b0cc4569SJeremy L Thompson   @ref Backend
735b0cc4569SJeremy L Thompson **/
736b0cc4569SJeremy L Thompson int CeedBasisGetChebyshevInterp1D(CeedBasis basis, CeedScalar *chebyshev_interp_1d) {
737b0cc4569SJeremy L Thompson   CeedInt           P_1d, Q_1d;
738b0cc4569SJeremy L Thompson   CeedScalar       *C, *chebyshev_coeffs_1d_inv;
739b0cc4569SJeremy L Thompson   const CeedScalar *interp_1d, *q_ref_1d;
740b0cc4569SJeremy L Thompson   Ceed              ceed;
741b0cc4569SJeremy L Thompson 
742b0cc4569SJeremy L Thompson   CeedCall(CeedBasisGetCeed(basis, &ceed));
743b0cc4569SJeremy L Thompson   CeedCall(CeedBasisGetNumNodes1D(basis, &P_1d));
744b0cc4569SJeremy L Thompson   CeedCall(CeedBasisGetNumQuadraturePoints1D(basis, &Q_1d));
745b0cc4569SJeremy L Thompson 
746b0cc4569SJeremy L Thompson   // Build coefficient matrix
747bd83cbc5SJeremy L Thompson   // -- Note: Clang-tidy needs this check
748bd83cbc5SJeremy L Thompson   CeedCheck((P_1d > 0) && (Q_1d > 0), ceed, CEED_ERROR_INCOMPATIBLE, "CeedBasis dimensions are malformed");
749b0cc4569SJeremy L Thompson   CeedCall(CeedCalloc(Q_1d * Q_1d, &C));
750b0cc4569SJeremy L Thompson   CeedCall(CeedBasisGetQRef(basis, &q_ref_1d));
751b0cc4569SJeremy L Thompson   for (CeedInt i = 0; i < Q_1d; i++) CeedCall(CeedChebyshevPolynomialsAtPoint(q_ref_1d[i], Q_1d, &C[i * Q_1d]));
752b0cc4569SJeremy L Thompson 
753b0cc4569SJeremy L Thompson   // Compute C^+, pseudoinverse of coefficient matrix
754b0cc4569SJeremy L Thompson   CeedCall(CeedCalloc(Q_1d * Q_1d, &chebyshev_coeffs_1d_inv));
755b0cc4569SJeremy L Thompson   CeedCall(CeedMatrixPseudoinverse(ceed, C, Q_1d, Q_1d, chebyshev_coeffs_1d_inv));
756b0cc4569SJeremy L Thompson 
757b0cc4569SJeremy L Thompson   // Build mapping from nodes to Chebyshev coefficients
758b0cc4569SJeremy L Thompson   CeedCall(CeedBasisGetInterp1D(basis, &interp_1d));
759b0cc4569SJeremy L Thompson   CeedCall(CeedMatrixMatrixMultiply(ceed, chebyshev_coeffs_1d_inv, interp_1d, chebyshev_interp_1d, Q_1d, P_1d, Q_1d));
760b0cc4569SJeremy L Thompson 
761b0cc4569SJeremy L Thompson   // Cleanup
762b0cc4569SJeremy L Thompson   CeedCall(CeedFree(&C));
763b0cc4569SJeremy L Thompson   CeedCall(CeedFree(&chebyshev_coeffs_1d_inv));
7649bc66399SJeremy L Thompson   CeedCall(CeedDestroy(&ceed));
765b0cc4569SJeremy L Thompson   return CEED_ERROR_SUCCESS;
766b0cc4569SJeremy L Thompson }
767b0cc4569SJeremy L Thompson 
768b0cc4569SJeremy L Thompson /**
769ca94c3ddSJeremy L Thompson   @brief Get tensor status for given `CeedBasis`
7707a982d89SJeremy L. Thompson 
771ca94c3ddSJeremy L Thompson   @param[in]  basis     `CeedBasis`
772d1d35e2fSjeremylt   @param[out] is_tensor Variable to store tensor status
7737a982d89SJeremy L. Thompson 
7747a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
7757a982d89SJeremy L. Thompson 
7767a982d89SJeremy L. Thompson   @ref Backend
7777a982d89SJeremy L. Thompson **/
778d1d35e2fSjeremylt int CeedBasisIsTensor(CeedBasis basis, bool *is_tensor) {
7796402da51SJeremy L Thompson   *is_tensor = basis->is_tensor_basis;
780e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
7817a982d89SJeremy L. Thompson }
7827a982d89SJeremy L. Thompson 
7837a982d89SJeremy L. Thompson /**
784ca62d558SJeremy L Thompson   @brief Determine if given `CeedBasis` has nodes collocated with quadrature points
785ca62d558SJeremy L Thompson 
786ca62d558SJeremy L Thompson   @param[in]  basis         `CeedBasis`
787*aa4b4a9fSJeremy L Thompson   @param[out] is_collocated Variable to store collocated status
788ca62d558SJeremy L Thompson 
789ca62d558SJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
790ca62d558SJeremy L Thompson 
791ca62d558SJeremy L Thompson   @ref Backend
792ca62d558SJeremy L Thompson **/
793ca62d558SJeremy L Thompson int CeedBasisIsCollocated(CeedBasis basis, bool *is_collocated) {
794ca62d558SJeremy L Thompson   if (basis->is_tensor_basis && (basis->Q_1d == basis->P_1d)) {
795ca62d558SJeremy L Thompson     *is_collocated = true;
796ca62d558SJeremy L Thompson 
797ca62d558SJeremy L Thompson     for (CeedInt i = 0; i < basis->P_1d; i++) {
798ca62d558SJeremy L Thompson       *is_collocated = *is_collocated && (fabs(basis->interp_1d[i + basis->P_1d * i] - 1.0) < 10 * CEED_EPSILON);
799ca62d558SJeremy L Thompson       for (CeedInt j = 0; j < basis->Q_1d; j++) {
800ca62d558SJeremy L Thompson         if (j != i) *is_collocated = *is_collocated && (fabs(basis->interp_1d[j + basis->P_1d * i]) < 10 * CEED_EPSILON);
801ca62d558SJeremy L Thompson       }
802ca62d558SJeremy L Thompson     }
803ca62d558SJeremy L Thompson   } else {
804ca62d558SJeremy L Thompson     *is_collocated = false;
805ca62d558SJeremy L Thompson   }
806ca62d558SJeremy L Thompson   return CEED_ERROR_SUCCESS;
807ca62d558SJeremy L Thompson }
808ca62d558SJeremy L Thompson 
809ca62d558SJeremy L Thompson /**
810ca94c3ddSJeremy L Thompson   @brief Get backend data of a `CeedBasis`
8117a982d89SJeremy L. Thompson 
812ca94c3ddSJeremy L Thompson   @param[in]  basis `CeedBasis`
8137a982d89SJeremy L. Thompson   @param[out] data  Variable to store data
8147a982d89SJeremy L. Thompson 
8157a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
8167a982d89SJeremy L. Thompson 
8177a982d89SJeremy L. Thompson   @ref Backend
8187a982d89SJeremy L. Thompson **/
819777ff853SJeremy L Thompson int CeedBasisGetData(CeedBasis basis, void *data) {
820777ff853SJeremy L Thompson   *(void **)data = basis->data;
821e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
8227a982d89SJeremy L. Thompson }
8237a982d89SJeremy L. Thompson 
8247a982d89SJeremy L. Thompson /**
825ca94c3ddSJeremy L Thompson   @brief Set backend data of a `CeedBasis`
8267a982d89SJeremy L. Thompson 
827ca94c3ddSJeremy L Thompson   @param[in,out] basis  `CeedBasis`
828ea61e9acSJeremy L Thompson   @param[in]     data   Data to set
8297a982d89SJeremy L. Thompson 
8307a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
8317a982d89SJeremy L. Thompson 
8327a982d89SJeremy L. Thompson   @ref Backend
8337a982d89SJeremy L. Thompson **/
834777ff853SJeremy L Thompson int CeedBasisSetData(CeedBasis basis, void *data) {
835777ff853SJeremy L Thompson   basis->data = data;
836e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
8377a982d89SJeremy L. Thompson }
8387a982d89SJeremy L. Thompson 
8397a982d89SJeremy L. Thompson /**
840ca94c3ddSJeremy L Thompson   @brief Increment the reference counter for a `CeedBasis`
84134359f16Sjeremylt 
842ca94c3ddSJeremy L Thompson   @param[in,out] basis `CeedBasis` to increment the reference counter
84334359f16Sjeremylt 
84434359f16Sjeremylt   @return An error code: 0 - success, otherwise - failure
84534359f16Sjeremylt 
84634359f16Sjeremylt   @ref Backend
84734359f16Sjeremylt **/
8489560d06aSjeremylt int CeedBasisReference(CeedBasis basis) {
84934359f16Sjeremylt   basis->ref_count++;
85034359f16Sjeremylt   return CEED_ERROR_SUCCESS;
85134359f16Sjeremylt }
85234359f16Sjeremylt 
85334359f16Sjeremylt /**
854ca94c3ddSJeremy L Thompson   @brief Get number of Q-vector components for given `CeedBasis`
855c4e3f59bSSebastian Grimberg 
856ca94c3ddSJeremy L Thompson   @param[in]  basis     `CeedBasis`
857ca94c3ddSJeremy L Thompson   @param[in]  eval_mode @ref CEED_EVAL_INTERP to use interpolated values,
858ca94c3ddSJeremy L Thompson                           @ref CEED_EVAL_GRAD to use gradients,
859ca94c3ddSJeremy L Thompson                           @ref CEED_EVAL_DIV to use divergence,
860ca94c3ddSJeremy L Thompson                           @ref CEED_EVAL_CURL to use curl
861c4e3f59bSSebastian Grimberg   @param[out] q_comp    Variable to store number of Q-vector components of basis
862c4e3f59bSSebastian Grimberg 
863c4e3f59bSSebastian Grimberg   @return An error code: 0 - success, otherwise - failure
864c4e3f59bSSebastian Grimberg 
865c4e3f59bSSebastian Grimberg   @ref Backend
866c4e3f59bSSebastian Grimberg **/
867c4e3f59bSSebastian Grimberg int CeedBasisGetNumQuadratureComponents(CeedBasis basis, CeedEvalMode eval_mode, CeedInt *q_comp) {
8681203703bSJeremy L Thompson   CeedInt dim;
8691203703bSJeremy L Thompson 
8701203703bSJeremy L Thompson   CeedCall(CeedBasisGetDimension(basis, &dim));
871c4e3f59bSSebastian Grimberg   switch (eval_mode) {
8721203703bSJeremy L Thompson     case CEED_EVAL_INTERP: {
8731203703bSJeremy L Thompson       CeedFESpace fe_space;
8741203703bSJeremy L Thompson 
8751203703bSJeremy L Thompson       CeedCall(CeedBasisGetFESpace(basis, &fe_space));
8761203703bSJeremy L Thompson       *q_comp = (fe_space == CEED_FE_SPACE_H1) ? 1 : dim;
8771203703bSJeremy L Thompson     } break;
878c4e3f59bSSebastian Grimberg     case CEED_EVAL_GRAD:
8791203703bSJeremy L Thompson       *q_comp = dim;
880c4e3f59bSSebastian Grimberg       break;
881c4e3f59bSSebastian Grimberg     case CEED_EVAL_DIV:
882c4e3f59bSSebastian Grimberg       *q_comp = 1;
883c4e3f59bSSebastian Grimberg       break;
884c4e3f59bSSebastian Grimberg     case CEED_EVAL_CURL:
8851203703bSJeremy L Thompson       *q_comp = (dim < 3) ? 1 : dim;
886c4e3f59bSSebastian Grimberg       break;
887c4e3f59bSSebastian Grimberg     case CEED_EVAL_NONE:
888c4e3f59bSSebastian Grimberg     case CEED_EVAL_WEIGHT:
889352a5e7cSSebastian Grimberg       *q_comp = 1;
890c4e3f59bSSebastian Grimberg       break;
891c4e3f59bSSebastian Grimberg   }
892c4e3f59bSSebastian Grimberg   return CEED_ERROR_SUCCESS;
893c4e3f59bSSebastian Grimberg }
894c4e3f59bSSebastian Grimberg 
895c4e3f59bSSebastian Grimberg /**
896ca94c3ddSJeremy L Thompson   @brief Estimate number of FLOPs required to apply `CeedBasis` in `t_mode` and `eval_mode`
8976e15d496SJeremy L Thompson 
898ca94c3ddSJeremy L Thompson   @param[in]  basis        `CeedBasis` to estimate FLOPs for
899ea61e9acSJeremy L Thompson   @param[in]  t_mode       Apply basis or transpose
900ca94c3ddSJeremy L Thompson   @param[in]  eval_mode    @ref CeedEvalMode
9013f919cbcSJeremy L Thompson   @param[in]  is_at_points Evaluate the basis at points or quadrature points
9023f919cbcSJeremy L Thompson   @param[in]  num_points   Number of points basis is evaluated at
903ea61e9acSJeremy L Thompson   @param[out] flops        Address of variable to hold FLOPs estimate
9046e15d496SJeremy L Thompson 
9056e15d496SJeremy L Thompson   @ref Backend
9066e15d496SJeremy L Thompson **/
9073f919cbcSJeremy L Thompson int CeedBasisGetFlopsEstimate(CeedBasis basis, CeedTransposeMode t_mode, CeedEvalMode eval_mode, bool is_at_points, CeedInt num_points,
9083f919cbcSJeremy L Thompson                               CeedSize *flops) {
9096e15d496SJeremy L Thompson   bool is_tensor;
9106e15d496SJeremy L Thompson 
9112b730f8bSJeremy L Thompson   CeedCall(CeedBasisIsTensor(basis, &is_tensor));
9123f919cbcSJeremy L Thompson   CeedCheck(!is_at_points || is_tensor, CeedBasisReturnCeed(basis), CEED_ERROR_INCOMPATIBLE, "Can only evaluate tensor-product bases at points");
9136e15d496SJeremy L Thompson   if (is_tensor) {
9146e15d496SJeremy L Thompson     CeedInt dim, num_comp, P_1d, Q_1d;
9151c66c397SJeremy L Thompson 
9162b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetDimension(basis, &dim));
9172b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumComponents(basis, &num_comp));
9182b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumNodes1D(basis, &P_1d));
9192b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumQuadraturePoints1D(basis, &Q_1d));
9206e15d496SJeremy L Thompson     if (t_mode == CEED_TRANSPOSE) {
9212b730f8bSJeremy L Thompson       P_1d = Q_1d;
9222b730f8bSJeremy L Thompson       Q_1d = P_1d;
9236e15d496SJeremy L Thompson     }
9246e15d496SJeremy L Thompson     CeedInt tensor_flops = 0, pre = num_comp * CeedIntPow(P_1d, dim - 1), post = 1;
9253f919cbcSJeremy L Thompson 
9266e15d496SJeremy L Thompson     for (CeedInt d = 0; d < dim; d++) {
9276e15d496SJeremy L Thompson       tensor_flops += 2 * pre * P_1d * post * Q_1d;
9286e15d496SJeremy L Thompson       pre /= P_1d;
9296e15d496SJeremy L Thompson       post *= Q_1d;
9306e15d496SJeremy L Thompson     }
9313f919cbcSJeremy L Thompson     if (is_at_points) {
93252780386SJeremy L Thompson       bool is_gpu = false;
93352780386SJeremy L Thompson 
93452780386SJeremy L Thompson       {
93552780386SJeremy L Thompson         CeedMemType mem_type;
93652780386SJeremy L Thompson 
93752780386SJeremy L Thompson         CeedCall(CeedGetPreferredMemType(CeedBasisReturnCeed(basis), &mem_type));
93852780386SJeremy L Thompson         is_gpu = mem_type == CEED_MEM_DEVICE;
93952780386SJeremy L Thompson       }
94052780386SJeremy L Thompson 
9413f919cbcSJeremy L Thompson       CeedInt chebyshev_flops = (Q_1d - 2) * 3 + 1, d_chebyshev_flops = (Q_1d - 2) * 8 + 1;
9423f919cbcSJeremy L Thompson       CeedInt point_tensor_flops = 0, pre = CeedIntPow(Q_1d, dim - 1), post = 1;
9433f919cbcSJeremy L Thompson 
9443f919cbcSJeremy L Thompson       for (CeedInt d = 0; d < dim; d++) {
9453f919cbcSJeremy L Thompson         point_tensor_flops += 2 * pre * Q_1d * post * 1;
9463f919cbcSJeremy L Thompson         pre /= P_1d;
9473f919cbcSJeremy L Thompson         post *= Q_1d;
9483f919cbcSJeremy L Thompson       }
9493f919cbcSJeremy L Thompson 
9503f919cbcSJeremy L Thompson       switch (eval_mode) {
9513f919cbcSJeremy L Thompson         case CEED_EVAL_NONE:
9523f919cbcSJeremy L Thompson           *flops = 0;
9533f919cbcSJeremy L Thompson           break;
954a82cd097SZach Atkins         case CEED_EVAL_INTERP: {
955a82cd097SZach Atkins           *flops = tensor_flops + num_points * num_comp * (point_tensor_flops + (t_mode == CEED_TRANSPOSE ? CeedIntPow(Q_1d, dim) : 0));
956a82cd097SZach Atkins           if (dim == 3 && is_gpu) {
957802d760aSJeremy L Thompson             *flops += num_points * Q_1d *
958802d760aSJeremy L Thompson                       (chebyshev_flops + num_comp * (2 * chebyshev_flops + 2 * Q_1d * Q_1d + (t_mode == CEED_TRANSPOSE ? 2 * Q_1d + 1 : 3 * Q_1d)));
959a82cd097SZach Atkins           } else {
960a82cd097SZach Atkins             *flops += num_points * (is_gpu ? num_comp : 1) * dim * chebyshev_flops;
961a82cd097SZach Atkins           }
9623f919cbcSJeremy L Thompson           break;
963a82cd097SZach Atkins         }
964a82cd097SZach Atkins         case CEED_EVAL_GRAD: {
965a82cd097SZach Atkins           *flops = tensor_flops + num_points * num_comp * (point_tensor_flops + (t_mode == CEED_TRANSPOSE ? CeedIntPow(Q_1d, dim) : 0));
966a82cd097SZach Atkins           if (dim == 3 && is_gpu) {
967802d760aSJeremy L Thompson             CeedInt inner_flops =
968dc7b9553SJeremy L Thompson                 dim * (2 * Q_1d * Q_1d + (t_mode == CEED_TRANSPOSE ? 2 : 3) * Q_1d) + (dim - 1) * (2 * chebyshev_flops + d_chebyshev_flops);
969802d760aSJeremy L Thompson 
97027a8a650SZach Atkins             *flops += num_points * Q_1d * (chebyshev_flops + d_chebyshev_flops + num_comp * (inner_flops + (t_mode == CEED_TRANSPOSE ? 1 : 0)));
971a82cd097SZach Atkins           } else {
972a82cd097SZach Atkins             *flops += num_points * (is_gpu ? num_comp : 1) * dim * (d_chebyshev_flops + (dim - 1) * chebyshev_flops);
973a82cd097SZach Atkins           }
9743f919cbcSJeremy L Thompson           break;
975a82cd097SZach Atkins         }
9763f919cbcSJeremy L Thompson         case CEED_EVAL_DIV:
9773f919cbcSJeremy L Thompson         case CEED_EVAL_CURL: {
9783f919cbcSJeremy L Thompson           // LCOV_EXCL_START
97952780386SJeremy L Thompson           return CeedError(CeedBasisReturnCeed(basis), CEED_ERROR_INCOMPATIBLE, "Tensor basis evaluation for %s not supported at points",
9803f919cbcSJeremy L Thompson                            CeedEvalModes[eval_mode]);
9813f919cbcSJeremy L Thompson           break;
9823f919cbcSJeremy L Thompson           // LCOV_EXCL_STOP
9833f919cbcSJeremy L Thompson         }
9843f919cbcSJeremy L Thompson         case CEED_EVAL_WEIGHT:
9853f919cbcSJeremy L Thompson           *flops = num_points;
9863f919cbcSJeremy L Thompson           break;
9873f919cbcSJeremy L Thompson       }
9883f919cbcSJeremy L Thompson     } else {
9896e15d496SJeremy L Thompson       switch (eval_mode) {
9902b730f8bSJeremy L Thompson         case CEED_EVAL_NONE:
9912b730f8bSJeremy L Thompson           *flops = 0;
9922b730f8bSJeremy L Thompson           break;
9932b730f8bSJeremy L Thompson         case CEED_EVAL_INTERP:
9942b730f8bSJeremy L Thompson           *flops = tensor_flops;
9952b730f8bSJeremy L Thompson           break;
9962b730f8bSJeremy L Thompson         case CEED_EVAL_GRAD:
9972b730f8bSJeremy L Thompson           *flops = tensor_flops * 2;
9982b730f8bSJeremy L Thompson           break;
9996e15d496SJeremy L Thompson         case CEED_EVAL_DIV:
10001203703bSJeremy L Thompson         case CEED_EVAL_CURL: {
10016574a04fSJeremy L Thompson           // LCOV_EXCL_START
10026e536b99SJeremy L Thompson           return CeedError(CeedBasisReturnCeed(basis), CEED_ERROR_INCOMPATIBLE, "Tensor basis evaluation for %s not supported",
10036e536b99SJeremy L Thompson                            CeedEvalModes[eval_mode]);
10042b730f8bSJeremy L Thompson           break;
10056e15d496SJeremy L Thompson           // LCOV_EXCL_STOP
10061203703bSJeremy L Thompson         }
10072b730f8bSJeremy L Thompson         case CEED_EVAL_WEIGHT:
10082b730f8bSJeremy L Thompson           *flops = dim * CeedIntPow(Q_1d, dim);
10092b730f8bSJeremy L Thompson           break;
10106e15d496SJeremy L Thompson       }
10113f919cbcSJeremy L Thompson     }
10126e15d496SJeremy L Thompson   } else {
1013c4e3f59bSSebastian Grimberg     CeedInt dim, num_comp, q_comp, num_nodes, num_qpts;
10141c66c397SJeremy L Thompson 
10152b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetDimension(basis, &dim));
10162b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumComponents(basis, &num_comp));
1017c4e3f59bSSebastian Grimberg     CeedCall(CeedBasisGetNumQuadratureComponents(basis, eval_mode, &q_comp));
10182b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumNodes(basis, &num_nodes));
10192b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumQuadraturePoints(basis, &num_qpts));
10206e15d496SJeremy L Thompson     switch (eval_mode) {
10212b730f8bSJeremy L Thompson       case CEED_EVAL_NONE:
10222b730f8bSJeremy L Thompson         *flops = 0;
10232b730f8bSJeremy L Thompson         break;
10242b730f8bSJeremy L Thompson       case CEED_EVAL_INTERP:
10252b730f8bSJeremy L Thompson       case CEED_EVAL_GRAD:
10262b730f8bSJeremy L Thompson       case CEED_EVAL_DIV:
10272b730f8bSJeremy L Thompson       case CEED_EVAL_CURL:
1028c4e3f59bSSebastian Grimberg         *flops = num_nodes * num_qpts * num_comp * q_comp;
10292b730f8bSJeremy L Thompson         break;
10302b730f8bSJeremy L Thompson       case CEED_EVAL_WEIGHT:
10312b730f8bSJeremy L Thompson         *flops = 0;
10322b730f8bSJeremy L Thompson         break;
10336e15d496SJeremy L Thompson     }
10346e15d496SJeremy L Thompson   }
10356e15d496SJeremy L Thompson   return CEED_ERROR_SUCCESS;
10366e15d496SJeremy L Thompson }
10376e15d496SJeremy L Thompson 
10386e15d496SJeremy L Thompson /**
1039ca94c3ddSJeremy L Thompson   @brief Get `CeedFESpace` for a `CeedBasis`
1040c4e3f59bSSebastian Grimberg 
1041ca94c3ddSJeremy L Thompson   @param[in]  basis    `CeedBasis`
1042ca94c3ddSJeremy L Thompson   @param[out] fe_space Variable to store `CeedFESpace`
1043c4e3f59bSSebastian Grimberg 
1044c4e3f59bSSebastian Grimberg   @return An error code: 0 - success, otherwise - failure
1045c4e3f59bSSebastian Grimberg 
1046c4e3f59bSSebastian Grimberg   @ref Backend
1047c4e3f59bSSebastian Grimberg **/
1048c4e3f59bSSebastian Grimberg int CeedBasisGetFESpace(CeedBasis basis, CeedFESpace *fe_space) {
1049c4e3f59bSSebastian Grimberg   *fe_space = basis->fe_space;
1050c4e3f59bSSebastian Grimberg   return CEED_ERROR_SUCCESS;
1051c4e3f59bSSebastian Grimberg }
1052c4e3f59bSSebastian Grimberg 
1053c4e3f59bSSebastian Grimberg /**
1054ca94c3ddSJeremy L Thompson   @brief Get dimension for given `CeedElemTopology`
10557a982d89SJeremy L. Thompson 
1056ca94c3ddSJeremy L Thompson   @param[in]  topo `CeedElemTopology`
10577a982d89SJeremy L. Thompson   @param[out] dim  Variable to store dimension of topology
10587a982d89SJeremy L. Thompson 
10597a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
10607a982d89SJeremy L. Thompson 
10617a982d89SJeremy L. Thompson   @ref Backend
10627a982d89SJeremy L. Thompson **/
10637a982d89SJeremy L. Thompson int CeedBasisGetTopologyDimension(CeedElemTopology topo, CeedInt *dim) {
10647a982d89SJeremy L. Thompson   *dim = (CeedInt)topo >> 16;
1065e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
10667a982d89SJeremy L. Thompson }
10677a982d89SJeremy L. Thompson 
10687a982d89SJeremy L. Thompson /**
1069ca94c3ddSJeremy L Thompson   @brief Get `CeedTensorContract` of a `CeedBasis`
10707a982d89SJeremy L. Thompson 
1071ca94c3ddSJeremy L Thompson   @param[in]  basis     `CeedBasis`
1072ca94c3ddSJeremy L Thompson   @param[out] contract  Variable to store `CeedTensorContract`
10737a982d89SJeremy L. Thompson 
10747a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
10757a982d89SJeremy L. Thompson 
10767a982d89SJeremy L. Thompson   @ref Backend
10777a982d89SJeremy L. Thompson **/
10787a982d89SJeremy L. Thompson int CeedBasisGetTensorContract(CeedBasis basis, CeedTensorContract *contract) {
10797a982d89SJeremy L. Thompson   *contract = basis->contract;
1080e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
10817a982d89SJeremy L. Thompson }
10827a982d89SJeremy L. Thompson 
10837a982d89SJeremy L. Thompson /**
1084ca94c3ddSJeremy L Thompson   @brief Set `CeedTensorContract` of a `CeedBasis`
10857a982d89SJeremy L. Thompson 
1086ca94c3ddSJeremy L Thompson   @param[in,out] basis    `CeedBasis`
1087ca94c3ddSJeremy L Thompson   @param[in]     contract `CeedTensorContract` to set
10887a982d89SJeremy L. Thompson 
10897a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
10907a982d89SJeremy L. Thompson 
10917a982d89SJeremy L. Thompson   @ref Backend
10927a982d89SJeremy L. Thompson **/
109334359f16Sjeremylt int CeedBasisSetTensorContract(CeedBasis basis, CeedTensorContract contract) {
109434359f16Sjeremylt   basis->contract = contract;
10952b730f8bSJeremy L Thompson   CeedCall(CeedTensorContractReference(contract));
1096e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
10977a982d89SJeremy L. Thompson }
10987a982d89SJeremy L. Thompson 
10997a982d89SJeremy L. Thompson /**
1100ca94c3ddSJeremy L Thompson   @brief Return a reference implementation of matrix multiplication \f$C = A B\f$.
1101ba59ac12SSebastian Grimberg 
1102ca94c3ddSJeremy L Thompson   Note: This is a reference implementation for CPU `CeedScalar` pointers that is not intended for high performance.
11037a982d89SJeremy L. Thompson 
1104ca94c3ddSJeremy L Thompson   @param[in]  ceed  `Ceed` context for error handling
1105ca94c3ddSJeremy L Thompson   @param[in]  mat_A Row-major matrix `A`
1106ca94c3ddSJeremy L Thompson   @param[in]  mat_B Row-major matrix `B`
1107ca94c3ddSJeremy L Thompson   @param[out] mat_C Row-major output matrix `C`
1108ca94c3ddSJeremy L Thompson   @param[in]  m     Number of rows of `C`
1109ca94c3ddSJeremy L Thompson   @param[in]  n     Number of columns of `C`
1110ca94c3ddSJeremy L Thompson   @param[in]  kk    Number of columns of `A`/rows of `B`
11117a982d89SJeremy L. Thompson 
11127a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
11137a982d89SJeremy L. Thompson 
11147a982d89SJeremy L. Thompson   @ref Utility
11157a982d89SJeremy L. Thompson **/
11162b730f8bSJeremy L Thompson int CeedMatrixMatrixMultiply(Ceed ceed, const CeedScalar *mat_A, const CeedScalar *mat_B, CeedScalar *mat_C, CeedInt m, CeedInt n, CeedInt kk) {
11172b730f8bSJeremy L Thompson   for (CeedInt i = 0; i < m; i++) {
11187a982d89SJeremy L. Thompson     for (CeedInt j = 0; j < n; j++) {
11197a982d89SJeremy L. Thompson       CeedScalar sum = 0;
11201c66c397SJeremy L Thompson 
11212b730f8bSJeremy L Thompson       for (CeedInt k = 0; k < kk; k++) sum += mat_A[k + i * kk] * mat_B[j + k * n];
1122d1d35e2fSjeremylt       mat_C[j + i * n] = sum;
11237a982d89SJeremy L. Thompson     }
11242b730f8bSJeremy L Thompson   }
1125e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
11267a982d89SJeremy L. Thompson }
11277a982d89SJeremy L. Thompson 
1128ba59ac12SSebastian Grimberg /**
1129ba59ac12SSebastian Grimberg   @brief Return QR Factorization of a matrix
1130ba59ac12SSebastian Grimberg 
1131ca94c3ddSJeremy L Thompson   @param[in]     ceed `Ceed` context for error handling
1132ba59ac12SSebastian Grimberg   @param[in,out] mat  Row-major matrix to be factorized in place
1133ca94c3ddSJeremy L Thompson   @param[in,out] tau  Vector of length `m` of scaling factors
1134ba59ac12SSebastian Grimberg   @param[in]     m    Number of rows
1135ba59ac12SSebastian Grimberg   @param[in]     n    Number of columns
1136ba59ac12SSebastian Grimberg 
1137ba59ac12SSebastian Grimberg   @return An error code: 0 - success, otherwise - failure
1138ba59ac12SSebastian Grimberg 
1139ba59ac12SSebastian Grimberg   @ref Utility
1140ba59ac12SSebastian Grimberg **/
1141ba59ac12SSebastian Grimberg int CeedQRFactorization(Ceed ceed, CeedScalar *mat, CeedScalar *tau, CeedInt m, CeedInt n) {
1142ba59ac12SSebastian Grimberg   CeedScalar v[m];
1143ba59ac12SSebastian Grimberg 
1144ba59ac12SSebastian Grimberg   // Check matrix shape
11456574a04fSJeremy L Thompson   CeedCheck(n <= m, ceed, CEED_ERROR_UNSUPPORTED, "Cannot compute QR factorization with n > m");
1146ba59ac12SSebastian Grimberg 
1147ba59ac12SSebastian Grimberg   for (CeedInt i = 0; i < n; i++) {
11481c66c397SJeremy L Thompson     CeedScalar sigma = 0.0;
11491c66c397SJeremy L Thompson 
1150ba59ac12SSebastian Grimberg     if (i >= m - 1) {  // last row of matrix, no reflection needed
1151ba59ac12SSebastian Grimberg       tau[i] = 0.;
1152ba59ac12SSebastian Grimberg       break;
1153ba59ac12SSebastian Grimberg     }
1154ba59ac12SSebastian Grimberg     // Calculate Householder vector, magnitude
1155ba59ac12SSebastian Grimberg     v[i] = mat[i + n * i];
1156ba59ac12SSebastian Grimberg     for (CeedInt j = i + 1; j < m; j++) {
1157ba59ac12SSebastian Grimberg       v[j] = mat[i + n * j];
1158ba59ac12SSebastian Grimberg       sigma += v[j] * v[j];
1159ba59ac12SSebastian Grimberg     }
11601c66c397SJeremy L Thompson     const CeedScalar norm = sqrt(v[i] * v[i] + sigma);  // norm of v[i:m]
11611c66c397SJeremy L Thompson     const CeedScalar R_ii = -copysign(norm, v[i]);
11621c66c397SJeremy L Thompson 
1163ba59ac12SSebastian Grimberg     v[i] -= R_ii;
1164ba59ac12SSebastian Grimberg     // norm of v[i:m] after modification above and scaling below
1165ba59ac12SSebastian Grimberg     //   norm = sqrt(v[i]*v[i] + sigma) / v[i];
1166ba59ac12SSebastian Grimberg     //   tau = 2 / (norm*norm)
1167ba59ac12SSebastian Grimberg     tau[i] = 2 * v[i] * v[i] / (v[i] * v[i] + sigma);
1168ba59ac12SSebastian Grimberg     for (CeedInt j = i + 1; j < m; j++) v[j] /= v[i];
1169ba59ac12SSebastian Grimberg 
1170ba59ac12SSebastian Grimberg     // Apply Householder reflector to lower right panel
1171ba59ac12SSebastian Grimberg     CeedHouseholderReflect(&mat[i * n + i + 1], &v[i], tau[i], m - i, n - i - 1, n, 1);
1172ba59ac12SSebastian Grimberg     // Save v
1173ba59ac12SSebastian Grimberg     mat[i + n * i] = R_ii;
1174ba59ac12SSebastian Grimberg     for (CeedInt j = i + 1; j < m; j++) mat[i + n * j] = v[j];
1175ba59ac12SSebastian Grimberg   }
1176ba59ac12SSebastian Grimberg   return CEED_ERROR_SUCCESS;
1177ba59ac12SSebastian Grimberg }
1178ba59ac12SSebastian Grimberg 
1179ba59ac12SSebastian Grimberg /**
1180ba59ac12SSebastian Grimberg   @brief Apply Householder Q matrix
1181ba59ac12SSebastian Grimberg 
1182ca94c3ddSJeremy L Thompson   Compute `mat_A = mat_Q mat_A`, where `mat_Q` is \f$m \times m\f$ and `mat_A` is \f$m \times n\f$.
1183ba59ac12SSebastian Grimberg 
1184ba59ac12SSebastian Grimberg   @param[in,out] mat_A  Matrix to apply Householder Q to, in place
1185ba59ac12SSebastian Grimberg   @param[in]     mat_Q  Householder Q matrix
1186ba59ac12SSebastian Grimberg   @param[in]     tau    Householder scaling factors
1187ba59ac12SSebastian Grimberg   @param[in]     t_mode Transpose mode for application
1188ca94c3ddSJeremy L Thompson   @param[in]     m      Number of rows in `A`
1189ca94c3ddSJeremy L Thompson   @param[in]     n      Number of columns in `A`
1190ca94c3ddSJeremy L Thompson   @param[in]     k      Number of elementary reflectors in Q, `k < m`
1191ca94c3ddSJeremy L Thompson   @param[in]     row    Row stride in `A`
1192ca94c3ddSJeremy L Thompson   @param[in]     col    Col stride in `A`
1193ba59ac12SSebastian Grimberg 
1194ba59ac12SSebastian Grimberg   @return An error code: 0 - success, otherwise - failure
1195ba59ac12SSebastian Grimberg 
1196c4e3f59bSSebastian Grimberg   @ref Utility
1197ba59ac12SSebastian Grimberg **/
1198ba59ac12SSebastian Grimberg int CeedHouseholderApplyQ(CeedScalar *mat_A, const CeedScalar *mat_Q, const CeedScalar *tau, CeedTransposeMode t_mode, CeedInt m, CeedInt n,
1199ba59ac12SSebastian Grimberg                           CeedInt k, CeedInt row, CeedInt col) {
1200ba59ac12SSebastian Grimberg   CeedScalar *v;
12011c66c397SJeremy L Thompson 
1202ba59ac12SSebastian Grimberg   CeedCall(CeedMalloc(m, &v));
1203ba59ac12SSebastian Grimberg   for (CeedInt ii = 0; ii < k; ii++) {
1204ba59ac12SSebastian Grimberg     CeedInt i = t_mode == CEED_TRANSPOSE ? ii : k - 1 - ii;
1205ba59ac12SSebastian Grimberg     for (CeedInt j = i + 1; j < m; j++) v[j] = mat_Q[j * k + i];
1206ba59ac12SSebastian Grimberg     // Apply Householder reflector (I - tau v v^T) collo_grad_1d^T
1207ba59ac12SSebastian Grimberg     CeedCall(CeedHouseholderReflect(&mat_A[i * row], &v[i], tau[i], m - i, n, row, col));
1208ba59ac12SSebastian Grimberg   }
1209ba59ac12SSebastian Grimberg   CeedCall(CeedFree(&v));
1210ba59ac12SSebastian Grimberg   return CEED_ERROR_SUCCESS;
1211ba59ac12SSebastian Grimberg }
1212ba59ac12SSebastian Grimberg 
1213ba59ac12SSebastian Grimberg /**
12142247a93fSRezgar Shakeri   @brief Return pseudoinverse of a matrix
12152247a93fSRezgar Shakeri 
12162247a93fSRezgar Shakeri   @param[in]     ceed      Ceed context for error handling
12172247a93fSRezgar Shakeri   @param[in]     mat       Row-major matrix to compute pseudoinverse of
12182247a93fSRezgar Shakeri   @param[in]     m         Number of rows
12192247a93fSRezgar Shakeri   @param[in]     n         Number of columns
12202247a93fSRezgar Shakeri   @param[out]    mat_pinv  Row-major pseudoinverse matrix
12212247a93fSRezgar Shakeri 
12222247a93fSRezgar Shakeri   @return An error code: 0 - success, otherwise - failure
12232247a93fSRezgar Shakeri 
12242247a93fSRezgar Shakeri   @ref Utility
12252247a93fSRezgar Shakeri **/
12261203703bSJeremy L Thompson int CeedMatrixPseudoinverse(Ceed ceed, const CeedScalar *mat, CeedInt m, CeedInt n, CeedScalar *mat_pinv) {
12272247a93fSRezgar Shakeri   CeedScalar *tau, *I, *mat_copy;
12282247a93fSRezgar Shakeri 
12292247a93fSRezgar Shakeri   CeedCall(CeedCalloc(m, &tau));
12302247a93fSRezgar Shakeri   CeedCall(CeedCalloc(m * m, &I));
12312247a93fSRezgar Shakeri   CeedCall(CeedCalloc(m * n, &mat_copy));
12322247a93fSRezgar Shakeri   memcpy(mat_copy, mat, m * n * sizeof mat[0]);
12332247a93fSRezgar Shakeri 
12342247a93fSRezgar Shakeri   // QR Factorization, mat = Q R
12352247a93fSRezgar Shakeri   CeedCall(CeedQRFactorization(ceed, mat_copy, tau, m, n));
12362247a93fSRezgar Shakeri 
12372247a93fSRezgar Shakeri   // -- Apply Q^T, I = Q^T * I
12382247a93fSRezgar Shakeri   for (CeedInt i = 0; i < m; i++) I[i * m + i] = 1.0;
12392247a93fSRezgar Shakeri   CeedCall(CeedHouseholderApplyQ(I, mat_copy, tau, CEED_TRANSPOSE, m, m, n, m, 1));
12402247a93fSRezgar Shakeri   // -- Apply R_inv, mat_pinv = R_inv * Q^T
12412247a93fSRezgar Shakeri   for (CeedInt j = 0; j < m; j++) {  // Column j
12422247a93fSRezgar Shakeri     mat_pinv[j + m * (n - 1)] = I[j + m * (n - 1)] / mat_copy[n * n - 1];
12432247a93fSRezgar Shakeri     for (CeedInt i = n - 2; i >= 0; i--) {  // Row i
12442247a93fSRezgar Shakeri       mat_pinv[j + m * i] = I[j + m * i];
12452247a93fSRezgar Shakeri       for (CeedInt k = i + 1; k < n; k++) mat_pinv[j + m * i] -= mat_copy[k + n * i] * mat_pinv[j + m * k];
12462247a93fSRezgar Shakeri       mat_pinv[j + m * i] /= mat_copy[i + n * i];
12472247a93fSRezgar Shakeri     }
12482247a93fSRezgar Shakeri   }
12492247a93fSRezgar Shakeri 
12502247a93fSRezgar Shakeri   // Cleanup
12512247a93fSRezgar Shakeri   CeedCall(CeedFree(&I));
12522247a93fSRezgar Shakeri   CeedCall(CeedFree(&tau));
12532247a93fSRezgar Shakeri   CeedCall(CeedFree(&mat_copy));
12542247a93fSRezgar Shakeri   return CEED_ERROR_SUCCESS;
12552247a93fSRezgar Shakeri }
12562247a93fSRezgar Shakeri 
12572247a93fSRezgar Shakeri /**
1258ba59ac12SSebastian Grimberg   @brief Return symmetric Schur decomposition of the symmetric matrix mat via symmetric QR factorization
1259ba59ac12SSebastian Grimberg 
1260ca94c3ddSJeremy L Thompson   @param[in]     ceed   `Ceed` context for error handling
1261ba59ac12SSebastian Grimberg   @param[in,out] mat    Row-major matrix to be factorized in place
1262ba59ac12SSebastian Grimberg   @param[out]    lambda Vector of length n of eigenvalues
1263ba59ac12SSebastian Grimberg   @param[in]     n      Number of rows/columns
1264ba59ac12SSebastian Grimberg 
1265ba59ac12SSebastian Grimberg   @return An error code: 0 - success, otherwise - failure
1266ba59ac12SSebastian Grimberg 
1267ba59ac12SSebastian Grimberg   @ref Utility
1268ba59ac12SSebastian Grimberg **/
12692c2ea1dbSJeremy L Thompson CeedPragmaOptimizeOff
12702c2ea1dbSJeremy L Thompson int CeedSymmetricSchurDecomposition(Ceed ceed, CeedScalar *mat, CeedScalar *lambda, CeedInt n) {
1271ba59ac12SSebastian Grimberg   // Check bounds for clang-tidy
12726574a04fSJeremy L Thompson   CeedCheck(n > 1, ceed, CEED_ERROR_UNSUPPORTED, "Cannot compute symmetric Schur decomposition of scalars");
1273ba59ac12SSebastian Grimberg 
1274ba59ac12SSebastian Grimberg   CeedScalar v[n - 1], tau[n - 1], mat_T[n * n];
1275ba59ac12SSebastian Grimberg 
1276ba59ac12SSebastian Grimberg   // Copy mat to mat_T and set mat to I
1277ba59ac12SSebastian Grimberg   memcpy(mat_T, mat, n * n * sizeof(mat[0]));
1278ba59ac12SSebastian Grimberg   for (CeedInt i = 0; i < n; i++) {
1279ba59ac12SSebastian Grimberg     for (CeedInt j = 0; j < n; j++) mat[j + n * i] = (i == j) ? 1 : 0;
1280ba59ac12SSebastian Grimberg   }
1281ba59ac12SSebastian Grimberg 
1282ba59ac12SSebastian Grimberg   // Reduce to tridiagonal
1283ba59ac12SSebastian Grimberg   for (CeedInt i = 0; i < n - 1; i++) {
1284ba59ac12SSebastian Grimberg     // Calculate Householder vector, magnitude
1285ba59ac12SSebastian Grimberg     CeedScalar sigma = 0.0;
12861c66c397SJeremy L Thompson 
1287ba59ac12SSebastian Grimberg     v[i] = mat_T[i + n * (i + 1)];
1288ba59ac12SSebastian Grimberg     for (CeedInt j = i + 1; j < n - 1; j++) {
1289ba59ac12SSebastian Grimberg       v[j] = mat_T[i + n * (j + 1)];
1290ba59ac12SSebastian Grimberg       sigma += v[j] * v[j];
1291ba59ac12SSebastian Grimberg     }
12921c66c397SJeremy L Thompson     const CeedScalar norm = sqrt(v[i] * v[i] + sigma);  // norm of v[i:n-1]
12931c66c397SJeremy L Thompson     const CeedScalar R_ii = -copysign(norm, v[i]);
12941c66c397SJeremy L Thompson 
1295ba59ac12SSebastian Grimberg     v[i] -= R_ii;
1296ba59ac12SSebastian Grimberg     // norm of v[i:m] after modification above and scaling below
1297ba59ac12SSebastian Grimberg     //   norm = sqrt(v[i]*v[i] + sigma) / v[i];
1298ba59ac12SSebastian Grimberg     //   tau = 2 / (norm*norm)
1299ba59ac12SSebastian Grimberg     tau[i] = i == n - 2 ? 2 : 2 * v[i] * v[i] / (v[i] * v[i] + sigma);
1300ba59ac12SSebastian Grimberg     for (CeedInt j = i + 1; j < n - 1; j++) v[j] /= v[i];
1301ba59ac12SSebastian Grimberg 
1302ba59ac12SSebastian Grimberg     // Update sub and super diagonal
1303ba59ac12SSebastian Grimberg     for (CeedInt j = i + 2; j < n; j++) {
1304ba59ac12SSebastian Grimberg       mat_T[i + n * j] = 0;
1305ba59ac12SSebastian Grimberg       mat_T[j + n * i] = 0;
1306ba59ac12SSebastian Grimberg     }
1307ba59ac12SSebastian Grimberg     // Apply symmetric Householder reflector to lower right panel
1308ba59ac12SSebastian Grimberg     CeedHouseholderReflect(&mat_T[(i + 1) + n * (i + 1)], &v[i], tau[i], n - (i + 1), n - (i + 1), n, 1);
1309ba59ac12SSebastian Grimberg     CeedHouseholderReflect(&mat_T[(i + 1) + n * (i + 1)], &v[i], tau[i], n - (i + 1), n - (i + 1), 1, n);
1310ba59ac12SSebastian Grimberg 
1311ba59ac12SSebastian Grimberg     // Save v
1312ba59ac12SSebastian Grimberg     mat_T[i + n * (i + 1)] = R_ii;
1313ba59ac12SSebastian Grimberg     mat_T[(i + 1) + n * i] = R_ii;
1314ba59ac12SSebastian Grimberg     for (CeedInt j = i + 1; j < n - 1; j++) {
1315ba59ac12SSebastian Grimberg       mat_T[i + n * (j + 1)] = v[j];
1316ba59ac12SSebastian Grimberg     }
1317ba59ac12SSebastian Grimberg   }
1318ba59ac12SSebastian Grimberg   // Backwards accumulation of Q
1319ba59ac12SSebastian Grimberg   for (CeedInt i = n - 2; i >= 0; i--) {
1320ba59ac12SSebastian Grimberg     if (tau[i] > 0.0) {
1321ba59ac12SSebastian Grimberg       v[i] = 1;
1322ba59ac12SSebastian Grimberg       for (CeedInt j = i + 1; j < n - 1; j++) {
1323ba59ac12SSebastian Grimberg         v[j]                   = mat_T[i + n * (j + 1)];
1324ba59ac12SSebastian Grimberg         mat_T[i + n * (j + 1)] = 0;
1325ba59ac12SSebastian Grimberg       }
1326ba59ac12SSebastian Grimberg       CeedHouseholderReflect(&mat[(i + 1) + n * (i + 1)], &v[i], tau[i], n - (i + 1), n - (i + 1), n, 1);
1327ba59ac12SSebastian Grimberg     }
1328ba59ac12SSebastian Grimberg   }
1329ba59ac12SSebastian Grimberg 
1330ba59ac12SSebastian Grimberg   // Reduce sub and super diagonal
1331ba59ac12SSebastian Grimberg   CeedInt    p = 0, q = 0, itr = 0, max_itr = n * n * n * n;
1332ba59ac12SSebastian Grimberg   CeedScalar tol = CEED_EPSILON;
1333ba59ac12SSebastian Grimberg 
1334ba59ac12SSebastian Grimberg   while (itr < max_itr) {
1335ba59ac12SSebastian Grimberg     // Update p, q, size of reduced portions of diagonal
1336ba59ac12SSebastian Grimberg     p = 0;
1337ba59ac12SSebastian Grimberg     q = 0;
1338ba59ac12SSebastian Grimberg     for (CeedInt i = n - 2; i >= 0; i--) {
1339ba59ac12SSebastian Grimberg       if (fabs(mat_T[i + n * (i + 1)]) < tol) q += 1;
1340ba59ac12SSebastian Grimberg       else break;
1341ba59ac12SSebastian Grimberg     }
1342ba59ac12SSebastian Grimberg     for (CeedInt i = 0; i < n - q - 1; i++) {
1343ba59ac12SSebastian Grimberg       if (fabs(mat_T[i + n * (i + 1)]) < tol) p += 1;
1344ba59ac12SSebastian Grimberg       else break;
1345ba59ac12SSebastian Grimberg     }
1346ba59ac12SSebastian Grimberg     if (q == n - 1) break;  // Finished reducing
1347ba59ac12SSebastian Grimberg 
1348ba59ac12SSebastian Grimberg     // Reduce tridiagonal portion
1349ba59ac12SSebastian Grimberg     CeedScalar t_nn = mat_T[(n - 1 - q) + n * (n - 1 - q)], t_nnm1 = mat_T[(n - 2 - q) + n * (n - 1 - q)];
1350ba59ac12SSebastian Grimberg     CeedScalar d  = (mat_T[(n - 2 - q) + n * (n - 2 - q)] - t_nn) / 2;
1351ba59ac12SSebastian Grimberg     CeedScalar mu = t_nn - t_nnm1 * t_nnm1 / (d + copysign(sqrt(d * d + t_nnm1 * t_nnm1), d));
1352ba59ac12SSebastian Grimberg     CeedScalar x  = mat_T[p + n * p] - mu;
1353ba59ac12SSebastian Grimberg     CeedScalar z  = mat_T[p + n * (p + 1)];
13541c66c397SJeremy L Thompson 
1355ba59ac12SSebastian Grimberg     for (CeedInt k = p; k < n - q - 1; k++) {
1356ba59ac12SSebastian Grimberg       // Compute Givens rotation
1357ba59ac12SSebastian Grimberg       CeedScalar c = 1, s = 0;
13581c66c397SJeremy L Thompson 
1359ba59ac12SSebastian Grimberg       if (fabs(z) > tol) {
1360ba59ac12SSebastian Grimberg         if (fabs(z) > fabs(x)) {
13611c66c397SJeremy L Thompson           const CeedScalar tau = -x / z;
13621c66c397SJeremy L Thompson 
13631c66c397SJeremy L Thompson           s = 1 / sqrt(1 + tau * tau);
13641c66c397SJeremy L Thompson           c = s * tau;
1365ba59ac12SSebastian Grimberg         } else {
13661c66c397SJeremy L Thompson           const CeedScalar tau = -z / x;
13671c66c397SJeremy L Thompson 
13681c66c397SJeremy L Thompson           c = 1 / sqrt(1 + tau * tau);
13691c66c397SJeremy L Thompson           s = c * tau;
1370ba59ac12SSebastian Grimberg         }
1371ba59ac12SSebastian Grimberg       }
1372ba59ac12SSebastian Grimberg 
1373ba59ac12SSebastian Grimberg       // Apply Givens rotation to T
1374ba59ac12SSebastian Grimberg       CeedGivensRotation(mat_T, c, s, CEED_NOTRANSPOSE, k, k + 1, n, n);
1375ba59ac12SSebastian Grimberg       CeedGivensRotation(mat_T, c, s, CEED_TRANSPOSE, k, k + 1, n, n);
1376ba59ac12SSebastian Grimberg 
1377ba59ac12SSebastian Grimberg       // Apply Givens rotation to Q
1378ba59ac12SSebastian Grimberg       CeedGivensRotation(mat, c, s, CEED_NOTRANSPOSE, k, k + 1, n, n);
1379ba59ac12SSebastian Grimberg 
1380ba59ac12SSebastian Grimberg       // Update x, z
1381ba59ac12SSebastian Grimberg       if (k < n - q - 2) {
1382ba59ac12SSebastian Grimberg         x = mat_T[k + n * (k + 1)];
1383ba59ac12SSebastian Grimberg         z = mat_T[k + n * (k + 2)];
1384ba59ac12SSebastian Grimberg       }
1385ba59ac12SSebastian Grimberg     }
1386ba59ac12SSebastian Grimberg     itr++;
1387ba59ac12SSebastian Grimberg   }
1388ba59ac12SSebastian Grimberg 
1389ba59ac12SSebastian Grimberg   // Save eigenvalues
1390ba59ac12SSebastian Grimberg   for (CeedInt i = 0; i < n; i++) lambda[i] = mat_T[i + n * i];
1391ba59ac12SSebastian Grimberg 
1392ba59ac12SSebastian Grimberg   // Check convergence
13936574a04fSJeremy L Thompson   CeedCheck(itr < max_itr || q > n, ceed, CEED_ERROR_MINOR, "Symmetric QR failed to converge");
1394ba59ac12SSebastian Grimberg   return CEED_ERROR_SUCCESS;
1395ba59ac12SSebastian Grimberg }
13962c2ea1dbSJeremy L Thompson CeedPragmaOptimizeOn
1397ba59ac12SSebastian Grimberg 
1398ba59ac12SSebastian Grimberg /**
1399ba59ac12SSebastian Grimberg   @brief Return Simultaneous Diagonalization of two matrices.
1400ba59ac12SSebastian Grimberg 
1401ca94c3ddSJeremy L Thompson   This solves the generalized eigenvalue problem `A x = lambda B x`, where `A` and `B` are symmetric and `B` is positive definite.
1402ca94c3ddSJeremy L Thompson   We generate the matrix `X` and vector `Lambda` such that `X^T A X = Lambda` and `X^T B X = I`.
1403ca94c3ddSJeremy L Thompson   This is equivalent to the LAPACK routine 'sygv' with `TYPE = 1`.
1404ba59ac12SSebastian Grimberg 
1405ca94c3ddSJeremy L Thompson   @param[in]  ceed   `Ceed` context for error handling
1406ba59ac12SSebastian Grimberg   @param[in]  mat_A  Row-major matrix to be factorized with eigenvalues
1407ba59ac12SSebastian Grimberg   @param[in]  mat_B  Row-major matrix to be factorized to identity
1408ba59ac12SSebastian Grimberg   @param[out] mat_X  Row-major orthogonal matrix
1409ca94c3ddSJeremy L Thompson   @param[out] lambda Vector of length `n` of generalized eigenvalues
1410ba59ac12SSebastian Grimberg   @param[in]  n      Number of rows/columns
1411ba59ac12SSebastian Grimberg 
1412ba59ac12SSebastian Grimberg   @return An error code: 0 - success, otherwise - failure
1413ba59ac12SSebastian Grimberg 
1414ba59ac12SSebastian Grimberg   @ref Utility
1415ba59ac12SSebastian Grimberg **/
14162c2ea1dbSJeremy L Thompson CeedPragmaOptimizeOff
14172c2ea1dbSJeremy L Thompson int CeedSimultaneousDiagonalization(Ceed ceed, CeedScalar *mat_A, CeedScalar *mat_B, CeedScalar *mat_X, CeedScalar *lambda, CeedInt n) {
1418ba59ac12SSebastian Grimberg   CeedScalar *mat_C, *mat_G, *vec_D;
14191c66c397SJeremy L Thompson 
1420ba59ac12SSebastian Grimberg   CeedCall(CeedCalloc(n * n, &mat_C));
1421ba59ac12SSebastian Grimberg   CeedCall(CeedCalloc(n * n, &mat_G));
1422ba59ac12SSebastian Grimberg   CeedCall(CeedCalloc(n, &vec_D));
1423ba59ac12SSebastian Grimberg 
1424ba59ac12SSebastian Grimberg   // Compute B = G D G^T
1425ba59ac12SSebastian Grimberg   memcpy(mat_G, mat_B, n * n * sizeof(mat_B[0]));
1426ba59ac12SSebastian Grimberg   CeedCall(CeedSymmetricSchurDecomposition(ceed, mat_G, vec_D, n));
1427ba59ac12SSebastian Grimberg 
1428ba59ac12SSebastian Grimberg   // Sort eigenvalues
1429ba59ac12SSebastian Grimberg   for (CeedInt i = n - 1; i >= 0; i--) {
1430ba59ac12SSebastian Grimberg     for (CeedInt j = 0; j < i; j++) {
1431ba59ac12SSebastian Grimberg       if (fabs(vec_D[j]) > fabs(vec_D[j + 1])) {
14321c66c397SJeremy L Thompson         CeedScalarSwap(vec_D[j], vec_D[j + 1]);
14331c66c397SJeremy L Thompson         for (CeedInt k = 0; k < n; k++) CeedScalarSwap(mat_G[k * n + j], mat_G[k * n + j + 1]);
1434ba59ac12SSebastian Grimberg       }
1435ba59ac12SSebastian Grimberg     }
1436ba59ac12SSebastian Grimberg   }
1437ba59ac12SSebastian Grimberg 
1438ba59ac12SSebastian Grimberg   // Compute C = (G D^1/2)^-1 A (G D^1/2)^-T
1439ba59ac12SSebastian Grimberg   //           = D^-1/2 G^T A G D^-1/2
1440ba59ac12SSebastian Grimberg   // -- D = D^-1/2
1441ba59ac12SSebastian Grimberg   for (CeedInt i = 0; i < n; i++) vec_D[i] = 1. / sqrt(vec_D[i]);
1442ba59ac12SSebastian Grimberg   // -- G = G D^-1/2
1443ba59ac12SSebastian Grimberg   // -- C = D^-1/2 G^T
1444ba59ac12SSebastian Grimberg   for (CeedInt i = 0; i < n; i++) {
1445ba59ac12SSebastian Grimberg     for (CeedInt j = 0; j < n; j++) {
1446ba59ac12SSebastian Grimberg       mat_G[i * n + j] *= vec_D[j];
1447ba59ac12SSebastian Grimberg       mat_C[j * n + i] = mat_G[i * n + j];
1448ba59ac12SSebastian Grimberg     }
1449ba59ac12SSebastian Grimberg   }
1450ba59ac12SSebastian Grimberg   // -- X = (D^-1/2 G^T) A
1451ba59ac12SSebastian Grimberg   CeedCall(CeedMatrixMatrixMultiply(ceed, (const CeedScalar *)mat_C, (const CeedScalar *)mat_A, mat_X, n, n, n));
1452ba59ac12SSebastian Grimberg   // -- C = (D^-1/2 G^T A) (G D^-1/2)
1453ba59ac12SSebastian Grimberg   CeedCall(CeedMatrixMatrixMultiply(ceed, (const CeedScalar *)mat_X, (const CeedScalar *)mat_G, mat_C, n, n, n));
1454ba59ac12SSebastian Grimberg 
1455ba59ac12SSebastian Grimberg   // Compute Q^T C Q = lambda
1456ba59ac12SSebastian Grimberg   CeedCall(CeedSymmetricSchurDecomposition(ceed, mat_C, lambda, n));
1457ba59ac12SSebastian Grimberg 
1458ba59ac12SSebastian Grimberg   // Sort eigenvalues
1459ba59ac12SSebastian Grimberg   for (CeedInt i = n - 1; i >= 0; i--) {
1460ba59ac12SSebastian Grimberg     for (CeedInt j = 0; j < i; j++) {
1461ba59ac12SSebastian Grimberg       if (fabs(lambda[j]) > fabs(lambda[j + 1])) {
14621c66c397SJeremy L Thompson         CeedScalarSwap(lambda[j], lambda[j + 1]);
14631c66c397SJeremy L Thompson         for (CeedInt k = 0; k < n; k++) CeedScalarSwap(mat_C[k * n + j], mat_C[k * n + j + 1]);
1464ba59ac12SSebastian Grimberg       }
1465ba59ac12SSebastian Grimberg     }
1466ba59ac12SSebastian Grimberg   }
1467ba59ac12SSebastian Grimberg 
1468ba59ac12SSebastian Grimberg   // Set X = (G D^1/2)^-T Q
1469ba59ac12SSebastian Grimberg   //       = G D^-1/2 Q
1470ba59ac12SSebastian Grimberg   CeedCall(CeedMatrixMatrixMultiply(ceed, (const CeedScalar *)mat_G, (const CeedScalar *)mat_C, mat_X, n, n, n));
1471ba59ac12SSebastian Grimberg 
1472ba59ac12SSebastian Grimberg   // Cleanup
1473ba59ac12SSebastian Grimberg   CeedCall(CeedFree(&mat_C));
1474ba59ac12SSebastian Grimberg   CeedCall(CeedFree(&mat_G));
1475ba59ac12SSebastian Grimberg   CeedCall(CeedFree(&vec_D));
1476ba59ac12SSebastian Grimberg   return CEED_ERROR_SUCCESS;
1477ba59ac12SSebastian Grimberg }
14782c2ea1dbSJeremy L Thompson CeedPragmaOptimizeOn
1479ba59ac12SSebastian Grimberg 
14807a982d89SJeremy L. Thompson /// @}
14817a982d89SJeremy L. Thompson 
14827a982d89SJeremy L. Thompson /// ----------------------------------------------------------------------------
14837a982d89SJeremy L. Thompson /// CeedBasis Public API
14847a982d89SJeremy L. Thompson /// ----------------------------------------------------------------------------
14857a982d89SJeremy L. Thompson /// @addtogroup CeedBasisUser
1486d7b241e6Sjeremylt /// @{
1487d7b241e6Sjeremylt 
1488b11c1e72Sjeremylt /**
1489ca94c3ddSJeremy L Thompson   @brief Create a tensor-product basis for \f$H^1\f$ discretizations
1490b11c1e72Sjeremylt 
1491ca94c3ddSJeremy L Thompson   @param[in]  ceed        `Ceed` object used to create the `CeedBasis`
1492ea61e9acSJeremy L Thompson   @param[in]  dim         Topological dimension
1493ea61e9acSJeremy L Thompson   @param[in]  num_comp    Number of field components (1 for scalar fields)
1494ea61e9acSJeremy L Thompson   @param[in]  P_1d        Number of nodes in one dimension
1495ea61e9acSJeremy L Thompson   @param[in]  Q_1d        Number of quadrature points in one dimension
1496ca94c3ddSJeremy L Thompson   @param[in]  interp_1d   Row-major (`Q_1d * P_1d`) matrix expressing the values of nodal basis functions at quadrature points
1497ca94c3ddSJeremy L Thompson   @param[in]  grad_1d     Row-major (`Q_1d * P_1d`) matrix expressing derivatives of nodal basis functions at quadrature points
1498ca94c3ddSJeremy L Thompson   @param[in]  q_ref_1d    Array of length `Q_1d` holding the locations of quadrature points on the 1D reference element `[-1, 1]`
1499ca94c3ddSJeremy L Thompson   @param[in]  q_weight_1d Array of length `Q_1d` holding the quadrature weights on the reference element
1500ca94c3ddSJeremy L Thompson   @param[out] basis       Address of the variable where the newly created `CeedBasis` will be stored
1501b11c1e72Sjeremylt 
1502b11c1e72Sjeremylt   @return An error code: 0 - success, otherwise - failure
1503dfdf5a53Sjeremylt 
15047a982d89SJeremy L. Thompson   @ref User
1505b11c1e72Sjeremylt **/
15062b730f8bSJeremy L Thompson int CeedBasisCreateTensorH1(Ceed ceed, CeedInt dim, CeedInt num_comp, CeedInt P_1d, CeedInt Q_1d, const CeedScalar *interp_1d,
15072b730f8bSJeremy L Thompson                             const CeedScalar *grad_1d, const CeedScalar *q_ref_1d, const CeedScalar *q_weight_1d, CeedBasis *basis) {
15085fe0d4faSjeremylt   if (!ceed->BasisCreateTensorH1) {
15095fe0d4faSjeremylt     Ceed delegate;
15106574a04fSJeremy L Thompson 
15112b730f8bSJeremy L Thompson     CeedCall(CeedGetObjectDelegate(ceed, &delegate, "Basis"));
15121ef3a2a9SJeremy L Thompson     CeedCheck(delegate, ceed, CEED_ERROR_UNSUPPORTED, "Backend does not implement BasisCreateTensorH1");
15132b730f8bSJeremy L Thompson     CeedCall(CeedBasisCreateTensorH1(delegate, dim, num_comp, P_1d, Q_1d, interp_1d, grad_1d, q_ref_1d, q_weight_1d, basis));
15149bc66399SJeremy L Thompson     CeedCall(CeedDestroy(&delegate));
1515e15f9bd0SJeremy L Thompson     return CEED_ERROR_SUCCESS;
15165fe0d4faSjeremylt   }
1517e15f9bd0SJeremy L Thompson 
1518ca94c3ddSJeremy L Thompson   CeedCheck(dim > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis dimension must be a positive value");
1519ca94c3ddSJeremy L Thompson   CeedCheck(num_comp > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 component");
1520ca94c3ddSJeremy L Thompson   CeedCheck(P_1d > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 node");
1521ca94c3ddSJeremy L Thompson   CeedCheck(Q_1d > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 quadrature point");
1522227444bfSJeremy L Thompson 
15232b730f8bSJeremy L Thompson   CeedElemTopology topo = dim == 1 ? CEED_TOPOLOGY_LINE : dim == 2 ? CEED_TOPOLOGY_QUAD : CEED_TOPOLOGY_HEX;
1524e15f9bd0SJeremy L Thompson 
15252b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(1, basis));
1526db002c03SJeremy L Thompson   CeedCall(CeedReferenceCopy(ceed, &(*basis)->ceed));
1527d1d35e2fSjeremylt   (*basis)->ref_count       = 1;
15286402da51SJeremy L Thompson   (*basis)->is_tensor_basis = true;
1529d7b241e6Sjeremylt   (*basis)->dim             = dim;
1530d99fa3c5SJeremy L Thompson   (*basis)->topo            = topo;
1531d1d35e2fSjeremylt   (*basis)->num_comp        = num_comp;
1532d1d35e2fSjeremylt   (*basis)->P_1d            = P_1d;
1533d1d35e2fSjeremylt   (*basis)->Q_1d            = Q_1d;
1534d1d35e2fSjeremylt   (*basis)->P               = CeedIntPow(P_1d, dim);
1535d1d35e2fSjeremylt   (*basis)->Q               = CeedIntPow(Q_1d, dim);
1536c4e3f59bSSebastian Grimberg   (*basis)->fe_space        = CEED_FE_SPACE_H1;
15372b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(Q_1d, &(*basis)->q_ref_1d));
15382b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(Q_1d, &(*basis)->q_weight_1d));
1539ff3a0f91SJeremy L Thompson   if (q_ref_1d) memcpy((*basis)->q_ref_1d, q_ref_1d, Q_1d * sizeof(q_ref_1d[0]));
15402b730f8bSJeremy L Thompson   if (q_weight_1d) memcpy((*basis)->q_weight_1d, q_weight_1d, Q_1d * sizeof(q_weight_1d[0]));
15412b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(Q_1d * P_1d, &(*basis)->interp_1d));
15422b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(Q_1d * P_1d, &(*basis)->grad_1d));
15432b730f8bSJeremy L Thompson   if (interp_1d) memcpy((*basis)->interp_1d, interp_1d, Q_1d * P_1d * sizeof(interp_1d[0]));
1544ff3a0f91SJeremy L Thompson   if (grad_1d) memcpy((*basis)->grad_1d, grad_1d, Q_1d * P_1d * sizeof(grad_1d[0]));
15452b730f8bSJeremy L Thompson   CeedCall(ceed->BasisCreateTensorH1(dim, P_1d, Q_1d, interp_1d, grad_1d, q_ref_1d, q_weight_1d, *basis));
1546e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
1547d7b241e6Sjeremylt }
1548d7b241e6Sjeremylt 
1549b11c1e72Sjeremylt /**
1550ca94c3ddSJeremy L Thompson   @brief Create a tensor-product \f$H^1\f$ Lagrange basis
1551b11c1e72Sjeremylt 
1552ca94c3ddSJeremy L Thompson   @param[in]  ceed      `Ceed` object used to create the `CeedBasis`
1553ea61e9acSJeremy L Thompson   @param[in]  dim       Topological dimension of element
1554ea61e9acSJeremy L Thompson   @param[in]  num_comp  Number of field components (1 for scalar fields)
1555ea61e9acSJeremy L Thompson   @param[in]  P         Number of Gauss-Lobatto nodes in one dimension.
1556ca94c3ddSJeremy L Thompson                           The polynomial degree of the resulting `Q_k` element is `k = P - 1`.
1557ea61e9acSJeremy L Thompson   @param[in]  Q         Number of quadrature points in one dimension.
1558ca94c3ddSJeremy L Thompson   @param[in]  quad_mode Distribution of the `Q` quadrature points (affects order of accuracy for the quadrature)
1559ca94c3ddSJeremy L Thompson   @param[out] basis     Address of the variable where the newly created `CeedBasis` will be stored
1560b11c1e72Sjeremylt 
1561b11c1e72Sjeremylt   @return An error code: 0 - success, otherwise - failure
1562dfdf5a53Sjeremylt 
15637a982d89SJeremy L. Thompson   @ref User
1564b11c1e72Sjeremylt **/
15652b730f8bSJeremy L Thompson int CeedBasisCreateTensorH1Lagrange(Ceed ceed, CeedInt dim, CeedInt num_comp, CeedInt P, CeedInt Q, CeedQuadMode quad_mode, CeedBasis *basis) {
1566d7b241e6Sjeremylt   // Allocate
1567c8c3fa7dSJeremy L Thompson   int        ierr = CEED_ERROR_SUCCESS;
15682b730f8bSJeremy L Thompson   CeedScalar c1, c2, c3, c4, dx, *nodes, *interp_1d, *grad_1d, *q_ref_1d, *q_weight_1d;
15694d537eeaSYohann 
1570ca94c3ddSJeremy L Thompson   CeedCheck(dim > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis dimension must be a positive value");
1571ca94c3ddSJeremy L Thompson   CeedCheck(num_comp > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 component");
1572ca94c3ddSJeremy L Thompson   CeedCheck(P > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 node");
1573ca94c3ddSJeremy L Thompson   CeedCheck(Q > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 quadrature point");
1574227444bfSJeremy L Thompson 
1575e15f9bd0SJeremy L Thompson   // Get Nodes and Weights
15762b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(P * Q, &interp_1d));
15772b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(P * Q, &grad_1d));
15782b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(P, &nodes));
15792b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(Q, &q_ref_1d));
15802b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(Q, &q_weight_1d));
15812b730f8bSJeremy L Thompson   if (CeedLobattoQuadrature(P, nodes, NULL) != CEED_ERROR_SUCCESS) goto cleanup;
1582d1d35e2fSjeremylt   switch (quad_mode) {
1583d7b241e6Sjeremylt     case CEED_GAUSS:
1584d1d35e2fSjeremylt       ierr = CeedGaussQuadrature(Q, q_ref_1d, q_weight_1d);
1585d7b241e6Sjeremylt       break;
1586d7b241e6Sjeremylt     case CEED_GAUSS_LOBATTO:
1587d1d35e2fSjeremylt       ierr = CeedLobattoQuadrature(Q, q_ref_1d, q_weight_1d);
1588d7b241e6Sjeremylt       break;
1589d7b241e6Sjeremylt   }
15902b730f8bSJeremy L Thompson   if (ierr != CEED_ERROR_SUCCESS) goto cleanup;
1591e15f9bd0SJeremy L Thompson 
1592d7b241e6Sjeremylt   // Build B, D matrix
1593d7b241e6Sjeremylt   // Fornberg, 1998
1594c8c3fa7dSJeremy L Thompson   for (CeedInt i = 0; i < Q; i++) {
1595d7b241e6Sjeremylt     c1                   = 1.0;
1596d1d35e2fSjeremylt     c3                   = nodes[0] - q_ref_1d[i];
1597d1d35e2fSjeremylt     interp_1d[i * P + 0] = 1.0;
1598c8c3fa7dSJeremy L Thompson     for (CeedInt j = 1; j < P; j++) {
1599d7b241e6Sjeremylt       c2 = 1.0;
1600d7b241e6Sjeremylt       c4 = c3;
1601d1d35e2fSjeremylt       c3 = nodes[j] - q_ref_1d[i];
1602c8c3fa7dSJeremy L Thompson       for (CeedInt k = 0; k < j; k++) {
1603d7b241e6Sjeremylt         dx = nodes[j] - nodes[k];
1604d7b241e6Sjeremylt         c2 *= dx;
1605d7b241e6Sjeremylt         if (k == j - 1) {
1606d1d35e2fSjeremylt           grad_1d[i * P + j]   = c1 * (interp_1d[i * P + k] - c4 * grad_1d[i * P + k]) / c2;
1607d1d35e2fSjeremylt           interp_1d[i * P + j] = -c1 * c4 * interp_1d[i * P + k] / c2;
1608d7b241e6Sjeremylt         }
1609d1d35e2fSjeremylt         grad_1d[i * P + k]   = (c3 * grad_1d[i * P + k] - interp_1d[i * P + k]) / dx;
1610d1d35e2fSjeremylt         interp_1d[i * P + k] = c3 * interp_1d[i * P + k] / dx;
1611d7b241e6Sjeremylt       }
1612d7b241e6Sjeremylt       c1 = c2;
1613d7b241e6Sjeremylt     }
1614d7b241e6Sjeremylt   }
16159ac7b42eSJeremy L Thompson   // Pass to CeedBasisCreateTensorH1
16162b730f8bSJeremy L Thompson   CeedCall(CeedBasisCreateTensorH1(ceed, dim, num_comp, P, Q, interp_1d, grad_1d, q_ref_1d, q_weight_1d, basis));
1617e15f9bd0SJeremy L Thompson cleanup:
16182b730f8bSJeremy L Thompson   CeedCall(CeedFree(&interp_1d));
16192b730f8bSJeremy L Thompson   CeedCall(CeedFree(&grad_1d));
16202b730f8bSJeremy L Thompson   CeedCall(CeedFree(&nodes));
16212b730f8bSJeremy L Thompson   CeedCall(CeedFree(&q_ref_1d));
16222b730f8bSJeremy L Thompson   CeedCall(CeedFree(&q_weight_1d));
1623e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
1624d7b241e6Sjeremylt }
1625d7b241e6Sjeremylt 
1626b11c1e72Sjeremylt /**
1627ca94c3ddSJeremy L Thompson   @brief Create a non tensor-product basis for \f$H^1\f$ discretizations
1628a8de75f0Sjeremylt 
1629ca94c3ddSJeremy L Thompson   @param[in]  ceed      `Ceed` object used to create the `CeedBasis`
1630e00f3be8SJames Wright   @param[in]  topo      Topology of element, e.g. hypercube, simplex, etc
1631ea61e9acSJeremy L Thompson   @param[in]  num_comp  Number of field components (1 for scalar fields)
1632ea61e9acSJeremy L Thompson   @param[in]  num_nodes Total number of nodes
1633ea61e9acSJeremy L Thompson   @param[in]  num_qpts  Total number of quadrature points
1634ca94c3ddSJeremy L Thompson   @param[in]  interp    Row-major (`num_qpts * num_nodes`) matrix expressing the values of nodal basis functions at quadrature points
1635ca94c3ddSJeremy L Thompson   @param[in]  grad      Row-major (`dim * num_qpts * num_nodes`) matrix expressing derivatives of nodal basis functions at quadrature points
1636fda26546SJeremy L Thompson   @param[in]  q_ref     Array of length `num_qpts * dim` holding the locations of quadrature points on the reference element
1637ca94c3ddSJeremy L Thompson   @param[in]  q_weight  Array of length `num_qpts` holding the quadrature weights on the reference element
1638ca94c3ddSJeremy L Thompson   @param[out] basis     Address of the variable where the newly created `CeedBasis` will be stored
1639a8de75f0Sjeremylt 
1640a8de75f0Sjeremylt   @return An error code: 0 - success, otherwise - failure
1641a8de75f0Sjeremylt 
16427a982d89SJeremy L. Thompson   @ref User
1643a8de75f0Sjeremylt **/
16442b730f8bSJeremy L Thompson int CeedBasisCreateH1(Ceed ceed, CeedElemTopology topo, CeedInt num_comp, CeedInt num_nodes, CeedInt num_qpts, const CeedScalar *interp,
16452b730f8bSJeremy L Thompson                       const CeedScalar *grad, const CeedScalar *q_ref, const CeedScalar *q_weight, CeedBasis *basis) {
1646d1d35e2fSjeremylt   CeedInt P = num_nodes, Q = num_qpts, dim = 0;
1647a8de75f0Sjeremylt 
16485fe0d4faSjeremylt   if (!ceed->BasisCreateH1) {
16495fe0d4faSjeremylt     Ceed delegate;
16506574a04fSJeremy L Thompson 
16512b730f8bSJeremy L Thompson     CeedCall(CeedGetObjectDelegate(ceed, &delegate, "Basis"));
16521ef3a2a9SJeremy L Thompson     CeedCheck(delegate, ceed, CEED_ERROR_UNSUPPORTED, "Backend does not implement BasisCreateH1");
16532b730f8bSJeremy L Thompson     CeedCall(CeedBasisCreateH1(delegate, topo, num_comp, num_nodes, num_qpts, interp, grad, q_ref, q_weight, basis));
16549bc66399SJeremy L Thompson     CeedCall(CeedDestroy(&delegate));
1655e15f9bd0SJeremy L Thompson     return CEED_ERROR_SUCCESS;
16565fe0d4faSjeremylt   }
16575fe0d4faSjeremylt 
1658ca94c3ddSJeremy L Thompson   CeedCheck(num_comp > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 component");
1659ca94c3ddSJeremy L Thompson   CeedCheck(num_nodes > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 node");
1660ca94c3ddSJeremy L Thompson   CeedCheck(num_qpts > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 quadrature point");
1661227444bfSJeremy L Thompson 
16622b730f8bSJeremy L Thompson   CeedCall(CeedBasisGetTopologyDimension(topo, &dim));
1663a8de75f0Sjeremylt 
1664db002c03SJeremy L Thompson   CeedCall(CeedCalloc(1, basis));
1665db002c03SJeremy L Thompson   CeedCall(CeedReferenceCopy(ceed, &(*basis)->ceed));
1666d1d35e2fSjeremylt   (*basis)->ref_count       = 1;
16676402da51SJeremy L Thompson   (*basis)->is_tensor_basis = false;
1668a8de75f0Sjeremylt   (*basis)->dim             = dim;
1669d99fa3c5SJeremy L Thompson   (*basis)->topo            = topo;
1670d1d35e2fSjeremylt   (*basis)->num_comp        = num_comp;
1671a8de75f0Sjeremylt   (*basis)->P               = P;
1672a8de75f0Sjeremylt   (*basis)->Q               = Q;
1673c4e3f59bSSebastian Grimberg   (*basis)->fe_space        = CEED_FE_SPACE_H1;
16742b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(Q * dim, &(*basis)->q_ref_1d));
16752b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(Q, &(*basis)->q_weight_1d));
1676ff3a0f91SJeremy L Thompson   if (q_ref) memcpy((*basis)->q_ref_1d, q_ref, Q * dim * sizeof(q_ref[0]));
1677ff3a0f91SJeremy L Thompson   if (q_weight) memcpy((*basis)->q_weight_1d, q_weight, Q * sizeof(q_weight[0]));
16782b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(Q * P, &(*basis)->interp));
16792b730f8bSJeremy L Thompson   CeedCall(CeedCalloc(dim * Q * P, &(*basis)->grad));
1680ff3a0f91SJeremy L Thompson   if (interp) memcpy((*basis)->interp, interp, Q * P * sizeof(interp[0]));
1681ff3a0f91SJeremy L Thompson   if (grad) memcpy((*basis)->grad, grad, dim * Q * P * sizeof(grad[0]));
16822b730f8bSJeremy L Thompson   CeedCall(ceed->BasisCreateH1(topo, dim, P, Q, interp, grad, q_ref, q_weight, *basis));
1683e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
1684a8de75f0Sjeremylt }
1685a8de75f0Sjeremylt 
1686a8de75f0Sjeremylt /**
1687859c15bbSJames Wright   @brief Create a non tensor-product basis for \f$H(\mathrm{div})\f$ discretizations
168850c301a5SRezgar Shakeri 
1689ca94c3ddSJeremy L Thompson   @param[in]  ceed      `Ceed` object used to create the `CeedBasis`
1690ea61e9acSJeremy L Thompson   @param[in]  topo      Topology of element (`CEED_TOPOLOGY_QUAD`, `CEED_TOPOLOGY_PRISM`, etc.), dimension of which is used in some array sizes below
1691ea61e9acSJeremy L Thompson   @param[in]  num_comp  Number of components (usually 1 for vectors in H(div) bases)
1692ca94c3ddSJeremy L Thompson   @param[in]  num_nodes Total number of nodes (DoFs per element)
1693ea61e9acSJeremy L Thompson   @param[in]  num_qpts  Total number of quadrature points
1694ca94c3ddSJeremy L Thompson   @param[in]  interp    Row-major (`dim * num_qpts * num_nodes`) matrix expressing the values of basis functions at quadrature points
1695ca94c3ddSJeremy L Thompson   @param[in]  div       Row-major (`num_qpts * num_nodes`) matrix expressing divergence of basis functions at quadrature points
1696ca94c3ddSJeremy L Thompson   @param[in]  q_ref     Array of length `num_qpts` * dim holding the locations of quadrature points on the reference element
1697ca94c3ddSJeremy L Thompson   @param[in]  q_weight  Array of length `num_qpts` holding the quadrature weights on the reference element
1698ca94c3ddSJeremy L Thompson   @param[out] basis     Address of the variable where the newly created `CeedBasis` will be stored
169950c301a5SRezgar Shakeri 
170050c301a5SRezgar Shakeri   @return An error code: 0 - success, otherwise - failure
170150c301a5SRezgar Shakeri 
170250c301a5SRezgar Shakeri   @ref User
170350c301a5SRezgar Shakeri **/
17042b730f8bSJeremy L Thompson int CeedBasisCreateHdiv(Ceed ceed, CeedElemTopology topo, CeedInt num_comp, CeedInt num_nodes, CeedInt num_qpts, const CeedScalar *interp,
17052b730f8bSJeremy L Thompson                         const CeedScalar *div, const CeedScalar *q_ref, const CeedScalar *q_weight, CeedBasis *basis) {
170650c301a5SRezgar Shakeri   CeedInt Q = num_qpts, P = num_nodes, dim = 0;
1707c4e3f59bSSebastian Grimberg 
170850c301a5SRezgar Shakeri   if (!ceed->BasisCreateHdiv) {
170950c301a5SRezgar Shakeri     Ceed delegate;
17106574a04fSJeremy L Thompson 
17112b730f8bSJeremy L Thompson     CeedCall(CeedGetObjectDelegate(ceed, &delegate, "Basis"));
17126574a04fSJeremy L Thompson     CeedCheck(delegate, ceed, CEED_ERROR_UNSUPPORTED, "Backend does not implement BasisCreateHdiv");
17132b730f8bSJeremy L Thompson     CeedCall(CeedBasisCreateHdiv(delegate, topo, num_comp, num_nodes, num_qpts, interp, div, q_ref, q_weight, basis));
17149bc66399SJeremy L Thompson     CeedCall(CeedDestroy(&delegate));
171550c301a5SRezgar Shakeri     return CEED_ERROR_SUCCESS;
171650c301a5SRezgar Shakeri   }
171750c301a5SRezgar Shakeri 
1718ca94c3ddSJeremy L Thompson   CeedCheck(num_comp > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 component");
1719ca94c3ddSJeremy L Thompson   CeedCheck(num_nodes > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 node");
1720ca94c3ddSJeremy L Thompson   CeedCheck(num_qpts > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 quadrature point");
1721227444bfSJeremy L Thompson 
1722c4e3f59bSSebastian Grimberg   CeedCall(CeedBasisGetTopologyDimension(topo, &dim));
1723c4e3f59bSSebastian Grimberg 
1724db002c03SJeremy L Thompson   CeedCall(CeedCalloc(1, basis));
1725db002c03SJeremy L Thompson   CeedCall(CeedReferenceCopy(ceed, &(*basis)->ceed));
172650c301a5SRezgar Shakeri   (*basis)->ref_count       = 1;
17276402da51SJeremy L Thompson   (*basis)->is_tensor_basis = false;
172850c301a5SRezgar Shakeri   (*basis)->dim             = dim;
172950c301a5SRezgar Shakeri   (*basis)->topo            = topo;
173050c301a5SRezgar Shakeri   (*basis)->num_comp        = num_comp;
173150c301a5SRezgar Shakeri   (*basis)->P               = P;
173250c301a5SRezgar Shakeri   (*basis)->Q               = Q;
1733c4e3f59bSSebastian Grimberg   (*basis)->fe_space        = CEED_FE_SPACE_HDIV;
17342b730f8bSJeremy L Thompson   CeedCall(CeedMalloc(Q * dim, &(*basis)->q_ref_1d));
17352b730f8bSJeremy L Thompson   CeedCall(CeedMalloc(Q, &(*basis)->q_weight_1d));
173650c301a5SRezgar Shakeri   if (q_ref) memcpy((*basis)->q_ref_1d, q_ref, Q * dim * sizeof(q_ref[0]));
173750c301a5SRezgar Shakeri   if (q_weight) memcpy((*basis)->q_weight_1d, q_weight, Q * sizeof(q_weight[0]));
17382b730f8bSJeremy L Thompson   CeedCall(CeedMalloc(dim * Q * P, &(*basis)->interp));
17392b730f8bSJeremy L Thompson   CeedCall(CeedMalloc(Q * P, &(*basis)->div));
174050c301a5SRezgar Shakeri   if (interp) memcpy((*basis)->interp, interp, dim * Q * P * sizeof(interp[0]));
174150c301a5SRezgar Shakeri   if (div) memcpy((*basis)->div, div, Q * P * sizeof(div[0]));
17422b730f8bSJeremy L Thompson   CeedCall(ceed->BasisCreateHdiv(topo, dim, P, Q, interp, div, q_ref, q_weight, *basis));
174350c301a5SRezgar Shakeri   return CEED_ERROR_SUCCESS;
174450c301a5SRezgar Shakeri }
174550c301a5SRezgar Shakeri 
174650c301a5SRezgar Shakeri /**
17474385fb7fSSebastian Grimberg   @brief Create a non tensor-product basis for \f$H(\mathrm{curl})\f$ discretizations
1748c4e3f59bSSebastian Grimberg 
1749ca94c3ddSJeremy L Thompson   @param[in]  ceed      `Ceed` object used to create the `CeedBasis`
1750c4e3f59bSSebastian Grimberg   @param[in]  topo      Topology of element (`CEED_TOPOLOGY_QUAD`, `CEED_TOPOLOGY_PRISM`, etc.), dimension of which is used in some array sizes below
1751ca94c3ddSJeremy L Thompson   @param[in]  num_comp  Number of components (usually 1 for vectors in \f$H(\mathrm{curl})\f$ bases)
1752ca94c3ddSJeremy L Thompson   @param[in]  num_nodes Total number of nodes (DoFs per element)
1753c4e3f59bSSebastian Grimberg   @param[in]  num_qpts  Total number of quadrature points
1754ca94c3ddSJeremy L Thompson   @param[in]  interp    Row-major (`dim * num_qpts * num_nodes`) matrix expressing the values of basis functions at quadrature points
1755ca94c3ddSJeremy L Thompson   @param[in]  curl      Row-major (`curl_comp * num_qpts * num_nodes`, `curl_comp = 1` if `dim < 3` otherwise `curl_comp = dim`) matrix expressing curl of basis functions at quadrature points
1756ca94c3ddSJeremy L Thompson   @param[in]  q_ref     Array of length `num_qpts * dim` holding the locations of quadrature points on the reference element
1757ca94c3ddSJeremy L Thompson   @param[in]  q_weight  Array of length `num_qpts` holding the quadrature weights on the reference element
1758ca94c3ddSJeremy L Thompson   @param[out] basis     Address of the variable where the newly created `CeedBasis` will be stored
1759c4e3f59bSSebastian Grimberg 
1760c4e3f59bSSebastian Grimberg   @return An error code: 0 - success, otherwise - failure
1761c4e3f59bSSebastian Grimberg 
1762c4e3f59bSSebastian Grimberg   @ref User
1763c4e3f59bSSebastian Grimberg **/
1764c4e3f59bSSebastian Grimberg int CeedBasisCreateHcurl(Ceed ceed, CeedElemTopology topo, CeedInt num_comp, CeedInt num_nodes, CeedInt num_qpts, const CeedScalar *interp,
1765c4e3f59bSSebastian Grimberg                          const CeedScalar *curl, const CeedScalar *q_ref, const CeedScalar *q_weight, CeedBasis *basis) {
1766c4e3f59bSSebastian Grimberg   CeedInt Q = num_qpts, P = num_nodes, dim = 0, curl_comp = 0;
1767c4e3f59bSSebastian Grimberg 
1768d075f50bSSebastian Grimberg   if (!ceed->BasisCreateHcurl) {
1769c4e3f59bSSebastian Grimberg     Ceed delegate;
17706574a04fSJeremy L Thompson 
1771c4e3f59bSSebastian Grimberg     CeedCall(CeedGetObjectDelegate(ceed, &delegate, "Basis"));
17726574a04fSJeremy L Thompson     CeedCheck(delegate, ceed, CEED_ERROR_UNSUPPORTED, "Backend does not implement BasisCreateHcurl");
1773c4e3f59bSSebastian Grimberg     CeedCall(CeedBasisCreateHcurl(delegate, topo, num_comp, num_nodes, num_qpts, interp, curl, q_ref, q_weight, basis));
17749bc66399SJeremy L Thompson     CeedCall(CeedDestroy(&delegate));
1775c4e3f59bSSebastian Grimberg     return CEED_ERROR_SUCCESS;
1776c4e3f59bSSebastian Grimberg   }
1777c4e3f59bSSebastian Grimberg 
1778ca94c3ddSJeremy L Thompson   CeedCheck(num_comp > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 component");
1779ca94c3ddSJeremy L Thompson   CeedCheck(num_nodes > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 node");
1780ca94c3ddSJeremy L Thompson   CeedCheck(num_qpts > 0, ceed, CEED_ERROR_DIMENSION, "CeedBasis must have at least 1 quadrature point");
1781c4e3f59bSSebastian Grimberg 
1782c4e3f59bSSebastian Grimberg   CeedCall(CeedBasisGetTopologyDimension(topo, &dim));
1783c4e3f59bSSebastian Grimberg   curl_comp = (dim < 3) ? 1 : dim;
1784c4e3f59bSSebastian Grimberg 
1785db002c03SJeremy L Thompson   CeedCall(CeedCalloc(1, basis));
1786db002c03SJeremy L Thompson   CeedCall(CeedReferenceCopy(ceed, &(*basis)->ceed));
1787c4e3f59bSSebastian Grimberg   (*basis)->ref_count       = 1;
17886402da51SJeremy L Thompson   (*basis)->is_tensor_basis = false;
1789c4e3f59bSSebastian Grimberg   (*basis)->dim             = dim;
1790c4e3f59bSSebastian Grimberg   (*basis)->topo            = topo;
1791c4e3f59bSSebastian Grimberg   (*basis)->num_comp        = num_comp;
1792c4e3f59bSSebastian Grimberg   (*basis)->P               = P;
1793c4e3f59bSSebastian Grimberg   (*basis)->Q               = Q;
1794c4e3f59bSSebastian Grimberg   (*basis)->fe_space        = CEED_FE_SPACE_HCURL;
1795c4e3f59bSSebastian Grimberg   CeedCall(CeedMalloc(Q * dim, &(*basis)->q_ref_1d));
1796c4e3f59bSSebastian Grimberg   CeedCall(CeedMalloc(Q, &(*basis)->q_weight_1d));
1797c4e3f59bSSebastian Grimberg   if (q_ref) memcpy((*basis)->q_ref_1d, q_ref, Q * dim * sizeof(q_ref[0]));
1798c4e3f59bSSebastian Grimberg   if (q_weight) memcpy((*basis)->q_weight_1d, q_weight, Q * sizeof(q_weight[0]));
1799c4e3f59bSSebastian Grimberg   CeedCall(CeedMalloc(dim * Q * P, &(*basis)->interp));
1800c4e3f59bSSebastian Grimberg   CeedCall(CeedMalloc(curl_comp * Q * P, &(*basis)->curl));
1801c4e3f59bSSebastian Grimberg   if (interp) memcpy((*basis)->interp, interp, dim * Q * P * sizeof(interp[0]));
1802c4e3f59bSSebastian Grimberg   if (curl) memcpy((*basis)->curl, curl, curl_comp * Q * P * sizeof(curl[0]));
1803c4e3f59bSSebastian Grimberg   CeedCall(ceed->BasisCreateHcurl(topo, dim, P, Q, interp, curl, q_ref, q_weight, *basis));
1804c4e3f59bSSebastian Grimberg   return CEED_ERROR_SUCCESS;
1805c4e3f59bSSebastian Grimberg }
1806c4e3f59bSSebastian Grimberg 
1807c4e3f59bSSebastian Grimberg /**
1808ca94c3ddSJeremy L Thompson   @brief Create a `CeedBasis` for projection from the nodes of `basis_from` to the nodes of `basis_to`.
1809ba59ac12SSebastian Grimberg 
1810ca94c3ddSJeremy L Thompson   Only @ref CEED_EVAL_INTERP will be valid for the new basis, `basis_project`.
1811ca94c3ddSJeremy L Thompson   For \f$H^1\f$ spaces, @ref CEED_EVAL_GRAD will also be valid.
1812ca94c3ddSJeremy L Thompson   The interpolation is given by `interp_project = interp_to^+ * interp_from`, where the pseudoinverse `interp_to^+` is given by QR factorization.
1813ca94c3ddSJeremy L Thompson   The gradient (for the \f$H^1\f$ case) is given by `grad_project = interp_to^+ * grad_from`.
181415ad3917SSebastian Grimberg 
181515ad3917SSebastian Grimberg   Note: `basis_from` and `basis_to` must have compatible quadrature spaces.
181615ad3917SSebastian Grimberg 
18179fd66db6SSebastian Grimberg   Note: `basis_project` will have the same number of components as `basis_from`, regardless of the number of components that `basis_to` has.
18189fd66db6SSebastian Grimberg         If `basis_from` has 3 components and `basis_to` has 5 components, then `basis_project` will have 3 components.
1819f113e5dcSJeremy L Thompson 
1820e104ad11SJames Wright   Note: If either `basis_from` or `basis_to` are non-tensor, then `basis_project` will also be non-tensor
1821e104ad11SJames Wright 
1822ca94c3ddSJeremy L Thompson   @param[in]  basis_from    `CeedBasis` to prolong from
1823ca94c3ddSJeremy L Thompson   @param[in]  basis_to      `CeedBasis` to prolong to
1824ca94c3ddSJeremy L Thompson   @param[out] basis_project Address of the variable where the newly created `CeedBasis` will be stored
1825f113e5dcSJeremy L Thompson 
1826f113e5dcSJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
1827f113e5dcSJeremy L Thompson 
1828f113e5dcSJeremy L Thompson   @ref User
1829f113e5dcSJeremy L Thompson **/
18302b730f8bSJeremy L Thompson int CeedBasisCreateProjection(CeedBasis basis_from, CeedBasis basis_to, CeedBasis *basis_project) {
1831f113e5dcSJeremy L Thompson   Ceed        ceed;
1832e104ad11SJames Wright   bool        create_tensor;
18331c66c397SJeremy L Thompson   CeedInt     dim, num_comp;
1834097cc795SJames Wright   CeedScalar *interp_project, *grad_project;
18351c66c397SJeremy L Thompson 
18362b730f8bSJeremy L Thompson   CeedCall(CeedBasisGetCeed(basis_to, &ceed));
1837f113e5dcSJeremy L Thompson 
1838ecc88aebSJeremy L Thompson   // Create projection matrix
18392b730f8bSJeremy L Thompson   CeedCall(CeedBasisCreateProjectionMatrices(basis_from, basis_to, &interp_project, &grad_project));
1840f113e5dcSJeremy L Thompson 
1841f113e5dcSJeremy L Thompson   // Build basis
1842e104ad11SJames Wright   {
1843e104ad11SJames Wright     bool is_tensor_to, is_tensor_from;
1844e104ad11SJames Wright 
1845e104ad11SJames Wright     CeedCall(CeedBasisIsTensor(basis_to, &is_tensor_to));
1846e104ad11SJames Wright     CeedCall(CeedBasisIsTensor(basis_from, &is_tensor_from));
1847e104ad11SJames Wright     create_tensor = is_tensor_from && is_tensor_to;
1848e104ad11SJames Wright   }
18492b730f8bSJeremy L Thompson   CeedCall(CeedBasisGetDimension(basis_to, &dim));
18502b730f8bSJeremy L Thompson   CeedCall(CeedBasisGetNumComponents(basis_from, &num_comp));
1851e104ad11SJames Wright   if (create_tensor) {
1852f113e5dcSJeremy L Thompson     CeedInt P_1d_to, P_1d_from;
18531c66c397SJeremy L Thompson 
18542b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumNodes1D(basis_from, &P_1d_from));
18552b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumNodes1D(basis_to, &P_1d_to));
1856097cc795SJames Wright     CeedCall(CeedBasisCreateTensorH1(ceed, dim, num_comp, P_1d_from, P_1d_to, interp_project, grad_project, NULL, NULL, basis_project));
1857f113e5dcSJeremy L Thompson   } else {
1858de05fbb2SSebastian Grimberg     // Even if basis_to and basis_from are not H1, the resulting basis is H1 for interpolation to work
1859f113e5dcSJeremy L Thompson     CeedInt          num_nodes_to, num_nodes_from;
18601c66c397SJeremy L Thompson     CeedElemTopology topo;
18611c66c397SJeremy L Thompson 
1862e00f3be8SJames Wright     CeedCall(CeedBasisGetTopology(basis_from, &topo));
18632b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumNodes(basis_from, &num_nodes_from));
18642b730f8bSJeremy L Thompson     CeedCall(CeedBasisGetNumNodes(basis_to, &num_nodes_to));
1865097cc795SJames Wright     CeedCall(CeedBasisCreateH1(ceed, topo, num_comp, num_nodes_from, num_nodes_to, interp_project, grad_project, NULL, NULL, basis_project));
1866f113e5dcSJeremy L Thompson   }
1867f113e5dcSJeremy L Thompson 
1868f113e5dcSJeremy L Thompson   // Cleanup
18692b730f8bSJeremy L Thompson   CeedCall(CeedFree(&interp_project));
18702b730f8bSJeremy L Thompson   CeedCall(CeedFree(&grad_project));
18719bc66399SJeremy L Thompson   CeedCall(CeedDestroy(&ceed));
1872f113e5dcSJeremy L Thompson   return CEED_ERROR_SUCCESS;
1873f113e5dcSJeremy L Thompson }
1874f113e5dcSJeremy L Thompson 
1875f113e5dcSJeremy L Thompson /**
1876ca94c3ddSJeremy L Thompson   @brief Copy the pointer to a `CeedBasis`.
18779560d06aSjeremylt 
1878ca94c3ddSJeremy L Thompson   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`.
1879ca94c3ddSJeremy L Thompson         This `CeedBasis` will be destroyed if `*basis_copy` is the only reference to this `CeedBasis`.
1880ea61e9acSJeremy L Thompson 
1881ca94c3ddSJeremy L Thompson   @param[in]     basis      `CeedBasis` to copy reference to
1882ea61e9acSJeremy L Thompson   @param[in,out] basis_copy Variable to store copied reference
18839560d06aSjeremylt 
18849560d06aSjeremylt   @return An error code: 0 - success, otherwise - failure
18859560d06aSjeremylt 
18869560d06aSjeremylt   @ref User
18879560d06aSjeremylt **/
18889560d06aSjeremylt int CeedBasisReferenceCopy(CeedBasis basis, CeedBasis *basis_copy) {
1889356036faSJeremy L Thompson   if (basis != CEED_BASIS_NONE) CeedCall(CeedBasisReference(basis));
18902b730f8bSJeremy L Thompson   CeedCall(CeedBasisDestroy(basis_copy));
18919560d06aSjeremylt   *basis_copy = basis;
18929560d06aSjeremylt   return CEED_ERROR_SUCCESS;
18939560d06aSjeremylt }
18949560d06aSjeremylt 
18959560d06aSjeremylt /**
1896ca94c3ddSJeremy L Thompson   @brief View a `CeedBasis`
18977a982d89SJeremy L. Thompson 
1898ca94c3ddSJeremy L Thompson   @param[in] basis  `CeedBasis` to view
1899ca94c3ddSJeremy L Thompson   @param[in] stream Stream to view to, e.g., `stdout`
19007a982d89SJeremy L. Thompson 
19017a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
19027a982d89SJeremy L. Thompson 
19037a982d89SJeremy L. Thompson   @ref User
19047a982d89SJeremy L. Thompson **/
19057a982d89SJeremy L. Thompson int CeedBasisView(CeedBasis basis, FILE *stream) {
19061203703bSJeremy L Thompson   bool             is_tensor_basis;
19071203703bSJeremy L Thompson   CeedElemTopology topo;
19081203703bSJeremy L Thompson   CeedFESpace      fe_space;
19091203703bSJeremy L Thompson 
19101203703bSJeremy L Thompson   // Basis data
19111203703bSJeremy L Thompson   CeedCall(CeedBasisIsTensor(basis, &is_tensor_basis));
19121203703bSJeremy L Thompson   CeedCall(CeedBasisGetTopology(basis, &topo));
19131203703bSJeremy L Thompson   CeedCall(CeedBasisGetFESpace(basis, &fe_space));
19142b730f8bSJeremy L Thompson 
191550c301a5SRezgar Shakeri   // Print FE space and element topology of the basis
1916edf04919SJeremy L Thompson   fprintf(stream, "CeedBasis in a %s on a %s element\n", CeedFESpaces[fe_space], CeedElemTopologies[topo]);
19171203703bSJeremy L Thompson   if (is_tensor_basis) {
1918edf04919SJeremy L Thompson     fprintf(stream, "  P: %" CeedInt_FMT "\n  Q: %" CeedInt_FMT "\n", basis->P_1d, basis->Q_1d);
191950c301a5SRezgar Shakeri   } else {
1920edf04919SJeremy L Thompson     fprintf(stream, "  P: %" CeedInt_FMT "\n  Q: %" CeedInt_FMT "\n", basis->P, basis->Q);
192150c301a5SRezgar Shakeri   }
1922edf04919SJeremy L Thompson   fprintf(stream, "  dimension: %" CeedInt_FMT "\n  field components: %" CeedInt_FMT "\n", basis->dim, basis->num_comp);
1923ea61e9acSJeremy L Thompson   // Print quadrature data, interpolation/gradient/divergence/curl of the basis
19241203703bSJeremy L Thompson   if (is_tensor_basis) {  // tensor basis
19251203703bSJeremy L Thompson     CeedInt           P_1d, Q_1d;
19261203703bSJeremy L Thompson     const CeedScalar *q_ref_1d, *q_weight_1d, *interp_1d, *grad_1d;
19271203703bSJeremy L Thompson 
19281203703bSJeremy L Thompson     CeedCall(CeedBasisGetNumNodes1D(basis, &P_1d));
19291203703bSJeremy L Thompson     CeedCall(CeedBasisGetNumQuadraturePoints1D(basis, &Q_1d));
19301203703bSJeremy L Thompson     CeedCall(CeedBasisGetQRef(basis, &q_ref_1d));
19311203703bSJeremy L Thompson     CeedCall(CeedBasisGetQWeights(basis, &q_weight_1d));
19321203703bSJeremy L Thompson     CeedCall(CeedBasisGetInterp1D(basis, &interp_1d));
19331203703bSJeremy L Thompson     CeedCall(CeedBasisGetGrad1D(basis, &grad_1d));
19341203703bSJeremy L Thompson 
19351203703bSJeremy L Thompson     CeedCall(CeedScalarView("qref1d", "\t% 12.8f", 1, Q_1d, q_ref_1d, stream));
19361203703bSJeremy L Thompson     CeedCall(CeedScalarView("qweight1d", "\t% 12.8f", 1, Q_1d, q_weight_1d, stream));
19371203703bSJeremy L Thompson     CeedCall(CeedScalarView("interp1d", "\t% 12.8f", Q_1d, P_1d, interp_1d, stream));
19381203703bSJeremy L Thompson     CeedCall(CeedScalarView("grad1d", "\t% 12.8f", Q_1d, P_1d, grad_1d, stream));
193950c301a5SRezgar Shakeri   } else {  // non-tensor basis
19401203703bSJeremy L Thompson     CeedInt           P, Q, dim, q_comp;
19411203703bSJeremy L Thompson     const CeedScalar *q_ref, *q_weight, *interp, *grad, *div, *curl;
19421203703bSJeremy L Thompson 
19431203703bSJeremy L Thompson     CeedCall(CeedBasisGetNumNodes(basis, &P));
19441203703bSJeremy L Thompson     CeedCall(CeedBasisGetNumQuadraturePoints(basis, &Q));
19451203703bSJeremy L Thompson     CeedCall(CeedBasisGetDimension(basis, &dim));
19461203703bSJeremy L Thompson     CeedCall(CeedBasisGetQRef(basis, &q_ref));
19471203703bSJeremy L Thompson     CeedCall(CeedBasisGetQWeights(basis, &q_weight));
19481203703bSJeremy L Thompson     CeedCall(CeedBasisGetInterp(basis, &interp));
19491203703bSJeremy L Thompson     CeedCall(CeedBasisGetGrad(basis, &grad));
19501203703bSJeremy L Thompson     CeedCall(CeedBasisGetDiv(basis, &div));
19511203703bSJeremy L Thompson     CeedCall(CeedBasisGetCurl(basis, &curl));
19521203703bSJeremy L Thompson 
19531203703bSJeremy L Thompson     CeedCall(CeedScalarView("qref", "\t% 12.8f", 1, Q * dim, q_ref, stream));
19541203703bSJeremy L Thompson     CeedCall(CeedScalarView("qweight", "\t% 12.8f", 1, Q, q_weight, stream));
1955c4e3f59bSSebastian Grimberg     CeedCall(CeedBasisGetNumQuadratureComponents(basis, CEED_EVAL_INTERP, &q_comp));
19561203703bSJeremy L Thompson     CeedCall(CeedScalarView("interp", "\t% 12.8f", q_comp * Q, P, interp, stream));
19571203703bSJeremy L Thompson     if (grad) {
1958c4e3f59bSSebastian Grimberg       CeedCall(CeedBasisGetNumQuadratureComponents(basis, CEED_EVAL_GRAD, &q_comp));
19591203703bSJeremy L Thompson       CeedCall(CeedScalarView("grad", "\t% 12.8f", q_comp * Q, P, grad, stream));
19607a982d89SJeremy L. Thompson     }
19611203703bSJeremy L Thompson     if (div) {
1962c4e3f59bSSebastian Grimberg       CeedCall(CeedBasisGetNumQuadratureComponents(basis, CEED_EVAL_DIV, &q_comp));
19631203703bSJeremy L Thompson       CeedCall(CeedScalarView("div", "\t% 12.8f", q_comp * Q, P, div, stream));
1964c4e3f59bSSebastian Grimberg     }
19651203703bSJeremy L Thompson     if (curl) {
1966c4e3f59bSSebastian Grimberg       CeedCall(CeedBasisGetNumQuadratureComponents(basis, CEED_EVAL_CURL, &q_comp));
19671203703bSJeremy L Thompson       CeedCall(CeedScalarView("curl", "\t% 12.8f", q_comp * Q, P, curl, stream));
196850c301a5SRezgar Shakeri     }
196950c301a5SRezgar Shakeri   }
1970e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
19717a982d89SJeremy L. Thompson }
19727a982d89SJeremy L. Thompson 
19737a982d89SJeremy L. Thompson /**
1974db2becc9SJeremy L Thompson   @brief Apply basis evaluation from nodes to quadrature points or vice versa
1975db2becc9SJeremy L Thompson 
1976db2becc9SJeremy L Thompson   @param[in]  basis     `CeedBasis` to evaluate
1977db2becc9SJeremy L Thompson   @param[in]  num_elem  The number of elements to apply the basis evaluation to;
1978db2becc9SJeremy L Thompson                           the backend will specify the ordering in @ref CeedElemRestrictionCreate()
1979db2becc9SJeremy L Thompson   @param[in]  t_mode    @ref CEED_NOTRANSPOSE to evaluate from nodes to quadrature points;
1980db2becc9SJeremy L Thompson                           @ref CEED_TRANSPOSE to apply the transpose, mapping from quadrature points to nodes
1981db2becc9SJeremy L Thompson   @param[in]  eval_mode @ref CEED_EVAL_NONE to use values directly,
1982db2becc9SJeremy L Thompson                           @ref CEED_EVAL_INTERP to use interpolated values,
1983db2becc9SJeremy L Thompson                           @ref CEED_EVAL_GRAD to use gradients,
1984db2becc9SJeremy L Thompson                           @ref CEED_EVAL_DIV to use divergence,
1985db2becc9SJeremy L Thompson                           @ref CEED_EVAL_CURL to use curl,
1986db2becc9SJeremy L Thompson                           @ref CEED_EVAL_WEIGHT to use quadrature weights
1987db2becc9SJeremy L Thompson   @param[in]  u         Input `CeedVector`
1988db2becc9SJeremy L Thompson   @param[out] v         Output `CeedVector`
1989db2becc9SJeremy L Thompson 
1990db2becc9SJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
1991db2becc9SJeremy L Thompson 
1992db2becc9SJeremy L Thompson   @ref User
1993db2becc9SJeremy L Thompson **/
1994db2becc9SJeremy L Thompson int CeedBasisApply(CeedBasis basis, CeedInt num_elem, CeedTransposeMode t_mode, CeedEvalMode eval_mode, CeedVector u, CeedVector v) {
1995db2becc9SJeremy L Thompson   CeedCall(CeedBasisApplyCheckDims(basis, num_elem, t_mode, eval_mode, u, v));
1996db2becc9SJeremy L Thompson   CeedCheck(basis->Apply, CeedBasisReturnCeed(basis), CEED_ERROR_UNSUPPORTED, "Backend does not support CeedBasisApply");
19972b730f8bSJeremy L Thompson   CeedCall(basis->Apply(basis, num_elem, t_mode, eval_mode, u, v));
1998e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
19997a982d89SJeremy L. Thompson }
20007a982d89SJeremy L. Thompson 
20017a982d89SJeremy L. Thompson /**
2002db2becc9SJeremy L Thompson   @brief Apply basis evaluation from quadrature points to nodes and sum into target vector
2003db2becc9SJeremy L Thompson 
2004db2becc9SJeremy L Thompson   @param[in]  basis     `CeedBasis` to evaluate
2005db2becc9SJeremy L Thompson   @param[in]  num_elem  The number of elements to apply the basis evaluation to;
2006db2becc9SJeremy L Thompson                           the backend will specify the ordering in @ref CeedElemRestrictionCreate()
2007db2becc9SJeremy L Thompson   @param[in]  t_mode    @ref CEED_TRANSPOSE to apply the transpose, mapping from quadrature points to nodes;
2008db2becc9SJeremy L Thompson                            @ref CEED_NOTRANSPOSE is not valid for `CeedBasisApplyAdd()`
2009db2becc9SJeremy L Thompson   @param[in]  eval_mode @ref CEED_EVAL_NONE to use values directly,
2010db2becc9SJeremy L Thompson                           @ref CEED_EVAL_INTERP to use interpolated values,
2011db2becc9SJeremy L Thompson                           @ref CEED_EVAL_GRAD to use gradients,
2012db2becc9SJeremy L Thompson                           @ref CEED_EVAL_DIV to use divergence,
2013db2becc9SJeremy L Thompson                           @ref CEED_EVAL_CURL to use curl,
2014db2becc9SJeremy L Thompson                           @ref CEED_EVAL_WEIGHT to use quadrature weights
2015db2becc9SJeremy L Thompson   @param[in]  u         Input `CeedVector`
2016db2becc9SJeremy L Thompson   @param[out] v         Output `CeedVector` to sum into
2017db2becc9SJeremy L Thompson 
2018db2becc9SJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
2019db2becc9SJeremy L Thompson 
2020db2becc9SJeremy L Thompson   @ref User
2021db2becc9SJeremy L Thompson **/
2022db2becc9SJeremy L Thompson int CeedBasisApplyAdd(CeedBasis basis, CeedInt num_elem, CeedTransposeMode t_mode, CeedEvalMode eval_mode, CeedVector u, CeedVector v) {
2023db2becc9SJeremy L Thompson   CeedCheck(t_mode == CEED_TRANSPOSE, CeedBasisReturnCeed(basis), CEED_ERROR_UNSUPPORTED, "CeedBasisApplyAdd only supports CEED_TRANSPOSE");
2024db2becc9SJeremy L Thompson   CeedCall(CeedBasisApplyCheckDims(basis, num_elem, t_mode, eval_mode, u, v));
2025db2becc9SJeremy L Thompson   CeedCheck(basis->ApplyAdd, CeedBasisReturnCeed(basis), CEED_ERROR_UNSUPPORTED, "Backend does not implement CeedBasisApplyAdd");
2026db2becc9SJeremy L Thompson   CeedCall(basis->ApplyAdd(basis, num_elem, t_mode, eval_mode, u, v));
2027db2becc9SJeremy L Thompson   return CEED_ERROR_SUCCESS;
2028db2becc9SJeremy L Thompson }
2029db2becc9SJeremy L Thompson 
2030db2becc9SJeremy L Thompson /**
2031db2becc9SJeremy L Thompson   @brief Apply basis evaluation from nodes to arbitrary points
2032db2becc9SJeremy L Thompson 
2033db2becc9SJeremy L Thompson   @param[in]  basis      `CeedBasis` to evaluate
2034db2becc9SJeremy L Thompson   @param[in]  num_elem   The number of elements to apply the basis evaluation to;
2035db2becc9SJeremy L Thompson                           the backend will specify the ordering in @ref CeedElemRestrictionCreate()
2036db2becc9SJeremy L Thompson   @param[in]  num_points Array of the number of points to apply the basis evaluation to in each element, size `num_elem`
2037db2becc9SJeremy L Thompson   @param[in]  t_mode     @ref CEED_NOTRANSPOSE to evaluate from nodes to points;
2038db2becc9SJeremy L Thompson                            @ref CEED_TRANSPOSE to apply the transpose, mapping from points to nodes
2039db2becc9SJeremy L Thompson   @param[in]  eval_mode  @ref CEED_EVAL_INTERP to use interpolated values,
2040db2becc9SJeremy L Thompson                            @ref CEED_EVAL_GRAD to use gradients,
2041db2becc9SJeremy L Thompson                            @ref CEED_EVAL_WEIGHT to use quadrature weights
2042db2becc9SJeremy L Thompson   @param[in]  x_ref      `CeedVector` holding reference coordinates of each point
2043db2becc9SJeremy L Thompson   @param[in]  u          Input `CeedVector`, of length `num_nodes * num_comp` for @ref CEED_NOTRANSPOSE
2044db2becc9SJeremy L Thompson   @param[out] v          Output `CeedVector`, of length `num_points * num_q_comp` for @ref CEED_NOTRANSPOSE with @ref CEED_EVAL_INTERP
2045db2becc9SJeremy L Thompson 
2046db2becc9SJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
2047db2becc9SJeremy L Thompson 
2048db2becc9SJeremy L Thompson   @ref User
2049db2becc9SJeremy L Thompson **/
2050db2becc9SJeremy L Thompson int CeedBasisApplyAtPoints(CeedBasis basis, CeedInt num_elem, const CeedInt *num_points, CeedTransposeMode t_mode, CeedEvalMode eval_mode,
2051db2becc9SJeremy L Thompson                            CeedVector x_ref, CeedVector u, CeedVector v) {
2052db2becc9SJeremy L Thompson   CeedCall(CeedBasisApplyAtPointsCheckDims(basis, num_elem, num_points, t_mode, eval_mode, x_ref, u, v));
2053db2becc9SJeremy L Thompson   if (basis->ApplyAtPoints) {
2054db2becc9SJeremy L Thompson     CeedCall(basis->ApplyAtPoints(basis, num_elem, num_points, t_mode, eval_mode, x_ref, u, v));
2055db2becc9SJeremy L Thompson   } else {
2056db2becc9SJeremy L Thompson     CeedCall(CeedBasisApplyAtPoints_Core(basis, false, num_elem, num_points, t_mode, eval_mode, x_ref, u, v));
2057db2becc9SJeremy L Thompson   }
2058db2becc9SJeremy L Thompson   return CEED_ERROR_SUCCESS;
2059db2becc9SJeremy L Thompson }
2060db2becc9SJeremy L Thompson 
2061db2becc9SJeremy L Thompson /**
2062db2becc9SJeremy L Thompson   @brief Apply basis evaluation from nodes to arbitrary points and sum into target vector
2063db2becc9SJeremy L Thompson 
2064db2becc9SJeremy L Thompson   @param[in]  basis      `CeedBasis` to evaluate
2065db2becc9SJeremy L Thompson   @param[in]  num_elem   The number of elements to apply the basis evaluation to;
2066db2becc9SJeremy L Thompson                           the backend will specify the ordering in @ref CeedElemRestrictionCreate()
2067db2becc9SJeremy L Thompson   @param[in]  num_points Array of the number of points to apply the basis evaluation to in each element, size `num_elem`
2068db2becc9SJeremy L Thompson   @param[in]  t_mode     @ref CEED_NOTRANSPOSE to evaluate from nodes to points;
2069db2becc9SJeremy L Thompson                            @ref CEED_NOTRANSPOSE is not valid for `CeedBasisApplyAddAtPoints()`
2070db2becc9SJeremy L Thompson   @param[in]  eval_mode  @ref CEED_EVAL_INTERP to use interpolated values,
2071db2becc9SJeremy L Thompson                            @ref CEED_EVAL_GRAD to use gradients,
2072db2becc9SJeremy L Thompson                            @ref CEED_EVAL_WEIGHT to use quadrature weights
2073db2becc9SJeremy L Thompson   @param[in]  x_ref      `CeedVector` holding reference coordinates of each point
2074db2becc9SJeremy L Thompson   @param[in]  u          Input `CeedVector`, of length `num_nodes * num_comp` for @ref CEED_NOTRANSPOSE
2075db2becc9SJeremy L Thompson   @param[out] v          Output `CeedVector`, of length `num_points * num_q_comp` for @ref CEED_NOTRANSPOSE with @ref CEED_EVAL_INTERP
2076db2becc9SJeremy L Thompson 
2077db2becc9SJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
2078db2becc9SJeremy L Thompson 
2079db2becc9SJeremy L Thompson   @ref User
2080db2becc9SJeremy L Thompson **/
2081db2becc9SJeremy L Thompson int CeedBasisApplyAddAtPoints(CeedBasis basis, CeedInt num_elem, const CeedInt *num_points, CeedTransposeMode t_mode, CeedEvalMode eval_mode,
2082db2becc9SJeremy L Thompson                               CeedVector x_ref, CeedVector u, CeedVector v) {
2083db2becc9SJeremy L Thompson   CeedCheck(t_mode == CEED_TRANSPOSE, CeedBasisReturnCeed(basis), CEED_ERROR_UNSUPPORTED, "CeedBasisApplyAddAtPoints only supports CEED_TRANSPOSE");
2084db2becc9SJeremy L Thompson   CeedCall(CeedBasisApplyAtPointsCheckDims(basis, num_elem, num_points, t_mode, eval_mode, x_ref, u, v));
2085db2becc9SJeremy L Thompson   if (basis->ApplyAddAtPoints) {
2086db2becc9SJeremy L Thompson     CeedCall(basis->ApplyAddAtPoints(basis, num_elem, num_points, t_mode, eval_mode, x_ref, u, v));
2087db2becc9SJeremy L Thompson   } else {
2088db2becc9SJeremy L Thompson     CeedCall(CeedBasisApplyAtPoints_Core(basis, true, num_elem, num_points, t_mode, eval_mode, x_ref, u, v));
2089db2becc9SJeremy L Thompson   }
2090db2becc9SJeremy L Thompson   return CEED_ERROR_SUCCESS;
2091db2becc9SJeremy L Thompson }
2092db2becc9SJeremy L Thompson 
2093db2becc9SJeremy L Thompson /**
20946e536b99SJeremy L Thompson   @brief Get the `Ceed` associated with a `CeedBasis`
2095b7c9bbdaSJeremy L Thompson 
2096ca94c3ddSJeremy L Thompson   @param[in]  basis `CeedBasis`
2097ca94c3ddSJeremy L Thompson   @param[out] ceed  Variable to store `Ceed`
2098b7c9bbdaSJeremy L Thompson 
2099b7c9bbdaSJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
2100b7c9bbdaSJeremy L Thompson 
2101b7c9bbdaSJeremy L Thompson   @ref Advanced
2102b7c9bbdaSJeremy L Thompson **/
2103b7c9bbdaSJeremy L Thompson int CeedBasisGetCeed(CeedBasis basis, Ceed *ceed) {
21049bc66399SJeremy L Thompson   *ceed = NULL;
21059bc66399SJeremy L Thompson   CeedCall(CeedReferenceCopy(CeedBasisReturnCeed(basis), ceed));
2106b7c9bbdaSJeremy L Thompson   return CEED_ERROR_SUCCESS;
2107b7c9bbdaSJeremy L Thompson }
2108b7c9bbdaSJeremy L Thompson 
2109b7c9bbdaSJeremy L Thompson /**
21106e536b99SJeremy L Thompson   @brief Return the `Ceed` associated with a `CeedBasis`
21116e536b99SJeremy L Thompson 
21126e536b99SJeremy L Thompson   @param[in]  basis `CeedBasis`
21136e536b99SJeremy L Thompson 
21146e536b99SJeremy L Thompson   @return `Ceed` associated with the `basis`
21156e536b99SJeremy L Thompson 
21166e536b99SJeremy L Thompson   @ref Advanced
21176e536b99SJeremy L Thompson **/
21186e536b99SJeremy L Thompson Ceed CeedBasisReturnCeed(CeedBasis basis) { return basis->ceed; }
21196e536b99SJeremy L Thompson 
21206e536b99SJeremy L Thompson /**
2121ca94c3ddSJeremy L Thompson   @brief Get dimension for given `CeedBasis`
21229d007619Sjeremylt 
2123ca94c3ddSJeremy L Thompson   @param[in]  basis `CeedBasis`
21249d007619Sjeremylt   @param[out] dim   Variable to store dimension of basis
21259d007619Sjeremylt 
21269d007619Sjeremylt   @return An error code: 0 - success, otherwise - failure
21279d007619Sjeremylt 
2128b7c9bbdaSJeremy L Thompson   @ref Advanced
21299d007619Sjeremylt **/
21309d007619Sjeremylt int CeedBasisGetDimension(CeedBasis basis, CeedInt *dim) {
21319d007619Sjeremylt   *dim = basis->dim;
2132e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
21339d007619Sjeremylt }
21349d007619Sjeremylt 
21359d007619Sjeremylt /**
2136ca94c3ddSJeremy L Thompson   @brief Get topology for given `CeedBasis`
2137d99fa3c5SJeremy L Thompson 
2138ca94c3ddSJeremy L Thompson   @param[in]  basis `CeedBasis`
2139d99fa3c5SJeremy L Thompson   @param[out] topo  Variable to store topology of basis
2140d99fa3c5SJeremy L Thompson 
2141d99fa3c5SJeremy L Thompson   @return An error code: 0 - success, otherwise - failure
2142d99fa3c5SJeremy L Thompson 
2143b7c9bbdaSJeremy L Thompson   @ref Advanced
2144d99fa3c5SJeremy L Thompson **/
2145d99fa3c5SJeremy L Thompson int CeedBasisGetTopology(CeedBasis basis, CeedElemTopology *topo) {
2146d99fa3c5SJeremy L Thompson   *topo = basis->topo;
2147e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
2148d99fa3c5SJeremy L Thompson }
2149d99fa3c5SJeremy L Thompson 
2150d99fa3c5SJeremy L Thompson /**
2151ca94c3ddSJeremy L Thompson   @brief Get number of components for given `CeedBasis`
21529d007619Sjeremylt 
2153ca94c3ddSJeremy L Thompson   @param[in]  basis    `CeedBasis`
2154ca94c3ddSJeremy L Thompson   @param[out] num_comp Variable to store number of components
21559d007619Sjeremylt 
21569d007619Sjeremylt   @return An error code: 0 - success, otherwise - failure
21579d007619Sjeremylt 
2158b7c9bbdaSJeremy L Thompson   @ref Advanced
21599d007619Sjeremylt **/
2160d1d35e2fSjeremylt int CeedBasisGetNumComponents(CeedBasis basis, CeedInt *num_comp) {
2161d1d35e2fSjeremylt   *num_comp = basis->num_comp;
2162e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
21639d007619Sjeremylt }
21649d007619Sjeremylt 
21659d007619Sjeremylt /**
2166ca94c3ddSJeremy L Thompson   @brief Get total number of nodes (in `dim` dimensions) of a `CeedBasis`
21679d007619Sjeremylt 
2168ca94c3ddSJeremy L Thompson   @param[in]  basis `CeedBasis`
21699d007619Sjeremylt   @param[out] P     Variable to store number of nodes
21709d007619Sjeremylt 
21719d007619Sjeremylt   @return An error code: 0 - success, otherwise - failure
21729d007619Sjeremylt 
21739d007619Sjeremylt   @ref Utility
21749d007619Sjeremylt **/
21759d007619Sjeremylt int CeedBasisGetNumNodes(CeedBasis basis, CeedInt *P) {
21769d007619Sjeremylt   *P = basis->P;
2177e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
21789d007619Sjeremylt }
21799d007619Sjeremylt 
21809d007619Sjeremylt /**
2181ca94c3ddSJeremy L Thompson   @brief Get total number of nodes (in 1 dimension) of a `CeedBasis`
21829d007619Sjeremylt 
2183ca94c3ddSJeremy L Thompson   @param[in]  basis `CeedBasis`
2184d1d35e2fSjeremylt   @param[out] P_1d  Variable to store number of nodes
21859d007619Sjeremylt 
21869d007619Sjeremylt   @return An error code: 0 - success, otherwise - failure
21879d007619Sjeremylt 
2188b7c9bbdaSJeremy L Thompson   @ref Advanced
21899d007619Sjeremylt **/
2190d1d35e2fSjeremylt int CeedBasisGetNumNodes1D(CeedBasis basis, CeedInt *P_1d) {
21916e536b99SJeremy L Thompson   CeedCheck(basis->is_tensor_basis, CeedBasisReturnCeed(basis), CEED_ERROR_MINOR, "Cannot supply P_1d for non-tensor CeedBasis");
2192d1d35e2fSjeremylt   *P_1d = basis->P_1d;
2193e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
21949d007619Sjeremylt }
21959d007619Sjeremylt 
21969d007619Sjeremylt /**
2197ca94c3ddSJeremy L Thompson   @brief Get total number of quadrature points (in `dim` dimensions) of a `CeedBasis`
21989d007619Sjeremylt 
2199ca94c3ddSJeremy L Thompson   @param[in]  basis `CeedBasis`
22009d007619Sjeremylt   @param[out] Q     Variable to store number of quadrature points
22019d007619Sjeremylt 
22029d007619Sjeremylt   @return An error code: 0 - success, otherwise - failure
22039d007619Sjeremylt 
22049d007619Sjeremylt   @ref Utility
22059d007619Sjeremylt **/
22069d007619Sjeremylt int CeedBasisGetNumQuadraturePoints(CeedBasis basis, CeedInt *Q) {
22079d007619Sjeremylt   *Q = basis->Q;
2208e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
22099d007619Sjeremylt }
22109d007619Sjeremylt 
22119d007619Sjeremylt /**
2212ca94c3ddSJeremy L Thompson   @brief Get total number of quadrature points (in 1 dimension) of a `CeedBasis`
22139d007619Sjeremylt 
2214ca94c3ddSJeremy L Thompson   @param[in]  basis `CeedBasis`
2215d1d35e2fSjeremylt   @param[out] Q_1d  Variable to store number of quadrature points
22169d007619Sjeremylt 
22179d007619Sjeremylt   @return An error code: 0 - success, otherwise - failure
22189d007619Sjeremylt 
2219b7c9bbdaSJeremy L Thompson   @ref Advanced
22209d007619Sjeremylt **/
2221d1d35e2fSjeremylt int CeedBasisGetNumQuadraturePoints1D(CeedBasis basis, CeedInt *Q_1d) {
22226e536b99SJeremy L Thompson   CeedCheck(basis->is_tensor_basis, CeedBasisReturnCeed(basis), CEED_ERROR_MINOR, "Cannot supply Q_1d for non-tensor CeedBasis");
2223d1d35e2fSjeremylt   *Q_1d = basis->Q_1d;
2224e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
22259d007619Sjeremylt }
22269d007619Sjeremylt 
22279d007619Sjeremylt /**
2228ca94c3ddSJeremy L Thompson   @brief Get reference coordinates of quadrature points (in `dim` dimensions) of a `CeedBasis`
22299d007619Sjeremylt 
2230ca94c3ddSJeremy L Thompson   @param[in]  basis `CeedBasis`
2231d1d35e2fSjeremylt   @param[out] q_ref Variable to store reference coordinates of quadrature points
22329d007619Sjeremylt 
22339d007619Sjeremylt   @return An error code: 0 - success, otherwise - failure
22349d007619Sjeremylt 
2235b7c9bbdaSJeremy L Thompson   @ref Advanced
22369d007619Sjeremylt **/
2237d1d35e2fSjeremylt int CeedBasisGetQRef(CeedBasis basis, const CeedScalar **q_ref) {
2238d1d35e2fSjeremylt   *q_ref = basis->q_ref_1d;
2239e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
22409d007619Sjeremylt }
22419d007619Sjeremylt 
22429d007619Sjeremylt /**
2243ca94c3ddSJeremy L Thompson   @brief Get quadrature weights of quadrature points (in `dim` dimensions) of a `CeedBasis`
22449d007619Sjeremylt 
2245ca94c3ddSJeremy L Thompson   @param[in]  basis    `CeedBasis`
2246d1d35e2fSjeremylt   @param[out] q_weight Variable to store quadrature weights
22479d007619Sjeremylt 
22489d007619Sjeremylt   @return An error code: 0 - success, otherwise - failure
22499d007619Sjeremylt 
2250b7c9bbdaSJeremy L Thompson   @ref Advanced
22519d007619Sjeremylt **/
2252d1d35e2fSjeremylt int CeedBasisGetQWeights(CeedBasis basis, const CeedScalar **q_weight) {
2253d1d35e2fSjeremylt   *q_weight = basis->q_weight_1d;
2254e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
22559d007619Sjeremylt }
22569d007619Sjeremylt 
22579d007619Sjeremylt /**
2258ca94c3ddSJeremy L Thompson   @brief Get interpolation matrix of a `CeedBasis`
22599d007619Sjeremylt 
2260ca94c3ddSJeremy L Thompson   @param[in]  basis  `CeedBasis`
22619d007619Sjeremylt   @param[out] interp Variable to store interpolation matrix
22629d007619Sjeremylt 
22639d007619Sjeremylt   @return An error code: 0 - success, otherwise - failure
22649d007619Sjeremylt 
2265b7c9bbdaSJeremy L Thompson   @ref Advanced
22669d007619Sjeremylt **/
22676c58de82SJeremy L Thompson int CeedBasisGetInterp(CeedBasis basis, const CeedScalar **interp) {
22686402da51SJeremy L Thompson   if (!basis->interp && basis->is_tensor_basis) {
22699d007619Sjeremylt     // Allocate
22702b730f8bSJeremy L Thompson     CeedCall(CeedMalloc(basis->Q * basis->P, &basis->interp));
22719d007619Sjeremylt 
22729d007619Sjeremylt     // Initialize
22732b730f8bSJeremy L Thompson     for (CeedInt i = 0; i < basis->Q * basis->P; i++) basis->interp[i] = 1.0;
22749d007619Sjeremylt 
22759d007619Sjeremylt     // Calculate
22762b730f8bSJeremy L Thompson     for (CeedInt d = 0; d < basis->dim; d++) {
22772b730f8bSJeremy L Thompson       for (CeedInt qpt = 0; qpt < basis->Q; qpt++) {
22789d007619Sjeremylt         for (CeedInt node = 0; node < basis->P; node++) {
2279d1d35e2fSjeremylt           CeedInt p = (node / CeedIntPow(basis->P_1d, d)) % basis->P_1d;
2280d1d35e2fSjeremylt           CeedInt q = (qpt / CeedIntPow(basis->Q_1d, d)) % basis->Q_1d;
22811c66c397SJeremy L Thompson 
2282d1d35e2fSjeremylt           basis->interp[qpt * (basis->P) + node] *= basis->interp_1d[q * basis->P_1d + p];
22839d007619Sjeremylt         }
22849d007619Sjeremylt       }
22852b730f8bSJeremy L Thompson     }
22862b730f8bSJeremy L Thompson   }
22879d007619Sjeremylt   *interp = basis->interp;
2288e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
22899d007619Sjeremylt }
22909d007619Sjeremylt 
22919d007619Sjeremylt /**
2292ca94c3ddSJeremy L Thompson   @brief Get 1D interpolation matrix of a tensor product `CeedBasis`
22939d007619Sjeremylt 
2294ca94c3ddSJeremy L Thompson   @param[in]  basis     `CeedBasis`
2295d1d35e2fSjeremylt   @param[out] interp_1d Variable to store interpolation matrix
22969d007619Sjeremylt 
22979d007619Sjeremylt   @return An error code: 0 - success, otherwise - failure
22989d007619Sjeremylt 
22999d007619Sjeremylt   @ref Backend
23009d007619Sjeremylt **/
2301d1d35e2fSjeremylt int CeedBasisGetInterp1D(CeedBasis basis, const CeedScalar **interp_1d) {
23021203703bSJeremy L Thompson   bool is_tensor_basis;
23031203703bSJeremy L Thompson 
23041203703bSJeremy L Thompson   CeedCall(CeedBasisIsTensor(basis, &is_tensor_basis));
23056e536b99SJeremy L Thompson   CeedCheck(is_tensor_basis, CeedBasisReturnCeed(basis), CEED_ERROR_MINOR, "CeedBasis is not a tensor product CeedBasis");
2306d1d35e2fSjeremylt   *interp_1d = basis->interp_1d;
2307e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
23089d007619Sjeremylt }
23099d007619Sjeremylt 
23109d007619Sjeremylt /**
2311ca94c3ddSJeremy L Thompson   @brief Get gradient matrix of a `CeedBasis`
23129d007619Sjeremylt 
2313ca94c3ddSJeremy L Thompson   @param[in]  basis `CeedBasis`
23149d007619Sjeremylt   @param[out] grad  Variable to store gradient matrix
23159d007619Sjeremylt 
23169d007619Sjeremylt   @return An error code: 0 - success, otherwise - failure
23179d007619Sjeremylt 
2318b7c9bbdaSJeremy L Thompson   @ref Advanced
23199d007619Sjeremylt **/
23206c58de82SJeremy L Thompson int CeedBasisGetGrad(CeedBasis basis, const CeedScalar **grad) {
23216402da51SJeremy L Thompson   if (!basis->grad && basis->is_tensor_basis) {
23229d007619Sjeremylt     // Allocate
23232b730f8bSJeremy L Thompson     CeedCall(CeedMalloc(basis->dim * basis->Q * basis->P, &basis->grad));
23249d007619Sjeremylt 
23259d007619Sjeremylt     // Initialize
23262b730f8bSJeremy L Thompson     for (CeedInt i = 0; i < basis->dim * basis->Q * basis->P; i++) basis->grad[i] = 1.0;
23279d007619Sjeremylt 
23289d007619Sjeremylt     // Calculate
23292b730f8bSJeremy L Thompson     for (CeedInt d = 0; d < basis->dim; d++) {
23302b730f8bSJeremy L Thompson       for (CeedInt i = 0; i < basis->dim; i++) {
23312b730f8bSJeremy L Thompson         for (CeedInt qpt = 0; qpt < basis->Q; qpt++) {
23329d007619Sjeremylt           for (CeedInt node = 0; node < basis->P; node++) {
2333d1d35e2fSjeremylt             CeedInt p = (node / CeedIntPow(basis->P_1d, d)) % basis->P_1d;
2334d1d35e2fSjeremylt             CeedInt q = (qpt / CeedIntPow(basis->Q_1d, d)) % basis->Q_1d;
23351c66c397SJeremy L Thompson 
23362b730f8bSJeremy L Thompson             if (i == d) basis->grad[(i * basis->Q + qpt) * (basis->P) + node] *= basis->grad_1d[q * basis->P_1d + p];
23372b730f8bSJeremy L Thompson             else basis->grad[(i * basis->Q + qpt) * (basis->P) + node] *= basis->interp_1d[q * basis->P_1d + p];
23382b730f8bSJeremy L Thompson           }
23392b730f8bSJeremy L Thompson         }
23402b730f8bSJeremy L Thompson       }
23419d007619Sjeremylt     }
23429d007619Sjeremylt   }
23439d007619Sjeremylt   *grad = basis->grad;
2344e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
23459d007619Sjeremylt }
23469d007619Sjeremylt 
23479d007619Sjeremylt /**
2348ca94c3ddSJeremy L Thompson   @brief Get 1D gradient matrix of a tensor product `CeedBasis`
23499d007619Sjeremylt 
2350ca94c3ddSJeremy L Thompson   @param[in]  basis   `CeedBasis`
2351d1d35e2fSjeremylt   @param[out] grad_1d Variable to store gradient matrix
23529d007619Sjeremylt 
23539d007619Sjeremylt   @return An error code: 0 - success, otherwise - failure
23549d007619Sjeremylt 
2355b7c9bbdaSJeremy L Thompson   @ref Advanced
23569d007619Sjeremylt **/
2357d1d35e2fSjeremylt int CeedBasisGetGrad1D(CeedBasis basis, const CeedScalar **grad_1d) {
23581203703bSJeremy L Thompson   bool is_tensor_basis;
23591203703bSJeremy L Thompson 
23601203703bSJeremy L Thompson   CeedCall(CeedBasisIsTensor(basis, &is_tensor_basis));
23616e536b99SJeremy L Thompson   CeedCheck(is_tensor_basis, CeedBasisReturnCeed(basis), CEED_ERROR_MINOR, "CeedBasis is not a tensor product CeedBasis");
2362d1d35e2fSjeremylt   *grad_1d = basis->grad_1d;
2363e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
23649d007619Sjeremylt }
23659d007619Sjeremylt 
23669d007619Sjeremylt /**
2367ca94c3ddSJeremy L Thompson   @brief Get divergence matrix of a `CeedBasis`
236850c301a5SRezgar Shakeri 
2369ca94c3ddSJeremy L Thompson   @param[in]  basis `CeedBasis`
237050c301a5SRezgar Shakeri   @param[out] div   Variable to store divergence matrix
237150c301a5SRezgar Shakeri 
237250c301a5SRezgar Shakeri   @return An error code: 0 - success, otherwise - failure
237350c301a5SRezgar Shakeri 
237450c301a5SRezgar Shakeri   @ref Advanced
237550c301a5SRezgar Shakeri **/
237650c301a5SRezgar Shakeri int CeedBasisGetDiv(CeedBasis basis, const CeedScalar **div) {
237750c301a5SRezgar Shakeri   *div = basis->div;
237850c301a5SRezgar Shakeri   return CEED_ERROR_SUCCESS;
237950c301a5SRezgar Shakeri }
238050c301a5SRezgar Shakeri 
238150c301a5SRezgar Shakeri /**
2382ca94c3ddSJeremy L Thompson   @brief Get curl matrix of a `CeedBasis`
2383c4e3f59bSSebastian Grimberg 
2384ca94c3ddSJeremy L Thompson   @param[in]  basis `CeedBasis`
2385c4e3f59bSSebastian Grimberg   @param[out] curl  Variable to store curl matrix
2386c4e3f59bSSebastian Grimberg 
2387c4e3f59bSSebastian Grimberg   @return An error code: 0 - success, otherwise - failure
2388c4e3f59bSSebastian Grimberg 
2389c4e3f59bSSebastian Grimberg   @ref Advanced
2390c4e3f59bSSebastian Grimberg **/
2391c4e3f59bSSebastian Grimberg int CeedBasisGetCurl(CeedBasis basis, const CeedScalar **curl) {
2392c4e3f59bSSebastian Grimberg   *curl = basis->curl;
2393c4e3f59bSSebastian Grimberg   return CEED_ERROR_SUCCESS;
2394c4e3f59bSSebastian Grimberg }
2395c4e3f59bSSebastian Grimberg 
2396c4e3f59bSSebastian Grimberg /**
2397ca94c3ddSJeremy L Thompson   @brief Destroy a @ref  CeedBasis
23987a982d89SJeremy L. Thompson 
2399ca94c3ddSJeremy L Thompson   @param[in,out] basis `CeedBasis` to destroy
24007a982d89SJeremy L. Thompson 
24017a982d89SJeremy L. Thompson   @return An error code: 0 - success, otherwise - failure
24027a982d89SJeremy L. Thompson 
24037a982d89SJeremy L. Thompson   @ref User
24047a982d89SJeremy L. Thompson **/
24057a982d89SJeremy L. Thompson int CeedBasisDestroy(CeedBasis *basis) {
2406356036faSJeremy L Thompson   if (!*basis || *basis == CEED_BASIS_NONE || --(*basis)->ref_count > 0) {
2407ad6481ceSJeremy L Thompson     *basis = NULL;
2408ad6481ceSJeremy L Thompson     return CEED_ERROR_SUCCESS;
2409ad6481ceSJeremy L Thompson   }
24102b730f8bSJeremy L Thompson   if ((*basis)->Destroy) CeedCall((*basis)->Destroy(*basis));
24119831d45aSJeremy L Thompson   CeedCall(CeedTensorContractDestroy(&(*basis)->contract));
2412c4e3f59bSSebastian Grimberg   CeedCall(CeedFree(&(*basis)->q_ref_1d));
2413c4e3f59bSSebastian Grimberg   CeedCall(CeedFree(&(*basis)->q_weight_1d));
24142b730f8bSJeremy L Thompson   CeedCall(CeedFree(&(*basis)->interp));
24152b730f8bSJeremy L Thompson   CeedCall(CeedFree(&(*basis)->interp_1d));
24162b730f8bSJeremy L Thompson   CeedCall(CeedFree(&(*basis)->grad));
24172b730f8bSJeremy L Thompson   CeedCall(CeedFree(&(*basis)->grad_1d));
2418c4e3f59bSSebastian Grimberg   CeedCall(CeedFree(&(*basis)->div));
2419c4e3f59bSSebastian Grimberg   CeedCall(CeedFree(&(*basis)->curl));
2420c8c3fa7dSJeremy L Thompson   CeedCall(CeedVectorDestroy(&(*basis)->vec_chebyshev));
2421c8c3fa7dSJeremy L Thompson   CeedCall(CeedBasisDestroy(&(*basis)->basis_chebyshev));
24222b730f8bSJeremy L Thompson   CeedCall(CeedDestroy(&(*basis)->ceed));
24232b730f8bSJeremy L Thompson   CeedCall(CeedFree(basis));
2424e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
24257a982d89SJeremy L. Thompson }
24267a982d89SJeremy L. Thompson 
24277a982d89SJeremy L. Thompson /**
2428b11c1e72Sjeremylt   @brief Construct a Gauss-Legendre quadrature
2429b11c1e72Sjeremylt 
2430ca94c3ddSJeremy L Thompson   @param[in]  Q           Number of quadrature points (integrates polynomials of degree `2*Q-1` exactly)
2431ca94c3ddSJeremy L Thompson   @param[out] q_ref_1d    Array of length `Q` to hold the abscissa on `[-1, 1]`
2432ca94c3ddSJeremy L Thompson   @param[out] q_weight_1d Array of length `Q` to hold the weights
2433b11c1e72Sjeremylt 
2434b11c1e72Sjeremylt   @return An error code: 0 - success, otherwise - failure
2435dfdf5a53Sjeremylt 
2436dfdf5a53Sjeremylt   @ref Utility
2437b11c1e72Sjeremylt **/
24382b730f8bSJeremy L Thompson int CeedGaussQuadrature(CeedInt Q, CeedScalar *q_ref_1d, CeedScalar *q_weight_1d) {
2439d7b241e6Sjeremylt   CeedScalar P0, P1, P2, dP2, xi, wi, PI = 4.0 * atan(1.0);
24401c66c397SJeremy L Thompson 
2441d1d35e2fSjeremylt   // Build q_ref_1d, q_weight_1d
244292ae7e47SJeremy L Thompson   for (CeedInt i = 0; i <= Q / 2; i++) {
2443d7b241e6Sjeremylt     // Guess
2444d7b241e6Sjeremylt     xi = cos(PI * (CeedScalar)(2 * i + 1) / ((CeedScalar)(2 * Q)));
2445d7b241e6Sjeremylt     // Pn(xi)
2446d7b241e6Sjeremylt     P0 = 1.0;
2447d7b241e6Sjeremylt     P1 = xi;
2448d7b241e6Sjeremylt     P2 = 0.0;
244992ae7e47SJeremy L Thompson     for (CeedInt j = 2; j <= Q; j++) {
2450d7b241e6Sjeremylt       P2 = (((CeedScalar)(2 * j - 1)) * xi * P1 - ((CeedScalar)(j - 1)) * P0) / ((CeedScalar)(j));
2451d7b241e6Sjeremylt       P0 = P1;
2452d7b241e6Sjeremylt       P1 = P2;
2453d7b241e6Sjeremylt     }
2454d7b241e6Sjeremylt     // First Newton Step
2455d7b241e6Sjeremylt     dP2 = (xi * P2 - P0) * (CeedScalar)Q / (xi * xi - 1.0);
2456d7b241e6Sjeremylt     xi  = xi - P2 / dP2;
2457d7b241e6Sjeremylt     // Newton to convergence
245892ae7e47SJeremy L Thompson     for (CeedInt k = 0; k < 100 && fabs(P2) > 10 * CEED_EPSILON; k++) {
2459d7b241e6Sjeremylt       P0 = 1.0;
2460d7b241e6Sjeremylt       P1 = xi;
246192ae7e47SJeremy L Thompson       for (CeedInt j = 2; j <= Q; j++) {
2462d7b241e6Sjeremylt         P2 = (((CeedScalar)(2 * j - 1)) * xi * P1 - ((CeedScalar)(j - 1)) * P0) / ((CeedScalar)(j));
2463d7b241e6Sjeremylt         P0 = P1;
2464d7b241e6Sjeremylt         P1 = P2;
2465d7b241e6Sjeremylt       }
2466d7b241e6Sjeremylt       dP2 = (xi * P2 - P0) * (CeedScalar)Q / (xi * xi - 1.0);
2467d7b241e6Sjeremylt       xi  = xi - P2 / dP2;
2468d7b241e6Sjeremylt     }
2469d7b241e6Sjeremylt     // Save xi, wi
2470d7b241e6Sjeremylt     wi                     = 2.0 / ((1.0 - xi * xi) * dP2 * dP2);
2471d1d35e2fSjeremylt     q_weight_1d[i]         = wi;
2472d1d35e2fSjeremylt     q_weight_1d[Q - 1 - i] = wi;
2473d1d35e2fSjeremylt     q_ref_1d[i]            = -xi;
2474d1d35e2fSjeremylt     q_ref_1d[Q - 1 - i]    = xi;
2475d7b241e6Sjeremylt   }
2476e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
2477d7b241e6Sjeremylt }
2478d7b241e6Sjeremylt 
2479b11c1e72Sjeremylt /**
2480b11c1e72Sjeremylt   @brief Construct a Gauss-Legendre-Lobatto quadrature
2481b11c1e72Sjeremylt 
2482ca94c3ddSJeremy L Thompson   @param[in]  Q           Number of quadrature points (integrates polynomials of degree `2*Q-3` exactly)
2483ca94c3ddSJeremy L Thompson   @param[out] q_ref_1d    Array of length `Q` to hold the abscissa on `[-1, 1]`
2484ca94c3ddSJeremy L Thompson   @param[out] q_weight_1d Array of length `Q` to hold the weights
2485b11c1e72Sjeremylt 
2486b11c1e72Sjeremylt   @return An error code: 0 - success, otherwise - failure
2487dfdf5a53Sjeremylt 
2488dfdf5a53Sjeremylt   @ref Utility
2489b11c1e72Sjeremylt **/
24902b730f8bSJeremy L Thompson int CeedLobattoQuadrature(CeedInt Q, CeedScalar *q_ref_1d, CeedScalar *q_weight_1d) {
2491d7b241e6Sjeremylt   CeedScalar P0, P1, P2, dP2, d2P2, xi, wi, PI = 4.0 * atan(1.0);
24921c66c397SJeremy L Thompson 
2493d1d35e2fSjeremylt   // Build q_ref_1d, q_weight_1d
2494d7b241e6Sjeremylt   // Set endpoints
24956574a04fSJeremy L Thompson   CeedCheck(Q > 1, NULL, CEED_ERROR_DIMENSION, "Cannot create Lobatto quadrature with Q=%" CeedInt_FMT " < 2 points", Q);
2496d7b241e6Sjeremylt   wi = 2.0 / ((CeedScalar)(Q * (Q - 1)));
2497d1d35e2fSjeremylt   if (q_weight_1d) {
2498d1d35e2fSjeremylt     q_weight_1d[0]     = wi;
2499d1d35e2fSjeremylt     q_weight_1d[Q - 1] = wi;
2500d7b241e6Sjeremylt   }
2501d1d35e2fSjeremylt   q_ref_1d[0]     = -1.0;
2502d1d35e2fSjeremylt   q_ref_1d[Q - 1] = 1.0;
2503d7b241e6Sjeremylt   // Interior
250492ae7e47SJeremy L Thompson   for (CeedInt i = 1; i <= (Q - 1) / 2; i++) {
2505d7b241e6Sjeremylt     // Guess
2506d7b241e6Sjeremylt     xi = cos(PI * (CeedScalar)(i) / (CeedScalar)(Q - 1));
2507d7b241e6Sjeremylt     // Pn(xi)
2508d7b241e6Sjeremylt     P0 = 1.0;
2509d7b241e6Sjeremylt     P1 = xi;
2510d7b241e6Sjeremylt     P2 = 0.0;
251192ae7e47SJeremy L Thompson     for (CeedInt j = 2; j < Q; j++) {
2512d7b241e6Sjeremylt       P2 = (((CeedScalar)(2 * j - 1)) * xi * P1 - ((CeedScalar)(j - 1)) * P0) / ((CeedScalar)(j));
2513d7b241e6Sjeremylt       P0 = P1;
2514d7b241e6Sjeremylt       P1 = P2;
2515d7b241e6Sjeremylt     }
2516d7b241e6Sjeremylt     // First Newton step
2517d7b241e6Sjeremylt     dP2  = (xi * P2 - P0) * (CeedScalar)Q / (xi * xi - 1.0);
2518d7b241e6Sjeremylt     d2P2 = (2 * xi * dP2 - (CeedScalar)(Q * (Q - 1)) * P2) / (1.0 - xi * xi);
2519d7b241e6Sjeremylt     xi   = xi - dP2 / d2P2;
2520d7b241e6Sjeremylt     // Newton to convergence
252192ae7e47SJeremy L Thompson     for (CeedInt k = 0; k < 100 && fabs(dP2) > 10 * CEED_EPSILON; k++) {
2522d7b241e6Sjeremylt       P0 = 1.0;
2523d7b241e6Sjeremylt       P1 = xi;
252492ae7e47SJeremy L Thompson       for (CeedInt j = 2; j < Q; j++) {
2525d7b241e6Sjeremylt         P2 = (((CeedScalar)(2 * j - 1)) * xi * P1 - ((CeedScalar)(j - 1)) * P0) / ((CeedScalar)(j));
2526d7b241e6Sjeremylt         P0 = P1;
2527d7b241e6Sjeremylt         P1 = P2;
2528d7b241e6Sjeremylt       }
2529d7b241e6Sjeremylt       dP2  = (xi * P2 - P0) * (CeedScalar)Q / (xi * xi - 1.0);
2530d7b241e6Sjeremylt       d2P2 = (2 * xi * dP2 - (CeedScalar)(Q * (Q - 1)) * P2) / (1.0 - xi * xi);
2531d7b241e6Sjeremylt       xi   = xi - dP2 / d2P2;
2532d7b241e6Sjeremylt     }
2533d7b241e6Sjeremylt     // Save xi, wi
2534d7b241e6Sjeremylt     wi = 2.0 / (((CeedScalar)(Q * (Q - 1))) * P2 * P2);
2535d1d35e2fSjeremylt     if (q_weight_1d) {
2536d1d35e2fSjeremylt       q_weight_1d[i]         = wi;
2537d1d35e2fSjeremylt       q_weight_1d[Q - 1 - i] = wi;
2538d7b241e6Sjeremylt     }
2539d1d35e2fSjeremylt     q_ref_1d[i]         = -xi;
2540d1d35e2fSjeremylt     q_ref_1d[Q - 1 - i] = xi;
2541d7b241e6Sjeremylt   }
2542e15f9bd0SJeremy L Thompson   return CEED_ERROR_SUCCESS;
2543d7b241e6Sjeremylt }
2544d7b241e6Sjeremylt 
2545d7b241e6Sjeremylt /// @}
2546