1 /*
2
3 Copyright (C) 2014, The University of Texas at Austin
4
5 This file is part of libflame and is available under the 3-Clause
6 BSD license, which can be found in the LICENSE file at the top-level
7 directory, or at http://opensource.org/licenses/BSD-3-Clause
8
9 */
10
11 #include "FLAME.h"
12
13 // --- FLAME to BLAS/LAPACK mappings -------------------------------------------
14
FLA_Param_map_flame_to_netlib_trans(FLA_Trans trans,void * blas_trans)15 void FLA_Param_map_flame_to_netlib_trans( FLA_Trans trans, void* blas_trans )
16 {
17 if ( trans == FLA_NO_TRANSPOSE )
18 {
19 #ifdef FLA_ENABLE_CBLAS_INTERFACES
20 *( ( enum CBLAS_TRANSPOSE* ) blas_trans ) = CblasNoTrans;
21 #else
22 *( ( char* ) blas_trans ) = 'N';
23 #endif
24 }
25 else if ( trans == FLA_TRANSPOSE )
26 {
27 #ifdef FLA_ENABLE_CBLAS_INTERFACES
28 *( ( enum CBLAS_TRANSPOSE* ) blas_trans ) = CblasTrans;
29 #else
30 *( ( char* ) blas_trans ) = 'T';
31 #endif
32 }
33 else if ( trans == FLA_CONJ_TRANSPOSE )
34 {
35 #ifdef FLA_ENABLE_CBLAS_INTERFACES
36 *( ( enum CBLAS_TRANSPOSE* ) blas_trans ) = CblasConjTrans;
37 #else
38 *( ( char* ) blas_trans ) = 'C';
39 #endif
40 }
41 else
42 {
43 FLA_Check_error_code( FLA_INVALID_TRANS );
44 }
45 }
46
FLA_Param_map_flame_to_netlib_uplo(FLA_Uplo uplo,void * blas_uplo)47 void FLA_Param_map_flame_to_netlib_uplo( FLA_Uplo uplo, void* blas_uplo )
48 {
49 if ( uplo == FLA_LOWER_TRIANGULAR )
50 {
51 #ifdef FLA_ENABLE_CBLAS_INTERFACES
52 *( ( enum CBLAS_UPLO* ) blas_uplo ) = CblasLower;
53 #else
54 *( ( char* ) blas_uplo ) = 'L';
55 #endif
56 }
57 else if ( uplo == FLA_UPPER_TRIANGULAR )
58 {
59 #ifdef FLA_ENABLE_CBLAS_INTERFACES
60 *( ( enum CBLAS_UPLO* ) blas_uplo ) = CblasUpper;
61 #else
62 *( ( char* ) blas_uplo ) = 'U';
63 #endif
64 }
65 else
66 {
67 FLA_Check_error_code( FLA_INVALID_UPLO );
68 }
69 }
70
FLA_Param_map_flame_to_netlib_side(FLA_Side side,void * blas_side)71 void FLA_Param_map_flame_to_netlib_side( FLA_Side side, void* blas_side )
72 {
73 if ( side == FLA_LEFT )
74 {
75 #ifdef FLA_ENABLE_CBLAS_INTERFACES
76 *( ( enum CBLAS_SIDE* ) blas_side ) = CblasLeft;
77 #else
78 *( ( char* ) blas_side ) = 'L';
79 #endif
80 }
81 else if ( side == FLA_RIGHT )
82 {
83 #ifdef FLA_ENABLE_CBLAS_INTERFACES
84 *( ( enum CBLAS_SIDE* ) blas_side ) = CblasRight;
85 #else
86 *( ( char* ) blas_side ) = 'R';
87 #endif
88 }
89 else
90 {
91 FLA_Check_error_code( FLA_INVALID_SIDE );
92 }
93 }
94
FLA_Param_map_flame_to_netlib_diag(FLA_Diag diag,void * blas_diag)95 void FLA_Param_map_flame_to_netlib_diag( FLA_Diag diag, void* blas_diag )
96 {
97 if ( diag == FLA_NONUNIT_DIAG )
98 {
99 #ifdef FLA_ENABLE_CBLAS_INTERFACES
100 *( ( enum CBLAS_DIAG* ) blas_diag ) = CblasNonUnit;
101 #else
102 *( ( char* ) blas_diag ) = 'N';
103 #endif
104 }
105 else if ( diag == FLA_UNIT_DIAG )
106 {
107 #ifdef FLA_ENABLE_CBLAS_INTERFACES
108 *( ( enum CBLAS_DIAG* ) blas_diag ) = CblasUnit;
109 #else
110 *( ( char* ) blas_diag ) = 'U';
111 #endif
112 }
113 else
114 {
115 FLA_Check_error_code( FLA_INVALID_DIAG );
116 }
117 }
118
FLA_Param_map_flame_to_netlib_direct(FLA_Direct direct,void * lapack_direct)119 void FLA_Param_map_flame_to_netlib_direct( FLA_Direct direct, void* lapack_direct )
120 {
121 if ( direct == FLA_FORWARD )
122 {
123 *( ( char* ) lapack_direct ) = 'F';
124 }
125 else if ( direct == FLA_BACKWARD )
126 {
127 *( ( char* ) lapack_direct ) = 'B';
128 }
129 else
130 {
131 FLA_Check_error_code( FLA_INVALID_DIRECT );
132 }
133 }
134
FLA_Param_map_flame_to_netlib_storev(FLA_Store storev,void * lapack_storev)135 void FLA_Param_map_flame_to_netlib_storev( FLA_Store storev, void* lapack_storev )
136 {
137 if ( storev == FLA_COLUMNWISE )
138 {
139 *( ( char* ) lapack_storev ) = 'C';
140 }
141 else if ( storev == FLA_ROWWISE )
142 {
143 *( ( char* ) lapack_storev ) = 'R';
144 }
145 else
146 {
147 FLA_Check_error_code( FLA_INVALID_STOREV );
148 }
149 }
150
FLA_Param_map_flame_to_netlib_evd_type(FLA_Evd_type evd_type,void * lapack_evd_type)151 void FLA_Param_map_flame_to_netlib_evd_type( FLA_Evd_type evd_type, void* lapack_evd_type )
152 {
153 if ( evd_type == FLA_EVD_WITHOUT_VECTORS )
154 {
155 *( ( char* ) lapack_evd_type ) = 'N';
156 }
157 else if ( evd_type == FLA_EVD_WITH_VECTORS )
158 {
159 *( ( char* ) lapack_evd_type ) = 'V';
160 }
161 else if ( evd_type == FLA_EVD_OF_TRIDIAG_WITH_VECTORS )
162 {
163 *( ( char* ) lapack_evd_type ) = 'I';
164 }
165 else
166 {
167 FLA_Check_error_code( FLA_INVALID_EVD_TYPE );
168 }
169 }
170
FLA_Param_map_flame_to_netlib_svd_type(FLA_Svd_type svd_type,void * lapack_svd_type)171 void FLA_Param_map_flame_to_netlib_svd_type( FLA_Svd_type svd_type, void* lapack_svd_type )
172 {
173 if ( svd_type == FLA_SVD_VECTORS_ALL )
174 {
175 *( ( char* ) lapack_svd_type ) = 'A';
176 }
177 else if ( svd_type == FLA_SVD_VECTORS_MIN_COPY )
178 {
179 *( ( char* ) lapack_svd_type ) = 'S';
180 }
181 else if ( svd_type == FLA_SVD_VECTORS_MIN_OVERWRITE )
182 {
183 *( ( char* ) lapack_svd_type ) = 'O';
184 }
185 else if ( svd_type == FLA_SVD_VECTORS_NONE )
186 {
187 *( ( char* ) lapack_svd_type ) = 'N';
188 }
189 else
190 {
191 FLA_Check_error_code( FLA_INVALID_SVD_TYPE );
192 }
193 }
194
FLA_Param_map_flame_to_netlib_machval(FLA_Machval machval,void * blas_machval)195 void FLA_Param_map_flame_to_netlib_machval( FLA_Machval machval, void* blas_machval )
196 {
197 if ( machval == FLA_MACH_EPS )
198 {
199 *( ( char* ) blas_machval ) = 'E';
200 }
201 else if ( machval == FLA_MACH_SFMIN )
202 {
203 *( ( char* ) blas_machval ) = 'S';
204 }
205 else if ( machval == FLA_MACH_BASE )
206 {
207 *( ( char* ) blas_machval ) = 'B';
208 }
209 else if ( machval == FLA_MACH_PREC )
210 {
211 *( ( char* ) blas_machval ) = 'P';
212 }
213 else if ( machval == FLA_MACH_NDIGMANT )
214 {
215 *( ( char* ) blas_machval ) = 'N';
216 }
217 else if ( machval == FLA_MACH_RND )
218 {
219 *( ( char* ) blas_machval ) = 'R';
220 }
221 else if ( machval == FLA_MACH_EMIN )
222 {
223 *( ( char* ) blas_machval ) = 'M';
224 }
225 else if ( machval == FLA_MACH_RMIN )
226 {
227 *( ( char* ) blas_machval ) = 'U';
228 }
229 else if ( machval == FLA_MACH_EMAX )
230 {
231 *( ( char* ) blas_machval ) = 'L';
232 }
233 else if ( machval == FLA_MACH_RMAX )
234 {
235 *( ( char* ) blas_machval ) = 'O';
236 }
237 else
238 {
239 FLA_Check_error_code( FLA_INVALID_MACHVAL );
240 }
241 }
242
243 // --- FLAME to BLIS mappings --------------------------------------------------
244
FLA_Param_map_flame_to_blis_trans(FLA_Trans trans,trans1_t * blis_trans)245 void FLA_Param_map_flame_to_blis_trans( FLA_Trans trans, trans1_t* blis_trans )
246 {
247 if ( trans == FLA_NO_TRANSPOSE )
248 {
249 *blis_trans = BLIS1_NO_TRANSPOSE;
250 }
251 else if ( trans == FLA_TRANSPOSE )
252 {
253 *blis_trans = BLIS1_TRANSPOSE;
254 }
255 else if ( trans == FLA_CONJ_NO_TRANSPOSE )
256 {
257 *blis_trans = BLIS1_CONJ_NO_TRANSPOSE;
258 }
259 else if ( trans == FLA_CONJ_TRANSPOSE )
260 {
261 *blis_trans = BLIS1_CONJ_TRANSPOSE;
262 }
263 else
264 {
265 FLA_Check_error_code( FLA_INVALID_TRANS );
266 }
267 }
268
FLA_Param_map_flame_to_blis_conj(FLA_Conj conj,conj1_t * blis_conj)269 void FLA_Param_map_flame_to_blis_conj( FLA_Conj conj, conj1_t* blis_conj )
270 {
271 if ( conj == FLA_NO_CONJUGATE )
272 {
273 *blis_conj = BLIS1_NO_CONJUGATE;
274 }
275 else if ( conj == FLA_CONJUGATE )
276 {
277 *blis_conj = BLIS1_CONJUGATE;
278 }
279 else
280 {
281 FLA_Check_error_code( FLA_INVALID_CONJ );
282 }
283 }
284
FLA_Param_map_flame_to_blis_uplo(FLA_Uplo uplo,uplo1_t * blis_uplo)285 void FLA_Param_map_flame_to_blis_uplo( FLA_Uplo uplo, uplo1_t* blis_uplo )
286 {
287 if ( uplo == FLA_LOWER_TRIANGULAR )
288 {
289 *blis_uplo = BLIS1_LOWER_TRIANGULAR;
290 }
291 else if ( uplo == FLA_UPPER_TRIANGULAR )
292 {
293 *blis_uplo = BLIS1_UPPER_TRIANGULAR;
294 }
295 else
296 {
297 FLA_Check_error_code( FLA_INVALID_UPLO );
298 }
299 }
300
FLA_Param_map_flame_to_blis_side(FLA_Side side,side1_t * blis_side)301 void FLA_Param_map_flame_to_blis_side( FLA_Side side, side1_t* blis_side )
302 {
303 if ( side == FLA_LEFT )
304 {
305 *blis_side = BLIS1_LEFT;
306 }
307 else if ( side == FLA_RIGHT )
308 {
309 *blis_side = BLIS1_RIGHT;
310 }
311 else
312 {
313 FLA_Check_error_code( FLA_INVALID_SIDE );
314 }
315 }
316
FLA_Param_map_flame_to_blis_diag(FLA_Diag diag,diag1_t * blis_diag)317 void FLA_Param_map_flame_to_blis_diag( FLA_Diag diag, diag1_t* blis_diag )
318 {
319 if ( diag == FLA_NONUNIT_DIAG )
320 {
321 *blis_diag = BLIS1_NONUNIT_DIAG;
322 }
323 else if ( diag == FLA_UNIT_DIAG )
324 {
325 *blis_diag = BLIS1_UNIT_DIAG;
326 }
327 else
328 {
329 FLA_Check_error_code( FLA_INVALID_DIAG );
330 }
331 }
332
333 // --- BLAS/LAPACK to FLAME mappings -------------------------------------------
334
FLA_Param_map_netlib_to_flame_trans(char * trans,FLA_Trans * flame_trans)335 void FLA_Param_map_netlib_to_flame_trans( char* trans, FLA_Trans* flame_trans )
336 {
337 if ( *trans == 'n' || *trans == 'N' )
338 *flame_trans = FLA_NO_TRANSPOSE;
339 else if ( *trans == 't' || *trans == 'T' )
340 *flame_trans = FLA_TRANSPOSE;
341 else if ( *trans == 'c' || *trans == 'C' )
342 *flame_trans = FLA_CONJ_TRANSPOSE;
343 else
344 FLA_Check_error_code( FLA_INVALID_TRANS );
345 }
346
FLA_Param_map_netlib_to_flame_uplo(char * uplo,FLA_Uplo * flame_uplo)347 void FLA_Param_map_netlib_to_flame_uplo( char* uplo, FLA_Uplo* flame_uplo )
348 {
349 if ( *uplo == 'l' || *uplo == 'L' )
350 *flame_uplo = FLA_LOWER_TRIANGULAR;
351 else if ( *uplo == 'u' || *uplo == 'U' )
352 *flame_uplo = FLA_UPPER_TRIANGULAR;
353 else
354 FLA_Check_error_code( FLA_INVALID_UPLO );
355 }
356
FLA_Param_map_netlib_to_flame_side(char * side,FLA_Side * flame_side)357 void FLA_Param_map_netlib_to_flame_side( char* side, FLA_Side* flame_side )
358 {
359 if ( *side == 'l' || *side == 'L' )
360 *flame_side = FLA_LEFT;
361 else if ( *side == 'r' || *side == 'R' )
362 *flame_side = FLA_RIGHT;
363 else
364 FLA_Check_error_code( FLA_INVALID_SIDE );
365 }
366
FLA_Param_map_netlib_to_flame_diag(char * diag,FLA_Diag * flame_diag)367 void FLA_Param_map_netlib_to_flame_diag( char* diag, FLA_Diag* flame_diag )
368 {
369 if ( *diag == 'n' || *diag == 'N' )
370 *flame_diag = FLA_NONUNIT_DIAG;
371 else if ( *diag == 'u' || *diag == 'U' )
372 *flame_diag = FLA_UNIT_DIAG;
373 else
374 FLA_Check_error_code( FLA_INVALID_DIAG );
375 }
376
FLA_Param_map_netlib_to_flame_inv(int * itype,FLA_Inv * flame_inv)377 void FLA_Param_map_netlib_to_flame_inv( int* itype, FLA_Inv* flame_inv )
378 {
379 if ( *itype == 1 )
380 *flame_inv = FLA_INVERSE;
381 else if ( *itype == 2 || *itype == 3 )
382 *flame_inv = FLA_NO_INVERSE;
383 else
384 FLA_Check_error_code( FLA_INVALID_INVERSE );
385 }
386
FLA_Param_map_netlib_to_flame_svd_type(char * svd,FLA_Svd_type * flame_svd)387 void FLA_Param_map_netlib_to_flame_svd_type( char* svd, FLA_Svd_type* flame_svd )
388 {
389 if ( *svd == 'A' || *svd == 'a' )
390 *flame_svd = FLA_SVD_VECTORS_ALL;
391 else if ( *svd == 'S' || *svd == 's' )
392 *flame_svd = FLA_SVD_VECTORS_MIN_COPY;
393 else if ( *svd == 'O' || *svd == 'o' )
394 *flame_svd = FLA_SVD_VECTORS_MIN_OVERWRITE;
395 else if ( *svd == 'N' || *svd == 'n' )
396 *flame_svd = FLA_SVD_VECTORS_NONE;
397 else
398 FLA_Check_error_code( FLA_INVALID_SVD_TYPE );
399 }
400
401
402 // --- BLIS to FLAME mappings --------------------------------------------------
403
FLA_Param_map_blis_to_flame_trans(trans1_t trans,FLA_Trans * flame_trans)404 void FLA_Param_map_blis_to_flame_trans( trans1_t trans, FLA_Trans* flame_trans )
405 {
406 if ( bl1_is_notrans( trans ) )
407 *flame_trans = FLA_NO_TRANSPOSE;
408 else if ( bl1_is_trans( trans ) )
409 *flame_trans = FLA_TRANSPOSE;
410 else if ( bl1_is_conjnotrans( trans ) )
411 *flame_trans = FLA_CONJ_NO_TRANSPOSE;
412 else if ( bl1_is_conjtrans( trans ) )
413 *flame_trans = FLA_CONJ_TRANSPOSE;
414 else
415 FLA_Check_error_code( FLA_INVALID_TRANS );
416 }
417
FLA_Param_map_blis_to_flame_uplo(uplo1_t uplo,FLA_Uplo * flame_uplo)418 void FLA_Param_map_blis_to_flame_uplo( uplo1_t uplo, FLA_Uplo* flame_uplo )
419 {
420 if ( bl1_is_lower( uplo ) )
421 *flame_uplo = FLA_LOWER_TRIANGULAR;
422 else if ( bl1_is_upper( uplo ) )
423 *flame_uplo = FLA_UPPER_TRIANGULAR;
424 else
425 FLA_Check_error_code( FLA_INVALID_UPLO );
426 }
427
FLA_Param_map_blis_to_flame_side(side1_t side,FLA_Side * flame_side)428 void FLA_Param_map_blis_to_flame_side( side1_t side, FLA_Side* flame_side )
429 {
430 if ( bl1_is_left( side ) )
431 *flame_side = FLA_LEFT;
432 else if ( bl1_is_right( side ) )
433 *flame_side = FLA_RIGHT;
434 else
435 FLA_Check_error_code( FLA_INVALID_SIDE );
436 }
437
FLA_Param_map_blis_to_flame_diag(diag1_t diag,FLA_Diag * flame_diag)438 void FLA_Param_map_blis_to_flame_diag( diag1_t diag, FLA_Diag* flame_diag )
439 {
440 if ( bl1_is_nonunit_diag( diag ) )
441 *flame_diag = FLA_NONUNIT_DIAG;
442 else if ( bl1_is_unit_diag( diag ) )
443 *flame_diag = FLA_UNIT_DIAG;
444 else if ( bl1_is_zero_diag( diag ) )
445 *flame_diag = FLA_ZERO_DIAG;
446 else
447 FLA_Check_error_code( FLA_INVALID_DIAG );
448 }
449
450 // --- FLAME char to FLAME mappings --------------------------------------------
451
FLA_Param_map_char_to_flame_trans(char * trans,FLA_Trans * flame_trans)452 void FLA_Param_map_char_to_flame_trans( char* trans, FLA_Trans* flame_trans )
453 {
454 if ( *trans == 'n' || *trans == 'N' )
455 *flame_trans = FLA_NO_TRANSPOSE;
456 else if ( *trans == 't' || *trans == 'T' )
457 *flame_trans = FLA_TRANSPOSE;
458 else if ( *trans == 'c' || *trans == 'C' )
459 *flame_trans = FLA_CONJ_NO_TRANSPOSE;
460 else if ( *trans == 'h' || *trans == 'H' )
461 *flame_trans = FLA_CONJ_TRANSPOSE;
462 else
463 FLA_Check_error_code( FLA_INVALID_TRANS );
464 }
465
FLA_Param_map_char_to_flame_uplo(char * uplo,FLA_Uplo * flame_uplo)466 void FLA_Param_map_char_to_flame_uplo( char* uplo, FLA_Uplo* flame_uplo )
467 {
468 if ( *uplo == 'l' || *uplo == 'L' )
469 *flame_uplo = FLA_LOWER_TRIANGULAR;
470 else if ( *uplo == 'u' || *uplo == 'U' )
471 *flame_uplo = FLA_UPPER_TRIANGULAR;
472 else
473 FLA_Check_error_code( FLA_INVALID_UPLO );
474 }
475
FLA_Param_map_char_to_flame_side(char * side,FLA_Side * flame_side)476 void FLA_Param_map_char_to_flame_side( char* side, FLA_Side* flame_side )
477 {
478 if ( *side == 'l' || *side == 'L' )
479 *flame_side = FLA_LEFT;
480 else if ( *side == 'r' || *side == 'R' )
481 *flame_side = FLA_RIGHT;
482 else
483 FLA_Check_error_code( FLA_INVALID_SIDE );
484 }
485
FLA_Param_map_char_to_flame_diag(char * diag,FLA_Diag * flame_diag)486 void FLA_Param_map_char_to_flame_diag( char* diag, FLA_Diag* flame_diag )
487 {
488 if ( *diag == 'n' || *diag == 'N' )
489 *flame_diag = FLA_NONUNIT_DIAG;
490 else if ( *diag == 'u' || *diag == 'U' )
491 *flame_diag = FLA_UNIT_DIAG;
492 else
493 FLA_Check_error_code( FLA_INVALID_DIAG );
494 }
495
FLA_Param_map_char_to_flame_direct(char * direct,FLA_Direct * flame_direct)496 void FLA_Param_map_char_to_flame_direct( char* direct, FLA_Direct* flame_direct )
497 {
498 if ( *direct == 'b' || *direct == 'B' )
499 *flame_direct = FLA_BACKWARD;
500 else if ( *direct == 'f' || *direct == 'F' )
501 *flame_direct = FLA_FORWARD;
502 else
503 FLA_Check_error_code( FLA_INVALID_DIRECT );
504 }
505
FLA_Param_map_char_to_flame_storev(char * storev,FLA_Direct * flame_storev)506 void FLA_Param_map_char_to_flame_storev( char* storev, FLA_Direct* flame_storev )
507 {
508 if ( *storev == 'c' || *storev == 'C' )
509 *flame_storev = FLA_COLUMNWISE;
510 else if ( *storev == 'r' || *storev == 'R' )
511 *flame_storev = FLA_ROWWISE;
512 else
513 FLA_Check_error_code( FLA_INVALID_STOREV );
514 }
515
FLA_Param_map_char_to_flame_inv(char * inv,FLA_Inv * flame_inv)516 void FLA_Param_map_char_to_flame_inv( char* inv, FLA_Inv* flame_inv )
517 {
518 if ( *inv == 'i' || *inv == 'I' )
519 *flame_inv = FLA_INVERSE;
520 else if ( *inv == 'n' || *inv == 'N' )
521 *flame_inv = FLA_NO_INVERSE;
522 else
523 FLA_Check_error_code( FLA_INVALID_INVERSE );
524 }
525
526