FLA_Swap_external.c File Reference

(r)


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)

Function Documentation

FLA_Error FLA_Swap_external ( FLA_Obj  A,
FLA_Obj  B 
)

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 }


Generated on Mon Jul 6 05:45:53 2009 for libflame by  doxygen 1.5.9