FLA_Scal_external.c File Reference

(r)


Functions

FLA_Error FLA_Scal_external (FLA_Obj alpha, FLA_Obj A)
void FLA_F2C() fla_scal_external_f (F_INT *alpha, F_INT *A, F_INT *IERROR)

Function Documentation

FLA_Error FLA_Scal_external ( FLA_Obj  alpha,
FLA_Obj  A 
)

References cblas_cscal(), cblas_csscal(), cblas_dscal(), cblas_sscal(), cblas_zdscal(), cblas_zscal(), cscal(), csscal(), dscal(), FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_equals(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_set_to_scalar(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_ONE, FLA_Scal_check(), FLA_ZERO, sscal(), zdscal(), and zscal().

Referenced by FLA_Axpys_external(), FLA_Dot2cs_external(), FLA_Dot2s_external(), FLA_Dotcs_external(), FLA_Dots_external(), FLA_Gemm_external(), FLA_Gemm_hh_unb_var1(), FLA_Gemm_hh_unb_var2(), FLA_Gemm_hh_unb_var3(), FLA_Gemm_hh_unb_var4(), FLA_Gemm_hh_unb_var5(), FLA_Gemm_hh_unb_var6(), FLA_Gemm_hn_unb_var1(), FLA_Gemm_hn_unb_var2(), FLA_Gemm_hn_unb_var3(), FLA_Gemm_hn_unb_var4(), FLA_Gemm_hn_unb_var5(), FLA_Gemm_hn_unb_var6(), FLA_Gemm_ht_unb_var1(), FLA_Gemm_ht_unb_var2(), FLA_Gemm_ht_unb_var3(), FLA_Gemm_ht_unb_var4(), FLA_Gemm_ht_unb_var5(), FLA_Gemm_ht_unb_var6(), FLA_Gemm_nh_unb_var1(), FLA_Gemm_nh_unb_var2(), FLA_Gemm_nh_unb_var3(), FLA_Gemm_nh_unb_var4(), FLA_Gemm_nh_unb_var5(), FLA_Gemm_nh_unb_var6(), FLA_Gemm_nn_unb_var1(), FLA_Gemm_nn_unb_var2(), FLA_Gemm_nn_unb_var3(), FLA_Gemm_nn_unb_var4(), FLA_Gemm_nn_unb_var5(), FLA_Gemm_nn_unb_var6(), FLA_Gemm_nt_unb_var1(), FLA_Gemm_nt_unb_var2(), FLA_Gemm_nt_unb_var3(), FLA_Gemm_nt_unb_var4(), FLA_Gemm_nt_unb_var5(), FLA_Gemm_nt_unb_var6(), FLA_Gemm_th_unb_var1(), FLA_Gemm_th_unb_var2(), FLA_Gemm_th_unb_var3(), FLA_Gemm_th_unb_var4(), FLA_Gemm_th_unb_var5(), FLA_Gemm_th_unb_var6(), FLA_Gemm_tn_unb_var1(), FLA_Gemm_tn_unb_var2(), FLA_Gemm_tn_unb_var3(), FLA_Gemm_tn_unb_var4(), FLA_Gemm_tn_unb_var5(), FLA_Gemm_tn_unb_var6(), FLA_Gemm_tt_unb_var1(), FLA_Gemm_tt_unb_var2(), FLA_Gemm_tt_unb_var3(), FLA_Gemm_tt_unb_var4(), FLA_Gemm_tt_unb_var5(), FLA_Gemm_tt_unb_var6(), FLA_Negate(), FLA_Scal(), fla_scal_external_f(), FLA_Trinv_l_unb_var1(), FLA_Trinv_l_unb_var2(), FLA_Trinv_l_unb_var3(), FLA_Trinv_l_unb_var4(), FLA_Trinv_u_unb_var1(), FLA_Trinv_u_unb_var2(), FLA_Trinv_u_unb_var3(), FLA_Trinv_u_unb_var4(), FLA_Trmm_llh_unb_var1(), FLA_Trmm_llh_unb_var2(), FLA_Trmm_llh_unb_var3(), FLA_Trmm_llh_unb_var4(), FLA_Trmm_lln_unb_var1(), FLA_Trmm_lln_unb_var2(), FLA_Trmm_lln_unb_var3(), FLA_Trmm_lln_unb_var4(), FLA_Trmm_llt_unb_var1(), FLA_Trmm_llt_unb_var2(), FLA_Trmm_llt_unb_var3(), FLA_Trmm_llt_unb_var4(), FLA_Trmm_luh_unb_var1(), FLA_Trmm_luh_unb_var2(), FLA_Trmm_luh_unb_var3(), FLA_Trmm_luh_unb_var4(), FLA_Trmm_lun_unb_var1(), FLA_Trmm_lun_unb_var2(), FLA_Trmm_lun_unb_var3(), FLA_Trmm_lun_unb_var4(), FLA_Trmm_lut_unb_var1(), FLA_Trmm_lut_unb_var2(), FLA_Trmm_lut_unb_var3(), FLA_Trmm_lut_unb_var4(), FLA_Trmm_rlh_unb_var1(), FLA_Trmm_rlh_unb_var2(), FLA_Trmm_rlh_unb_var3(), FLA_Trmm_rlh_unb_var4(), FLA_Trmm_rln_unb_var1(), FLA_Trmm_rln_unb_var2(), FLA_Trmm_rln_unb_var3(), FLA_Trmm_rln_unb_var4(), FLA_Trmm_rlt_unb_var1(), FLA_Trmm_rlt_unb_var2(), FLA_Trmm_rlt_unb_var3(), FLA_Trmm_rlt_unb_var4(), FLA_Trmm_ruh_unb_var1(), FLA_Trmm_ruh_unb_var2(), FLA_Trmm_ruh_unb_var3(), FLA_Trmm_ruh_unb_var4(), FLA_Trmm_run_unb_var1(), FLA_Trmm_run_unb_var2(), FLA_Trmm_run_unb_var3(), FLA_Trmm_run_unb_var4(), FLA_Trmm_rut_unb_var1(), FLA_Trmm_rut_unb_var2(), FLA_Trmm_rut_unb_var3(), FLA_Trmm_rut_unb_var4(), FLA_Trmmsx_external(), FLA_Trmvsx_external(), FLA_Trsm_llh_unb_var1(), FLA_Trsm_llh_unb_var2(), FLA_Trsm_llh_unb_var3(), FLA_Trsm_llh_unb_var4(), FLA_Trsm_lln_unb_var1(), FLA_Trsm_lln_unb_var2(), FLA_Trsm_lln_unb_var3(), FLA_Trsm_lln_unb_var4(), FLA_Trsm_llt_unb_var1(), FLA_Trsm_llt_unb_var2(), FLA_Trsm_llt_unb_var3(), FLA_Trsm_llt_unb_var4(), FLA_Trsm_luh_unb_var1(), FLA_Trsm_luh_unb_var2(), FLA_Trsm_luh_unb_var3(), FLA_Trsm_luh_unb_var4(), FLA_Trsm_lun_unb_var1(), FLA_Trsm_lun_unb_var2(), FLA_Trsm_lun_unb_var3(), FLA_Trsm_lun_unb_var4(), FLA_Trsm_lut_unb_var1(), FLA_Trsm_lut_unb_var2(), FLA_Trsm_lut_unb_var3(), FLA_Trsm_lut_unb_var4(), FLA_Trsm_rlh_unb_var1(), FLA_Trsm_rlh_unb_var2(), FLA_Trsm_rlh_unb_var3(), FLA_Trsm_rlh_unb_var4(), FLA_Trsm_rln_unb_var1(), FLA_Trsm_rln_unb_var2(), FLA_Trsm_rln_unb_var3(), FLA_Trsm_rln_unb_var4(), FLA_Trsm_rlt_unb_var1(), FLA_Trsm_rlt_unb_var2(), FLA_Trsm_rlt_unb_var3(), FLA_Trsm_rlt_unb_var4(), FLA_Trsm_ruh_unb_var1(), FLA_Trsm_ruh_unb_var2(), FLA_Trsm_ruh_unb_var3(), FLA_Trsm_ruh_unb_var4(), FLA_Trsm_run_unb_var1(), FLA_Trsm_run_unb_var2(), FLA_Trsm_run_unb_var3(), FLA_Trsm_run_unb_var4(), FLA_Trsm_rut_unb_var1(), FLA_Trsm_rut_unb_var2(), FLA_Trsm_rut_unb_var3(), FLA_Trsm_rut_unb_var4(), FLA_Trsmsx_external(), FLA_Trsvsx_external(), FLA_Ttmm_l_unb_var1(), FLA_Ttmm_l_unb_var2(), FLA_Ttmm_u_unb_var1(), and FLA_Ttmm_u_unb_var2().

00036 {
00037   FLA_Datatype datatype, dt_alpha;
00038   int          j, n_iter;
00039   int          num_elem;
00040   int          m_A, n_A, inc_A, ldim_A;
00041 
00042   if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING )
00043     FLA_Scal_check( alpha, A );
00044 
00045   if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS;
00046 
00047   if ( FLA_Obj_equals( alpha, FLA_ONE ) )
00048   {
00049     return FLA_SUCCESS;
00050   }
00051   else if ( FLA_Obj_equals( alpha, FLA_ZERO ) )
00052   {
00053     FLA_Obj_set_to_scalar( FLA_ZERO, A );
00054     return FLA_SUCCESS;
00055   }
00056 
00057   dt_alpha = FLA_Obj_datatype( alpha );
00058   datatype = FLA_Obj_datatype( A );
00059 
00060   m_A      = FLA_Obj_length( A );
00061   n_A      = FLA_Obj_width( A );
00062   ldim_A   = FLA_Obj_ldim( A );
00063 
00064   if ( FLA_Obj_is_vector( A ) )
00065   {
00066     inc_A    = ( m_A == 1 ? ldim_A : 1 );
00067     n_iter   = 1;
00068     num_elem = FLA_Obj_vector_dim( A );
00069   }
00070   else
00071   {
00072     inc_A    = 1;
00073     n_iter   = n_A;
00074     num_elem = m_A;
00075   }
00076 
00077   switch ( datatype ){
00078 
00079   case FLA_FLOAT:
00080   {
00081     float *buff_A     = ( float * ) FLA_FLOAT_PTR( A );
00082     float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha );
00083 
00084     for ( j = 0; j < n_iter; ++j )
00085     {
00086 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00087       cblas_sscal( num_elem,
00088                    *buff_alpha,
00089                    buff_A + j*ldim_A, inc_A );
00090 #else
00091       FLA_C2F( sscal )( &num_elem,
00092                         buff_alpha,
00093                         buff_A + j*ldim_A, &inc_A );
00094 #endif
00095     }
00096 
00097     break;
00098   }
00099 
00100   case FLA_DOUBLE:
00101   {
00102     double *buff_A     = ( double * ) FLA_DOUBLE_PTR( A );
00103     double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha );
00104 
00105     for ( j = 0; j < n_iter; ++j )
00106     {
00107 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00108       cblas_dscal( num_elem,
00109                    *buff_alpha,
00110                    buff_A + j*ldim_A, inc_A );
00111 #else
00112       FLA_C2F( dscal )( &num_elem,
00113                         buff_alpha,
00114                         buff_A + j*ldim_A, &inc_A );
00115 #endif
00116     }
00117 
00118     break;
00119   }
00120 
00121   case FLA_COMPLEX:
00122   {
00123     if ( dt_alpha == FLA_COMPLEX )
00124     {
00125       scomplex *buff_A     = ( scomplex * ) FLA_COMPLEX_PTR( A );
00126       scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha );
00127 
00128       for ( j = 0; j < n_iter; ++j )
00129       {
00130 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00131         cblas_cscal( num_elem,
00132                      *buff_alpha,
00133                      buff_A + j*ldim_A, inc_A );
00134 #else
00135         FLA_C2F( cscal )( &num_elem,
00136                           buff_alpha,
00137                           buff_A + j*ldim_A, &inc_A );
00138 #endif
00139       }
00140     }
00141     else if ( dt_alpha == FLA_FLOAT )
00142     {
00143       scomplex *buff_A     = ( scomplex * ) FLA_FLOAT_PTR( A );
00144       float    *buff_alpha = ( float    * ) FLA_FLOAT_PTR( alpha );
00145 
00146       for ( j = 0; j < n_iter; ++j )
00147       {
00148 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00149         cblas_csscal( num_elem,
00150                       *buff_alpha,
00151                       buff_A + j*ldim_A, inc_A );
00152 #else
00153         FLA_C2F( csscal )( &num_elem,
00154                            buff_alpha,
00155                            buff_A + j*ldim_A, &inc_A );
00156 #endif
00157       }
00158     }
00159 
00160     break;
00161   }
00162 
00163   case FLA_DOUBLE_COMPLEX:
00164   {
00165     if ( dt_alpha == FLA_DOUBLE_COMPLEX )
00166     {
00167       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00168       dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha );
00169 
00170       for ( j = 0; j < n_iter; ++j )
00171       {
00172 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00173         cblas_zscal( num_elem,
00174                      *buff_alpha,
00175                      buff_A + j*ldim_A, inc_A );
00176 #else
00177         FLA_C2F( zscal )( &num_elem,
00178                           buff_alpha,
00179                           buff_A + j*ldim_A, &inc_A );
00180 #endif
00181       }
00182     }
00183     else if ( dt_alpha == FLA_DOUBLE )
00184     {
00185       dcomplex *buff_A     = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A );
00186       double   *buff_alpha = ( double   * ) FLA_DOUBLE_PTR( alpha );
00187 
00188       for ( j = 0; j < n_iter; ++j )
00189       {
00190 #ifdef FLA_ENABLE_CBLAS_INTERFACE
00191         cblas_zdscal( num_elem,
00192                       *buff_alpha,
00193                       buff_A + j*ldim_A, inc_A );
00194 #else
00195         FLA_C2F( zdscal )( &num_elem,
00196                            buff_alpha,
00197                            buff_A + j*ldim_A, &inc_A );
00198 #endif
00199       }
00200     }
00201 
00202     break;
00203   }
00204 
00205   }
00206 
00207   return FLA_SUCCESS;
00208 }

void FLA_F2C() fla_scal_external_f ( F_INT *  alpha,
F_INT *  A,
F_INT *  IERROR 
)

References FLA_Scal_external().

00212 {
00213   *IERROR = FLA_Scal_external( *( ( FLA_Obj * ) alpha ),
00214                                *( ( FLA_Obj * ) A     ) );
00215 }


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