Functions | |
FLA_Error | FLA_Scalr_external (FLA_Uplo uplo, FLA_Obj alpha, FLA_Obj A) |
void FLA_F2C() | fla_scalr_external_f (F_INT *uplo, 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_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_width(), FLA_Scalr_check(), sscal(), zdscal(), and zscal().
Referenced by FLA_Her2k_lh_unb_var10(), FLA_Her2k_lh_unb_var9(), FLA_Her2k_ln_unb_var10(), FLA_Her2k_ln_unb_var9(), FLA_Her2k_uh_unb_var10(), FLA_Her2k_uh_unb_var9(), FLA_Her2k_un_unb_var10(), FLA_Her2k_un_unb_var9(), FLA_Herk_lh_unb_var1(), FLA_Herk_lh_unb_var2(), FLA_Herk_lh_unb_var3(), FLA_Herk_lh_unb_var4(), FLA_Herk_lh_unb_var5(), FLA_Herk_lh_unb_var6(), FLA_Herk_ln_unb_var1(), FLA_Herk_ln_unb_var2(), FLA_Herk_ln_unb_var3(), FLA_Herk_ln_unb_var4(), FLA_Herk_ln_unb_var5(), FLA_Herk_ln_unb_var6(), FLA_Herk_uh_unb_var1(), FLA_Herk_uh_unb_var2(), FLA_Herk_uh_unb_var3(), FLA_Herk_uh_unb_var4(), FLA_Herk_uh_unb_var5(), FLA_Herk_uh_unb_var6(), FLA_Herk_un_unb_var1(), FLA_Herk_un_unb_var2(), FLA_Herk_un_unb_var3(), FLA_Herk_un_unb_var4(), FLA_Herk_un_unb_var5(), FLA_Herk_un_unb_var6(), FLA_Scalr(), fla_scalr_external_f(), FLA_Syr2k_ln_unb_var10(), FLA_Syr2k_ln_unb_var9(), FLA_Syr2k_lt_unb_var10(), FLA_Syr2k_lt_unb_var9(), FLA_Syr2k_un_unb_var10(), FLA_Syr2k_un_unb_var9(), FLA_Syr2k_ut_unb_var10(), FLA_Syr2k_ut_unb_var9(), FLA_Syrk_ln_unb_var1(), FLA_Syrk_ln_unb_var2(), FLA_Syrk_ln_unb_var3(), FLA_Syrk_ln_unb_var4(), FLA_Syrk_ln_unb_var5(), FLA_Syrk_ln_unb_var6(), FLA_Syrk_lt_unb_var1(), FLA_Syrk_lt_unb_var2(), FLA_Syrk_lt_unb_var3(), FLA_Syrk_lt_unb_var4(), FLA_Syrk_lt_unb_var5(), FLA_Syrk_lt_unb_var6(), FLA_Syrk_un_unb_var1(), FLA_Syrk_un_unb_var2(), FLA_Syrk_un_unb_var3(), FLA_Syrk_un_unb_var4(), FLA_Syrk_un_unb_var5(), FLA_Syrk_un_unb_var6(), FLA_Syrk_ut_unb_var1(), FLA_Syrk_ut_unb_var2(), FLA_Syrk_ut_unb_var3(), FLA_Syrk_ut_unb_var4(), FLA_Syrk_ut_unb_var5(), and FLA_Syrk_ut_unb_var6().
00036 { 00037 FLA_Datatype datatype, dt_alpha; 00038 int j, i_one = 1; 00039 int num_elem; 00040 int n_A, ldim_A; 00041 00042 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 00043 FLA_Scalr_check( uplo, alpha, A ); 00044 00045 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; 00046 00047 dt_alpha = FLA_Obj_datatype( alpha ); 00048 datatype = FLA_Obj_datatype( A ); 00049 00050 n_A = FLA_Obj_width( A ); 00051 ldim_A = FLA_Obj_ldim( A ); 00052 00053 switch ( datatype ){ 00054 00055 case FLA_FLOAT: 00056 { 00057 float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); 00058 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); 00059 00060 if ( uplo == FLA_LOWER_TRIANGULAR ) 00061 { 00062 for ( j = 0; j < n_A; ++j ) 00063 { 00064 num_elem = n_A - j; 00065 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00066 cblas_sscal( num_elem, 00067 *buff_alpha, 00068 buff_A + j*ldim_A + j, i_one ); 00069 #else 00070 FLA_C2F( sscal )( &num_elem, 00071 buff_alpha, 00072 buff_A + j*ldim_A + j, &i_one ); 00073 #endif 00074 } 00075 } 00076 else 00077 { 00078 for ( j = 0; j < n_A; ++j ) 00079 { 00080 num_elem = j + 1; 00081 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00082 cblas_sscal( num_elem, 00083 *buff_alpha, 00084 buff_A + j*ldim_A, i_one ); 00085 #else 00086 FLA_C2F( sscal )( &num_elem, 00087 buff_alpha, 00088 buff_A + j*ldim_A, &i_one ); 00089 #endif 00090 } 00091 } 00092 00093 break; 00094 } 00095 00096 case FLA_DOUBLE: 00097 { 00098 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); 00099 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00100 00101 if ( uplo == FLA_LOWER_TRIANGULAR ) 00102 { 00103 for ( j = 0; j < n_A; ++j ) 00104 { 00105 num_elem = n_A - j; 00106 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00107 cblas_dscal( num_elem, 00108 *buff_alpha, 00109 buff_A + j*ldim_A + j, i_one ); 00110 #else 00111 FLA_C2F( dscal )( &num_elem, 00112 buff_alpha, 00113 buff_A + j*ldim_A + j, &i_one ); 00114 #endif 00115 } 00116 } 00117 else 00118 { 00119 for ( j = 0; j < n_A; ++j ) 00120 { 00121 num_elem = j + 1; 00122 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00123 cblas_dscal( num_elem, 00124 *buff_alpha, 00125 buff_A + j*ldim_A, i_one ); 00126 #else 00127 FLA_C2F( dscal )( &num_elem, 00128 buff_alpha, 00129 buff_A + j*ldim_A, &i_one ); 00130 #endif 00131 } 00132 } 00133 00134 break; 00135 } 00136 00137 case FLA_COMPLEX: 00138 { 00139 if ( dt_alpha == FLA_COMPLEX ) 00140 { 00141 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00142 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); 00143 00144 if ( uplo == FLA_LOWER_TRIANGULAR ) 00145 { 00146 for ( j = 0; j < n_A; ++j ) 00147 { 00148 num_elem = n_A - j; 00149 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00150 cblas_cscal( num_elem, 00151 buff_alpha, 00152 buff_A + j*ldim_A + j, i_one ); 00153 #else 00154 FLA_C2F( cscal )( &num_elem, 00155 buff_alpha, 00156 buff_A + j*ldim_A + j, &i_one ); 00157 #endif 00158 } 00159 } 00160 else 00161 { 00162 for ( j = 0; j < n_A; ++j ) 00163 { 00164 num_elem = j + 1; 00165 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00166 cblas_cscal( num_elem, 00167 buff_alpha, 00168 buff_A + j*ldim_A, i_one ); 00169 #else 00170 FLA_C2F( cscal )( &num_elem, 00171 buff_alpha, 00172 buff_A + j*ldim_A, &i_one ); 00173 #endif 00174 } 00175 } 00176 } 00177 else if ( dt_alpha == FLA_FLOAT ) 00178 { 00179 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00180 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); 00181 00182 if ( uplo == FLA_LOWER_TRIANGULAR ) 00183 { 00184 for ( j = 0; j < n_A; ++j ) 00185 { 00186 num_elem = n_A - j; 00187 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00188 cblas_csscal( num_elem, 00189 *buff_alpha, 00190 buff_A + j*ldim_A + j, i_one ); 00191 #else 00192 FLA_C2F( csscal )( &num_elem, 00193 buff_alpha, 00194 buff_A + j*ldim_A + j, &i_one ); 00195 #endif 00196 } 00197 } 00198 else 00199 { 00200 for ( j = 0; j < n_A; ++j ) 00201 { 00202 num_elem = j + 1; 00203 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00204 cblas_csscal( num_elem, 00205 *buff_alpha, 00206 buff_A + j*ldim_A, i_one ); 00207 #else 00208 FLA_C2F( csscal )( &num_elem, 00209 buff_alpha, 00210 buff_A + j*ldim_A, &i_one ); 00211 #endif 00212 } 00213 } 00214 } 00215 00216 break; 00217 } 00218 00219 case FLA_DOUBLE_COMPLEX: 00220 { 00221 if ( dt_alpha == FLA_DOUBLE_COMPLEX ) 00222 { 00223 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00224 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); 00225 00226 if ( uplo == FLA_LOWER_TRIANGULAR ) 00227 { 00228 for ( j = 0; j < n_A; ++j ) 00229 { 00230 num_elem = n_A - j; 00231 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00232 cblas_zscal( num_elem, 00233 buff_alpha, 00234 buff_A + j*ldim_A + j, i_one ); 00235 #else 00236 FLA_C2F( zscal )( &num_elem, 00237 buff_alpha, 00238 buff_A + j*ldim_A + j, &i_one ); 00239 #endif 00240 } 00241 } 00242 else 00243 { 00244 for ( j = 0; j < n_A; ++j ) 00245 { 00246 num_elem = j + 1; 00247 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00248 cblas_zscal( num_elem, 00249 buff_alpha, 00250 buff_A + j*ldim_A, i_one ); 00251 #else 00252 FLA_C2F( zscal )( &num_elem, 00253 buff_alpha, 00254 buff_A + j*ldim_A, &i_one ); 00255 #endif 00256 } 00257 } 00258 } 00259 else if ( dt_alpha == FLA_DOUBLE ) 00260 { 00261 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00262 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00263 00264 if ( uplo == FLA_LOWER_TRIANGULAR ) 00265 { 00266 for ( j = 0; j < n_A; ++j ) 00267 { 00268 num_elem = n_A - j; 00269 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00270 cblas_zdscal( num_elem, 00271 *buff_alpha, 00272 buff_A + j*ldim_A + j, i_one ); 00273 #else 00274 FLA_C2F( zdscal )( &num_elem, 00275 buff_alpha, 00276 buff_A + j*ldim_A + j, &i_one ); 00277 #endif 00278 } 00279 } 00280 else 00281 { 00282 for ( j = 0; j < n_A; ++j ) 00283 { 00284 num_elem = j + 1; 00285 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00286 cblas_zdscal( num_elem, 00287 *buff_alpha, 00288 buff_A + j*ldim_A, i_one ); 00289 #else 00290 FLA_C2F( zdscal )( &num_elem, 00291 buff_alpha, 00292 buff_A + j*ldim_A, &i_one ); 00293 #endif 00294 } 00295 } 00296 } 00297 00298 break; 00299 } 00300 00301 } 00302 00303 return FLA_SUCCESS; 00304 }
void FLA_F2C() fla_scalr_external_f | ( | F_INT * | uplo, | |
F_INT * | alpha, | |||
F_INT * | A, | |||
F_INT * | IERROR | |||
) |
References FLA_Scalr_external().
00308 { 00309 *IERROR = FLA_Scalr_external( *( ( FLA_Uplo * ) uplo ), 00310 *( ( FLA_Obj * ) alpha ), 00311 *( ( FLA_Obj * ) A ) ); 00312 }