FLA_Dot2s_external.c File Reference

(r)


Functions

FLA_Error FLA_Dot2s_external (FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
void FLA_F2C() fla_dot2s_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_Dot2s_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_Dot2s(), fla_dot2s_external_f(), FLA_Syr2k_ln_unb_var1(), FLA_Syr2k_ln_unb_var2(), FLA_Syr2k_ln_unb_var3(), FLA_Syr2k_ln_unb_var4(), FLA_Syr2k_ln_unb_var5(), FLA_Syr2k_ln_unb_var6(), FLA_Syr2k_ln_unb_var7(), FLA_Syr2k_ln_unb_var8(), FLA_Syr2k_lt_unb_var1(), FLA_Syr2k_lt_unb_var2(), FLA_Syr2k_lt_unb_var3(), FLA_Syr2k_lt_unb_var4(), FLA_Syr2k_lt_unb_var5(), FLA_Syr2k_lt_unb_var6(), FLA_Syr2k_lt_unb_var7(), FLA_Syr2k_lt_unb_var8(), FLA_Syr2k_un_unb_var1(), FLA_Syr2k_un_unb_var2(), FLA_Syr2k_un_unb_var3(), FLA_Syr2k_un_unb_var4(), FLA_Syr2k_un_unb_var5(), FLA_Syr2k_un_unb_var6(), FLA_Syr2k_un_unb_var7(), FLA_Syr2k_un_unb_var8(), FLA_Syr2k_ut_unb_var1(), FLA_Syr2k_ut_unb_var2(), FLA_Syr2k_ut_unb_var3(), FLA_Syr2k_ut_unb_var4(), FLA_Syr2k_ut_unb_var5(), FLA_Syr2k_ut_unb_var6(), FLA_Syr2k_ut_unb_var7(), and FLA_Syr2k_ut_unb_var8().

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 = 2.0F * (*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 = 2.0 * (*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, temp2, alphac, temp_rho;
00122     
00123     alphac = *buff_alpha;
00124     alphac.imag *= -1.0F;
00125 
00126 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00127     cblas_cdotu_sub( num_elem, 
00128                      buff_x, inc_x, 
00129                      buff_y, inc_y, &temp ); 
00130     cblas_cdotu_sub( num_elem, 
00131                      buff_y, inc_y, 
00132                      buff_x, inc_x, &temp2 ); 
00133 #else
00134     FLA_F2C( fla_cdotu ) ( &num_elem, 
00135                            buff_x, &inc_x, 
00136                            buff_y, &inc_y, &temp ); 
00137     FLA_F2C( fla_cdotu ) ( &num_elem, 
00138                            buff_y, &inc_y, 
00139                            buff_x, &inc_x, &temp2 ); 
00140 #endif
00141 
00142 
00143     temp_rho.real = buff_alpha->real  * temp.real      - buff_alpha->imag  * temp.imag +
00144                     alphac.real       * temp2.real     - alphac.imag       * temp2.imag +
00145                     buff_beta->real   * buff_rho->real - buff_beta->imag   * buff_rho->imag;
00146 
00147     temp_rho.imag = buff_alpha->real  * temp.imag      + buff_alpha->imag  * temp.real +
00148                     alphac.real       * temp2.imag     + alphac.imag       * temp2.real +
00149                     buff_beta->real   * buff_rho->imag + buff_beta->imag   * buff_rho->real;
00150 
00151     buff_rho->real = temp_rho.real;
00152     buff_rho->imag = temp_rho.imag;
00153 
00154     break;
00155   }
00156 
00157   case FLA_DOUBLE_COMPLEX:
00158   {
00159     dcomplex *buff_x      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00160     dcomplex *buff_y      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00161     dcomplex *buff_rho    = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho );
00162     dcomplex *buff_alpha  = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00163     dcomplex *buff_beta   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta );
00164     dcomplex  temp, temp2, alphac, temp_rho;
00165     
00166     alphac = *buff_alpha;
00167     alphac.imag *= -1.0;
00168 
00169 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00170     cblas_zdotu_sub( num_elem, 
00171                      buff_x, inc_x, 
00172                      buff_y, inc_y, &temp ); 
00173     cblas_zdotu_sub( num_elem, 
00174                      buff_x, inc_x, 
00175                      buff_y, inc_y, &temp2 ); 
00176 #else
00177     FLA_F2C( fla_zdotu ) ( &num_elem, 
00178                            buff_x, &inc_x, 
00179                            buff_y, &inc_y, &temp ); 
00180     FLA_F2C( fla_zdotu ) ( &num_elem, 
00181                            buff_x, &inc_x, 
00182                            buff_y, &inc_y, &temp2 ); 
00183 #endif
00184 
00185     temp_rho.real = buff_alpha->real  * temp.real      - buff_alpha->imag  * temp.imag +
00186                     alphac.real       * temp2.real     - alphac.imag       * temp2.imag +
00187                     buff_beta->real   * buff_rho->real - buff_beta->imag   * buff_rho->imag;
00188 
00189     temp_rho.imag = buff_alpha->real  * temp.imag      + buff_alpha->imag  * temp.real +
00190                     alphac.real       * temp2.imag     + alphac.imag       * temp2.real +
00191                     buff_beta->real   * buff_rho->imag + buff_beta->imag   * buff_rho->real;
00192 
00193     buff_rho->real = temp_rho.real;
00194     buff_rho->imag = temp_rho.imag;
00195 
00196     break;
00197   }
00198 
00199   }
00200 
00201   return FLA_SUCCESS;
00202 }

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

References FLA_Dot2s_external().

00206 {
00207   *IERROR = FLA_Dot2s_external( *( ( FLA_Obj * ) alpha ),
00208                                 *( ( FLA_Obj * ) x     ),
00209                                 *( ( FLA_Obj * ) y     ),
00210                                 *( ( FLA_Obj * ) beta  ),
00211                                 *( ( FLA_Obj * ) rho   ) );
00212 }


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