xref: /libCEED/rust/libceed-sys/c-src/backends/magma/ceed-magma.c (revision a8de75f0ba69dfecd93c7d0093c041c0285ffd21)
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 CeedBasisCreateH1_Magma(Ceed ceed, CeedElemTopology topo, CeedInt dim,
709                           CeedInt ndof, CeedInt nqpts,
710                           const CeedScalar *interp,
711                           const CeedScalar *grad,
712                           const CeedScalar *qref,
713                           const CeedScalar *qweight,
714                           CeedBasis basis) {
715   return CeedError(basis->ceed, 1, "Backend does not implement non-tensor bases");
716 }
717 
718 static int CeedQFunctionApply_Magma(CeedQFunction qf, CeedInt Q,
719                                     const CeedScalar *const *u,
720                                     CeedScalar *const *v) {
721   int ierr;
722   ierr = qf->function(qf->ctx, Q, u, v); CeedChk(ierr);
723   return 0;
724 }
725 
726 static int CeedQFunctionDestroy_Magma(CeedQFunction qf) {
727   return 0;
728 }
729 
730 static int CeedQFunctionCreate_Magma(CeedQFunction qf) {
731   qf->Apply = CeedQFunctionApply_Magma;
732   qf->Destroy = CeedQFunctionDestroy_Magma;
733   return 0;
734 }
735 
736 static int CeedOperatorDestroy_Magma(CeedOperator op) {
737   CeedOperator_Magma *impl = op->data;
738   int ierr;
739 
740   for (CeedInt i=0; i<impl->numein+impl->numeout; i++) {
741     ierr = CeedVectorDestroy(&impl->evecs[i]); CeedChk(ierr);
742   }
743 
744   ierr = CeedFree(&impl->evecs); CeedChk(ierr);
745   ierr = CeedFree(&impl->edata); CeedChk(ierr);
746 
747   for (CeedInt i=0; i<impl->numqin+impl->numqout; i++) {
748     ierr = CeedFree(&impl->qdata_alloc[i]); CeedChk(ierr);
749   }
750 
751   ierr = CeedFree(&impl->qdata_alloc); CeedChk(ierr);
752   ierr = CeedFree(&impl->qdata); CeedChk(ierr);
753 
754   ierr = CeedFree(&impl->indata); CeedChk(ierr);
755   ierr = CeedFree(&impl->outdata); CeedChk(ierr);
756 
757   ierr = CeedFree(&op->data); CeedChk(ierr);
758   return 0;
759 }
760 
761 
762 /*
763   Setup infields or outfields
764  */
765 static int CeedOperatorSetupFields_Magma(struct CeedQFunctionField qfields[16],
766                                        struct CeedOperatorField ofields[16],
767                                        CeedVector *evecs, CeedScalar **qdata,
768                                        CeedScalar **qdata_alloc, CeedScalar **indata,
769                                        CeedInt starti, CeedInt startq,
770                                        CeedInt numfields, CeedInt Q) {
771   CeedInt dim, ierr, iq=startq, ncomp;
772 
773   // Loop over fields
774   for (CeedInt i=0; i<numfields; i++) {
775     CeedEvalMode emode = qfields[i].emode;
776     if (emode != CEED_EVAL_WEIGHT) {
777       ierr = CeedElemRestrictionCreateVector(ofields[i].Erestrict, NULL, &evecs[i]);
778       CeedChk(ierr);
779     }
780     switch(emode) {
781     case CEED_EVAL_NONE:
782       break; // No action
783     case CEED_EVAL_INTERP:
784       ncomp = qfields[i].ncomp;
785       ierr = CeedMalloc(Q*ncomp, &qdata_alloc[iq]); CeedChk(ierr);
786       qdata[i + starti] = qdata_alloc[iq];
787       iq++;
788       break;
789     case CEED_EVAL_GRAD:
790       ncomp = qfields[i].ncomp;
791       dim = ofields[i].basis->dim;
792       ierr = CeedMalloc(Q*ncomp*dim, &qdata_alloc[iq]); CeedChk(ierr);
793       qdata[i + starti] = qdata_alloc[iq];
794       iq++;
795       break;
796     case CEED_EVAL_WEIGHT: // Only on input fields
797       ierr = CeedMalloc(Q, &qdata_alloc[iq]); CeedChk(ierr);
798       ierr = CeedBasisApply(ofields[iq].basis, 1, CEED_NOTRANSPOSE, CEED_EVAL_WEIGHT,
799                             NULL, qdata_alloc[iq]); CeedChk(ierr);
800       qdata[i] = qdata_alloc[iq];
801       indata[i] = qdata[i];
802       iq++;
803       break;
804     case CEED_EVAL_DIV:
805       break; // Not implimented
806     case CEED_EVAL_CURL:
807       break; // Not implimented
808     }
809   }
810   return 0;
811 }
812 
813 /*
814   CeedOperator needs to connect all the named fields (be they active or passive)
815   to the named inputs and outputs of its CeedQFunction.
816  */
817 static int CeedOperatorSetup_Magma(CeedOperator op) {
818   if (op->setupdone) return 0;
819   CeedOperator_Magma *opmagma = op->data;
820   CeedQFunction qf = op->qf;
821   CeedInt Q = op->numqpoints;
822   int ierr;
823 
824   // Count infield and outfield array sizes and evectors
825   opmagma->numein = qf->numinfutfields;
826   for (CeedInt i=0; i<qf->numinputfields; i++) {
827     CeedEvalMode emode = qf->inputfields[i].emode;
828     opmagma->numqin += !!(emode & CEED_EVAL_INTERP) + !!(emode & CEED_EVAL_GRAD) + !!
829                      (emode & CEED_EVAL_WEIGHT);
830   }
831   qpmagma->numeout = qf->numoutputfields;
832   for (CeedInt i=0; i<qf->numoutputfields; i++) {
833     CeedEvalMode emode = qf->outputfields[i].emode;
834     opmagma->numqout += !!(emode & CEED_EVAL_INTERP) + !!(emode & CEED_EVAL_GRAD);
835   }
836 
837   // Allocate
838   ierr = CeedCalloc(opmagma->numein + opmagma->numeout, &opmagma->evecs); CeedChk(ierr);
839   ierr = CeedCalloc(opmagma->numein + opmagma->numeout, &opmagma->edata);
840   CeedChk(ierr);
841 
842   ierr = CeedCalloc(opmagma->numqin + opmagma->numqout, &opmagma->qdata_alloc);
843   CeedChk(ierr);
844   ierr = CeedCalloc(qf->numinputfields + qf->numoutputfields, &opmagma->qdata);
845   CeedChk(ierr);
846 
847   ierr = CeedCalloc(16, &opmagma->indata); CeedChk(ierr);
848   ierr = CeedCalloc(16, &opmagma->outdata); CeedChk(ierr);
849 
850   // Set up infield and outfield pointer arrays
851   // Infields
852   ierr = CeedOperatorSetupFields_Magma(qf->inputfields, op->inputfields,
853                                      opmagma->evecs, opmagma->qdata, opmagma->qdata_alloc,
854                                      opmagma->indata, 0, 0,
855                                      qf->numinputfields, Q); CeedChk(ierr);
856 
857   // Outfields
858   ierr = CeedOperatorSetupFields_Magma(qf->outputfields, op->outputfields,
859                                      opmagma->evecs, opmagma->qdata, opmagma->qdata_alloc,
860                                      opmagma->indata, qf->numinputfields,
861                                      opmagma->numqin, qf->numoutputfields, Q); CeedChk(ierr);
862 
863   // Output Qvecs
864   for (CeedInt i=0; i<qf->numoutputfields; i++) {
865     CeedEvalMode emode = qf->outputfields[i].emode;
866     if (emode != CEED_EVAL_NONE) {
867       opmagma->outdata[i] =  opmagma->qdata[i + qf->numinputfields];
868     }
869   }
870 
871   op->setupdone = 1;
872 
873   return 0;
874 }
875 
876 static int CeedOperatorApply_Magma(CeedOperator op, CeedVector invec,
877                                  CeedVector outvec, CeedRequest *request) {
878   CeedOperator_Magma *opmagma = op->data;
879   CeedInt Q = op->numqpoints, elemsize;
880   int ierr;
881   CeedQFunction qf = op->qf;
882   CeedTransposeMode lmode = CEED_NOTRANSPOSE;
883   CeedScalar *vec_temp;
884 
885   // Setup
886   ierr = CeedOperatorSetup_Magma(op); CeedChk(ierr);
887 
888   // Input Evecs and Restriction
889   for (CeedInt i=0; i<qf->numinputfields; i++) {
890     CeedEvalMode emode = qf->inputfields[i].emode;
891     if (emode & CEED_EVAL_WEIGHT) { // Skip
892     } else {
893       // Zero evec
894       ierr = CeedVectorGetArray(opmagma->evecs[i], CEED_MEM_HOST, &vec_temp);
895       CeedChk(ierr);
896       for (CeedInt j=0; j<opmagma->evecs[i]->length; j++)
897         vec_temp[j] = 0.;
898       ierr = CeedVectorRestoreArray(opmagma->evecs[i], &vec_temp); CeedChk(ierr);
899       // Active
900       if (op->inputfields[i].vec == CEED_VECTOR_ACTIVE) {
901         // Restrict
902         ierr = CeedElemRestrictionApply(op->inputfields[i].Erestrict, CEED_NOTRANSPOSE,
903                                         lmode, invec, opmagma->evecs[ieiin],
904                                         request); CeedChk(ierr);
905         // Get evec
906         ierr = CeedVectorGetArrayRead(opmagma->evecs[i], CEED_MEM_HOST,
907                                       (const CeedScalar **) &opmagma->edata[i]); CeedChk(ierr);
908       } else {
909         // Passive
910         // Restrict
911         ierr = CeedElemRestrictionApply(op->inputfields[i].Erestrict, CEED_NOTRANSPOSE,
912                                         lmode, op->inputfields[i].vec, opmagma->evecs[i],
913                                         request); CeedChk(ierr);
914         // Get evec
915         ierr = CeedVectorGetArrayRead(opmagma->evecs[i], CEED_MEM_HOST,
916                                       (const CeedScalar **) &opmagma->edata[i]); CeedChk(ierr);
917       }
918     }
919   }
920 
921   // Output Evecs
922   for (CeedInt i=0; i<qf->numoutputfields; i++) {
923     ierr = CeedVectorGetArray(opmagma->evecs[i+opmagma->numein], CEED_MEM_HOST,
924                               &opmagma->edata[i + qf->numinputfields]);
925     CeedChk(ierr);
926   }
927 
928   // Loop through elements
929   for (CeedInt e=0; e<op->numelements; e++) {
930     // Input basis apply if needed
931     for (CeedInt i=0; i<qf->numinputfields; i++) {
932       // Get elemsize, emode, ncomp
933       elemsize = op->inputfields[i].Erestrict->elemsize;
934       CeedEvalMode emode = qf->inputfields[i].emode;
935       CeedInt ncomp = qf->inputfields[i].ncomp;
936       // Basis action
937       switch(emode) {
938       case CEED_EVAL_NONE:
939         opmagma->indata[i] = &opmagma->edata[i][e*Q*ncomp];
940         break;
941       case CEED_EVAL_INTERP:
942         ierr = CeedBasisApply(op->inputfields[i].basis, 1, CEED_NOTRANSPOSE,
943                               CEED_EVAL_INTERP, &opmagma->edata[i][e*elemsize*ncomp], opmagma->qdata[i]);
944         CeedChk(ierr);
945         opmagma->indata[i] = opmagma->qdata[i];
946         break;
947       case CEED_EVAL_GRAD:
948         ierr = CeedBasisApply(op->inputfields[i].basis, 1, CEED_NOTRANSPOSE,
949                               CEED_EVAL_GRAD, &opmagma->edata[i][e*elemsize*ncomp], opmagma->qdata[i]);
950         CeedChk(ierr);
951         opmagma->indata[i] = opmagma->qdata[i];
952         break;
953       case CEED_EVAL_WEIGHT:
954         break;  // No action
955       case CEED_EVAL_DIV:
956         break; // Not implimented
957       case CEED_EVAL_CURL:
958         break; // Not implimented
959       }
960     }
961     // Output pointers
962     for (CeedInt i=0; i<qf->numoutputfields; i++) {
963       CeedEvalMode emode = qf->outputfields[i].emode;
964       if (emode == CEED_EVAL_NONE) {
965         CeedInt ncomp = qf->outputfields[i].ncomp;
966         opmagma->outdata[i] = &opmagma->edata[i + qf->numinputfields][e*Q*ncomp];
967       }
968     }
969     // Q function
970     ierr = CeedQFunctionApply(op->qf, Q, (const CeedScalar * const*) opmagma->indata,
971                               opmagma->outdata); CeedChk(ierr);
972 
973     // Output basis apply if needed
974     for (CeedInt i=0; i<qf->numoutputfields; i++) {
975       // Get elemsize, emode, ncomp
976       elemsize = op->outputfields[i].Erestrict->elemsize;
977       CeedInt ncomp = qf->outputfields[i].ncomp;
978       CeedEvalMode emode = qf->outputfields[i].emode;
979       // Basis action
980       switch(emode) {
981       case CEED_EVAL_NONE:
982         break; // No action
983       case CEED_EVAL_INTERP:
984         ierr = CeedBasisApply(op->outputfields[i].basis, 1, CEED_TRANSPOSE,
985                               CEED_EVAL_INTERP, opmagma->outdata[i],
986                               &opmagma->edata[i + qf->numinputfields][e*elemsize*ncomp]); CeedChk(ierr);
987         break;
988       case CEED_EVAL_GRAD:
989         ierr = CeedBasisApply(op->outputfields[i].basis, 1, CEED_TRANSPOSE, CEED_EVAL_GRAD,
990                               opmagma->outdata[i], &opmagma->edata[i + qf->numinputfields][e*elemsize*ncomp]);
991         CeedChk(ierr);
992         break;
993       case CEED_EVAL_WEIGHT:
994         break; // Should not occur
995       case CEED_EVAL_DIV:
996         break; // Not implimented
997       case CEED_EVAL_CURL:
998         break; // Not implimented
999       }
1000     }
1001   }
1002 
1003   // Output restriction
1004   for (CeedInt i=0; i<qf->numoutputfields; i++) {
1005     // Active
1006     if (op->outputfields[i].vec == CEED_VECTOR_ACTIVE) {
1007       // Restore evec
1008       ierr = CeedVectorRestoreArray(opmagma->evecs[i+opmagma->numein],
1009                                     &opmagma->edata[i + qf->numinputfields]); CeedChk(ierr);
1010       // Zero lvec
1011       ierr = CeedVectorGetArray(outvec, CEED_MEM_HOST, &vec_temp); CeedChk(ierr);
1012       for (CeedInt j=0; j<outvec->length; j++)
1013         vec_temp[j] = 0.;
1014       ierr = CeedVectorRestoreArray(outvec, &vec_temp); CeedChk(ierr);
1015       // Restrict
1016       ierr = CeedElemRestrictionApply(op->outputfields[i].Erestrict, CEED_TRANSPOSE,
1017                                       lmode, opmagma->evecs[i+opmagma->numein], outvec, request); CeedChk(ierr);
1018     } else {
1019       // Passive
1020       // Restore evec
1021       ierr = CeedVectorRestoreArray(opmagma->evecs[i+opmagma->numein],
1022                                     &opmagma->edata[i + qf->numinputfields]); CeedChk(ierr);
1023       // Zero lvec
1024       ierr = CeedVectorGetArray(op->outputfields[i].vec, CEED_MEM_HOST, &vec_temp);
1025       CeedChk(ierr);
1026       for (CeedInt j=0; j<op->outputfields[i].vec->length; j++)
1027         vec_temp[j] = 0.;
1028       ierr = CeedVectorRestoreArray(op->outputfields[i].vec, &vec_temp);
1029       CeedChk(ierr);
1030       // Restrict
1031       ierr = CeedElemRestrictionApply(op->outputfields[i].Erestrict, CEED_TRANSPOSE,
1032                                       lmode, opmagma->evecs[i+opmagma->numein], op->outputfields[i].vec,
1033                                       request); CeedChk(ierr);
1034     }
1035   }
1036 
1037   // Restore input arrays
1038   for (CeedInt i=0; i<qf->numinputfields; i++) {
1039     CeedEvalMode emode = qf->inputfields[i].emode;
1040     if (emode & CEED_EVAL_WEIGHT) {
1041     } else {
1042       ierr = CeedVectorRestoreArrayRead(opmagma->evecs[i],
1043                                         (const CeedScalar **) &opmagma->edata[i]); CeedChk(ierr);
1044     }
1045   }
1046 
1047   return 0;
1048 }
1049 
1050 static int CeedOperatorCreate_Magma(CeedOperator op) {
1051   CeedOperator_Magma *impl;
1052   int ierr;
1053 
1054   ierr = CeedCalloc(1, &impl); CeedChk(ierr);
1055   op->data = impl;
1056   op->Destroy  = CeedOperatorDestroy_Magma;
1057   op->Apply    = CeedOperatorApply_Magma;
1058   return 0;
1059 }
1060 
1061 // *****************************************************************************
1062 // * INIT
1063 // *****************************************************************************
1064 static int CeedInit_Magma(const char *resource, Ceed ceed) {
1065   int ierr;
1066   if (strcmp(resource, "/gpu/magma"))
1067     return CeedError(ceed, 1, "MAGMA backend cannot use resource: %s", resource);
1068 
1069   ierr = magma_init();
1070   if (ierr) return CeedError(ceed, 1, "error in magma_init(): %d\n", ierr);
1071   //magma_print_environment();
1072 
1073   ceed->VecCreate = CeedVectorCreate_Magma;
1074   ceed->BasisCreateTensorH1 = CeedBasisCreateTensorH1_Magma;
1075   ceed->BasisCreateH1 = CeedBasisCreateH1_Magma;
1076   ceed->ElemRestrictionCreate = CeedElemRestrictionCreate_Magma;
1077   ceed->ElemRestrictionCreateBlocked = CeedElemRestrictionCreateBlocked_Magma;
1078   ceed->QFunctionCreate = CeedQFunctionCreate_Magma;
1079   ceed->OperatorCreate = CeedOperatorCreate_Magma;
1080   return 0;
1081 }
1082 
1083 // *****************************************************************************
1084 // * REGISTER
1085 // *****************************************************************************
1086 __attribute__((constructor))
1087 static void Register(void) {
1088   CeedRegister("/gpu/magma", CeedInit_Magma, 20);
1089 }
1090