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
FLA_Trmm_external(FLA_Side side,FLA_Uplo uplo,FLA_Trans trans,FLA_Diag diag,FLA_Obj alpha,FLA_Obj A,FLA_Obj B)13 FLA_Error FLA_Trmm_external( FLA_Side side, FLA_Uplo uplo, FLA_Trans trans, FLA_Diag diag, FLA_Obj alpha, FLA_Obj A, FLA_Obj B )
14 {
15 FLA_Datatype datatype;
16 int m_B, n_B;
17 int rs_A, cs_A;
18 int rs_B, cs_B;
19 side1_t blis_side;
20 uplo1_t blis_uplo;
21 trans1_t blis_trans;
22 diag1_t blis_diag;
23
24 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
25 FLA_Trmm_check( side, uplo, trans, diag, alpha, A, B );
26
27 if ( FLA_Obj_has_zero_dim( B ) ) return FLA_SUCCESS;
28
29 datatype = FLA_Obj_datatype( A );
30
31 rs_A = FLA_Obj_row_stride( A );
32 cs_A = FLA_Obj_col_stride( A );
33
34 m_B = FLA_Obj_length( B );
35 n_B = FLA_Obj_width( B );
36 rs_B = FLA_Obj_row_stride( B );
37 cs_B = FLA_Obj_col_stride( B );
38
39 FLA_Param_map_flame_to_blis_side( side, &blis_side );
40 FLA_Param_map_flame_to_blis_uplo( uplo, &blis_uplo );
41 FLA_Param_map_flame_to_blis_trans( trans, &blis_trans );
42 FLA_Param_map_flame_to_blis_diag( diag, &blis_diag );
43
44
45 switch( datatype ){
46
47 case FLA_FLOAT:
48 {
49 float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
50 float *buff_B = ( float * ) FLA_FLOAT_PTR( B );
51 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
52
53 bl1_strmm( blis_side,
54 blis_uplo,
55 blis_trans,
56 blis_diag,
57 m_B,
58 n_B,
59 buff_alpha,
60 buff_A, rs_A, cs_A,
61 buff_B, rs_B, cs_B );
62
63 break;
64 }
65
66 case FLA_DOUBLE:
67 {
68 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
69 double *buff_B = ( double * ) FLA_DOUBLE_PTR( B );
70 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
71
72 bl1_dtrmm( blis_side,
73 blis_uplo,
74 blis_trans,
75 blis_diag,
76 m_B,
77 n_B,
78 buff_alpha,
79 buff_A, rs_A, cs_A,
80 buff_B, rs_B, cs_B );
81
82 break;
83 }
84
85 case FLA_COMPLEX:
86 {
87 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
88 scomplex *buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B );
89 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
90
91 bl1_ctrmm( blis_side,
92 blis_uplo,
93 blis_trans,
94 blis_diag,
95 m_B,
96 n_B,
97 buff_alpha,
98 buff_A, rs_A, cs_A,
99 buff_B, rs_B, cs_B );
100
101 break;
102 }
103
104
105 case FLA_DOUBLE_COMPLEX:
106 {
107 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
108 dcomplex *buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B );
109 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
110
111 bl1_ztrmm( blis_side,
112 blis_uplo,
113 blis_trans,
114 blis_diag,
115 m_B,
116 n_B,
117 buff_alpha,
118 buff_A, rs_A, cs_A,
119 buff_B, rs_B, cs_B );
120
121 break;
122 }
123
124 }
125
126 return FLA_SUCCESS;
127 }
128
129