xref: /libCEED/rust/libceed-sys/c-src/backends/magma/ceed-magma.c (revision 4cc6aec30334fede8fa125ca2cd3e6c0352c038d)
1 // Copyright (c) 2017, Lawrence Livermore National Security, LLC. Produced at
2 // the Lawrence Livermore National Laboratory. LLNL-CODE-734707. All Rights
3 // reserved. See files LICENSE and NOTICE for details.
4 //
5 // This file is part of CEED, a collection of benchmarks, miniapps, software
6 // libraries and APIs for efficient high-order finite element and spectral
7 // element discretizations for exascale applications. For more information and
8 // source code availability see http://github.com/ceed.
9 //
10 // The CEED research is supported by the Exascale Computing Project 17-SC-20-SC,
11 // a collaborative effort of two U.S. Department of Energy organizations (Office
12 // of Science and the National Nuclear Security Administration) responsible for
13 // the planning and preparation of a capable exascale ecosystem, including
14 // software, applications, hardware, advanced system engineering and early
15 // testbed platforms, in support of the nation's exascale computing imperative.
16 
17 #include "ceed-magma.h"
18 #include <string.h>
19 
20 typedef struct {
21   CeedScalar *array;
22   CeedScalar *darray;
23   int  own_;
24   int down_;
25 } CeedVector_Magma;
26 
27 typedef struct {
28   CeedInt *indices;
29   CeedInt *dindices;
30   int  own_;
31   int down_;            // cover a case where we own Device memory
32 } CeedElemRestriction_Magma;
33 
34 typedef struct {
35   CeedVector
36   *evecs;   /// E-vectors needed to apply operator (input followed by outputs)
37   CeedScalar **edata;
38   CeedScalar **qdata; /// Inputs followed by outputs
39   CeedScalar
40   **qdata_alloc; /// Allocated quadrature data arrays (to be freed by us)
41   CeedScalar **indata;
42   CeedScalar **outdata;
43   CeedInt    numein;
44   CeedInt    numeout;
45   CeedInt    numqin;
46   CeedInt    numqout;
47 } CeedOperator_Magma;
48 
49 // *****************************************************************************
50 // * Initialize vector vec (after free mem) with values from array based on cmode
51 // *   CEED_COPY_VALUES: memory is allocated in vec->array_allocated, made equal
52 // *                     to array, and data is copied (not store passed pointer)
53 // *   CEED_OWN_POINTER: vec->data->array_allocated and vec->data->array = array
54 // *   CEED_USE_POINTER: vec->data->array = array (can modify; no ownership)
55 // * mtype: CEED_MEM_HOST or CEED_MEM_DEVICE
56 // *****************************************************************************
57 static int CeedVectorSetArray_Magma(CeedVector vec, CeedMemType mtype,
58                                     CeedCopyMode cmode, CeedScalar *array) {
59   CeedVector_Magma *impl = vec->data;
60   int ierr;
61 
62   // If own data, free the "old" data, e.g., as it may be of different size
63   if (impl->own_) {
64     magma_free( impl->darray );
65     magma_free_pinned( impl->array );
66     impl->darray = NULL;
67     impl->array  = NULL;
68     impl->own_ = 0;
69     impl->down_= 0;
70   }
71 
72   if (mtype == CEED_MEM_HOST) {
73     // memory is on the host; own_ = 0
74     switch (cmode) {
75     case CEED_COPY_VALUES:
76       ierr = magma_malloc( (void**)&impl->darray,
77                            vec->length * sizeof(CeedScalar)); CeedChk(ierr);
78       ierr = magma_malloc_pinned( (void**)&impl->array,
79                                   vec->length * sizeof(CeedScalar)); CeedChk(ierr);
80       impl->own_ = 1;
81 
82       if (array != NULL)
83         magma_setvector(vec->length, sizeof(array[0]),
84                         array, 1, impl->darray, 1);
85       break;
86     case CEED_OWN_POINTER:
87       ierr = magma_malloc( (void**)&impl->darray,
88                            vec->length * sizeof(CeedScalar)); CeedChk(ierr);
89       // TODO: possible problem here is if we are passed non-pinned memory;
90       //       (as we own it, lter in destroy, we use free for pinned memory).
91       impl->array = array;
92       impl->own_ = 1;
93 
94       if (array != NULL)
95         magma_setvector(vec->length, sizeof(array[0]),
96                         array, 1, impl->darray, 1);
97       break;
98     case CEED_USE_POINTER:
99       ierr = magma_malloc( (void**)&impl->darray,
100                            vec->length * sizeof(CeedScalar)); CeedChk(ierr);
101       magma_setvector(vec->length, sizeof(array[0]),
102                       array, 1, impl->darray, 1);
103 
104       impl->down_  = 1;
105       impl->array  = array;
106     }
107   } else if (mtype == CEED_MEM_DEVICE) {
108     // memory is on the device; own = 0
109     switch (cmode) {
110     case CEED_COPY_VALUES:
111       ierr = magma_malloc( (void**)&impl->darray,
112                            vec->length * sizeof(CeedScalar)); CeedChk(ierr);
113       ierr = magma_malloc_pinned( (void**)&impl->array,
114                                   vec->length * sizeof(CeedScalar)); CeedChk(ierr);
115       impl->own_ = 1;
116 
117       if (array)
118         magma_copyvector(vec->length, sizeof(array[0]),
119                          array, 1, impl->darray, 1);
120       else
121         // t30 assumes allocation initializes with 0s
122         magma_setvector(vec->length, sizeof(array[0]),
123                         impl->array, 1, impl->darray, 1);
124       break;
125     case CEED_OWN_POINTER:
126       impl->darray = array;
127       ierr = magma_malloc_pinned( (void**)&impl->array,
128                                   vec->length * sizeof(CeedScalar)); CeedChk(ierr);
129       impl->own_ = 1;
130 
131       break;
132     case CEED_USE_POINTER:
133       impl->darray = array;
134       impl->array  = NULL;
135     }
136 
137   } else
138     return CeedError(vec->ceed, 1, "Only MemType = HOST or DEVICE supported");
139 
140   return 0;
141 }
142 
143 // *****************************************************************************
144 // * Give data pointer from vector vec to array (on HOST or DEVICE)
145 // *****************************************************************************
146 static int CeedVectorGetArray_Magma(CeedVector vec, CeedMemType mtype,
147                                     CeedScalar **array) {
148   CeedVector_Magma *impl = vec->data;
149   int ierr;
150 
151   if (mtype == CEED_MEM_HOST) {
152     if (impl->own_) {
153       // data is owned so GPU had the most up-to-date version; copy it
154       // TTT - apparantly it doesn't have most up to date data
155       magma_getvector(vec->length, sizeof(*array[0]),
156                       impl->darray, 1, impl->array, 1);
157       CeedDebug("\033[31m[CeedVectorGetArray_Magma]");
158       //fprintf(stderr,"rrrrrrrrrrrrrrr\n");
159     } else if (impl->array == NULL) {
160       // Vector doesn't own the data and was set on GPU
161       if (impl->darray == NULL) {
162         // call was made just to allocate memory
163         ierr = CeedVectorSetArray(vec, mtype, CEED_COPY_VALUES, NULL);
164         CeedChk(ierr);
165       } else
166         return CeedError(vec->ceed, 1, "Can not access DEVICE vector on HOST");
167     }
168     *array = impl->array;
169   } else if (mtype == CEED_MEM_DEVICE) {
170     if (impl->darray == NULL) {
171       // Vector doesn't own the data and was set on the CPU
172       if (impl->array == NULL) {
173         // call was made just to allocate memory
174         ierr = CeedVectorSetArray(vec, mtype, CEED_COPY_VALUES, NULL);
175         CeedChk(ierr);
176       } else
177         return CeedError(vec->ceed, 1, "Can not access HOST vector on DEVICE");
178     }
179     *array = impl->darray;
180   } else
181     return CeedError(vec->ceed, 1, "Can only provide to HOST or DEVICE memory");
182 
183   return 0;
184 }
185 
186 // *****************************************************************************
187 // * Give data pointer from vector vec to array (on HOST or DEVICE) to read it
188 // *****************************************************************************
189 static int CeedVectorGetArrayRead_Magma(CeedVector vec, CeedMemType mtype,
190                                         const CeedScalar **array) {
191   CeedVector_Magma *impl = vec->data;
192   int ierr;
193 
194   if (mtype == CEED_MEM_HOST) {
195     if (impl->own_) {
196       // data is owned so GPU had the most up-to-date version; copy it
197       magma_getvector(vec->length, sizeof(*array[0]),
198                       impl->darray, 1, impl->array, 1);
199     } else if (impl->array == NULL) {
200       // Vector doesn't own the data and was set on GPU
201       if (impl->darray == NULL) {
202         // call was made just to allocate memory
203         ierr = CeedVectorSetArray(vec, mtype, CEED_COPY_VALUES, NULL);
204         CeedChk(ierr);
205       } else
206         return CeedError(vec->ceed, 1, "Can not access DEVICE vector on HOST");
207     }
208     *array = impl->array;
209   } else if (mtype == CEED_MEM_DEVICE) {
210     if (impl->darray == NULL) {
211       // Vector doesn't own the data and was set on the CPU
212       if (impl->array == NULL) {
213         // call was made just to allocate memory
214         ierr = CeedVectorSetArray(vec, mtype, CEED_COPY_VALUES, NULL);
215         CeedChk(ierr);
216       } else
217         return CeedError(vec->ceed, 1, "Can not access HOST vector on DEVICE");
218     }
219     *array = impl->darray;
220   } else
221     return CeedError(vec->ceed, 1, "Can only provide to HOST or DEVICE memory");
222 
223   return 0;
224 }
225 
226 // *****************************************************************************
227 // * There is no mtype here for array so it is not clear if we restore from HOST
228 // * memory or from DEVICE memory. We assume that it is CPU memory because if
229 // * it was GPU memory we would not call this routine at all.
230 // * Restore vector vec with values from array, where array received its values
231 // * from vec and possibly modified them.
232 // *****************************************************************************
233 static int CeedVectorRestoreArray_Magma(CeedVector vec, CeedScalar **array) {
234   CeedVector_Magma *impl = vec->data;
235 
236   // Check if the array is a CPU pointer
237   if (*array == impl->array) {
238     // Update device, if the device pointer is not NULL
239     if (impl->darray != NULL) {
240       magma_setvector(vec->length, sizeof(*array[0]),
241                       *array, 1, impl->darray, 1);
242     } else {
243       // nothing to do (case of CPU use pointer)
244     }
245 
246   } else if (impl->down_) {
247     // nothing to do if array is on GPU, except if down_=1(case CPU use pointer)
248     magma_getvector(vec->length, sizeof(*array[0]),
249                     impl->darray, 1, impl->array, 1);
250   }
251 
252   *array = NULL;
253   return 0;
254 }
255 
256 // *****************************************************************************
257 // * There is no mtype here for array so it is not clear if we restore from HOST
258 // * memory or from DEVICE memory. We assume that it is CPU memory because if
259 // * it was GPU memory we would not call this routine at all.
260 // * Restore vector vec with values from array, where array received its values
261 // * from vec to only read them; in this case vec may have been modified meanwhile
262 // * and needs to be restored here.
263 // *****************************************************************************
264 static int CeedVectorRestoreArrayRead_Magma(CeedVector vec,
265     const CeedScalar **array) {
266   CeedVector_Magma *impl = vec->data;
267 
268   // Check if the array is a CPU pointer
269   if (*array == impl->array) {
270     // Update device, if the device pointer is not NULL
271     if (impl->darray != NULL) {
272       magma_setvector(vec->length, sizeof(*array[0]),
273                       *array, 1, impl->darray, 1);
274     } else {
275       // nothing to do (case of CPU use pointer)
276     }
277 
278   } else if (impl->down_) {
279     // nothing to do if array is on GPU, except if down_=1(case CPU use pointer)
280     magma_getvector(vec->length, sizeof(*array[0]),
281                     impl->darray, 1, impl->array, 1);
282   }
283 
284   *array = NULL;
285   return 0;
286 }
287 
288 static int CeedVectorDestroy_Magma(CeedVector vec) {
289   CeedVector_Magma *impl = vec->data;
290   int ierr;
291 
292   // Free if we own the data
293   if (impl->own_) {
294     ierr = magma_free_pinned(impl->array); CeedChk(ierr);
295     ierr = magma_free(impl->darray);       CeedChk(ierr);
296   } else if (impl->down_) {
297     ierr = magma_free(impl->darray);       CeedChk(ierr);
298   }
299   ierr = CeedFree(&vec->data); CeedChk(ierr);
300   return 0;
301 }
302 
303 // *****************************************************************************
304 // * Create vector vec of size n
305 // *****************************************************************************
306 static int CeedVectorCreate_Magma(Ceed ceed, CeedInt n, CeedVector vec) {
307   CeedVector_Magma *impl;
308   int ierr;
309 
310   vec->SetArray = CeedVectorSetArray_Magma;
311   vec->GetArray = CeedVectorGetArray_Magma;
312   vec->GetArrayRead = CeedVectorGetArrayRead_Magma;
313   vec->RestoreArray = CeedVectorRestoreArray_Magma;
314   vec->RestoreArrayRead = CeedVectorRestoreArrayRead_Magma;
315   vec->Destroy = CeedVectorDestroy_Magma;
316   ierr = CeedCalloc(1,&impl); CeedChk(ierr);
317   impl->darray = NULL;
318   impl->array  = NULL;
319   impl->own_ = 0;
320   impl->down_= 0;
321   vec->data = impl;
322   return 0;
323 }
324 
325 
326 // *****************************************************************************
327 // * Apply restriction operator r to u: v = r(rmode) u
328 // *****************************************************************************
329 static int CeedElemRestrictionApply_Magma(CeedElemRestriction r,
330     CeedTransposeMode tmode,
331     CeedTransposeMode lmode, CeedVector u,
332     CeedVector v, CeedRequest *request) {
333   CeedElemRestriction_Magma *impl = r->data;
334   int ierr;
335   const CeedScalar *uu;
336   CeedScalar *vv;
337   CeedInt nelem = r->nelem, elemsize = r->elemsize, ndof = r->ndof,
338           ncomp=r->ncomp;
339   CeedInt esize = nelem * elemsize;
340 
341 #ifdef USE_MAGMA_BATCH2
342   CeedInt *dindices = impl->dindices;
343   // Get pointers on the device
344   ierr = CeedVectorGetArrayRead(u, CEED_MEM_DEVICE, &uu); CeedChk(ierr);
345   ierr = CeedVectorGetArray(v, CEED_MEM_DEVICE, &vv); CeedChk(ierr);
346 #else
347   CeedInt *indices = impl->indices;
348   ierr = CeedVectorGetArrayRead(u, CEED_MEM_HOST, &uu); CeedChk(ierr);
349   ierr = CeedVectorGetArray(v, CEED_MEM_HOST, &vv); CeedChk(ierr);
350 #endif
351 
352   if (tmode == CEED_NOTRANSPOSE) {
353     // Perform: v = r * u
354     if (!impl->indices) {
355       for (CeedInt i=0; i<esize*ncomp; i++) vv[i] = uu[i];
356     } else if (ncomp == 1) {
357 #ifdef USE_MAGMA_BATCH2
358 magma_template<<i=0:esize>>
359       (const CeedScalar *uu, CeedScalar *vv, CeedInt *dindices) {
360         vv[i] = uu[dindices[i]];
361       }
362 #else
363       for (CeedInt i=0; i<esize; i++) vv[i] = uu[indices[i]];
364 #endif
365     } else {
366       // vv is (elemsize x ncomp x nelem), column-major
367       if (lmode == CEED_NOTRANSPOSE) { // u is (ndof x ncomp), column-major
368 #ifdef USE_MAGMA_BATCH2
369 magma_template<<e=0:nelem, d=0:ncomp, i=0:elemsize>>
370         (const CeedScalar *uu, CeedScalar *vv, CeedInt *dindices, int ndof) {
371           vv[i + iend*(d+dend*e)] = uu[dindices[i+iend*e]+ndof*d];
372         }
373 #else
374         for (CeedInt e = 0; e < nelem; e++)
375           for (CeedInt d = 0; d < ncomp; d++)
376             for (CeedInt i=0; i < elemsize; i++) {
377               vv[i + elemsize*(d+ncomp*e)] =
378                 uu[indices[i+elemsize*e]+ndof*d];
379             }
380 #endif
381       } else { // u is (ncomp x ndof), column-major
382 #ifdef USE_MAGMA_BATCH2
383 magma_template<<e=0:nelem, d=0:ncomp, i=0:elemsize>>
384         (const CeedScalar *uu, CeedScalar *vv, CeedInt *dindices) {
385           vv[i + iend*(d+dend*e)] = uu[d+dend*dindices[i + iend*e]];
386         }
387 #else
388         for (CeedInt e = 0; e < nelem; e++)
389           for (CeedInt d = 0; d < ncomp; d++)
390             for (CeedInt i=0; i< elemsize; i++) {
391               vv[i + elemsize*(d+ncomp*e)] =
392                 uu[d+ncomp*indices[i+elemsize*e]];
393             }
394 #endif
395       }
396     }
397   } else {
398     // Note: in transpose mode, we perform: v += r^t * u
399     if (!impl->indices) {
400       for (CeedInt i=0; i<esize; i++) vv[i] += uu[i];
401     } else if (ncomp == 1) {
402       // fprintf(stderr,"3 ---------\n");
403 #ifdef USE_MAGMA_BATCH2
404 magma_template<<i=0:esize>>
405       (const CeedScalar *uu, CeedScalar *vv, CeedInt *dindices) {
406         magmablas_datomic_add( &vv[dindices[i]], uu[i]);
407       }
408 #else
409       for (CeedInt i=0; i<esize; i++) vv[indices[i]] += uu[i];
410 #endif
411     } else { // u is (elemsize x ncomp x nelem)
412       fprintf(stderr,"2 ---------\n");
413 
414       if (lmode == CEED_NOTRANSPOSE) { // vv is (ndof x ncomp), column-major
415 #ifdef USE_MAGMA_BATCH2
416 magma_template<<e=0:nelem, d=0:ncomp, i=0:elemsize>>
417         (const CeedScalar *uu, CeedScalar *vv, CeedInt *dindices, CeedInt ndof) {
418           magmablas_datomic_add( &vv[dindices[i+iend*e]+ndof*d],
419                                  uu[i+iend*(d+e*dend)]);
420         }
421 #else
422         for (CeedInt e = 0; e < nelem; e++)
423           for (CeedInt d = 0; d < ncomp; d++)
424             for (CeedInt i=0; i < elemsize; i++) {
425               vv[indices[i + elemsize*e]+ndof*d] +=
426                 uu[i + elemsize*(d+e*ncomp)];
427             }
428 #endif
429       } else { // vv is (ncomp x ndof), column-major
430 #ifdef USE_MAGMA_BATCH2
431 magma_template<<e=0:nelem, d=0:ncomp, i=0:elemsize>>
432         (const CeedScalar *uu, CeedScalar *vv, CeedInt *dindices) {
433           magmablas_datomic_add( &vv[d+dend*dindices[i + iend*e]],
434                                  uu[i+iend*(d+e*dend)]);
435         }
436 #else
437         for (CeedInt e = 0; e < nelem; e++)
438           for (CeedInt d = 0; d < ncomp; d++)
439             for (CeedInt i=0; i < elemsize; i++) {
440               vv[d+ncomp*indices[i + elemsize*e]] +=
441                 uu[i + elemsize*(d+e*ncomp)];
442             }
443 #endif
444       }
445     }
446   }
447 
448   ierr = CeedVectorRestoreArrayRead(u, &uu); CeedChk(ierr);
449   ierr = CeedVectorRestoreArray(v, &vv); CeedChk(ierr);
450 
451   if (request != CEED_REQUEST_IMMEDIATE && request != CEED_REQUEST_ORDERED)
452     *request = NULL;
453   return 0;
454 }
455 
456 static int CeedElemRestrictionDestroy_Magma(CeedElemRestriction r) {
457   CeedElemRestriction_Magma *impl = r->data;
458   int ierr;
459 
460   // Free if we own the data
461   if (impl->own_) {
462     ierr = magma_free_pinned(impl->indices); CeedChk(ierr);
463     ierr = magma_free(impl->dindices);       CeedChk(ierr);
464   } else if (impl->down_) {
465     ierr = magma_free(impl->dindices);       CeedChk(ierr);
466   }
467   ierr = CeedFree(&r->data); CeedChk(ierr);
468   return 0;
469 }
470 
471 static int CeedElemRestrictionCreate_Magma(CeedElemRestriction r,
472     CeedMemType mtype,
473     CeedCopyMode cmode,
474     const CeedInt *indices) {
475   int ierr, size = r->nelem*r->elemsize;
476   CeedElemRestriction_Magma *impl;
477 
478   // Allocate memory for the MAGMA Restricton and initializa pointers to NULL
479   ierr = CeedCalloc(1,&impl); CeedChk(ierr);
480   impl->dindices = NULL;
481   impl->indices  = NULL;
482   impl->own_ = 0;
483   impl->down_= 0;
484 
485   if (mtype == CEED_MEM_HOST) {
486     // memory is on the host; own_ = 0
487     switch (cmode) {
488     case CEED_COPY_VALUES:
489       ierr = magma_malloc( (void**)&impl->dindices,
490                            size * sizeof(CeedInt)); CeedChk(ierr);
491       ierr = magma_malloc_pinned( (void**)&impl->indices,
492                                   size * sizeof(CeedInt)); CeedChk(ierr);
493       impl->own_ = 1;
494 
495       if (indices != NULL) {
496         memcpy(impl->indices, indices, size * sizeof(indices[0]));
497         magma_setvector(size, sizeof(CeedInt),
498                         impl->indices, 1, impl->dindices, 1);
499       }
500       break;
501     case CEED_OWN_POINTER:
502       ierr = magma_malloc( (void**)&impl->dindices,
503                            size * sizeof(CeedInt)); CeedChk(ierr);
504       // TODO: possible problem here is if we are passed non-pinned memory;
505       //       (as we own it, lter in destroy, we use free for pinned memory).
506       impl->indices = (CeedInt *)indices;
507       impl->own_ = 1;
508 
509       if (indices != NULL)
510         magma_setvector(size, sizeof(CeedInt),
511                         indices, 1, impl->dindices, 1);
512       break;
513     case CEED_USE_POINTER:
514       ierr = magma_malloc( (void**)&impl->dindices,
515                            size * sizeof(CeedInt)); CeedChk(ierr);
516       magma_setvector(size, sizeof(CeedInt),
517                       indices, 1, impl->dindices, 1);
518       impl->down_ = 1;
519       impl->indices  = (CeedInt *)indices;
520     }
521   } else if (mtype == CEED_MEM_DEVICE) {
522     // memory is on the device; own = 0
523     switch (cmode) {
524     case CEED_COPY_VALUES:
525       ierr = magma_malloc( (void**)&impl->dindices,
526                            size * sizeof(CeedInt)); CeedChk(ierr);
527       ierr = magma_malloc_pinned( (void**)&impl->indices,
528                                   size * sizeof(CeedInt)); CeedChk(ierr);
529       impl->own_ = 1;
530 
531       if (indices)
532         magma_copyvector(size, sizeof(CeedInt),
533                          indices, 1, impl->dindices, 1);
534       break;
535     case CEED_OWN_POINTER:
536       impl->dindices = (CeedInt *)indices;
537       ierr = magma_malloc_pinned( (void**)&impl->indices,
538                                   size * sizeof(CeedInt)); CeedChk(ierr);
539       impl->own_ = 1;
540 
541       break;
542     case CEED_USE_POINTER:
543       impl->dindices = (CeedInt *)indices;
544       impl->indices  = NULL;
545     }
546 
547   } else
548     return CeedError(r->ceed, 1, "Only MemType = HOST or DEVICE supported");
549 
550   r->data    = impl;
551   r->Apply   = CeedElemRestrictionApply_Magma;
552   r->Destroy = CeedElemRestrictionDestroy_Magma;
553 
554   return 0;
555 }
556 
557 static int CeedElemRestrictionCreate_Magma(CeedElemRestriction r,
558     CeedMemType mtype,
559     CeedCopyMode cmode,
560     const CeedInt *indices) {
561   return CeedError(r->ceed, 1, "Backend does not implement blocked restrictions");
562 }
563 
564 // Contracts on the middle index
565 // NOTRANSPOSE: V_ajc = T_jb U_abc
566 // TRANSPOSE:   V_ajc = T_bj U_abc
567 // If Add != 0, "=" is replaced by "+="
568 static int CeedTensorContract_Magma(Ceed ceed,
569                                     CeedInt A, CeedInt B, CeedInt C, CeedInt J,
570                                     const CeedScalar *t, CeedTransposeMode tmode,
571                                     const CeedInt Add,
572                                     const CeedScalar *u, CeedScalar *v) {
573 #ifdef USE_MAGMA_BATCH
574   magma_dtensor_contract(ceed, A, B, C, J, t, tmode, Add, u, v);
575 #else
576   CeedInt tstride0 = B, tstride1 = 1;
577   if (tmode == CEED_TRANSPOSE) {
578     tstride0 = 1; tstride1 = J;
579   }
580   CeedDebug("\033[31m[CeedTensorContract] A=%d, J=%d, C=%d, B=%d: %d %d %d",
581             A,J,C,B,A*J*B*C, C*J*A, C*B*A);
582   for (CeedInt a=0; a<A; a++) {
583     for (CeedInt j=0; j<J; j++) {
584       if (!Add) {
585         for (CeedInt c=0; c<C; c++)
586           v[(a*J+j)*C+c] = 0;
587       }
588       for (CeedInt b=0; b<B; b++) {
589         for (CeedInt c=0; c<C; c++) {
590           v[(a*J+j)*C+c] += t[j*tstride0 + b*tstride1] * u[(a*B+b)*C+c];
591         }
592       }
593     }
594   }
595 #endif
596   return 0;
597 }
598 
599 static int CeedBasisApply_Magma(CeedBasis basis, CeedInt nelem,
600                                 CeedTransposeMode tmode, CeedEvalMode emode,
601                                 const CeedScalar *u, CeedScalar *v) {
602   int ierr;
603   const CeedInt dim = basis->dim;
604   const CeedInt ncomp = basis->ncomp;
605   const CeedInt nqpt = ncomp*CeedPowInt(basis->Q1d, dim);
606   const CeedInt add = (tmode == CEED_TRANSPOSE);
607 
608   if (nelem != 1)
609     return CeedError(basis->ceed, 1,
610                      "This backend does not support BasisApply for multiple elements");
611 
612   CeedDebug("\033[01m[CeedBasisApply_Magma] vsize=%d",
613             ncomp*CeedPowInt(basis->P1d, dim));
614 
615   if (tmode == CEED_TRANSPOSE) {
616     const CeedInt vsize = ncomp*CeedPowInt(basis->P1d, dim);
617     for (CeedInt i = 0; i < vsize; i++)
618       v[i] = (CeedScalar) 0;
619   }
620   if (emode & CEED_EVAL_INTERP) {
621     CeedInt P = basis->P1d, Q = basis->Q1d;
622     if (tmode == CEED_TRANSPOSE) {
623       P = basis->Q1d; Q = basis->P1d;
624     }
625     CeedInt pre = ncomp*CeedPowInt(P, dim-1), post = 1;
626     CeedScalar tmp[2][ncomp*Q*CeedPowInt(P>Q?P:Q, dim-1)];
627     CeedDebug("\033[01m[CeedBasisApply_Magma] tmpsize = %d",
628               ncomp*Q*CeedPowInt(P>Q?P:Q, dim-1));
629     for (CeedInt d=0; d<dim; d++) {
630       ierr = CeedTensorContract_Magma(basis->ceed, pre, P, post, Q, basis->interp1d,
631                                       tmode, add&&(d==dim-1),
632                                       d==0?u:tmp[d%2], d==dim-1?v:tmp[(d+1)%2]);
633       CeedChk(ierr);
634       pre /= P;
635       post *= Q;
636     }
637     if (tmode == CEED_NOTRANSPOSE) {
638       v += nqpt;
639     } else {
640       u += nqpt;
641     }
642   }
643   if (emode & CEED_EVAL_GRAD) {
644     CeedInt P = basis->P1d, Q = basis->Q1d;
645     // In CEED_NOTRANSPOSE mode:
646     // u is (P^dim x nc), column-major layout (nc = ncomp)
647     // v is (Q^dim x nc x dim), column-major layout (nc = ncomp)
648     // In CEED_TRANSPOSE mode, the sizes of u and v are switched.
649     if (tmode == CEED_TRANSPOSE) {
650       P = basis->Q1d, Q = basis->P1d;
651     }
652     CeedScalar tmp[2][ncomp*Q*CeedPowInt(P>Q?P:Q, dim-1)];
653     CeedDebug("\033[01m[CeedBasisApply_Magma] tmpsize = %d",
654               ncomp*Q*CeedPowInt(P>Q?P:Q, dim-1));
655     for (CeedInt p = 0; p < dim; p++) {
656       CeedInt pre = ncomp*CeedPowInt(P, dim-1), post = 1;
657       for (CeedInt d=0; d<dim; d++) {
658         ierr = CeedTensorContract_Magma(basis->ceed, pre, P, post, Q,
659                                         (p==d)?basis->grad1d:basis->interp1d,
660                                         tmode, add&&(d==dim-1),
661                                         d==0?u:tmp[d%2], d==dim-1?v:tmp[(d+1)%2]);
662         CeedChk(ierr);
663         pre /= P;
664         post *= Q;
665       }
666       if (tmode == CEED_NOTRANSPOSE) {
667         v += nqpt;
668       } else {
669         u += nqpt;
670       }
671     }
672   }
673   if (emode & CEED_EVAL_WEIGHT) {
674     if (tmode == CEED_TRANSPOSE)
675       return CeedError(basis->ceed, 1,
676                        "CEED_EVAL_WEIGHT incompatible with CEED_TRANSPOSE");
677     CeedInt Q = basis->Q1d;
678     for (CeedInt d=0; d<dim; d++) {
679       CeedInt pre = CeedPowInt(Q, dim-d-1), post = CeedPowInt(Q, d);
680       for (CeedInt i=0; i<pre; i++) {
681         for (CeedInt j=0; j<Q; j++) {
682           for (CeedInt k=0; k<post; k++) {
683             v[(i*Q + j)*post + k] = basis->qweight1d[j]
684                                     * (d == 0 ? 1 : v[(i*Q + j)*post + k]);
685           }
686         }
687       }
688     }
689   }
690   return 0;
691 }
692 
693 static int CeedBasisDestroy_Magma(CeedBasis basis) {
694   return 0;
695 }
696 
697 static int CeedBasisCreateTensorH1_Magma(Ceed ceed, CeedInt dim, CeedInt P1d,
698     CeedInt Q1d, const CeedScalar *interp1d,
699     const CeedScalar *grad1d,
700     const CeedScalar *qref1d,
701     const CeedScalar *qweight1d,
702     CeedBasis basis) {
703   basis->Apply = CeedBasisApply_Magma;
704   basis->Destroy = CeedBasisDestroy_Magma;
705   return 0;
706 }
707 
708 static int CeedQFunctionApply_Magma(CeedQFunction qf, CeedInt Q,
709                                     const CeedScalar *const *u,
710                                     CeedScalar *const *v) {
711   int ierr;
712   ierr = qf->function(qf->ctx, Q, u, v); CeedChk(ierr);
713   return 0;
714 }
715 
716 static int CeedQFunctionDestroy_Magma(CeedQFunction qf) {
717   return 0;
718 }
719 
720 static int CeedQFunctionCreate_Magma(CeedQFunction qf) {
721   qf->Apply = CeedQFunctionApply_Magma;
722   qf->Destroy = CeedQFunctionDestroy_Magma;
723   return 0;
724 }
725 
726 static int CeedOperatorDestroy_Magma(CeedOperator op) {
727   CeedOperator_Magma *impl = op->data;
728   int ierr;
729 
730   for (CeedInt i=0; i<impl->numein+impl->numeout; i++) {
731     ierr = CeedVectorDestroy(&impl->evecs[i]); CeedChk(ierr);
732   }
733 
734   ierr = CeedFree(&impl->evecs); CeedChk(ierr);
735   ierr = CeedFree(&impl->edata); CeedChk(ierr);
736 
737   for (CeedInt i=0; i<impl->numqin+impl->numqout; i++) {
738     ierr = CeedFree(&impl->qdata_alloc[i]); CeedChk(ierr);
739   }
740 
741   ierr = CeedFree(&impl->qdata_alloc); CeedChk(ierr);
742   ierr = CeedFree(&impl->qdata); CeedChk(ierr);
743 
744   ierr = CeedFree(&impl->indata); CeedChk(ierr);
745   ierr = CeedFree(&impl->outdata); CeedChk(ierr);
746 
747   ierr = CeedFree(&op->data); CeedChk(ierr);
748   return 0;
749 }
750 
751 
752 /*
753   Setup infields or outfields
754  */
755 static int CeedOperatorSetupFields_Magma(struct CeedQFunctionField qfields[16],
756                                        struct CeedOperatorField ofields[16],
757                                        CeedVector *evecs, CeedScalar **qdata,
758                                        CeedScalar **qdata_alloc, CeedScalar **indata,
759                                        CeedInt starti, CeedInt startq,
760                                        CeedInt numfields, CeedInt Q) {
761   CeedInt dim, ierr, iq=startq, ncomp;
762 
763   // Loop over fields
764   for (CeedInt i=0; i<numfields; i++) {
765     CeedEvalMode emode = qfields[i].emode;
766     if (emode != CEED_EVAL_WEIGHT) {
767       ierr = CeedElemRestrictionCreateVector(ofields[i].Erestrict, NULL, &evecs[i]);
768       CeedChk(ierr);
769     }
770     switch(emode) {
771     case CEED_EVAL_NONE:
772       break; // No action
773     case CEED_EVAL_INTERP:
774       ncomp = qfields[i].ncomp;
775       ierr = CeedMalloc(Q*ncomp, &qdata_alloc[iq]); CeedChk(ierr);
776       qdata[i + starti] = qdata_alloc[iq];
777       iq++;
778       break;
779     case CEED_EVAL_GRAD:
780       ncomp = qfields[i].ncomp;
781       dim = ofields[i].basis->dim;
782       ierr = CeedMalloc(Q*ncomp*dim, &qdata_alloc[iq]); CeedChk(ierr);
783       qdata[i + starti] = qdata_alloc[iq];
784       iq++;
785       break;
786     case CEED_EVAL_WEIGHT: // Only on input fields
787       ierr = CeedMalloc(Q, &qdata_alloc[iq]); CeedChk(ierr);
788       ierr = CeedBasisApply(ofields[iq].basis, 1, CEED_NOTRANSPOSE, CEED_EVAL_WEIGHT,
789                             NULL, qdata_alloc[iq]); CeedChk(ierr);
790       qdata[i] = qdata_alloc[iq];
791       indata[i] = qdata[i];
792       iq++;
793       break;
794     case CEED_EVAL_DIV:
795       break; // Not implimented
796     case CEED_EVAL_CURL:
797       break; // Not implimented
798     }
799   }
800   return 0;
801 }
802 
803 /*
804   CeedOperator needs to connect all the named fields (be they active or passive)
805   to the named inputs and outputs of its CeedQFunction.
806  */
807 static int CeedOperatorSetup_Magma(CeedOperator op) {
808   if (op->setupdone) return 0;
809   CeedOperator_Magma *opmagma = op->data;
810   CeedQFunction qf = op->qf;
811   CeedInt Q = op->numqpoints;
812   int ierr;
813 
814   // Count infield and outfield array sizes and evectors
815   opmagma->numein = qf->numinfutfields;
816   for (CeedInt i=0; i<qf->numinputfields; i++) {
817     CeedEvalMode emode = qf->inputfields[i].emode;
818     opmagma->numqin += !!(emode & CEED_EVAL_INTERP) + !!(emode & CEED_EVAL_GRAD) + !!
819                      (emode & CEED_EVAL_WEIGHT);
820   }
821   qpmagma->numeout = qf->numoutputfields;
822   for (CeedInt i=0; i<qf->numoutputfields; i++) {
823     CeedEvalMode emode = qf->outputfields[i].emode;
824     opmagma->numqout += !!(emode & CEED_EVAL_INTERP) + !!(emode & CEED_EVAL_GRAD);
825   }
826 
827   // Allocate
828   ierr = CeedCalloc(opmagma->numein + opmagma->numeout, &opmagma->evecs); CeedChk(ierr);
829   ierr = CeedCalloc(opmagma->numein + opmagma->numeout, &opmagma->edata);
830   CeedChk(ierr);
831 
832   ierr = CeedCalloc(opmagma->numqin + opmagma->numqout, &opmagma->qdata_alloc);
833   CeedChk(ierr);
834   ierr = CeedCalloc(qf->numinputfields + qf->numoutputfields, &opmagma->qdata);
835   CeedChk(ierr);
836 
837   ierr = CeedCalloc(16, &opmagma->indata); CeedChk(ierr);
838   ierr = CeedCalloc(16, &opmagma->outdata); CeedChk(ierr);
839 
840   // Set up infield and outfield pointer arrays
841   // Infields
842   ierr = CeedOperatorSetupFields_Magma(qf->inputfields, op->inputfields,
843                                      opmagma->evecs, opmagma->qdata, opmagma->qdata_alloc,
844                                      opmagma->indata, 0, 0,
845                                      qf->numinputfields, Q); CeedChk(ierr);
846 
847   // Outfields
848   ierr = CeedOperatorSetupFields_Magma(qf->outputfields, op->outputfields,
849                                      opmagma->evecs, opmagma->qdata, opmagma->qdata_alloc,
850                                      opmagma->indata, qf->numinputfields,
851                                      opmagma->numqin, qf->numoutputfields, Q); CeedChk(ierr);
852 
853   // Output Qvecs
854   for (CeedInt i=0; i<qf->numoutputfields; i++) {
855     CeedEvalMode emode = qf->outputfields[i].emode;
856     if (emode != CEED_EVAL_NONE) {
857       opmagma->outdata[i] =  opmagma->qdata[i + qf->numinputfields];
858     }
859   }
860 
861   op->setupdone = 1;
862 
863   return 0;
864 }
865 
866 static int CeedOperatorApply_Magma(CeedOperator op, CeedVector invec,
867                                  CeedVector outvec, CeedRequest *request) {
868   CeedOperator_Magma *opmagma = op->data;
869   CeedInt Q = op->numqpoints, elemsize;
870   int ierr;
871   CeedQFunction qf = op->qf;
872   CeedTransposeMode lmode = CEED_NOTRANSPOSE;
873   CeedScalar *vec_temp;
874 
875   // Setup
876   ierr = CeedOperatorSetup_Magma(op); CeedChk(ierr);
877 
878   // Input Evecs and Restriction
879   for (CeedInt i=0; i<qf->numinputfields; i++) {
880     CeedEvalMode emode = qf->inputfields[i].emode;
881     if (emode & CEED_EVAL_WEIGHT) { // Skip
882     } else {
883       // Zero evec
884       ierr = CeedVectorGetArray(opmagma->evecs[i], CEED_MEM_HOST, &vec_temp);
885       CeedChk(ierr);
886       for (CeedInt j=0; j<opmagma->evecs[i]->length; j++)
887         vec_temp[j] = 0.;
888       ierr = CeedVectorRestoreArray(opmagma->evecs[i], &vec_temp); CeedChk(ierr);
889       // Active
890       if (op->inputfields[i].vec == CEED_VECTOR_ACTIVE) {
891         // Restrict
892         ierr = CeedElemRestrictionApply(op->inputfields[i].Erestrict, CEED_NOTRANSPOSE,
893                                         lmode, invec, opmagma->evecs[ieiin],
894                                         request); CeedChk(ierr);
895         // Get evec
896         ierr = CeedVectorGetArrayRead(opmagma->evecs[i], CEED_MEM_HOST,
897                                       (const CeedScalar **) &opmagma->edata[i]); CeedChk(ierr);
898       } else {
899         // Passive
900         // Restrict
901         ierr = CeedElemRestrictionApply(op->inputfields[i].Erestrict, CEED_NOTRANSPOSE,
902                                         lmode, op->inputfields[i].vec, opmagma->evecs[i],
903                                         request); CeedChk(ierr);
904         // Get evec
905         ierr = CeedVectorGetArrayRead(opmagma->evecs[i], CEED_MEM_HOST,
906                                       (const CeedScalar **) &opmagma->edata[i]); CeedChk(ierr);
907       }
908     }
909   }
910 
911   // Output Evecs
912   for (CeedInt i=0; i<qf->numoutputfields; i++) {
913     ierr = CeedVectorGetArray(opmagma->evecs[i+opmagma->numein], CEED_MEM_HOST,
914                               &opmagma->edata[i + qf->numinputfields]);
915     CeedChk(ierr);
916   }
917 
918   // Loop through elements
919   for (CeedInt e=0; e<op->numelements; e++) {
920     // Input basis apply if needed
921     for (CeedInt i=0; i<qf->numinputfields; i++) {
922       // Get elemsize, emode, ncomp
923       elemsize = op->inputfields[i].Erestrict->elemsize;
924       CeedEvalMode emode = qf->inputfields[i].emode;
925       CeedInt ncomp = qf->inputfields[i].ncomp;
926       // Basis action
927       switch(emode) {
928       case CEED_EVAL_NONE:
929         opmagma->indata[i] = &opmagma->edata[i][e*Q*ncomp];
930         break;
931       case CEED_EVAL_INTERP:
932         ierr = CeedBasisApply(op->inputfields[i].basis, 1, CEED_NOTRANSPOSE,
933                               CEED_EVAL_INTERP, &opmagma->edata[i][e*elemsize*ncomp], opmagma->qdata[i]);
934         CeedChk(ierr);
935         opmagma->indata[i] = opmagma->qdata[i];
936         break;
937       case CEED_EVAL_GRAD:
938         ierr = CeedBasisApply(op->inputfields[i].basis, 1, CEED_NOTRANSPOSE,
939                               CEED_EVAL_GRAD, &opmagma->edata[i][e*elemsize*ncomp], opmagma->qdata[i]);
940         CeedChk(ierr);
941         opmagma->indata[i] = opmagma->qdata[i];
942         break;
943       case CEED_EVAL_WEIGHT:
944         break;  // No action
945       case CEED_EVAL_DIV:
946         break; // Not implimented
947       case CEED_EVAL_CURL:
948         break; // Not implimented
949       }
950     }
951     // Output pointers
952     for (CeedInt i=0; i<qf->numoutputfields; i++) {
953       CeedEvalMode emode = qf->outputfields[i].emode;
954       if (emode == CEED_EVAL_NONE) {
955         CeedInt ncomp = qf->outputfields[i].ncomp;
956         opmagma->outdata[i] = &opmagma->edata[i + qf->numinputfields][e*Q*ncomp];
957       }
958     }
959     // Q function
960     ierr = CeedQFunctionApply(op->qf, Q, (const CeedScalar * const*) opmagma->indata,
961                               opmagma->outdata); CeedChk(ierr);
962 
963     // Output basis apply if needed
964     for (CeedInt i=0; i<qf->numoutputfields; i++) {
965       // Get elemsize, emode, ncomp
966       elemsize = op->outputfields[i].Erestrict->elemsize;
967       CeedInt ncomp = qf->outputfields[i].ncomp;
968       CeedEvalMode emode = qf->outputfields[i].emode;
969       // Basis action
970       switch(emode) {
971       case CEED_EVAL_NONE:
972         break; // No action
973       case CEED_EVAL_INTERP:
974         ierr = CeedBasisApply(op->outputfields[i].basis, 1, CEED_TRANSPOSE,
975                               CEED_EVAL_INTERP, opmagma->outdata[i],
976                               &opmagma->edata[i + qf->numinputfields][e*elemsize*ncomp]); CeedChk(ierr);
977         break;
978       case CEED_EVAL_GRAD:
979         ierr = CeedBasisApply(op->outputfields[i].basis, 1, CEED_TRANSPOSE, CEED_EVAL_GRAD,
980                               opmagma->outdata[i], &opmagma->edata[i + qf->numinputfields][e*elemsize*ncomp]);
981         CeedChk(ierr);
982         break;
983       case CEED_EVAL_WEIGHT:
984         break; // Should not occur
985       case CEED_EVAL_DIV:
986         break; // Not implimented
987       case CEED_EVAL_CURL:
988         break; // Not implimented
989       }
990     }
991   }
992 
993   // Output restriction
994   for (CeedInt i=0; i<qf->numoutputfields; i++) {
995     // Active
996     if (op->outputfields[i].vec == CEED_VECTOR_ACTIVE) {
997       // Restore evec
998       ierr = CeedVectorRestoreArray(opmagma->evecs[i+opmagma->numein],
999                                     &opmagma->edata[i + qf->numinputfields]); CeedChk(ierr);
1000       // Zero lvec
1001       ierr = CeedVectorGetArray(outvec, CEED_MEM_HOST, &vec_temp); CeedChk(ierr);
1002       for (CeedInt j=0; j<outvec->length; j++)
1003         vec_temp[j] = 0.;
1004       ierr = CeedVectorRestoreArray(outvec, &vec_temp); CeedChk(ierr);
1005       // Restrict
1006       ierr = CeedElemRestrictionApply(op->outputfields[i].Erestrict, CEED_TRANSPOSE,
1007                                       lmode, opmagma->evecs[i+opmagma->numein], outvec, request); CeedChk(ierr);
1008     } else {
1009       // Passive
1010       // Restore evec
1011       ierr = CeedVectorRestoreArray(opmagma->evecs[i+opmagma->numein],
1012                                     &opmagma->edata[i + qf->numinputfields]); CeedChk(ierr);
1013       // Zero lvec
1014       ierr = CeedVectorGetArray(op->outputfields[i].vec, CEED_MEM_HOST, &vec_temp);
1015       CeedChk(ierr);
1016       for (CeedInt j=0; j<op->outputfields[i].vec->length; j++)
1017         vec_temp[j] = 0.;
1018       ierr = CeedVectorRestoreArray(op->outputfields[i].vec, &vec_temp);
1019       CeedChk(ierr);
1020       // Restrict
1021       ierr = CeedElemRestrictionApply(op->outputfields[i].Erestrict, CEED_TRANSPOSE,
1022                                       lmode, opmagma->evecs[i+opmagma->numein], op->outputfields[i].vec,
1023                                       request); CeedChk(ierr);
1024     }
1025   }
1026 
1027   // Restore input arrays
1028   for (CeedInt i=0; i<qf->numinputfields; i++) {
1029     CeedEvalMode emode = qf->inputfields[i].emode;
1030     if (emode & CEED_EVAL_WEIGHT) {
1031     } else {
1032       ierr = CeedVectorRestoreArrayRead(opmagma->evecs[i],
1033                                         (const CeedScalar **) &opmagma->edata[i]); CeedChk(ierr);
1034     }
1035   }
1036 
1037   return 0;
1038 }
1039 
1040 static int CeedOperatorCreate_Magma(CeedOperator op) {
1041   CeedOperator_Magma *impl;
1042   int ierr;
1043 
1044   ierr = CeedCalloc(1, &impl); CeedChk(ierr);
1045   op->data = impl;
1046   op->Destroy  = CeedOperatorDestroy_Magma;
1047   op->Apply    = CeedOperatorApply_Magma;
1048   return 0;
1049 }
1050 
1051 // *****************************************************************************
1052 // * INIT
1053 // *****************************************************************************
1054 static int CeedInit_Magma(const char *resource, Ceed ceed) {
1055   int ierr;
1056   if (strcmp(resource, "/gpu/magma"))
1057     return CeedError(ceed, 1, "MAGMA backend cannot use resource: %s", resource);
1058 
1059   ierr = magma_init();
1060   if (ierr) return CeedError(ceed, 1, "error in magma_init(): %d\n", ierr);
1061   //magma_print_environment();
1062 
1063   ceed->VecCreate = CeedVectorCreate_Magma;
1064   ceed->BasisCreateTensorH1 = CeedBasisCreateTensorH1_Magma;
1065   ceed->ElemRestrictionCreate = CeedElemRestrictionCreate_Magma;
1066   ceed->ElemRestrictionCreateBlocked = CeedElemRestrictionCreateBlocked_Magma;
1067   ceed->QFunctionCreate = CeedQFunctionCreate_Magma;
1068   ceed->OperatorCreate = CeedOperatorCreate_Magma;
1069   return 0;
1070 }
1071 
1072 // *****************************************************************************
1073 // * REGISTER
1074 // *****************************************************************************
1075 __attribute__((constructor))
1076 static void Register(void) {
1077   CeedRegister("/gpu/magma", CeedInit_Magma, 20);
1078 }
1079