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_Her2c_external(FLA_Uplo uplo,FLA_Conj conj,FLA_Obj alpha,FLA_Obj x,FLA_Obj y,FLA_Obj A)13 FLA_Error FLA_Her2c_external( FLA_Uplo uplo, FLA_Conj conj, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj A )
14 {
15 FLA_Datatype datatype;
16 int m_A;
17 int rs_A, cs_A;
18 int inc_x;
19 int inc_y;
20 uplo1_t blis_uplo;
21 conj1_t blis_conj;
22
23 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
24 FLA_Her2c_check( uplo, conj, 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 rs_A = FLA_Obj_row_stride( A );
32 cs_A = FLA_Obj_col_stride( A );
33
34 inc_x = FLA_Obj_vector_inc( x );
35 inc_y = FLA_Obj_vector_inc( y );
36
37 FLA_Param_map_flame_to_blis_uplo( uplo, &blis_uplo );
38 FLA_Param_map_flame_to_blis_conj( conj, &blis_conj );
39
40
41 switch( datatype ){
42
43 case FLA_FLOAT:
44 {
45 float *buff_A = ( float * ) FLA_FLOAT_PTR( A );
46 float *buff_x = ( float * ) FLA_FLOAT_PTR( x );
47 float *buff_y = ( float * ) FLA_FLOAT_PTR( y );
48 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
49
50 bl1_ssyr2( blis_uplo,
51 m_A,
52 buff_alpha,
53 buff_x, inc_x,
54 buff_y, inc_y,
55 buff_A, rs_A, cs_A );
56
57 break;
58 }
59
60 case FLA_DOUBLE:
61 {
62 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A );
63 double *buff_x = ( double * ) FLA_DOUBLE_PTR( x );
64 double *buff_y = ( double * ) FLA_DOUBLE_PTR( y );
65 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
66
67 bl1_dsyr2( blis_uplo,
68 m_A,
69 buff_alpha,
70 buff_x, inc_x,
71 buff_y, inc_y,
72 buff_A, rs_A, cs_A );
73 break;
74 }
75
76 case FLA_COMPLEX:
77 {
78 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A );
79 scomplex *buff_x = ( scomplex * ) FLA_COMPLEX_PTR( x );
80 scomplex *buff_y = ( scomplex * ) FLA_COMPLEX_PTR( y );
81 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
82
83 bl1_cher2( blis_uplo,
84 blis_conj,
85 m_A,
86 buff_alpha,
87 buff_x, inc_x,
88 buff_y, inc_y,
89 buff_A, rs_A, cs_A );
90
91 break;
92 }
93
94 case FLA_DOUBLE_COMPLEX:
95 {
96 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
97 dcomplex *buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
98 dcomplex *buff_y = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
99 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
100
101 bl1_zher2( blis_uplo,
102 blis_conj,
103 m_A,
104 buff_alpha,
105 buff_x, inc_x,
106 buff_y, inc_y,
107 buff_A, rs_A, cs_A );
108
109 break;
110 }
111
112 }
113
114 return FLA_SUCCESS;
115 }
116
117