Functions | |
FLA_Error | FLA_Inv_scal_external (FLA_Obj alpha, FLA_Obj A) |
void FLA_F2C() | fla_inv_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_Inv_scal_check(), FLA_MINUS_ONE, FLA_Negate(), FLA_Obj_datatype(), FLA_Obj_equals(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_ONE, dcomplex::imag, scomplex::imag, dcomplex::real, scomplex::real, sscal(), zdscal(), and zscal().
Referenced by FLA_Chol_l_unb_var2(), FLA_Chol_l_unb_var3(), FLA_Chol_u_unb_var2(), FLA_Chol_u_unb_var3(), FLA_Inv_scal(), fla_inv_scal_external_f(), FLA_LU_nopiv_unb_var3(), FLA_LU_nopiv_unb_var4(), FLA_LU_nopiv_unb_var5(), FLA_LU_piv_unb_var3(), FLA_LU_piv_unb_var3b(), FLA_LU_piv_unb_var4(), FLA_LU_piv_unb_var5(), FLA_Trsm_lln_unb_var1(), FLA_Trsm_lln_unb_var2(), FLA_Trsm_llt_unb_var1(), FLA_Trsm_llt_unb_var2(), FLA_Trsm_lun_unb_var1(), FLA_Trsm_lun_unb_var2(), FLA_Trsm_lut_unb_var1(), FLA_Trsm_lut_unb_var2(), FLA_Trsm_rln_unb_var1(), FLA_Trsm_rln_unb_var2(), FLA_Trsm_rlt_unb_var1(), FLA_Trsm_rlt_unb_var2(), FLA_Trsm_run_unb_var1(), FLA_Trsm_run_unb_var2(), FLA_Trsm_rut_unb_var1(), and FLA_Trsm_rut_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_Inv_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_MINUS_ONE ) ) 00052 { 00053 FLA_Negate( 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 float alpha_inv = 1.0F / (*buff_alpha); 00084 00085 for ( j = 0; j < n_iter; ++j ) 00086 { 00087 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00088 cblas_sscal( num_elem, 00089 alpha_inv, 00090 buff_A + j*ldim_A, inc_A ); 00091 #else 00092 FLA_C2F( sscal )( &num_elem, 00093 &alpha_inv, 00094 buff_A + j*ldim_A, &inc_A ); 00095 #endif 00096 } 00097 00098 break; 00099 } 00100 00101 case FLA_DOUBLE: 00102 { 00103 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); 00104 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00105 double alpha_inv = 1.0 / (*buff_alpha); 00106 00107 for ( j = 0; j < n_iter; ++j ) 00108 { 00109 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00110 cblas_dscal( num_elem, 00111 alpha_inv, 00112 buff_A + j*ldim_A, inc_A ); 00113 #else 00114 FLA_C2F( dscal )( &num_elem, 00115 &alpha_inv, 00116 buff_A + j*ldim_A, &inc_A ); 00117 #endif 00118 } 00119 00120 break; 00121 } 00122 00123 case FLA_COMPLEX: 00124 { 00125 if ( dt_alpha == FLA_COMPLEX ) 00126 { 00127 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00128 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); 00129 scomplex alpha_inv; 00130 float temp; 00131 00132 temp = 1.0F / ( buff_alpha->real * buff_alpha->real + 00133 buff_alpha->imag * buff_alpha->imag ); 00134 00135 alpha_inv.real = buff_alpha->real * temp; 00136 alpha_inv.imag = buff_alpha->imag * -temp; 00137 00138 for ( j = 0; j < n_iter; ++j ) 00139 { 00140 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00141 cblas_cscal( num_elem, 00142 alpha_inv, 00143 buff_A + j*ldim_A, inc_A ); 00144 #else 00145 FLA_C2F( cscal )( &num_elem, 00146 &alpha_inv, 00147 buff_A + j*ldim_A, &inc_A ); 00148 #endif 00149 } 00150 } 00151 else if ( dt_alpha == FLA_FLOAT ) 00152 { 00153 scomplex *buff_A = ( scomplex * ) FLA_FLOAT_PTR( A ); 00154 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); 00155 float alpha_inv = 1.0F / (*buff_alpha); 00156 00157 for ( j = 0; j < n_iter; ++j ) 00158 { 00159 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00160 cblas_csscal( num_elem, 00161 alpha_inv, 00162 buff_A + j*ldim_A, inc_A ); 00163 #else 00164 FLA_C2F( csscal )( &num_elem, 00165 &alpha_inv, 00166 buff_A + j*ldim_A, &inc_A ); 00167 #endif 00168 } 00169 } 00170 00171 break; 00172 } 00173 00174 case FLA_DOUBLE_COMPLEX: 00175 { 00176 if ( dt_alpha == FLA_DOUBLE_COMPLEX ) 00177 { 00178 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00179 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); 00180 dcomplex alpha_inv; 00181 double temp; 00182 00183 temp = 1.0 / ( buff_alpha->real * buff_alpha->real + 00184 buff_alpha->imag * buff_alpha->imag ); 00185 00186 alpha_inv.real = buff_alpha->real * temp; 00187 alpha_inv.imag = buff_alpha->imag * -temp; 00188 00189 for ( j = 0; j < n_iter; ++j ) 00190 { 00191 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00192 cblas_zscal( num_elem, 00193 alpha_inv, 00194 buff_A + j*ldim_A, inc_A ); 00195 #else 00196 FLA_C2F( zscal )( &num_elem, 00197 &alpha_inv, 00198 buff_A + j*ldim_A, &inc_A ); 00199 #endif 00200 } 00201 } 00202 else if ( dt_alpha == FLA_DOUBLE ) 00203 { 00204 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00205 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00206 double alpha_inv = 1.0 / (*buff_alpha); 00207 00208 for ( j = 0; j < n_iter; ++j ) 00209 { 00210 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00211 cblas_zdscal( num_elem, 00212 alpha_inv, 00213 buff_A + j*ldim_A, inc_A ); 00214 #else 00215 FLA_C2F( zdscal )( &num_elem, 00216 &alpha_inv, 00217 buff_A + j*ldim_A, &inc_A ); 00218 #endif 00219 } 00220 } 00221 00222 break; 00223 } 00224 00225 } 00226 00227 return FLA_SUCCESS; 00228 }
void FLA_F2C() fla_inv_scal_external_f | ( | F_INT * | alpha, | |
F_INT * | A, | |||
F_INT * | IERROR | |||
) |
References FLA_Inv_scal_external().
00232 { 00233 *IERROR = FLA_Inv_scal_external( *( ( FLA_Obj * ) alpha ), 00234 *( ( FLA_Obj * ) A ) ); 00235 }