Functions | |
FLA_Error | FLA_Inv_scalc_external (FLA_Conj conjalpha, FLA_Obj alpha, FLA_Obj A) |
void FLA_F2C() | fla_inv_scalc_external_f (F_INT *conjalpha, 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_scalc_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_Apply_househ2_UT(), FLA_Inv_scalc(), fla_inv_scalc_external_f(), FLA_Trsm_llh_unb_var1(), FLA_Trsm_llh_unb_var2(), FLA_Trsm_luh_unb_var1(), FLA_Trsm_luh_unb_var2(), FLA_Trsm_rlh_unb_var1(), FLA_Trsm_rlh_unb_var2(), FLA_Trsm_ruh_unb_var1(), and FLA_Trsm_ruh_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_scalc_check( conjalpha, 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 if ( conjalpha == FLA_CONJUGATE ) 00136 { 00137 alpha_inv.real = buff_alpha->real * temp; 00138 alpha_inv.imag = buff_alpha->imag * temp; 00139 } 00140 else 00141 { 00142 alpha_inv.real = buff_alpha->real * temp; 00143 alpha_inv.imag = buff_alpha->imag * -temp; 00144 } 00145 00146 for ( j = 0; j < n_iter; ++j ) 00147 { 00148 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00149 cblas_cscal( num_elem, 00150 alpha_inv, 00151 buff_A + j*ldim_A, inc_A ); 00152 #else 00153 FLA_C2F( cscal )( &num_elem, 00154 &alpha_inv, 00155 buff_A + j*ldim_A, &inc_A ); 00156 #endif 00157 } 00158 } 00159 else if ( dt_alpha == FLA_FLOAT ) 00160 { 00161 scomplex *buff_A = ( scomplex * ) FLA_FLOAT_PTR( A ); 00162 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); 00163 float alpha_inv = 1.0F / (*buff_alpha); 00164 00165 for ( j = 0; j < n_iter; ++j ) 00166 { 00167 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00168 cblas_csscal( num_elem, 00169 alpha_inv, 00170 buff_A + j*ldim_A, inc_A ); 00171 #else 00172 FLA_C2F( csscal )( &num_elem, 00173 &alpha_inv, 00174 buff_A + j*ldim_A, &inc_A ); 00175 #endif 00176 } 00177 } 00178 00179 break; 00180 } 00181 00182 case FLA_DOUBLE_COMPLEX: 00183 { 00184 if ( dt_alpha == FLA_DOUBLE_COMPLEX ) 00185 { 00186 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00187 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); 00188 dcomplex alpha_inv; 00189 double temp; 00190 00191 temp = 1.0 / ( buff_alpha->real * buff_alpha->real + 00192 buff_alpha->imag * buff_alpha->imag ); 00193 00194 if ( conjalpha == FLA_CONJUGATE ) 00195 { 00196 alpha_inv.real = buff_alpha->real * temp; 00197 alpha_inv.imag = buff_alpha->imag * temp; 00198 } 00199 else 00200 { 00201 alpha_inv.real = buff_alpha->real * temp; 00202 alpha_inv.imag = buff_alpha->imag * -temp; 00203 } 00204 00205 for ( j = 0; j < n_iter; ++j ) 00206 { 00207 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00208 cblas_zscal( num_elem, 00209 alpha_inv, 00210 buff_A + j*ldim_A, inc_A ); 00211 #else 00212 FLA_C2F( zscal )( &num_elem, 00213 &alpha_inv, 00214 buff_A + j*ldim_A, &inc_A ); 00215 #endif 00216 } 00217 } 00218 else if ( dt_alpha == FLA_DOUBLE ) 00219 { 00220 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00221 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00222 double alpha_inv = 1.0 / (*buff_alpha); 00223 00224 for ( j = 0; j < n_iter; ++j ) 00225 { 00226 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00227 cblas_zdscal( num_elem, 00228 alpha_inv, 00229 buff_A + j*ldim_A, inc_A ); 00230 #else 00231 FLA_C2F( zdscal )( &num_elem, 00232 &alpha_inv, 00233 buff_A + j*ldim_A, &inc_A ); 00234 #endif 00235 } 00236 } 00237 00238 break; 00239 } 00240 00241 } 00242 00243 return FLA_SUCCESS; 00244 }
void FLA_F2C() fla_inv_scalc_external_f | ( | F_INT * | conjalpha, | |
F_INT * | alpha, | |||
F_INT * | A, | |||
F_INT * | IERROR | |||
) |
References FLA_Inv_scalc_external().
00248 { 00249 *IERROR = FLA_Inv_scalc_external( *( ( FLA_Conj * ) conjalpha ), 00250 *( ( FLA_Obj * ) alpha ), 00251 *( ( FLA_Obj * ) A ) ); 00252 }