xref: /libCEED/backends/ref/ceed-ref-basis.c (revision a5b2249e6a3796f8a6da38b7b2ab27b54d7081ba)
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     return CeedError(ceed, 1,
39                      "An input vector is required for this CeedEvalMode");
40   }
41   ierr = CeedVectorGetArray(V, CEED_MEM_HOST, &v); CeedChk(ierr);
42 
43   // Clear v if operating in transpose
44   if (tmode == CEED_TRANSPOSE) {
45     const CeedInt vsize = nelem*ncomp*nnodes;
46     for (CeedInt i = 0; i < vsize; i++)
47       v[i] = (CeedScalar) 0.0;
48   }
49   bool tensorbasis;
50   ierr = CeedBasisGetTensorStatus(basis, &tensorbasis); CeedChk(ierr);
51   // Tensor basis
52   if (tensorbasis) {
53     CeedInt P1d, Q1d;
54     ierr = CeedBasisGetNumNodes1D(basis, &P1d); CeedChk(ierr);
55     ierr = CeedBasisGetNumQuadraturePoints1D(basis, &Q1d); CeedChk(ierr);
56     switch (emode) {
57     // Interpolate to/from quadrature points
58     case CEED_EVAL_INTERP: {
59       CeedBasis_Ref *impl;
60       ierr = CeedBasisGetData(basis, (void *)&impl); CeedChk(ierr);
61       if (impl->collointerp) {
62         memcpy(v, u, nelem*ncomp*nnodes*sizeof(u[0]));
63       } else {
64         CeedInt P = P1d, Q = Q1d;
65         if (tmode == CEED_TRANSPOSE) {
66           P = Q1d; Q = P1d;
67         }
68         CeedInt pre = ncomp*CeedIntPow(P, dim-1), post = nelem;
69         CeedScalar tmp[2][nelem*ncomp*Q*CeedIntPow(P>Q?P:Q, dim-1)];
70         CeedScalar *interp1d;
71         ierr = CeedBasisGetInterp(basis, &interp1d); CeedChk(ierr);
72         for (CeedInt d=0; d<dim; d++) {
73           ierr = CeedTensorContractApply(contract, pre, P, post, Q,
74                                          interp1d, tmode, add&&(d==dim-1),
75                                          d==0?u:tmp[d%2],
76                                          d==dim-1?v:tmp[(d+1)%2]);
77           CeedChk(ierr);
78           pre /= P;
79           post *= Q;
80         }
81       }
82     } break;
83     // Evaluate the gradient to/from quadrature points
84     case CEED_EVAL_GRAD: {
85       // In CEED_NOTRANSPOSE mode:
86       // u has shape [dim, ncomp, P^dim, nelem], row-major layout
87       // v has shape [dim, ncomp, Q^dim, nelem], row-major layout
88       // In CEED_TRANSPOSE mode, the sizes of u and v are switched.
89       CeedInt P = P1d, Q = Q1d;
90       if (tmode == CEED_TRANSPOSE) {
91         P = Q1d, Q = Q1d;
92       }
93       CeedBasis_Ref *impl;
94       ierr = CeedBasisGetData(basis, (void *)&impl); CeedChk(ierr);
95       CeedInt pre = ncomp*CeedIntPow(P, dim-1), post = nelem;
96       CeedScalar *interp1d;
97       ierr = CeedBasisGetInterp(basis, &interp1d); CeedChk(ierr);
98       if (impl->collograd1d) {
99         CeedScalar tmp[2][nelem*ncomp*Q*CeedIntPow(P>Q?P:Q, dim-1)];
100         CeedScalar interp[nelem*ncomp*Q*CeedIntPow(P>Q?P:Q, dim-1)];
101         // Interpolate to quadrature points (NoTranspose)
102         //  or Grad to quadrature points (Transpose)
103         for (CeedInt d=0; d<dim; d++) {
104           ierr = CeedTensorContractApply(contract, pre, P, post, Q,
105                                          (tmode == CEED_NOTRANSPOSE
106                                           ? interp1d
107                                           : impl->collograd1d),
108                                          tmode, add&&(d>0),
109                                          (tmode == CEED_NOTRANSPOSE
110                                           ? (d==0?u:tmp[d%2])
111                                           : u + d*nqpt*ncomp*nelem),
112                                          (tmode == CEED_NOTRANSPOSE
113                                           ? (d==dim-1?interp:tmp[(d+1)%2])
114                                           : interp));
115           CeedChk(ierr);
116           pre /= P;
117           post *= Q;
118         }
119         // Grad to quadrature points (NoTranspose)
120         //  or Interpolate to nodes (Transpose)
121         P = Q1d, Q = Q1d;
122         if (tmode == CEED_TRANSPOSE) {
123           P = Q1d, Q = P1d;
124         }
125         pre = ncomp*CeedIntPow(P, dim-1), post = nelem;
126         for (CeedInt d=0; d<dim; d++) {
127           ierr = CeedTensorContractApply(contract, pre, P, post, Q,
128                                          (tmode == CEED_NOTRANSPOSE
129                                           ? impl->collograd1d
130                                           : interp1d),
131                                          tmode, add&&(d==dim-1),
132                                          (tmode == CEED_NOTRANSPOSE
133                                           ? interp
134                                           : (d==0?interp:tmp[d%2])),
135                                          (tmode == CEED_NOTRANSPOSE
136                                           ? v + d*nqpt*ncomp*nelem
137                                           : (d==dim-1?v:tmp[(d+1)%2])));
138           CeedChk(ierr);
139           pre /= P;
140           post *= Q;
141         }
142       } else if (impl->collointerp) { // Qpts collocated with nodes
143         CeedScalar *grad1d;
144         ierr = CeedBasisGetGrad(basis, &grad1d); CeedChk(ierr);
145 
146         // Dim contractions, identity in other directions
147         for (CeedInt d=0; d<dim; d++) {
148           CeedInt pre = ncomp*CeedIntPow(P, dim-1), post = nelem;
149             ierr = CeedTensorContractApply(contract, pre, P, post, Q,
150                                            grad1d,
151                                            tmode, add&&(d>0),
152                                            tmode == CEED_NOTRANSPOSE
153                                              ? u : u+d*ncomp*nqpt*nelem,
154                                            tmode == CEED_TRANSPOSE
155                                              ? v : v+d*ncomp*nqpt*nelem);
156             CeedChk(ierr);
157         }
158       } else { // Underintegration, P > Q
159         CeedScalar *grad1d;
160         ierr = CeedBasisGetGrad(basis, &grad1d); CeedChk(ierr);
161 
162         if (tmode == CEED_TRANSPOSE) {
163           P = Q1d, Q = P1d;
164         }
165         CeedScalar tmp[2][nelem*ncomp*Q*CeedIntPow(P>Q?P:Q, dim-1)];
166 
167         // Dim**2 contractions, apply grad when pass == dim
168         for (CeedInt p=0; p<dim; p++) {
169           CeedInt pre = ncomp*CeedIntPow(P, dim-1), post = nelem;
170           for (CeedInt d=0; d<dim; d++) {
171             ierr = CeedTensorContractApply(contract, pre, P, post, Q,
172                                            (p==d)? grad1d : interp1d,
173                                            tmode, add&&(d==dim-1),
174                                            (d == 0
175                                             ? (tmode == CEED_NOTRANSPOSE
176                                                ? u : u+p*ncomp*nqpt*nelem)
177                                             : tmp[d%2]),
178                                            (d == dim-1
179                                             ? (tmode == CEED_TRANSPOSE
180                                                ? v : v+p*ncomp*nqpt*nelem)
181                                             : tmp[(d+1)%2]));
182             CeedChk(ierr);
183             pre /= P;
184             post *= Q;
185           }
186         }
187       }
188     } break;
189     // Retrieve interpolation weights
190     case CEED_EVAL_WEIGHT: {
191       if (tmode == CEED_TRANSPOSE)
192         return CeedError(ceed, 1,
193                          "CEED_EVAL_WEIGHT incompatible with CEED_TRANSPOSE");
194       CeedInt Q = Q1d;
195       CeedScalar *qweight1d;
196       ierr = CeedBasisGetQWeights(basis, &qweight1d); CeedChk(ierr);
197       for (CeedInt d=0; d<dim; d++) {
198         CeedInt pre = CeedIntPow(Q, dim-d-1), post = CeedIntPow(Q, d);
199         for (CeedInt i=0; i<pre; i++)
200           for (CeedInt j=0; j<Q; j++)
201             for (CeedInt k=0; k<post; k++) {
202               CeedScalar w = qweight1d[j]
203                              * (d == 0 ? 1 : v[((i*Q + j)*post + k)*nelem]);
204               for (CeedInt e=0; e<nelem; e++)
205                 v[((i*Q + j)*post + k)*nelem + e] = w;
206             }
207       }
208     } break;
209     // Evaluate the divergence to/from the quadrature points
210     case CEED_EVAL_DIV:
211       return CeedError(ceed, 1, "CEED_EVAL_DIV not supported");
212     // Evaluate the curl to/from the quadrature points
213     case CEED_EVAL_CURL:
214       return CeedError(ceed, 1, "CEED_EVAL_CURL not supported");
215     // Take no action, BasisApply should not have been called
216     case CEED_EVAL_NONE:
217       return CeedError(ceed, 1,
218                        "CEED_EVAL_NONE does not make sense in this context");
219     }
220   } else {
221     // Non-tensor basis
222     switch (emode) {
223     // Interpolate to/from quadrature points
224     case CEED_EVAL_INTERP: {
225       CeedInt P = nnodes, Q = nqpt;
226       CeedScalar *interp;
227       ierr = CeedBasisGetInterp(basis, &interp); CeedChk(ierr);
228       if (tmode == CEED_TRANSPOSE) {
229         P = nqpt; Q = nnodes;
230       }
231       ierr = CeedTensorContractApply(contract, ncomp, P, nelem, Q,
232                                      interp, tmode, add, u, v);
233       CeedChk(ierr);
234     }
235     break;
236     // Evaluate the gradient to/from quadrature points
237     case CEED_EVAL_GRAD: {
238       CeedInt P = nnodes, Q = dim*nqpt;
239       CeedScalar *grad;
240       ierr = CeedBasisGetGrad(basis, &grad); CeedChk(ierr);
241       if (tmode == CEED_TRANSPOSE) {
242         P = dim*nqpt; Q = nnodes;
243       }
244       ierr = CeedTensorContractApply(contract, ncomp, P, nelem, Q,
245                                      grad, tmode, add, u, v);
246       CeedChk(ierr);
247     }
248     break;
249     // Retrieve interpolation weights
250     case CEED_EVAL_WEIGHT: {
251       if (tmode == CEED_TRANSPOSE)
252         return CeedError(ceed, 1,
253                          "CEED_EVAL_WEIGHT incompatible with CEED_TRANSPOSE");
254       CeedScalar *qweight;
255       ierr = CeedBasisGetQWeights(basis, &qweight); CeedChk(ierr);
256       for (CeedInt i=0; i<nqpt; i++)
257         for (CeedInt e=0; e<nelem; e++)
258           v[i*nelem + e] = qweight[i];
259     } break;
260     // Evaluate the divergence to/from the quadrature points
261     case CEED_EVAL_DIV:
262       return CeedError(ceed, 1, "CEED_EVAL_DIV not supported");
263     // Evaluate the curl to/from the quadrature points
264     case CEED_EVAL_CURL:
265       return CeedError(ceed, 1, "CEED_EVAL_CURL not supported");
266     // Take no action, BasisApply should not have been called
267     case CEED_EVAL_NONE:
268       return CeedError(ceed, 1,
269                        "CEED_EVAL_NONE does not make sense in this context");
270     }
271   }
272   if (U) {
273     ierr = CeedVectorRestoreArrayRead(U, &u); CeedChk(ierr);
274   }
275   ierr = CeedVectorRestoreArray(V, &v); CeedChk(ierr);
276   return 0;
277 }
278 
279 static int CeedBasisDestroyNonTensor_Ref(CeedBasis basis) {
280   int ierr;
281   CeedTensorContract contract;
282   ierr = CeedBasisGetTensorContract(basis, &contract); CeedChk(ierr);
283   ierr = CeedTensorContractDestroy(&contract); CeedChk(ierr);
284   return 0;
285 }
286 
287 static int CeedBasisDestroyTensor_Ref(CeedBasis basis) {
288   int ierr;
289   CeedTensorContract contract;
290   ierr = CeedBasisGetTensorContract(basis, &contract); CeedChk(ierr);
291   ierr = CeedTensorContractDestroy(&contract); CeedChk(ierr);
292 
293   CeedBasis_Ref *impl;
294   ierr = CeedBasisGetData(basis, (void *)&impl); CeedChk(ierr);
295   ierr = CeedFree(&impl->collograd1d); CeedChk(ierr);
296   ierr = CeedFree(&impl); CeedChk(ierr);
297 
298   return 0;
299 }
300 
301 int CeedBasisCreateTensorH1_Ref(CeedInt dim, CeedInt P1d,
302                                 CeedInt Q1d, const CeedScalar *interp1d,
303                                 const CeedScalar *grad1d,
304                                 const CeedScalar *qref1d,
305                                 const CeedScalar *qweight1d,
306                                 CeedBasis basis) {
307   int ierr;
308   Ceed ceed;
309   ierr = CeedBasisGetCeed(basis, &ceed); CeedChk(ierr);
310   CeedBasis_Ref *impl;
311   ierr = CeedCalloc(1, &impl); CeedChk(ierr);
312   // Check for collocated interp
313   if (Q1d == P1d) {
314     bool collocated = 1;
315     for (CeedInt i=0; i<P1d; i++) {
316       collocated = collocated && (fabs(interp1d[i+P1d*i] - 1.0) < 1e-14);
317       for (CeedInt j=0; j<P1d; j++)
318         if (j != i)
319           collocated = collocated && (fabs(interp1d[j+P1d*i]) < 1e-14);
320     }
321     impl->collointerp = collocated;
322   }
323   // Calculate collocated grad
324   if (Q1d >= P1d && !impl->collointerp) {
325     ierr = CeedMalloc(Q1d*Q1d, &impl->collograd1d); CeedChk(ierr);
326     ierr = CeedBasisGetCollocatedGrad(basis, impl->collograd1d); CeedChk(ierr);
327   }
328   ierr = CeedBasisSetData(basis, (void *)&impl); CeedChk(ierr);
329 
330   Ceed parent;
331   ierr = CeedGetParent(ceed, &parent); CeedChk(ierr);
332   CeedTensorContract contract;
333   ierr = CeedTensorContractCreate(parent, basis, &contract); CeedChk(ierr);
334   ierr = CeedBasisSetTensorContract(basis, &contract); CeedChk(ierr);
335 
336   ierr = CeedSetBackendFunction(ceed, "Basis", basis, "Apply",
337                                 CeedBasisApply_Ref); CeedChk(ierr);
338   ierr = CeedSetBackendFunction(ceed, "Basis", basis, "Destroy",
339                                 CeedBasisDestroyTensor_Ref); CeedChk(ierr);
340   return 0;
341 }
342 
343 
344 
345 int CeedBasisCreateH1_Ref(CeedElemTopology topo, CeedInt dim,
346                           CeedInt nnodes, CeedInt nqpts,
347                           const CeedScalar *interp,
348                           const CeedScalar *grad,
349                           const CeedScalar *qref,
350                           const CeedScalar *qweight,
351                           CeedBasis basis) {
352   int ierr;
353   Ceed ceed;
354   ierr = CeedBasisGetCeed(basis, &ceed); CeedChk(ierr);
355 
356   Ceed parent;
357   ierr = CeedGetParent(ceed, &parent); CeedChk(ierr);
358   CeedTensorContract contract;
359   ierr = CeedTensorContractCreate(parent, basis, &contract); CeedChk(ierr);
360   ierr = CeedBasisSetTensorContract(basis, &contract); CeedChk(ierr);
361 
362   ierr = CeedSetBackendFunction(ceed, "Basis", basis, "Apply",
363                                 CeedBasisApply_Ref); CeedChk(ierr);
364   ierr = CeedSetBackendFunction(ceed, "Basis", basis, "Destroy",
365                                 CeedBasisDestroyNonTensor_Ref); CeedChk(ierr);
366 
367   return 0;
368 }
369