FLA_Dotcs_external.c File Reference

(r)


Functions

FLA_Error FLA_Dotcs_external (FLA_Conj conj, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho)
void FLA_F2C() fla_dotcs_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_Dotcs_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_Dotcs_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_Chol_l_unb_var1(), FLA_Chol_l_unb_var2(), FLA_Chol_u_unb_var1(), FLA_Chol_u_unb_var2(), FLA_Dotcs(), fla_dotcs_external_f(), FLA_Herk_lh_unb_var1(), FLA_Herk_lh_unb_var2(), FLA_Herk_lh_unb_var3(), FLA_Herk_lh_unb_var4(), FLA_Herk_ln_unb_var1(), FLA_Herk_ln_unb_var2(), FLA_Herk_ln_unb_var3(), FLA_Herk_ln_unb_var4(), FLA_Herk_uh_unb_var1(), FLA_Herk_uh_unb_var2(), FLA_Herk_uh_unb_var3(), FLA_Herk_uh_unb_var4(), FLA_Herk_un_unb_var1(), FLA_Herk_un_unb_var2(), FLA_Herk_un_unb_var3(), FLA_Herk_un_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_Dotcs_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 = (*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     if ( conj == FLA_NO_CONJUGATE )
00124     {
00125 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00126       cblas_cdotu_sub( num_elem, 
00127                        buff_x, inc_x, 
00128                        buff_y, inc_y, &temp ); 
00129 #else
00130       FLA_F2C( fla_cdotu ) ( &num_elem, 
00131                              buff_x, &inc_x, 
00132                              buff_y, &inc_y, &temp ); 
00133 #endif
00134     }
00135     else
00136     {
00137 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00138       cblas_cdotc_sub( num_elem, 
00139                        buff_x, inc_x, 
00140                        buff_y, inc_y, &temp ); 
00141 #else
00142       FLA_F2C( fla_cdotc ) ( &num_elem, 
00143                              buff_x, &inc_x, 
00144                              buff_y, &inc_y, &temp ); 
00145 #endif
00146     }
00147 
00148     temp_rho.real = buff_alpha->real * temp.real      - buff_alpha->imag * temp.imag +
00149                     buff_beta->real  * buff_rho->real - buff_beta->imag  * buff_rho->imag;
00150 
00151     temp_rho.imag = buff_alpha->real * temp.imag      + buff_alpha->imag * temp.real +
00152                     buff_beta->real  * buff_rho->imag + buff_beta->imag  * buff_rho->real;
00153 
00154     buff_rho->real = temp_rho.real;
00155     buff_rho->imag = temp_rho.imag;
00156 
00157     break;
00158   }
00159 
00160   case FLA_DOUBLE_COMPLEX:
00161   {
00162     dcomplex *buff_x      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x );
00163     dcomplex *buff_y      = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y );
00164     dcomplex *buff_rho    = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho );
00165     dcomplex *buff_alpha  = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00166     dcomplex *buff_beta   = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta );
00167     dcomplex  temp, temp_rho;
00168 
00169     if ( conj == FLA_NO_CONJUGATE )
00170     {
00171 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00172       cblas_zdotu_sub( num_elem, 
00173                        buff_x, inc_x, 
00174                        buff_y, inc_y, &temp ); 
00175 #else
00176       FLA_F2C( fla_zdotu ) ( &num_elem, 
00177                              buff_x, &inc_x, 
00178                              buff_y, &inc_y, &temp ); 
00179 #endif
00180     }
00181     else
00182     {
00183 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00184       cblas_zdotc_sub( num_elem, 
00185                        buff_x, inc_x, 
00186                        buff_y, inc_y, &temp ); 
00187 #else
00188       FLA_F2C( fla_zdotc ) ( &num_elem, 
00189                              buff_x, &inc_x, 
00190                              buff_y, &inc_y, &temp ); 
00191 #endif
00192     }
00193 
00194     temp_rho.real = buff_alpha->real * temp.real      - buff_alpha->imag * temp.imag +
00195                     buff_beta->real  * buff_rho->real - buff_beta->imag  * buff_rho->imag;
00196 
00197     temp_rho.imag = buff_alpha->real * temp.imag      + buff_alpha->imag * temp.real +
00198                     buff_beta->real  * buff_rho->imag + buff_beta->imag  * buff_rho->real;
00199 
00200     buff_rho->real = temp_rho.real;
00201     buff_rho->imag = temp_rho.imag;
00202 
00203     break;
00204   }
00205 
00206   }
00207   
00208   return FLA_SUCCESS;
00209 }

void FLA_F2C() fla_dotcs_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_Dotcs_external().

00213 {
00214   *IERROR = FLA_Dotcs_external( *( ( FLA_Conj * ) conj  ),
00215                                 *( ( FLA_Obj  * ) alpha ),
00216                                 *( ( FLA_Obj  * ) x     ),
00217                                 *( ( FLA_Obj  * ) y     ),
00218                                 *( ( FLA_Obj  * ) beta  ),
00219                                 *( ( FLA_Obj  * ) rho   ) );
00220 }


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