FLA_Dot_external.c File Reference

(r)


Functions

FLA_Error FLA_Dot_external (FLA_Obj x, FLA_Obj y, FLA_Obj rho)
void FLA_F2C() fla_dot_external_f (F_INT *x, F_INT *y, F_INT *rho, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Dot_external ( FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  rho 
)

References cblas_cdotu_sub(), cblas_ddot(), cblas_sdot(), cblas_zdotu_sub(), ddot(), fla_cdotu(), FLA_Check_error_level(), FLA_Dot_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), fla_zdotu(), and sdot().

Referenced by FLA_Dot(), and fla_dot_external_f().

00036 {
00037   FLA_Datatype datatype;
00038   int          num_elem;
00039   int          m_x, inc_x, ldim_x;
00040   int          m_y, inc_y, ldim_y;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 
00043     FLA_Dot_check( x, y, rho );
00044 
00045   if ( FLA_Obj_has_zero_dim( x ) ) return FLA_SUCCESS;
00046 
00047   datatype = FLA_Obj_datatype( x );
00048 
00049   m_x      = FLA_Obj_length( x );
00050   ldim_x   = FLA_Obj_ldim( x );
00051 
00052   m_y      = FLA_Obj_length( y );
00053   ldim_y   = FLA_Obj_ldim( y ); 
00054 
00055   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00056   inc_y    = ( m_y == 1 ? ldim_y : 1 );
00057   num_elem = FLA_Obj_vector_dim( x );
00058 
00059 
00060   switch ( datatype ){
00061 
00062   case FLA_FLOAT:
00063   {
00064     float *buff_x   = ( float * ) FLA_FLOAT_PTR( x );
00065     float *buff_y   = ( float * ) FLA_FLOAT_PTR( y );
00066     float *buff_rho = ( float * ) FLA_FLOAT_PTR( rho );
00067 
00068 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00069     *buff_rho = 
00070       cblas_sdot( num_elem, 
00071                   buff_x, inc_x,
00072                   buff_y, inc_y );
00073 #else
00074     *buff_rho = 
00075       FLA_C2F( sdot ) ( &num_elem, 
00076                         buff_x, &inc_x,
00077                         buff_y, &inc_y );
00078 #endif
00079 
00080     break;
00081   }
00082 
00083   case FLA_DOUBLE:
00084   {
00085     double *buff_x   = ( double * ) FLA_DOUBLE_PTR( x );
00086     double *buff_y   = ( double * ) FLA_DOUBLE_PTR( y );
00087     double *buff_rho = ( double * ) FLA_DOUBLE_PTR( rho );
00088 
00089 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00090     *buff_rho = 
00091       cblas_ddot( num_elem, 
00092                   buff_x, inc_x,
00093                   buff_y, inc_y );
00094 #else
00095     *buff_rho = 
00096       FLA_C2F( ddot ) ( &num_elem, 
00097                         buff_x, &inc_x,
00098                         buff_y, &inc_y );
00099 #endif
00100 
00101     break;
00102   }
00103 
00104   case FLA_COMPLEX:
00105   {
00106     scomplex *buff_x   = ( scomplex * ) FLA_COMPLEX_PTR( x );
00107     scomplex *buff_y   = ( scomplex * ) FLA_COMPLEX_PTR( y );
00108     scomplex *buff_rho = ( scomplex * ) FLA_COMPLEX_PTR( rho );
00109 
00110 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00111     cblas_cdotu_sub( num_elem, 
00112                      buff_x, inc_x,
00113                      buff_y, inc_y, buff_rho );
00114 #else
00115     // Using FLA_F2C here is not a bug! FLA_C2F() appends an (possibly) incorrect number
00116     // of underscores.
00117     FLA_F2C( fla_cdotu ) ( &num_elem, 
00118                            buff_x, &inc_x,
00119                            buff_y, &inc_y, buff_rho );
00120 #endif
00121 
00122     break;
00123   }
00124 
00125   case FLA_DOUBLE_COMPLEX:
00126   {
00127     dcomplex *buff_x   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00128     dcomplex *buff_y   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00129     dcomplex *buff_rho = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho );
00130 
00131 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00132     cblas_zdotu_sub( num_elem, 
00133                      buff_x, inc_x,
00134                      buff_y, inc_y, buff_rho );
00135 #else
00136     // Using FLA_F2C here is not a bug! FLA_C2F() appends an (possibly) incorrect number
00137     // of underscores.
00138     FLA_F2C( fla_zdotu ) ( &num_elem, 
00139                            buff_x, &inc_x,
00140                            buff_y, &inc_y, buff_rho );
00141 #endif
00142 
00143     break;
00144   }
00145 
00146   }
00147 
00148   return FLA_SUCCESS;
00149 }

void FLA_F2C() fla_dot_external_f ( F_INT *  x,
F_INT *  y,
F_INT *  rho,
F_INT *  IERROR 
)

References FLA_Dot_external().

00153 {
00154   *IERROR = FLA_Dot_external( *( ( FLA_Obj * ) x   ), 
00155                               *( ( FLA_Obj * ) y   ),
00156                               *( ( FLA_Obj * ) rho ) );
00157 }


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