Functions | |
FLA_Error | FLA_Gerc_external (FLA_Conj conjx, FLA_Conj conjy, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj A) |
void FLA_F2C() | fla_gerc_external_f (F_INT *conjx, F_INT *conjy, F_INT *alpha, F_INT *x, F_INT *y, F_INT *A, F_INT *IERROR) |
FLA_Error FLA_Gerc_external | ( | FLA_Conj | conjx, | |
FLA_Conj | conjy, | |||
FLA_Obj | alpha, | |||
FLA_Obj | x, | |||
FLA_Obj | y, | |||
FLA_Obj | A | |||
) |
References cblas_cgerc(), cblas_cgeru(), cblas_dger(), cblas_sger(), cblas_zgerc(), cblas_zgeru(), CblasColMajor, cgerc(), cgeru(), dger(), FLA_Check_error_level(), FLA_Copyt_external(), FLA_Gerc_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(), sger(), zgerc(), and zgeru().
Referenced by FLA_Gemm_hh_unb_var5(), FLA_Gemm_hh_unb_var6(), FLA_Gemm_hn_unb_var5(), FLA_Gemm_hn_unb_var6(), FLA_Gemm_ht_unb_var5(), FLA_Gemm_ht_unb_var6(), FLA_Gemm_nh_unb_var5(), FLA_Gemm_nh_unb_var6(), FLA_Gerc(), fla_gerc_external_f(), FLA_Hemm_ll_unb_var1(), FLA_Hemm_ll_unb_var4(), FLA_Hemm_ll_unb_var7(), FLA_Hemm_ll_unb_var8(), FLA_Hemm_lu_unb_var3(), FLA_Hemm_lu_unb_var4(), FLA_Hemm_lu_unb_var5(), FLA_Hemm_lu_unb_var8(), FLA_Hemm_rl_unb_var3(), FLA_Hemm_rl_unb_var4(), FLA_Hemm_rl_unb_var5(), FLA_Hemm_rl_unb_var8(), FLA_Hemm_ru_unb_var1(), FLA_Hemm_ru_unb_var4(), FLA_Hemm_ru_unb_var7(), FLA_Hemm_ru_unb_var8(), FLA_Symm_rl_unb_var3(), FLA_Symm_rl_unb_var4(), FLA_Symm_rl_unb_var5(), FLA_Symm_rl_unb_var8(), FLA_Symm_ru_unb_var1(), FLA_Symm_ru_unb_var4(), FLA_Symm_ru_unb_var7(), FLA_Symm_ru_unb_var8(), FLA_Trmm_llh_unb_var2(), FLA_Trmm_luh_unb_var2(), FLA_Trmm_rlh_unb_var2(), FLA_Trmm_ruh_unb_var2(), FLA_Trsm_llh_unb_var2(), FLA_Trsm_luh_unb_var2(), FLA_Trsm_rlh_unb_var2(), and FLA_Trsm_ruh_unb_var2().
00036 { 00037 FLA_Datatype datatype; 00038 int m_A, n_A, ldim_A; 00039 int m_x, inc_x, ldim_x; 00040 int m_y, inc_y, ldim_y; 00041 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00042 CBLAS_ORDER cblas_order = CblasColMajor; 00043 #endif 00044 FLA_Obj x_copy; 00045 00046 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 00047 FLA_Gerc_check( conjx, conjy, alpha, x, y, A ); 00048 00049 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; 00050 00051 datatype = FLA_Obj_datatype( A ); 00052 00053 m_A = FLA_Obj_length( A ); 00054 n_A = FLA_Obj_width( A ); 00055 ldim_A = FLA_Obj_ldim( A ); 00056 00057 m_x = FLA_Obj_length( x ); 00058 ldim_x = FLA_Obj_ldim( x ); 00059 00060 m_y = FLA_Obj_length( y ); 00061 ldim_y = FLA_Obj_ldim( y ); 00062 00063 inc_x = ( m_x == 1 ? ldim_x : 1 ); 00064 inc_y = ( m_y == 1 ? ldim_y : 1 ); 00065 00066 if ( conjx == FLA_CONJUGATE ) 00067 { 00068 FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, x, &x_copy ); 00069 FLA_Copyt_external( FLA_CONJ_NO_TRANSPOSE, x, x_copy ); 00070 00071 m_x = FLA_Obj_length( x_copy ); 00072 ldim_x = FLA_Obj_ldim( x_copy ); 00073 inc_x = ( m_x == 1 ? ldim_x : 1 ); 00074 } 00075 else 00076 { 00077 x_copy = x; 00078 } 00079 00080 00081 switch( datatype ){ 00082 00083 case FLA_FLOAT: 00084 { 00085 float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); 00086 float *buff_x = ( float * ) FLA_FLOAT_PTR( x ); 00087 float *buff_y = ( float * ) FLA_FLOAT_PTR( y ); 00088 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); 00089 00090 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00091 cblas_sger( cblas_order, 00092 m_A, n_A, 00093 *buff_alpha, 00094 buff_x, inc_x, 00095 buff_y, inc_y, 00096 buff_A, ldim_A ); 00097 #else 00098 FLA_C2F( sger )( &m_A, &n_A, 00099 buff_alpha, 00100 buff_x, &inc_x, 00101 buff_y, &inc_y, 00102 buff_A, &ldim_A ); 00103 #endif 00104 break; 00105 } 00106 00107 case FLA_DOUBLE: 00108 { 00109 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); 00110 double *buff_x = ( double * ) FLA_DOUBLE_PTR( x ); 00111 double *buff_y = ( double * ) FLA_DOUBLE_PTR( y ); 00112 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00113 00114 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00115 cblas_dger( cblas_order, 00116 m_A, n_A, 00117 *buff_alpha, 00118 buff_x, inc_x, 00119 buff_y, inc_y, 00120 buff_A, ldim_A ); 00121 #else 00122 FLA_C2F( dger )( &m_A, &n_A, 00123 buff_alpha, 00124 buff_x, &inc_x, 00125 buff_y, &inc_y, 00126 buff_A, &ldim_A ); 00127 #endif 00128 break; 00129 } 00130 00131 case FLA_COMPLEX: 00132 { 00133 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00134 scomplex *buff_x = ( scomplex * ) FLA_COMPLEX_PTR( x_copy ); 00135 scomplex *buff_y = ( scomplex * ) FLA_COMPLEX_PTR( y ); 00136 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); 00137 00138 if ( conjy == FLA_NO_CONJUGATE ) 00139 { 00140 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00141 cblas_cgeru( cblas_order, 00142 m_A, n_A, 00143 buff_alpha, 00144 buff_x, inc_x, 00145 buff_y, inc_y, 00146 buff_A, ldim_A ); 00147 #else 00148 FLA_C2F( cgeru )( &m_A, &n_A, 00149 buff_alpha, 00150 buff_x, &inc_x, 00151 buff_y, &inc_y, 00152 buff_A, &ldim_A ); 00153 #endif 00154 } 00155 else 00156 { 00157 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00158 cblas_cgerc( cblas_order, 00159 m_A, n_A, 00160 buff_alpha, 00161 buff_x, inc_x, 00162 buff_y, inc_y, 00163 buff_A, ldim_A ); 00164 #else 00165 FLA_C2F( cgerc )( &m_A, &n_A, 00166 buff_alpha, 00167 buff_x, &inc_x, 00168 buff_y, &inc_y, 00169 buff_A, &ldim_A ); 00170 #endif 00171 } 00172 00173 break; 00174 } 00175 00176 case FLA_DOUBLE_COMPLEX: 00177 { 00178 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00179 dcomplex *buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x_copy ); 00180 dcomplex *buff_y = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y ); 00181 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); 00182 00183 if ( conjy == FLA_NO_CONJUGATE ) 00184 { 00185 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00186 cblas_zgeru( cblas_order, 00187 m_A, n_A, 00188 buff_alpha, 00189 buff_x, inc_x, 00190 buff_y, inc_y, 00191 buff_A, ldim_A ); 00192 #else 00193 FLA_C2F( zgeru )( &m_A, &n_A, 00194 buff_alpha, 00195 buff_x, &inc_x, 00196 buff_y, &inc_y, 00197 buff_A, &ldim_A ); 00198 #endif 00199 } 00200 else 00201 { 00202 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00203 cblas_zgerc( cblas_order, 00204 m_A, n_A, 00205 buff_alpha, 00206 buff_x, inc_x, 00207 buff_y, inc_y, 00208 buff_A, ldim_A ); 00209 #else 00210 FLA_C2F( zgerc )( &m_A, &n_A, 00211 buff_alpha, 00212 buff_x, &inc_x, 00213 buff_y, &inc_y, 00214 buff_A, &ldim_A ); 00215 #endif 00216 } 00217 00218 break; 00219 } 00220 00221 } 00222 00223 if ( conjx == FLA_CONJUGATE ) 00224 FLA_Obj_free( &x_copy ); 00225 00226 return FLA_SUCCESS; 00227 }
void FLA_F2C() fla_gerc_external_f | ( | F_INT * | conjx, | |
F_INT * | conjy, | |||
F_INT * | alpha, | |||
F_INT * | x, | |||
F_INT * | y, | |||
F_INT * | A, | |||
F_INT * | IERROR | |||
) |
References FLA_Gerc_external().
00232 { 00233 *IERROR = FLA_Gerc_external( *( ( FLA_Conj * ) conjx ), 00234 *( ( FLA_Conj * ) conjy ), 00235 *( ( FLA_Obj * ) alpha ), 00236 *( ( FLA_Obj * ) x ), 00237 *( ( FLA_Obj * ) y ), 00238 *( ( FLA_Obj * ) A ) ); 00239 }