Functions | |
FLA_Error | FLA_Gemvc_external (FLA_Trans transa, FLA_Conj conjx, FLA_Obj alpha, FLA_Obj A, FLA_Obj x, FLA_Obj beta, FLA_Obj y) |
void FLA_F2C() | fla_gemvc_external_f (F_INT *trans, F_INT *conj, F_INT *alpha, F_INT *A, F_INT *x, F_INT *beta, F_INT *y, F_INT *IERROR) |
FLA_Error FLA_Gemvc_external | ( | FLA_Trans | transa, | |
FLA_Conj | conjx, | |||
FLA_Obj | alpha, | |||
FLA_Obj | A, | |||
FLA_Obj | x, | |||
FLA_Obj | beta, | |||
FLA_Obj | y | |||
) |
References cblas_cgemv(), cblas_dgemv(), cblas_sgemv(), cblas_zgemv(), CblasColMajor, cgemv(), dgemv(), FLA_Check_error_level(), FLA_Copyt_external(), FLA_Gemvc_check(), FLA_Obj_create_conf_to(), FLA_Obj_datatype(), FLA_Obj_free(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_width(), FLA_Param_map_to_blas_trans(), sgemv(), and zgemv().
Referenced by FLA_Apply_househ2_UT(), FLA_Chol_l_unb_var2(), FLA_Chol_u_unb_var2(), FLA_Gemm_hh_unb_var1(), FLA_Gemm_hh_unb_var2(), FLA_Gemm_hh_unb_var3(), FLA_Gemm_hh_unb_var4(), FLA_Gemm_hn_unb_var1(), FLA_Gemm_hn_unb_var2(), FLA_Gemm_ht_unb_var1(), FLA_Gemm_ht_unb_var2(), FLA_Gemm_nh_unb_var3(), FLA_Gemm_nh_unb_var4(), FLA_Gemvc(), fla_gemvc_external_f(), FLA_Hemm_ll_unb_var2(), FLA_Hemm_ll_unb_var3(), FLA_Hemm_ll_unb_var5(), FLA_Hemm_ll_unb_var6(), FLA_Hemm_lu_unb_var1(), FLA_Hemm_lu_unb_var2(), FLA_Hemm_lu_unb_var6(), FLA_Hemm_lu_unb_var7(), FLA_Hemm_rl_unb_var1(), FLA_Hemm_rl_unb_var2(), FLA_Hemm_rl_unb_var6(), FLA_Hemm_rl_unb_var7(), FLA_Hemm_ru_unb_var2(), FLA_Hemm_ru_unb_var3(), FLA_Hemm_ru_unb_var5(), FLA_Hemm_ru_unb_var6(), FLA_Her2k_lh_unb_var1(), FLA_Her2k_lh_unb_var2(), FLA_Her2k_lh_unb_var3(), FLA_Her2k_lh_unb_var6(), FLA_Her2k_lh_unb_var7(), FLA_Her2k_lh_unb_var8(), FLA_Her2k_ln_unb_var2(), FLA_Her2k_ln_unb_var3(), FLA_Her2k_ln_unb_var4(), FLA_Her2k_ln_unb_var5(), FLA_Her2k_ln_unb_var6(), FLA_Her2k_ln_unb_var7(), FLA_Her2k_uh_unb_var1(), FLA_Her2k_uh_unb_var2(), FLA_Her2k_uh_unb_var3(), FLA_Her2k_uh_unb_var6(), FLA_Her2k_uh_unb_var7(), FLA_Her2k_uh_unb_var8(), FLA_Her2k_un_unb_var2(), FLA_Her2k_un_unb_var3(), FLA_Her2k_un_unb_var4(), FLA_Her2k_un_unb_var5(), FLA_Her2k_un_unb_var6(), FLA_Her2k_un_unb_var7(), FLA_Herk_lh_unb_var1(), FLA_Herk_lh_unb_var4(), FLA_Herk_ln_unb_var2(), FLA_Herk_ln_unb_var3(), FLA_Herk_uh_unb_var1(), FLA_Herk_uh_unb_var3(), FLA_Herk_un_unb_var2(), FLA_Herk_un_unb_var4(), FLA_Trmm_llh_unb_var1(), FLA_Trmm_luh_unb_var1(), FLA_Trmm_rlh_unb_var1(), FLA_Trmm_ruh_unb_var1(), FLA_Trsm_llh_unb_var1(), FLA_Trsm_luh_unb_var1(), FLA_Trsm_rlh_unb_var1(), FLA_Trsm_ruh_unb_var1(), FLA_Ttmm_l_unb_var2(), and FLA_Ttmm_u_unb_var2().
00036 { 00037 FLA_Datatype datatype; 00038 int m_A, n_A, ldim_A; 00039 int m_x, ldim_x; 00040 int m_y, ldim_y; 00041 int inc_x, inc_y; 00042 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00043 CBLAS_ORDER cblas_order = CblasColMajor; 00044 CBLAS_TRANSPOSE blas_transa; 00045 #else 00046 char blas_transa; 00047 #endif 00048 FLA_Obj A_copy; 00049 FLA_Obj x_copy; 00050 FLA_Trans transa_copy; 00051 00052 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 00053 FLA_Gemvc_check( transa, conjx, alpha, A, x, beta, y ); 00054 00055 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; 00056 00057 datatype = FLA_Obj_datatype( A ); 00058 00059 m_A = FLA_Obj_length( A ); 00060 n_A = FLA_Obj_width( A ); 00061 ldim_A = FLA_Obj_ldim( A ); 00062 00063 m_x = FLA_Obj_length( x ); 00064 ldim_x = FLA_Obj_ldim( x ); 00065 00066 m_y = FLA_Obj_length( y ); 00067 ldim_y = FLA_Obj_ldim( y ); 00068 00069 inc_x = ( m_x == 1 ? ldim_x : 1 ); 00070 inc_y = ( m_y == 1 ? ldim_y : 1 ); 00071 00072 if ( transa == FLA_CONJ_NO_TRANSPOSE ) 00073 { 00074 FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, A, &A_copy ); 00075 FLA_Copyt_external( FLA_CONJ_NO_TRANSPOSE, A, A_copy ); 00076 transa_copy = FLA_NO_TRANSPOSE; 00077 00078 ldim_A = FLA_Obj_ldim( A_copy ); 00079 } 00080 else 00081 { 00082 A_copy = A; 00083 transa_copy = transa; 00084 } 00085 00086 if ( conjx == FLA_CONJUGATE ) 00087 { 00088 FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, x, &x_copy ); 00089 FLA_Copyt_external( FLA_CONJ_NO_TRANSPOSE, x, x_copy ); 00090 00091 m_x = FLA_Obj_length( x_copy ); 00092 ldim_x = FLA_Obj_ldim( x_copy ); 00093 inc_x = ( m_x == 1 ? ldim_x : 1 ); 00094 } 00095 else 00096 { 00097 x_copy = x; 00098 } 00099 00100 FLA_Param_map_to_blas_trans( transa_copy, &blas_transa ); 00101 00102 00103 switch( datatype ){ 00104 00105 case FLA_FLOAT: 00106 { 00107 float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); 00108 float *buff_x = ( float * ) FLA_FLOAT_PTR( x ); 00109 float *buff_y = ( float * ) FLA_FLOAT_PTR( y ); 00110 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); 00111 float *buff_beta = ( float * ) FLA_FLOAT_PTR( beta ); 00112 00113 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00114 cblas_sgemv( cblas_order, 00115 blas_transa, 00116 m_A, n_A, 00117 *buff_alpha, 00118 buff_A, ldim_A, 00119 buff_x, inc_x, 00120 *buff_beta, 00121 buff_y, inc_y ); 00122 #else 00123 FLA_C2F( sgemv )( &blas_transa, 00124 &m_A, &n_A, 00125 buff_alpha, 00126 buff_A, &ldim_A, 00127 buff_x, &inc_x, 00128 buff_beta, 00129 buff_y, &inc_y ); 00130 #endif 00131 break; 00132 } 00133 00134 case FLA_DOUBLE: 00135 { 00136 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); 00137 double *buff_x = ( double * ) FLA_DOUBLE_PTR( x ); 00138 double *buff_y = ( double * ) FLA_DOUBLE_PTR( y ); 00139 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00140 double *buff_beta = ( double * ) FLA_DOUBLE_PTR( beta ); 00141 00142 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00143 cblas_dgemv( cblas_order, 00144 blas_transa, 00145 m_A, n_A, 00146 *buff_alpha, 00147 buff_A, ldim_A, 00148 buff_x, inc_x, 00149 *buff_beta, 00150 buff_y, inc_y ); 00151 #else 00152 FLA_C2F( dgemv )( &blas_transa, 00153 &m_A, &n_A, 00154 buff_alpha, 00155 buff_A, &ldim_A, 00156 buff_x, &inc_x, 00157 buff_beta, 00158 buff_y, &inc_y ); 00159 #endif 00160 break; 00161 } 00162 00163 case FLA_COMPLEX: 00164 { 00165 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A_copy ); 00166 scomplex *buff_x = ( scomplex * ) FLA_COMPLEX_PTR( x_copy ); 00167 scomplex *buff_y = ( scomplex * ) FLA_COMPLEX_PTR( y ); 00168 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); 00169 scomplex *buff_beta = ( scomplex * ) FLA_COMPLEX_PTR( beta ); 00170 00171 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00172 cblas_cgemv( cblas_order, 00173 blas_transa, 00174 m_A, n_A, 00175 buff_alpha, 00176 buff_A, ldim_A, 00177 buff_x, inc_x, 00178 buff_beta, 00179 buff_y, inc_y ); 00180 #else 00181 FLA_C2F( cgemv )( &blas_transa, 00182 &m_A, &n_A, 00183 buff_alpha, 00184 buff_A, &ldim_A, 00185 buff_x, &inc_x, 00186 buff_beta, 00187 buff_y, &inc_y ); 00188 #endif 00189 break; 00190 } 00191 00192 case FLA_DOUBLE_COMPLEX: 00193 { 00194 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A_copy ); 00195 dcomplex *buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x_copy ); 00196 dcomplex *buff_y = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y ); 00197 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); 00198 dcomplex *buff_beta = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta ); 00199 00200 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00201 cblas_zgemv( cblas_order, 00202 blas_transa, 00203 m_A, n_A, 00204 buff_alpha, 00205 buff_A, ldim_A, 00206 buff_x, inc_x, 00207 buff_beta, 00208 buff_y, inc_y ); 00209 #else 00210 FLA_C2F( zgemv )( &blas_transa, 00211 &m_A, &n_A, 00212 buff_alpha, 00213 buff_A, &ldim_A, 00214 buff_x, &inc_x, 00215 buff_beta, 00216 buff_y, &inc_y ); 00217 #endif 00218 break; 00219 } 00220 00221 } 00222 00223 if ( transa == FLA_CONJ_NO_TRANSPOSE ) 00224 FLA_Obj_free( &A_copy ); 00225 00226 if ( conjx == FLA_CONJUGATE ) 00227 FLA_Obj_free( &x_copy ); 00228 00229 return FLA_SUCCESS; 00230 }
void FLA_F2C() fla_gemvc_external_f | ( | F_INT * | trans, | |
F_INT * | conj, | |||
F_INT * | alpha, | |||
F_INT * | A, | |||
F_INT * | x, | |||
F_INT * | beta, | |||
F_INT * | y, | |||
F_INT * | IERROR | |||
) |
References FLA_Gemvc_external().
00235 { 00236 *IERROR = FLA_Gemvc_external( *( ( FLA_Trans * ) trans ), 00237 *( ( FLA_Conj * ) conj ), 00238 *( ( FLA_Obj * ) alpha ), 00239 *( ( FLA_Obj * ) A ), 00240 *( ( FLA_Obj * ) x ), 00241 *( ( FLA_Obj * ) beta ), 00242 *( ( FLA_Obj * ) y ) ); 00243 }