Functions | |
FLA_Error | FLA_Scalc_external (FLA_Conj conjalpha, FLA_Obj alpha, FLA_Obj A) |
void FLA_F2C() | fla_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_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_set_to_scalar(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_ONE, FLA_Scalc_check(), FLA_ZERO, dcomplex::imag, scomplex::imag, sscal(), zdscal(), and zscal().
Referenced by FLA_Scalc(), fla_scalc_external_f(), FLA_Trmm_llh_unb_var1(), FLA_Trmm_llh_unb_var2(), FLA_Trmm_luh_unb_var1(), FLA_Trmm_luh_unb_var2(), FLA_Trmm_rlh_unb_var1(), FLA_Trmm_rlh_unb_var2(), FLA_Trmm_ruh_unb_var1(), and FLA_Trmm_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_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_ZERO ) ) 00052 { 00053 FLA_Obj_set_to_scalar( FLA_ZERO, A ); 00054 return FLA_SUCCESS; 00055 } 00056 else if ( FLA_Obj_equals( alpha, FLA_MINUS_ONE ) ) 00057 { 00058 FLA_Negate( A ); 00059 return FLA_SUCCESS; 00060 } 00061 00062 dt_alpha = FLA_Obj_datatype( alpha ); 00063 datatype = FLA_Obj_datatype( A ); 00064 00065 m_A = FLA_Obj_length( A ); 00066 n_A = FLA_Obj_width( A ); 00067 ldim_A = FLA_Obj_ldim( A ); 00068 00069 if ( FLA_Obj_is_vector( A ) ) 00070 { 00071 inc_A = ( m_A == 1 ? ldim_A : 1 ); 00072 n_iter = 1; 00073 num_elem = FLA_Obj_vector_dim( A ); 00074 } 00075 else 00076 { 00077 inc_A = 1; 00078 n_iter = n_A; 00079 num_elem = m_A; 00080 } 00081 00082 00083 switch ( datatype ){ 00084 00085 case FLA_FLOAT: 00086 { 00087 float *buff_A = ( float * ) FLA_FLOAT_PTR( A ); 00088 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); 00089 00090 for ( j = 0; j < n_iter; ++j ) 00091 { 00092 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00093 cblas_sscal( num_elem, 00094 *buff_alpha, 00095 buff_A + j*ldim_A, inc_A ); 00096 #else 00097 FLA_C2F( sscal )( &num_elem, 00098 buff_alpha, 00099 buff_A + j*ldim_A, &inc_A ); 00100 #endif 00101 } 00102 00103 break; 00104 } 00105 00106 case FLA_DOUBLE: 00107 { 00108 double *buff_A = ( double * ) FLA_DOUBLE_PTR( A ); 00109 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00110 00111 for ( j = 0; j < n_iter; ++j ) 00112 { 00113 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00114 cblas_dscal( num_elem, 00115 *buff_alpha, 00116 buff_A + j*ldim_A, inc_A ); 00117 #else 00118 FLA_C2F( dscal )( &num_elem, 00119 buff_alpha, 00120 buff_A + j*ldim_A, &inc_A ); 00121 #endif 00122 } 00123 00124 break; 00125 } 00126 00127 case FLA_COMPLEX: 00128 { 00129 if ( dt_alpha == FLA_COMPLEX ) 00130 { 00131 scomplex *buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00132 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); 00133 scomplex temp_alpha = *buff_alpha; 00134 00135 if ( conjalpha == FLA_CONJUGATE ) 00136 temp_alpha.imag *= -1.0F; 00137 00138 for ( j = 0; j < n_iter; ++j ) 00139 { 00140 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00141 cblas_cscal( num_elem, 00142 &temp_alpha, 00143 buff_A + j*ldim_A, inc_A ); 00144 #else 00145 FLA_C2F( cscal )( &num_elem, 00146 &temp_alpha, 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 00156 for ( j = 0; j < n_iter; ++j ) 00157 { 00158 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00159 cblas_csscal( num_elem, 00160 *buff_alpha, 00161 buff_A + j*ldim_A, inc_A ); 00162 #else 00163 FLA_C2F( csscal )( &num_elem, 00164 buff_alpha, 00165 buff_A + j*ldim_A, &inc_A ); 00166 #endif 00167 } 00168 } 00169 00170 break; 00171 } 00172 00173 case FLA_DOUBLE_COMPLEX: 00174 { 00175 if ( dt_alpha == FLA_DOUBLE_COMPLEX ) 00176 { 00177 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00178 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); 00179 dcomplex temp_alpha = *buff_alpha; 00180 00181 if ( conjalpha == FLA_CONJUGATE ) 00182 temp_alpha.imag *= -1.0; 00183 00184 for ( j = 0; j < n_iter; ++j ) 00185 { 00186 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00187 cblas_zscal( num_elem, 00188 &temp_alpha, 00189 buff_A + j*ldim_A, inc_A ); 00190 #else 00191 FLA_C2F( zscal )( &num_elem, 00192 &temp_alpha, 00193 buff_A + j*ldim_A, &inc_A ); 00194 #endif 00195 } 00196 } 00197 else if ( dt_alpha == FLA_DOUBLE ) 00198 { 00199 dcomplex *buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00200 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00201 00202 for ( j = 0; j < n_iter; ++j ) 00203 { 00204 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00205 cblas_zdscal( num_elem, 00206 *buff_alpha, 00207 buff_A + j*ldim_A, inc_A ); 00208 #else 00209 FLA_C2F( zdscal )( &num_elem, 00210 buff_alpha, 00211 buff_A + j*ldim_A, &inc_A ); 00212 #endif 00213 } 00214 } 00215 00216 break; 00217 } 00218 00219 } 00220 00221 return FLA_SUCCESS; 00222 }
void FLA_F2C() fla_scalc_external_f | ( | F_INT * | conjalpha, | |
F_INT * | alpha, | |||
F_INT * | A, | |||
F_INT * | IERROR | |||
) |
References FLA_Scalc_external().
00226 { 00227 *IERROR = FLA_Scalc_external( *( ( FLA_Conj * ) conjalpha ), 00228 *( ( FLA_Obj * ) alpha ), 00229 *( ( FLA_Obj * ) A ) ); 00230 }