FLA_Dotc_external.c File Reference

(r)


Functions

FLA_Error FLA_Dotc_external (FLA_Conj conj, FLA_Obj x, FLA_Obj y, FLA_Obj rho)
void FLA_F2C() fla_dotc_external_f (F_INT *conj, F_INT *x, F_INT *y, F_INT *rho, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Dotc_external ( FLA_Conj  conj,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  rho 
)

References cblas_cdotc_sub(), cblas_cdotu_sub(), cblas_ddot(), cblas_sdot(), cblas_zdotc_sub(), cblas_zdotu_sub(), ddot(), fla_cdotc(), fla_cdotu(), FLA_Check_error_level(), FLA_Dotc_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), fla_zdotc(), fla_zdotu(), and sdot().

Referenced by FLA_Dotc(), and fla_dotc_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_Dotc_check( conj, 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     if ( conj == FLA_NO_CONJUGATE )
00111     {
00112 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00113       cblas_cdotu_sub( num_elem, 
00114                        buff_x, inc_x,
00115                        buff_y, inc_y, buff_rho );
00116 #else
00117       FLA_F2C( fla_cdotu ) ( &num_elem, 
00118                              buff_x, &inc_x,
00119                              buff_y, &inc_y, buff_rho );
00120 #endif
00121     }
00122     else
00123     {
00124 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00125       cblas_cdotc_sub( num_elem, 
00126                        buff_x, inc_x,
00127                        buff_y, inc_y, buff_rho );
00128 #else
00129       FLA_F2C( fla_cdotc ) ( &num_elem, 
00130                              buff_x, &inc_x,
00131                              buff_y, &inc_y, buff_rho );
00132 #endif
00133     }
00134 
00135     break;
00136   }
00137 
00138   case FLA_DOUBLE_COMPLEX:
00139   {
00140     dcomplex *buff_x   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00141     dcomplex *buff_y   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00142     dcomplex *buff_rho = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho );
00143 
00144     if ( conj == FLA_NO_CONJUGATE )
00145     {
00146 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00147       cblas_zdotu_sub( num_elem, 
00148                        buff_x, inc_x,
00149                        buff_y, inc_y, buff_rho );
00150 #else
00151       FLA_F2C( fla_zdotu ) ( &num_elem, 
00152                              buff_x, &inc_x,
00153                              buff_y, &inc_y, buff_rho );
00154 #endif
00155     }
00156     else
00157     {
00158 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00159       cblas_zdotc_sub( num_elem, 
00160                        buff_x, inc_x,
00161                        buff_y, inc_y, buff_rho );
00162 #else
00163       FLA_F2C( fla_zdotc ) ( &num_elem, 
00164                              buff_x, &inc_x,
00165                              buff_y, &inc_y, buff_rho );
00166 #endif
00167     }
00168 
00169     break;
00170   }
00171 
00172   }
00173 
00174   return FLA_SUCCESS;
00175 }

void FLA_F2C() fla_dotc_external_f ( F_INT *  conj,
F_INT *  x,
F_INT *  y,
F_INT *  rho,
F_INT *  IERROR 
)

References FLA_Dotc_external().

00179 {
00180   *IERROR = FLA_Dotc_external( *( ( FLA_Conj * ) conj ), 
00181                                *( ( FLA_Obj  * ) x    ), 
00182                                *( ( FLA_Obj  * ) y    ),
00183                                *( ( FLA_Obj  * ) rho  ) );
00184 }


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