Functions | |
FLA_Error | FLA_Swap_external (FLA_Obj A, FLA_Obj B) |
void FLA_F2C() | fla_swap_external_f (F_INT *A, F_INT *B, F_INT *IERROR) |
References cblas_cswap(), cblas_dswap(), cblas_sswap(), cblas_zswap(), cswap(), dswap(), FLA_Check_error_level(), FLA_Obj_datatype(), FLA_Obj_has_zero_dim(), FLA_Obj_is_vector(), FLA_Obj_ldim(), FLA_Obj_length(), FLA_Obj_vector_dim(), FLA_Obj_width(), FLA_Swap_check(), sswap(), and zswap().
Referenced by FLA_Swap(), and fla_swap_external_f().
00036 { 00037 FLA_Datatype datatype; 00038 int j, n_iter; 00039 int num_elem; 00040 int m_A, n_A, inc_A, ldim_A; 00041 int m_B, inc_B, ldim_B; 00042 00043 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 00044 FLA_Swap_check( A, B ); 00045 00046 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; 00047 00048 datatype = FLA_Obj_datatype( A ); 00049 00050 m_A = FLA_Obj_length( A ); 00051 n_A = FLA_Obj_width( A ); 00052 ldim_A = FLA_Obj_ldim( A ); 00053 00054 m_B = FLA_Obj_length( B ); 00055 ldim_B = FLA_Obj_ldim( B ); 00056 00057 if ( FLA_Obj_is_vector( A ) ) 00058 { 00059 inc_A = ( m_A == 1 ? ldim_A : 1 ); 00060 inc_B = ( m_B == 1 ? ldim_B : 1 ); 00061 n_iter = 1; 00062 num_elem = FLA_Obj_vector_dim( A ); 00063 } 00064 else 00065 { 00066 inc_A = 1; 00067 inc_B = 1; 00068 n_iter = n_A; 00069 num_elem = m_A; 00070 } 00071 00072 switch ( datatype ){ 00073 00074 case FLA_FLOAT: 00075 { 00076 float* buff_A = ( float * ) FLA_FLOAT_PTR( A ); 00077 float* buff_B = ( float * ) FLA_FLOAT_PTR( B ); 00078 00079 for ( j = 0; j < n_iter; ++j ) 00080 { 00081 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00082 cblas_sswap( num_elem, 00083 buff_A + j*ldim_A, inc_A, 00084 buff_B + j*ldim_B, inc_B ); 00085 #else 00086 FLA_C2F( sswap )( &num_elem, 00087 buff_A + j*ldim_A, &inc_A, 00088 buff_B + j*ldim_B, &inc_B ); 00089 #endif 00090 } 00091 00092 break; 00093 } 00094 00095 case FLA_DOUBLE: 00096 { 00097 double* buff_A = ( double * ) FLA_DOUBLE_PTR( A ); 00098 double* buff_B = ( double * ) FLA_DOUBLE_PTR( B ); 00099 00100 for ( j = 0; j < n_iter; ++j ) 00101 { 00102 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00103 cblas_dswap( num_elem, 00104 buff_A + j*ldim_A, inc_A, 00105 buff_B + j*ldim_B, inc_B ); 00106 #else 00107 FLA_C2F( dswap )( &num_elem, 00108 buff_A + j*ldim_A, &inc_A, 00109 buff_B + j*ldim_B, &inc_B ); 00110 #endif 00111 } 00112 00113 break; 00114 } 00115 00116 case FLA_COMPLEX: 00117 { 00118 scomplex* buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00119 scomplex* buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B ); 00120 00121 for ( j = 0; j < n_iter; ++j ) 00122 { 00123 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00124 cblas_cswap( num_elem, 00125 buff_A + j*ldim_A, inc_A, 00126 buff_B + j*ldim_B, inc_B ); 00127 #else 00128 FLA_C2F( cswap )( &num_elem, 00129 buff_A + j*ldim_A, &inc_A, 00130 buff_B + j*ldim_B, &inc_B ); 00131 #endif 00132 } 00133 00134 break; 00135 } 00136 00137 case FLA_DOUBLE_COMPLEX: 00138 { 00139 dcomplex* buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00140 dcomplex* buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B ); 00141 00142 for ( j = 0; j < n_iter; ++j ) 00143 { 00144 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00145 cblas_zswap( num_elem, 00146 buff_A + j*ldim_A, inc_A, 00147 buff_B + j*ldim_B, inc_B ); 00148 #else 00149 FLA_C2F( zswap )( &num_elem, 00150 buff_A + j*ldim_A, &inc_A, 00151 buff_B + j*ldim_B, &inc_B ); 00152 #endif 00153 } 00154 00155 break; 00156 } 00157 00158 } 00159 00160 return FLA_SUCCESS; 00161 }
void FLA_F2C() fla_swap_external_f | ( | F_INT * | A, | |
F_INT * | B, | |||
F_INT * | IERROR | |||
) |
References FLA_Swap_external().
00165 { 00166 *IERROR = FLA_Swap_external( *( ( FLA_Obj * ) A ), 00167 *( ( FLA_Obj * ) B ) ); 00168 }