FLA_Gerc_external.c File Reference

(r)


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)

Function Documentation

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 }


Generated on Mon Jul 6 05:45:53 2009 for libflame by  doxygen 1.5.9