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) |
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 }