Functions | |
FLA_Error | FLA_Dot_external (FLA_Obj x, FLA_Obj y, FLA_Obj rho) |
void FLA_F2C() | fla_dot_external_f (F_INT *x, F_INT *y, F_INT *rho, F_INT *IERROR) |
References cblas_cdotu_sub(), cblas_ddot(), cblas_sdot(), cblas_zdotu_sub(), ddot(), fla_cdotu(), FLA_Check_error_level(), FLA_Dot_check(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), fla_zdotu(), and sdot().
Referenced by FLA_Dot(), and fla_dot_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_Dot_check( 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 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00111 cblas_cdotu_sub( num_elem, 00112 buff_x, inc_x, 00113 buff_y, inc_y, buff_rho ); 00114 #else 00115 // Using FLA_F2C here is not a bug! FLA_C2F() appends an (possibly) incorrect number 00116 // of underscores. 00117 FLA_F2C( fla_cdotu ) ( &num_elem, 00118 buff_x, &inc_x, 00119 buff_y, &inc_y, buff_rho ); 00120 #endif 00121 00122 break; 00123 } 00124 00125 case FLA_DOUBLE_COMPLEX: 00126 { 00127 dcomplex *buff_x = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( x ); 00128 dcomplex *buff_y = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( y ); 00129 dcomplex *buff_rho = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( rho ); 00130 00131 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00132 cblas_zdotu_sub( num_elem, 00133 buff_x, inc_x, 00134 buff_y, inc_y, buff_rho ); 00135 #else 00136 // Using FLA_F2C here is not a bug! FLA_C2F() appends an (possibly) incorrect number 00137 // of underscores. 00138 FLA_F2C( fla_zdotu ) ( &num_elem, 00139 buff_x, &inc_x, 00140 buff_y, &inc_y, buff_rho ); 00141 #endif 00142 00143 break; 00144 } 00145 00146 } 00147 00148 return FLA_SUCCESS; 00149 }
void FLA_F2C() fla_dot_external_f | ( | F_INT * | x, | |
F_INT * | y, | |||
F_INT * | rho, | |||
F_INT * | IERROR | |||
) |
References FLA_Dot_external().
00153 { 00154 *IERROR = FLA_Dot_external( *( ( FLA_Obj * ) x ), 00155 *( ( FLA_Obj * ) y ), 00156 *( ( FLA_Obj * ) rho ) ); 00157 }