xref: /libCEED/backends/ref/ceed-ref-basis.c (revision 138d40723aa3d9074a0e9bff3a6f097507ae8e2b)
1 // Copyright (c) 2017-2018, Lawrence Livermore National Security, LLC.
2 // Produced at the Lawrence Livermore National Laboratory. LLNL-CODE-734707.
3 // All Rights reserved. See files LICENSE and NOTICE for details.
4 //
5 // This file is part of CEED, a collection of benchmarks, miniapps, software
6 // libraries and APIs for efficient high-order finite element and spectral
7 // element discretizations for exascale applications. For more information and
8 // source code availability see http://github.com/ceed.
9 //
10 // The CEED research is supported by the Exascale Computing Project 17-SC-20-SC,
11 // a collaborative effort of two U.S. Department of Energy organizations (Office
12 // of Science and the National Nuclear Security Administration) responsible for
13 // the planning and preparation of a capable exascale ecosystem, including
14 // software, applications, hardware, advanced system engineering and early
15 // testbed platforms, in support of the nation's exascale computing imperative.
16 
17 #include "ceed-ref.h"
18 
19 static int CeedBasisApply_Ref(CeedBasis basis, CeedInt nelem,
20                               CeedTransposeMode tmode, CeedEvalMode emode,
21                               CeedVector U, CeedVector V) {
22   int ierr;
23   Ceed ceed;
24   ierr = CeedBasisGetCeed(basis, &ceed); CeedChk(ierr);
25   CeedInt dim, ncomp, nnodes, nqpt;
26   ierr = CeedBasisGetDimension(basis, &dim); CeedChk(ierr);
27   ierr = CeedBasisGetNumComponents(basis, &ncomp); CeedChk(ierr);
28   ierr = CeedBasisGetNumNodes(basis, &nnodes); CeedChk(ierr);
29   ierr = CeedBasisGetNumQuadraturePoints(basis, &nqpt); CeedChk(ierr);
30   CeedTensorContract contract;
31   ierr = CeedBasisGetTensorContract(basis, &contract); CeedChk(ierr);
32   const CeedInt add = (tmode == CEED_TRANSPOSE);
33   const CeedScalar *u;
34   CeedScalar *v;
35   if (U) {
36     ierr = CeedVectorGetArrayRead(U, CEED_MEM_HOST, &u); CeedChk(ierr);
37   } else if (emode != CEED_EVAL_WEIGHT) {
38     // LCOV_EXCL_START
39     return CeedError(ceed, 1,
40                      "An input vector is required for this CeedEvalMode");
41     // LCOV_EXCL_STOP
42   }
43   ierr = CeedVectorGetArray(V, CEED_MEM_HOST, &v); CeedChk(ierr);
44 
45   // Clear v if operating in transpose
46   if (tmode == CEED_TRANSPOSE) {
47     const CeedInt vsize = nelem*ncomp*nnodes;
48     for (CeedInt i = 0; i < vsize; i++)
49       v[i] = (CeedScalar) 0.0;
50   }
51   bool tensorbasis;
52   ierr = CeedBasisGetTensorStatus(basis, &tensorbasis); CeedChk(ierr);
53   // Tensor basis
54   if (tensorbasis) {
55     CeedInt P1d, Q1d;
56     ierr = CeedBasisGetNumNodes1D(basis, &P1d); CeedChk(ierr);
57     ierr = CeedBasisGetNumQuadraturePoints1D(basis, &Q1d); CeedChk(ierr);
58     switch (emode) {
59     // Interpolate to/from quadrature points
60     case CEED_EVAL_INTERP: {
61       CeedBasis_Ref *impl;
62       ierr = CeedBasisGetData(basis, (void *)&impl); CeedChk(ierr);
63       if (impl->collointerp) {
64         memcpy(v, u, nelem*ncomp*nnodes*sizeof(u[0]));
65       } else {
66         CeedInt P = P1d, Q = Q1d;
67         if (tmode == CEED_TRANSPOSE) {
68           P = Q1d; Q = P1d;
69         }
70         CeedInt pre = ncomp*CeedIntPow(P, dim-1), post = nelem;
71         CeedScalar tmp[2][nelem*ncomp*Q*CeedIntPow(P>Q?P:Q, dim-1)];
72         CeedScalar *interp1d;
73         ierr = CeedBasisGetInterp(basis, &interp1d); CeedChk(ierr);
74         for (CeedInt d=0; d<dim; d++) {
75           ierr = CeedTensorContractApply(contract, pre, P, post, Q,
76                                          interp1d, tmode, add&&(d==dim-1),
77                                          d==0?u:tmp[d%2],
78                                          d==dim-1?v:tmp[(d+1)%2]);
79           CeedChk(ierr);
80           pre /= P;
81           post *= Q;
82         }
83       }
84     } break;
85     // Evaluate the gradient to/from quadrature points
86     case CEED_EVAL_GRAD: {
87       // In CEED_NOTRANSPOSE mode:
88       // u has shape [dim, ncomp, P^dim, nelem], row-major layout
89       // v has shape [dim, ncomp, Q^dim, nelem], row-major layout
90       // In CEED_TRANSPOSE mode, the sizes of u and v are switched.
91       CeedInt P = P1d, Q = Q1d;
92       if (tmode == CEED_TRANSPOSE) {
93         P = Q1d, Q = Q1d;
94       }
95       CeedBasis_Ref *impl;
96       ierr = CeedBasisGetData(basis, (void *)&impl); CeedChk(ierr);
97       CeedInt pre = ncomp*CeedIntPow(P, dim-1), post = nelem;
98       CeedScalar *interp1d;
99       ierr = CeedBasisGetInterp(basis, &interp1d); CeedChk(ierr);
100       if (impl->collograd1d) {
101         CeedScalar tmp[2][nelem*ncomp*Q*CeedIntPow(P>Q?P:Q, dim-1)];
102         CeedScalar interp[nelem*ncomp*Q*CeedIntPow(P>Q?P:Q, dim-1)];
103         // Interpolate to quadrature points (NoTranspose)
104         //  or Grad to quadrature points (Transpose)
105         for (CeedInt d=0; d<dim; d++) {
106           ierr = CeedTensorContractApply(contract, pre, P, post, Q,
107                                          (tmode == CEED_NOTRANSPOSE
108                                           ? interp1d
109                                           : impl->collograd1d),
110                                          tmode, add&&(d>0),
111                                          (tmode == CEED_NOTRANSPOSE
112                                           ? (d==0?u:tmp[d%2])
113                                           : u + d*nqpt*ncomp*nelem),
114                                          (tmode == CEED_NOTRANSPOSE
115                                           ? (d==dim-1?interp:tmp[(d+1)%2])
116                                           : interp));
117           CeedChk(ierr);
118           pre /= P;
119           post *= Q;
120         }
121         // Grad to quadrature points (NoTranspose)
122         //  or Interpolate to nodes (Transpose)
123         P = Q1d, Q = Q1d;
124         if (tmode == CEED_TRANSPOSE) {
125           P = Q1d, Q = P1d;
126         }
127         pre = ncomp*CeedIntPow(P, dim-1), post = nelem;
128         for (CeedInt d=0; d<dim; d++) {
129           ierr = CeedTensorContractApply(contract, pre, P, post, Q,
130                                          (tmode == CEED_NOTRANSPOSE
131                                           ? impl->collograd1d
132                                           : interp1d),
133                                          tmode, add&&(d==dim-1),
134                                          (tmode == CEED_NOTRANSPOSE
135                                           ? interp
136                                           : (d==0?interp:tmp[d%2])),
137                                          (tmode == CEED_NOTRANSPOSE
138                                           ? v + d*nqpt*ncomp*nelem
139                                           : (d==dim-1?v:tmp[(d+1)%2])));
140           CeedChk(ierr);
141           pre /= P;
142           post *= Q;
143         }
144       } else if (impl->collointerp) { // Qpts collocated with nodes
145         CeedScalar *grad1d;
146         ierr = CeedBasisGetGrad(basis, &grad1d); CeedChk(ierr);
147 
148         // Dim contractions, identity in other directions
149         for (CeedInt d=0; d<dim; d++) {
150           CeedInt pre = ncomp*CeedIntPow(P, dim-1), post = nelem;
151           ierr = CeedTensorContractApply(contract, pre, P, post, Q,
152                                          grad1d, tmode, add&&(d>0),
153                                          tmode == CEED_NOTRANSPOSE
154                                          ? u : u+d*ncomp*nqpt*nelem,
155                                          tmode == CEED_TRANSPOSE
156                                          ? v : v+d*ncomp*nqpt*nelem);
157           CeedChk(ierr);
158         }
159       } else { // Underintegration, P > Q
160         CeedScalar *grad1d;
161         ierr = CeedBasisGetGrad(basis, &grad1d); CeedChk(ierr);
162 
163         if (tmode == CEED_TRANSPOSE) {
164           P = Q1d, Q = P1d;
165         }
166         CeedScalar tmp[2][nelem*ncomp*Q*CeedIntPow(P>Q?P:Q, dim-1)];
167 
168         // Dim**2 contractions, apply grad when pass == dim
169         for (CeedInt p=0; p<dim; p++) {
170           CeedInt pre = ncomp*CeedIntPow(P, dim-1), post = nelem;
171           for (CeedInt d=0; d<dim; d++) {
172             ierr = CeedTensorContractApply(contract, pre, P, post, Q,
173                                            (p==d)? grad1d : interp1d,
174                                            tmode, add&&(d==dim-1),
175                                            (d == 0
176                                             ? (tmode == CEED_NOTRANSPOSE
177                                                ? u : u+p*ncomp*nqpt*nelem)
178                                             : tmp[d%2]),
179                                            (d == dim-1
180                                             ? (tmode == CEED_TRANSPOSE
181                                                ? v : v+p*ncomp*nqpt*nelem)
182                                             : tmp[(d+1)%2]));
183             CeedChk(ierr);
184             pre /= P;
185             post *= Q;
186           }
187         }
188       }
189     } break;
190     // Retrieve interpolation weights
191     case CEED_EVAL_WEIGHT: {
192       if (tmode == CEED_TRANSPOSE)
193         // LCOV_EXCL_START
194         return CeedError(ceed, 1,
195                          "CEED_EVAL_WEIGHT incompatible with CEED_TRANSPOSE");
196       // LCOV_EXCL_STOP
197       CeedInt Q = Q1d;
198       CeedScalar *qweight1d;
199       ierr = CeedBasisGetQWeights(basis, &qweight1d); CeedChk(ierr);
200       for (CeedInt d=0; d<dim; d++) {
201         CeedInt pre = CeedIntPow(Q, dim-d-1), post = CeedIntPow(Q, d);
202         for (CeedInt i=0; i<pre; i++)
203           for (CeedInt j=0; j<Q; j++)
204             for (CeedInt k=0; k<post; k++) {
205               CeedScalar w = qweight1d[j]
206                              * (d == 0 ? 1 : v[((i*Q + j)*post + k)*nelem]);
207               for (CeedInt e=0; e<nelem; e++)
208                 v[((i*Q + j)*post + k)*nelem + e] = w;
209             }
210       }
211     } break;
212     // LCOV_EXCL_START
213     // Evaluate the divergence to/from the quadrature points
214     case CEED_EVAL_DIV:
215       return CeedError(ceed, 1, "CEED_EVAL_DIV not supported");
216     // Evaluate the curl to/from the quadrature points
217     case CEED_EVAL_CURL:
218       return CeedError(ceed, 1, "CEED_EVAL_CURL not supported");
219     // Take no action, BasisApply should not have been called
220     case CEED_EVAL_NONE:
221       return CeedError(ceed, 1,
222                        "CEED_EVAL_NONE does not make sense in this context");
223     // LCOV_EXCL_STOP
224     }
225   } else {
226     // Non-tensor basis
227     switch (emode) {
228     // Interpolate to/from quadrature points
229     case CEED_EVAL_INTERP: {
230       CeedInt P = nnodes, Q = nqpt;
231       CeedScalar *interp;
232       ierr = CeedBasisGetInterp(basis, &interp); CeedChk(ierr);
233       if (tmode == CEED_TRANSPOSE) {
234         P = nqpt; Q = nnodes;
235       }
236       ierr = CeedTensorContractApply(contract, ncomp, P, nelem, Q,
237                                      interp, tmode, add, u, v);
238       CeedChk(ierr);
239     }
240     break;
241     // Evaluate the gradient to/from quadrature points
242     case CEED_EVAL_GRAD: {
243       CeedInt P = nnodes, Q = nqpt;
244       CeedInt dimstride = nqpt * ncomp * nelem;
245       CeedInt gradstride = nqpt * nnodes;
246       CeedScalar *grad;
247       ierr = CeedBasisGetGrad(basis, &grad); CeedChk(ierr);
248       if (tmode == CEED_TRANSPOSE) {
249         P = nqpt; Q = nnodes;
250         for (CeedInt d = 0; d < dim; d++) {
251           ierr = CeedTensorContractApply(contract, ncomp, P, nelem, Q,
252                                          grad + d * gradstride, tmode, add,
253                                          u + d * dimstride, v); CeedChk(ierr);
254         }
255       } else {
256         for (CeedInt d = 0; d < dim; d++) {
257           ierr = CeedTensorContractApply(contract, ncomp, P, nelem, Q,
258                                          grad + d * gradstride, tmode, add,
259                                          u, v + d * dimstride); CeedChk(ierr);
260         }
261       }
262     }
263     break;
264     // Retrieve interpolation weights
265     case CEED_EVAL_WEIGHT: {
266       if (tmode == CEED_TRANSPOSE)
267         // LCOV_EXCL_START
268         return CeedError(ceed, 1,
269                          "CEED_EVAL_WEIGHT incompatible with CEED_TRANSPOSE");
270       // LCOV_EXCL_STOP
271       CeedScalar *qweight;
272       ierr = CeedBasisGetQWeights(basis, &qweight); CeedChk(ierr);
273       for (CeedInt i=0; i<nqpt; i++)
274         for (CeedInt e=0; e<nelem; e++)
275           v[i*nelem + e] = qweight[i];
276     } break;
277     // LCOV_EXCL_START
278     // Evaluate the divergence to/from the quadrature points
279     case CEED_EVAL_DIV:
280       return CeedError(ceed, 1, "CEED_EVAL_DIV not supported");
281     // Evaluate the curl to/from the quadrature points
282     case CEED_EVAL_CURL:
283       return CeedError(ceed, 1, "CEED_EVAL_CURL not supported");
284     // Take no action, BasisApply should not have been called
285     case CEED_EVAL_NONE:
286       return CeedError(ceed, 1,
287                        "CEED_EVAL_NONE does not make sense in this context");
288     // LCOV_EXCL_STOP
289     }
290   }
291   if (U) {
292     ierr = CeedVectorRestoreArrayRead(U, &u); CeedChk(ierr);
293   }
294   ierr = CeedVectorRestoreArray(V, &v); CeedChk(ierr);
295   return 0;
296 }
297 
298 static int CeedBasisDestroyNonTensor_Ref(CeedBasis basis) {
299   int ierr;
300   CeedTensorContract contract;
301   ierr = CeedBasisGetTensorContract(basis, &contract); CeedChk(ierr);
302   ierr = CeedTensorContractDestroy(&contract); CeedChk(ierr);
303   return 0;
304 }
305 
306 static int CeedBasisDestroyTensor_Ref(CeedBasis basis) {
307   int ierr;
308   CeedTensorContract contract;
309   ierr = CeedBasisGetTensorContract(basis, &contract); CeedChk(ierr);
310   ierr = CeedTensorContractDestroy(&contract); CeedChk(ierr);
311 
312   CeedBasis_Ref *impl;
313   ierr = CeedBasisGetData(basis, (void *)&impl); CeedChk(ierr);
314   ierr = CeedFree(&impl->collograd1d); CeedChk(ierr);
315   ierr = CeedFree(&impl); CeedChk(ierr);
316 
317   return 0;
318 }
319 
320 int CeedBasisCreateTensorH1_Ref(CeedInt dim, CeedInt P1d,
321                                 CeedInt Q1d, const CeedScalar *interp1d,
322                                 const CeedScalar *grad1d,
323                                 const CeedScalar *qref1d,
324                                 const CeedScalar *qweight1d,
325                                 CeedBasis basis) {
326   int ierr;
327   Ceed ceed;
328   ierr = CeedBasisGetCeed(basis, &ceed); CeedChk(ierr);
329   CeedBasis_Ref *impl;
330   ierr = CeedCalloc(1, &impl); CeedChk(ierr);
331   // Check for collocated interp
332   if (Q1d == P1d) {
333     bool collocated = 1;
334     for (CeedInt i=0; i<P1d; i++) {
335       collocated = collocated && (fabs(interp1d[i+P1d*i] - 1.0) < 1e-14);
336       for (CeedInt j=0; j<P1d; j++)
337         if (j != i)
338           collocated = collocated && (fabs(interp1d[j+P1d*i]) < 1e-14);
339     }
340     impl->collointerp = collocated;
341   }
342   // Calculate collocated grad
343   if (Q1d >= P1d && !impl->collointerp) {
344     ierr = CeedMalloc(Q1d*Q1d, &impl->collograd1d); CeedChk(ierr);
345     ierr = CeedBasisGetCollocatedGrad(basis, impl->collograd1d); CeedChk(ierr);
346   }
347   ierr = CeedBasisSetData(basis, (void *)&impl); CeedChk(ierr);
348 
349   Ceed parent;
350   ierr = CeedGetParent(ceed, &parent); CeedChk(ierr);
351   CeedTensorContract contract;
352   ierr = CeedTensorContractCreate(parent, basis, &contract); CeedChk(ierr);
353   ierr = CeedBasisSetTensorContract(basis, &contract); CeedChk(ierr);
354 
355   ierr = CeedSetBackendFunction(ceed, "Basis", basis, "Apply",
356                                 CeedBasisApply_Ref); CeedChk(ierr);
357   ierr = CeedSetBackendFunction(ceed, "Basis", basis, "Destroy",
358                                 CeedBasisDestroyTensor_Ref); CeedChk(ierr);
359   return 0;
360 }
361 
362 
363 
364 int CeedBasisCreateH1_Ref(CeedElemTopology topo, CeedInt dim,
365                           CeedInt nnodes, CeedInt nqpts,
366                           const CeedScalar *interp,
367                           const CeedScalar *grad,
368                           const CeedScalar *qref,
369                           const CeedScalar *qweight,
370                           CeedBasis basis) {
371   int ierr;
372   Ceed ceed;
373   ierr = CeedBasisGetCeed(basis, &ceed); CeedChk(ierr);
374 
375   Ceed parent;
376   ierr = CeedGetParent(ceed, &parent); CeedChk(ierr);
377   CeedTensorContract contract;
378   ierr = CeedTensorContractCreate(parent, basis, &contract); CeedChk(ierr);
379   ierr = CeedBasisSetTensorContract(basis, &contract); CeedChk(ierr);
380 
381   ierr = CeedSetBackendFunction(ceed, "Basis", basis, "Apply",
382                                 CeedBasisApply_Ref); CeedChk(ierr);
383   ierr = CeedSetBackendFunction(ceed, "Basis", basis, "Destroy",
384                                 CeedBasisDestroyNonTensor_Ref); CeedChk(ierr);
385 
386   return 0;
387 }
388