Functions | |
FLA_Error | FLA_Dot2cs_external (FLA_Conj conj, FLA_Obj alpha, FLA_Obj x, FLA_Obj y, FLA_Obj beta, FLA_Obj rho) |
void FLA_F2C() | fla_dot2cs_external_f (F_INT *conj, F_INT *alpha, F_INT *x, F_INT *y, F_INT *beta, F_INT *rho, F_INT *IERROR) |
FLA_Error FLA_Dot2cs_external | ( | FLA_Conj | conj, | |
FLA_Obj | alpha, | |||
FLA_Obj | x, | |||
FLA_Obj | y, | |||
FLA_Obj | beta, | |||
FLA_Obj | rho | |||
) |
References cblas_cdotc_sub(), cblas_cdotu_sub(), cblas_ddot(), cblas_sdot(), cblas_zdotc_sub(), cblas_zdotu_sub(), ddot(), fla_cdotc(), fla_cdotu(), FLA_Check_error_level(), FLA_Dot2cs_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Scal_external(), fla_zdotc(), fla_zdotu(), dcomplex::imag, scomplex::imag, dcomplex::real, scomplex::real, and sdot().
Referenced by FLA_Dot2cs(), fla_dot2cs_external_f(), FLA_Her2k_lh_unb_var1(), FLA_Her2k_lh_unb_var2(), FLA_Her2k_lh_unb_var3(), FLA_Her2k_lh_unb_var4(), FLA_Her2k_lh_unb_var5(), FLA_Her2k_lh_unb_var6(), FLA_Her2k_lh_unb_var7(), FLA_Her2k_lh_unb_var8(), FLA_Her2k_ln_unb_var1(), FLA_Her2k_ln_unb_var2(), FLA_Her2k_ln_unb_var3(), FLA_Her2k_ln_unb_var4(), FLA_Her2k_ln_unb_var5(), FLA_Her2k_ln_unb_var6(), FLA_Her2k_ln_unb_var7(), FLA_Her2k_ln_unb_var8(), FLA_Her2k_uh_unb_var1(), FLA_Her2k_uh_unb_var2(), FLA_Her2k_uh_unb_var3(), FLA_Her2k_uh_unb_var4(), FLA_Her2k_uh_unb_var5(), FLA_Her2k_uh_unb_var6(), FLA_Her2k_uh_unb_var7(), FLA_Her2k_uh_unb_var8(), FLA_Her2k_un_unb_var1(), FLA_Her2k_un_unb_var2(), FLA_Her2k_un_unb_var3(), FLA_Her2k_un_unb_var4(), FLA_Her2k_un_unb_var5(), FLA_Her2k_un_unb_var6(), FLA_Her2k_un_unb_var7(), and FLA_Her2k_un_unb_var8().
00036 { 00037 FLA_Datatype datatype; 00038 int num_elem; 00039 int m_x, inc_x, ldim_x; 00040 int m_y, inc_y, ldim_y; 00041 00042 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 00043 FLA_Dot2cs_check( conj, alpha, x, y, beta, rho ); 00044 00045 if ( FLA_Obj_has_zero_dim( x ) ) 00046 { 00047 FLA_Scal_external( beta, rho ); 00048 return FLA_SUCCESS; 00049 } 00050 00051 datatype = FLA_Obj_datatype( x ); 00052 00053 m_x = FLA_Obj_length( x ); 00054 ldim_x = FLA_Obj_ldim( x ); 00055 00056 m_y = FLA_Obj_length( y ); 00057 ldim_y = FLA_Obj_ldim( y ); 00058 00059 inc_x = ( m_x == 1 ? ldim_x : 1 ); 00060 inc_y = ( m_y == 1 ? ldim_y : 1 ); 00061 num_elem = FLA_Obj_vector_dim( x ); 00062 00063 00064 switch ( datatype ){ 00065 00066 case FLA_FLOAT: 00067 { 00068 float *buff_x = ( float * ) FLA_FLOAT_PTR( x ); 00069 float *buff_y = ( float * ) FLA_FLOAT_PTR( y ); 00070 float *buff_rho = ( float * ) FLA_FLOAT_PTR( rho ); 00071 float *buff_alpha = ( float * ) FLA_FLOAT_PTR( alpha ); 00072 float *buff_beta = ( float * ) FLA_FLOAT_PTR( beta ); 00073 float temp; 00074 00075 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00076 temp = cblas_sdot( num_elem, 00077 buff_x, inc_x, 00078 buff_y, inc_y ); 00079 #else 00080 temp = FLA_C2F( sdot ) ( &num_elem, 00081 buff_x, &inc_x, 00082 buff_y, &inc_y ); 00083 #endif 00084 00085 *buff_rho = 2.0F * (*buff_alpha) * temp + (*buff_beta) * (*buff_rho); 00086 00087 break; 00088 } 00089 00090 case FLA_DOUBLE: 00091 { 00092 double *buff_x = ( double * ) FLA_DOUBLE_PTR( x ); 00093 double *buff_y = ( double * ) FLA_DOUBLE_PTR( y ); 00094 double *buff_rho = ( double * ) FLA_DOUBLE_PTR( rho ); 00095 double *buff_alpha = ( double * ) FLA_DOUBLE_PTR( alpha ); 00096 double *buff_beta = ( double * ) FLA_DOUBLE_PTR( beta ); 00097 double temp; 00098 00099 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00100 temp = cblas_ddot( num_elem, 00101 buff_x, inc_x, 00102 buff_y, inc_y ); 00103 #else 00104 temp = FLA_C2F( ddot ) ( &num_elem, 00105 buff_x, &inc_x, 00106 buff_y, &inc_y ); 00107 #endif 00108 00109 *buff_rho = 2.0 * (*buff_alpha) * temp + (*buff_beta) * (*buff_rho); 00110 00111 break; 00112 } 00113 00114 case FLA_COMPLEX: 00115 { 00116 scomplex *buff_x = ( scomplex * ) FLA_COMPLEX_PTR( x ); 00117 scomplex *buff_y = ( scomplex * ) FLA_COMPLEX_PTR( y ); 00118 scomplex *buff_rho = ( scomplex * ) FLA_COMPLEX_PTR( rho ); 00119 scomplex *buff_alpha = ( scomplex * ) FLA_COMPLEX_PTR( alpha ); 00120 scomplex *buff_beta = ( scomplex * ) FLA_COMPLEX_PTR( beta ); 00121 scomplex temp, temp2, alphac, temp_rho; 00122 00123 alphac = *buff_alpha; 00124 alphac.imag *= -1.0F; 00125 00126 if ( conj == FLA_NO_CONJUGATE ) 00127 { 00128 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00129 cblas_cdotu_sub( num_elem, 00130 buff_x, inc_x, 00131 buff_y, inc_y, &temp ); 00132 cblas_cdotu_sub( num_elem, 00133 buff_y, inc_y, 00134 buff_x, inc_x, &temp2 ); 00135 #else 00136 FLA_F2C( fla_cdotu ) ( &num_elem, 00137 buff_x, &inc_x, 00138 buff_y, &inc_y, &temp ); 00139 FLA_F2C( fla_cdotu ) ( &num_elem, 00140 buff_y, &inc_y, 00141 buff_x, &inc_x, &temp2 ); 00142 #endif 00143 } 00144 else 00145 { 00146 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00147 cblas_cdotc_sub( num_elem, 00148 buff_x, inc_x, 00149 buff_y, inc_y, &temp ); 00150 cblas_cdotc_sub( num_elem, 00151 buff_y, inc_y, 00152 buff_x, inc_x, &temp2 ); 00153 #else 00154 FLA_F2C( fla_cdotc ) ( &num_elem, 00155 buff_x, &inc_x, 00156 buff_y, &inc_y, &temp ); 00157 FLA_F2C( fla_cdotc ) ( &num_elem, 00158 buff_y, &inc_y, 00159 buff_x, &inc_x, &temp2 ); 00160 #endif 00161 } 00162 00163 temp_rho.real = buff_alpha->real * temp.real - buff_alpha->imag * temp.imag + 00164 alphac.real * temp2.real - alphac.imag * temp2.imag + 00165 buff_beta->real * buff_rho->real - buff_beta->imag * buff_rho->imag; 00166 00167 temp_rho.imag = buff_alpha->real * temp.imag + buff_alpha->imag * temp.real + 00168 alphac.real * temp2.imag + alphac.imag * temp2.real + 00169 buff_beta->real * buff_rho->imag + buff_beta->imag * buff_rho->real; 00170 00171 buff_rho->real = temp_rho.real; 00172 buff_rho->imag = temp_rho.imag; 00173 00174 break; 00175 } 00176 00177 case FLA_DOUBLE_COMPLEX: 00178 { 00179 dcomplex *buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x ); 00180 dcomplex *buff_y = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y ); 00181 dcomplex *buff_rho = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho ); 00182 dcomplex *buff_alpha = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( alpha ); 00183 dcomplex *buff_beta = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( beta ); 00184 dcomplex temp, temp2, alphac, temp_rho; 00185 00186 alphac = *buff_alpha; 00187 alphac.imag *= -1.0; 00188 00189 if ( conj == FLA_NO_CONJUGATE ) 00190 { 00191 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00192 cblas_zdotu_sub( num_elem, 00193 buff_x, inc_x, 00194 buff_y, inc_y, &temp ); 00195 cblas_zdotu_sub( num_elem, 00196 buff_y, inc_y, 00197 buff_x, inc_x, &temp2 ); 00198 #else 00199 FLA_F2C( fla_zdotu ) ( &num_elem, 00200 buff_x, &inc_x, 00201 buff_y, &inc_y, &temp ); 00202 FLA_F2C( fla_zdotu ) ( &num_elem, 00203 buff_y, &inc_y, 00204 buff_x, &inc_x, &temp2 ); 00205 #endif 00206 } 00207 else 00208 { 00209 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00210 cblas_zdotc_sub( num_elem, 00211 buff_x, inc_x, 00212 buff_y, inc_y, &temp ); 00213 cblas_zdotc_sub( num_elem, 00214 buff_y, inc_y, 00215 buff_x, inc_x, &temp2 ); 00216 #else 00217 FLA_F2C( fla_zdotc ) ( &num_elem, 00218 buff_x, &inc_x, 00219 buff_y, &inc_y, &temp ); 00220 FLA_F2C( fla_zdotc ) ( &num_elem, 00221 buff_y, &inc_y, 00222 buff_x, &inc_x, &temp2 ); 00223 #endif 00224 } 00225 00226 temp_rho.real = buff_alpha->real * temp.real - buff_alpha->imag * temp.imag + 00227 alphac.real * temp2.real - alphac.imag * temp2.imag + 00228 buff_beta->real * buff_rho->real - buff_beta->imag * buff_rho->imag; 00229 00230 temp_rho.imag = buff_alpha->real * temp.imag + buff_alpha->imag * temp.real + 00231 alphac.real * temp2.imag + alphac.imag * temp2.real + 00232 buff_beta->real * buff_rho->imag + buff_beta->imag * buff_rho->real; 00233 00234 buff_rho->real = temp_rho.real; 00235 buff_rho->imag = temp_rho.imag; 00236 00237 break; 00238 } 00239 00240 } 00241 00242 return FLA_SUCCESS; 00243 }
void FLA_F2C() fla_dot2cs_external_f | ( | F_INT * | conj, | |
F_INT * | alpha, | |||
F_INT * | x, | |||
F_INT * | y, | |||
F_INT * | beta, | |||
F_INT * | rho, | |||
F_INT * | IERROR | |||
) |
References FLA_Dot2cs_external().
00247 { 00248 *IERROR = FLA_Dot2cs_external( *( ( FLA_Conj * ) conj ), 00249 *( ( FLA_Obj * ) alpha ), 00250 *( ( FLA_Obj * ) x ), 00251 *( ( FLA_Obj * ) y ), 00252 *( ( FLA_Obj * ) beta ), 00253 *( ( FLA_Obj * ) rho ) ); 00254 }