Functions | |
FLA_Error | FLA_Swapt_external (FLA_Trans trans, FLA_Obj A, FLA_Obj B) |
void FLA_F2C() | fla_swapt_external_f (F_INT *trans, 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_Conjugate(), 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_Swapt_check(), sswap(), and zswap().
Referenced by FLA_Swap_t_blk_var1(), FLA_Swap_t_blk_var2(), FLA_Swapt(), fla_swapt_external_f(), FLA_Transpose_unb_var1(), and FLA_Transpose_unb_var2().
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 int ldim_B_trans, inc_B_trans; 00043 00044 if ( FLA_Check_error_level() == FLA_FULL_ERROR_CHECKING ) 00045 FLA_Swapt_check( trans, A, B ); 00046 00047 if ( FLA_Obj_has_zero_dim( A ) ) return FLA_SUCCESS; 00048 00049 datatype = FLA_Obj_datatype( A ); 00050 00051 m_A = FLA_Obj_length( A ); 00052 n_A = FLA_Obj_width( A ); 00053 ldim_A = FLA_Obj_ldim( A ); 00054 00055 m_B = FLA_Obj_length( B ); 00056 ldim_B = FLA_Obj_ldim( B ); 00057 00058 if ( FLA_Obj_is_vector( A ) ) 00059 { 00060 inc_A = ( m_A == 1 ? ldim_A : 1 ); 00061 inc_B = ( m_B == 1 ? ldim_B : 1 ); 00062 n_iter = 1; 00063 num_elem = FLA_Obj_vector_dim( A ); 00064 00065 ldim_B_trans = ldim_B; 00066 inc_B_trans = inc_B; 00067 } 00068 else 00069 { 00070 inc_A = 1; 00071 inc_B = 1; 00072 n_iter = n_A; 00073 num_elem = m_A; 00074 00075 if ( trans == FLA_NO_TRANSPOSE || trans == FLA_CONJ_NO_TRANSPOSE ) 00076 { 00077 ldim_B_trans = ldim_B; 00078 inc_B_trans = inc_B; 00079 } 00080 else // ( trans == FLA_TRANSPOSE || trans == FLA_CONJ_TRANSPOSE ) 00081 { 00082 ldim_B_trans = inc_B; 00083 inc_B_trans = ldim_B; 00084 } 00085 } 00086 00087 switch ( datatype ){ 00088 00089 case FLA_FLOAT: 00090 { 00091 float* buff_A = ( float * ) FLA_FLOAT_PTR( A ); 00092 float* buff_B = ( float * ) FLA_FLOAT_PTR( B ); 00093 00094 for ( j = 0; j < n_iter; j++ ) 00095 { 00096 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00097 cblas_sswap( num_elem, 00098 buff_A + j*ldim_A, inc_A, 00099 buff_B + j*ldim_B_trans, inc_B_trans ); 00100 #else 00101 FLA_C2F( sswap )( &num_elem, 00102 buff_A + j*ldim_A, &inc_A, 00103 buff_B + j*ldim_B_trans, &inc_B_trans ); 00104 #endif 00105 } 00106 00107 break; 00108 } 00109 00110 case FLA_DOUBLE: 00111 { 00112 double* buff_A = ( double * ) FLA_DOUBLE_PTR( A ); 00113 double* buff_B = ( double * ) FLA_DOUBLE_PTR( B ); 00114 00115 for ( j = 0; j < n_iter; j++ ) 00116 { 00117 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00118 cblas_dswap( num_elem, 00119 buff_A + j*ldim_A, inc_A, 00120 buff_B + j*ldim_B_trans, inc_B_trans ); 00121 #else 00122 FLA_C2F( dswap )( &num_elem, 00123 buff_A + j*ldim_A, &inc_A, 00124 buff_B + j*ldim_B_trans, &inc_B_trans ); 00125 #endif 00126 } 00127 00128 break; 00129 } 00130 00131 case FLA_COMPLEX: 00132 { 00133 scomplex* buff_A = ( scomplex * ) FLA_COMPLEX_PTR( A ); 00134 scomplex* buff_B = ( scomplex * ) FLA_COMPLEX_PTR( B ); 00135 00136 for ( j = 0; j < n_iter; j++ ) 00137 { 00138 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00139 cblas_cswap( num_elem, 00140 buff_A + j*ldim_A, inc_A, 00141 buff_B + j*ldim_B_trans, inc_B_trans ); 00142 #else 00143 FLA_C2F( cswap )( &num_elem, 00144 buff_A + j*ldim_A, &inc_A, 00145 buff_B + j*ldim_B_trans, &inc_B_trans ); 00146 #endif 00147 } 00148 00149 break; 00150 } 00151 00152 case FLA_DOUBLE_COMPLEX: 00153 { 00154 dcomplex* buff_A = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( A ); 00155 dcomplex* buff_B = ( dcomplex * ) FLA_DOUBLE_COMPLEX_PTR( B ); 00156 00157 for ( j = 0; j < n_iter; j++ ) 00158 { 00159 #ifdef FLA_ENABLE_CBLAS_INTERFACE 00160 cblas_zswap( num_elem, 00161 buff_A + j*ldim_A, inc_A, 00162 buff_B + j*ldim_B_trans, inc_B_trans ); 00163 #else 00164 FLA_C2F( zswap )( &num_elem, 00165 buff_A + j*ldim_A, &inc_A, 00166 buff_B + j*ldim_B_trans, &inc_B_trans ); 00167 #endif 00168 } 00169 00170 break; 00171 } 00172 00173 } 00174 00175 if ( trans == FLA_CONJ_NO_TRANSPOSE || trans == FLA_CONJ_TRANSPOSE ) 00176 { 00177 FLA_Conjugate( A ); 00178 FLA_Conjugate( B ); 00179 } 00180 00181 return FLA_SUCCESS; 00182 }
void FLA_F2C() fla_swapt_external_f | ( | F_INT * | trans, | |
F_INT * | A, | |||
F_INT * | B, | |||
F_INT * | IERROR | |||
) |
References FLA_Swapt_external().
00186 { 00187 *IERROR = FLA_Swapt_external( *( ( FLA_Trans * ) trans ), 00188 *( ( FLA_Obj * ) A ), 00189 *( ( FLA_Obj * ) B ) ); 00190 }