Functions | |
FLA_Error | FLA_Dotc_external (FLA_Conj conj, FLA_Obj x, FLA_Obj y, FLA_Obj rho) |
void FLA_F2C() | fla_dotc_external_f (F_INT *conj, F_INT *x, F_INT *y, F_INT *rho, F_INT *IERROR) |
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_Dotc_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), fla_zdotc(), fla_zdotu(), and sdot().
Referenced by FLA_Dotc(), and fla_dotc_external_f().
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_Dotc_check( conj, x, y, rho ); 00044 00045 if ( FLA_Obj_has_zero_dim( x ) ) return FLA_SUCCESS; 00046 00047 datatype = FLA_Obj_datatype( x ); 00048 00049 m_x = FLA_Obj_length( x ); 00050 ldim_x = FLA_Obj_ldim( x ); 00051 00052 m_y = FLA_Obj_length( y ); 00053 ldim_y = FLA_Obj_ldim( y ); 00054 00055 inc_x = ( m_x == 1 ? ldim_x : 1 ); 00056 inc_y = ( m_y == 1 ? ldim_y : 1 ); 00057 num_elem = FLA_Obj_vector_dim( x ); 00058 00059 00060 switch ( datatype ){ 00061 00062 case FLA_FLOAT: 00063 { 00064 float *buff_x = ( float * ) FLA_FLOAT_PTR( x ); 00065 float *buff_y = ( float * ) FLA_FLOAT_PTR( y ); 00066 float *buff_rho = ( float * ) FLA_FLOAT_PTR( rho ); 00067 00068 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00069 *buff_rho = 00070 cblas_sdot( num_elem, 00071 buff_x, inc_x, 00072 buff_y, inc_y ); 00073 #else 00074 *buff_rho = 00075 FLA_C2F( sdot ) ( &num_elem, 00076 buff_x, &inc_x, 00077 buff_y, &inc_y ); 00078 #endif 00079 00080 break; 00081 } 00082 00083 case FLA_DOUBLE: 00084 { 00085 double *buff_x = ( double * ) FLA_DOUBLE_PTR( x ); 00086 double *buff_y = ( double * ) FLA_DOUBLE_PTR( y ); 00087 double *buff_rho = ( double * ) FLA_DOUBLE_PTR( rho ); 00088 00089 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00090 *buff_rho = 00091 cblas_ddot( num_elem, 00092 buff_x, inc_x, 00093 buff_y, inc_y ); 00094 #else 00095 *buff_rho = 00096 FLA_C2F( ddot ) ( &num_elem, 00097 buff_x, &inc_x, 00098 buff_y, &inc_y ); 00099 #endif 00100 00101 break; 00102 } 00103 00104 case FLA_COMPLEX: 00105 { 00106 scomplex *buff_x = ( scomplex * ) FLA_COMPLEX_PTR( x ); 00107 scomplex *buff_y = ( scomplex * ) FLA_COMPLEX_PTR( y ); 00108 scomplex *buff_rho = ( scomplex * ) FLA_COMPLEX_PTR( rho ); 00109 00110 if ( conj == FLA_NO_CONJUGATE ) 00111 { 00112 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00113 cblas_cdotu_sub( num_elem, 00114 buff_x, inc_x, 00115 buff_y, inc_y, buff_rho ); 00116 #else 00117 FLA_F2C( fla_cdotu ) ( &num_elem, 00118 buff_x, &inc_x, 00119 buff_y, &inc_y, buff_rho ); 00120 #endif 00121 } 00122 else 00123 { 00124 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00125 cblas_cdotc_sub( num_elem, 00126 buff_x, inc_x, 00127 buff_y, inc_y, buff_rho ); 00128 #else 00129 FLA_F2C( fla_cdotc ) ( &num_elem, 00130 buff_x, &inc_x, 00131 buff_y, &inc_y, buff_rho ); 00132 #endif 00133 } 00134 00135 break; 00136 } 00137 00138 case FLA_DOUBLE_COMPLEX: 00139 { 00140 dcomplex *buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x ); 00141 dcomplex *buff_y = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y ); 00142 dcomplex *buff_rho = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho ); 00143 00144 if ( conj == FLA_NO_CONJUGATE ) 00145 { 00146 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00147 cblas_zdotu_sub( num_elem, 00148 buff_x, inc_x, 00149 buff_y, inc_y, buff_rho ); 00150 #else 00151 FLA_F2C( fla_zdotu ) ( &num_elem, 00152 buff_x, &inc_x, 00153 buff_y, &inc_y, buff_rho ); 00154 #endif 00155 } 00156 else 00157 { 00158 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00159 cblas_zdotc_sub( num_elem, 00160 buff_x, inc_x, 00161 buff_y, inc_y, buff_rho ); 00162 #else 00163 FLA_F2C( fla_zdotc ) ( &num_elem, 00164 buff_x, &inc_x, 00165 buff_y, &inc_y, buff_rho ); 00166 #endif 00167 } 00168 00169 break; 00170 } 00171 00172 } 00173 00174 return FLA_SUCCESS; 00175 }
void FLA_F2C() fla_dotc_external_f | ( | F_INT * | conj, | |
F_INT * | x, | |||
F_INT * | y, | |||
F_INT * | rho, | |||
F_INT * | IERROR | |||
) |
References FLA_Dotc_external().
00179 { 00180 *IERROR = FLA_Dotc_external( *( ( FLA_Conj * ) conj ), 00181 *( ( FLA_Obj * ) x ), 00182 *( ( FLA_Obj * ) y ), 00183 *( ( FLA_Obj * ) rho ) ); 00184 }