FLA_Dots_external.c File Reference

(r)


Functions

FLA_Error FLA_Dots_external (FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
void FLA_F2C() fla_dots_external_f (F_INT *alpha, F_INT *x, F_INT *y, F_INT *beta, F_INT *rho, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Dots_external ( FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
FLA_Obj  rho 
)

References cblas_cdotu_sub(), cblas_ddot(), cblas_sdot(), cblas_zdotu_sub(), ddot(), fla_cdotu(), FLA_Check_error_level(), FLA_Dots_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Scal_external(), fla_zdotu(), dcomplex::imag, scomplex::imag, dcomplex::real, scomplex::real, and sdot().

Referenced by FLA_Chol_l_unb_var1(), FLA_Chol_l_unb_var2(), FLA_Chol_u_unb_var1(), FLA_Chol_u_unb_var2(), FLA_Dots(), fla_dots_external_f(), FLA_LU_nopiv_unb_var1(), FLA_LU_nopiv_unb_var2(), FLA_LU_nopiv_unb_var3(), FLA_LU_nopiv_unb_var4(), FLA_LU_piv_unb_var3(), FLA_LU_piv_unb_var3b(), FLA_LU_piv_unb_var4(), FLA_Syrk_ln_unb_var1(), FLA_Syrk_ln_unb_var2(), FLA_Syrk_ln_unb_var3(), FLA_Syrk_ln_unb_var4(), FLA_Syrk_lt_unb_var1(), FLA_Syrk_lt_unb_var2(), FLA_Syrk_lt_unb_var3(), FLA_Syrk_lt_unb_var4(), FLA_Syrk_un_unb_var1(), FLA_Syrk_un_unb_var2(), FLA_Syrk_un_unb_var3(), FLA_Syrk_un_unb_var4(), FLA_Syrk_ut_unb_var1(), FLA_Syrk_ut_unb_var2(), FLA_Syrk_ut_unb_var3(), FLA_Syrk_ut_unb_var4(), FLA_Ttmm_l_unb_var2(), FLA_Ttmm_l_unb_var3(), FLA_Ttmm_u_unb_var2(), and FLA_Ttmm_u_unb_var3().

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_Dots_check( alpha, x, y, beta, rho );
00044 
00045   if ( FLA_Obj_has_zero_dim( x ) )
00046   {
00047     FLA_Scal_external( beta, rho );
00048     return FLA_SUCCESS;
00049   }
00050 
00051   datatype = FLA_Obj_datatype( x );
00052 
00053   m_x      = FLA_Obj_length( x );
00054   ldim_x   = FLA_Obj_ldim( x );
00055 
00056   m_y      = FLA_Obj_length( y );
00057   ldim_y   = FLA_Obj_ldim( y ); 
00058 
00059   inc_x    = ( m_x == 1 ? ldim_x : 1 );
00060   inc_y    = ( m_y == 1 ? ldim_y : 1 );
00061   num_elem = FLA_Obj_vector_dim( x );
00062 
00063 
00064   switch ( datatype ){
00065   
00066   case FLA_FLOAT:
00067   {
00068     float *buff_x      = ( float * ) FLA_FLOAT_PTR( x );
00069     float *buff_y      = ( float * ) FLA_FLOAT_PTR( y );
00070     float *buff_rho    = ( float * ) FLA_FLOAT_PTR( rho );
00071     float *buff_alpha  = ( float * ) FLA_FLOAT_PTR( alpha );
00072     float *buff_beta   = ( float * ) FLA_FLOAT_PTR( beta );
00073     float  temp;
00074 
00075 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00076     temp = cblas_sdot( num_elem, 
00077                        buff_x, inc_x, 
00078                        buff_y, inc_y ); 
00079 #else
00080     temp = FLA_C2F( sdot ) ( &num_elem, 
00081                              buff_x, &inc_x, 
00082                              buff_y, &inc_y ); 
00083 #endif
00084 
00085     *buff_rho = (*buff_alpha) * temp + (*buff_beta) * (*buff_rho);
00086 
00087     break;
00088   }
00089 
00090   case FLA_DOUBLE:
00091   {
00092     double *buff_x      = ( double * ) FLA_DOUBLE_PTR( x );
00093     double *buff_y      = ( double * ) FLA_DOUBLE_PTR( y );
00094     double *buff_rho    = ( double * ) FLA_DOUBLE_PTR( rho );
00095     double *buff_alpha  = ( double * ) FLA_DOUBLE_PTR( alpha );
00096     double *buff_beta   = ( double * ) FLA_DOUBLE_PTR( beta );
00097     double  temp;
00098 
00099 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00100     temp = cblas_ddot( num_elem, 
00101                        buff_x, inc_x, 
00102                        buff_y, inc_y ); 
00103 #else
00104     temp = FLA_C2F( ddot ) ( &num_elem, 
00105                              buff_x, &inc_x, 
00106                              buff_y, &inc_y ); 
00107 #endif
00108 
00109     *buff_rho = (*buff_alpha) * temp + (*buff_beta) * (*buff_rho);
00110 
00111     break;
00112   }
00113 
00114   case FLA_COMPLEX:
00115   {
00116     scomplex *buff_x      = ( scomplex * ) FLA_COMPLEX_PTR( x );
00117     scomplex *buff_y      = ( scomplex * ) FLA_COMPLEX_PTR( y );
00118     scomplex *buff_rho    = ( scomplex * ) FLA_COMPLEX_PTR( rho );
00119     scomplex *buff_alpha  = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00120     scomplex *buff_beta   = ( scomplex * ) FLA_COMPLEX_PTR( beta );
00121     scomplex  temp, temp_rho;
00122 
00123 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00124     cblas_cdotu_sub( num_elem, 
00125                      buff_x, inc_x, 
00126                      buff_y, inc_y, &temp ); 
00127 #else
00128     // Using FLA_F2C here is not a bug! FLA_C2F() appends an (possibly) incorrect number
00129     // of underscores.
00130     FLA_F2C( fla_cdotu ) ( &num_elem, 
00131                            buff_x, &inc_x, 
00132                            buff_y, &inc_y, &temp ); 
00133 #endif
00134 
00135     temp_rho.real = buff_alpha->real * temp.real      - buff_alpha->imag * temp.imag +
00136                     buff_beta->real  * buff_rho->real - buff_beta->imag  * buff_rho->imag;
00137 
00138     temp_rho.imag = buff_alpha->real * temp.imag      + buff_alpha->imag * temp.real +
00139                     buff_beta->real  * buff_rho->imag + buff_beta->imag  * buff_rho->real;
00140 
00141     buff_rho->real = temp_rho.real;
00142     buff_rho->imag = temp_rho.imag;
00143 
00144     break;
00145   }
00146 
00147   case FLA_DOUBLE_COMPLEX:
00148   {
00149     dcomplex *buff_x      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00150     dcomplex *buff_y      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00151     dcomplex *buff_rho    = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho );
00152     dcomplex *buff_alpha  = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00153     dcomplex *buff_beta   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta );
00154     dcomplex  temp, temp_rho;
00155 
00156 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00157     cblas_zdotu_sub( num_elem, 
00158                      buff_x, inc_x, 
00159                      buff_y, inc_y, &temp ); 
00160 #else
00161     // Using FLA_F2C here is not a bug! FLA_C2F() appends an (possibly) incorrect number
00162     // of underscores.
00163     FLA_F2C( fla_zdotu ) ( &num_elem, 
00164                            buff_x, &inc_x, 
00165                            buff_y, &inc_y, &temp ); 
00166 #endif
00167 
00168     temp_rho.real = buff_alpha->real * temp.real      - buff_alpha->imag * temp.imag +
00169                     buff_beta->real  * buff_rho->real - buff_beta->imag  * buff_rho->imag;
00170 
00171     temp_rho.imag = buff_alpha->real * temp.imag      + buff_alpha->imag * temp.real +
00172                     buff_beta->real  * buff_rho->imag + buff_beta->imag  * buff_rho->real;
00173 
00174     buff_rho->real = temp_rho.real;
00175     buff_rho->imag = temp_rho.imag;
00176 
00177     break;
00178   }
00179 
00180   }
00181   
00182   return FLA_SUCCESS;
00183 }

void FLA_F2C() fla_dots_external_f ( F_INT *  alpha,
F_INT *  x,
F_INT *  y,
F_INT *  beta,
F_INT *  rho,
F_INT *  IERROR 
)

References FLA_Dots_external().

00187 {
00188   *IERROR = FLA_Dots_external( *( ( FLA_Obj * ) alpha ), 
00189                                *( ( FLA_Obj * ) x     ),
00190                                *( ( FLA_Obj * ) y     ), 
00191                                *( ( FLA_Obj * ) beta  ),
00192                                *( ( FLA_Obj * ) rho   ) );
00193 }


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