FLA_Dot2cs_external.c File Reference

(r)


Functions

FLA_Error FLA_Dot2cs_external (FLA_Conj conj, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
void FLA_F2C() fla_dot2cs_external_f (F_INT *conj, F_INT *alpha, F_INT *x, F_INT *y, F_INT *beta, F_INT *rho, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Dot2cs_external ( FLA_Conj  conj,
FLA_Obj  alpha,
FLA_Obj  x,
FLA_Obj  y,
FLA_Obj  beta,
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_Dot2cs_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Scal_external(), fla_zdotc(), fla_zdotu(), dcomplex::imag, scomplex::imag, dcomplex::real, scomplex::real, and sdot().

Referenced by FLA_Dot2cs(), fla_dot2cs_external_f(), FLA_Her2k_lh_unb_var1(), FLA_Her2k_lh_unb_var2(), FLA_Her2k_lh_unb_var3(), FLA_Her2k_lh_unb_var4(), FLA_Her2k_lh_unb_var5(), FLA_Her2k_lh_unb_var6(), FLA_Her2k_lh_unb_var7(), FLA_Her2k_lh_unb_var8(), FLA_Her2k_ln_unb_var1(), FLA_Her2k_ln_unb_var2(), FLA_Her2k_ln_unb_var3(), FLA_Her2k_ln_unb_var4(), FLA_Her2k_ln_unb_var5(), FLA_Her2k_ln_unb_var6(), FLA_Her2k_ln_unb_var7(), FLA_Her2k_ln_unb_var8(), FLA_Her2k_uh_unb_var1(), FLA_Her2k_uh_unb_var2(), FLA_Her2k_uh_unb_var3(), FLA_Her2k_uh_unb_var4(), FLA_Her2k_uh_unb_var5(), FLA_Her2k_uh_unb_var6(), FLA_Her2k_uh_unb_var7(), FLA_Her2k_uh_unb_var8(), FLA_Her2k_un_unb_var1(), FLA_Her2k_un_unb_var2(), FLA_Her2k_un_unb_var3(), FLA_Her2k_un_unb_var4(), FLA_Her2k_un_unb_var5(), FLA_Her2k_un_unb_var6(), FLA_Her2k_un_unb_var7(), and FLA_Her2k_un_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_Dot2cs_check( conj, 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     if ( conj == FLA_NO_CONJUGATE )
00127     {
00128 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00129       cblas_cdotu_sub( num_elem, 
00130                        buff_x, inc_x, 
00131                        buff_y, inc_y, &temp ); 
00132       cblas_cdotu_sub( num_elem, 
00133                        buff_y, inc_y, 
00134                        buff_x, inc_x, &temp2 ); 
00135 #else
00136       FLA_F2C( fla_cdotu ) ( &num_elem, 
00137                              buff_x, &inc_x, 
00138                              buff_y, &inc_y, &temp ); 
00139       FLA_F2C( fla_cdotu ) ( &num_elem, 
00140                              buff_y, &inc_y, 
00141                              buff_x, &inc_x, &temp2 ); 
00142 #endif
00143     }
00144     else
00145     {
00146 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00147       cblas_cdotc_sub( num_elem, 
00148                        buff_x, inc_x, 
00149                        buff_y, inc_y, &temp ); 
00150       cblas_cdotc_sub( num_elem, 
00151                        buff_y, inc_y, 
00152                        buff_x, inc_x, &temp2 ); 
00153 #else
00154       FLA_F2C( fla_cdotc ) ( &num_elem, 
00155                              buff_x, &inc_x, 
00156                              buff_y, &inc_y, &temp ); 
00157       FLA_F2C( fla_cdotc ) ( &num_elem, 
00158                              buff_y, &inc_y, 
00159                              buff_x, &inc_x, &temp2 ); 
00160 #endif
00161     }
00162 
00163     temp_rho.real = buff_alpha->real  * temp.real      - buff_alpha->imag  * temp.imag +
00164                     alphac.real       * temp2.real     - alphac.imag       * temp2.imag +
00165                     buff_beta->real   * buff_rho->real - buff_beta->imag   * buff_rho->imag;
00166 
00167     temp_rho.imag = buff_alpha->real  * temp.imag      + buff_alpha->imag  * temp.real +
00168                     alphac.real       * temp2.imag     + alphac.imag       * temp2.real +
00169                     buff_beta->real   * buff_rho->imag + buff_beta->imag   * buff_rho->real;
00170 
00171     buff_rho->real = temp_rho.real;
00172     buff_rho->imag = temp_rho.imag;
00173 
00174     break;
00175   }
00176 
00177   case FLA_DOUBLE_COMPLEX:
00178   {
00179     dcomplex *buff_x      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00180     dcomplex *buff_y      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00181     dcomplex *buff_rho    = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho );
00182     dcomplex *buff_alpha  = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00183     dcomplex *buff_beta   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta );
00184     dcomplex  temp, temp2, alphac, temp_rho;
00185 
00186     alphac = *buff_alpha;
00187     alphac.imag *= -1.0;
00188 
00189     if ( conj == FLA_NO_CONJUGATE )
00190     {
00191 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00192       cblas_zdotu_sub( num_elem, 
00193                        buff_x, inc_x, 
00194                        buff_y, inc_y, &temp ); 
00195       cblas_zdotu_sub( num_elem, 
00196                        buff_y, inc_y, 
00197                        buff_x, inc_x, &temp2 ); 
00198 #else
00199       FLA_F2C( fla_zdotu ) ( &num_elem, 
00200                              buff_x, &inc_x, 
00201                              buff_y, &inc_y, &temp ); 
00202       FLA_F2C( fla_zdotu ) ( &num_elem, 
00203                              buff_y, &inc_y, 
00204                              buff_x, &inc_x, &temp2 ); 
00205 #endif
00206     }
00207     else
00208     {
00209 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00210       cblas_zdotc_sub( num_elem, 
00211                        buff_x, inc_x, 
00212                        buff_y, inc_y, &temp ); 
00213       cblas_zdotc_sub( num_elem, 
00214                        buff_y, inc_y, 
00215                        buff_x, inc_x, &temp2 ); 
00216 #else
00217       FLA_F2C( fla_zdotc ) ( &num_elem, 
00218                              buff_x, &inc_x, 
00219                              buff_y, &inc_y, &temp ); 
00220       FLA_F2C( fla_zdotc ) ( &num_elem, 
00221                              buff_y, &inc_y, 
00222                              buff_x, &inc_x, &temp2 ); 
00223 #endif
00224     }
00225 
00226     temp_rho.real = buff_alpha->real  * temp.real      - buff_alpha->imag  * temp.imag +
00227                     alphac.real       * temp2.real     - alphac.imag       * temp2.imag +
00228                     buff_beta->real   * buff_rho->real - buff_beta->imag   * buff_rho->imag;
00229 
00230     temp_rho.imag = buff_alpha->real  * temp.imag      + buff_alpha->imag  * temp.real +
00231                     alphac.real       * temp2.imag     + alphac.imag       * temp2.real +
00232                     buff_beta->real   * buff_rho->imag + buff_beta->imag   * buff_rho->real;
00233 
00234     buff_rho->real = temp_rho.real;
00235     buff_rho->imag = temp_rho.imag;
00236 
00237     break;
00238   }
00239 
00240   }
00241 
00242   return FLA_SUCCESS;
00243 }

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

References FLA_Dot2cs_external().

00247 {
00248   *IERROR = FLA_Dot2cs_external( *( ( FLA_Conj * ) conj  ),
00249                                  *( ( FLA_Obj  * ) alpha ),
00250                                  *( ( FLA_Obj  * ) x     ),
00251                                  *( ( FLA_Obj  * ) y     ),
00252                                  *( ( FLA_Obj  * ) beta  ),
00253                                  *( ( FLA_Obj  * ) rho   ) );
00254 }


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