1 // SPDX-License-Identifier: Apache-2.0
2 //
3 // Copyright 2008-2016 Conrad Sanderson (http://conradsanderson.id.au)
4 // Copyright 2008-2016 National ICT Australia (NICTA)
5 //
6 // Licensed under the Apache License, Version 2.0 (the "License");
7 // you may not use this file except in compliance with the License.
8 // You may obtain a copy of the License at
9 // http://www.apache.org/licenses/LICENSE-2.0
10 //
11 // Unless required by applicable law or agreed to in writing, software
12 // distributed under the License is distributed on an "AS IS" BASIS,
13 // WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14 // See the License for the specific language governing permissions and
15 // limitations under the License.
16 // ------------------------------------------------------------------------
17 
18 
19 
20 #if defined(ARMA_USE_SUPERLU)
21 
22 //! \namespace superlu namespace for SuperLU functions
23 namespace superlu
24   {
25 
26   template<typename eT>
27   inline
28   void
gssv(superlu_options_t * options,SuperMatrix * A,int * perm_c,int * perm_r,SuperMatrix * L,SuperMatrix * U,SuperMatrix * B,SuperLUStat_t * stat,int * info)29   gssv(superlu_options_t* options, SuperMatrix* A, int* perm_c, int* perm_r, SuperMatrix* L, SuperMatrix* U, SuperMatrix* B, SuperLUStat_t* stat, int* info)
30     {
31     arma_type_check(( is_supported_blas_type<eT>::value == false ));
32 
33     if(is_float<eT>::value)
34       {
35       arma_wrapper(sgssv)(options, A, perm_c, perm_r, L, U, B, stat, info);
36       }
37     else
38     if(is_double<eT>::value)
39       {
40       arma_wrapper(dgssv)(options, A, perm_c, perm_r, L, U, B, stat, info);
41       }
42     else
43     if(is_cx_float<eT>::value)
44       {
45       arma_wrapper(cgssv)(options, A, perm_c, perm_r, L, U, B, stat, info);
46       }
47     else
48     if(is_cx_double<eT>::value)
49       {
50       arma_wrapper(zgssv)(options, A, perm_c, perm_r, L, U, B, stat, info);
51       }
52     }
53 
54 
55 
56   template<typename eT>
57   inline
58   void
gssvx(superlu_options_t * opts,SuperMatrix * A,int * perm_c,int * perm_r,int * etree,char * equed,typename get_pod_type<eT>::result * R,typename get_pod_type<eT>::result * C,SuperMatrix * L,SuperMatrix * U,void * work,int lwork,SuperMatrix * B,SuperMatrix * X,typename get_pod_type<eT>::result * rpg,typename get_pod_type<eT>::result * rcond,typename get_pod_type<eT>::result * ferr,typename get_pod_type<eT>::result * berr,GlobalLU_t * glu,mem_usage_t * mu,SuperLUStat_t * stat,int * info)59   gssvx(
60         superlu_options_t* opts,
61         SuperMatrix* A,
62         int* perm_c, int* perm_r,
63         int* etree, char* equed,
64         typename get_pod_type<eT>::result* R, typename get_pod_type<eT>::result* C,
65         SuperMatrix* L, SuperMatrix* U,
66         void* work, int lwork,
67         SuperMatrix* B, SuperMatrix* X,
68         typename get_pod_type<eT>::result* rpg, typename get_pod_type<eT>::result* rcond,
69         typename get_pod_type<eT>::result* ferr, typename get_pod_type<eT>::result* berr,
70         GlobalLU_t* glu, mem_usage_t* mu, SuperLUStat_t* stat, int* info
71        )
72     {
73     arma_type_check(( is_supported_blas_type<eT>::value == false ));
74 
75     if(is_float<eT>::value)
76       {
77       typedef float T;
78       arma_wrapper(sgssvx)(opts, A, perm_c, perm_r, etree, equed, (T*)R, (T*)C, L, U, work, lwork, B, X, (T*)rpg, (T*)rcond, (T*)ferr, (T*)berr, glu, mu, stat, info);
79       }
80     else
81     if(is_double<eT>::value)
82       {
83       typedef double T;
84       arma_wrapper(dgssvx)(opts, A, perm_c, perm_r, etree, equed, (T*)R, (T*)C, L, U, work, lwork, B, X, (T*)rpg, (T*)rcond, (T*)ferr, (T*)berr, glu, mu, stat, info);
85       }
86     else
87     if(is_cx_float<eT>::value)
88       {
89       typedef float T;
90       arma_wrapper(cgssvx)(opts, A, perm_c, perm_r, etree, equed, (T*)R, (T*)C, L, U, work, lwork, B, X, (T*)rpg, (T*)rcond, (T*)ferr, (T*)berr, glu, mu, stat, info);
91       }
92     else
93     if(is_cx_double<eT>::value)
94       {
95       typedef double T;
96       arma_wrapper(zgssvx)(opts, A, perm_c, perm_r, etree, equed, (T*)R, (T*)C, L, U, work, lwork, B, X, (T*)rpg, (T*)rcond, (T*)ferr, (T*)berr, glu, mu, stat, info);
97       }
98     }
99 
100 
101 
102   template<typename eT>
103   inline
104   void
gstrf(superlu_options_t * options,SuperMatrix * A,int relax,int panel_size,int * etree,void * work,int lwork,int * perm_c,int * perm_r,SuperMatrix * L,SuperMatrix * U,GlobalLU_t * Glu,SuperLUStat_t * stat,int * info)105   gstrf(superlu_options_t* options,
106         SuperMatrix* A,
107         int relax,
108         int panel_size, int *etree,
109         void  *work,  int  lwork,
110         int* perm_c, int* perm_r,
111         SuperMatrix* L, SuperMatrix* U,
112         GlobalLU_t* Glu, SuperLUStat_t* stat, int* info
113        )
114     {
115     arma_type_check(( is_supported_blas_type<eT>::value == false ));
116 
117     if(is_float<eT>::value)
118       {
119       arma_wrapper(sgstrf)(options, A, relax, panel_size, etree, work, lwork, perm_c, perm_r, L, U, Glu, stat, info);
120       }
121     else
122     if(is_double<eT>::value)
123       {
124       arma_wrapper(dgstrf)(options, A, relax, panel_size, etree, work, lwork, perm_c, perm_r, L, U, Glu, stat, info);
125       }
126     else
127     if(is_cx_float<eT>::value)
128       {
129       arma_wrapper(cgstrf)(options, A, relax, panel_size, etree, work, lwork, perm_c, perm_r, L, U, Glu, stat, info);
130       }
131     else
132     if(is_cx_double<eT>::value)
133       {
134       arma_wrapper(zgstrf)(options, A, relax, panel_size, etree, work, lwork, perm_c, perm_r, L, U, Glu, stat, info);
135       }
136     }
137 
138 
139 
140   template<typename eT>
141   inline
142   void
gstrs(trans_t trans,SuperMatrix * L,SuperMatrix * U,int * perm_c,int * perm_r,SuperMatrix * B,SuperLUStat_t * stat,int * info)143   gstrs(trans_t trans,
144         SuperMatrix* L, SuperMatrix* U,
145         int* perm_c, int* perm_r,
146         SuperMatrix* B, SuperLUStat_t* stat, int* info
147        )
148     {
149     arma_type_check(( is_supported_blas_type<eT>::value == false ));
150 
151     if(is_float<eT>::value)
152       {
153       arma_wrapper(sgstrs)(trans, L, U, perm_c, perm_r, B, stat, info);
154       }
155     else
156     if(is_double<eT>::value)
157       {
158       arma_wrapper(dgstrs)(trans, L, U, perm_c, perm_r, B, stat, info);
159       }
160     else
161     if(is_cx_float<eT>::value)
162       {
163       arma_wrapper(cgstrs)(trans, L, U, perm_c, perm_r, B, stat, info);
164       }
165     else
166     if(is_cx_double<eT>::value)
167       {
168       arma_wrapper(zgstrs)(trans, L, U, perm_c, perm_r, B, stat, info);
169       }
170     }
171 
172 
173 
174   template<typename eT>
175   inline
176   typename get_pod_type<eT>::result
langs(char * norm,superlu::SuperMatrix * A)177   langs(char* norm, superlu::SuperMatrix* A)
178     {
179     arma_type_check(( is_supported_blas_type<eT>::value == false ));
180 
181     typedef typename get_pod_type<eT>::result T;
182 
183     if(is_float<eT>::value)
184       {
185       return arma_wrapper(slangs)(norm, A);
186       }
187     else
188     if(is_double<eT>::value)
189       {
190       return arma_wrapper(dlangs)(norm, A);
191       }
192     else
193     if(is_cx_float<eT>::value)
194       {
195       return arma_wrapper(clangs)(norm, A);
196       }
197     else
198     if(is_cx_double<eT>::value)
199       {
200       return arma_wrapper(zlangs)(norm, A);
201       }
202 
203     return T(0);  // to avoid false warnigns from the compiler
204     }
205 
206 
207 
208   template<typename eT>
209   inline
210   void
gscon(char * norm,superlu::SuperMatrix * L,superlu::SuperMatrix * U,typename get_pod_type<eT>::result anorm,typename get_pod_type<eT>::result * rcond,superlu::SuperLUStat_t * stat,int * info)211   gscon(char* norm, superlu::SuperMatrix* L, superlu::SuperMatrix* U, typename get_pod_type<eT>::result anorm, typename get_pod_type<eT>::result* rcond, superlu::SuperLUStat_t* stat, int* info)
212     {
213     arma_type_check(( is_supported_blas_type<eT>::value == false ));
214 
215     if(is_float<eT>::value)
216       {
217       typedef float T;
218       arma_wrapper(sgscon)(norm, L, U, (T)anorm, (T*)rcond, stat, info);
219       }
220     else
221     if(is_double<eT>::value)
222       {
223       typedef double T;
224       arma_wrapper(dgscon)(norm, L, U, (T)anorm, (T*)rcond, stat, info);
225       }
226     else
227     if(is_cx_float<eT>::value)
228       {
229       typedef float T;
230       arma_wrapper(cgscon)(norm, L, U, (T)anorm, (T*)rcond, stat, info);
231       }
232     else
233     if(is_cx_double<eT>::value)
234       {
235       typedef double T;
236       arma_wrapper(zgscon)(norm, L, U, (T)anorm, (T*)rcond, stat, info);
237       }
238     }
239 
240 
241 
242   inline
243   void
init_stat(SuperLUStat_t * stat)244   init_stat(SuperLUStat_t* stat)
245     {
246     arma_wrapper(StatInit)(stat);
247     }
248 
249 
250   inline
251   void
free_stat(SuperLUStat_t * stat)252   free_stat(SuperLUStat_t* stat)
253     {
254     arma_wrapper(StatFree)(stat);
255     }
256 
257 
258 
259   inline
260   void
set_default_opts(superlu_options_t * opts)261   set_default_opts(superlu_options_t* opts)
262     {
263     arma_wrapper(set_default_options)(opts);
264     }
265 
266 
267   inline
268   void
get_permutation_c(int ispec,SuperMatrix * A,int * perm_c)269   get_permutation_c(int ispec, SuperMatrix* A, int* perm_c)
270     {
271     arma_wrapper(get_perm_c)(ispec, A, perm_c);
272     }
273 
274 
275 
276   inline
277   void
sp_preorder_mat(superlu_options_t * opts,SuperMatrix * A,int * perm_c,int * etree,SuperMatrix * AC)278   sp_preorder_mat(superlu_options_t* opts, SuperMatrix* A, int* perm_c, int* etree, SuperMatrix* AC)
279     {
280     arma_wrapper(sp_preorder)(opts, A, perm_c, etree, AC);
281     }
282 
283 
284 
285   inline
286   int
sp_ispec_environ(int ispec)287   sp_ispec_environ(int ispec)
288     {
289     return arma_wrapper(sp_ienv)(ispec);
290     }
291 
292 
293 
294   inline
295   void
destroy_supernode_mat(SuperMatrix * a)296   destroy_supernode_mat(SuperMatrix* a)
297     {
298     arma_wrapper(Destroy_SuperNode_Matrix)(a);
299     }
300 
301 
302 
303   inline
304   void
destroy_compcol_mat(SuperMatrix * a)305   destroy_compcol_mat(SuperMatrix* a)
306     {
307     arma_wrapper(Destroy_CompCol_Matrix)(a);
308     }
309 
310 
311 
312   inline
313   void
destroy_compcolperm_mat(SuperMatrix * a)314   destroy_compcolperm_mat(SuperMatrix* a)
315     {
316     arma_wrapper(Destroy_CompCol_Permuted)(a);
317     }
318 
319 
320 
321   inline
322   void
destroy_dense_mat(SuperMatrix * a)323   destroy_dense_mat(SuperMatrix* a)
324     {
325     arma_wrapper(Destroy_SuperMatrix_Store)(a);
326     }
327 
328 
329 
330   inline
331   void*
malloc(size_t N)332   malloc(size_t N)
333     {
334     return arma_wrapper(superlu_malloc)(N);
335     }
336 
337 
338 
339   inline
340   void
free(void * mem)341   free(void* mem)
342     {
343     arma_wrapper(superlu_free)(mem);
344     }
345 
346   } // namespace superlu
347 
348 #endif
349