FLA_Gemvc_external.c File Reference

(r)


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)

Function Documentation

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 }


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