FLA_Hemv_external.c File Reference

(r)


Functions

FLA_Error FLA_Hemv_external (FLA_Uplo uplo, FLA_Obj alpha, FLA_Obj A, FLA_Obj x, FLA_Obj beta, FLA_Obj y)
void FLA_F2C() fla_hemv_external_f (F_INT *uplo, F_INT *alpha, F_INT *A, F_INT *x, F_INT *beta, F_INT *y, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Hemv_external ( FLA_Uplo  uplo,
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_Hemv_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Param_map_to_blas_uplo(), and zhemv().

Referenced by FLA_Hemm_ll_unb_var10(), FLA_Hemm_ll_unb_var9(), FLA_Hemm_lu_unb_var10(), FLA_Hemm_lu_unb_var9(), FLA_Hemv(), and fla_hemv_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 
00048   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00049     FLA_Hemv_check( uplo, alpha, A, x, beta, y );
00050 
00051   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00052 
00053   datatype = FLA_Obj_datatype( A );
00054 
00055   m_A      = FLA_Obj_length( A );
00056   ldim_A   = FLA_Obj_ldim( A );
00057 
00058   m_x      = FLA_Obj_length( x );
00059   ldim_x   = FLA_Obj_ldim( x );
00060 
00061   m_y      = FLA_Obj_length( y );
00062   ldim_y   = FLA_Obj_ldim( y );
00063 
00064   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00065   inc_y    = ( m_y == 1 ? ldim_y : 1 );
00066 
00067   FLA_Param_map_to_blas_uplo( uplo, &blas_uplo );
00068 
00069 
00070   switch( datatype ){
00071   
00072   case FLA_COMPLEX:
00073   {
00074     scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00075     scomplex *buff_x     = ( scomplex * ) FLA_COMPLEX_PTR( x );
00076     scomplex *buff_y     = ( scomplex * ) FLA_COMPLEX_PTR( y );
00077     scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00078     scomplex *buff_beta  = ( scomplex * ) FLA_COMPLEX_PTR( beta );
00079 
00080 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00081     cblas_chemv( cblas_order,
00082                  blas_uplo,
00083                  m_A,
00084                  buff_alpha,
00085                  buff_A, ldim_A, 
00086                  buff_x, inc_x,
00087                  buff_beta,
00088                  buff_y, inc_y );
00089 #else
00090     FLA_C2F( chemv )( &blas_uplo,
00091                       &m_A,
00092                       buff_alpha,
00093                       buff_A, &ldim_A, 
00094                       buff_x, &inc_x,
00095                       buff_beta,
00096                       buff_y, &inc_y );
00097 #endif
00098     break;
00099   }
00100 
00101   case FLA_DOUBLE_COMPLEX:
00102   {
00103     dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00104     dcomplex *buff_x     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00105     dcomplex *buff_y     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00106     dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00107     dcomplex *buff_beta  = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta );
00108 
00109 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00110     cblas_zhemv( cblas_order,
00111                  blas_uplo,
00112                  m_A,
00113                  buff_alpha,
00114                  buff_A, ldim_A,
00115                  buff_x, inc_x,
00116                  buff_beta,
00117                  buff_y, inc_y );
00118 #else
00119     FLA_C2F( zhemv )( &blas_uplo,
00120                       &m_A,
00121                       buff_alpha,
00122                       buff_A, &ldim_A,
00123                       buff_x, &inc_x,
00124                       buff_beta,
00125                       buff_y, &inc_y );
00126 #endif
00127     break;
00128   }
00129 
00130   }
00131   
00132   return FLA_SUCCESS;
00133 }

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

References FLA_Hemv_external().

00137 {
00138   *IERROR = FLA_Hemv_external( *( ( FLA_Uplo * ) uplo  ), 
00139                                *( ( FLA_Obj  * ) alpha ),
00140                                *( ( FLA_Obj  * ) A     ),
00141                                *( ( FLA_Obj  * ) x     ),
00142                                *( ( FLA_Obj  * ) beta  ),
00143                                *( ( FLA_Obj  * ) y     ) );
00144 }


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