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_Ger_external(FLA_Obj alpha,FLA_Obj x,FLA_Obj y,FLA_Obj A)13 FLA_Error FLA_Ger_external( FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj A )
14 {
15 FLA_Datatype datatype;
16 int m_A, n_A;
17 int rs_A, cs_A;
18 int inc_x;
19 int inc_y;
20 conj1_t blis_conjx;
21 conj1_t blis_conjy;
22
23 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
24 FLA_Ger_check( alpha, x, y, A );
25
26 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
27
28 datatype = FLA_Obj_datatype( A );
29
30 m_A = FLA_Obj_length( A );
31 n_A = FLA_Obj_width( A );
32 rs_A = FLA_Obj_row_stride( A );
33 cs_A = FLA_Obj_col_stride( A );
34
35 inc_x = FLA_Obj_vector_inc( x );
36 inc_y = FLA_Obj_vector_inc( y );
37
38 FLA_Param_map_flame_to_blis_conj( FLA_NO_CONJUGATE, &blis_conjx );
39 FLA_Param_map_flame_to_blis_conj( FLA_NO_CONJUGATE, &blis_conjy );
40
41
42 switch( datatype ){
43
44 case FLA_FLOAT:
45 {
46 float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
47 float *buff_x = ( float * ) FLA_FLOAT_PTR( x );
48 float *buff_y = ( float * ) FLA_FLOAT_PTR( y );
49 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
50
51 bl1_sger( blis_conjx,
52 blis_conjy,
53 m_A,
54 n_A,
55 buff_alpha,
56 buff_x, inc_x,
57 buff_y, inc_y,
58 buff_A, rs_A, cs_A );
59
60 break;
61 }
62
63 case FLA_DOUBLE:
64 {
65 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
66 double *buff_x = ( double * ) FLA_DOUBLE_PTR( x );
67 double *buff_y = ( double * ) FLA_DOUBLE_PTR( y );
68 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
69
70 bl1_dger( blis_conjx,
71 blis_conjy,
72 m_A,
73 n_A,
74 buff_alpha,
75 buff_x, inc_x,
76 buff_y, inc_y,
77 buff_A, rs_A, cs_A );
78
79 break;
80 }
81
82 case FLA_COMPLEX:
83 {
84 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
85 scomplex *buff_x = ( scomplex * ) FLA_COMPLEX_PTR( x );
86 scomplex *buff_y = ( scomplex * ) FLA_COMPLEX_PTR( y );
87 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
88
89 bl1_cger( blis_conjx,
90 blis_conjy,
91 m_A,
92 n_A,
93 buff_alpha,
94 buff_x, inc_x,
95 buff_y, inc_y,
96 buff_A, rs_A, cs_A );
97
98 break;
99 }
100
101 case FLA_DOUBLE_COMPLEX:
102 {
103 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
104 dcomplex *buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
105 dcomplex *buff_y = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
106 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
107
108 bl1_zger( blis_conjx,
109 blis_conjy,
110 m_A,
111 n_A,
112 buff_alpha,
113 buff_x, inc_x,
114 buff_y, inc_y,
115 buff_A, rs_A, cs_A );
116
117 break;
118 }
119
120 }
121
122 return FLA_SUCCESS;
123 }
124
125