FLA_Hemvc_external.c File Reference

(r)


Functions

FLA_Error FLA_Hemvc_external (FLA_Uplo uplo, FLA_Conj conja, FLA_Obj alpha, FLA_Obj A, FLA_Obj x, FLA_Obj beta, FLA_Obj y)
void FLA_F2C() fla_hemvc_external_f (F_INT *uplo, 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_Hemvc_external ( FLA_Uplo  uplo,
FLA_Conj  conja,
FLA_Obj  alpha,
FLA_Obj  A,
FLA_Obj  x,
FLA_Obj  beta,
FLA_Obj  y 
)

References cblas_chemv(), cblas_zhemv(), CblasColMajor, chemv(), FLA_Check_error_level(), FLA_Copyt_external(), FLA_Hemvc_check(), FLA_Obj_create_conf_to(), FLA_Obj_datatype(), FLA_Obj_free(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Param_map_to_blas_uplo(), and zhemv().

Referenced by FLA_Hemm_rl_unb_var10(), FLA_Hemm_rl_unb_var9(), FLA_Hemm_ru_unb_var10(), FLA_Hemm_ru_unb_var9(), FLA_Hemvc(), and fla_hemvc_external_f().

00036 {
00037   FLA_Datatype datatype;
00038   int          m_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   CBLAS_UPLO   blas_uplo;   
00044 #else
00045   char         blas_uplo;
00046 #endif
00047   FLA_Obj      A_copy;
00048 
00049   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00050     FLA_Hemvc_check( uplo, conja, alpha, A, x, beta, y );
00051 
00052   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00053 
00054   datatype = FLA_Obj_datatype( A );
00055 
00056   m_A      = FLA_Obj_length( A );
00057   ldim_A   = FLA_Obj_ldim( A );
00058 
00059   m_x      = FLA_Obj_length( x );
00060   ldim_x   = FLA_Obj_ldim( x );
00061 
00062   m_y      = FLA_Obj_length( y );
00063   ldim_y   = FLA_Obj_ldim( y );
00064 
00065   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00066   inc_y    = ( m_y == 1 ? ldim_y : 1 );
00067 
00068   if ( conja == FLA_CONJUGATE )
00069   {
00070     FLA_Obj_create_conf_to( FLA_NO_TRANSPOSE, A, &A_copy );
00071     FLA_Copyt_external( FLA_CONJ_NO_TRANSPOSE, A, A_copy );
00072 
00073     ldim_A = FLA_Obj_ldim( A_copy );
00074   }
00075   else
00076   {
00077     A_copy = A;
00078   }
00079 
00080   FLA_Param_map_to_blas_uplo( uplo, &blas_uplo );
00081 
00082 
00083   switch( datatype ){
00084   
00085   case FLA_COMPLEX:
00086   {
00087     scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A_copy );
00088     scomplex *buff_x     = ( scomplex * ) FLA_COMPLEX_PTR( x );
00089     scomplex *buff_y     = ( scomplex * ) FLA_COMPLEX_PTR( y );
00090     scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00091     scomplex *buff_beta  = ( scomplex * ) FLA_COMPLEX_PTR( beta );
00092 
00093 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00094     cblas_chemv( cblas_order,
00095                  blas_uplo,
00096                  m_A,
00097                  buff_alpha,
00098                  buff_A, ldim_A, 
00099                  buff_x, inc_x,
00100                  buff_beta,
00101                  buff_y, inc_y );
00102 #else
00103     FLA_C2F( chemv )( &blas_uplo,
00104                       &m_A,
00105                       buff_alpha,
00106                       buff_A, &ldim_A, 
00107                       buff_x, &inc_x,
00108                       buff_beta,
00109                       buff_y, &inc_y );
00110 #endif
00111     break;
00112   }
00113 
00114   case FLA_DOUBLE_COMPLEX:
00115   {
00116     dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A_copy );
00117     dcomplex *buff_x     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00118     dcomplex *buff_y     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00119     dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00120     dcomplex *buff_beta  = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta );
00121 
00122 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00123     cblas_zhemv( cblas_order,
00124                  blas_uplo,
00125                  m_A,
00126                  buff_alpha,
00127                  buff_A, ldim_A,
00128                  buff_x, inc_x,
00129                  buff_beta,
00130                  buff_y, inc_y );
00131 #else
00132     FLA_C2F( zhemv )( &blas_uplo,
00133                       &m_A,
00134                       buff_alpha,
00135                       buff_A, &ldim_A,
00136                       buff_x, &inc_x,
00137                       buff_beta,
00138                       buff_y, &inc_y );
00139 #endif
00140     break;
00141   }
00142 
00143   }
00144 
00145   if ( conja == FLA_CONJUGATE )
00146     FLA_Obj_free( &A_copy );
00147   
00148   return FLA_SUCCESS;
00149 }

void FLA_F2C() fla_hemvc_external_f ( F_INT *  uplo,
F_INT *  conj,
F_INT *  alpha,
F_INT *  A,
F_INT *  x,
F_INT *  beta,
F_INT *  y,
F_INT *  IERROR 
)

References FLA_Hemvc_external().

00153 {
00154   *IERROR = FLA_Hemvc_external( *( ( FLA_Uplo * ) uplo  ), 
00155                                 *( ( FLA_Conj * ) conj  ), 
00156                                 *( ( FLA_Obj  * ) alpha ),
00157                                 *( ( FLA_Obj  * ) A     ),
00158                                 *( ( FLA_Obj  * ) x     ),
00159                                 *( ( FLA_Obj  * ) beta  ),
00160                                 *( ( FLA_Obj  * ) y     ) );
00161 }


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